Return to DINVVXD.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DINVVXD.m, revision 1.1

1.1     ! snw         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