ZISUTL.m

%ZISUTL ;ISD/HGW - Device Handler Utility routine ;05/22/12  10:22

 ;;8.0;KERNEL;**18,24,34,69,118,127,199,275,425,599**;JUL 10, 1995;Build 9

 ;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" D  Q 1

 .I +$$VERSION^%ZOSV>2010 X "D $SYSTEM.Process.SetZEOF(1)"

 .I +$$VERSION^%ZOSV'>2010 S %=$ZUTIL(68,40,1)

 Q 0

%ZISUTL   ;ISD/HGW - Device Handler Utility routine ;05/22/12  10:22

 +1       ;;8.0;KERNEL;**18,24,34,69,118,127,199,275,425,599**;JUL 10, 1995;Build 9

 +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