Return to DDBRU.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    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