| 1 | %ZIS2 ;SFISC/AC,RWF -- DEVICE HANDLER (CHECKS) ;06/12/2002 15:41
|
|---|
| 2 | ;;8.0;KERNEL;**69,104,112,118,136,241**;JUL 10, 1995
|
|---|
| 3 | HUNT S:'$D(%ZISHP) %ZISHP=%E,%ZISHGL=0 S %E=0
|
|---|
| 4 | F S %ZISHGL=$O(^%ZIS(1,%ZISHG(0),"HG",%ZISHGL)) Q:%ZISHGL'>0 D Q:%E
|
|---|
| 5 | . N %1,%2 S %1=$G(^%ZIS(1,%ZISHG(0),"HG",+%ZISHGL,0)),%2=$G(^%ZIS(1,+%1,0))
|
|---|
| 6 | . ;Check that HG device is on same VOL.
|
|---|
| 7 | . I $P(%2,"^",9)=%ZISV!($P(%2,"^",9)="") S %E=+$P(^%ZIS(1,%ZISHG(0),"HG",+%ZISHGL,0),"^")
|
|---|
| 8 | . Q
|
|---|
| 9 | G L2:%ZISHGL>0 S %ZISHPOP=1,%E=%ZISHP
|
|---|
| 10 | ;
|
|---|
| 11 | L2 ;Entry point from %ZIS1
|
|---|
| 12 | I $D(DTOUT)!$D(DUOUT) K %ZISHP,%ZISHPOP Q
|
|---|
| 13 | CHECK K %ZISCPU S POP=0,%Z=^%ZIS(1,%E,0),IO=$P(%Z,"^",2)
|
|---|
| 14 | S:%IS["Q"&'$D(ZTQUEUED)&($P(%Z,"^",12)=1!$D(XQNOGO)) %ZISB=0,IO("Q")=1 ;Forced Queueing
|
|---|
| 15 | I $P(%Z,"^",12)=2 S %IS=$TR(%IS,"Q") I $D(IO("Q")) D Q
|
|---|
| 16 | . I '$D(IOP) W !,"Queuing NOT ALLOWED on this device"
|
|---|
| 17 | . S POP=1 K:$D(IOP) IO("Q") Q
|
|---|
| 18 | S %Z90=$G(^(90)),%Z95=$G(^(95)),%ZTIME=$G(^("TIME")),%ZTYPE=$G(^("TYPE")),%ZISHG=$O(^%ZIS(1,"AHG",%E,0))
|
|---|
| 19 | I %ZISHG,$D(^%ZIS(1,+%ZISHG,0)) S:'$D(%ZISHG(0)) %ZISHG(0)=+%ZISHG S %ZISHG=$P(^(0),"^",1)
|
|---|
| 20 | E S %ZISHG=""
|
|---|
| 21 | I %ZTYPE="HG" D OTHCPU("HUNT GROUP") G T:$D(%ZISHG(0))!POP
|
|---|
| 22 | I %ZTYPE="RES" S %ZISRL=+$P(%Z1,"^",10) G T
|
|---|
| 23 | 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
|
|---|
| 24 | S:%ZTYPE="VTRM"&'$D(IO("Q"))&(%A=%H) IO=$I
|
|---|
| 25 | ;
|
|---|
| 26 | 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
|
|---|
| 27 | OCPU D OTHCPU("DEVICE")
|
|---|
| 28 | ;
|
|---|
| 29 | OOS G T:POP I %Z90,$D(DT)#2,%Z90'>DT S POP=1 ;Out Of Service Check
|
|---|
| 30 | I $T,'$D(IOP),'$D(%ZISHP) W *7," [Out of Service]" ;I 'POP W " ..OK" S %=2,U="^" D YN^%ZIS1 G:%=0 OOS S:%'=1 POP=1
|
|---|
| 31 | ;
|
|---|
| 32 | PTIME G T:POP!(IO=$I)!(IO=0)
|
|---|
| 33 | ;Prohibitted Time Check
|
|---|
| 34 | S %A=$P(%ZTIME,"^") I %ZISB,$L(%A) D I POP,'$D(IOP),'$D(%ZISHP) W *7," [ACCESS PROHIBITED "_%A_"]" ;AT THIS TIME]"
|
|---|
| 35 | . N %C,%L,%H ;%C is current time, %L is lower limit, %H is upper limit
|
|---|
| 36 | . S %C=$P($H,",",2),%C=%C\60#60+(%C\3600*100),%H=$P(%A,"-",2),%L=+%A
|
|---|
| 37 | . I $S(%H'<%L:(%C'>%H&(%C'<%L)),1:(%C'<%L!(%C'>%H))) S POP=1
|
|---|
| 38 | . Q
|
|---|
| 39 | DUZ I 'POP D SEC ;Security Check
|
|---|
| 40 | ;
|
|---|
| 41 | T I POP,$D(%ZISHG(0)),%IS'["D",'$D(%ZISHPOP),%ZISB G HUNT
|
|---|
| 42 | I POP D HGBSY:$D(%ZISHPOP) ;G T2:%IS["T"
|
|---|
| 43 | ;
|
|---|
| 44 | TMPVAR K IO("S") S %ZISIOS=%E S:IO=0 IO=$I,IO("S")=%H
|
|---|
| 45 | S %ZISOPAR=$$IOPAR(%E,"IOPAR")
|
|---|
| 46 | S %ZISUPAR=$$IOPAR(%E,"IOUPAR"),%ZISTO=+$P(%ZTIME,"^",2)
|
|---|
| 47 | I $D(IO("S")) D I POP Q
|
|---|
| 48 | . S IO=$S(%IS["S":$P($G(^%ZIS(1,+$P(%Z,"^",8),0)),"^",2),1:IO)
|
|---|
| 49 | . I %IS["S",IO]"" S %H=+$P(%Z,"^",8),IO("S")=%H,IO(0)=IO
|
|---|
| 50 | . S IO("S")=$S($G(^XUTL("XQ",$J,"IOST(0)")):^("IOST(0)"),1:$G(^%ZIS(1,%H,"SUBTYPE")))
|
|---|
| 51 | . S:IO="" POP=1
|
|---|
| 52 | . Q
|
|---|
| 53 | S %A=+$G(^%ZIS(1,%E,"SUBTYPE")),%ZISTP=0 ;%A is pointer to subtype
|
|---|
| 54 | I %E=%H,%ZTYPE["TRM" D I 1
|
|---|
| 55 | . I $D(^XUTL("XQ",$J,"IOST(0)")) D ;Use home
|
|---|
| 56 | . . S %A=+^XUTL("XQ",$J,"IOST(0)"),%Z91="",%ZISTP=1
|
|---|
| 57 | . . F %ZISI="IOM","IOF","IOSL","IOBS","IOXY" S %Z91=%Z91_$G(^XUTL("XQ",$J,%ZISI))_"^"
|
|---|
| 58 | . E S %=$$LNPRTSUB^%ZISUTL I %>0 S %A=%,%Z91=""
|
|---|
| 59 | E S %Z91=$P($G(^%ZIS(2,%A,1)),"^",1,4),$P(%Z91,"^",5)=$G(^("XY"))
|
|---|
| 60 | ;I $D(%Z91),%Z91'?1.4"^" ;$P(%Z91,"^")]"",$P(%Z91,"^",2)]"",$P(%Z91,"^",3),$P(%Z91,"^",4)]""
|
|---|
| 61 | D ST^%ZIS3(%ZISTP) S:%IS["U" USIO=$P(%Z91,"^",1,4)
|
|---|
| 62 | T2 I POP S:%IS'["T" IO="" Q
|
|---|
| 63 | G ^%ZIS3:"^MTRM^VTRM^TRM^SPL^MT^SDP^HFS^RES^OTH^BAR^HG^IMPC^CHAN^"[("^"_%ZTYPE_"^") ;Jump to next part
|
|---|
| 64 | S POP=1 Q
|
|---|
| 65 | ;
|
|---|
| 66 | HGBSY S POP=1 S:%IS'["T" IO="" K %ZISHP,%ZISHPOP Q:$D(IOP)
|
|---|
| 67 | W:$X>38 !,?5 W *7," All devices in hunt group "_%ZISHG_" are busy!" Q
|
|---|
| 68 | ;
|
|---|
| 69 | OTHCPU(%1) ;%1 should be either DEVICE or HUNT GROUP
|
|---|
| 70 | N %2,X,Y,%ZISMSG S %ZISMSG=0
|
|---|
| 71 | F %2="CPU","VOLUME SET" D
|
|---|
| 72 | .I %2="VOLUME SET" S X=$P($P(%Z,"^",9),":"),Y=%ZISV
|
|---|
| 73 | .E D GETENV^%ZOSV S X=$P($P(%Z,"^",9),":",2),Y=$P($P(Y,"^",4),":",2)
|
|---|
| 74 | .I X=Y!(X="") Q:%1="DEVICE" D Q ;Other Vol Set/Cpu Check
|
|---|
| 75 | ..S %ZISHG(0)=%E,%ZISHG=$P(%Z,"^")
|
|---|
| 76 | ..I %ZISB S POP=1
|
|---|
| 77 | ..E S IO=" "
|
|---|
| 78 | .I %2="VOLUME SET" S $P(%ZISCPU,":")=X
|
|---|
| 79 | .E S $P(%ZISCPU,":",2)=X
|
|---|
| 80 | .I %1="HUNT GROUP" K %ZISHG(0)
|
|---|
| 81 | .I %IS["Q" S IO("Q")=1,%ZISB=0 S:%1="HUNT GROUP" IO=" "
|
|---|
| 82 | .E I %ZISB&(%ZTYPE="TRM"&($D(%ZISHG(0))&(%IS'["D"))) S POP=1
|
|---|
| 83 | .E W:'$D(IOP)&'%ZISMSG *7," ["_%1_" is on another "_%2_" ('"_X_"')]",! S POP=1,%ZISMSG=1
|
|---|
| 84 | Q
|
|---|
| 85 | IOPAR(%DA,%N) ;Return I/O parameters
|
|---|
| 86 | Q $S($G(%ZIS(%N))]"":%ZIS(%N),1:$G(^%ZIS(1,%DA,%N)))
|
|---|
| 87 | ;
|
|---|
| 88 | SEC 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
|
|---|
| 89 | I POP,'$D(IOP),'$D(%ZISHP) W *7," [Access Prohibited]"
|
|---|
| 90 | Q
|
|---|
