Annotation of freem_fileman/DINVDTM.m, revision 1.1
1.1 ! snw 1: %ZOSV ;SFISC/AC,LL/DFH,sfisc/fyb-View commands and special functions ;03:15 PM 21 Dec 1994
! 2: ;;21.0;VA FileMan;;Dec 28, 1994
! 3: ;Per VHA Directive 10-93-142, this routine should not be modified.
! 4: ; ** For DataTree **
! 5: ;
! 6: ACTJ() ; Active Jobs
! 7: Q $$njobs^%mjob("running")
! 8: ;
! 9: AVJ() ; Available Jobs
! 10: Q $$njobs^%mjob("free")
! 11: ;
! 12: T0 ; start RT clock
! 13: S XRT0=$H Q
! 14: T1 ; store RT datum
! 15: S ^%ZRTL(3,XRTL,+$H,XRTN,$P($H,",",2))=XRT0 K XRT0 Q
! 16: MAXJ ; Maximum # of Jobs
! 17: S Y=$$njobs^%mjob("total") Q
! 18: ;
! 19: BAUD ; Baud rate of device - used by BAUD field of the Device File
! 20: ; Internal entry of device is D0
! 21: ;ZETRAP BAUDERR
! 22: ;S X=$zdevspeed($P(^%ZIS(1,D0,0),"^",2)) Q
! 23: BAUDERR ;S X="" Q
! 24: Q
! 25: ;
! 26: LGR() Q $ZR ;Last global reference
! 27: ;
! 28: EC() Q $ZE ;Error code
! 29: ;
! 30: DEVOPN ;X=$J,Y=List of devices separated by a comma
! 31: G DEVOPN^%ZOSV1
! 32: ;
! 33: DEVOK ;X=Device $I, Y=0 if available, Y=999 if device is busy
! 34: ;Y=-1 if device is undefined.
! 35: G RES:$G(X1)="RES" I $E(X)="/"!($E(X)="\") S Y=0 Q
! 36: I $D(X)[0 S X=$I
! 37: I X=$I S Y=$J Q
! 38: I X<20,(X>9) S Y=0 D NULLDEV O X:("W":NULLDEV):0 C:$T X S:'$T Y=999 Q
! 39: ZETRAP NODEV
! 40: L:$D(%ZISLOCK) +@%ZISLOCK:60
! 41: O X::0 I '$T S Y=999 L:$D(%ZISLOCK) -@%ZISLOCK Q
! 42: L:$D(%ZISLOCK) -@%ZISLOCK
! 43: C X S Y=0
! 44: Q
! 45: RES S Y=0,%ZISD0=$O(^%ZISL(3.54,"B",X,0))
! 46: 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
! 47: S X1=$S($D(^%ZISL(3.54,+%ZISD0,0)):^(0),1:"")
! 48: I $P(X1,"^",2)&(X=$P(X1,"^")) S Y=0 Q
! 49: 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
! 50: K %ZISD0,%ZISD1
! 51: Q
! 52: NULLDEV ; based on %device
! 53: K HWTYPE S NULLDEV="NUL",H=$V($S($P($ZVER,"/",2)<4:4,1:1),3,-1)
! 54: S HWTYPE=$S(H<10:"WS",H<20:"MF",H<64:"?",H<129:"PC",1:"?")
! 55: I HWTYPE'="PC" S NULLDEV="[NUL]"
! 56: K H,HWTYPE Q
! 57: ;
! 58: NODEV S Y=-1
! 59: Q
! 60: ;
! 61: DOLRO ;SAVE ENTIRE SYMBOL TABLE IN LOCATION SPECIFIED BY X
! 62: ;I $P($ZVER,"/",2)<4 D ^%VARLOG
! 63: 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
! 64: Q
! 65: ;
! 66: ORDER ; Save part of the symbol table in location specified by X
! 67: S (Y,Y1)=$P(Y,"*",1) I $D(@Y)=0 F %=0:0 S Y=$O(@Y) Q:Y=""!(Y[Y1)
! 68: Q:Y="" S %=$D(@Y) S:%#2 @(X_"Y)="_Y)
! 69: I %>9 S %X=Y_"(",%Y=X_"Y," D %XY^%RCR
! 70: 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
! 71: K %,X,Y,Y1 Q
! 72: ;
! 73: JOBPAR ; Returns job X's namespace
! 74: D JSTAT^%ZOSV1
! 75: I ($P($ZVER,"/",2)'<4)&($P($ZVER,"/",2)<4.3) S Y=$ZCONVERT($V(0,JA+908,-5),"U")
! 76: E S Y=$$jstat^%mjob(X),Y=$P(Y,"|",4)
! 77: Q
! 78: ;
! 79: ;
! 80: NOLOG ; No logins allowed
! 81: S Y=0 Q
! 82: ;
! 83: PARSIZ ;
! 84: S X=3 Q
! 85: ;
! 86: PRIINQ() ; Priority Inquire
! 87: N X,Y S X=$J D JSTAT^%ZOSV1
! 88: I ZVER S Y=$V(0,$V(1,(X-1*2)+100,-2)*16+5,-1)-128\2 S:Y Y=10-Y
! 89: E S Y=$$jstat^%mjob(X),Y=$P(Y,"|",7) S:Y Y=10-Y
! 90: Q Y
! 91: ;
! 92: PRIORITY ; Set priority of job
! 93: I X<1!(X>10) Q
! 94: S Y=X,X=10-X ; convert Kernel to DTM priority
! 95: I $P($ZVER,"/",2)<4 V 64+$J:50:$C(128+X) Q
! 96: S X=X*2+128 zc #changepriority(X) V 2:5:$C(X)
! 97: Q
! 98: PRGMODE ;
! 99: W ! S ZTPAC=$S($D(^VA(200,+DUZ,.1))#10:$P(^(.1),"^",5),1:""),XUVOL=^%ZOSF("VOL")
! 100: I ZTPAC]"" X ^%ZOSF("EOFF") R !,"PAC: ",X:60 S X=$ZCONVERT(X,"U") X ^%ZOSF("EON") I X'=ZTPAC W "??",*7 Q
! 101: I $D(^XMB(3.7,0)),$D(DUZ)#2 S XMB="XUPROGMODE",XMB(1)=DUZ,XMB(2)=$I D ^XMB:$D(^XMB(3.7,0)) K ^XMB(3.7,DUZ,100,$I),^XUSEC(0,"CUR",DUZ,+^XUTL("XQ",$J,0))
! 102: K ZTPAC,X,XMB
! 103: X ^%ZOSF("UCI") S XUCI=Y,XQZ="PRGM^ZUA[MGR]",XUSLNT=1 D DO^%XUCI
! 104: U:$I>99 $I:IXXLATE=2 D ^%mshell
! 105: ;
! 106: UCICHECK(X) ; The call to ns^%m for Version 4 is necessary
! 107: ; only if namespaces are password protected.
! 108: ZETRAP BADUCI N CURUCI
! 109: S X=$P(X,",")
! 110: S X=$ZCONVERT(X,"U"),CURUCI=$ZNSPACE
! 111: I $P($ZVER,"/",2)<4 ZNSPACE X ZNSPACE CURUCI Q X
! 112: D ns^%m(X,1) S ^UTILITY($J)="" ; *** force error if dataset not mounted
! 113: I CURUCI'=X D ns^%m(CURUCI,1)
! 114: Q X
! 115: BADUCI ; set flag and return to old namespace
! 116: S Y=0
! 117: I $P($ZVER,"/",2)<4 ZNSPACE CURUCI
! 118: E D ns^%m(CURUCI,1)
! 119: Q Y
! 120: ;
! 121: SETENV ; Set environment
! 122: S XUENV=X_"^"
! 123: I $P($ZVER,"/",2)>4.2 V 2:374:$C($L(X))_X:$J#256 Q
! 124: S X1=X,X=$J D JSTAT^%ZOSV1
! 125: V 0:JA+374:$C($L(X1))_X1
! 126: Q
! 127: GETENV ; Get environment
! 128: S Y=$ZNSPACE_"^"_^%ZOSF("VOL")_"^^"_^%ZOSF("VOL")
! 129: Q
! 130: TRMON ;Turn terminators on
! 131: U $I:IXINTERP=2 N % S %=$$getall^%mixinterp()
! 132: I $A(%)'=35 F %=0:1:31,127 D set^%mixinterp(%,35)
! 133: Q
! 134: TRMOFF ;Turn terminators off
! 135: U $I:IXINTERP=$S($I>99:1,1:0)
! 136: Q
! 137: PASSALL ;Pass all characters
! 138: U $I:IXINTERP=3 N % S %=$$getall^%mixinterp()
! 139: I $A(%)'=18 F %=0:1:31,127 D set^%mixinterp(%,18)
! 140: Q
! 141: NOPASS ;Do not pass all characters
! 142: D TRMOFF
! 143: Q
! 144: ;
! 145: HFSREW(IO,IOPAR) ;Rewind Host File
! 146: S $ZT="HFSRWERR"
! 147: U IO:(LFA=0)
! 148: Q 1
! 149: HFSRWERR ;Error encountered.
! 150: Q 0
! 151: LOGRSRC(OPT) ;record resource usage in ^XUCP
! 152: Q
! 153: SETTRM(X) ;Turn on specified terminators.
! 154: U $I:TERM=X
! 155: Q 1
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DINVDTM.m CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem_fileman