ZIS2.m

%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 ---ZIS2   4635     printed  Mar 13, 2025@21:19:16                                                                                                                                                                                                        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       ;