source: FOIAVistA/tag/r/CLINICAL_REMINDERS-PXRM/PXRMTEXT.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version

File size: 6.5 KB
Line 
1PXRMTEXT ; SLC/PKR - Text formatting utility routines. ;07/19/2007
2 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
3 ;
4 ;============================================
5NEWLINE ;Put TEXT on a new line to the output, make sure it does not end
6 ;with a " ".
7 N TLEN
8 ;If there is no text in TEXT don't do anything.
9 I TEXT=INDSTR Q
10 S TLEN=$L(TEXT)
11 I $E(TEXT,TLEN)=" " S TEXT=$E(TEXT,1,TLEN-1)
12 S NOUT=NOUT+1,TEXTOUT(NOUT)=TEXT
13 S TEXT=INDSTR,CLEN=0
14 Q
15 ;
16 ;============================================
17BLANK ;Add a blank line (line containing just " ") to the output.
18 S NOUT=NOUT+1,TEXTOUT(NOUT)=" "
19 S TEXT=INDSTR,CLEN=0
20 Q
21 ;
22 ;============================================
23CHECKLEN(WORD) ;Check to see if adding the next word makes the line too long.
24 ;If it does add it to the output and start a new line.
25 N LENWORD
26 S LENWORD=$L(WORD)
27 I (CLEN+LENWORD)>WIDTH D
28 . D NEWLINE
29 . I WORD'[" " S WORD=WORD_" ",LENWORD=LENWORD+1
30 . S TEXT=INDSTR_WORD,CLEN=LENWORD
31 E D
32 . I WORD'[" " S WORD=WORD_" ",LENWORD=LENWORD+1
33 . S TEXT=TEXT_WORD,CLEN=CLEN+LENWORD
34 Q
35 ;
36 ;============================================
37COLFMT(FMTSTR,TEXTSTR,PC,NL,OUTPUT) ;Columnar text formatter.
38 ;FMTSTR - format string; ^ separated string for each column in the
39 ;output. 35R2 defines a right justified column 35 characters wide
40 ;with 2 blank spaces following. Columns can be centered (C) left
41 ;justified (L) or right justified (R).
42 ;TEXTSTR - string to be formated
43 ;PC - the pad character
44 ;NL - number of lines of output
45 ;OUTPUT - array containing output lines.
46 N COLOUT,ENTRY,FMT,JND,JUS,IND,LEN,NCOL,NLO,NROW,SP,TEMP,TEXT,WIDTH,WPSP
47 S NCOL=$L(FMTSTR,U),NROW=1
48 F IND=1:1:NCOL D
49 . S FMT=$P(FMTSTR,U,IND)
50 . S JUS(IND)=$S(FMT["C":"C",FMT["L":"L",FMT["R":"R",1:"C")
51 . S WIDTH(IND)=$P(FMT,JUS(IND),1)
52 . S SP(IND)=$P(FMT,JUS(IND),2)
53 . S WPSP(IND)=WIDTH(IND)+SP(IND)
54 F IND=1:1:NCOL D
55 . S ENTRY=$S(JUS(IND)="C":"CJ",JUS(IND)="L":"LJ",JUS(IND)="R":"RJ")
56 . S TEMP=$P(TEXTSTR,U,IND)
57 . S LEN=$L(TEMP)
58 . I LEN'>WIDTH(IND) D
59 .. S TEMP=$$@ENTRY^XLFSTR(TEMP,WIDTH(IND),PC)
60 .. S COLOUT(1,IND)=TEMP_$$LJ^XLFSTR("",SP(IND)," ")
61 . I LEN>WIDTH(IND) D
62 .. D FORMATS(1,WIDTH(IND),TEMP,.NLO,.TEXTOUT)
63 .. F JND=1:1:NLO D
64 ... S TEMP=$$@ENTRY^XLFSTR(TEXTOUT(JND),WIDTH(IND),PC)
65 ... S COLOUT(JND,IND)=TEMP_$$LJ^XLFSTR("",SP(IND)," ")
66 .. I NLO>NROW S NROW=NLO
67 F IND=1:1:NROW D
68 . S TEXT=""
69 . F JND=1:1:NCOL D
70 .. I $D(COLOUT(IND,JND)) S TEXT=TEXT_COLOUT(IND,JND)
71 .. E S TEXT=TEXT_$$LJ^XLFSTR("",(WPSP(JND))," ")
72 . S OUTPUT(IND)=TEXT
73 S NL=NROW
74 Q
75 ;
76 ;============================================
77COLFMTA(FMTSTR,INPUT,PC,NL,OUTPUT) ;Columnar text formatter.
78 ;Array version of COLFMT. Input array is ^TMP($J,INPUT,M) and
79 ;output is ^TMP(OUTPUT,$J,N,0).
80 N COLOUT,ENTRY,FMT,JND,JUS,IND,LEN,NCOL,NLO,NROW,NUM
81 N SP,TEMP,TEXT,WIDTH,WPSP
82 S NCOL=$L(FMTSTR,U)
83 F IND=1:1:NCOL D
84 . S FMT=$P(FMTSTR,U,IND)
85 . S JUS(IND)=$S(FMT["C":"C",FMT["L":"L",FMT["R":"R",1:"C")
86 . S WIDTH(IND)=$P(FMT,JUS(IND),1)
87 . S SP(IND)=$P(FMT,JUS(IND),2)
88 . S WPSP(IND)=WIDTH(IND)+SP(IND)
89 S NL=0,NUM=""
90 F S NUM=$O(^TMP($J,INPUT,NUM)) Q:NUM="" D
91 . K COLOUT
92 . S NROW=1
93 . F IND=1:1:NCOL D
94 .. S ENTRY=$S(JUS(IND)="C":"CJ",JUS(IND)="L":"LJ",JUS(IND)="R":"RJ")
95 .. S TEMP=$P(^TMP($J,INPUT,NUM),U,IND)
96 .. S LEN=$L(TEMP)
97 .. I LEN'>WIDTH(IND) D
98 ... S TEMP=$$@ENTRY^XLFSTR(TEMP,WIDTH(IND),PC)
99 ... S COLOUT(1,IND)=TEMP_$$LJ^XLFSTR("",SP(IND)," ")
100 .. I LEN>WIDTH(IND) D
101 ... D FORMATS(1,WIDTH(IND),TEMP,.NLO,.TEXTOUT)
102 ... F JND=1:1:NLO D
103 .... S TEMP=$$@ENTRY^XLFSTR(TEXTOUT(JND),WIDTH(IND),PC)
104 .... S COLOUT(JND,IND)=TEMP_$$LJ^XLFSTR("",SP(IND)," ")
105 ... I NLO>NROW S NROW=NLO
106 . F IND=1:1:NROW D
107 .. S TEXT=""
108 .. F JND=1:1:NCOL D
109 ... I $D(COLOUT(IND,JND)) S TEXT=TEXT_COLOUT(IND,JND)
110 ... E S TEXT=TEXT_$$LJ^XLFSTR("",(WPSP(JND))," ")
111 .. S NL=NL+1,^TMP(OUTPUT,$J,NL,0)=TEXT
112 Q
113 ;
114 ;============================================
115FORMAT(LM,RM,NIN,TEXTIN,NOUT,TEXTOUT) ;Format the text in TEXTIN so it has
116 ;a left margin of LM and a right margin of RM. The formatted text
117 ;is in TEXTOUT. "\\" is the end of line marker. Lines ending with
118 ;"\\" will not have anything appended to them. A blank line can
119 ;be created by creating a line containing just "\\". Lines containing
120 ;nothing but whitespace will also act like a "\\".
121 I NIN=0 S NOUT=0 Q
122 N ACHAR,ALLWSP,CHAR,CLEN,END,IND,INDENT,INDSTR,JND
123 N LWSP,NWSP,START,TEMP,TEXT,TLEN,WIDTH,W1,W2,WORD
124 ;Catalog the whitespace so we have places to break and look for
125 ;end of line markers.
126 F IND=1:1:NIN D
127 . S TEMP=TEXTIN(IND)
128 . S TLEN=$L(TEMP)
129 . S ALLWSP=1,NWSP=0
130 . F JND=1:1:TLEN D
131 .. S CHAR=$E(TEMP,JND)
132 .. S ACHAR=$A(CHAR)
133 .. I ACHAR>32 S ALLWSP=0
134 .. E S NWSP=NWSP+1,LWSP(IND,NWSP)=JND
135 .;Mark the end of the line.
136 . S NWSP=NWSP+1,LWSP(IND,NWSP)=TLEN,LWSP(IND)=NWSP
137 . I ALLWSP S LWSP(IND,"ALLWSP")=""
138 I LM<1 S LM=1
139 S WIDTH=RM-LM+1
140 S INDENT=LM-1
141 S INDSTR=""
142 F IND=1:1:INDENT S INDSTR=INDSTR_" "
143 S NOUT=0
144 S TEXT=INDSTR,CLEN=0
145 F IND=1:1:NIN D
146 .;If there is a blank line force whatever is in TEXT to be output by
147 .;calling NEWLINE and then add the blank.
148 . I $D(LWSP(IND,"ALLWSP")) D NEWLINE,BLANK Q
149 . S TEMP=TEXTIN(IND)
150 . S (END,NWSP)=0
151 . F NWSP=1:1:LWSP(IND) D
152 .. S START=END+1,END=LWSP(IND,NWSP)
153 .. S WORD=$E(TEMP,START,END)
154 .. I WORD["\\" D Q
155 ... S W1=$P(WORD,"\\",1)
156 ... D CHECKLEN(W1)
157 ... D NEWLINE
158 ... S W2=$P(WORD,"\\",2)
159 ... I W2'="" D CHECKLEN(W2)
160 .. D CHECKLEN(WORD)
161 ;Output the last line.
162 D NEWLINE
163 Q
164 ;
165 ;============================================
166FORMATS(LM,RM,TEXTLINE,NOUT,TEXTOUT) ;Take a single line of input text
167 ;and format it.
168 N TEXTIN
169 S TEXTIN(1)=TEXTLINE
170 D FORMAT(LM,RM,1,.TEXTIN,.NOUT,.TEXTOUT)
171 Q
172 ;
173 ;============================================
174LMFMTSTR(VALMDDF,JSTR) ;The List Manager variable VALMDDF contains the
175 ;list template caption column formatting information. It contains
176 ;the starting column and the width if the form
177 ;VALMDDF(COLUMN NAME)=COLUMN NAME^COLUMN^WIDTH^CAPTION^VIDEO^SCROLL
178 ;LOCK. JUSSTR, which is optional,is the justification for each column;
179 ;(L=left, C=center, R=right) the default is center. Use this information
180 ;to build the format string for the column formatter COLFMT.
181 N CN,COL,FMTSTR,IND,JC,JUSSTR,PLCOL,SCOL,SP,TEMP,WIDTH
182 ;Sort by columns
183 S IND=""
184 F S IND=$O(VALMDDF(IND)) Q:IND="" D
185 . S TEMP=VALMDDF(IND)
186 . S COL($P(TEMP,U,2))=$P(TEMP,U,3)
187 S JUSSTR=$G(JSTR)
188 S (CN,PLCOL,SCOL,SP)=0
189 S FMTSTR=""
190 S SCOL=0
191 F S SCOL=$O(COL(SCOL)) Q:SCOL="" D
192 . S CN=CN+1
193 . S WIDTH=COL(SCOL)
194 . I CN=1 S PLCOL=WIDTH
195 . E S SP=SCOL-PLCOL-1,FMTSTR=FMTSTR_SP_U,PLCOL=SCOL+WIDTH-1
196 . S JC=$E(JUSSTR,CN)
197 . I JC="" S JC="C"
198 . S TEMP=WIDTH_JC
199 . S FMTSTR=FMTSTR_TEMP
200 Q FMTSTR
201 ;
Note: See TracBrowser for help on using the repository browser.