%ZIS2 ;SFISC/AC,RWF -- DEVICE HANDLER (CHECKS) ;11/08/2011
;;8.0;KERNEL;**69,104,112,118,136,241,440,546,585**;JUL 10, 1995;Build 22
;Per VHA Directive 2004-038, this routine should not be modified
;
L2 ;Entry point from %ZIS1, %E holds the IEN value
I $D(DTOUT)!$D(DUOUT) K %ZISHP,%ZISHPOP Q
CHECK ;Get IO check for secondary $I
K %ZISCPU N %Z2,%ZFQ
S POP=0,%Z=^%ZIS(1,%E,0),%Z2=$S(%ZIS("PRI")=1:"",1:$G(^%ZIS(1,%E,2))) ;Get Primary and secondary IO.
S IO=$S(%ZIS("PRI")=1:$P(%Z,"^",2),$L($P(%Z2,"^")):$P(%Z2,"^"),1:$P(%Z,"^",2)) ;
S %Z90=$G(^(90)),%Z95=$G(^(95)),%ZTIME=$G(^("TIME")),%ZTYPE=$G(^("TYPE"))
I '$$QUECHK Q
I %ZTYPE="RES" S %ZISRL=+$P(%Z1,"^",10) G T
VTRM I %ZTYPE="VTRM",'('$D(IO("Q"))&(%A=%H)) W:'$D(IOP)&'$D(%ZISHP) *7," [YOU CAN NOT SELECT A VIRTUAL TERMINAL]" S POP=1 ;Virtual Terminal Check
S:%ZTYPE="VTRM"&'$D(IO("Q"))&(%A=%H) IO=$I
;
SLAVE I $D(IO("Q")),$P(%Z,"^",2)=0,$P(%Z,"^",8)']"" W:'$D(IOP) *7,!?10," [SLAVE device NOT set up for queuing]" S POP=1 G T
;
;
;**P585 START CJM
PQ ;Check (if not queueing to secondary system) that print queue is established and available
I %ZTYPE="PQ",%ZISB!'$P($G(^XTV(8989.3,1,0)),"^",5),(%ZIS'["T"),'$$QEXIST^ZISPQ(%E) D G T
.S POP=1
.W:'$D(IOP) *7,!?10," [The Print Queue does not exist]"
;**P585 END CJM
;
OCPU D OTHCPU("DEVICE")
;
OOS G T:POP
;Out Of Service Check
I %Z90,$D(DT)#2,%Z90'>DT S POP=1 I '$D(IOP),'$D(%ZISHP) W *7," [Out of Service]"
;
PTIME G T:POP!(IO=$I)!(IO=0)
;Prohibitted Time Check
S %A=$P(%ZTIME,"^") I %ZISB,$L(%A) D I POP,'$D(IOP),'$D(%ZISHP) W *7," [ACCESS PROHIBITED "_%A_"]" ;AT THIS TIME]"
. N %C,%L,%H ;%C is current time, %L is lower limit, %H is upper limit
. S %C=$P($H,",",2),%C=%C\60#60+(%C\3600*100),%H=$P(%A,"-",2),%L=+%A
. I $S(%H'<%L:(%C'>%H&(%C'<%L)),1:(%C'<%L!(%C'>%H))) S POP=1
. Q
DUZ I 'POP D SEC ;Security Check
;
T ;
;
TMPVAR K IO("S") S %ZISIOS=%E S:IO=0 IO=$I,IO("S")=%H
S %ZISOPAR=$$IOPAR(%E,"IOPAR")
S %ZISUPAR=$$IOPAR(%E,"IOUPAR"),%ZISTO=+$P(%ZTIME,"^",2)
;Slave Device
I $D(IO("S")) D I POP Q
. S IO=$S(%ZIS["S":$P($G(^%ZIS(1,+$P(%Z,"^",8),0)),"^",2),1:IO)
. I %ZIS["S",IO]"" S %H=+$P(%Z,"^",8),IO("S")=%H,IO(0)=IO
. S IO("S")=$S($G(^XUTL("XQ",$J,"IOST(0)")):^("IOST(0)"),1:$G(^%ZIS(1,%H,"SUBTYPE")))
. S:IO="" POP=1
. Q
S %A=+$G(^%ZIS(1,%E,"SUBTYPE")),%ZISTP=0 ;%A is pointer to subtype
I %E=%H,%ZTYPE["TRM" D I 1
. I $D(^XUTL("XQ",$J,"IOST(0)")) D ;Use home
. . S %A=+^XUTL("XQ",$J,"IOST(0)"),%Z91="",%ZISTP=1
. . F %ZISI="IOM","IOF","IOSL","IOBS","IOXY" S %Z91=%Z91_$G(^XUTL("XQ",$J,%ZISI))_"^"
. E S %=$$LNPRTSUB^%ZISUTL I %>0 S %A=%,%Z91=""
E S %Z91=$P($G(^%ZIS(2,%A,1)),"^",1,4),$P(%Z91,"^",5)=$G(^("XY"))
;
D ST^%ZIS3(%ZISTP) S:%ZIS["U" USIO=$P(%Z91,"^",1,4)
T2 I POP S:%ZIS'["T" IO="" Q
;Removed HG from next line.
;**P585 START CJM
;G ^%ZIS3:"^MTRM^VTRM^TRM^SPL^MT^SDP^HFS^RES^OTH^BAR^IMPC^CHAN^"[("^"_%ZTYPE_"^") ;Jump to next part
G ^%ZIS3:"^MTRM^VTRM^TRM^SPL^MT^SDP^HFS^RES^OTH^BAR^IMPC^CHAN^PQ^"[("^"_%ZTYPE_"^") ;Jump to next part
;**P585 END CJM
S POP=1 Q
;
QUECHK() ;Return 1 if OK
S %ZFQ=$P(%Z,"^",12) ;5.5 =QUEUING 0:ALLOWED;1:FORCED;2:NOT ALLOWED;
;Forced Queuing, Don't check if %ZIS["N"
S:%ZIS["Q"&'$D(ZTQUEUED)&(%ZFQ=1!$D(XQNOGO)) %ZISB=0,IO("Q")=1
I %ZFQ=1,(%ZIS'["Q")&(%ZIS'["N"),'$D(ZTQUEUED) D Q 0
. W:'$D(IOP) !,"Sorry, QUEUING is required for this device."
. S POP=1
. Q
;Or Queuing NOT allowed
I %ZFQ=2 S %ZIS=$TR(%ZIS,"Q") I $D(IO("Q")) D Q 0
. W:'$D(IOP) !,"Queuing NOT ALLOWED on this device"
. S POP=1 K:$D(IOP) IO("Q")
. Q
Q 1
;
OTHCPU(%1) ;%1 should be either DEVICE or HUNT GROUP
N %2,X,Y,%ZISMSG S %ZISMSG=0
F %2="CPU","VOLUME SET" D
.I %2="VOLUME SET" S X=$P($P(%Z,"^",9),":"),Y=%ZISV
.E D GETENV^%ZOSV S X=$P($P(%Z,"^",9),":",2),Y=$P($P(Y,"^",4),":",2)
.I X=Y!(X="") Q:%1="DEVICE" D Q ;Other Vol Set/Cpu Check
..S %ZISHG(0)=%E,%ZISHG=$P(%Z,"^")
..I %ZISB S POP=1
..E S IO=" "
.I %2="VOLUME SET" S $P(%ZISCPU,":")=X
.E S $P(%ZISCPU,":",2)=X
.I %1="HUNT GROUP" K %ZISHG(0)
.I %ZIS["Q" S IO("Q")=1,%ZISB=0 S:%1="HUNT GROUP" IO=" "
.E I %ZISB&(%ZTYPE="TRM"&($D(%ZISHG(0))&(%ZIS'["D"))) S POP=1
.E W:'$D(IOP)&'%ZISMSG *7," ["_%1_" is on another "_%2_" ('"_X_"')]",! S POP=1,%ZISMSG=1
Q
IOPAR(%DA,%N) ;Return I/O parameter
Q $S($L($G(%ZIS(%N))):%ZIS(%N),1:$G(^%ZIS(1,%DA,%N)))
;
SEC ;Do Security check
I %Z95]"" S %X=$G(DUZ(0)) I %X'="@" S POP=1 F %A=1:1:$L(%X) I %Z95[$E(%X,%A) S POP=0 Q
I POP,'$D(IOP),'$D(%ZISHP) W *7," [Access Prohibited]"
Q
;
;
;
;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HZIS2 4635 printed Apr 09, 2024@21:14:10 Page 2
%ZIS2 ;SFISC/AC,RWF -- DEVICE HANDLER (CHECKS) ;11/08/2011
+1 ;;8.0;KERNEL;**69,104,112,118,136,241,440,546,585**;JUL 10, 1995;Build 22
+2 ;Per VHA Directive 2004-038, this routine should not be modified
+3 ;
L2 ;Entry point from %ZIS1, %E holds the IEN value
+1 IF $DATA(DTOUT)!$DATA(DUOUT)
KILL %ZISHP,%ZISHPOP
QUIT
CHECK ;Get IO check for secondary $I
+1 KILL %ZISCPU
NEW %Z2,%ZFQ
+2 ;Get Primary and secondary IO.
SET POP=0
SET %Z=^%ZIS(1,%E,0)
SET %Z2=$SELECT(%ZIS("PRI")=1:"",1:$GET(^%ZIS(1,%E,2)))
+3 ;
SET IO=$SELECT(%ZIS("PRI")=1:$PIECE(%Z,"^",2),$LENGTH($PIECE(%Z2,"^")):$PIECE(%Z2,"^"),1:$PIECE(%Z,"^",2))
+4 SET %Z90=$GET(^(90))
SET %Z95=$GET(^(95))
SET %ZTIME=$GET(^("TIME"))
SET %ZTYPE=$GET(^("TYPE"))
+5 IF '$$QUECHK
QUIT
+6 IF %ZTYPE="RES"
SET %ZISRL=+$PIECE(%Z1,"^",10)
GOTO T
VTRM ;Virtual Terminal Check
IF %ZTYPE="VTRM"
IF '('$DATA(IO("Q"))&(%A=%H))
if '$DATA(IOP)&'$DATA(%ZISHP)
WRITE *7," [YOU CAN NOT SELECT A VIRTUAL TERMINAL]"
SET POP=1
+1 if %ZTYPE="VTRM"&'$DATA(IO("Q"))&(%A=%H)
SET IO=$IO
+2 ;
SLAVE IF $DATA(IO("Q"))
IF $PIECE(%Z,"^",2)=0
IF $PIECE(%Z,"^",8)']""
if '$DATA(IOP)
WRITE *7,!?10," [SLAVE device NOT set up for queuing]"
SET POP=1
GOTO T
+1 ;
+2 ;
+3 ;**P585 START CJM
PQ ;Check (if not queueing to secondary system) that print queue is established and available
+1 IF %ZTYPE="PQ"
IF %ZISB!'$PIECE($GET(^XTV(8989.3,1,0)),"^",5)
IF (%ZIS'["T")
IF '$$QEXIST^ZISPQ(%E)
Begin DoDot:1
+2 SET POP=1
+3 if '$DATA(IOP)
WRITE *7,!?10," [The Print Queue does not exist]"
End DoDot:1
GOTO T
+4 ;**P585 END CJM
+5 ;
OCPU DO OTHCPU("DEVICE")
+1 ;
OOS if POP
GOTO T
+1 ;Out Of Service Check
+2 IF %Z90
IF $DATA(DT)#2
IF %Z90'>DT
SET POP=1
IF '$DATA(IOP)
IF '$DATA(%ZISHP)
WRITE *7," [Out of Service]"
+3 ;
PTIME if POP!(IO=$IO)!(IO=0)
GOTO T
+1 ;Prohibitted Time Check
+2 ;AT THIS TIME]"
SET %A=$PIECE(%ZTIME,"^")
IF %ZISB
IF $LENGTH(%A)
Begin DoDot:1
+3 ;%C is current time, %L is lower limit, %H is upper limit
NEW %C,%L,%H
+4 SET %C=$PIECE($HOROLOG,",",2)
SET %C=%C\60#60+(%C\3600*100)
SET %H=$PIECE(%A,"-",2)
SET %L=+%A
+5 IF $SELECT(%H'<%L:(%C'>%H&(%C'<%L)),1:(%C'<%L!(%C'>%H)))
SET POP=1
+6 QUIT
End DoDot:1
IF POP
IF '$DATA(IOP)
IF '$DATA(%ZISHP)
WRITE *7," [ACCESS PROHIBITED "_%A_"]"
DUZ ;Security Check
IF 'POP
DO SEC
+1 ;
T ;
+1 ;
TMPVAR KILL IO("S")
SET %ZISIOS=%E
if IO=0
SET IO=$IO
SET IO("S")=%H
+1 SET %ZISOPAR=$$IOPAR(%E,"IOPAR")
+2 SET %ZISUPAR=$$IOPAR(%E,"IOUPAR")
SET %ZISTO=+$PIECE(%ZTIME,"^",2)
+3 ;Slave Device
+4 IF $DATA(IO("S"))
Begin DoDot:1
+5 SET IO=$SELECT(%ZIS["S":$PIECE($GET(^%ZIS(1,+$PIECE(%Z,"^",8),0)),"^",2),1:IO)
+6 IF %ZIS["S"
IF IO]""
SET %H=+$PIECE(%Z,"^",8)
SET IO("S")=%H
SET IO(0)=IO
+7 SET IO("S")=$SELECT($GET(^XUTL("XQ",$JOB,"IOST(0)")):^("IOST(0)"),1:$GET(^%ZIS(1,%H,"SUBTYPE")))
+8 if IO=""
SET POP=1
+9 QUIT
End DoDot:1
IF POP
QUIT
+10 ;%A is pointer to subtype
SET %A=+$GET(^%ZIS(1,%E,"SUBTYPE"))
SET %ZISTP=0
+11 IF %E=%H
IF %ZTYPE["TRM"
Begin DoDot:1
+12 ;Use home
IF $DATA(^XUTL("XQ",$JOB,"IOST(0)"))
Begin DoDot:2
+13 SET %A=+^XUTL("XQ",$JOB,"IOST(0)")
SET %Z91=""
SET %ZISTP=1
+14 FOR %ZISI="IOM","IOF","IOSL","IOBS","IOXY"
SET %Z91=%Z91_$GET(^XUTL("XQ",$JOB,%ZISI))_"^"
End DoDot:2
+15 IF '$TEST
SET %=$$LNPRTSUB^%ZISUTL
IF %>0
SET %A=%
SET %Z91=""
End DoDot:1
IF 1
+16 IF '$TEST
SET %Z91=$PIECE($GET(^%ZIS(2,%A,1)),"^",1,4)
SET $PIECE(%Z91,"^",5)=$GET(^("XY"))
+17 ;
+18 DO ST^%ZIS3(%ZISTP)
if %ZIS["U"
SET USIO=$PIECE(%Z91,"^",1,4)
T2 IF POP
if %ZIS'["T"
SET IO=""
QUIT
+1 ;Removed HG from next line.
+2 ;**P585 START CJM
+3 ;G ^%ZIS3:"^MTRM^VTRM^TRM^SPL^MT^SDP^HFS^RES^OTH^BAR^IMPC^CHAN^"[("^"_%ZTYPE_"^") ;Jump to next part
+4 ;Jump to next part
if "^MTRM^VTRM^TRM^SPL^MT^SDP^HFS^RES^OTH^BAR^IMPC^CHAN^PQ^"[("^"_%ZTYPE_"^")
GOTO ^%ZIS3
+5 ;**P585 END CJM
+6 SET POP=1
QUIT
+7 ;
QUECHK() ;Return 1 if OK
+1 ;5.5 =QUEUING 0:ALLOWED;1:FORCED;2:NOT ALLOWED;
SET %ZFQ=$PIECE(%Z,"^",12)
+2 ;Forced Queuing, Don't check if %ZIS["N"
+3 if %ZIS["Q"&'$DATA(ZTQUEUED)&(%ZFQ=1!$DATA(XQNOGO))
SET %ZISB=0
SET IO("Q")=1
+4 IF %ZFQ=1
IF (%ZIS'["Q")&(%ZIS'["N")
IF '$DATA(ZTQUEUED)
Begin DoDot:1
+5 if '$DATA(IOP)
WRITE !,"Sorry, QUEUING is required for this device."
+6 SET POP=1
+7 QUIT
End DoDot:1
QUIT 0
+8 ;Or Queuing NOT allowed
+9 IF %ZFQ=2
SET %ZIS=$TRANSLATE(%ZIS,"Q")
IF $DATA(IO("Q"))
Begin DoDot:1
+10 if '$DATA(IOP)
WRITE !,"Queuing NOT ALLOWED on this device"
+11 SET POP=1
if $DATA(IOP)
KILL IO("Q")
+12 QUIT
End DoDot:1
QUIT 0
+13 QUIT 1
+14 ;
OTHCPU(%1) ;%1 should be either DEVICE or HUNT GROUP
+1 NEW %2,X,Y,%ZISMSG
SET %ZISMSG=0
+2 FOR %2="CPU","VOLUME SET"
Begin DoDot:1
+3 IF %2="VOLUME SET"
SET X=$PIECE($PIECE(%Z,"^",9),":")
SET Y=%ZISV
+4 IF '$TEST
DO GETENV^%ZOSV
SET X=$PIECE($PIECE(%Z,"^",9),":",2)
SET Y=$PIECE($PIECE(Y,"^",4),":",2)
+5 ;Other Vol Set/Cpu Check
IF X=Y!(X="")
if %1="DEVICE"
QUIT
Begin DoDot:2
+6 SET %ZISHG(0)=%E
SET %ZISHG=$PIECE(%Z,"^")
+7 IF %ZISB
SET POP=1
+8 IF '$TEST
SET IO=" "
End DoDot:2
QUIT
+9 IF %2="VOLUME SET"
SET $PIECE(%ZISCPU,":")=X
+10 IF '$TEST
SET $PIECE(%ZISCPU,":",2)=X
+11 IF %1="HUNT GROUP"
KILL %ZISHG(0)
+12 IF %ZIS["Q"
SET IO("Q")=1
SET %ZISB=0
if %1="HUNT GROUP"
SET IO=" "
+13 IF '$TEST
IF %ZISB&(%ZTYPE="TRM"&($DATA(%ZISHG(0))&(%ZIS'["D")))
SET POP=1
+14 IF '$TEST
if '$DATA(IOP)&'%ZISMSG
WRITE *7," ["_%1_" is on another "_%2_" ('"_X_"')]",!
SET POP=1
SET %ZISMSG=1
End DoDot:1
+15 QUIT
IOPAR(%DA,%N) ;Return I/O parameter
+1 QUIT $SELECT($LENGTH($GET(%ZIS(%N))):%ZIS(%N),1:$GET(^%ZIS(1,%DA,%N)))
+2 ;
SEC ;Do Security check
+1 IF %Z95]""
SET %X=$GET(DUZ(0))
IF %X'="@"
SET POP=1
FOR %A=1:1:$LENGTH(%X)
IF %Z95[$EXTRACT(%X,%A)
SET POP=0
QUIT
+2 IF POP
IF '$DATA(IOP)
IF '$DATA(%ZISHP)
WRITE *7," [Access Prohibited]"
+3 QUIT
+4 ;
+5 ;
+6 ;
+7 ;
+8 ;
