%ZISUTL ;ISD/HGW - Device Handler Utility routine ; 8/19/20 10:51am
;;8.0;KERNEL;**18,24,34,69,118,127,199,275,425,599,736**;JUL 10, 1995;Build 12
;Per VHA Directive 2004-038, this routine should not be modified
; Unit test routine ^ZZUTZI00
Q ;No entry from top
GETDEV(X) ;Return IO variables
; ZEXCEPT: POP
I '$D(^TMP("XUDEVICE",$J,X)) S POP=1 Q
;Cleanup first
N % K IO("S")
D SYMBOL("K") ;Kill first
D SYMBOL(1,$NA(^TMP("XUDEVICE",$J,X)))
Q
SAVDEV(NM) ;Save IO variables
;NM=Handle name
N %,Y,R
I $G(IO)="" Q
S Y=$$FINDEV(NM) I 'Y S Y=$$NEXTDEV(NM)
S R=$NA(^TMP("XUDEVICE",$J,Y)) K @R ;Clear
S @R@(0)=NM
D SYMBOL(0,R)
Q
SYMBOL(MODE,ROOT) ;0=Save, 1=Restore, K=Kill IO variables
N %
;Handle IO as special case. Don't want to kill all of IO.
I MODE=0 S:$D(IO)#2 @ROOT@("IO")=IO
I MODE=1 S:$D(@ROOT@("IO")) IO=@ROOT@("IO")
F %="IO(""DOC"")","IO(""HFSIO"")","IO(""Q"")","IO(""S"")","IO(""SPOOL"")","IO(""ZIO"")","IOBS","IOCPU","IOF","IOHG","IOM","ION","IOPAR","IOUPAR","IOS","IOSL","IOST","IOST(0)","IOT","IOXY" D
. I MODE=0 S:$D(@%)#2 @ROOT@(%)=@% Q
. I MODE=1 S:$D(@ROOT@(%)) @%=@ROOT@(%) Q
. I MODE="K" K @%
. Q
Q
RMDEV(X) ;Remove saved IO variables.
N Y
S Y=$$FINDEV(X)
Q:'Y
K ^TMP("XUDEVICE",$J,"B",X),^TMP("XUDEVICE",$J,+Y)
Q
RMALLDEV() ;Remove saved IO variables for all devices saved in table.
K ^TMP("XUDEVICE",$J)
Q 1
FINDEV(NM) ;Find Device name and return IEN.
Q $O(^TMP("XUDEVICE",$J,"B",NM,0))
NEXTDEV(NM) ;Return next available device.
N Y
F Y=1:1 Q:'$D(^TMP("XUDEVICE",$J,Y))
S ^TMP("XUDEVICE",$J,"B",NM,Y)=""
Q Y
OPEN(HNDL,IOP,%ZIS) ;Open extrinsic function
;Parameters
;HNDL=Handle name
;IOP string--optional
;%ZIS string--optional
N %
I $G(IOP)="" K IOP ;Remove IOP if null.
D ^%ZIS,SAVDEV(HNDL):POP=0
Q
CLOSE(X1) ;Close extrinsic function
;X1=Handle
N %,Y
S Y=$$FINDEV(X1)
Q:'Y
D GETDEV(Y)
D ^%ZISC,RMDEV(X1)
Q
USE(X1) ;Restore IO* variables pertaining to the device.
;X1=Handle name
; ZEXCEPT: IOT
N %,Y
S Y=$$FINDEV^%ZISUTL(X1)
Q:'Y
D GETDEV^%ZISUTL(Y)
I $G(IOT)'="RES" U $S($D(IO(1,IO)):IO,1:IO(0))
K IO("CLOSE")
Q
LINEPORT() ;Return device name for line port.
N %
S %=$$LNPRTIEN^%ZISUTL($$LNPRTNAM^%ZISUTL)
Q +$P($G(^%ZIS(3.23,+%,0)),"^",3)
LNPRTSUB() ;Return line port subtype pointer.
N %
S %=$$LNPRTIEN^%ZISUTL($$LNPRTNAM^%ZISUTL)
Q +$P($G(^%ZIS(3.23,+%,0)),"^",4)
LNPRTNAM() ;Return Line port name
N Y,%
S Y="",%=$G(^%ZOSF("OS"))
I %["VAX DSM"!(%["OpenM-NT") D
.S Y=$ZIO
E I %["MSM" X "S Y=$ZDEV($I)"
Q Y
LNPRTIEN(X) ;Return internal entry number of Line/port
Q:X'?1AN.29ANP 0
Q $O(^%ZIS(3.23,"B",X,0))
LNPRTADR(X) ;Returns Line/Port name of a fixed device.
N %,Y
S Y=""
S %=$O(^%ZIS(1,"B",X,0))
S %=$O(^%ZIS(3.23,"C",+%,0))
I %,$G(^%ZIS(3.23,+%,0))]"" S Y=$P(^(0),"^")
Q Y
FIND(IOP) ;e.f. Get the IEN of a device
N %XX,%YY,%ZIS,%ZISV
S %ZISV=^%ZOSF("VOL"),%XX=$$UP^%ZIS1(IOP) D 1^%ZIS5
Q %YY
NOQ(IOP) ;e.f. Return queueing status
;Call with Device name, Return 1 if NO QUEUE, Else 0.
N %X,%Y S %X=$$FIND(IOP) Q:%X'>0 0
S %Y=$P($G(^%ZIS(1,%X,0)),U,12)
Q %Y=2
UNIQUE(ZISNA) ;Build a unique number to add to a device name
;If passed a name put the number before the last dot.
N %,%1,%2
S %2=$INCREMENT(^TMP("ZISUTL",$J)) ;Kernel exemption, allowed to use $INCREMENT
S %=$H,%=$H_"-"_$J,%=$$CRC32^XLFCRC(%)_"-"_%2
I '$L($G(ZISNA)) Q %
S %1=$L(ZISNA,"."),%="_"_%
S:%1=1 %=ZISNA_% S:%1>1 %=$P(ZISNA,".",1,%1-1)_%_"."_$P(ZISNA,".",%1)
Q %
ENDOFILE() ;p599 Set Cache end-of-file to work like DSM
;Return 1 if mode was changed, 0 if unchanged
N %
I ($$VERSION^%ZOSV(1)["Cache")!($$VERSION^%ZOSV(1)["IRIS") D Q 1
.I +$$VERSION^%ZOSV>2010 X "D $SYSTEM.Process.SetZEOF(1)"
.I +$$VERSION^%ZOSV'>2010 S %=$ZUTIL(68,40,1)
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HZISUTL 3875 printed Oct 16, 2024@18:16:05 Page 2
%ZISUTL ;ISD/HGW - Device Handler Utility routine ; 8/19/20 10:51am
+1 ;;8.0;KERNEL;**18,24,34,69,118,127,199,275,425,599,736**;JUL 10, 1995;Build 12
+2 ;Per VHA Directive 2004-038, this routine should not be modified
+3 ; Unit test routine ^ZZUTZI00
+4 ;No entry from top
QUIT
GETDEV(X) ;Return IO variables
+1 ; ZEXCEPT: POP
+2 IF '$DATA(^TMP("XUDEVICE",$JOB,X))
SET POP=1
QUIT
+3 ;Cleanup first
+4 NEW %
KILL IO("S")
+5 ;Kill first
DO SYMBOL("K")
+6 DO SYMBOL(1,$NAME(^TMP("XUDEVICE",$JOB,X)))
+7 QUIT
SAVDEV(NM) ;Save IO variables
+1 ;NM=Handle name
+2 NEW %,Y,R
+3 IF $GET(IO)=""
QUIT
+4 SET Y=$$FINDEV(NM)
IF 'Y
SET Y=$$NEXTDEV(NM)
+5 ;Clear
SET R=$NAME(^TMP("XUDEVICE",$JOB,Y))
KILL @R
+6 SET @R@(0)=NM
+7 DO SYMBOL(0,R)
+8 QUIT
SYMBOL(MODE,ROOT) ;0=Save, 1=Restore, K=Kill IO variables
+1 NEW %
+2 ;Handle IO as special case. Don't want to kill all of IO.
+3 IF MODE=0
if $DATA(IO)#2
SET @ROOT@("IO")=IO
+4 IF MODE=1
if $DATA(@ROOT@("IO"))
SET IO=@ROOT@("IO")
+5 FOR %="IO(""DOC"")","IO(""HFSIO"")","IO(""Q"")","IO(""S"")","IO(""SPOOL"")","IO(""ZIO"")","IOBS","IOCPU","IOF","IOHG","IOM","ION","IOPAR","IOUPAR","IOS","IOSL","IOST","IOST(0)","IOT","IOXY"
Begin DoDot:1
+6 IF MODE=0
if $DATA(@%)#2
SET @ROOT@(%)=@%
QUIT
+7 IF MODE=1
if $DATA(@ROOT@(%))
SET @%=@ROOT@(%)
QUIT
+8 IF MODE="K"
KILL @%
+9 QUIT
End DoDot:1
+10 QUIT
RMDEV(X) ;Remove saved IO variables.
+1 NEW Y
+2 SET Y=$$FINDEV(X)
+3 if 'Y
QUIT
+4 KILL ^TMP("XUDEVICE",$JOB,"B",X),^TMP("XUDEVICE",$JOB,+Y)
+5 QUIT
RMALLDEV() ;Remove saved IO variables for all devices saved in table.
+1 KILL ^TMP("XUDEVICE",$JOB)
+2 QUIT 1
FINDEV(NM) ;Find Device name and return IEN.
+1 QUIT $ORDER(^TMP("XUDEVICE",$JOB,"B",NM,0))
NEXTDEV(NM) ;Return next available device.
+1 NEW Y
+2 FOR Y=1:1
if '$DATA(^TMP("XUDEVICE",$JOB,Y))
QUIT
+3 SET ^TMP("XUDEVICE",$JOB,"B",NM,Y)=""
+4 QUIT Y
OPEN(HNDL,IOP,%ZIS) ;Open extrinsic function
+1 ;Parameters
+2 ;HNDL=Handle name
+3 ;IOP string--optional
+4 ;%ZIS string--optional
+5 NEW %
+6 ;Remove IOP if null.
IF $GET(IOP)=""
KILL IOP
+7 DO ^%ZIS
if POP=0
DO SAVDEV(HNDL)
+8 QUIT
CLOSE(X1) ;Close extrinsic function
+1 ;X1=Handle
+2 NEW %,Y
+3 SET Y=$$FINDEV(X1)
+4 if 'Y
QUIT
+5 DO GETDEV(Y)
+6 DO ^%ZISC
DO RMDEV(X1)
+7 QUIT
USE(X1) ;Restore IO* variables pertaining to the device.
+1 ;X1=Handle name
+2 ; ZEXCEPT: IOT
+3 NEW %,Y
+4 SET Y=$$FINDEV^%ZISUTL(X1)
+5 if 'Y
QUIT
+6 DO GETDEV^%ZISUTL(Y)
+7 IF $GET(IOT)'="RES"
USE $SELECT($DATA(IO(1,IO)):IO,1:IO(0))
+8 KILL IO("CLOSE")
+9 QUIT
LINEPORT() ;Return device name for line port.
+1 NEW %
+2 SET %=$$LNPRTIEN^%ZISUTL($$LNPRTNAM^%ZISUTL)
+3 QUIT +$PIECE($GET(^%ZIS(3.23,+%,0)),"^",3)
LNPRTSUB() ;Return line port subtype pointer.
+1 NEW %
+2 SET %=$$LNPRTIEN^%ZISUTL($$LNPRTNAM^%ZISUTL)
+3 QUIT +$PIECE($GET(^%ZIS(3.23,+%,0)),"^",4)
LNPRTNAM() ;Return Line port name
+1 NEW Y,%
+2 SET Y=""
SET %=$GET(^%ZOSF("OS"))
+3 IF %["VAX DSM"!(%["OpenM-NT")
Begin DoDot:1
+4 SET Y=$ZIO
End DoDot:1
+5 IF '$TEST
IF %["MSM"
XECUTE "S Y=$ZDEV($I)"
+6 QUIT Y
LNPRTIEN(X) ;Return internal entry number of Line/port
+1 if X'?1AN.29ANP
QUIT 0
+2 QUIT $ORDER(^%ZIS(3.23,"B",X,0))
LNPRTADR(X) ;Returns Line/Port name of a fixed device.
+1 NEW %,Y
+2 SET Y=""
+3 SET %=$ORDER(^%ZIS(1,"B",X,0))
+4 SET %=$ORDER(^%ZIS(3.23,"C",+%,0))
+5 IF %
IF $GET(^%ZIS(3.23,+%,0))]""
SET Y=$PIECE(^(0),"^")
+6 QUIT Y
FIND(IOP) ;e.f. Get the IEN of a device
+1 NEW %XX,%YY,%ZIS,%ZISV
+2 SET %ZISV=^%ZOSF("VOL")
SET %XX=$$UP^%ZIS1(IOP)
DO 1^%ZIS5
+3 QUIT %YY
NOQ(IOP) ;e.f. Return queueing status
+1 ;Call with Device name, Return 1 if NO QUEUE, Else 0.
+2 NEW %X,%Y
SET %X=$$FIND(IOP)
if %X'>0
QUIT 0
+3 SET %Y=$PIECE($GET(^%ZIS(1,%X,0)),U,12)
+4 QUIT %Y=2
UNIQUE(ZISNA) ;Build a unique number to add to a device name
+1 ;If passed a name put the number before the last dot.
+2 NEW %,%1,%2
+3 ;Kernel exemption, allowed to use $INCREMENT
