Routine: DINVONT

%ZOSV ;SFISC/AC - $View commands for Open M for NT. ;2015-01-02  4:31 PM

 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42

 ;;Per VA Directive 6402, this routine should not be modified.

 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.

 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.

 ;;Licensed under the terms of the Apache License, Version 2.0.

ACTJ() ;# Active jobs

 N Y,% S %=0 F Y=0:1 S %=$ZJ(%) Q:%=""

Q Y

AVJ() ;# available jobs

 ;Return fixed value if version < 2.1.6 (e.i. not Cache)

 N V S V=$$VERSION($ZV) I 216>$TR(V,".") Q 15 ;

 N MAXPID S MAXPID=$V($ZU(40,2,118),-2,4) ;from %SS

 Q MAXPID-$$ACTJ() ;need ISM to provide maxpid in ^%MACHINE

PRIINQ() ;

Q 8

UCI ;Current UCI

 S Y=$ZU(5)_","_^%ZOSF("VOL") Q

UCICHECK(X) ;Check if valid UCI

 N Y,%

 S %=$P(X,",",1),Y=0 I ##CLASS(%SYS.Namespace).Exists(%) S Y=%

Q Y

JOBPAR ;See if X points to a valid Job. Return its UCI.

 N ZJ S Y="",$ZT="JOBX"

 Q:'$D(^$JOB(X))  S Y=$V(-1,X),Y=$P(Y,"^",14)_","_^%ZOSF("VOL")

JOBX Q

T0 ; start RT clock

 S XRT0=$H Q

T1 ; store RT datum

 S ^%ZRTL(3,XRTL,+$H,XRTN,$P($H,",",2))=XRT0 K XRT0 Q

NOLOG ;

 S Y="$V(0,-2,4)\4096#2" Q

PROGMODE() ;Check if in PROG mode

 Q $ZJ#2

PRGMODE ;

 W ! S ZTPAC=$S('$D(^VA(200,+DUZ,.1)):"",1:$P(^(.1),U,5)),XUVOL=^%ZOSF("VOL")

 S X="" X ^%ZOSF("EOFF") R:ZTPAC]"" !,"PAC: ",X:60 D LC^XUS X ^%ZOSF("EON") I X'=ZTPAC W "??",*7 Q

 S XMB="XUPROGMODE",XMB(1)=DUZ,XMB(2)=$I D ^XMB:$L($T(^XMB)) D BYE^XUSCLEAN K ZTPAC,X,XMB

 D UCI S XUCI=Y,XQZ="PRGM^ZUA[MGR]",XUSLNT=1 D DO^%XUCI D ^%PMODE U $I:("":"+B+C+R") S $ZT="" Q

LGR() S $ZT="LGRX^%ZOSV"

 Q $ZR ;Last Global ref.

LGRX Q ""

EC() Q $ZE ;Error code

DOLRO ;SAVE ENTIRE SYMBOL TABLE IN LOCATION SPECIFIED BY X

 S Y="%" F %=0:0 S Y=$O(@Y) Q:Y=""  S %=$D(@Y) S:%#2 @(X_"Y)="_Y) I %>9 S %X=Y_"(",%Y=X_"Y," D %XY^%RCR

ORDER ;SAVE PART OF SYMBOL TABLE IN LOCATION SPECIFIED BY X

 S (Y,Y1)=$P(Y,"*",1) I $D(@Y)=0 F %=0:0 S Y=$O(@Y) Q:Y=""!(Y[Y1)

 Q:Y=""  S %=$D(@Y) S:%#2 @(X_"Y)="_Y) I %>9 S %X=Y_"(",%Y=X_"Y," D %XY^%RCR

 F %=0:0 S Y=$O(@Y) Q:Y=""!(Y'[Y1)  S %=$D(@Y) S:%#2 @(X_"Y)="_Y) I %>9 S %X=Y_"(",%Y=X_"Y," D %XY^%RCR

 K %,X,Y,Y1 Q

PARSIZ ;

 S X=3 Q

DEVOPN ;List of Devices opened

 ;Returns variable Y. Y=Devices owned separated by a comma

 S X=$J

 N % S Y=$P($V(-1,$J),"^",3) F %=1:1:$L(Y,",") S $P(Y,",",%)=$P($P(Y,",",%),"*",1)

DEVOK ;

 S Y=0,X1=$G(X1) Q:X=2  Q:(X1="HFS")!(X1="MT")  G:X1="RES" RES ;Quit w/ OK for HFS, Spool, MT

 S $ZT="OPNERR"

 O X::$S($D(%ZISTO):%ZISTO,1:0) E  S Y=999 Q  ;G NOPN

 S Y=0 I '$D(%ZISCHK)!$S($D(%ZIS)#2:(%ZIS["T"),1:0) C X Q

 S:X]"" IO(1,X)="" Q

NOPN ;

 N ZJ S $ZT="NJ"

 S ZJ="" F %=0:0 S ZJ=$ZJ(ZJ) Q:'ZJ  D NOPN1 Q:'ZJ

NOPN1 S Y=$V(-1,ZJ) I $P(Y,"^",3)[X_","!($P(Y,"^",3)[X_"*,") S Y=ZJ,ZJ="" Q

NJ Q  ;NOJOB ERROR

OPNERR S Y=-1 Q

RES S Y=0,%ZISD0=$O(^%ZISL(3.54,"B",X,0))

 I '%ZISD0 S Y=-1,%ZISD0=%O(^%ZIS(1,"C",X)) Q:'%ZISD0  Q:'$D(^%ZIS(1,+%ZISD0,0))  Q:$P(^(0),"^")'=X  Q:'$D(^("TYPE"))  Q:^("TYPE")'="RES"  S Y=0 Q

 S X1=$S($D(^%ZISL(3.54,+%ZISD0,0)):^(0),1:"")

 I $P(X1,"^",2)&(X=$P(X1,"^")) S Y=0 Q

 S Y=999 F %ZISD1=0:0 S %ZISD1=$O(^%ZISL(3.54,%ZISD0,1,%ZISD1)) Q:%ZISD1'>0  I $D(^(%ZISD1,0)) S Y=$P(^(0),"^",3) Q

 K %ZISD0,%ZISD1

GETENV ;Get environment  (UCI^VOL^NODE)

 X ^%ZOSF("UCI") S Y=$P(Y,",")_"^"_^%ZOSF("VOL")_"^"_$ZU(110)_"^"_^%ZOSF("VOL")

VERSION(X) ;return OS version, X=1 - return OS

 Q $S($G(X):$P($ZV,")")_")",1:$P($P($ZV,") ",2),"("))

SETNM(X) ;Set name, Fall into SETENV

SETENV ;Set environment

HFSREW(IO,IOPAR) ;Rewind Host File.

 S $ZT="HFSRWERR"

 C IO O @(""""_IO_""""_$S(IOPAR]"":":"_IOPAR_":1",1:":1")) I '$T Q 0

Q 1

HFSRWERR ;Error encountered

Q 0

LOGRSRC(OPT) ;record resource usage in ^XTMP("KMPR"

 D RO^%ZOSVKR(OPT)

SETTRM(X) ;Turn on specified terminators.

 U $I:(::X)

Q 1

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDINVONT   3929     printed  Mar 13, 2025@21:57:08                                                                                                                                                                                                     Page 2

%ZOSV     ;SFISC/AC - $View commands for Open M for NT. ;2015-01-02  4:31 PM

 +1       ;;22.2;VA FileMan;;Jan 05, 2016;Build 42

 +2       ;;Per VA Directive 6402, this routine should not be modified.

 +3       ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.

 +4       ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.

 +5       ;;Licensed under the terms of the Apache License, Version 2.0.

 +6       ;

ACTJ()    ;# Active jobs

 +1        NEW Y,%

           SET %=0

           FOR Y=0:1

               SET %=$ZJ(%)

               if %=""

                   QUIT

 +2        QUIT Y

AVJ()     ;# available jobs

 +1       ;Return fixed value if version < 2.1.6 (e.i. not Cache)

 +2       ;

           NEW V

           SET V=$$VERSION($ZV)

           IF 216>$TRANSLATE(V,".")

               QUIT 15

 +3       ;from %SS

           NEW MAXPID

           SET MAXPID=$VIEW($ZU(40,2,118),-2,4)

 +4       ;need ISM to provide maxpid in ^%MACHINE

           QUIT MAXPID-$$ACTJ()

PRIINQ()  ;

 +1        QUIT 8

UCI       ;Current UCI

 +1        SET Y=$ZU(5)_","_^%ZOSF("VOL")

           QUIT

 +2       ;

UCICHECK(X) ;Check if valid UCI

 +1        NEW Y,%

 +2        SET %=$PIECE(X,",",1)

           SET Y=0

           IF ##CLASS(%SYS.Namespace).Exists(%)

               SET Y=%

 +3        QUIT Y

JOBPAR    ;See if X points to a valid Job. Return its UCI.

 +1        NEW ZJ

           SET Y=""

           SET $ZT="JOBX"

+2

*** ERROR ***

           if '$DATA(^$JOB(X))

               QUIT

           SET Y=$VIEW(-1,X)

           SET Y=$PIECE(Y,"^",14)_","_^%ZOSF("VOL")

JOBX       QUIT

 +1       ;

T0        ; start RT clock

 +1        SET XRT0=$HOROLOG

           QUIT

T1        ; store RT datum

 +1        SET ^%ZRTL(3,XRTL,+$HOROLOG,XRTN,$PIECE($HOROLOG,",",2))=XRT0

           KILL XRT0

           QUIT

NOLOG     ;

 +1        SET Y="$V(0,-2,4)\4096#2"

           QUIT

 +2       ;

PROGMODE() ;Check if in PROG mode

 +1        QUIT $ZJ#2

 +2       ;

PRGMODE   ;

 +1        WRITE !

           SET ZTPAC=$SELECT('$DATA(^VA(200,+DUZ,.1)):"",1:$PIECE(^(.1),U,5))

           SET XUVOL=^%ZOSF("VOL")

 +2        SET X=""

           XECUTE ^%ZOSF("EOFF")

           if ZTPAC]""

               READ !,"PAC: ",X:60

           DO LC^XUS

           XECUTE ^%ZOSF("EON")

           IF X'=ZTPAC

               WRITE "??",*7

               QUIT

 +3        SET XMB="XUPROGMODE"

           SET XMB(1)=DUZ

           SET XMB(2)=$IO

           if $LENGTH($TEXT(^XMB))

               DO ^XMB

           DO BYE^XUSCLEAN

           KILL ZTPAC,X,XMB

 +4        DO UCI

           SET XUCI=Y

           SET XQZ="PRGM^ZUA[MGR]"

           SET XUSLNT=1

           DO DO^%XUCI

           DO ^%PMODE

           USE $IO:("":"+B+C+R")

           SET $ZT=""

           QUIT

 +5        QUIT

LGR()      SET $ZT="LGRX^%ZOSV"

 +1       ;Last Global ref.

           QUIT $ZR

LGRX       QUIT ""

 +1       ;

EC()      ;Error code

           QUIT $ZE

 +1       ;

DOLRO     ;SAVE ENTIRE SYMBOL TABLE IN LOCATION SPECIFIED BY X

 +1        SET Y="%"

           FOR %=0:0

               SET Y=$ORDER(@Y)

               if Y=""

                   QUIT

               SET %=$DATA(@Y)

               if %#2

                   SET @(X_"Y)="_Y)

               IF %>9

                   SET %X=Y_"("

                   SET %Y=X_"Y,"

                   DO %XY^%RCR

 +2        QUIT

 +3       ;

ORDER     ;SAVE PART OF SYMBOL TABLE IN LOCATION SPECIFIED BY X

 +1        SET (Y,Y1)=$PIECE(Y,"*",1)

           IF $DATA(@Y)=0

               FOR %=0:0

                   SET Y=$ORDER(@Y)

                   if Y=""!(Y[Y1)

                       QUIT

 +2        if Y=""

               QUIT

           SET %=$DATA(@Y)

           if %#2

               SET @(X_"Y)="_Y)

           IF %>9

               SET %X=Y_"("

               SET %Y=X_"Y,"

               DO %XY^%RCR

 +3        FOR %=0:0

               SET Y=$ORDER(@Y)

               if Y=""!(Y'[Y1)

                   QUIT

               SET %=$DATA(@Y)

               if %#2

                   SET @(X_"Y)="_Y)

               IF %>9

                   SET %X=Y_"("

                   SET %Y=X_"Y,"

                   DO %XY^%RCR

 +4        KILL %,X,Y,Y1

           QUIT

 +5       ;

PARSIZ    ;

 +1        SET X=3

           QUIT

 +2       ;

DEVOPN    ;List of Devices opened

 +1       ;Returns variable Y. Y=Devices owned separated by a comma

 +2        SET X=$JOB

 +3        NEW %

           SET Y=$PIECE($VIEW(-1,$JOB),"^",3)

           FOR %=1:1:$LENGTH(Y,",")

               SET $PIECE(Y,",",%)=$PIECE($PIECE(Y,",",%),"*",1)

 +4        QUIT

DEVOK     ;

 +1       ;Quit w/ OK for HFS, Spool, MT

           SET Y=0

           SET X1=$GET(X1)

           if X=2

               QUIT

           if (X1="HFS")!(X1="MT")

               QUIT

           if X1="RES"

               GOTO RES

 +2        SET $ZT="OPNERR"

 +3       ;G NOPN

           OPEN X::$SELECT($DATA(%ZISTO):%ZISTO,1:0)

          IF '$TEST

               SET Y=999

               QUIT

 +4        SET Y=0

           IF '$DATA(%ZISCHK)!$SELECT($DATA(%ZIS)#2:(%ZIS["T"),1:0)

               CLOSE X

               QUIT

 +5        if X]""

               SET IO(1,X)=""

           QUIT

 +6        QUIT

NOPN      ;

 +1        NEW ZJ

           SET $ZT="NJ"

 +2        SET ZJ=""

           FOR %=0:0

               SET ZJ=$ZJ(ZJ)

               if 'ZJ

                   QUIT

               DO NOPN1

               if 'ZJ

                   QUIT

 +3        QUIT

NOPN1      SET Y=$VIEW(-1,ZJ)

           IF $PIECE(Y,"^",3)[X_","!($PIECE(Y,"^",3)[X_"*,")

               SET Y=ZJ

               SET ZJ=""

               QUIT

 +1        QUIT

NJ        ;NOJOB ERROR

           QUIT

OPNERR     SET Y=-1

           QUIT

 +1       ;

RES        SET Y=0

           SET %ZISD0=$ORDER(^%ZISL(3.54,"B",X,0))

 +1        IF '%ZISD0

               SET Y=-1

               SET %ZISD0=%O(^%ZIS(1,"C",X))

               if '%ZISD0

                   QUIT

               if '$DATA(^%ZIS(1,+%ZISD0,0))

                   QUIT

               if $PIECE(^(0),"^")'=X

                   QUIT

               if '$DATA(^("TYPE"))

                   QUIT

               if ^("TYPE")'="RES"

                   QUIT

               SET Y=0

               QUIT

 +2        SET X1=$SELECT($DATA(^%ZISL(3.54,+%ZISD0,0)):^(0),1:"")

 +3        IF $PIECE(X1,"^",2)&(X=$PIECE(X1,"^"))

               SET Y=0

               QUIT

 +4        SET Y=999

           FOR %ZISD1=0:0

               SET %ZISD1=$ORDER(^%ZISL(3.54,%ZISD0,1,%ZISD1))

               if %ZISD1'>0

                   QUIT

               IF $DATA(^(%ZISD1,0))

                   SET Y=$PIECE(^(0),"^",3)

                   QUIT

 +5        KILL %ZISD0,%ZISD1

 +6        QUIT

GETENV    ;Get environment  (UCI^VOL^NODE)

 +1        XECUTE ^%ZOSF("UCI")

           SET Y=$PIECE(Y,",")_"^"_^%ZOSF("VOL")_"^"_$ZU(110)_"^"_^%ZOSF("VOL")

 +2        QUIT

VERSION(X) ;return OS version, X=1 - return OS

 +1        QUIT $SELECT($GET(X):$PIECE($ZV,")")_")",1:$PIECE($PIECE($ZV,") ",2),"("))

 +2       ;

SETNM(X)  ;Set name, Fall into SETENV

SETENV    ;Set environment

 +1        QUIT

 +2       ;

HFSREW(IO,IOPAR) ;Rewind Host File.

 +1        SET $ZT="HFSRWERR"

 +2        CLOSE IO

           OPEN @(""""_IO_""""_$SELECT(IOPAR]"":":"_IOPAR_":1",1:":1"))

           IF '$TEST

               QUIT 0

 +3        QUIT 1

HFSRWERR  ;Error encountered

 +1        QUIT 0

LOGRSRC(OPT) ;record resource usage in ^XTMP("KMPR"

 +1        DO RO^%ZOSVKR(OPT)

 +2        QUIT

SETTRM(X) ;Turn on specified terminators.

 +1        USE $IO:(::X)

 +2        QUIT 1

DINVONT.m