| 1 | IBDE ;ALB/CJM - ENCOUNTER FORM - IMP/EXP UTILITY ;AUG 12,1993
|
|---|
| 2 | ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | MAIN ;
|
|---|
| 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
|
|---|
| 11 | HDR ;
|
|---|
| 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
|
|---|
| 15 | ONENTRY ;
|
|---|
| 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
|
|---|
| 20 | ONEXIT ;
|
|---|
| 21 | K ^TMP("IBDF",$J,"IMP/EXP WS"),VALMY,VALMBCK,X,Y,I,DA,D0
|
|---|
| 22 | Q
|
|---|
| 23 | ;
|
|---|
| 24 | IDXFORMS ;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 | ;
|
|---|
| 33 | DISPLAY(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
|
|---|
