IBDFU1C ;ALB/CJM - ENCOUNTER FORM (sets various parameters);Jan 5, 1995
;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
;utilities
;
FORMDSCR(IBFORM) ;
;IBFORM=ien of form - sets the IBFORM array with form parameterss - should be passed by reference
;returns 1=ok, 0=failure
;
Q:'IBFORM 0
N NODE,MODE,SUB
S NODE=$G(^IBE(357,IBFORM,0))
Q:NODE="" 0
S IBFORM("NAME")=$P(NODE,"^")
S IBFORM("WIDTH")=$P(NODE,"^",9) S:'IBFORM("WIDTH") IBFORM("WIDTH")=133
S IBFORM("PAGE_HT")=$P(NODE,"^",10) S:'IBFORM("PAGE_HT") IBFORM("PAGE_HT")=80
S IBFORM("PAGES")=$P(NODE,"^",11) S:'IBFORM("PAGES") IBFORM("PAGES")=1
S IBFORM("HT")=IBFORM("PAGE_HT")*IBFORM("PAGES")
S IBFORM("TOOLKIT")=$P(NODE,"^",7)
S IBFORM("COMPILED")=0 I +$P(NODE,"^",5),+$P(NODE,"^",13) S IBFORM("COMPILED")=1
;S IBFORM("COMPILED")=+$P(NODE,"^",5)
S IBFORM("SCAN")=$P(NODE,"^",12)
S IBFORM("SCAN","ICR")=$S(IBFORM("SCAN"):$P(NODE,"^",6),1:0)
S IBFORM("TYPE")=$P(NODE,"^",13)
;
S MODE=$P(NODE,"^",2)
S IBFORM("PRINT_MODE")=$S(MODE=1:"DUPLEX_LONG",MODE=2:"DUPLEX_SHORT",1:"SIMPLEX")
;
;pages to be scanned
I IBFORM("SCAN") S SUB=0 F S SUB=$O(^IBE(357,IBFORM,2,SUB)) Q:'SUB S NODE=$G(^IBE(357,IBFORM,2,SUB,0)) I +NODE,$P(NODE,"^",2) S IBFORM("SCAN",+NODE)=1
Q 1
;
FORMSIZE(IBFORM) ;pass IBFORM by reference
;returns 0=failure, 1=success
N NODE
S NODE=$G(^IBE(357,IBFORM,0))
Q:NODE="" 0
S IBFORM("WIDTH")=$P(NODE,"^",9) S:'IBFORM("WIDTH") IBFORM("WIDTH")=133
S IBFORM("PAGE_HT")=$P(NODE,"^",10) S:'IBFORM("PAGE_HT") IBFORM("PAGE_HT")=80
S IBFORM("PAGES")=$P(NODE,"^",11) S:'IBFORM("PAGES") IBFORM("PAGES")=1
S IBFORM("HT")=IBFORM("PAGE_HT")*IBFORM("PAGES")
Q 1
;
ARRAYS(IBFORM,IBARRAY) ;decide what arrays will be used to contain the form
;pass IBFORM,IBARRAY by reference
;
;non-toolkit forms are compiled
I 'IBFORM("TOOLKIT") D
.S IBARRAY("UNDERLINES")="^IBE(357,""AU"",IBFORM)"
.S IBARRAY("CONTROLS")="^IBE(357,""AC"",IBFORM)"
.S IBARRAY("GRAPHICS")="^IBE(357,""AG"",IBFORM)"
.S IBARRAY("BOXES")="^IBE(357,""AB"",IBFORM)"
.S IBARRAY("BUBBLES")=$S(IBFORM("TYPE"):"^IBD(357.95,""AC"",IBFORM(""TYPE""))",1:"^TMP(""IBDF"",$J,""FORM"",""BUBBLES"")")
.S IBARRAY("HAND_PRINT")=$S(IBFORM("TYPE"):"^IBD(357.95,""AD"",IBFORM(""TYPE""))",1:"^TMP(""IBDF"",$J,""FORM"",""HAND PRINT"")")
.;
.;if using compiled version, use a copy of the text portion so as to not change it
.I IBFORM("COMPILED") D
..N IBROW,TEXT
..S IBARRAY("TEXT")="^TMP(""IBDF"",$J,""FORM"")"
..S TEXT="^IBE(357,""AT"",IBFORM)"
..S IBROW="" F S IBROW=$O(@TEXT@(IBROW)) Q:IBROW="" S @IBARRAY("TEXT")@(IBROW)=$G(@TEXT@(IBROW))
.;
.I 'IBFORM("COMPILED") S IBARRAY("TEXT")="^IBE(357,""AT"",IBFORM)"
;
;toolkit forms don't have compiled versions
I IBFORM("TOOLKIT") D
.S IBARRAY("CONTROLS")="^TMP(""IBDF"",$J,""FORM"",""CTRL"")"
.S IBARRAY("UNDERLINES")="^TMP(""IBDF"",$J,""FORM"",""UNDRLN"")"
.S IBARRAY("GRAPHICS")="^TMP(""IBDF"",$J,""FORM"",""GRPHC"")"
.S IBARRAY("BOXES")="^TMP(""IBDF"",$J,""FORM"",""BOXES"")"
.S IBARRAY("BUBBLES")="^TMP(""IBDF"",$J,""FORM"",""BUBBLES"")"
.S IBARRAY("HAND_PRINT")="^TMP(""IBDF"",$J,""FORM"",""HAND PRINT"")"
.S IBARRAY("TEXT")="^TMP(""IBDF"",$J,""FORM"")"
S IBARRAY("OVERFLOW")="^TMP(""IBDF"",$J,""OVERFLOW"")"
Q
;
PRNTPRMS(IBPRINT,WITHDATA,ENTIRE,RECMPILE,WRITE) ;
;sets pararameters in the IBPRINT array that controll printing - pass IBPRINT by reference
;WITHDATA - whether to fill in the form with data
;ENTIRE - whether to print the non-data parts
;RECMPILE - whether blocks should be compiled, even if already compiled
;WRITE - only applies if RECMPILE - whether to print the block
;
S IBPRINT("WITH_DATA")=WITHDATA
S IBPRINT("ENTIRE")=ENTIRE
S IBPRINT("COMPILING_BLOCKS")=RECMPILE
S IBPRINT("WRITE_IF_COMPILING")=WRITE ;if IBPRINT("COMPILING_BLOCKS"),this =0 if the form isn't being printed, =1 if the form is being printed
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDFU1C 3949 printed Dec 13, 2024@02:53:33 Page 2
IBDFU1C ;ALB/CJM - ENCOUNTER FORM (sets various parameters);Jan 5, 1995
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
+2 ;utilities
+3 ;
FORMDSCR(IBFORM) ;
+1 ;IBFORM=ien of form - sets the IBFORM array with form parameterss - should be passed by reference
+2 ;returns 1=ok, 0=failure
+3 ;
+4 if 'IBFORM
QUIT 0
+5 NEW NODE,MODE,SUB
+6 SET NODE=$GET(^IBE(357,IBFORM,0))
+7 if NODE=""
QUIT 0
+8 SET IBFORM("NAME")=$PIECE(NODE,"^")
+9 SET IBFORM("WIDTH")=$PIECE(NODE,"^",9)
if 'IBFORM("WIDTH")
SET IBFORM("WIDTH")=133
+10 SET IBFORM("PAGE_HT")=$PIECE(NODE,"^",10)
if 'IBFORM("PAGE_HT")
SET IBFORM("PAGE_HT")=80
+11 SET IBFORM("PAGES")=$PIECE(NODE,"^",11)
if 'IBFORM("PAGES")
SET IBFORM("PAGES")=1
+12 SET IBFORM("HT")=IBFORM("PAGE_HT")*IBFORM("PAGES")
+13 SET IBFORM("TOOLKIT")=$PIECE(NODE,"^",7)
+14 SET IBFORM("COMPILED")=0
IF +$PIECE(NODE,"^",5)
IF +$PIECE(NODE,"^",13)
SET IBFORM("COMPILED")=1
+15 ;S IBFORM("COMPILED")=+$P(NODE,"^",5)
+16 SET IBFORM("SCAN")=$PIECE(NODE,"^",12)
+17 SET IBFORM("SCAN","ICR")=$SELECT(IBFORM("SCAN"):$PIECE(NODE,"^",6),1:0)
+18 SET IBFORM("TYPE")=$PIECE(NODE,"^",13)
+19 ;
+20 SET MODE=$PIECE(NODE,"^",2)
+21 SET IBFORM("PRINT_MODE")=$SELECT(MODE=1:"DUPLEX_LONG",MODE=2:"DUPLEX_SHORT",1:"SIMPLEX")
+22 ;
+23 ;pages to be scanned
+24 IF IBFORM("SCAN")
SET SUB=0
FOR
SET SUB=$ORDER(^IBE(357,IBFORM,2,SUB))
if 'SUB
QUIT
SET NODE=$GET(^IBE(357,IBFORM,2,SUB,0))
IF +NODE
IF $PIECE(NODE,"^",2)
SET IBFORM("SCAN",+NODE)=1
+25 QUIT 1
+26 ;
FORMSIZE(IBFORM) ;pass IBFORM by reference
+1 ;returns 0=failure, 1=success
+2 NEW NODE
+3 SET NODE=$GET(^IBE(357,IBFORM,0))
+4 if NODE=""
QUIT 0
+5 SET IBFORM("WIDTH")=$PIECE(NODE,"^",9)
if 'IBFORM("WIDTH")
SET IBFORM("WIDTH")=133
+6 SET IBFORM("PAGE_HT")=$PIECE(NODE,"^",10)
if 'IBFORM("PAGE_HT")
SET IBFORM("PAGE_HT")=80
+7 SET IBFORM("PAGES")=$PIECE(NODE,"^",11)
if 'IBFORM("PAGES")
SET IBFORM("PAGES")=1
+8 SET IBFORM("HT")=IBFORM("PAGE_HT")*IBFORM("PAGES")
+9 QUIT 1
+10 ;
ARRAYS(IBFORM,IBARRAY) ;decide what arrays will be used to contain the form
+1 ;pass IBFORM,IBARRAY by reference
+2 ;
+3 ;non-toolkit forms are compiled
+4 IF 'IBFORM("TOOLKIT")
Begin DoDot:1
+5 SET IBARRAY("UNDERLINES")="^IBE(357,""AU"",IBFORM)"
+6 SET IBARRAY("CONTROLS")="^IBE(357,""AC"",IBFORM)"
+7 SET IBARRAY("GRAPHICS")="^IBE(357,""AG"",IBFORM)"
+8 SET IBARRAY("BOXES")="^IBE(357,""AB"",IBFORM)"
+9 SET IBARRAY("BUBBLES")=$SELECT(IBFORM("TYPE"):"^IBD(357.95,""AC"",IBFORM(""TYPE""))",1:"^TMP(""IBDF"",$J,""FORM"",""BUBBLES"")")
+10 SET IBARRAY("HAND_PRINT")=$SELECT(IBFORM("TYPE"):"^IBD(357.95,""AD"",IBFORM(""TYPE""))",1:"^TMP(""IBDF"",$J,""FORM"",""HAND PRINT"")")
+11 ;
+12 ;if using compiled version, use a copy of the text portion so as to not change it
+13 IF IBFORM("COMPILED")
Begin DoDot:2
+14 NEW IBROW,TEXT
+15 SET IBARRAY("TEXT")="^TMP(""IBDF"",$J,""FORM"")"
+16 SET TEXT="^IBE(357,""AT"",IBFORM)"
+17 SET IBROW=""
FOR
SET IBROW=$ORDER(@TEXT@(IBROW))
if IBROW=""
QUIT
SET @IBARRAY("TEXT")@(IBROW)=$GET(@TEXT@(IBROW))
End DoDot:2
+18 ;
+19 IF 'IBFORM("COMPILED")
SET IBARRAY("TEXT")="^IBE(357,""AT"",IBFORM)"
End DoDot:1
+20 ;
+21 ;toolkit forms don't have compiled versions
+22 IF IBFORM("TOOLKIT")
Begin DoDot:1
+23 SET IBARRAY("CONTROLS")="^TMP(""IBDF"",$J,""FORM"",""CTRL"")"
+24 SET IBARRAY("UNDERLINES")="^TMP(""IBDF"",$J,""FORM"",""UNDRLN"")"
+25 SET IBARRAY("GRAPHICS")="^TMP(""IBDF"",$J,""FORM"",""GRPHC"")"
+26 SET IBARRAY("BOXES")="^TMP(""IBDF"",$J,""FORM"",""BOXES"")"
+27 SET IBARRAY("BUBBLES")="^TMP(""IBDF"",$J,""FORM"",""BUBBLES"")"
+28 SET IBARRAY("HAND_PRINT")="^TMP(""IBDF"",$J,""FORM"",""HAND PRINT"")"
+29 SET IBARRAY("TEXT")="^TMP(""IBDF"",$J,""FORM"")"
End DoDot:1
+30 SET IBARRAY("OVERFLOW")="^TMP(""IBDF"",$J,""OVERFLOW"")"
+31 QUIT
+32 ;
PRNTPRMS(IBPRINT,WITHDATA,ENTIRE,RECMPILE,WRITE) ;
+1 ;sets pararameters in the IBPRINT array that controll printing - pass IBPRINT by reference
+2 ;WITHDATA - whether to fill in the form with data
+3 ;ENTIRE - whether to print the non-data parts
+4 ;RECMPILE - whether blocks should be compiled, even if already compiled
+5 ;WRITE - only applies if RECMPILE - whether to print the block
+6 ;
+7 SET IBPRINT("WITH_DATA")=WITHDATA
+8 SET IBPRINT("ENTIRE")=ENTIRE
+9 SET IBPRINT("COMPILING_BLOCKS")=RECMPILE
+10 ;if IBPRINT("COMPILING_BLOCKS"),this =0 if the form isn't being printed, =1 if the form is being printed
SET IBPRINT("WRITE_IF_COMPILING")=WRITE
+11 QUIT
