IBDFUA.m

IBDFUA ;ALB/CJM - ENCOUNTER FORM (utilities - IBDFU continued) ;NOV 16,1992

 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997

 ;

PRNTVAR ;defines the screen and graphics variables needed for printing

 ;

 D GSET^%ZISS,KILL^%ZISS

 S X="IOINHI;IOINORM;IOUON;IOUOFF"

 D ENDR^%ZISS

 S (IORVON,IORVOFF)=""

 K X

 Q

 ;

KPRNTVAR ;kills the variables defined by PRINTVAR 

 ; -- (actually, kills all screen paramters)

 ;

 Q:$D(VALMEVL)  ;don't kill if listman, (needed for 1010T)

 D GKILL^%ZISS,KILL^%ZISS

 Q 

 ;

GRAPHICS() ; returns1 if graphic mode available with characters needed

 ;sets graphics characters to "|" and "_" if graphics mode not available

 ;If not a raster device, then returns 0 no matter what

 ;

 N GRAPHICS S GRAPHICS=0

 I IBDEVICE("RASTER"),($G(IOG0)'=""),($G(IOG1)'=""),($G(IOVL)'=""),($G(IOHL)'=""),($G(IOBLC)'=""),($G(IOBRC)'=""),($G(IOTLC)'=""),($G(IOTRC)'="") S GRAPHICS=1

 S:IBDEVICE("PCL") GRAPHICS=1

 S:'GRAPHICS (IOVL,IOBLC,IOBRC)="|",(IOHL,IOTRC,IOTLC)="_"

 Q GRAPHICS

 ;

DEVICE(LISTMAN,IBDEVICE) ;sets various device parameters

 ;LISTMAN=1 if display for the List Manager, 0 otherwise

 ;returns IBDEVICE array - pass by reference

 ;Also, the required Kernel screen and graphics parameters are defined.

 ;

 ;IBDEVICE array elements:

 ;  RASTER = 1 if IOXY defined and not a crt

 ;  CRT= 1 if crt

 ;  GRAPHICS=1 if graphic mode available with characters needed.

 ;  PCL=1 if the printer language is PCL, version 5 or higher.

 ;  SIMPLEX,DUPLEX_LONG,DUPLEX_SHORT are printer control statements for simplex, duplex long-edge binding, duplex short-edge binding - in an encounter form file until added to the TERMINAL TYPE file in future version of KERNEL

 ;

 S IBDEVICE("TCP")=0

 ;

 I LISTMAN D  Q

 .S IBDEVICE("LISTMAN")=1

 .S IBDEVICE("CRT")=1

 .S IBDEVICE("PCL")=0

 .S IBDEVICE("GRAPHICS")=0

 .S IBDEVICE("RASTER")=0

 .D NOGRPHCS^IBDFU5

 ;

 ;not List Manager ->

 ;

 S (IBDEVICE("LISTMAN"),IBDEVICE("RASTER"),IBDEVICE("CRT"),IBDEVICE("PCL"))=0

 I $E($G(IOST),1,2)="C-" S IBDEVICE("CRT")=1

 I $G(IOXY)'="" S IBDEVICE("RASTER")=1

 D PRNTVAR

 S (IBDEVICE("SIMPLEX"),IBDEVICE("DUPLEX_LONG"),IBDEVICE("DUPLEX_SHORT"))=""

 I 'IBDEVICE("CRT"),'LISTMAN,$G(IOST(0)) D

 .N TERMINAL,TEMP

 .S TERMINAL=$G(^IBE(357.94,+$O(^IBE(357.94,"B",IOST(0),0)),0))

 .S IBDEVICE("TCP")=+$P(TERMINAL,"^",6)

 .S IBDEVICE("RESET")=$P(TERMINAL,"^",7)

 .S IBDEVICE("PCL")=$S($P(TERMINAL,"^",2)=1:1,1:0)

 .I $P(TERMINAL,"^",3)]"" S TEMP="S IBDEVICE(""SIMPLEX"")="_$P(TERMINAL,"^",3) X TEMP

 .;

 .;do not define duplex mode if simplex not defined

 .Q:IBDEVICE("SIMPLEX")=""

 .I $P(TERMINAL,"^",4)]"" S TEMP="S IBDEVICE(""DUPLEX_LONG"")="_$P(TERMINAL,"^",4) X TEMP

 .I $P(TERMINAL,"^",5)]"" S TEMP="S IBDEVICE(""DUPLEX_SHORT"")="_$P(TERMINAL,"^",5) X TEMP

 ;

 S IBDEVICE("GRAPHICS")=$$GRAPHICS

 Q

 ;

KILL ;this can be used just before calling List Manager to save space in the symbol table

 ;

 ;K XQORKBD,VALMKEY,VALMDDF,VALMHDR,%,CTRLCOL,DIC,Y,X,POP,DX,DY,%I,D,ZTSK,DIC,D0,POP,SEL,DIR,DIE,DR,DA,DIK,DD,%DT,%H,IOP,COL,J

 ;

 K %,CTRLCOL,DIC,Y,X,POP,DX,DY,%I,D,ZTSK,DIC,D0,POP,SEL,DIR,DIE,DR,DA,DIK,DD,%DT,%H,IOP,COL,J

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBDFUA   3187     printed  Mar 13, 2025@21:58:48                                                                                                                                                                                                      Page 2

IBDFUA    ;ALB/CJM - ENCOUNTER FORM (utilities - IBDFU continued) ;NOV 16,1992

 +1       ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997

 +2       ;

PRNTVAR   ;defines the screen and graphics variables needed for printing

 +1       ;

 +2        DO GSET^%ZISS

           DO KILL^%ZISS

 +3        SET X="IOINHI;IOINORM;IOUON;IOUOFF"

 +4        DO ENDR^%ZISS

 +5        SET (IORVON,IORVOFF)=""

 +6        KILL X

 +7        QUIT 

 +8       ;

KPRNTVAR  ;kills the variables defined by PRINTVAR 

 +1       ; -- (actually, kills all screen paramters)

 +2       ;

 +3       ;don't kill if listman, (needed for 1010T)

           if $DATA(VALMEVL)

               QUIT 

 +4        DO GKILL^%ZISS

           DO KILL^%ZISS

 +5        QUIT 

 +6       ;

GRAPHICS() ; returns1 if graphic mode available with characters needed

 +1       ;sets graphics characters to "|" and "_" if graphics mode not available

 +2       ;If not a raster device, then returns 0 no matter what

 +3       ;

 +4        NEW GRAPHICS

           SET GRAPHICS=0

 +5        IF IBDEVICE("RASTER")

               IF ($GET(IOG0)'="")

                   IF ($GET(IOG1)'="")

                       IF ($GET(IOVL)'="")

                           IF ($GET(IOHL)'="")

                               IF ($GET(IOBLC)'="")

                                   IF ($GET(IOBRC)'="")

                                       IF ($GET(IOTLC)'="")

                                           IF ($GET(IOTRC)'="")

                                               SET GRAPHICS=1

 +6        if IBDEVICE("PCL")

               SET GRAPHICS=1

 +7        if 'GRAPHICS

               SET (IOVL,IOBLC,IOBRC)="|"

               SET (IOHL,IOTRC,IOTLC)="_"

 +8        QUIT GRAPHICS

 +9       ;

DEVICE(LISTMAN,IBDEVICE) ;sets various device parameters

 +1       ;LISTMAN=1 if display for the List Manager, 0 otherwise

 +2       ;returns IBDEVICE array - pass by reference

 +3       ;Also, the required Kernel screen and graphics parameters are defined.

 +4       ;

 +5       ;IBDEVICE array elements:

 +6       ;  RASTER = 1 if IOXY defined and not a crt

 +7       ;  CRT= 1 if crt

 +8       ;  GRAPHICS=1 if graphic mode available with characters needed.

 +9       ;  PCL=1 if the printer language is PCL, version 5 or higher.

 +10      ;  SIMPLEX,DUPLEX_LONG,DUPLEX_SHORT are printer control statements for simplex, duplex long-edge binding, duplex short-edge binding - in an encounter form file until added to the TERMINAL TYPE file in future version of KERNEL

 +11      ;

 +12       SET IBDEVICE("TCP")=0

 +13      ;

 +14       IF LISTMAN

               Begin DoDot:1

 +15               SET IBDEVICE("LISTMAN")=1

 +16               SET IBDEVICE("CRT")=1

 +17               SET IBDEVICE("PCL")=0

 +18               SET IBDEVICE("GRAPHICS")=0

 +19               SET IBDEVICE("RASTER")=0

 +20               DO NOGRPHCS^IBDFU5

               End DoDot:1

               QUIT 

 +21      ;

 +22      ;not List Manager ->

 +23      ;

 +24       SET (IBDEVICE("LISTMAN"),IBDEVICE("RASTER"),IBDEVICE("CRT"),IBDEVICE("PCL"))=0

 +25       IF $EXTRACT($GET(IOST),1,2)="C-"

               SET IBDEVICE("CRT")=1

 +26       IF $GET(IOXY)'=""

               SET IBDEVICE("RASTER")=1

 +27       DO PRNTVAR

 +28       SET (IBDEVICE("SIMPLEX"),IBDEVICE("DUPLEX_LONG"),IBDEVICE("DUPLEX_SHORT"))=""

 +29       IF 'IBDEVICE("CRT")

               IF 'LISTMAN

                   IF $GET(IOST(0))

                       Begin DoDot:1

 +30                       NEW TERMINAL,TEMP

 +31                       SET TERMINAL=$GET(^IBE(357.94,+$ORDER(^IBE(357.94,"B",IOST(0),0)),0))

 +32                       SET IBDEVICE("TCP")=+$PIECE(TERMINAL,"^",6)

 +33                       SET IBDEVICE("RESET")=$PIECE(TERMINAL,"^",7)

 +34                       SET IBDEVICE("PCL")=$SELECT($PIECE(TERMINAL,"^",2)=1:1,1:0)

 +35                       IF $PIECE(TERMINAL,"^",3)]""

                               SET TEMP="S IBDEVICE(""SIMPLEX"")="_$PIECE(TERMINAL,"^",3)

                               XECUTE TEMP

 +36      ;

 +37      ;do not define duplex mode if simplex not defined

 +38                       if IBDEVICE("SIMPLEX")=""

                               QUIT 

 +39                       IF $PIECE(TERMINAL,"^",4)]""

                               SET TEMP="S IBDEVICE(""DUPLEX_LONG"")="_$PIECE(TERMINAL,"^",4)

                               XECUTE TEMP

 +40                       IF $PIECE(TERMINAL,"^",5)]""

                               SET TEMP="S IBDEVICE(""DUPLEX_SHORT"")="_$PIECE(TERMINAL,"^",5)

                               XECUTE TEMP

                       End DoDot:1

 +41      ;

 +42       SET IBDEVICE("GRAPHICS")=$$GRAPHICS

 +43       QUIT 

 +44      ;

KILL      ;this can be used just before calling List Manager to save space in the symbol table

 +1       ;

 +2       ;K XQORKBD,VALMKEY,VALMDDF,VALMHDR,%,CTRLCOL,DIC,Y,X,POP,DX,DY,%I,D,ZTSK,DIC,D0,POP,SEL,DIR,DIE,DR,DA,DIK,DD,%DT,%H,IOP,COL,J

 +3       ;

 +4        KILL %,CTRLCOL,DIC,Y,X,POP,DX,DY,%I,D,ZTSK,DIC,D0,POP,SEL,DIR,DIE,DR,DA,DIK,DD,%DT,%H,IOP,COL,J

 +5        QUIT