[796] | 1 | TMGSTUTL ;TMG/kst/String Utilities and Library ;03/25/06
|
---|
| 2 | ;;1.0;TMG-LIB;**1**;09/01/05
|
---|
| 3 |
|
---|
| 4 | ;"TMG STRING UTILITIES
|
---|
| 5 |
|
---|
| 6 | ;"=======================================================================
|
---|
| 7 | ;" API -- Public Functions.
|
---|
| 8 | ;"=======================================================================
|
---|
| 9 | ;"CleaveToArray^TMGSTUTL(Text,Divider,Array)
|
---|
| 10 | ;"CatArray(Words,i1,i2,DivChr) -- return concat array from index1 to index2
|
---|
| 11 | ;"CleaveStr^TMGSTUTL(Text,Divider,PartB)
|
---|
| 12 | ;"SplitStr^TMGSTUTL(Text,Width,PartB)
|
---|
| 13 | ;"SetStrLen^TMGSTUTL(Text,Width)
|
---|
| 14 | ;"$$NestSplit^TMGSTUTL(Text,OpenBracket,CloseBracket,SBefore,S,SAfter)
|
---|
| 15 | ;"$$Substitute^TMGSTUTL(S,Match,NewValue)
|
---|
| 16 | ;"$$FormatArray^TMGSTUTL(InArray,OutArray,Divider)
|
---|
| 17 | ;"$$Trim^TMGSTUTL(S,TrimCh) ; --> or use $$TRIM^XLFSTR
|
---|
| 18 | ;"$$TrimL^TMGSTUTL(S,TrimCh)
|
---|
| 19 | ;"$$TrimR^TMGSTUTL(S,TrimCh)
|
---|
| 20 | ;"$$TrimRType^TMGSTUTL(S,type)
|
---|
| 21 | ;"$$NumLWS^TMGSTUTL(S)
|
---|
| 22 | ;"$$MakeWS^TMGSTUTL(n)
|
---|
| 23 | ;"WordWrapArray^TMGSTUTL(.Array,Width,SpecialIndent)
|
---|
| 24 | ;"SplitLine^TMGSTUTL(s,.LineArray,Width)
|
---|
| 25 | ;"WriteWP^TMGSTUTL(NodeRef)
|
---|
| 26 | ;"$$LPad^TMGSTUTL(S,width) ;"NOTE: should use XLFSTR fn below
|
---|
| 27 | ;"$$RPad^TMGSTUTL(S,width) ;"NOTE: should use XLFSTR fn below
|
---|
| 28 | ;"$$Center^TMGSTUTL(S,width) ;"NOTE: should use XLFSTR fn below
|
---|
| 29 | ;"$$Clip^TMGSTUTL(S,width)
|
---|
| 30 | ;"$$STRB2H^TMGSTUTL(s,F) Convert a string to hex characters
|
---|
| 31 | ;"$$CapWords^TMGSTUTL(S,Divider) ;"capitalize the first character of each word in a string
|
---|
| 32 | ;"$$LinuxStr^TMGSTUTL(S) ;"Convert string to a valid linux filename
|
---|
| 33 | ;"StrToWP^TMGSTUTL(s,pArray,width,DivCh,InitLine) ;"wrap long string into a WP array
|
---|
| 34 | ;"$$WPToStr^TMGSTUTL(pArray,DivCh,MaxLen,InitLine)
|
---|
| 35 | ;"Comp2Strs(s1,s2) -- compare two strings and assign an arbritrary score to their similarity
|
---|
| 36 | ;"$$PosNum(s,[Num],LeadingSpace) -- return position of a number in a string
|
---|
| 37 | ;"IsNumeric(s) -- deterimine if word s is a numeric
|
---|
| 38 | ;"ScrubNumeric(s) -- remove numeric words from a sentence
|
---|
| 39 | ;"Pos(subStr,s,count) -- return the beginning position of subStr in s
|
---|
| 40 | ;"DiffPos(s1,s2) -- Return the position of the first difference between s1 and s2
|
---|
| 41 | ;"DiffWords(Words1,Words2) -- Return index of first different word between Words arrays
|
---|
| 42 | ;"SimStr(s1,p1,s2,p2) -- return matching string in s1 and s2, starting at position p1,p2
|
---|
| 43 | ;"SimWord(Words1,p1,Words2,p2) -- return the matching words in both words array 1 and 2, starting
|
---|
| 44 | ;" at word positions p1 and p2.
|
---|
| 45 | ;"SimPos(s1,s2) -- return the first position that two strings are similar.
|
---|
| 46 | ;"SimWPos(Words1,Words2,DivStr,p1,p2,MatchStr) -- return the first position that two word arrays
|
---|
| 47 | ;" are similar. This means the first index in Words array 1 that matches to words in Words array 2.
|
---|
| 48 | ;"DiffStr(s1,s2,DivChr) -- Return how s1 differs from s2.
|
---|
| 49 | ;"CatArray(Words,i1,i2,DivChr) -- return concat array from index1 to index2
|
---|
| 50 | ;"$$QtProtect(s) -- Protects quotes by converting all quotes do double quotes (" --> "")
|
---|
| 51 | ;"$$InQt(s,Pos) -- return if a character at position P is inside quotes in s
|
---|
| 52 | ;"$$GetWord(s,Pos,OpenDiv,CloseDiv) -- extract a word from a sentance, bounded by OpenDiv,CloseDiv
|
---|
| 53 | ;"$$CmdChStrip(s) -- Strips all characters < #32 from string.
|
---|
| 54 | ;"$$StrBounds(s,p) -- return position of end of string
|
---|
| 55 | ;"NonWhite(s,p) -- return index of first non-whitespace character
|
---|
| 56 | ;"Pad2Pos(Pos,ch) -- return a padding string from current $X up to Pos, using ch
|
---|
| 57 |
|
---|
| 58 | ;"=======================================================================
|
---|
| 59 | ;"Dependancies
|
---|
| 60 | ;" uses TMGDEBUG for debug messaging.
|
---|
| 61 | ;"=======================================================================
|
---|
| 62 | ;"=======================================================================
|
---|
| 63 |
|
---|
| 64 | ;"------------------------------------------------------------------------
|
---|
| 65 | ;"FYI, String functions in XLFSTR module:
|
---|
| 66 | ;"------------------------------------------------------------------------
|
---|
| 67 | ;"$$CJ^XLFSTR(s,i[,p]) -- Returns a center-justified string
|
---|
| 68 | ;" s=string, i=field size, p(optional)=pad character
|
---|
| 69 | ;"$$LJ^XLFSTR(s,i[,p]) -- Returns a left-justified string
|
---|
| 70 | ;" s=string, i=field size, p(optional)=pad character
|
---|
| 71 | ;"$$RJ^XLFSTR(s,i[,p]) -- Returns a right-justified string
|
---|
| 72 | ;" s=string, i=field size, p(optional)=pad character
|
---|
| 73 | ;"$$INVERT^XLFSTR(s) -- returns an inverted string (i.e. "ABC"-->"CBA")
|
---|
| 74 | ;"$$LOW^XLFSTR(s) -- returns string with all letters converted to lower-case
|
---|
| 75 | ;"$$UP^XLFSTR(s) -- returns string with all letters converted to upper-case
|
---|
| 76 | ;"$$TRIM^XLFSTR(s,[LRFlags],[char])
|
---|
| 77 | ;"$$REPEAT^XLFSTR(s,Count) -- returns a string that is a repeat of s Count times
|
---|
| 78 | ;"$$REPLACE^XLFSTR(s,.spec) -- Uses a multi-character $TRanslate to return a
|
---|
| 79 | ;" string with the specified string replaced
|
---|
| 80 | ;" s=input string, spec=array passed by reference
|
---|
| 81 | ;" spec format:
|
---|
| 82 | ;" spec("Any_Search_String")="Replacement_String"
|
---|
| 83 | ;"$$STRIP^XLFSTR(s,Char) -- returns string striped of all instances of Char
|
---|
| 84 |
|
---|
| 85 | ;"=======================================================================
|
---|
| 86 |
|
---|
| 87 | CleaveToArray(Text,Divider,Array,InitIndex)
|
---|
| 88 | ;"Purpose: To take a string, delineated by 'divider' and
|
---|
| 89 | ;" to split it up into all its parts, putting each part
|
---|
| 90 | ;" into an array. e.g.:
|
---|
| 91 | ;" This/Is/A/Test, with '/' divider would result in
|
---|
| 92 | ;" Array(1)="This"
|
---|
| 93 | ;" Array(2)="Is"
|
---|
| 94 | ;" Array(3)="A"
|
---|
| 95 | ;" Array(4)="Test"
|
---|
| 96 | ;" Array(cMaxNode)=4 ;cMaxNode="MAXNODE"
|
---|
| 97 | ;"Input: Text - the input string -- should NOT be passed by reference.
|
---|
| 98 | ;" Divider - the delineating string
|
---|
| 99 | ;" Array - The array to receive output **SHOULD BE PASSED BY REFERENCE.
|
---|
| 100 | ;" InitIndex - OPTIONAL -- The index of the array to start with, i.e. 0 or 1. Default=1
|
---|
| 101 | ;"Output: Array is changed, as outlined above
|
---|
| 102 | ;"Result: none
|
---|
| 103 | ;"Notes: Note -- Text is NOT changed (unless passed by reference, in
|
---|
| 104 | ;" which case the next to the last piece is put into Text)
|
---|
| 105 | ;" Array is killed, the filled with data **ONLY** IF DIVISIONS FOUND
|
---|
| 106 | ;" Limit of 256 nodes
|
---|
| 107 | ;" if cMaxNode is not defined, "MAXNODE" will be used
|
---|
| 108 |
|
---|
| 109 | set DBIndent=$get(DBIndent,0)
|
---|
| 110 | do DebugEntry^TMGDEBUG(.DBIndent,"CleaveToArray")
|
---|
| 111 |
|
---|
| 112 | set InitIndex=$get(InitIndex,1)
|
---|
| 113 | new PartB
|
---|
| 114 | new count set count=InitIndex
|
---|
| 115 | set cMaxNode=$get(cMaxNode,"MAXNODE")
|
---|
| 116 |
|
---|
| 117 | kill Array ;"Clear out any old data
|
---|
| 118 |
|
---|
| 119 | C2ArLoop
|
---|
| 120 | if '(Text[Divider) do goto C2ArDone
|
---|
| 121 | . set Array(count)=Text ;"put it all into first line.
|
---|
| 122 | . set Array(cMaxNode)=1
|
---|
| 123 | do CleaveStr(.Text,Divider,.PartB)
|
---|
| 124 | set Array(count)=Text
|
---|
| 125 | set Array(cMaxNode)=count
|
---|
| 126 | set count=count+1
|
---|
| 127 | if '(PartB[Divider) do goto C2ArDone
|
---|
| 128 | . set Array(count)=PartB
|
---|
| 129 | . set Array(cMaxNode)=count
|
---|
| 130 | else do goto C2ArLoop
|
---|
| 131 | . set Text=$get(PartB)
|
---|
| 132 | . set PartB=""
|
---|
| 133 |
|
---|
| 134 | C2ArDone
|
---|
| 135 | do DebugExit^TMGDEBUG(.DBIndent,"CleaveToArray")
|
---|
| 136 | quit
|
---|
| 137 |
|
---|
| 138 |
|
---|
| 139 | CleaveStr(Text,Divider,PartB)
|
---|
| 140 | ;"Purpse: To take a string, delineated by 'Divider'
|
---|
| 141 | ;" and to split it into two parts: Text and PartB
|
---|
| 142 | ;" e.g. Text="Hello\nThere"
|
---|
| 143 | ;" Divider="\n"
|
---|
| 144 | ;" Function will result in: Text="Hello", PartB="There"
|
---|
| 145 | ;"Input: Text - the input string **SHOULD BE PASSED BY REFERENCE.
|
---|
| 146 | ;" Divider - the delineating string
|
---|
| 147 | ;" PartB - the string to get second part **SHOULD BE PASSED BY REFERENCE.
|
---|
| 148 | ;"Output: Text and PartB will be changed
|
---|
| 149 | ;" Function will result in: Text="Hello", PartB="There"
|
---|
| 150 | ;"Result: none
|
---|
| 151 |
|
---|
| 152 | set DBIndent=$get(DBIndent,0)
|
---|
| 153 | do DebugEntry^TMGDEBUG(.DBIndent,"CleaveStr")
|
---|
| 154 |
|
---|
| 155 | do DebugMsg^TMGDEBUG(DBIndent,"Text=",Text)
|
---|
| 156 |
|
---|
| 157 | if '$data(Text) goto CSDone
|
---|
| 158 | if '$Data(Divider) goto CSDone
|
---|
| 159 | set PartB=""
|
---|
| 160 |
|
---|
| 161 | new PartA
|
---|
| 162 |
|
---|
| 163 | if Text[Divider do
|
---|
| 164 | . set PartA=$piece(Text,Divider,1)
|
---|
| 165 | . set PartB=$piece(Text,Divider,2,256)
|
---|
| 166 | . set Text=PartA
|
---|
| 167 |
|
---|
| 168 | do DebugMsg^TMGDEBUG(DBIndent,"After Processing, Text='",Text,"', and PartB='",PartB,"'")
|
---|
| 169 | CSDone
|
---|
| 170 | do DebugExit^TMGDEBUG(.DBIndent,"CleaveStr")
|
---|
| 171 | quit
|
---|
| 172 |
|
---|
| 173 |
|
---|
| 174 | SplitStr(Text,Width,PartB)
|
---|
| 175 | ;"PUBLIC FUNCTION
|
---|
| 176 | ;"Purpose: To a string into two parts. The first part will fit within 'Width'
|
---|
| 177 | ;" the second part is what is left over
|
---|
| 178 | ;" The split will be inteligent, so words are not divided (splits at a space)
|
---|
| 179 | ;"Input: Text = input text. **Should be passed by reference
|
---|
| 180 | ;" Width = the constraining width
|
---|
| 181 | ;" PartB = the left over part. **Should be passed by reference
|
---|
| 182 | ;"output: Text and PartB are modified
|
---|
| 183 | ;"result: none.
|
---|
| 184 |
|
---|
| 185 | new Len
|
---|
| 186 | set Width=$get(Width,80)
|
---|
| 187 | new SpaceFound set SpaceFound=0
|
---|
| 188 | new SplitPoint set SplitPoint=Width
|
---|
| 189 | set Text=$get(Text)
|
---|
| 190 | set PartB=""
|
---|
| 191 |
|
---|
| 192 | set Len=$length(Text)
|
---|
| 193 | if Len>Width do
|
---|
| 194 | . new Ch
|
---|
| 195 | . for SplitPoint=SplitPoint:-1:1 do quit:SpaceFound
|
---|
| 196 | . . set Ch=$extract(Text,SplitPoint,SplitPoint)
|
---|
| 197 | . . set SpaceFound=(Ch=" ")
|
---|
| 198 | . if 'SpaceFound set SplitPoint=Width
|
---|
| 199 | . set s1=$extract(Text,1,SplitPoint)
|
---|
| 200 | . set PartB=$extract(Text,SplitPoint+1,1024) ;"max String length=1024
|
---|
| 201 | . set Text=s1
|
---|
| 202 | else do
|
---|
| 203 |
|
---|
| 204 | quit
|
---|
| 205 |
|
---|
| 206 |
|
---|
| 207 |
|
---|
| 208 | SetStrLen(Text,Width)
|
---|
| 209 | ;"PUBLIC FUNCTION
|
---|
| 210 | ;"Purpose: To make string exactly Width in length
|
---|
| 211 | ;" Shorten as needed, or pad with terminal spaces as needed.
|
---|
| 212 | ;"Input: Text -- should be passed as reference. This is string to alter.
|
---|
| 213 | ;" Width -- the desired width
|
---|
| 214 | ;"Results: none.
|
---|
| 215 |
|
---|
| 216 | set Text=$get(Text)
|
---|
| 217 | set Width=$get(Width,80)
|
---|
| 218 | new result set result=Text
|
---|
| 219 | new i,Len
|
---|
| 220 |
|
---|
| 221 | set Len=$length(result)
|
---|
| 222 | if Len>Width do
|
---|
| 223 | . set result=$extract(result,1,Width)
|
---|
| 224 | else if Len<Width do
|
---|
| 225 | . for i=1:1:(Width-Len) set result=result_" "
|
---|
| 226 |
|
---|
| 227 | set Text=result ;"pass back changes
|
---|
| 228 |
|
---|
| 229 | quit
|
---|
| 230 |
|
---|
| 231 |
|
---|
| 232 | NestSplit(Text,OpenBracket,CloseBracket,SBefore,S,SAfter)
|
---|
| 233 | ;"PUBLIC FUNCTION
|
---|
| 234 | ;"Purpose: To take a string in this format:
|
---|
| 235 | ;" Text='a big black {{Data.Section[{{MVar.Num}}]}} chased me'
|
---|
| 236 | ;" OpenBracket='{{'
|
---|
| 237 | ;" CloseBracket='}}'
|
---|
| 238 | ;" and return:
|
---|
| 239 | ;" SBefore='a big black {{Data.Section['
|
---|
| 240 | ;" S='MVar.Num
|
---|
| 241 | ;" SAfter=']}} chased me'
|
---|
| 242 | ;" Notice that this function will return the INNER-MOST text inside the brackets pair
|
---|
| 243 | ;" Note: if multiple sets of brackets exist in the string, like this:
|
---|
| 244 | ;" 'I am a {{MVar.Person}} who loves {{MVar.Food}} every day.
|
---|
| 245 | ;" Then the LAST set (i.e. MVar.Food) will be returned in S
|
---|
| 246 | ;"
|
---|
| 247 | ;"Input:Text -- the string to operate on
|
---|
| 248 | ;" OpenBracket -- string with opening brackets (i.e. '(','{', '{{' etc.)
|
---|
| 249 | ;" CloseBracket -- string with close brackets (i.e. ')','}','}}' etc.)
|
---|
| 250 | ;" SBefore -- SHOULD BE PASSED BY REFERENCE... to receive results.
|
---|
| 251 | ;" S -- SHOULD BE PASSED BY REFERENCE... to receive results.
|
---|
| 252 | ;" SAfter -- SHOULD BE PASSED BY REFERENCE... to receive results.
|
---|
| 253 | ;"Output: SBefore -- returns all text up to innermost opening brackets, or "" if none
|
---|
| 254 | ;" S -- returns text INSIDE innermost brackets -- with brackets REMOVED, or "" if none
|
---|
| 255 | ;" SAfter -- returns all text after innermost opening brackets, or "" if none
|
---|
| 256 | ;" Text is NOT changed
|
---|
| 257 | ;" NOTE: Above vars must be passed by reference to recieve results.
|
---|
| 258 | ;"Results: 1=valid results returned in output vars.
|
---|
| 259 | ;" 0=No text found inside brackets, so output vars empty.
|
---|
| 260 |
|
---|
| 261 | set SBefore="",S="",SAfter=""
|
---|
| 262 | new Result set Result=0
|
---|
| 263 |
|
---|
| 264 | ;"do DebugEntry^TMGDEBUG(.DBIndent,"NestSplit")
|
---|
| 265 |
|
---|
| 266 | if $data(Text)#10=0 goto QNSp
|
---|
| 267 | ;"do DebugMsg^TMGDEBUG(DBIndent,"Looking at '",Text,"'")
|
---|
| 268 | if ($data(OpenBracket)#10=0)!($data(CloseBracket)#10=0) goto QNSp
|
---|
| 269 | if '((Text[OpenBracket)&(Text[CloseBracket)) goto QNSp
|
---|
| 270 |
|
---|
| 271 |
|
---|
| 272 | ;"First we need to get the text after LAST instance of OpenBracket
|
---|
| 273 | ;"i.e. 'MVar.Num}}]}}' chased m from 'a big black {{Data.Section[{{MVar.Num}}]}} chased me'
|
---|
| 274 | new i set i=2
|
---|
| 275 | new part set part=""
|
---|
| 276 | new temp set temp=""
|
---|
| 277 | NSL1 set temp=$piece(Text,OpenBracket,i)
|
---|
| 278 | if temp'="" do goto NSL1
|
---|
| 279 | . set part=temp
|
---|
| 280 | . set SBefore=$piece(Text,OpenBracket,1,i-1)
|
---|
| 281 | . set i=i+1
|
---|
| 282 |
|
---|
| 283 | ;"do DebugMsg^TMGDEBUG(DBIndent,"First part is: ",SBefore)
|
---|
| 284 |
|
---|
| 285 | ;"Now we find the text before the FIRST instance of CloseBracket
|
---|
| 286 | ;"i.e. 'MVar.Num' from 'MVar.Num}}]}} chased me'
|
---|
| 287 | ;"do DebugMsg^TMGDEBUG(DBIndent,"part=",part)
|
---|
| 288 | set S=$piece(part,CloseBracket,1)
|
---|
| 289 | set SAfter=$piece(part,CloseBracket,2,128)
|
---|
| 290 |
|
---|
| 291 | ;"do DebugMsg^TMGDEBUG(DBIndent,"Main result is :",S)
|
---|
| 292 | ;"do DebugMsg^TMGDEBUG(DBIndent,"Part after result is: ",SAfter)
|
---|
| 293 |
|
---|
| 294 | ;"If we got here, we are successful
|
---|
| 295 | set Result=1
|
---|
| 296 |
|
---|
| 297 | QNSp
|
---|
| 298 | ;"do DebugExit^TMGDEBUG(.DBIndent,"NestSplit")
|
---|
| 299 |
|
---|
| 300 | quit Result
|
---|
| 301 |
|
---|
| 302 |
|
---|
| 303 | Substitute(S,Match,NewValue)
|
---|
| 304 | ;"PUBLIC FUNCTION
|
---|
| 305 | ;"Purpose: to look for all instances of Match in S, and replace with NewValue
|
---|
| 306 | ;"Input: S - string to alter. Altered if passed by reference
|
---|
| 307 | ;" Match -- the sequence to look for, i.e. '##'
|
---|
| 308 | ;" NewValue -- what to replace Match with, i.e. '$$'
|
---|
| 309 | ;"Note: This is different than $translate, as follows
|
---|
| 310 | ;" $translate("ABC###DEF","###","$") --> "ABC$$$DEF"
|
---|
| 311 | ;" Substitute("ABC###DEF","###","$") --> "ABC$DEF"
|
---|
| 312 | ;"Result: returns altered string (if any alterations indicated)
|
---|
| 313 | ;"Output: S is altered, if passed by reference.
|
---|
| 314 |
|
---|
| 315 | new spec
|
---|
| 316 | set spec($get(Match))=$get(NewValue)
|
---|
| 317 | set S=$$REPLACE^XLFSTR(S,.spec)
|
---|
| 318 |
|
---|
| 319 | quit S
|
---|
| 320 |
|
---|
| 321 |
|
---|
| 322 | FormatArray(InArray,OutArray,Divider)
|
---|
| 323 | ;"PUBLIC FUNCTION
|
---|
| 324 | ;"Purpose: The XML parser does not recognize whitespace, or end-of-line
|
---|
| 325 | ;" characters. Thus many lines get lumped together. However, if there
|
---|
| 326 | ;" is a significant amount of text, then the parser will put the text into
|
---|
| 327 | ;" several lines (when get attrib text called etc.)
|
---|
| 328 | ;" SO, this function is to take an array composed of input lines (each
|
---|
| 329 | ;" with multiple sublines clumped together), and format it such that each
|
---|
| 330 | ;" line is separated in the array.
|
---|
| 331 | ;" e.g. Take this input array"
|
---|
| 332 | ;" InArray(cText,1)="line one\nline two\nline three\n
|
---|
| 333 | ;" InArray(cText,2)="line four\nline five\nline six\n
|
---|
| 334 | ;" and convert to:
|
---|
| 335 | ;" OutArray(1)="line one"
|
---|
| 336 | ;" OutArray(2)="line two"
|
---|
| 337 | ;" OutArray(3)="line three"
|
---|
| 338 | ;" OutArray(4)="line four"
|
---|
| 339 | ;" OutArray(5)="line five"
|
---|
| 340 | ;" OutArray(6)="line six"
|
---|
| 341 | ;"Input: InArray, best if passed by reference (faster) -- see example above
|
---|
| 342 | ;" Note: expected to be in format: InArray(cText,n)
|
---|
| 343 | ;" OutArray, must be passed by reference-- see example above
|
---|
| 344 | ;" Divider: the character(s) that divides lines ("\n" in this example)
|
---|
| 345 | ;"Note: It is expected that InArray will be index by integers (i.e. 1, 2, 3)
|
---|
| 346 | ;" And this should be the case, as that is how XML functions pass back.
|
---|
| 347 | ;" Limit of 256 separate lines on any one InArray line
|
---|
| 348 | ;"Output: OutArray is set, any prior data is killed
|
---|
| 349 | ;"result: 1=OK to continue, 0=abort
|
---|
| 350 |
|
---|
| 351 | set DEBUG=$get(DEBUG,0)
|
---|
| 352 | set cOKToCont=$get(cOKToCont,1)
|
---|
| 353 | set cAbort=$get(cAbort,0)
|
---|
| 354 |
|
---|
| 355 | if DEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"FormatArray")
|
---|
| 356 |
|
---|
| 357 | new result set result=cOKToCont
|
---|
| 358 | new InIndex
|
---|
| 359 | new OutIndex set OutIndex=1
|
---|
| 360 | new TempArray
|
---|
| 361 | new Done
|
---|
| 362 |
|
---|
| 363 | kill OutArray ;"remove any prior data
|
---|
| 364 |
|
---|
| 365 | if DEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Input array:")
|
---|
| 366 | if DEBUG do ArrayDump^TMGDEBUG("InArray")
|
---|
| 367 |
|
---|
| 368 | if $data(Divider)=0 do goto FADone
|
---|
| 369 | . set result=cAbort
|
---|
| 370 |
|
---|
| 371 | set Done=0
|
---|
| 372 | for InIndex=1:1 do quit:Done
|
---|
| 373 | . if $data(InArray(cText,InIndex))=0 set Done=1 quit
|
---|
| 374 | . if DEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Converting line: ",InArray(cText,InIndex))
|
---|
| 375 | . do CleaveToArray^TMGSTUTL(InArray(cText,InIndex),Divider,.TempArray,OutIndex)
|
---|
| 376 | . if DEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Resulting temp array:")
|
---|
| 377 | . if DEBUG do ArrayDump^TMGDEBUG("TempArray")
|
---|
| 378 | . set OutIndex=TempArray(cMaxNode)+1
|
---|
| 379 | . kill TempArray(cMaxNode)
|
---|
| 380 | . merge OutArray=TempArray
|
---|
| 381 | . if DEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"OutArray so far:")
|
---|
| 382 | . if DEBUG do ArrayDump^TMGDEBUG("OutArray")
|
---|
| 383 |
|
---|
| 384 | FADone
|
---|
| 385 | if DEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"FormatArray")
|
---|
| 386 | quit result
|
---|
| 387 |
|
---|
| 388 |
|
---|
| 389 |
|
---|
| 390 | TrimL(S,TrimCh)
|
---|
| 391 | ;"Purpose: To a trip a string of leading white space
|
---|
| 392 | ;" i.e. convert " hello" into "hello"
|
---|
| 393 | ;"Input: S -- the string to convert. Won't be changed if passed by reference
|
---|
| 394 | ;" TrimCh -- OPTIONAL: Charachter to trim. Default is " "
|
---|
| 395 | ;"Results: returns modified string
|
---|
| 396 | ;"Note: processing limitation is string length=1024
|
---|
| 397 |
|
---|
| 398 | set DEBUG=$get(DEBUG,0)
|
---|
| 399 | set cOKToCont=$get(cOKToCont,1)
|
---|
| 400 | set cAbort=$get(cAbort,0)
|
---|
| 401 | set TrimCh=$get(TrimCh," ")
|
---|
| 402 |
|
---|
| 403 | new result set result=$get(S)
|
---|
| 404 | new Ch set Ch=""
|
---|
| 405 | for do quit:(Ch'=TrimCh)
|
---|
| 406 | . set Ch=$extract(result,1,1)
|
---|
| 407 | . if Ch=TrimCh set result=$extract(result,2,1024)
|
---|
| 408 |
|
---|
| 409 | quit result
|
---|
| 410 |
|
---|
| 411 |
|
---|
| 412 | TrimR(S,TrimCh)
|
---|
| 413 | ;"Purpose: To a trip a string of trailing white space
|
---|
| 414 | ;" i.e. convert "hello " into "hello"
|
---|
| 415 | ;"Input: S -- the string to convert. Won't be changed if passed by reference
|
---|
| 416 | ;" TrimCh -- OPTIONAL: Charachter to trim. Default is " "
|
---|
| 417 | ;"Results: returns modified string
|
---|
| 418 | ;"Note: processing limitation is string length=1024
|
---|
| 419 |
|
---|
| 420 | set DEBUG=$get(DEBUG,0)
|
---|
| 421 | set cOKToCont=$get(cOKToCont,1)
|
---|
| 422 | set cAbort=$get(cAbort,0)
|
---|
| 423 | set TrimCh=$get(TrimCh," ")
|
---|
| 424 |
|
---|
| 425 | if DEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"TrimR")
|
---|
| 426 |
|
---|
| 427 | new result set result=$get(S)
|
---|
| 428 | new Ch set Ch=""
|
---|
| 429 | new L
|
---|
| 430 |
|
---|
| 431 | for do quit:(Ch'=TrimCh)
|
---|
| 432 | . set L=$length(result)
|
---|
| 433 | . set Ch=$extract(result,L,L)
|
---|
| 434 | . if Ch=TrimCh do
|
---|
| 435 | . . set result=$extract(result,1,L-1)
|
---|
| 436 |
|
---|
| 437 | if DEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"TrimR")
|
---|
| 438 | quit result
|
---|
| 439 |
|
---|
| 440 | Trim(S,TrimCh)
|
---|
| 441 | ;"Purpose: To a trip a string of leading and trailing white space
|
---|
| 442 | ;" i.e. convert " hello " into "hello"
|
---|
| 443 | ;"Input: S -- the string to convert. Won't be changed if passed by reference
|
---|
| 444 | ;" TrimCh -- OPTIONAL: Charachter to trim. Default is " "
|
---|
| 445 | ;"Results: returns modified string
|
---|
| 446 | ;"Note: processing limitation is string length=1024
|
---|
| 447 |
|
---|
| 448 | ;"NOTE: this function could be replaced with $$TRIM^XLFSTR
|
---|
| 449 |
|
---|
| 450 | set DEBUG=$get(DEBUG,0)
|
---|
| 451 | set cOKToCont=$get(cOKToCont,1)
|
---|
| 452 | set cAbort=$get(cAbort,0)
|
---|
| 453 | set TrimCh=$get(TrimCh," ")
|
---|
| 454 |
|
---|
| 455 | if DEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"Trim")
|
---|
| 456 |
|
---|
| 457 | new result set result=$get(S)
|
---|
| 458 | set result=$$TrimL(.result,TrimCh)
|
---|
| 459 | set result=$$TrimR(.result,TrimCh)
|
---|
| 460 |
|
---|
| 461 | if DEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"Trim")
|
---|
| 462 | quit result
|
---|
| 463 |
|
---|
| 464 | TrimRType(S,type)
|
---|
| 465 | ;"Scope: PUBLIC FUNCTION
|
---|
| 466 | ;"Purpose: trim characters on the right of the string of a specified type.
|
---|
| 467 | ;" Goal, to be able to distinguish between numbers and strings.
|
---|
| 468 | ;" i.e. "1234<=" --> "1234" by trimming strings
|
---|
| 469 | ;"Input: S -- The string to work on
|
---|
| 470 | ;" type -- the type of characters to TRIM: N for numbers,C for non-numbers (characters)
|
---|
| 471 | ;"Results : modified string
|
---|
| 472 |
|
---|
| 473 | set tempS=$get(S)
|
---|
| 474 | set type=$$UP^XLFSTR($get(type)) goto:(type="") TRTDone
|
---|
| 475 | new done set done=0
|
---|
| 476 | for quit:(tempS="")!done do
|
---|
| 477 | . new c set c=$extract(tempS,$length(tempS))
|
---|
| 478 | . new cType set cType="C"
|
---|
| 479 | . if +c=c set cType="N"
|
---|
| 480 | . if type["N" do
|
---|
| 481 | . . if cType="N" set tempS=$extract(tempS,1,$length(tempS)-1) quit
|
---|
| 482 | . . set done=1
|
---|
| 483 | . else if type["C" do
|
---|
| 484 | . . if cType="C" set tempS=$extract(tempS,1,$length(tempS)-1) quit
|
---|
| 485 | . . set done=1
|
---|
| 486 | . else set done=1
|
---|
| 487 |
|
---|
| 488 | TRTDone quit tempS
|
---|
| 489 |
|
---|
| 490 | NumLWS(S)
|
---|
| 491 | ;"Scope: PUBLIC FUNCTION
|
---|
| 492 | ;":Purpose: To count the number of white space characters on the left
|
---|
| 493 | ;" side of the string
|
---|
| 494 |
|
---|
| 495 | new result set result=0
|
---|
| 496 | new i,ch
|
---|
| 497 | set S=$get(S)
|
---|
| 498 |
|
---|
| 499 | for i=1:1:$length(S) do quit:(ch'=" ")
|
---|
| 500 | . set ch=$extract(S,i,i)
|
---|
| 501 | . if ch=" " set result=result+1
|
---|
| 502 |
|
---|
| 503 | quit result
|
---|
| 504 |
|
---|
| 505 |
|
---|
| 506 | MakeWS(n)
|
---|
| 507 | ;"Scope: PUBLIC FUNCTION
|
---|
| 508 | ;"Purpose: Return a whitespace string that is n characters long
|
---|
| 509 |
|
---|
| 510 | new result set result=""
|
---|
| 511 | set n=$get(n,0)
|
---|
| 512 | if n'>0 goto MWSDone
|
---|
| 513 |
|
---|
| 514 | new i
|
---|
| 515 | for i=1:1:n set result=result_" "
|
---|
| 516 |
|
---|
| 517 | MWSDone
|
---|
| 518 | quit result
|
---|
| 519 |
|
---|
| 520 |
|
---|
| 521 | WordWrapArray(Array,Width,SpecialIndent)
|
---|
| 522 | ;"Scope: PUBLIC FUNCTION
|
---|
| 523 | ;"Purpose: To take an array and perform word wrapping such that
|
---|
| 524 | ;" no line is longer than Width.
|
---|
| 525 | ;" This function is really designed for reformatting a Fileman WP field
|
---|
| 526 | ;"Input: Array MUST BE PASSED BY REFERENCE. This contains the array
|
---|
| 527 | ;" to be reformatted. Changes will be made to this array.
|
---|
| 528 | ;" It is expected that Array will be in this format:
|
---|
| 529 | ;" Array(1)="Some text on the first line."
|
---|
| 530 | ;" Array(2)="Some text on the second line."
|
---|
| 531 | ;" Array(3)="Some text on the third line."
|
---|
| 532 | ;" Array(4)="Some text on the fourth line."
|
---|
| 533 | ;" or
|
---|
| 534 | ;" Array(1,0)="Some text on the first line."
|
---|
| 535 | ;" Array(2,0)="Some text on the second line."
|
---|
| 536 | ;" Array(3,0)="Some text on the third line."
|
---|
| 537 | ;" Array(4,0)="Some text on the fourth line."
|
---|
| 538 | ;" Width -- the limit on the length of any line. Default value=70
|
---|
| 539 | ;" SpecialIndent : if 1, then wrapping is done like this:
|
---|
| 540 | ;" " This is a very long line......"
|
---|
| 541 | ;" will be wrapped like this:
|
---|
| 542 | ;" " This is a very
|
---|
| 543 | ;" " long line ...
|
---|
| 544 | ;" Notice that the leading space is copied subsequent line.
|
---|
| 545 | ;" Also, a line like this:
|
---|
| 546 | ;" " 1. Here is the beginning of a paragraph that is very long..."
|
---|
| 547 | ;" will be wrapped like this:
|
---|
| 548 | ;" " 1. Here is the beginning of a paragraph
|
---|
| 549 | ;" " that is very long..."
|
---|
| 550 | ;" Notice that a pattern '#. ' causes the wrapping to match the start of
|
---|
| 551 | ;" of the text on the line above.
|
---|
| 552 | ;" The exact rules for matching this are as follows:
|
---|
| 553 | ;" (FirstWord?.N1".")!(FirstWord?1.3E1".")
|
---|
| 554 | ;" i.e. any number of digits, followed by "."
|
---|
| 555 | ;" OR 1-4 all upper-case characters followed by a "."
|
---|
| 556 | ;" This will allow "VIII. " pattern but not "viii. "
|
---|
| 557 | ;" HOWEVER, might get confused with a word, like "NOTE. "
|
---|
| 558 | ;"
|
---|
| 559 | ;" This, below, is not dependant on SpecialIndent setting
|
---|
| 560 | ;" Also, because some of the lines have already partly wrapped, like this:
|
---|
| 561 | ;" " 1. Here is the beginning of a paragraph that is very long..."
|
---|
| 562 | ;" "and this is a line that has already wrapped.
|
---|
| 563 | ;" So when the first line is wrapped, it would look like this:
|
---|
| 564 | ;" " 1. Here is the beginning of a paragraph
|
---|
| 565 | ;" " that is very long..."
|
---|
| 566 | ;" "and this is a line that has already wrapped.
|
---|
| 567 | ;" But is should look like this:
|
---|
| 568 | ;" " 1. Here is the beginning of a paragraph
|
---|
| 569 | ;" " that is very long...and this is a line
|
---|
| 570 | ;" " that has already wrapped.
|
---|
| 571 | ;" But the next line SHOULD NOT be pulled up if it is the start
|
---|
| 572 | ;" of a new paragraph. I will tell by looking for #. paattern.
|
---|
| 573 |
|
---|
| 574 |
|
---|
| 575 | ;"Result -- none
|
---|
| 576 |
|
---|
| 577 | if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"WordWrapArray^TMGSTUTL")
|
---|
| 578 | new tempArray set tempArray="" ;"holds result during work.
|
---|
| 579 | new tindex set tindex=0
|
---|
| 580 | new index
|
---|
| 581 | set index=$order(Array(""))
|
---|
| 582 | new s
|
---|
| 583 | new residualS set residualS=""
|
---|
| 584 | new AddZero set AddZero=0
|
---|
| 585 | set Width=$get(Width,70)
|
---|
| 586 |
|
---|
| 587 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Starting loop")
|
---|
| 588 |
|
---|
| 589 | if index'="" for do quit:((index="")&(residualS=""))
|
---|
| 590 | . set s=$get(Array(index))
|
---|
| 591 | . if s="" do
|
---|
| 592 | . . set s=$get(Array(index,0))
|
---|
| 593 | . . set AddZero=1
|
---|
| 594 | . if residualS'="" do ;"See if should join to next line. Don't if '#. ' pattern
|
---|
| 595 | . . new FirstWord set FirstWord=$piece($$Trim(s)," ",1)
|
---|
| 596 | . . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"First Word: ",FirstWord)
|
---|
| 597 | . . if (FirstWord?.N1".")!(FirstWord?1.4U1".") do ;"match for '#.' pattern
|
---|
| 598 | . . . ;"Here we have the next line is a new paragraph, so don't link to residualS
|
---|
| 599 | . . . set tindex=tindex+1
|
---|
| 600 | . . . if AddZero=0 set tempArray(tindex)=residualS
|
---|
| 601 | . . . else set tempArray(tindex,0)=residualS
|
---|
| 602 | . . . set residualS=""
|
---|
| 603 | . if $length(residualS)+$length(s)'<256 do
|
---|
| 604 | . . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"ERROR -- string too long.")
|
---|
| 605 | . set s=residualS_s
|
---|
| 606 | . set residualS=""
|
---|
| 607 | . if $length(s)>Width do
|
---|
| 608 | . . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Long line: ",s)
|
---|
| 609 | . . new LineArray
|
---|
| 610 | . . new NumLines
|
---|
| 611 | . . set NumLines=$$SplitLine(.s,.LineArray,Width,.SpecialIndent)
|
---|
| 612 | . . if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("LineArray")
|
---|
| 613 | . . set s=""
|
---|
| 614 | . . new LineIndex
|
---|
| 615 | . . for LineIndex=1:1:NumLines do
|
---|
| 616 | . . . set tindex=tindex+1
|
---|
| 617 | . . . if AddZero=0 set tempArray(tindex)=LineArray(LineIndex)
|
---|
| 618 | . . . else set tempArray(tindex,0)=LineArray(LineIndex)
|
---|
| 619 | . . ;"long wrap probably continues into next paragraph, so link together.
|
---|
| 620 | . . if NumLines>2 do
|
---|
| 621 | . . . if AddZero=0 set residualS=tempArray(tindex) set tempArray(tindex)=""
|
---|
| 622 | . . . else set residualS=tempArray(tindex,0) set tempArray(tindex,0)=""
|
---|
| 623 | . . . set tindex=tindex-1
|
---|
| 624 | . else do
|
---|
| 625 | . . set tindex=tindex+1
|
---|
| 626 | . . if AddZero=0 set tempArray(tindex)=s
|
---|
| 627 | . . else set tempArray(tindex,0)=s
|
---|
| 628 | . set index=$order(Array(index))
|
---|
| 629 | else do
|
---|
| 630 | . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Array appears empty")
|
---|
| 631 |
|
---|
| 632 |
|
---|
| 633 | kill Array
|
---|
| 634 | merge Array=tempArray
|
---|
| 635 |
|
---|
| 636 | if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("Array")
|
---|
| 637 |
|
---|
| 638 | if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent," WordWrapArray^TMGSTUTL")
|
---|
| 639 | quit
|
---|
| 640 |
|
---|
| 641 |
|
---|
| 642 | SplitLine(s,LineArray,Width,SpecialIndent,Indent)
|
---|
| 643 | ;"Scope: PUBLIC FUNCTION
|
---|
| 644 | ;"Purpose: To take a long line, and wrap into an array, such that each
|
---|
| 645 | ;" line is not longer than Width.
|
---|
| 646 | ;" Line breaks will be made at spaces, unless there are no spaces in
|
---|
| 647 | ;" the entire line (in which case, the line will be divided at Width).
|
---|
| 648 | ;"Input: s= string with the long line. **If passed by reference**, then
|
---|
| 649 | ;" it WILL BE CHANGED to equal the last line of array.
|
---|
| 650 | ;" LineArray -- MUST BE PASSED BY REFERENCE. This OUT variable will
|
---|
| 651 | ;" receive the resulting array.
|
---|
| 652 | ;" Width = the desired wrap width.
|
---|
| 653 | ;" SpecialIndent [OPTIONAL]: if 1, then wrapping is done like this:
|
---|
| 654 | ;" " This is a very long line......"
|
---|
| 655 | ;" will be wrapped like this:
|
---|
| 656 | ;" " This is a very
|
---|
| 657 | ;" " long line ...
|
---|
| 658 | ;" Notice that the leading space is copied subsequent line.
|
---|
| 659 | ;" Also, a line like this:
|
---|
| 660 | ;" " 1. Here is the beginning of a paragraph that is very long..."
|
---|
| 661 | ;" will be wrapped like this:
|
---|
| 662 | ;" " 1. Here is the beginning of a paragraph
|
---|
| 663 | ;" " that is very long..."
|
---|
| 664 | ;" Notice that a pattern '#. ' causes the wrapping to match the start
|
---|
| 665 | ;" of the text on the line above.
|
---|
| 666 | ;" Indent [OPTIONAL]: Any absolute amount that all lines should be indented by.
|
---|
| 667 | ;" This could be used if this long line is continuation of an
|
---|
| 668 | ;" indentation above it.
|
---|
| 669 | ;"Result: resulting number of lines (1 if no wrap needed).
|
---|
| 670 |
|
---|
| 671 | if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"SplitLine")
|
---|
| 672 |
|
---|
| 673 | new result set result=0
|
---|
| 674 | kill LineArray
|
---|
| 675 | if ($get(s)="")!($get(Width)'>0) goto SPDone
|
---|
| 676 | new index set index=0
|
---|
| 677 | new p,tempS,splitPoint
|
---|
| 678 |
|
---|
| 679 | new PreSpace set PreSpace=$$NeededWS(s,.SpecialIndent,.Indent)
|
---|
| 680 |
|
---|
| 681 | if ($length(s)>Width) for do quit:($length(s)'>Width)
|
---|
| 682 | . for splitPoint=1:1:Width do quit:($length(tempS)>Width)
|
---|
| 683 | . . set tempS=$piece(s," ",1,splitPoint)
|
---|
| 684 | . . ;"write "tempS>",tempS,!
|
---|
| 685 | . if splitPoint>1 do
|
---|
| 686 | . . set tempS=$piece(s," ",1,splitPoint-1)
|
---|
| 687 | . . set s=$piece(s," ",splitPoint,Width)
|
---|
| 688 | . else do
|
---|
| 689 | . . ;"We must have a word > Width with no spaces--so just divide
|
---|
| 690 | . . set tempS=$extract(s,1,Width)
|
---|
| 691 | . . set s=$extract(s,Width+1,999)
|
---|
| 692 | . set index=index+1
|
---|
| 693 | . set LineArray(index)=tempS
|
---|
| 694 | . set s=PreSpace_s
|
---|
| 695 | . ;"write "tempS>",tempS,!
|
---|
| 696 | . ;"write "s>",s,!
|
---|
| 697 |
|
---|
| 698 | set index=index+1
|
---|
| 699 | set LineArray(index)=s
|
---|
| 700 |
|
---|
| 701 | set result=index
|
---|
| 702 |
|
---|
| 703 | SPDone
|
---|
| 704 | if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"SplitLine")
|
---|
| 705 | quit result
|
---|
| 706 |
|
---|
| 707 |
|
---|
| 708 |
|
---|
| 709 | NeededWS(S,SpecialIndent,Indent)
|
---|
| 710 | ;"Scope: PRIVATE
|
---|
| 711 | ;"Purpose: Evaluate the line, and create the white space string
|
---|
| 712 | ;" need for wrapped lines
|
---|
| 713 | ;"Input: s -- the string to eval. i.e.
|
---|
| 714 | ;" " John is very happy today ... .. .. .. .."
|
---|
| 715 | ;" or " 1. John is very happy today ... .. .. .. .."
|
---|
| 716 | ;" SpecialIndent -- See SplitLine() discussion
|
---|
| 717 | ;" Indent -- See SplitLine() discussion
|
---|
| 718 |
|
---|
| 719 | new result set result=""
|
---|
| 720 | if $get(S)="" goto NdWSDone
|
---|
| 721 |
|
---|
| 722 | new WSNum
|
---|
| 723 | set WSNum=+$get(Indent,0)
|
---|
| 724 | set WSNum=WSNum+$$NumLWS(S)
|
---|
| 725 |
|
---|
| 726 | if $get(SpecialIndent)=1 do
|
---|
| 727 | . new ts,FirstWord
|
---|
| 728 | . set ts=$$TrimL(.S)
|
---|
| 729 | . set FirstWord=$piece(ts," ",1)
|
---|
| 730 | . if (FirstWord?.N1".")!(FirstWord?1.4U1".") do ;"match for '#.' pattern
|
---|
| 731 | . . set WSNum=WSNum+$length(FirstWord)
|
---|
| 732 | . . set ts=$piece(ts," ",2,9999)
|
---|
| 733 | . . set WSNum=WSNum+$$NumLWS(.ts)+1
|
---|
| 734 |
|
---|
| 735 | set result=$$MakeWS(WSNum)
|
---|
| 736 |
|
---|
| 737 | NdWSDone
|
---|
| 738 | quit result
|
---|
| 739 |
|
---|
| 740 |
|
---|
| 741 | WriteWP(NodeRef)
|
---|
| 742 | ;"Purpose: Given a reference to a WP field, this function will print it out.
|
---|
| 743 | ;"INput: NodeRef -- the name of the node to print out.
|
---|
| 744 | ;" For example, "^PS(50.605,1,1)"
|
---|
| 745 | ;"Modification: 2/10/06 -- I removed need for @NodeRef@(0) to contain data.
|
---|
| 746 |
|
---|
| 747 | new i
|
---|
| 748 | ;"if $get(@NodeRef@(0))="" goto WWPDone
|
---|
| 749 | set i=$order(@NodeRef@(0))
|
---|
| 750 | if i'="" for do quit:(i="")
|
---|
| 751 | . new OneLine
|
---|
| 752 | . set OneLine=$get(@NodeRef@(i))
|
---|
| 753 | . if OneLine="" set OneLine=$get(@NodeRef@(i,0))
|
---|
| 754 | . write OneLine,!
|
---|
| 755 | . set i=$order(@NodeRef@(i))
|
---|
| 756 |
|
---|
| 757 | WWPDone quit
|
---|
| 758 |
|
---|
| 759 |
|
---|
| 760 | LPad(S,width)
|
---|
| 761 | ;"Purpose: To add space ("pad") string S such that final width is per specified with.
|
---|
| 762 | ;" space is added to left side of string
|
---|
| 763 | ;"Input: S : the string to pad.
|
---|
| 764 | ;" width : the desired final width
|
---|
| 765 | ;"result: returns resulting string
|
---|
| 766 | ;"Example: LPad("$5.23",7)=" $5.23"
|
---|
| 767 |
|
---|
| 768 | quit $$RJ^XLFSTR(.S,.width," ")
|
---|
| 769 |
|
---|
| 770 | RPad(S,width)
|
---|
| 771 | ;"Purpose: To add space ("pad") string S such that final width is per specified with.
|
---|
| 772 | ;" space is added to right side of string
|
---|
| 773 | ;"Input: S : the string to pad.
|
---|
| 774 | ;" width : the desired final width
|
---|
| 775 | ;"result: returns resulting string
|
---|
| 776 | ;"Example: RPad("$5.23",7)="$5.23 "
|
---|
| 777 |
|
---|
| 778 | quit $$LJ^XLFSTR(.S,.width," ")
|
---|
| 779 |
|
---|
| 780 | Center(S,width)
|
---|
| 781 | ;"Purpose: to return a center justified string
|
---|
| 782 |
|
---|
| 783 | quit $$CJ^XLFSTR(.S,.width," ")
|
---|
| 784 |
|
---|
| 785 | Clip(S,width)
|
---|
| 786 | ;"Purpose: to ensure that string S is no longer than width
|
---|
| 787 |
|
---|
| 788 | new result set result=$get(S)
|
---|
| 789 | if result'="" set result=$extract(S,1,width)
|
---|
| 790 | ClipDone
|
---|
| 791 | quit result
|
---|
| 792 |
|
---|
| 793 |
|
---|
| 794 | STRB2H(s,F,noSpace)
|
---|
| 795 | ;"Convert a string to hex characters)
|
---|
| 796 | ;"Input: s -- the input string (need not be ascii characters)
|
---|
| 797 | ;" F -- (optional) if F>0 then will append an ascii display of string.
|
---|
| 798 | ;" noSpace -- (Optional) if >0 then characters NOT separated by spaces
|
---|
| 799 | ;"result -- the converted string
|
---|
| 800 |
|
---|
| 801 | new i,ch
|
---|
| 802 | new result set result=""
|
---|
| 803 |
|
---|
| 804 | for i=1:1:$length(s) do
|
---|
| 805 | . set ch=$extract(s,i)
|
---|
| 806 | . set result=result_$$HEXCHR^TMGMISC($ascii(ch))
|
---|
| 807 | . if +$get(noSpace)=0 set result=result_" "
|
---|
| 808 |
|
---|
| 809 | if $get(F)>0 set result=result_" "_$$HIDECTRLS^TMGSTUTL(s)
|
---|
| 810 | quit result
|
---|
| 811 |
|
---|
| 812 |
|
---|
| 813 | HIDECTRLS(s)
|
---|
| 814 | ;"hide all unprintable characters from a string
|
---|
| 815 | new i,ch,byte
|
---|
| 816 | new result set result=""
|
---|
| 817 | for i=1:1:$length(s) do
|
---|
| 818 | . set ch=$e(s,i)
|
---|
| 819 | . set byte=$ascii(ch)
|
---|
| 820 | . if (byte<32)!(byte>122) set result=result_"."
|
---|
| 821 | . else set result=result_ch
|
---|
| 822 |
|
---|
| 823 | quit result
|
---|
| 824 |
|
---|
| 825 |
|
---|
| 826 |
|
---|
| 827 | CapWords(S,Divider)
|
---|
| 828 | ;"Purpose: convert each word in the string: 'test string' --> 'Test String', 'TEST STRING' --> 'Test String'
|
---|
| 829 |
|
---|
| 830 | ;"Input: S -- the string to convert
|
---|
| 831 | ;" Divider -- [OPTIONAL] the character used to separate string (default is ' ' [space])
|
---|
| 832 | ;"Result: returns the converted string
|
---|
| 833 |
|
---|
| 834 | new s2,part
|
---|
| 835 | new result set result=""
|
---|
| 836 | set Divider=$get(Divider," ")
|
---|
| 837 |
|
---|
| 838 | set s2=$$LOW^XLFSTR(S)
|
---|
| 839 |
|
---|
| 840 | for i=1:1 do quit:part=""
|
---|
| 841 | . set part=$piece(s2,Divider,i)
|
---|
| 842 | . if part="" quit
|
---|
| 843 | . set $extract(part,1)=$$UP^XLFSTR($extract(part,1))
|
---|
| 844 | . if result'="" set result=result_Divider
|
---|
| 845 | . set result=result_part
|
---|
| 846 |
|
---|
| 847 | quit result
|
---|
| 848 |
|
---|
| 849 |
|
---|
| 850 | LinuxStr(S)
|
---|
| 851 | ;"Purpose: convert string to a valid linux filename
|
---|
| 852 | ;" e.g. 'File Name' --> 'File\ Name'
|
---|
| 853 |
|
---|
| 854 | quit $$Substitute(.S," ","\ ")
|
---|
| 855 |
|
---|
| 856 |
|
---|
| 857 |
|
---|
| 858 | NiceSplit(S,Len,s1,s2,s2Min,DivCh)
|
---|
| 859 | ;"Purpose: to split S into two strings, s1 & s2
|
---|
| 860 | ;" Furthermore, s1's length must be <= length.
|
---|
| 861 | ;" and the split will be made at spaces
|
---|
| 862 | ;"Input: S -- the string to split
|
---|
| 863 | ;" Len -- the length limit of s1
|
---|
| 864 | ;" s1 -- PASS BY REFERENCE, an OUT parameter
|
---|
| 865 | ;" receives first part of split
|
---|
| 866 | ;" s2 -- PASS BY REFERENCE, an OUT parameter
|
---|
| 867 | ;" receives the rest of string
|
---|
| 868 | ;" s2Min -- OPTIONAL -- the minimum that
|
---|
| 869 | ;" length of s2 can be. Note, if s2
|
---|
| 870 | ;" is "", then this is not applied
|
---|
| 871 | ;" DivCH -- OPTIONAL, default is " ".
|
---|
| 872 | ;" This is the character to split words by
|
---|
| 873 | ;"Output: s1 and s2 is filled with data
|
---|
| 874 | ;"Result: none
|
---|
| 875 |
|
---|
| 876 | set (s1,s2)=""
|
---|
| 877 | if $get(DivCh)="" set DivCh=" "
|
---|
| 878 |
|
---|
| 879 | if $length(S)'>Len do goto NSpDone
|
---|
| 880 | . set s1=S
|
---|
| 881 |
|
---|
| 882 | new i
|
---|
| 883 | new done
|
---|
| 884 | for i=200:-1:1 do quit:(done)
|
---|
| 885 | . set s1=$piece(S,DivCh,1,i)_DivCh
|
---|
| 886 | . set s2=$piece(S,DivCh,i+1,999)
|
---|
| 887 | . set done=($length(s1)'>Len)
|
---|
| 888 | . if done,+$get(s2Min)>0 do
|
---|
| 889 | . . if s2="" quit
|
---|
| 890 | . . set done=($length(s2)'<s2Min)
|
---|
| 891 |
|
---|
| 892 | NSpDone quit
|
---|
| 893 |
|
---|
| 894 |
|
---|
| 895 | StrToWP(s,pArray,width,DivCh,InitLine)
|
---|
| 896 | ;"Purpose: to take a long string and wrap it into formal WP format
|
---|
| 897 | ;"Input: s: the long string to wrap into the WP field
|
---|
| 898 | ;" pArray: the NAME of the array to put output into.
|
---|
| 899 | ;" Any pre-existing data in this array will NOT be killed
|
---|
| 900 | ;" width: OPTIONAL -- the width to target for word wrapping. Default is 60
|
---|
| 901 | ;" DivCh: OPTIONAL -- the character to use separate words (to allow nice wrapping). Default is " "
|
---|
| 902 | ;" InitLine: OPTIONAL -- the line to start putting data into. Default is 1
|
---|
| 903 | ;"Output: pArray will be filled as follows:
|
---|
| 904 | ;" @pArray@(InitLine+0)=line 1
|
---|
| 905 | ;" @pArray@(InitLine+1)=line 2
|
---|
| 906 | ;" @pArray@(InitLine+2)=line 3
|
---|
| 907 |
|
---|
| 908 | if +$get(width)=0 set width=60
|
---|
| 909 | if $get(DivCh)="" set DivCh=" "
|
---|
| 910 | new tempS set tempS=$get(s)
|
---|
| 911 | if $get(InitLine)="" set InitLine=1
|
---|
| 912 | new curLine set curLine=+InitLine
|
---|
| 913 | ;"kill @pArray
|
---|
| 914 |
|
---|
| 915 | for do quit:(tempS="")
|
---|
| 916 | . new s1,s2
|
---|
| 917 | . do NiceSplit(tempS,width,.s1,.s2,,DivCh)
|
---|
| 918 | . set @pArray@(curLine)=s1
|
---|
| 919 | . set curLine=curLine+1
|
---|
| 920 | . set tempS=s2
|
---|
| 921 |
|
---|
| 922 | quit
|
---|
| 923 |
|
---|
| 924 |
|
---|
| 925 | WPToStr(pArray,DivCh,MaxLen,InitLine)
|
---|
| 926 | ;"Purpose: This is the opposite of StrToWP. It takes a WP field, and concatenates
|
---|
| 927 | ;" each line to make one long string.
|
---|
| 928 | ;"Input: pArray: the NAME of the array to get WP lines from. Expected format as follows
|
---|
| 929 | ;" @pArray@(InitLine+0)=line 1
|
---|
| 930 | ;" @pArray@(InitLine+1)=line 2
|
---|
| 931 | ;" @pArray@(InitLine+2)=line 3
|
---|
| 932 | ;" -or-
|
---|
| 933 | ;" @pArray@(InitLine+0,0)=line 1
|
---|
| 934 | ;" @pArray@(InitLine+1,0)=line 2
|
---|
| 935 | ;" @pArray@(InitLine+2,0)=line 3
|
---|
| 936 | ;" DivCh: OPTIONAL, default is " ". This character is appended to the end of each line, e.g
|
---|
| 937 | ;" output=output_line1_DivCh_line2
|
---|
| 938 | ;" MaxLen: OPTIONAL, default=255. The maximum allowable length of the resulting string.
|
---|
| 939 | ;" InitLine: OPTIONAL -- the line in pArray to start reading data from. Default is 1
|
---|
| 940 | ;"result: Returns one long string representing the WP array
|
---|
| 941 |
|
---|
| 942 | new i,OneLine,result,Len
|
---|
| 943 | set i=$get(InitLine,1)
|
---|
| 944 | set result=""
|
---|
| 945 | set DivCh=$get(DivCh," ")
|
---|
| 946 | set MaxLen=$get(MaxLen,255)
|
---|
| 947 | set Len=0
|
---|
| 948 |
|
---|
| 949 | for do quit:(OneLine="")!(Len'<MaxLen)!(+i'>0)
|
---|
| 950 | . set OneLine=$get(@pArray@(i))
|
---|
| 951 | . if OneLine="" set OneLine=$get(@pArray@(i,0))
|
---|
| 952 | . if OneLine="" quit
|
---|
| 953 | . set Len=$length(result)+$length(DivCh)
|
---|
| 954 | . if Len+$length(OneLine)>MaxLen do
|
---|
| 955 | . . set OneLine=$extract(OneLine,1,(MaxLen-Len))
|
---|
| 956 | . set result=result_OneLine_DivCh
|
---|
| 957 | . set Len=Len+$length(OneLine)
|
---|
| 958 | . set i=$order(@pArray@(i))
|
---|
| 959 |
|
---|
| 960 | quit result;
|
---|
| 961 |
|
---|
| 962 |
|
---|
| 963 | Comp2Strs(s1,s2)
|
---|
| 964 | ;"Purpose: To compare two strings and assign an arbritrary score to their similarity
|
---|
| 965 | ;"Input: s1,s2 -- The two strings to compare
|
---|
| 966 | ;"Result: a score comparing the two strings
|
---|
| 967 | ;" 0.5 point for every word in s1 that is also in s2 (case specific)
|
---|
| 968 | ;" 0.25 point for every word in s1 that is also in s2 (not case specific)
|
---|
| 969 | ;" 0.5 point for every word in s2 that is also in s1 (case specific)
|
---|
| 970 | ;" 0.25 point for every word in s2 that is also in s1 (not case specific)
|
---|
| 971 | ;" 1 points if same number of words in string (compared each way)
|
---|
| 972 | ;" 2 points for each word that is in the same position in each string (case specific)
|
---|
| 973 | ;" 1.5 points for each word that is in the same position in each string (not case specific)
|
---|
| 974 |
|
---|
| 975 | new score set score=0
|
---|
| 976 | new Us1 set Us1=$$UP^XLFSTR(s1)
|
---|
| 977 | new Us2 set Us2=$$UP^XLFSTR(s2)
|
---|
| 978 |
|
---|
| 979 | new i
|
---|
| 980 | for i=1:1:$length(s1," ") do
|
---|
| 981 | . if s2[$piece(s1," ",i) set score=score+0.5
|
---|
| 982 | . else if Us2[$piece(Us1," ",i) set score=score+0.25
|
---|
| 983 | . if $piece(s1," ",i)=$piece(s2," ",i) set score=score+1
|
---|
| 984 | . else if $piece(Us1," ",i)=$piece(Us2," ",i) set score=score+1.5
|
---|
| 985 |
|
---|
| 986 | for i=1:1:$length(s2," ") do
|
---|
| 987 | . if s1[$piece(s2," ",i) set score=score+0.5
|
---|
| 988 | . else if Us1[$piece(Us2," ",i) set score=score+0.25
|
---|
| 989 | . if $piece(s1," ",i)=$piece(s2," ",i) set score=score+1
|
---|
| 990 | . else if $piece(Us1," ",i)=$piece(Us2," ",i) set score=score+1.5
|
---|
| 991 |
|
---|
| 992 | if $length(s1," ")=$length(s2," ") set score=score+2
|
---|
| 993 |
|
---|
| 994 | quit score
|
---|
| 995 |
|
---|
| 996 |
|
---|
| 997 | PosNum(s,Num,LeadingSpace)
|
---|
| 998 | ;"Purpose: To return the position of the first Number in a string
|
---|
| 999 | ;"Input: S -- string to check
|
---|
| 1000 | ;" Num -- OPTIONAL, default is 0-9 numbers. number to look for.
|
---|
| 1001 | ;" LeadingSpace -- OPTIONAL. If 1 then looks for " #" or " .#", not just "#"
|
---|
| 1002 | ;"Results: -1 if not found, otherwise position of found digit.
|
---|
| 1003 |
|
---|
| 1004 | new result set result=-1
|
---|
| 1005 | new Leader set Leader=""
|
---|
| 1006 | if $get(LeadingSpace)=1 set Leader=" "
|
---|
| 1007 |
|
---|
| 1008 | if $get(Num) do goto PNDone
|
---|
| 1009 | . set result=$find(s,Leader_Num)-1
|
---|
| 1010 |
|
---|
| 1011 | new temp,i,decimalFound
|
---|
| 1012 | for i=0:1:9 do
|
---|
| 1013 | . set decimalFound=0
|
---|
| 1014 | . set temp=$find(s,Leader_i)
|
---|
| 1015 | . if (temp=0)&(Leader'="") do
|
---|
| 1016 | . . set temp=$find(s,Leader_"."_i)
|
---|
| 1017 | . . if temp>-1 set decimalFound=1
|
---|
| 1018 | . if temp>-1 set temp=temp-$length(Leader_i)
|
---|
| 1019 | . if decimalFound set temp=temp-1
|
---|
| 1020 | . if (temp>0)&((temp<result)!(result=-1)) set result=temp
|
---|
| 1021 |
|
---|
| 1022 | PNDone
|
---|
| 1023 | if (result>0)&(Leader=" ") set result=result+1
|
---|
| 1024 | quit result
|
---|
| 1025 |
|
---|
| 1026 |
|
---|
| 1027 | IsNumeric(s)
|
---|
| 1028 | ;"Purpose: To deterimine if word s is a numeric
|
---|
| 1029 | ;" Examples of numeric words:
|
---|
| 1030 | ;" 10, N-100, 0.5%, 50000UNT/ML
|
---|
| 1031 | ;" the test will be if the word contains any digit 0-9
|
---|
| 1032 | ;"Results: 1 if is a numeric word, 0 if not.
|
---|
| 1033 |
|
---|
| 1034 | quit ($$PosNum(.s)>0)
|
---|
| 1035 |
|
---|
| 1036 |
|
---|
| 1037 | ScrubNumeric(s)
|
---|
| 1038 | ;"Purpose: This is a specialty function designed to remove numeric words
|
---|
| 1039 | ;" from a sentence. E.g.
|
---|
| 1040 | ;" BELLADONNA ALK 0.3/PHENOBARB 16MG CHW TB --> BELLADONNA ALK /PHENOBARB CHW TB
|
---|
| 1041 | ;" ESTROGENS,CONJUGATED 2MG/ML INJ (IN OIL) --> ESTROGENS,CONJUGATED INJ (IN OIL)
|
---|
| 1042 |
|
---|
| 1043 | new Array,i,result
|
---|
| 1044 | set s=$$Substitute(s,"/MG","")
|
---|
| 1045 | set s=$$Substitute(s,"/ML","")
|
---|
| 1046 | set s=$$Substitute(s,"/"," / ")
|
---|
| 1047 | set s=$$Substitute(s,"-"," - ")
|
---|
| 1048 | do CleaveToArray(s," ",.Array)
|
---|
| 1049 | new ToKill
|
---|
| 1050 | set i=0 for set i=$order(Array(i)) quit:+i'>0 do
|
---|
| 1051 | . if (Array(i)="MG")&($get(ToKill(i-1))=1) set ToKill(i)=1 quit
|
---|
| 1052 | . if (Array(i)="MCG")&($get(ToKill(i-1))=1) set ToKill(i)=1 quit
|
---|
| 1053 | . if (Array(i)="MEQ")&($get(ToKill(i-1))=1) set ToKill(i)=1 quit
|
---|
| 1054 | . if (Array(i)="%")&($get(ToKill(i-1))=1) set ToKill(i)=1 quit
|
---|
| 1055 | . if (Array(i)="MM")&($get(ToKill(i-1))=1) set ToKill(i)=1 quit
|
---|
| 1056 | . if $$IsNumeric(Array(i))=0 quit
|
---|
| 1057 | . set ToKill(i)=1
|
---|
| 1058 | . new tempS set tempS=$get(Array(i-1))
|
---|
| 1059 | . if (tempS="/")!(tempS="-") set ToKill(i-1)=1
|
---|
| 1060 | . if (tempS="NO")!(tempS="#") set ToKill(i-1)=1
|
---|
| 1061 |
|
---|
| 1062 | set i=0 for set i=$order(Array(i)) quit:+i'>0 do
|
---|
| 1063 | . if $get(ToKill(i))=1 kill Array(i)
|
---|
| 1064 |
|
---|
| 1065 | set i="",result=""
|
---|
| 1066 | for set i=$order(Array(i)) quit:+i'>0 do
|
---|
| 1067 | . set result=result_Array(i)_" "
|
---|
| 1068 |
|
---|
| 1069 | set result=$$Trim(result)
|
---|
| 1070 | set result=$$Substitute(result," / ","/")
|
---|
| 1071 | set result=$$Substitute(result," - ","-")
|
---|
| 1072 |
|
---|
| 1073 | quit result
|
---|
| 1074 |
|
---|
| 1075 |
|
---|
| 1076 | Pos(subStr,s,count)
|
---|
| 1077 | ;"Purpose: return the beginning position of subStr in s
|
---|
| 1078 | ;"Input: subStr -- the string to be searched for in s
|
---|
| 1079 | ;" s -- the string to search
|
---|
| 1080 | ;" count -- OPTIONAL, the instance to return pos of (1=1st, 2=2nd, etc.)
|
---|
| 1081 | ;" if count=2 and only 1 instance exists, then 0 returned
|
---|
| 1082 | ;"Result: the beginning position, or 0 if not found
|
---|
| 1083 | ;"Note: This function differs from $find in that $find returns the pos of the
|
---|
| 1084 | ;" first character AFTER the subStr
|
---|
| 1085 |
|
---|
| 1086 | set count=$get(count,1)
|
---|
| 1087 | new result set result=0
|
---|
| 1088 | new instance set instance=1
|
---|
| 1089 | PS1
|
---|
| 1090 | set result=$find(s,subStr,result+1)
|
---|
| 1091 | if result>0 set result=result-$length(subStr)
|
---|
| 1092 | if count>instance set instance=instance+1 goto PS1
|
---|
| 1093 |
|
---|
| 1094 | quit result
|
---|
| 1095 |
|
---|
| 1096 |
|
---|
| 1097 | ArrayPos(array,s)
|
---|
| 1098 | ;"Purpose: return the index position of s in array
|
---|
| 1099 |
|
---|
| 1100 | ;"...
|
---|
| 1101 |
|
---|
| 1102 | quit
|
---|
| 1103 |
|
---|
| 1104 | DiffPos(s1,s2)
|
---|
| 1105 | ;"Purpose: Return the position of the first difference between s1 and s2
|
---|
| 1106 | ;"Input -- s1, s2 : The strings to compare.
|
---|
| 1107 | ;"result: the position (in s1) of the first difference, or 0 if no difference
|
---|
| 1108 |
|
---|
| 1109 | new l set l=$length(s1)
|
---|
| 1110 | if $length(s2)>l set l=$length(s2)
|
---|
| 1111 | new done set done=0
|
---|
| 1112 | new i for i=1:1:l do quit:(done=1)
|
---|
| 1113 | . set done=($extract(s1,1,i)'=$extract(s2,1,i))
|
---|
| 1114 | new result set result=0
|
---|
| 1115 | if done=1 set result=i
|
---|
| 1116 | quit result
|
---|
| 1117 |
|
---|
| 1118 |
|
---|
| 1119 | DiffWPos(Words1,Words2)
|
---|
| 1120 | ;"Purpose: Return the index of the first different word between Words arrays
|
---|
| 1121 | ;"Input: Words1,Words2 -- the array of words, such as would be made
|
---|
| 1122 | ;" by CleaveToArray^TMGSTUTL
|
---|
| 1123 | ;"Returns: Index of first different word in Words1, or 0 if no difference
|
---|
| 1124 |
|
---|
| 1125 | new l set l=+$get(Words1("MAXNODE"))
|
---|
| 1126 | if +$get(Words2("MAXNODE"))>l set l=+$get(Words2("MAXNODE"))
|
---|
| 1127 | new done set done=0
|
---|
| 1128 | new i for i=1:1:l do quit:(done=1)
|
---|
| 1129 | . set done=($get(Words1(i))'=$get(Words2(i)))
|
---|
| 1130 | new result
|
---|
| 1131 | if done=1 set result=i
|
---|
| 1132 | else set result=0
|
---|
| 1133 | quit result
|
---|
| 1134 |
|
---|
| 1135 |
|
---|
| 1136 | SimStr(s1,p1,s2,p2)
|
---|
| 1137 | ;"Purpose: return the matching string in both s1 and s2, starting
|
---|
| 1138 | ;" at positions p1 and p2.
|
---|
| 1139 | ;" Example: s1='Tom is 12 years old', p1=7
|
---|
| 1140 | ;" s2='Bill will be 12 years young tomorrow' p2=13
|
---|
| 1141 | ;" would return ' 12 years '
|
---|
| 1142 |
|
---|
| 1143 | new ch1,ch2,offset,result,done
|
---|
| 1144 | set result="",done=0
|
---|
| 1145 | for offset=0:1:9999 do quit:(done=1)
|
---|
| 1146 | . set ch1=$extract(s1,p1+offset)
|
---|
| 1147 | . set ch2=$extract(s2,p2+offset)
|
---|
| 1148 | . if (ch1=ch2) set result=result_ch1
|
---|
| 1149 | . else set done=1
|
---|
| 1150 | quit result
|
---|
| 1151 |
|
---|
| 1152 |
|
---|
| 1153 | SimWord(Words1,p1,Words2,p2)
|
---|
| 1154 | ;"Purpose: return the matching words in both words array 1 and 2, starting
|
---|
| 1155 | ;" at word positions p1 and p2. This function is different from
|
---|
| 1156 | ;" SimStr in that it works with whole words
|
---|
| 1157 | ;" Example:
|
---|
| 1158 | ;" Words1(1)=Tom Words2(1)=Bill
|
---|
| 1159 | ;" Words1(2)=is Words2(2)=will
|
---|
| 1160 | ;" Words1(3)=12 Words2(3)=be
|
---|
| 1161 | ;" Words1(4)=years Words2(4)=12
|
---|
| 1162 | ;" Words1(5)=old Words2(5)=years
|
---|
| 1163 | ;" Words1("MAXNODE")=5 Words2(6)=young
|
---|
| 1164 | ;" Words2(7)=tomorrow
|
---|
| 1165 | ;" Words1("MAXNODE")=7
|
---|
| 1166 | ;" This will return 3, (where '12 years' starts)
|
---|
| 1167 | ;" if p1=3 and p2=4 would return '12 years'
|
---|
| 1168 | ;"Note: A '|' will be used as word separator when constructing result
|
---|
| 1169 | ;"Input: Words1,Words2 -- the array of words, such as would be made
|
---|
| 1170 | ;" by CleaveToArray^TMGSTUTL. e.g.
|
---|
| 1171 | ;" p1,p2 -- the index of the word in Words array to start with
|
---|
| 1172 | ;"result: (see example)
|
---|
| 1173 |
|
---|
| 1174 | new w1,w2,offset,result,done
|
---|
| 1175 | set result="",done=0
|
---|
| 1176 | for offset=0:1:$get(Words1("MAXNODE")) do quit:(done=1)
|
---|
| 1177 | . set w1=$get(Words1(offset+p1))
|
---|
| 1178 | . set w2=$get(Words2(offset+p2))
|
---|
| 1179 | . if (w1=w2)&(w1'="") do
|
---|
| 1180 | . . if (result'="") set result=result_"|"
|
---|
| 1181 | . . set result=result_w1
|
---|
| 1182 | . else set done=1
|
---|
| 1183 | quit result
|
---|
| 1184 |
|
---|
| 1185 |
|
---|
| 1186 | SimPos(s1,s2,DivStr,pos1,pos2,MatchStr)
|
---|
| 1187 | ;"Purpose: return the first position that two strings are similar. This means
|
---|
| 1188 | ;" the first position in string s1 that characters match in s2. A
|
---|
| 1189 | ;" match will be set to mean 3 or more characters being the same.
|
---|
| 1190 | ;" Example: s1='Tom is 12 years old'
|
---|
| 1191 | ;" s2='Bill will be 12 years young tomorrow'
|
---|
| 1192 | ;" This will return 7, (where '12 years' starts)
|
---|
| 1193 | ;"Input: s1,s2 -- the two strings to compare
|
---|
| 1194 | ;" DivStr -- OPTIONAL, the character to use to separate the answers
|
---|
| 1195 | ;" in the return string. Default is '^'
|
---|
| 1196 | ;" pos1 -- OPTIONAL, an OUT PARAMETER. Returns Pos1 from result
|
---|
| 1197 | ;" pos2 -- OPTIONAL, an OUT PARAMETER. Returns Pos2 from result
|
---|
| 1198 | ;" MatchStr -- OPTIONAL, an OUT PARAMETER. Returns MatchStr from result
|
---|
| 1199 | ;"Results: Pos1^Pos2^MatchStr Pos1=position in s1, Pos2=position in s2,
|
---|
| 1200 | ;" MatchStr=the matching Str
|
---|
| 1201 |
|
---|
| 1202 | set DivStr=$get(DivStr,"^")
|
---|
| 1203 | new startPos,subStr,found,s2Pos
|
---|
| 1204 | set found=0,s2Pos=0
|
---|
| 1205 | for startPos=1:1:$length(s1) do quit:(found=1)
|
---|
| 1206 | . set subStr=$extract(s1,startPos,startPos+3)
|
---|
| 1207 | . set s2Pos=$$Pos(subStr,s2)
|
---|
| 1208 | . set found=(s2Pos>0)
|
---|
| 1209 |
|
---|
| 1210 | new result
|
---|
| 1211 | if found=1 do
|
---|
| 1212 | . set pos1=startPos,pos2=s2Pos
|
---|
| 1213 | . set MatchStr=$$SimStr(s1,startPos,s2,s2Pos)
|
---|
| 1214 | else do
|
---|
| 1215 | . set pos1=0,pos2=0,MatchStr=""
|
---|
| 1216 |
|
---|
| 1217 | set result=pos1_DivStr_pos2_DivStr_MatchStr
|
---|
| 1218 |
|
---|
| 1219 | quit result
|
---|
| 1220 |
|
---|
| 1221 |
|
---|
| 1222 | SimWPos(Words1,Words2,DivStr,p1,p2,MatchStr)
|
---|
| 1223 | ;"Purpose: return the first position that two word arrays are similar. This means
|
---|
| 1224 | ;" the first index in Words array 1 that matches to words in Words array 2.
|
---|
| 1225 | ;" A match will be set to mean the two words are equal
|
---|
| 1226 | ;" Example:
|
---|
| 1227 | ;" Words1(1)=Tom Words2(1)=Bill
|
---|
| 1228 | ;" Words1(2)=is Words2(2)=will
|
---|
| 1229 | ;" Words1(3)=12 Words2(3)=be
|
---|
| 1230 | ;" Words1(4)=years Words2(4)=12
|
---|
| 1231 | ;" Words1(5)=old Words2(5)=years
|
---|
| 1232 | ;" Words1("MAXNODE")=5 Words2(6)=young
|
---|
| 1233 | ;" Words2(7)=tomorrow
|
---|
| 1234 | ;" Words2("MAXNODE")=7
|
---|
| 1235 | ;" This will return 3, (where '12 years' starts)
|
---|
| 1236 | ;"Input: Words1,Words2 -- the two arrays to compare
|
---|
| 1237 | ;" DivStr -- OPTIONAL, the character to use to separate the answers
|
---|
| 1238 | ;" in the return string. Default is '^'
|
---|
| 1239 | ;" pos1 -- OPTIONAL, an OUT PARAMETER. Returns Pos1 from result
|
---|
| 1240 | ;" pos2 -- OPTIONAL, an OUT PARAMETER. Returns Pos2 from result
|
---|
| 1241 | ;" MatchStr -- OPTIONAL, an OUT PARAMETER. Returns MatchStr from result
|
---|
| 1242 | ;"Results: Pos1^Pos2^MatchStr Pos1=position in Words1, Pos2=position in Words2,
|
---|
| 1243 | ;" MatchStr=the first matching Word or phrase
|
---|
| 1244 | ;" Note: | will be used as a word separator for phrases.
|
---|
| 1245 |
|
---|
| 1246 | set DivStr=$get(DivStr,"^")
|
---|
| 1247 | new startPos,word1,found,w2Pos
|
---|
| 1248 | set found=0,s2Pos=0
|
---|
| 1249 | for startPos=1:1:+$get(Words1("MAXNODE")) do quit:(found=1)
|
---|
| 1250 | . set word1=$get(Words1(startPos))
|
---|
| 1251 | . set w2Pos=$$IndexOf^TMGMISC($name(Words2),word1)
|
---|
| 1252 | . set found=(w2Pos>0)
|
---|
| 1253 |
|
---|
| 1254 | if found=1 do
|
---|
| 1255 | . set p1=startPos,p2=w2Pos
|
---|
| 1256 | . set MatchStr=$$SimWord(.Words1,p1,.Words2,p2)
|
---|
| 1257 | else do
|
---|
| 1258 | . set p1=0,p2=0,MatchStr=""
|
---|
| 1259 |
|
---|
| 1260 | new result set result=p1_DivStr_p2_DivStr_MatchStr
|
---|
| 1261 |
|
---|
| 1262 | quit result
|
---|
| 1263 |
|
---|
| 1264 |
|
---|
| 1265 | DiffStr(s1,s2,DivChr)
|
---|
| 1266 | ;"Purpose: Return how s1 differs from s2. E.g.
|
---|
| 1267 | ;" s1='Today was the birthday of Bill and John'
|
---|
| 1268 | ;" s2='Yesterday was the birthday of Tom and Sue'
|
---|
| 1269 | ;" results='Today^1^Bill^26^John^35'
|
---|
| 1270 | ;" This means that 'Today', starting at pos 1 in s1 differs
|
---|
| 1271 | ;" from s2. And 'Bill' starting at pos 26 differs from s2 etc..
|
---|
| 1272 | ;"Input: s1,s2 -- the two strings to compare
|
---|
| 1273 | ;" DivStr -- OPTIONAL, the character to use to separate the answers
|
---|
| 1274 | ;" in the return string. Default is '^'
|
---|
| 1275 | ;"Results: DiffStr1^pos1^DiffStr2^pos2^...
|
---|
| 1276 |
|
---|
| 1277 | set DivChr=$get(DivChr,"^")
|
---|
| 1278 | new result set result=""
|
---|
| 1279 | new offset set offset=0
|
---|
| 1280 | new p1,p2,matchStr,matchLen
|
---|
| 1281 | new diffStr,temp
|
---|
| 1282 | DSLoop
|
---|
| 1283 | set temp=$$SimPos(s1,s2,DivChr,.p1,.p2,.matchStr)
|
---|
| 1284 | ;"Returns: Pos1^Pos2^MatchStr Pos1=pos in s1, Pos2=pos in s2, MatchStr=the matching Str
|
---|
| 1285 | if p1=0 set:(s1'="") result=result_s1_DivChr_(+offset) goto DSDone
|
---|
| 1286 |
|
---|
| 1287 | set matchLen=$length(matchStr)
|
---|
| 1288 |
|
---|
| 1289 | if p1>1 do
|
---|
| 1290 | . set diffStr=$extract(s1,1,p1-1)
|
---|
| 1291 | . set result=result_diffStr_DivChr_(1+offset)_DivChr
|
---|
| 1292 | set offset=offset+(p1+matchLen-1)
|
---|
| 1293 | set s1=$extract(s1,p1+matchLen,9999) ;"trim s1
|
---|
| 1294 | set s2=$extract(s2,p2+matchLen,9999) ;"trim s2
|
---|
| 1295 | goto DSLoop
|
---|
| 1296 | DSDone
|
---|
| 1297 | quit result
|
---|
| 1298 |
|
---|
| 1299 |
|
---|
| 1300 | DiffWords(Words1,Words2,DivChr)
|
---|
| 1301 | ;"Purpose: Return how Word arrays Words1 differs from Words2. E.g.
|
---|
| 1302 | ;" Example:
|
---|
| 1303 | ;" Words1(1)=Tom Words2(1)=Bill
|
---|
| 1304 | ;" Words1(2)=is Words2(2)=will
|
---|
| 1305 | ;" Words1(3)=12 Words2(3)=be
|
---|
| 1306 | ;" Words1(4)=years Words2(4)=12
|
---|
| 1307 | ;" Words1(5)=old Words2(5)=years
|
---|
| 1308 | ;" Words1("MAXNODE")=5 Words2(6)=young
|
---|
| 1309 | ;" Words2(7)=tomorrow
|
---|
| 1310 | ;" Words1("MAXNODE")=7
|
---|
| 1311 | ;"
|
---|
| 1312 | ;" s1='Today was the birthday of Bill and John'
|
---|
| 1313 | ;" s2='Yesterday was the birthday of Tom and Sue'
|
---|
| 1314 | ;" results='Tom is^1^old^5'
|
---|
| 1315 | ;" This means that 'Tom is', starting at pos 1 in Words1 differs
|
---|
| 1316 | ;" from Words2. And 'old' starting at pos 5 differs from Words2 etc..
|
---|
| 1317 | ;"Input: Words1,Words2 -- PASS BY REFERENCE. The two word arrays to compare
|
---|
| 1318 | ;" DivStr -- OPTIONAL, the character to use to separate the answers
|
---|
| 1319 | ;" in the return string. Default is '^'
|
---|
| 1320 | ;"Note: The words in DiffStr are divided by "|"
|
---|
| 1321 | ;"Results: DiffStr1A>DiffStr1B^pos1>pos2^DiffStr2A>DiffStr2B^pos1>pos2^...
|
---|
| 1322 | ;" The A DiffStr would be what the value is in Words1, and
|
---|
| 1323 | ;" the B DiffStr would be what the value is in Words2, or @ if deleted.
|
---|
| 1324 |
|
---|
| 1325 | set DivChr=$get(DivChr,"^")
|
---|
| 1326 | new result set result=""
|
---|
| 1327 | new trimmed1,trimmed2 set trimmed1=0,trimmed2=0
|
---|
| 1328 | new p1,p2,matchStr,matchLen
|
---|
| 1329 | new diffStr1,diffStr2,temp
|
---|
| 1330 | new tWords1,tWords2
|
---|
| 1331 | merge tWords1=Words1
|
---|
| 1332 | merge tWords2=Words2
|
---|
| 1333 | new i,len1,len2,trimLen1,trimLen2
|
---|
| 1334 | new diffPos1,diffPos2
|
---|
| 1335 | set len1=+$get(tWords1("MAXNODE"))
|
---|
| 1336 | set len2=+$get(tWords2("MAXNODE"))
|
---|
| 1337 | DWLoop
|
---|
| 1338 | set temp=$$SimWPos(.tWords1,.tWords2,DivChr,.p1,.p2,.matchStr)
|
---|
| 1339 | ;"Returns: Pos1^Pos2^MatchStr Pos1=pos in s1, Pos2=pos in s2, MatchStr=the matching Str
|
---|
| 1340 |
|
---|
| 1341 | ;"Possible return options:
|
---|
| 1342 | ;" p1=p2=0 -- two strings have nothing in common
|
---|
| 1343 | ;" p1=p2=1 -- first word of each string is the same
|
---|
| 1344 | ;" p1=p2=X -- words 1..(X-1) differ from each other.
|
---|
| 1345 | ;" p1>p2 -- e.g. EXT REL TAB --> XR TAB
|
---|
| 1346 | ;" p1<p2 -- XR TAB --> EXT REL TAB
|
---|
| 1347 |
|
---|
| 1348 | if (p1=0)&(p2=0) do
|
---|
| 1349 | . set diffStr1=$$CatArray(.tWords1,1,len1,"|")
|
---|
| 1350 | . set diffStr2=$$CatArray(.tWords2,1,len2,"|")
|
---|
| 1351 | . set trimLen1=len1,trimLen2=len2
|
---|
| 1352 | . set diffPos1=1+trimmed1
|
---|
| 1353 | . set diffPos2=1+trimmed2
|
---|
| 1354 | else if (p1=1)&(p2=1) do
|
---|
| 1355 | . set diffStr1="@",diffStr2="@"
|
---|
| 1356 | . set trimLen1=1,trimLen2=1
|
---|
| 1357 | . set diffPos1=0,diffPos2=0
|
---|
| 1358 | else do
|
---|
| 1359 | . set diffStr1=$$CatArray(.tWords1,1,p1-1,"|")
|
---|
| 1360 | . set diffStr2=$$CatArray(.tWords2,1,p2-1,"|")
|
---|
| 1361 | . set trimLen1=p1-1,trimLen2=p2-1
|
---|
| 1362 | . set diffPos1=1+trimmed1,diffPos2=1+trimmed2
|
---|
| 1363 |
|
---|
| 1364 | if diffStr1="" set diffStr1="@"
|
---|
| 1365 | if diffStr2="" set diffStr2="@"
|
---|
| 1366 |
|
---|
| 1367 | if '((diffStr1="@")&(diffStr1="@")) do
|
---|
| 1368 | . set:(result'="")&($extract(result,$length(result))'=DivChr) result=result_DivChr
|
---|
| 1369 | . set result=result_diffStr1_">"_diffStr2_DivChr
|
---|
| 1370 | . set result=result_diffPos1_">"_diffPos2
|
---|
| 1371 |
|
---|
| 1372 | do ListTrim^TMGMISC("tWords1",1,trimLen1,"MAXNODE")
|
---|
| 1373 | do ListTrim^TMGMISC("tWords2",1,trimLen2,"MAXNODE")
|
---|
| 1374 | set trimmed1=trimmed1+trimLen1
|
---|
| 1375 | set trimmed2=trimmed2+trimLen2
|
---|
| 1376 |
|
---|
| 1377 | if ($get(tWords1("MAXNODE"))=0)&($get(tWords2("MAXNODE"))=0) goto DWDone
|
---|
| 1378 | goto DWLoop
|
---|
| 1379 |
|
---|
| 1380 | DWDone
|
---|
| 1381 | quit result
|
---|
| 1382 |
|
---|
| 1383 | CatArray(Words,i1,i2,DivChr)
|
---|
| 1384 | ;"Purpose: For given word array, return contatenated results from index1 to index2
|
---|
| 1385 | ;"Input: Words -- PASS BY REFERENCE. Array of Words, as might be created by CleaveToArray
|
---|
| 1386 | ;" i1 -- the index to start concat at
|
---|
| 1387 | ;" i2 -- the last index to include in concat
|
---|
| 1388 | ;" DivChr -- OPTIONAL. The character to used to separate words. Default=" "
|
---|
| 1389 |
|
---|
| 1390 | new result set result=""
|
---|
| 1391 | set DivChr=$get(DivChr," ")
|
---|
| 1392 | new i for i=i1:1:i2 do
|
---|
| 1393 | . new word set word=$get(Words(i))
|
---|
| 1394 | . if word="" quit
|
---|
| 1395 | . set:(result'="")&($extract(result,$length(result))'=DivChr) result=result_DivChr
|
---|
| 1396 | . set result=result_word
|
---|
| 1397 | quit result
|
---|
| 1398 |
|
---|
| 1399 |
|
---|
| 1400 | QtProtect(s)
|
---|
| 1401 | ;"Purpose: Protects quotes by converting all quotes do double quotes (" --> "")
|
---|
| 1402 | ;"Input : s -- The string to be modified. Original string is unchanged.
|
---|
| 1403 | ;"Result: returns a string with all instances of single instances of quotes
|
---|
| 1404 | ;" being replaced with two quotes.
|
---|
| 1405 |
|
---|
| 1406 | new tempS
|
---|
| 1407 | set tempS=$$Substitute($get(s),"""""","<^@^>") ;"protect original double quotes
|
---|
| 1408 | set tempS=$$Substitute(tempS,"""","""""")
|
---|
| 1409 | set tempS=$$Substitute(tempS,"<^@^>","""""") ;"reverse protection
|
---|
| 1410 | quit tempS
|
---|
| 1411 |
|
---|
| 1412 |
|
---|
| 1413 | GetStrPos(s,StartPos,P1,P2) ;"INCOMPLETE!!
|
---|
| 1414 | ;"Purpose: return position of start and end of a string (marked by starting
|
---|
| 1415 | ;" and ending quote. Search is started at StartPos.
|
---|
| 1416 | ;" Example: if s='She said "Hello" to Bill', and StartPos=1
|
---|
| 1417 | ;" then P1 should be returned as 10, and P2 as 16
|
---|
| 1418 | ;"Input: s -- the text to be
|
---|
| 1419 | ;" StartPos -- the position to start the search at. Optional: default=1
|
---|
| 1420 | ;" P1 -- PASS BY REFERENCE, an Out Parameter
|
---|
| 1421 | ;" P2 -- PASS BY REFERENCE, an Out Parameter
|
---|
| 1422 | ;"Results: None
|
---|
| 1423 | ;"Output: P1 and P2 are returned as per example above, or 0 if not quotes in text
|
---|
| 1424 |
|
---|
| 1425 | set P1=0,P2=0
|
---|
| 1426 | if s'["""" goto GSPDone
|
---|
| 1427 | set StartPos=+$get(StartPos,1)
|
---|
| 1428 | new tempS set tempS=$extract(s,StartPos,$length(s))
|
---|
| 1429 | set tempS=$$Substitute(tempS,"""""",$char(1)_$char(1))
|
---|
| 1430 |
|
---|
| 1431 | ;"FINISH... NOT COMPLETED...
|
---|
| 1432 | GSPDone
|
---|
| 1433 | quit
|
---|
| 1434 |
|
---|
| 1435 | InQt(s,Pos)
|
---|
| 1436 | ;"Purpose: to return if a given character, in string(s), is insided quotes
|
---|
| 1437 | ;" e.g. s='His name is "Bill," OK?' and if p=14, then returns 1
|
---|
| 1438 | ;" (note the above string is usually stored as:
|
---|
| 1439 | ;" "His name is ""Bill,"" OK?" in the text editor, BUT in the
|
---|
| 1440 | ;" strings that will be passed here I will get only 1 quote character
|
---|
| 1441 | ;"Input: s -- the string to scan
|
---|
| 1442 | ;" Pos -- the position of the character in question
|
---|
| 1443 | ;"Results: 0 if not inside quotes, 1 if it is.
|
---|
| 1444 | ;"NOTE: if Pos points to the bounding quotes, the result is 0
|
---|
| 1445 | new inQt set inQt=0
|
---|
| 1446 | if (Pos>$length(s))!(Pos<1) goto IQtDone
|
---|
| 1447 | new p set p=$find(s,"""")-1
|
---|
| 1448 | if p<Pos for p=p-1:1:Pos set:($extract(s,p)="""") inQt='inQt
|
---|
| 1449 | IQtDone quit inQt
|
---|
| 1450 |
|
---|
| 1451 |
|
---|
| 1452 | GetWord(s,Pos,OpenDiv,CloseDiv)
|
---|
| 1453 | ;"Purpose: Extract a word from a sentance, bounded by OpenDiv,CloseDiv
|
---|
| 1454 | ;"Example: s="The cat is hungry", Pos=14 --> returns "hungry"
|
---|
| 1455 | ;"Example: s="Find('Purple')", Pos=8, OpenDiv="(", CloseDiv=")" --> returns "'Purple'"
|
---|
| 1456 | ;"Input: s -- the string containing the source sentence
|
---|
| 1457 | ;" Pos -- the index of a character anywhere inside desired word.
|
---|
| 1458 | ;" OpenDiv -- OPTIONAL, default is " " this is what marks the start of the word.
|
---|
| 1459 | ;" NOTE: if $length(OpenDiv)>1, then OpenDiv is considered
|
---|
| 1460 | ;" to be a SET of characters, any of which can be used
|
---|
| 1461 | ;" as a opening character.
|
---|
| 1462 | ;" CloseDiv -- OPTIONAL, default is " " this is what marks the end of the word.
|
---|
| 1463 | ;" NOTE: if $length(CloseDiv)>1, then CloseDiv is considered
|
---|
| 1464 | ;" to be a SET of characters, any of which can be used
|
---|
| 1465 | ;" as a closing character.
|
---|
| 1466 | ;"Results: returns desired word, or "" if problem.
|
---|
| 1467 | ;
|
---|
| 1468 | new result set result=""
|
---|
| 1469 | set OpenDiv=$get(OpenDiv," ")
|
---|
| 1470 | set CloseDiv=$get(CloseDiv," ")
|
---|
| 1471 | set Pos=+$get(Pos) if Pos'>0 goto GWdDone
|
---|
| 1472 | new p1,p2,len,i
|
---|
| 1473 | set len=$length(s)
|
---|
| 1474 | for p2=Pos:1:len if CloseDiv[$extract(s,p2) set p2=p2-1 quit
|
---|
| 1475 | for p1=Pos:-1:1 if OpenDiv[$extract(s,p1) set p1=p1+1 quit
|
---|
| 1476 | set result=$extract(s,p1,p2)
|
---|
| 1477 | GWdDone quit result
|
---|
| 1478 |
|
---|
| 1479 | CmdChStrip(s)
|
---|
| 1480 | ;"Purpose: Strip all characters < #32 from string.
|
---|
| 1481 | new Codes,i,result
|
---|
| 1482 | set Codes=""
|
---|
| 1483 | for i=1:1:31 set Codes=Codes_$char(i)
|
---|
| 1484 | set result=$translate(s,Codes,"")
|
---|
| 1485 | quit result
|
---|
| 1486 |
|
---|
| 1487 | StrBounds(s,p)
|
---|
| 1488 | ;"Purpose: given position of start of string, returns index of end of string
|
---|
| 1489 | ;"Input: s -- the string to eval
|
---|
| 1490 | ;" p -- the index of the start of the string
|
---|
| 1491 | ;"Results : returns the index of the end of the string, or 0 if not found.
|
---|
| 1492 | new result set result=0
|
---|
| 1493 | for p=p+1:1 quit:(p>$length(s))!(result>0) do
|
---|
| 1494 | . if $extract(s,p)'="""" quit
|
---|
| 1495 | . set p=p+1
|
---|
| 1496 | . if $extract(s,p)="""" quit
|
---|
| 1497 | . set result=p-1
|
---|
| 1498 | quit result
|
---|
| 1499 |
|
---|
| 1500 | NonWhite(s,p)
|
---|
| 1501 | ;"Purpose: given starting position, return index of first non-whitespace character
|
---|
| 1502 | ;" Note: either a " " or a TAB [$char(9)] will be considered a whitespace char
|
---|
| 1503 | ;"result: returns index if non-whitespace, or index past end of string if none found.
|
---|
| 1504 | new result,ch,done
|
---|
| 1505 | for result=p:1 quit:(result>$length(s)) do quit:done
|
---|
| 1506 | . set ch=$extract(s,result)
|
---|
| 1507 | . set done=(ch'=" ")&(ch'=$char(9))
|
---|
| 1508 | quit result
|
---|
| 1509 |
|
---|
| 1510 | Pad2Pos(Pos,ch)
|
---|
| 1511 | ;"Purpose: return a string that can be used to pad from the current $X
|
---|
| 1512 | ;" screen cursor position, up to Pos, using char Ch (optional)
|
---|
| 1513 | ;"Input: Pos -- a screen X cursor position, i.e. from 1-80 etc (depending on screen width)
|
---|
| 1514 | ;" ch -- Optional, default is " "
|
---|
| 1515 | ;"Result: returns string of padded characters.
|
---|
| 1516 | new width set width=+$get(Pos)-$X if width'>0 set width=0
|
---|
| 1517 | quit $$LJ^XLFSTR("",width,.ch)
|
---|
| 1518 |
|
---|