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 ---[H[J[2J[HIBDFUA 3187 printed Apr 09, 2024@21:47:32 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
