Return to DDBRU.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DDBRU.m, revision 1.1

1.1     ! snw         1: DDBRU  ;SFISC/DCL-BROWSER UTILITIES AND EXTRINSIC FUNCTIONS ;09:47 AM  1 Dec 1994;
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4: CTRLCH()       ;Extrinsic function - returns control characters 1-31
        !             5:        N I,X S X="" N I F I=1:1:31 S X=X_$C(I)
        !             6:        Q X
        !             7:        ;
        !             8: COL(DDBC)      ;Set up colums used by Fileman Print Set DIOEND="D COL^DDBRU()" when calling Browser
        !             9:        N H,I,P,Q,T,X
        !            10:        S DDBC=$G(DDBC,"^TMP(""DDBC"",$J)")
        !            11:        I $D(^TMP("DDBC",$J)) K ^($J)
        !            12:        S X=0 F  S X=$O(^UTILITY($J,99,X)) Q:X'>0  S T=^(X) D
        !            13:        .S:T["D ^" H=$P(T,"^",2)
        !            14:        .S Q=$L(T,"?") I Q>1 F I=1:1:Q S P=+$P(T,"?",I)+1 S @DDBC@(P)=""
        !            15:        .Q
        !            16:        I $G(H)]""  F X=1:1 S T=$T(@"HEAD"+X^@H) Q:T=""  D
        !            17:        .S Q=$L(T,"?") I Q>1 F I=1:1:Q S P=+$P(T,"?",I)+1 S @DDBC@(P)=""
        !            18:        .Q
        !            19:        Q
        !            20:        ;
        !            21: KTMP   K ^TMP("DDB",$J),^TMP("DDBC",$J)
        !            22:        K ^TMP("DDBLST",$J)
        !            23:        Q
        !            24:        ;
        !            25: TRMERR(DDGLCH) ;Terminal type errors
        !            26:        N P
        !            27:        S P(1)=DDGLCH,P(2)=IOST
        !            28:        D BLD^DIALOG(842,.P)
        !            29:        Q
        !            30:        ;
        !            31: RTN(RTN,TMPGBL)        ;
        !            32:        N I,F,X
        !            33:        F I=1:1 S X=$T(+I^@RTN) Q:X=""  S F=$F(X," ")-1,$E(X,F)=$E("        ",1,$S(F'>8:8-F,1:1)),@TMPGBL@(I)=$TR(X,$C(9)," ")
        !            34:        Q
        !            35:        ;
        !            36: RTNTB(DDBRTOP,DDBRBOT) ;PASS TOP AND BOTTOM MARGINS
        !            37:        G DR
        !            38:        ;
        !            39: ENDR   N DDBENDR S DDBENDR=1
        !            40:        ;
        !            41: DR     ;Display Routine(s)
        !            42:        N DESC,RN,RSA,RTN,X,Y
        !            43:        K ^TMP($J,"DDBDR"),^TMP($J,"DDBDRL"),^UTILITY($J)  ;DR LIST
        !            44:        X ^%ZOSF("RSEL") Q:$O(^UTILITY($J,""))']""
        !            45:        S RTN="",RN=1 F  S RTN=$O(^UTILITY($J,RTN)) Q:RTN=""  D
        !            46:        .S DESC=$P($P($T(+1^@RTN),";",2),"-",2),DESC=$S($L(DESC)>45:$E(DESC,1,45)_"...",1:DESC)
        !            47:        .S RSA=$NA(^TMP($J,"DDBDR",RN)),RN=RN+1,^TMP($J,"DDBDRL",RTN_$E("        ",1,8-$L(RTN))_": "_DESC)=RSA
        !            48:        .W !,"...loading ",RTN
        !            49:        .D RTN^DDBRU(RTN,RSA)
        !            50:        .Q
        !            51:        W !,"...building ""Current List"" tables"
        !            52:        D DOCLIST^DDBR("^TMP($J,""DDBDRL"")","",$G(DDBRTOP),$G(DDBRBOT))
        !            53: K      K ^TMP($J,"DDBDRL"),^TMP($J,"DDBDR"),^UTILITY($J)
        !            54:        Q
        !            55:        ;
        !            56: OUT    ;
        !            57:        D:'$D(DDS) KILL^DDGLIB0($G(DDBFLG))
        !            58:        D:$G(DDBFLG)'["P" KTMP
        !            59:        Q
        !            60:        ;
        !            61: RE(DDBRTN)     G EDIT
        !            62: RTNEDIT        N DDBRTN
        !            63: EDIT   ;ROUTINE EDIT VIA VA FILEMAN SCREEN EDITOR
        !            64:        ;EITHER PASS ROUTINE NAME RE^DDBRU("ROUTINE_NAME") OR USE
        !            65:        ;RTNEDIT^DDBRU AND BE PROMPTED FOR ROUTINE NAME
        !            66:        I '$D(^DD("OS",^DD("OS"),"ZS")) W !,"ROUTINE SAVE NODE NOT DEFINED IN MUMPS OPERATING SYSTEM FILE",! Q
        !            67:        N DDBRI,DDBRX,X,Y,%,%X,%Y
        !            68:        I $G(DDBRTN)]"" S X=DDBRTN X ^%ZOSF("TEST") I '$T W !,DDBRTN," Invalid",!
        !            69:        X ^%ZOSF("EON")
        !            70:        R:$G(DDBRTN)="" !,"Enter Routine> ",DDBRTN:DTIME
        !            71:        I DDBRTN="" W !,"NO ROUTINE SELECTED",! Q
        !            72:        S X=DDBRTN X ^%ZOSF("TEST")
        !            73:        I '$T W !,"NO SUCH ROUTINE",! Q
        !            74:        K ^TMP("DDBRTN",$J)
        !            75:        W !,"Loading ",DDBRTN
        !            76:        F DDBRI=1:1 S DDBRX=$T(+DDBRI^@DDBRTN) Q:DDBRX=""  S ^TMP("DDBRTN",$J,DDBRI)=$$SP(DDBRX)
        !            77:        D EDIT^DDW("^TMP(""DDBRTN"",$J)","M",DDBRTN,"Routine: "_DDBRTN)
        !            78:        K ^UTILITY($J,0)
        !            79:        S DDBRI=0,$P(^TMP("DDBRTN",$J,1),";",3)=$$NOW
        !            80:        F  S DDBRI=$O(^TMP("DDBRTN",$J,DDBRI)) Q:DDBRI'>0  S ^UTILITY($J,0,DDBRI)=$$TAB(^(DDBRI))
        !            81:        S X=DDBRTN
        !            82:        X ^DD("OS",^DD("OS"),"ZS")
        !            83:        K ^TMP("DDBRTN",$J),^UTILITY($J,0)
        !            84:        X ^%ZOSF("EON")
        !            85:        Q
        !            86: TAB(X) ;CONVERT 1ST SPACE TO TAB IF NO TAB
        !            87:        N E,L,T
        !            88:        S X=$G(X)
        !            89:        Q:X="" ""
        !            90:        S T=$C(9)
        !            91:        Q:$E(X)=T X
        !            92:        S L=$L(X)
        !            93:        F E=1:1:L Q:$E(X,E)=T  I $E(X,E)=" " S $E(X,E)=T D  Q
        !            94:        .S E=E+1
        !            95:        .F  Q:$E(X,E)'=" "  S $E(X,E)=""
        !            96:        .Q
        !            97:        Q X
        !            98:        ;
        !            99: SP(X)  ;MAKE SURE A TAB OR 1ST SPACE IS SET TO SPACES
        !           100:        N E,L,S,SPS,T
        !           101:        S X=$G(X)
        !           102:        Q:X="" ""
        !           103:        S S=8,$P(SPS," ",S)=" ",T=$E(9)
        !           104:        I $E(X)=T S $E(X)=" "  ;Q "       "_X
        !           105:        S L=$L(X)
        !           106:        F E=1:1:L I $E(X,E)=" " D  S $E(X,E)=$E(SPS,1,S-(E#S)) Q
        !           107:        .S E=E+1
        !           108:        .F  Q:$E(X,E)'=" "  S $E(X,E)=""
        !           109:        .S E=E-1
        !           110:        .Q
        !           111:        Q X
        !           112:        ;
        !           113: NOW()  ;
        !           114:        N %DT,X,Y
        !           115:        S %DT="T",X="NOW"
        !           116:        D ^%DT
        !           117:        Q $$FMTE^DILIBF(Y,"1U")
        !           118:        ;
        !           119: MSMCON ;MSM CONSOLE FOR 132/80 MODES
        !           120:        ;OR VT TERMINALS
        !           121: 80     W *27,"[?",3,*108
        !           122:        S (IOM,X)=80 X ^%ZOSF("RM")
        !           123:        Q
        !           124: 132    W *27,"[?",3,*104
        !           125:        S (IOM,X)=132 X ^%ZOSF("RM")
        !           126:        Q