%ZOSV ;SFISC/AC,LL/DFH,sfisc/fyb ;2:33 PM 1 Oct 1998
;;22.0;VA FileMan;;Mar 30, 1999;Build 1
;Per VHA Directive 10-93-142, this routine should not be modified.
; ** For DataTree **
;
ACTJ() ; Active Jobs
Q $$njobs^%mjob("running")
;
AVJ() ; Available Jobs
Q $$njobs^%mjob("free")
;
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
MAXJ ; Maximum # of Jobs
S Y=$$njobs^%mjob("total") Q
;
BAUD ; Baud rate of device - used by BAUD field of the Device File
; Internal entry of device is D0
;ZETRAP BAUDERR
;S X=$zdevspeed($P(^%ZIS(1,D0,0),"^",2)) Q
Q
BAUDERR S X="" Q
;
LGR() Q $ZR ;Last global reference
;
EC() Q $ZE ;Error code
;
DEVOPN ;X=$J,Y=List of devices separated by a comma
G DEVOPN^%ZOSV1
;
DEVOK ;X=Device $I, Y=0 if available, Y=999 if device is busy
;Y=-1 if device is undefined.
G RES:$G(X1)="RES" I $E(X)="/"!($E(X)="\") S Y=0 Q
I $D(X)[0 S X=$I
I X=$I S Y=$J Q
I X<20,(X>9) S Y=0 D NULLDEV O X:("W":NULLDEV):0 C:$T X S:'$T Y=999 Q
ZETRAP NODEV
O X::0 I '$T S Y=999 Q
C X S Y=0
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
NULLDEV ; based on %device
K HWTYPE S NULLDEV="NUL",H=$V($S($P($ZVER,"/",2)<4:4,1:1),3,-1)
S HWTYPE=$S(H<10:"WS",H<20:"MF",H<64:"?",H<129:"PC",1:"?")
I HWTYPE'="PC" S NULLDEV="[NUL]"
K H,HWTYPE Q
;
NODEV S Y=-1
Q
;
DOLRO ;SAVE ENTIRE SYMBOL TABLE IN LOCATION SPECIFIED BY X
;I $P($ZVER,"/",2)<4 D ^%VARLOG
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 the 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
;
JOBPAR ; Returns job X's namespace
D JSTAT^%ZOSV1
I ($P($ZVER,"/",2)'<4)&($P($ZVER,"/",2)<4.3) S Y=$ZCONVERT($V(0,JA+908,-5),"U")
E S Y=$$jstat^%mjob(X),Y=$P(Y,"|",4)
Q
;
;
NOLOG ; No logins allowed
S Y=0 Q
;
PARSIZ ;
S X=3 Q
;
PRIINQ() ; Priority Inquire
N X,Y S X=$J ;D JSTAT^%ZOSV1
;I ZVER S Y=$V(0,$V(1,(X-1*2)+100,-2)*16+5,-1)-128\2 S:Y Y=10-Y
S Y=$$jstat^%mjob(X),Y=$P(Y,"|",7) S:Y Y=10-Y
Q Y
;
PRIORITY ; Set priority of job
I X<1!(X>10) Q
S Y=X,X=10-X ; convert Kernel to DTM priority
I $P($ZVER,"/",2)<4 V 64+$J:50:$C(128+X) Q
S X=X*2+128 zc #changepriority(X) V 2:5:$C(X)
Q
PRGMODE ;
W ! S ZTPAC=$S($D(^VA(200,+DUZ,.1))#10:$P(^(.1),"^",5),1:""),XUVOL=^%ZOSF("VOL")
I ZTPAC]"" X ^%ZOSF("EOFF") R !,"PAC: ",X:60 S X=$ZCONVERT(X,"U") 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
X ^%ZOSF("UCI") S XUCI=Y,XQZ="PRGM^ZUA[MGR]",XUSLNT=1 D DO^%XUCI
U:$I>99 $I:IXXLATE=2 D ^%mshell
;
UCICHECK(X) ; The call to ns^%m for Version 4 is necessary
; only if namespaces are password protected.
ZETRAP BADUCI N CURUCI
S X=$P(X,",")
S X=$ZCONVERT(X,"U"),CURUCI=$ZNSPACE
I $P($ZVER,"/",2)<4 ZNSPACE X ZNSPACE CURUCI Q X
D ns^%m(X,1) S ^UTILITY($J)="" ; *** force error if dataset not mounted
I CURUCI'=X D ns^%m(CURUCI,1)
Q X
BADUCI ; set flag and return to old namespace
S Y=0
I $P($ZVER,"/",2)<4 ZNSPACE CURUCI
E D ns^%m(CURUCI,1)
Q Y
;
VERSION(X) ;return OS version, X=1 - return OS
Q $S($G(X):$P($ZV,"/"),1:$P($ZV,"/",2))
;
SETNM(X) ;Set name, Fall into SETENV
SETENV ; Set environment
S XUENV=X_"^"
I $P($ZVER,"/",2)>4.2 V 2:374:$C($L(X))_X:$J#256 Q
S X1=X,X=$J D JSTAT^%ZOSV1
V 0:JA+374:$C($L(X1))_X1
Q
GETENV ; Get environment
S Y=$ZNSPACE_"^"_^%ZOSF("VOL")_"^^"_^%ZOSF("VOL")
Q
TRMON ;Turn terminators on
U $I:IXINTERP=2 N % S %=$$getall^%mixinterp()
I $A(%)'=35 F %=0:1:31,127 D set^%mixinterp(%,35)
Q
TRMOFF ;Turn terminators off
U $I:IXINTERP=$S($I>99:1,1:0)
Q
PASSALL ;Pass all characters
U $I:IXINTERP=3 N % S %=$$getall^%mixinterp()
I $A(%)'=18 F %=0:1:31,127 D set^%mixinterp(%,18)
Q
NOPASS ;Do not pass all characters
D TRMOFF
Q
;
HFSREW(IO,IOPAR) ;Rewind Host File
S $ZT="HFSRWERR"
U IO:(LFA=0)
Q 1
HFSRWERR ;Error encountered.
Q 0
LOGRSRC(OPT) ;record resource usage in ^XUCP
Q
SETTRM(X) ;Turn on specified terminators.
U $I:TERM=X
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDINVDTM 4798 printed Dec 13, 2024@02:52:13 Page 2
%ZOSV ;SFISC/AC,LL/DFH,sfisc/fyb ;2:33 PM 1 Oct 1998
+1 ;;22.0;VA FileMan;;Mar 30, 1999;Build 1
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ; ** For DataTree **
+4 ;
ACTJ() ; Active Jobs
+1 QUIT $$njobs^%mjob("running")
+2 ;
AVJ() ; Available Jobs
+1 QUIT $$njobs^%mjob("free")
+2 ;
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
MAXJ ; Maximum # of Jobs
+1 SET Y=$$njobs^%mjob("total")
QUIT
+2 ;
BAUD ; Baud rate of device - used by BAUD field of the Device File
+1 ; Internal entry of device is D0
+2 ;ZETRAP BAUDERR
+3 ;S X=$zdevspeed($P(^%ZIS(1,D0,0),"^",2)) Q
+4 QUIT
BAUDERR SET X=""
QUIT
+1 ;
LGR() ;Last global reference
QUIT $ZR
+1 ;
EC() ;Error code
QUIT $ZE
+1 ;
DEVOPN ;X=$J,Y=List of devices separated by a comma
+1 GOTO DEVOPN^%ZOSV1
+2 ;
DEVOK ;X=Device $I, Y=0 if available, Y=999 if device is busy
+1 ;Y=-1 if device is undefined.
+2 if $GET(X1)="RES"
GOTO RES
IF $EXTRACT(X)="/"!($EXTRACT(X)="\")
SET Y=0
QUIT
+3 IF $DATA(X)[0
SET X=$IO
+4 IF X=$IO
SET Y=$JOB
QUIT
+5 IF X<20
IF (X>9)
SET Y=0
DO NULLDEV
OPEN X:("W":NULLDEV):0
if $TEST
CLOSE X
if '$TEST
SET Y=999
QUIT
+6
*** ERROR ***
+7 OPEN X::0
IF '$TEST
SET Y=999
QUIT
+8 CLOSE X
SET Y=0
+9 QUIT
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
NULLDEV ; based on %device
+1 KILL HWTYPE
SET NULLDEV="NUL"
SET H=$VIEW($SELECT($PIECE($ZVER,"/",2)<4:4,1:1),3,-1)
+2 SET HWTYPE=$SELECT(H<10:"WS",H<20:"MF",H<64:"?",H<129:"PC",1:"?")
+3 IF HWTYPE'="PC"
SET NULLDEV="[NUL]"
+4 KILL H,HWTYPE
QUIT
+5 ;
NODEV SET Y=-1
+1 QUIT
+2 ;
DOLRO ;SAVE ENTIRE SYMBOL TABLE IN LOCATION SPECIFIED BY X
+1 ;I $P($ZVER,"/",2)<4 D ^%VARLOG
+2 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
+3 QUIT
+4 ;
ORDER ; Save part of the 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)
+3 IF %>9
SET %X=Y_"("
SET %Y=X_"Y,"
DO %XY^%RCR
+4 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
+5 KILL %,X,Y,Y1
QUIT
+6 ;
JOBPAR ; Returns job X's namespace
+1 DO JSTAT^%ZOSV1
+2 IF ($PIECE($ZVER,"/",2)'<4)&($PIECE($ZVER,"/",2)<4.3)
SET Y=$ZCONVERT($VIEW(0,JA+908,-5),"U")
+3 IF '$TEST
SET Y=$$jstat^%mjob(X)
SET Y=$PIECE(Y,"|",4)
+4 QUIT
+5 ;
+6 ;
NOLOG ; No logins allowed
+1 SET Y=0
QUIT
+2 ;
PARSIZ ;
+1 SET X=3
QUIT
+2 ;
PRIINQ() ; Priority Inquire
+1 ;D JSTAT^%ZOSV1
NEW X,Y
SET X=$JOB
+2 ;I ZVER S Y=$V(0,$V(1,(X-1*2)+100,-2)*16+5,-1)-128\2 S:Y Y=10-Y
+3 SET Y=$$jstat^%mjob(X)
SET Y=$PIECE(Y,"|",7)
if Y
SET Y=10-Y
+4 QUIT Y
+5 ;
PRIORITY ; Set priority of job
+1 IF X<1!(X>10)
QUIT
+2 ; convert Kernel to DTM priority
SET Y=X
SET X=10-X
+3 IF $PIECE($ZVER,"/",2)<4
VIEW 64+$JOB:50:$CHAR(128+X)
QUIT
+4 SET X=X*2+128
