- IBDE ;ALB/CJM - ENCOUNTER FORM - IMP/EXP UTILITY ;AUG 12,1993
- ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
- ;
- MAIN ;
- N FORMLIST,BLKLIST,FORMCNT,BLKCNT,IBTKBLK,SCREEN
- S SCREEN="F" ;a flag that indicates wheter user is looking at the block screen(=B) or the form screen(=F)
- S IBTKBLK=0 ;if 1 overrides check preventing deletion of tk blocks
- K XQORS,VALMEVL
- D EN^VALM("IBDE IMP/EXP FORMS")
- Q
- HDR ;
- S VALMHDR(1)="LIST OF FORMS READY FOR IMPORT OR EXPORT"
- S VALMHDR(3)="(** there are "_$S($O(^IBE(358.1,"D",0)):"also",1:"no")_" toolkit blocks in the work space **)"
- Q
- ONENTRY ;
- S FORMLIST="^TMP(""IBDF"",$J,""IMP/EXP WS"",""FORMS"")"
- S BLKLIST="^TMP(""IBDF"",$J,""IMP/EXP WS"",""BLOCKS"")"
- D IDXBLKS^IBDE3,IDXFORMS
- Q
- ONEXIT ;
- K ^TMP("IBDF",$J,"IMP/EXP WS"),VALMY,VALMBCK,X,Y,I,DA,D0
- Q
- ;
- IDXFORMS ;build an array of forms used by IBCLINIC for the list processor
- N FORM,NODE
- K @FORMLIST
- S (FORM,VALMCNT)=0 F S FORM=$O(^IBE(358,FORM)) Q:'FORM D
- .I $D(^IBE(358,FORM,0)) D
- ..S VALMCNT=VALMCNT+1,@FORMLIST@(VALMCNT,0)=$$DISPLAY(FORM,VALMCNT),@FORMLIST@("IDX",VALMCNT,VALMCNT)=FORM D FLDCTRL^VALM10(VALMCNT) ;set video for ID column
- S FORMCNT=VALMCNT
- Q
- ;
- DISPLAY(FORM,ID) ;
- N NODE,RET
- S RET=$J(ID,3)_" "
- S NODE=$G(^IBE(358,FORM,0))
- S RET=RET_$$PADRIGHT^IBDFU($P(NODE,"^",1),30)_" "_$P(NODE,"^",3)
- Q RET
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDE 1368 printed Jan 18, 2025@02:40 Page 2
- IBDE ;ALB/CJM - ENCOUNTER FORM - IMP/EXP UTILITY ;AUG 12,1993
- +1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
- +2 ;
- MAIN ;
- +1 NEW FORMLIST,BLKLIST,FORMCNT,BLKCNT,IBTKBLK,SCREEN
- +2 ;a flag that indicates wheter user is looking at the block screen(=B) or the form screen(=F)
- SET SCREEN="F"
- +3 ;if 1 overrides check preventing deletion of tk blocks
- SET IBTKBLK=0
- +4 KILL XQORS,VALMEVL
- +5 DO EN^VALM("IBDE IMP/EXP FORMS")
- +6 QUIT
- HDR ;
- +1 SET VALMHDR(1)="LIST OF FORMS READY FOR IMPORT OR EXPORT"
- +2 SET VALMHDR(3)="(** there are "_$SELECT($ORDER(^IBE(358.1,"D",0)):"also",1:"no")_" toolkit blocks in the work space **)"
- +3 QUIT
- ONENTRY ;
- +1 SET FORMLIST="^TMP(""IBDF"",$J,""IMP/EXP WS"",""FORMS"")"
- +2 SET BLKLIST="^TMP(""IBDF"",$J,""IMP/EXP WS"",""BLOCKS"")"
- +3 DO IDXBLKS^IBDE3
- DO IDXFORMS
- +4 QUIT
- ONEXIT ;
- +1 KILL ^TMP("IBDF",$JOB,"IMP/EXP WS"),VALMY,VALMBCK,X,Y,I,DA,D0
- +2 QUIT
- +3 ;
- IDXFORMS ;build an array of forms used by IBCLINIC for the list processor
- +1 NEW FORM,NODE
- +2 KILL @FORMLIST
- +3 SET (FORM,VALMCNT)=0
- FOR
- SET FORM=$ORDER(^IBE(358,FORM))
- if 'FORM
- QUIT
- Begin DoDot:1
- +4 IF $DATA(^IBE(358,FORM,0))
- Begin DoDot:2
- +5 ;set video for ID column
- SET VALMCNT=VALMCNT+1
- SET @FORMLIST@(VALMCNT,0)=$$DISPLAY(FORM,VALMCNT)
- SET @FORMLIST@("IDX",VALMCNT,VALMCNT)=FORM
- DO FLDCTRL^VALM10(VALMCNT)
- End DoDot:2
- End DoDot:1
- +6 SET FORMCNT=VALMCNT
- +7 QUIT
- +8 ;
- DISPLAY(FORM,ID) ;
- +1 NEW NODE,RET
- +2 SET RET=$JUSTIFY(ID,3)_" "
- +3 SET NODE=$GET(^IBE(358,FORM,0))
- +4 SET RET=RET_$$PADRIGHT^IBDFU($PIECE(NODE,"^",1),30)_" "_$PIECE(NODE,"^",3)
- +5 QUIT RET