IBDFU1C.m

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 ---IBDFU1C   3949     printed  Feb 19, 2025@00:19:58                                                                                                                                                                                                     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