%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
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
Q
;
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)
Q
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
Q
NOPN ;
N ZJ S $ZT="NJ"
S ZJ="" F %=0:0 S ZJ=$ZJ(ZJ) Q:'ZJ D NOPN1 Q:'ZJ
Q
NOPN1 S Y=$V(-1,ZJ) I $P(Y,"^",3)[X_","!($P(Y,"^",3)[X_"*,") S Y=ZJ,ZJ="" Q
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
Q
GETENV ;Get environment (UCI^VOL^NODE)
X ^%ZOSF("UCI") S Y=$P(Y,",")_"^"_^%ZOSF("VOL")_"^"_$ZU(110)_"^"_^%ZOSF("VOL")
Q
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
Q
;
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)
Q
SETTRM(X) ;Turn on specified terminators.
U $I:(::X)
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDINVONT 3929 printed Nov 22, 2024@18:02:13 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
