Routine: ZOSVDTM

%ZOSV ;SFISC/AC,LL/DFH,sfisc/fyb ;10/31/95  10:04 [ 04/02/2003   8:29 AM ]

 ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003

 ;;8.0;KERNEL;**13**;Jul 10, 1995

 ; ** 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

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

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

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

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

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)

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)

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

GETENV ; Get environment

 S Y=$ZNSPACE_"^"_^%ZOSF("VOL")_"^^"_^%ZOSF("VOL")

TRMON ;Turn terminators on

 U $I:IXINTERP=2 N % S %=$$getall^%mixinterp()

 I $A(%)'=35 F %=0:1:31,127 D set^%mixinterp(%,35)

TRMOFF ;Turn terminators off

 U $I:IXINTERP=$S($I>99:1,1:0)

PASSALL ;Pass all characters

 U $I:IXINTERP=3 N % S %=$$getall^%mixinterp()

 I $A(%)'=18 F %=0:1:31,127 D set^%mixinterp(%,18)

NOPASS ;Do not pass all characters

 D TRMOFF

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

SETTRM(X) ;Turn on specified terminators.

 U $I:TERM=X

Q 1

ZOSVDTM.m