Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMTEXT.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMTEXT.m
r613 r623 1 PXRMTEXT ; SLC/PKR - Text formatting utility routines. ;07/19/2007 2 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123 3 ; 4 ;============================================ 5 NEWLINE ;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 ;============================================ 17 BLANK ;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 ;============================================ 23 CHECKLEN(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 ;============================================ 37 COLFMT(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 ;============================================ 77 COLFMTA(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 ;============================================ 115 FORMAT(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 ;============================================ 166 FORMATS(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 ;============================================ 174 LMFMTSTR(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 ; 1 PXRMTEXT ; SLC/PKR - Text formatting utility routines. ;11/03/2004 2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005 3 ; 4 ;================================================================ 5 NEWLINE ;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 ;================================================================ 17 BLANK ;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 ;================================================================ 23 CHECKLEN(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 ;================================================================ 37 FORMAT(LM,RM,NIN,TEXTIN,NOUT,TEXTOUT) ;Format the text in TEXTIN so it has 38 ;a left margin of LM and a right margin of RM. The formatted text 39 ;is in TEXTOUT. "\\" is the end of line marker. Lines ending with 40 ;"\\" will not have anything appended to them. A blank line can 41 ;be created by creating a line containing just "\\". Lines containing 42 ;nothing but whitespace will also act like a "\\". 43 I NIN=0 S NOUT=0 Q 44 N ACHAR,ALLWSP,CHAR,CLEN,END,IND,INDENT,INDSTR,JND 45 N LWSP,NWSP,START,TEMP,TEXT,TLEN,WIDTH,W1,W2,WORD 46 ;Catalog the whitespace so we have places to break and look for 47 ;end of line markers. 48 F IND=1:1:NIN D 49 . S TEMP=TEXTIN(IND) 50 . S TLEN=$L(TEMP) 51 . S ALLWSP=1,NWSP=0 52 . F JND=1:1:TLEN D 53 .. S CHAR=$E(TEMP,JND) 54 .. S ACHAR=$A(CHAR) 55 .. I ACHAR>32 S ALLWSP=0 56 .. E S NWSP=NWSP+1,LWSP(IND,NWSP)=JND 57 .;Mark the end of the line. 58 . S NWSP=NWSP+1,LWSP(IND,NWSP)=TLEN,LWSP(IND)=NWSP 59 . I ALLWSP S LWSP(IND,"ALLWSP")="" 60 I LM<1 S LM=1 61 S WIDTH=RM-LM+1 62 S INDENT=LM-1 63 S INDSTR="" 64 F IND=1:1:INDENT S INDSTR=INDSTR_" " 65 S NOUT=0 66 S TEXT=INDSTR,CLEN=0 67 F IND=1:1:NIN D 68 .;If there is a blank line force whatever is in TEXT to be output by 69 .;calling NEWLINE and then add the blank. 70 . I $D(LWSP(IND,"ALLWSP")) D NEWLINE,BLANK Q 71 . S TEMP=TEXTIN(IND) 72 . S (END,NWSP)=0 73 . F NWSP=1:1:LWSP(IND) D 74 .. S START=END+1,END=LWSP(IND,NWSP) 75 .. S WORD=$E(TEMP,START,END) 76 .. I WORD["\\" D Q 77 ... S W1=$P(WORD,"\\",1) 78 ... D CHECKLEN(W1) 79 ... D NEWLINE 80 ... S W2=$P(WORD,"\\",2) 81 ... I W2'="" D CHECKLEN(W2) 82 .. D CHECKLEN(WORD) 83 ;Output the last line. 84 D NEWLINE 85 Q 86 ; 87 ;================================================================ 88 FORMATS(LM,RM,TEXTLINE,NOUT,TEXTOUT) ;Take a single line of input text 89 ;and format it. 90 N TEXTIN 91 S TEXTIN(1)=TEXTLINE 92 D FORMAT(LM,RM,1,.TEXTIN,.NOUT,.TEXTOUT) 93 Q 94 ;
Note:
See TracChangeset
for help on using the changeset viewer.
