source: WorldVistAEHR/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDE.m@ 724

Last change on this file since 724 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.3 KB
Line 
1IBDE ;ALB/CJM - ENCOUNTER FORM - IMP/EXP UTILITY ;AUG 12,1993
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
3 ;
4MAIN ;
5 N FORMLIST,BLKLIST,FORMCNT,BLKCNT,IBTKBLK,SCREEN
6 S SCREEN="F" ;a flag that indicates wheter user is looking at the block screen(=B) or the form screen(=F)
7 S IBTKBLK=0 ;if 1 overrides check preventing deletion of tk blocks
8 K XQORS,VALMEVL
9 D EN^VALM("IBDE IMP/EXP FORMS")
10 Q
11HDR ;
12 S VALMHDR(1)="LIST OF FORMS READY FOR IMPORT OR EXPORT"
13 S VALMHDR(3)="(** there are "_$S($O(^IBE(358.1,"D",0)):"also",1:"no")_" toolkit blocks in the work space **)"
14 Q
15ONENTRY ;
16 S FORMLIST="^TMP(""IBDF"",$J,""IMP/EXP WS"",""FORMS"")"
17 S BLKLIST="^TMP(""IBDF"",$J,""IMP/EXP WS"",""BLOCKS"")"
18 D IDXBLKS^IBDE3,IDXFORMS
19 Q
20ONEXIT ;
21 K ^TMP("IBDF",$J,"IMP/EXP WS"),VALMY,VALMBCK,X,Y,I,DA,D0
22 Q
23 ;
24IDXFORMS ;build an array of forms used by IBCLINIC for the list processor
25 N FORM,NODE
26 K @FORMLIST
27 S (FORM,VALMCNT)=0 F S FORM=$O(^IBE(358,FORM)) Q:'FORM D
28 .I $D(^IBE(358,FORM,0)) D
29 ..S VALMCNT=VALMCNT+1,@FORMLIST@(VALMCNT,0)=$$DISPLAY(FORM,VALMCNT),@FORMLIST@("IDX",VALMCNT,VALMCNT)=FORM D FLDCTRL^VALM10(VALMCNT) ;set video for ID column
30 S FORMCNT=VALMCNT
31 Q
32 ;
33DISPLAY(FORM,ID) ;
34 N NODE,RET
35 S RET=$J(ID,3)_" "
36 S NODE=$G(^IBE(358,FORM,0))
37 S RET=RET_$$PADRIGHT^IBDFU($P(NODE,"^",1),30)_" "_$P(NODE,"^",3)
38 Q RET
Note: See TracBrowser for help on using the repository browser.