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

    1: DDSMSG	;SFISC/MKO-PRINT MESSAGES ;02:44 PM  9 Nov 1994
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	;
    5: ERR	;Print "DIERR" messages in help box
    6: 	N DDSE,DDSL,DDSLMT,DDSN
    7: 	K DDH,DDQ
    8: 	S DDSLMT=$G(DDC,15),DDSE=0
    9: 	;
   10: 	W $C(7)
   11: 	S DDSN=0
   12: 	F  S DDSN=$O(^TMP("DIERR",$J,DDSN)) Q:'DDSN!DDSE  D
   13: 	. S DDSL=0
   14: 	. F  S DDSL=$O(^TMP("DIERR",$J,DDSN,"TEXT",DDSL)) Q:'DDSL!DDSE  D
   15: 	.. D LD($G(^TMP("DIERR",$J,DDSN,"TEXT",DDSL)),"!")
   16: 	.. I DDH'<DDSLMT D SC^DDSU S:$D(DTOUT)!($D(DUOUT)) DDSE=1
   17: 	;
   18: 	I $G(DDH) S:DDH(1,"T")?1.C DDH(1,"T")="" D SC^DDSU
   19: 	S DDSKM=1
   20: 	K DIERR,^TMP("DIERR",$J)
   21: 	Q
   22: 	;
   23: HLP(DDSG)	;Print messages from @DDSG in help area
   24: 	N DDSE,DDSL,DDSLMT,DDST
   25: 	S:$G(DDSG)="" DDSG=$NA(@DDSREFT@("HLP"))
   26: 	;
   27: 	K DDH
   28: 	I $D(DDSID),DY-1>DDSHBX!$X D SETDDH
   29: 	S DDSLMT=$G(DDC,15),(DDSE,DDSL)=0
   30: 	;
   31: 	F  S DDSL=$O(@DDSG@(DDSL)) Q:'DDSL!DDSE  D
   32: 	. S DDST=$G(@DDSG@(DDSL))
   33: 	. I DDST="$$EOP" S DDH=$G(DDH)+1,DDH(DDH,"E")=""
   34: 	. E  D LD(DDST,$G(@DDSG@(DDSL,"F"),"!"))
   35: 	. I DDH'<DDSLMT D SC^DDSU S:$D(DTOUT)!($D(DUOUT)) DDSE=1
   36: 	;
   37: 	I $G(DDH) S:DDH(1,"T")?1.C DDH(1,"T")="" D SC^DDSU
   38: 	K:DDSG=$NA(@DDSREFT@("HLP")) @DDSG
   39: 	S:'$D(DDSID) DDSKM=1
   40: 	Q
   41: 	;
   42: WP(DDSR)	;Print the contents of a wp field @DDSR in help area
   43: 	N DDSE,DDSL,DDSLMT
   44: 	;
   45: 	K DDH
   46: 	I $D(DDSID),DY-1>DDSHBX!$X D SETDDH
   47: 	S DDSLMT=$G(DDC,15),(DDSE,DDSL)=0
   48: 	;
   49: 	F  S DDSL=$O(@DDSR@(DDSL)) Q:'DDSL!DDSE  D
   50: 	. D LD($G(@DDSR@(DDSL,0)),$G(@DDSR@(DDSL,"F"),"!"))
   51: 	. I DDH'<DDSLMT D SC^DDSU S:$D(DTOUT)!($D(DUOUT)) DDSE=1
   52: 	;
   53: 	I $G(DDH) S:DDH(1,"T")?1.C DDH(1,"T")="" D SC^DDSU
   54: 	S:'$D(DDSID) DDSKM=1
   55: 	Q
   56: 	;
   57: MSG(DDSMSG,DDSFLG,DDSFMT)	;Print local var or array DDSMSG in help area
   58: 	;DDSFLG [ 1 : Write bell
   59: 	;DDSFMT : Format if one line is sent
   60: 	N DDSL
   61: 	K DDH
   62: 	I $D(DDSID),DY-1>DDSHBX!$X D SETDDH
   63: 	;
   64: 	I $D(DDSMSG)=1 D
   65: 	. D LD(DDSMSG,$S($G(DDSFMT)]"":DDSFMT,1:"!"))
   66: 	;
   67: 	E  S DDSL=0 F  S DDSL=$O(DDSMSG(DDSL)) Q:'DDSL  D
   68: 	. D LD($G(DDSMSG(DDSL)),$G(DDSMSG(DDSL,"F"),"!"))
   69: 	Q:'$G(DDH)
   70: 	;
   71: 	I $G(DDH) D
   72: 	. S:DDH(1,"T")?1.C DDH(1,"T")=""
   73: 	. S:$G(DDSFLG)[1 DDH(1,"T")=$C(7)_DDH(1,"T")
   74: 	. D SC^DDSU
   75: 	S:'$D(DDSID) DDSKM=1
   76: 	Q
   77: 	;
   78: SETDDH	;Setup DDH and DDQ for identifiers and executable help
   79: 	;that called EN^DDIOL
   80: 	S DDH=1
   81: 	S DDH(1,"T")=$TR($J("",$X)," ",$C(0))
   82: 	S DDQ=$S(DY>(IOSL-1):IOSL-1,1:DY)-1_U_$X
   83: 	Q
   84: 	;
   85: LD(S,F)	;Load string S with format F into DDH array
   86: 	N A,C,J,L
   87: 	S DDH=+$G(DDH)
   88: 	F J=1:1:$L(F,"!")-1 S DDH=DDH+1,DDH(DDH,"T")=""
   89: 	S:'DDH DDH=1
   90: 	S:F["?" @("C="_$P(F,"?",2))
   91: 	S L=$G(DDH(DDH,"T"))
   92: 	S S=L_$J("",$G(C)-$L(L))_S
   93: 	;
   94: 	D WRAP(S,.A,IOM-1)
   95: 	S DDH=DDH-1
   96: 	F A=1:1:A S DDH=$G(DDH)+1,DDH(DDH,"T")=A(A)
   97: 	Q
   98: 	;
   99: WRAP(L,A,M)	;Wrap line at word boundaries
  100: 	; L    = Line of text
  101: 	; M    = Margin width
  102: 	;Return:
  103: 	; A    = Number of lines
  104: 	; A(n) = Array of text
  105: 	;
  106: 	S:'$G(M) M=$S($G(IOM):IOM-5,1:75)
  107: 	N I,N
  108: 	S N=0
  109: 	F I=$L(L," "):-1:1 D  Q:L=""
  110: 	. I I=1 S N=N+1,A(N)=$E(L,1,M),L=$E(L,M+1,999) Q
  111: 	. I $L($P(L," ",1,I))'>M D
  112: 	.. S N=N+1,A(N)=$P(L," ",1,I),L=$P(L," ",I+1,999)
  113: 	S A=N
  114: 	Q

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>