freem_fileman/USER/DINVVXD.m - view

File: [Coherent Logic Development] / freem_fileman / USER / DINVVXD.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:21 2025 UTC (3 months ago) by snw
Branches: MAIN
CVS tags: HEAD

Restructure repository

1: %ZOSV ;SFISC/AC-View commands & special functions. ;03:29 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: ACTJ() ; # active jobs 5: Q $P($$JOBS^%SY,",",2) 6: ; 7: AVJ() ; # available jobs 8: N Y S Y=$$JOBS^%SY Q +Y-$P(Y,",",2) 9: ; 10: T0 ; start RT clock 11: S %ZH0=$ZH,%=$P(%ZH0,",",3) S:$E($ZV,10,12)>5.1 %=$E(%,13,23) S XRT0=+$H_","_($P(%,":")*3600+($P(%,":",2)*60)+$P(%,":",3)) Q 12: ; 13: T1 ; store RT datum w/ZHDIF 14: S %ZH1=$ZH,%=$P(%ZH1,",",3) S:$E($ZV,10,12)>5.1 %=$E(%,13,23) S XRT1=+$H_","_($P(%,":")*3600+($P(%,":",2)*60)+$P(%,":",3)) 15: S ^%ZRTL(3,XRTL,+XRT1,XRTN,$P(XRT1,",",2))=XRT0_"^^"_($P(%ZH1,",")-$P(%ZH0,","))_"^"_($P(%ZH1,",",7)-$P(%ZH0,",",7))_"^"_($P(%ZH1,",",8)-$P(%ZH0,",",8)) K XRT0,%ZH0,%ZH1 Q 16: ; 17: PASSALL ; 18: S Y=$ZC(%SPAWN,"SET TERM/PASTHRU "_$I) U $I:NOTERM Q 19: NOPASS ; 20: S Y=$ZC(%SPAWN,"SET TERM/NOPASTHRU "_$I) U $I:TERM="" Q 21: ; 22: PRGMODE ; 23: W ! S ZTPAC=$S($D(^VA(200,+DUZ,.1))#10:$P(^(.1),"^",5),1:""),XUVOL=^%ZOSF("VOL") 24: S X="" X ^%ZOSF("EOFF") R:ZTPAC]"" !,"PAC: ",X:60 D LC^XUS X ^%ZOSF("EON") I X'=ZTPAC W "??",*7 Q 25: 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)),ZTPAC,X,XMB 26: I '$$PROGMODE() D UCI S XUCI=Y,XQZ="PRGM^ZUA[MGR]",XUSLNT=1 D DO^%XUCI ZESCAPE 27: E S $ECODE=",<<PROG>>," 28: ; 29: PROGMODE() ; 30: Q ($V($V($V(0)))#2=0) 31: ; 32: UCI ; 33: S Y=$ZC(%UCI),Y=$P(Y,",",1)_","_$P(Y,",",4) Q 34: ; 35: UCICHECK(X) ; 36: N %,%1,U,V,Y 37: I '(X?3U!(X?3U1","3U)) Q "" 38: S U=$ZC(%UCI),V=$P(U,",",4),U=$P(U,","),%1=$P(X,",",2),%=$P(X,",") 39: S Y=$ZC(%SETUCI,%,%1),Y=$S(Y:%_","_$S(%1]"":%1,1:V),1:""),V=$ZC(%SETUCI,U,V) 40: Q Y 41: ; 42: PRIORITY ; 43: Q:X>10!(X<1) S X=(X+1)\2-1,Y=$ZC(%SETPRI,X) Q 44: ; 45: PRIINQ() ; 46: Q $ZC(%GETJPI,0,"PRIB")*2+2 47: ; 48: BAUD ;S X="UNKNOWN" Q 49: Q 50: ; 51: LGR() Q $ZR ;Last global ref. 52: ; 53: EC() Q $ZE ;Error code 54: ; 55: DOLRO ;SAVE ENTIRE SYMBOL TABLE IN LOCATION SPECIFIED BY X 56: S Y="%" F S Y=$ZSORT(@Y) Q:Y="" D ;code from DEC 57: . I $D(@Y)#2 S @(X_"Y)="_Y) 58: . I $D(@Y)>9 S %X=Y_"(",%Y=X_"Y," D %XY^%RCR 59: K %X,%Y,Y Q 60: ; 61: ORDER ;SAVE PARTS OF SYMBOL TABLE IN LOCATION SPECIFIED BY X 62: ;PARTS INDICATED BY X1("NAMESPACE*")="" ARRAY 63: I $D(X1("*"))#2 D DOLRO Q 64: S X1="" F S X1=$O(X1(X1)) Q:X1="" D 65: . S (Y,Y1)=$P(X1,"*") I $D(@Y)=0 F S Y=$ZSORT(@Y) Q:Y=""!(Y[Y1) 66: . Q:Y="" S %=$D(@Y) S:%#2 @(X_"Y)="_Y) I %>9 S %X=Y_"(",%Y=X_"Y," D %XY^%RCR 67: . F S Y=$ZSORT(@Y) Q:Y=""!(Y'[Y1) S %=$D(@Y) S:%#2 @(X_"Y)="_Y) I %>9 S %X=Y_"(",%Y=X_"Y," D %XY^%RCR 68: . Q 69: K %,%X,%Y,Y,Y1 Q 70: ; 71: PARSIZ ; 72: S X=3 Q 73: ; 74: NOLOG ; 75: S Y=0 Q 76: ; 77: DEVOPN G DEVOPN^%ZOSV1 78: DEVOK G DEVOK^%ZOSV1 79: RES G RES^%ZOSV1 80: ; 81: GETENV ;Get environment Return Y='UCI^VOL/DIR^NODE^BOX LOOKUP' 82: S Y=$P($ZU(0),",",1)_"^"_$P($ZU(0),",",2)_"^"_$P($ZC(%GETSYI),",",4) 83: S $P(Y,"^",4)=$P(Y,"^",2)_":"_$P(Y,"^",3) Q 84: SETENV ;Set environment X='PROCESS NAME^ ' 85: S %=$ZC(%SETPRN,$P(X,"^")) Q 86: ; 87: ZHDIF ;Display dif of two $ZH's 88: W !," CPU=",$J($P(%ZH1,",")-$P(%ZH0,","),6,2),?14," ET=",$J($P(%ZH1,",",2)-$P(%ZH0,",",2),6,1),?27," DIO=",$J($P(%ZH1,",",7)-$P(%ZH0,",",7),5),?40," BIO=",$J($P(%ZH1,",",8)-$P(%ZH0,",",8),5),! Q 89: LOGRSRC(OPT) ;record resource usage in ^XUCP 90: N C,H,U S C=",",U="^",%=$ZH,H=$P(%,C,3) S:$E($ZV,10,12)>5.1 H=$E(H,13,23) S H=$P($H,C)_C_($P(H,":")*3600+($P(H,":",2)*60)+$P(H,":",3)) 91: S ^XUCP($P($ZC(%GETSYI),C,4),$P(H,C),$J,$P(H,C,2))=$P(%,C)_U_$P(%,C,7)_U_$P(%,C,8)_U_$P(%,C,4)_U_OPT_U_$P(%,C,3) Q 92: ; 93: SETTRM(X) ;Turn on specified terminators. 94: U $I:TERM=X 95: Q 1