%ZIS3 ;SFISC/AC,RWF -- DEVICE HANDLER(DEVICE TYPES & PARAMETERS) ;06/09/10 17:47
;;8.0;KERNEL;**18,36,69,104,391,440,499,546**;JUL 10, 1995;Build 9
;Per VHA Directive 2004-038, this routine should not be modified
;Call with a Go from ^%ZIS2
I %ZIS'["T",$G(^%ZIS(1,+%E,"POX"))]"" D XPOX^ZISX(%E) ;Pre-Open
I $D(%ZISQUIT) S POP=1 K %ZISQUIT
S %ZISCHK=1
;See if need to lock.
K %ZISLOCK
I %ZIS'["T",+$G(^%ZIS(1,+%E,"GBL")) S %ZISLOCK=$NA(^%ZIS("lock",IO))
;
I 'POP G TRM:(%ZTYPE["TRM"),@(%ZTYPE_"^%ZIS6") ;Jump to next part
;
Q ;%ZIS6 Returns here
;See if need to un-lock.
I $D(%ZISUOUT) K %ZISUOUT,%ZISHP,%ZISHPOP Q
I POP S:%ZIS'["T" IO=""
Q ;Return to %ZIS1
;
VTRM ;Virtual terminal type
TRM ;Terminal type
D MARGN:'POP,SETPAR:'POP ;Terminal type
I 'POP,%ZIS'["T",%ZISB=1,'$D(IOP),IO'=IO(0),'$D(IO("Q")),%ZIS["Q" D AQUE
D W("")
I '$D(IO("Q")),'POP,%ZISB,%ZIS'["T" D O^%ZIS4
G Q
DEVOK N X,Y,X1 ;Not sure this is needed
S X=IO,X1=%ZTYPE
D DEVOK^%ZOSV I Y=-99!(Y=0)!(Y=$J) Q
I Y>0 S POP=1 D:(%ZIS["D") W($C(7)_"[Device Unavailable]") Q
I Y=-1 S IO="",POP=1 D:(%ZIS["D") W($C(7)_"[Device does not Exist or Unavailable]") Q
Q
;
MARGN ;Get the margin and page length
S %A=$P(%Y,";",1)
I %A?1A.ANP D SUBIEN(.%A,1) I $D(^%ZIS(2,%A,1)) K %Z91 D ST(1) S %Y=$P(%Y,";",2,9),%ZISMY=$P(%ZISMY,";",2,9) G MARGN
I %A>3 S $P(%Z91,"^")=$S(%A>255:255,1:+%A)
I $P(%Y,";",2) S $P(%Z91,"^",3)=+$S($P(%Y,";",2)>65534:65534,1:$P(%Y,";",2)) ;Cache fix for $Y#65535 wrap
;
ALTP I '$D(IO("P")) Q:%A>3 G ASKMAR:%ZTYPE["TRM" Q
S %X=$F(IO("P"),"M") I %X S %A=+$E(IO("P"),%X,99),$P(%Z91,"^")=$S(%A>255:255,1:%A)
S %X=$F(IO("P"),"L") I %X S $P(%Z91,"^",3)=+$E(IO("P"),%X,99)
Q:%A>3!(%ZTYPE'["TRM")
ASKMAR I %ZIS["M",'$D(IOP),$S(%E=%H:+$P(%Z,"^",3),1:1),$P(%Z,"^",4) W " Right Margin: " W:$P(%Z91,"^")]"" +%Z91,"// "
E Q
D SBR^%ZIS1 I '$D(DTOUT)&'$D(DUOUT) S:%X=""&($P(%Z91,"^")]"") %X=+%Z91 G ASKMAR:%X'?1.N S $P(%Z91,"^")=$S(%X>255:255,1:%X) Q
S POP=1 I %ZISB&(%ZTYPE["TRM") D C Q
Q
;
W(%) ;Write text
Q:$D(IOP)
W !,%
Q
;
C ;Close open device
I IO'=$G(IO(0)),$D(IO(1,IO)) C IO K IO(1,IO)
Q
;
SETPAR S:$L(%ZISOPAR)&($E(%ZISOPAR)'="(") %ZISOPAR="("_%ZISOPAR_")"
Q
;
AQUE ;Ask about Queueing
W ! S %=$S($D(IO("Q")):1,1:2)
I $D(IO("Q")) W !,"Previously, you have selected queueing."
W !,"Do you "_$S($D(IO("Q")):"STILL ",1:"")_"want your output QUEUED"
D YN^%ZIS1 G AQUE:%=0 Q:$D(IO("Q"))
I %=-1 S POP=1,%ZISHPOP=1,%ZISUOUT=1 D C Q
I %=1 S IO("Q")=1 D C Q
Q
;
ST(%ZISTP) ;
S %ZISIOST(0)=%A,%ZISIOST=$P($G(^%ZIS(2,%A,0)),"^")
S:'$D(%Z91) %Z91=$P($G(^%ZIS(2,%A,1),"132^#^60^$C(8)"),"^",1,4),$P(%Z91,"^",5)=$G(^("XY"))
Q:%ZISTP
STP N %B ;%E is a pointer to the Device file
S %B=$G(^%ZIS(1,%E,91))
S:$P(%B,"^")]"" $P(%Z91,"^")=+%B S:$P(%B,"^",3)]"" $P(%Z91,"^",3)=$P(%B,"^",3) ;S $P(%Z91,"^",5)=$G(^%ZIS(2,%ZISIOST(0),"XY"))
Q
SUBIEN(%1,%) ;Return Subtype ien. %1 is call by Ref.
N %XX,%YY
I $D(^%ZIS(2,"B",%1))>9 S %1=+$O(^%ZIS(2,"B",%1,0)) Q
I '$G(%) S X="" Q
S %XX=%1 D 2^%ZIS5 S %1=+%YY
Q
SUBTYPE(%A) ;Called from %ZISH
N %ZISIOST,%Z91
S:$G(%A)="" %A="P-OTHER"
D SUBIEN(.%A),ST(1)
S IOM=$P(%Z91,U,1),IOF=$P(%Z91,U,2),IOSL=$P(%Z91,U,3),IOST=%ZISIOST,IOST(0)=%ZISIOST(0),IOBS="$C(8)"
S:IOST="" IOST="P-OTHER",IOST(0)=0
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HZIS3 3356 printed Oct 16, 2024@18:15:11 Page 2
%ZIS3 ;SFISC/AC,RWF -- DEVICE HANDLER(DEVICE TYPES & PARAMETERS) ;06/09/10 17:47
+1 ;;8.0;KERNEL;**18,36,69,104,391,440,499,546**;JUL 10, 1995;Build 9
+2 ;Per VHA Directive 2004-038, this routine should not be modified
+3 ;Call with a Go from ^%ZIS2
+4 ;Pre-Open
IF %ZIS'["T"
IF $GET(^%ZIS(1,+%E,"POX"))]""
DO XPOX^ZISX(%E)
+5 IF $DATA(%ZISQUIT)
SET POP=1
KILL %ZISQUIT
+6 SET %ZISCHK=1
+7 ;See if need to lock.
+8 KILL %ZISLOCK
+9 IF %ZIS'["T"
IF +$GET(^%ZIS(1,+%E,"GBL"))
SET %ZISLOCK=$NAME(^%ZIS("lock",IO))
+10 ;
+11 ;Jump to next part
IF 'POP
if (%ZTYPE["TRM")
GOTO TRM
GOTO @(%ZTYPE_"^%ZIS6")
+12 ;
Q ;%ZIS6 Returns here
+1 ;See if need to un-lock.
+2 IF $DATA(%ZISUOUT)
KILL %ZISUOUT,%ZISHP,%ZISHPOP
QUIT
+3 IF POP
if %ZIS'["T"
SET IO=""
+4 ;Return to %ZIS1
QUIT
+5 ;
VTRM ;Virtual terminal type
TRM ;Terminal type
+1 ;Terminal type
if 'POP
DO MARGN
if 'POP
DO SETPAR
+2 IF 'POP
IF %ZIS'["T"
IF %ZISB=1
IF '$DATA(IOP)
IF IO'=IO(0)
IF '$DATA(IO("Q"))
IF %ZIS["Q"
DO AQUE
+3 DO W("")
+4 IF '$DATA(IO("Q"))
IF 'POP
IF %ZISB
IF %ZIS'["T"
DO O^%ZIS4
+5 GOTO Q
DEVOK ;Not sure this is needed
NEW X,Y,X1
+1 SET X=IO
SET X1=%ZTYPE
+2 DO DEVOK^%ZOSV
IF Y=-99!(Y=0)!(Y=$JOB)
QUIT
+3 IF Y>0
SET POP=1
if (%ZIS["D")
DO W($CHAR(7)_"[Device Unavailable]")
QUIT
+4 IF Y=-1
SET IO=""
SET POP=1
if (%ZIS["D")
DO W($CHAR(7)_"[Device does not Exist or Unavailable]")
QUIT
+5 QUIT
+6 ;
MARGN ;Get the margin and page length
+1 SET %A=$PIECE(%Y,";",1)
+2 IF %A?1A.ANP
DO SUBIEN(.%A,1)
IF $DATA(^%ZIS(2,%A,1))
KILL %Z91
DO ST(1)
SET %Y=$PIECE(%Y,";",2,9)
SET %ZISMY=$PIECE(%ZISMY,";",2,9)
GOTO MARGN
+3 IF %A>3
SET $PIECE(%Z91,"^")=$SELECT(%A>255:255,1:+%A)
+4 ;Cache fix for $Y#65535 wrap
IF $PIECE(%Y,";",2)
SET $PIECE(%Z91,"^",3)=+$SELECT($PIECE(%Y,";",2)>65534:65534,1:$PIECE(%Y,";",2))
+5 ;
ALTP IF '$DATA(IO("P"))
if %A>3
QUIT
if %ZTYPE["TRM"
GOTO ASKMAR
QUIT
+1 SET %X=$FIND(IO("P"),"M")
IF %X
SET %A=+$EXTRACT(IO("P"),%X,99)
SET $PIECE(%Z91,"^")=$SELECT(%A>255:255,1:%A)
+2 SET %X=$FIND(IO("P"),"L")
IF %X
SET $PIECE(%Z91,"^",3)=+$EXTRACT(IO("P"),%X,99)
+3 if %A>3!(%ZTYPE'["TRM")
QUIT
ASKMAR IF %ZIS["M"
IF '$DATA(IOP)
IF $SELECT(%E=%H:+$PIECE(%Z,"^",3),1:1)
IF $PIECE(%Z,"^",4)
WRITE " Right Margin: "
if $PIECE(%Z91,"^")]""
WRITE +%Z91,"// "
+1 IF '$TEST
QUIT
+2 DO SBR^%ZIS1
IF '$DATA(DTOUT)&'$DATA(DUOUT)
if %X=""&($PIECE(%Z91,"^")]"")
SET %X=+%Z91
if %X'?1.N
GOTO ASKMAR
SET $PIECE(%Z91,"^")=$SELECT(%X>255:255,1:%X)
QUIT
+3 SET POP=1
IF %ZISB&(%ZTYPE["TRM")
DO C
QUIT
+4 QUIT
+5 ;
W(%) ;Write text
+1 if $DATA(IOP)
QUIT
+2 WRITE !,%
+3 QUIT
+4 ;
C ;Close open device
+1 IF IO'=$GET(IO(0))
IF $DATA(IO(1,IO))
CLOSE IO
KILL IO(1,IO)
+2 QUIT
+3 ;
SETPAR if $LENGTH(%ZISOPAR)&($EXTRACT(%ZISOPAR)'="(")
SET %ZISOPAR="("_%ZISOPAR_")"
+1 QUIT
+2 ;
AQUE ;Ask about Queueing
+1 WRITE !
SET %=$SELECT($DATA(IO("Q")):1,1:2)
+2 IF $DATA(IO("Q"))
WRITE !,"Previously, you have selected queueing."
+3 WRITE !,"Do you "_$SELECT($DATA(IO("Q")):"STILL ",1:"")_"want your output QUEUED"
+4 DO YN^%ZIS1
if %=0
GOTO AQUE
if $DATA(IO("Q"))
QUIT
+5 IF %=-1
SET POP=1
SET %ZISHPOP=1
SET %ZISUOUT=1
DO C
QUIT
+6 IF %=1
SET IO("Q")=1
DO C
QUIT
+7 QUIT
+8 ;
ST(%ZISTP) ;
+1 SET %ZISIOST(0)=%A
SET %ZISIOST=$PIECE($GET(^%ZIS(2,%A,0)),"^")
+2 if '$DATA(%Z91)
SET %Z91=$PIECE($GET(^%ZIS(2,%A,1),"132^#^60^$C(8)"),"^",1,4)
SET $PIECE(%Z91,"^",5)=$GET(^("XY"))
+3 if %ZISTP
QUIT
STP ;%E is a pointer to the Device file
NEW %B
+1 SET %B=$GET(^%ZIS(1,%E,91))
+2 ;S $P(%Z91,"^",5)=$G(^%ZIS(2,%ZISIOST(0),"XY"))
if $PIECE(%B,"^")]""
SET $PIECE(%Z91,"^")=+%B
if $PIECE(%B,"^",3)]""
SET $PIECE(%Z91,"^",3)=$PIECE(%B,"^",3)
+3 QUIT
SUBIEN(%1,%) ;Return Subtype ien. %1 is call by Ref.
+1 NEW %XX,%YY
+2 IF $DATA(^%ZIS(2,"B",%1))>9
SET %1=+$ORDER(^%ZIS(2,"B",%1,0))
QUIT
+3 IF '$GET(%)
SET X=""
QUIT
+4 SET %XX=%1
DO 2^%ZIS5
SET %1=+%YY
+5 QUIT
SUBTYPE(%A) ;Called from %ZISH
+1 NEW %ZISIOST,%Z91
+2 if $GET(%A)=""
SET %A="P-OTHER"
+3 DO SUBIEN(.%A)
DO ST(1)
+4 SET IOM=$PIECE(%Z91,U,1)
SET IOF=$PIECE(%Z91,U,2)
SET IOSL=$PIECE(%Z91,U,3)
SET IOST=%ZISIOST
SET IOST(0)=%ZISIOST(0)
SET IOBS="$C(8)"
+5 if IOST=""
SET IOST="P-OTHER"
SET IOST(0)=0
+6 QUIT
