source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DDSMSG.m@ 837

Last change on this file since 837 was 613, checked in by George Lilly, 15 years ago

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