1 | TMGABV ;TMG/kst/Abbreviation code ; 03/25/06
|
---|
2 | ;;1.0;TMG-LIB;**1**;12/23/05
|
---|
3 |
|
---|
4 | ;" ABBREVIATION code
|
---|
5 |
|
---|
6 | ;"Kevin Toppenberg MD
|
---|
7 | ;"GNU General Public License (GPL) applies
|
---|
8 | ;"12-23-2006
|
---|
9 |
|
---|
10 | ;"=======================================================================
|
---|
11 | ;" API -- Public Functions.
|
---|
12 | ;"=======================================================================
|
---|
13 | ;"$$Read(OrigName,LenCat,DefValue)
|
---|
14 | ;"Write(OrigName,ShortName,LenCat,AskConfirm)
|
---|
15 | ;"Del(OrigName,LenCat,AskConfirm)
|
---|
16 | ;"GetAbvr(Name,AskUser,UseSR)
|
---|
17 | ;"Fix(ShortName) -- provides a way to fix erroneous abbreviations.
|
---|
18 | ;"ShowDiff -- scan and show changes. This is not very useful (a testing function)
|
---|
19 | ;"ScanDel(Text) -- scan for text and allow deletions.
|
---|
20 |
|
---|
21 | ;"=======================================================================
|
---|
22 | ;" Private Functions.
|
---|
23 | ;"=======================================================================
|
---|
24 | ;"CheckDel(longName,DiffArray,DiffStr,lenCat)
|
---|
25 | ;"Fix1(ShortName) -- provide a way to fix erroneous abbreviations.
|
---|
26 | ;"ShowLinks(ShortName,LenCat,array) -- show a chain of abbreviations.
|
---|
27 | ;"GetDiff(longName,LenCat) -- for longName, return what changes for it's abbreviation
|
---|
28 | ;"GetDiffStr(longName,shortName) -- given longName and it's shortname abbreviation, return what changes
|
---|
29 | ;"ScanAbvs(xstr,showProgress) -- scan abbreviations and execute code
|
---|
30 |
|
---|
31 | ;"=======================================================================
|
---|
32 | ;"=======================================================================
|
---|
33 |
|
---|
34 | Read(OrigName,LenCat,DefValue)
|
---|
35 | ;"Purpose: To read from the ABBREV array and return an abbreviation
|
---|
36 | ;"Input: OrigName -- the name to look up
|
---|
37 | ;" LenCat -- OPTIONAL. If specified, then results returned from that category
|
---|
38 | ;" if LenCat="ALL" then all categories are scanned until some value found.
|
---|
39 | ;" DefValue -- OPTIONAL. If specified, a default value if not found
|
---|
40 | ;"Results: Returns the found abbreviation, or "" if not found
|
---|
41 |
|
---|
42 | set DefValue=$get(DefValue)
|
---|
43 | new result set result=DefValue
|
---|
44 | if $get(OrigName)="" goto RdDone
|
---|
45 | if $get(LenCat)'="" do
|
---|
46 | . if LenCat="ALL" do
|
---|
47 | . . set result=$get(^TMG("ABBREV",OrigName),DefValue) quit:(result'="")
|
---|
48 | . . set LenCat=""
|
---|
49 | . . for set LenCat=$order(^TMG("ABBREV",LenCat),-1) quit:(+LenCat'=LenCat)!(result'="") do
|
---|
50 | . . . set result=$get(^TMG("ABBREV",LenCat,OrigName),DefValue)
|
---|
51 | . else do
|
---|
52 | . . set result=$get(^TMG("ABBREV",LenCat,OrigName),DefValue)
|
---|
53 | else do
|
---|
54 | . set result=$get(^TMG("ABBREV",OrigName),DefValue)
|
---|
55 | RdDone
|
---|
56 | if result'="" do
|
---|
57 | . if ($get(TMGDBABV)=1)&(result'=OrigName) do
|
---|
58 | . . write OrigName,"-->",!,result," OK"
|
---|
59 | . . new % set %=1 do YN^DICN write !
|
---|
60 | . . if %=1 quit
|
---|
61 | . . set result=""
|
---|
62 | . . if %=-1 quit
|
---|
63 | . . if %=2 do Del(OrigNameName,.LenCat,1)
|
---|
64 |
|
---|
65 | quit result
|
---|
66 |
|
---|
67 |
|
---|
68 | Write(OrigName,ShortName,LenCat,AskConfirm)
|
---|
69 | ;"Purpose: To provide a unified writer for ABBREV array
|
---|
70 | ;"Input: OrigName -- the longer name that the abbreviation will stand for
|
---|
71 | ;" ShortName -- the shorter abbreviation of OrigName
|
---|
72 | ;" LenCat -- OPTIONAL -- If supplied, then abbreviation will be stored in this category
|
---|
73 | ;" AskConfirm -- OPTIONAL -- if 1 then user asked to confirm save.
|
---|
74 | ;"results: none
|
---|
75 | ;"Note: Assigning a NULL ShortName is not currently allowed.
|
---|
76 |
|
---|
77 | if $get(OrigName)="" goto WtDone
|
---|
78 | if $get(ShortName)="" goto WtDone
|
---|
79 | set AskConfirm=$get(AskConfirm,0)
|
---|
80 | if $$Read(OrigName,.LenCat)=ShortName goto WtDone ;"Skip write if already there
|
---|
81 | new % set %=1
|
---|
82 | if AskConfirm=1 do
|
---|
83 | W1 . write "[",OrigName,"] --> [",ShortName,"]",!
|
---|
84 | . write "Save for future use"
|
---|
85 | . do YN^DICN write !
|
---|
86 | if %'=1 goto WtDone
|
---|
87 | if $get(LenCat)'="" do
|
---|
88 | . set ^TMG("ABBREV",LenCat,OrigName)=ShortName
|
---|
89 | . set ^TMG("ABBREV",LenCat,"XREF",ShortName)=OrigName
|
---|
90 | else do
|
---|
91 | . set ^TMG("ABBREV",OrigName)=ShortName
|
---|
92 | . set ^TMG("ABBREV","XREF",ShortName)=OrigName
|
---|
93 | WtDone quit
|
---|
94 |
|
---|
95 |
|
---|
96 | Del(OrigName,LenCat,AskConfirm)
|
---|
97 | ;"Purpose: To delete a value from the ABBREV array
|
---|
98 | ;"Input: OrigName -- the name to look up
|
---|
99 | ;" LenCat -- OPTIONAL. If specified, then category to delete from
|
---|
100 | ;" AskConfirm -- OPTIONAL -- if 1 then user asked to confirm save.
|
---|
101 | ;"Results: none
|
---|
102 |
|
---|
103 | if $get(OrigName)="" goto DelDone
|
---|
104 | set AskConfirm=$get(AskConfirm,0)
|
---|
105 | new CurValue
|
---|
106 | if $get(LenCat)'="" set CurValue=$get(^TMG("ABBREV",LenCat,OrigName))
|
---|
107 | else set CurValue=$get(^TMG("ABBREV",OrigName))
|
---|
108 | new % set %=1
|
---|
109 | if AskConfirm=1 do
|
---|
110 | . write "[",OrigName,"] -->",!,"[",CurValue,"]",!
|
---|
111 | . write "OK to DELETE" do YN^DICN write !
|
---|
112 | if %'=1 goto DelDone
|
---|
113 | if $get(LenCat)'="" do
|
---|
114 | . kill ^TMG("ABBREV",LenCat,OrigName)
|
---|
115 | . kill ^TMG("ABBREV",LenCat,"XREF",CurValue)
|
---|
116 | else do
|
---|
117 | . kill ^TMG("ABBREV",OrigName)
|
---|
118 | . kill ^TMG("ABBREV","XREF",CurValue)
|
---|
119 | if AskConfirm'=1 goto DelDone
|
---|
120 |
|
---|
121 | ;"Now see if this same problem needs to be fixed in other abbreviations.
|
---|
122 | new tempS set tempS=$$GetDiffStr(OrigName,CurValue)
|
---|
123 | new DiffArray,count set count=1
|
---|
124 | write "That association had the following difference(s):",!
|
---|
125 | for quit:(tempS'["^") do
|
---|
126 | . new OneDiff set OneDiff=$piece(tempS,"^",1)
|
---|
127 | . set DiffArray(count)=OneDiff,count=count+1
|
---|
128 | . write " ",$piece(OneDiff,">",1)," --> ",$piece(OneDiff,">",2),!
|
---|
129 | . set tempS=tempS=$piece(tempS,"^",3,999)
|
---|
130 | set DiffArray("MAXNODE")=$$ListCt^TMGMISC("DiffArray")
|
---|
131 | set %=1
|
---|
132 | write "Delete all other abbreviations that have these difference(s)"
|
---|
133 | do YN^DICN write !
|
---|
134 | if %'=1 goto DelDone
|
---|
135 | Del1 new xstr set xstr="do CheckDel(longName,.DiffArray,DiffStr,lenCat)"
|
---|
136 | do ScanAbvs(xstr,1)
|
---|
137 |
|
---|
138 | DelDone quit
|
---|
139 |
|
---|
140 |
|
---|
141 | CheckDel(longName,DiffArray,DiffStr,lenCat)
|
---|
142 | ;"Purpose: this is a callback function for a ScanAbvs run
|
---|
143 | ;" it will be called for each abbreviation
|
---|
144 | ;"Input: DiffArray -- PASS BY REFERENCE. Format:
|
---|
145 | ;" DiffArray(1)="Long1>short1"
|
---|
146 | ;" DiffArray(2)="Long2>short2"
|
---|
147 | ;" DiffArray(3)="Long3>short3"
|
---|
148 | ;" DiffArray("MAXNODE")=3
|
---|
149 | ;" DiffStr -- a difference string, as created by $$GetDiff
|
---|
150 | ;" lenCat -- the category that eval is from, or "" if none
|
---|
151 |
|
---|
152 | new shouldDel set shouldDel=1
|
---|
153 | new i for i=1:1:+$get(DiffArray("MAXNODE")) do quit:(shouldDel=0)
|
---|
154 | . set shouldDel=DiffStr[DiffArray(i)
|
---|
155 |
|
---|
156 | if shouldDel=1 do Del(longName,lenCat,0)
|
---|
157 | quit
|
---|
158 |
|
---|
159 |
|
---|
160 |
|
---|
161 | GetAbvr(Name,AskUser,UseSR)
|
---|
162 | ;"Purpose: To get an abbreviation for one word
|
---|
163 | ;"Input: Name -- name to shorten
|
---|
164 | ;" AskUser -- if 1, then user will be asked to supply abbreviations
|
---|
165 | ;" UseSR -- OPTIONAL, default=0. If 0, then ^DIR won't be used
|
---|
166 | ;"Note: The name returned here may be longer than desired, no testing of length done.
|
---|
167 | ;"Results: Returns abreviated name, or original name if not found, or "" if deleted
|
---|
168 |
|
---|
169 | set UseSR=$get(UseSR,0)
|
---|
170 |
|
---|
171 | new result,Y
|
---|
172 | set result=$get(Name)
|
---|
173 | if Name="" goto GADone
|
---|
174 | if $get(AskUser)=1 do
|
---|
175 | . write "Enter a shorter form of '"_Name_"' (^ to delete)",!
|
---|
176 | . if UseSR do
|
---|
177 | . . new DIR
|
---|
178 | . . set DIR(0)="F"
|
---|
179 | . . set DIR("A")="New Name"
|
---|
180 | . . set DIR("B")=result
|
---|
181 | . . do ^DIR write !
|
---|
182 | . else do
|
---|
183 | . . read "New Name: ",Y:($get(DTIME,3600)),!
|
---|
184 | . if Y="^" do quit
|
---|
185 | . . write "Delete word from name"
|
---|
186 | . . new % set %=1 do YN^DICN write !
|
---|
187 | . . if %=1 set result=""
|
---|
188 | . if Y'=result do
|
---|
189 | . . do Write(Name,Y,,1) ;"1=> confirm save
|
---|
190 | . . set result=Y
|
---|
191 | else do
|
---|
192 | . set result=$$Read(Name,,Name)
|
---|
193 | . if result="^" set result="" do Del(Name)
|
---|
194 | . if result="" quit
|
---|
195 | . if ($get(TMGDBABV)=1)&(result'=Name) do
|
---|
196 | . . write Name,"-->",!,result,!," OK"
|
---|
197 | . . new % set %=1 do YN^DICN write !
|
---|
198 | . . if %=1 quit
|
---|
199 | . . if %=-1 set result="" quit
|
---|
200 | . . if %=2 do
|
---|
201 | . . . write "Delete abbreviation" do YN^DICN write !
|
---|
202 | . . . if %=1 do Del(Name) set result=""
|
---|
203 |
|
---|
204 | GADone
|
---|
205 | quit result
|
---|
206 |
|
---|
207 |
|
---|
208 |
|
---|
209 | Fix(ShortName,Context)
|
---|
210 | ;"Purpose: To provide a way to fix erroneous abbreviations.
|
---|
211 | ;"Input: ShortName -- the abbreviation to fix.
|
---|
212 | ;" Context -- OPTIONAL. The sentence ShortName is found in.
|
---|
213 | ;"Result: Returns new name after fixing mislinked abbreviations,
|
---|
214 | ;" or 0 for requested retry
|
---|
215 |
|
---|
216 | new Menu,Option
|
---|
217 | set Context=$get(Context)
|
---|
218 | new result set result=""
|
---|
219 |
|
---|
220 | FL1 if Context="" goto FL2
|
---|
221 |
|
---|
222 | set Menu(0)="Pick Which to Fix"
|
---|
223 | set Menu(1)=ShortName
|
---|
224 | set Menu(2)=Context
|
---|
225 | write #
|
---|
226 | set Option=$$Menu^TMGUSRIF(.Menu,"^")
|
---|
227 | if Option="^" goto FixDone
|
---|
228 |
|
---|
229 | FL2 if (Option=1)!(Context="") do goto:(Context'="") FL1 goto FixDone
|
---|
230 | . set ShortName=$$Fix1(ShortName)
|
---|
231 | . if ShortName'="" set result=ShortName
|
---|
232 | if (Option=2) do goto FixDone
|
---|
233 | . new temp set temp=$$Fix1(Context)
|
---|
234 | . set result=0
|
---|
235 | if (Option="^") goto FixDone
|
---|
236 | goto FL1
|
---|
237 |
|
---|
238 | FixDone
|
---|
239 | quit result
|
---|
240 |
|
---|
241 |
|
---|
242 | Fix1(ShortName)
|
---|
243 | ;"Purpose: To provide a way to fix erroneous abbreviations.
|
---|
244 | ;"Input: ShortName -- the abbreviation to fix.
|
---|
245 | ;"Result: Returns new name after fixing mislinked abbreviations.
|
---|
246 |
|
---|
247 | new array,Option
|
---|
248 | new Name,LenCat
|
---|
249 | new result set result=""
|
---|
250 | new max
|
---|
251 | Fix1Loop
|
---|
252 | kill array
|
---|
253 | do ShowLinks(ShortName,,.array)
|
---|
254 | ;"Return Format
|
---|
255 | ;" array(x)=ShortName <-- LongerName[TAB]LongerName^LenCat
|
---|
256 |
|
---|
257 | set max=+$get(array("MAX"))
|
---|
258 | kill array("MAX")
|
---|
259 | set array(0)="Pick item to DELETE"
|
---|
260 | write #
|
---|
261 | set Option=$$Menu^TMGUSRIF(.array,"^")
|
---|
262 | if Option="^" goto Fix1Done
|
---|
263 | set Name=$piece(Option,"^",1)
|
---|
264 | set LenCat=$piece(Option,"^",2)
|
---|
265 | do Del(Name,LenCat,1)
|
---|
266 | goto Fix1Loop
|
---|
267 |
|
---|
268 | Fix1Done
|
---|
269 | new s set s=$get(array(max))
|
---|
270 | set s=$piece(s,$char(9),2)
|
---|
271 | set s=$piece(s,"^",1)
|
---|
272 | set result=s
|
---|
273 | quit result
|
---|
274 |
|
---|
275 |
|
---|
276 |
|
---|
277 | ShowLinks(ShortName,LenCat,array)
|
---|
278 | ;"Purpose: To show a chain of abbreviations.
|
---|
279 | ;"Input: ShortName -- the abbreviation to check.
|
---|
280 | ;" LenCat -- the category to look in
|
---|
281 | ;" Array -- PASS BY REFERENCE. an OUT PARAMETER. Format
|
---|
282 | ;" array("MAX")=maxCount (e.g. 2)
|
---|
283 | ;" array(1)=ShortName <-- LongerName[TAB]LongerName^LenCat
|
---|
284 | ;" array(2)=ShortName <-- LongerName[TAB]LongerName^LenCat
|
---|
285 |
|
---|
286 | new i set i=""
|
---|
287 | new max set max=$get(array("MAX"),0)
|
---|
288 | new value set value=""
|
---|
289 | if $get(LenCat)="" do
|
---|
290 | . for set i=$order(^TMG("ABBREV",i)) quit:(+i'>0) do
|
---|
291 | . . do ShowLinks(ShortName,i,.array)
|
---|
292 | . set value=$get(^TMG("ABBREV","XREF",ShortName))
|
---|
293 | else do
|
---|
294 | . set value=$get(^TMG("ABBREV",LenCat,"XREF",ShortName))
|
---|
295 | if value'="" do
|
---|
296 | . set max=max+1
|
---|
297 | . write max,". ",ShortName," <-- ",value,!
|
---|
298 | . set array(max)=ShortName_" <-- "_value_$char(9)_value_"^"_$get(LenCat)
|
---|
299 | . set array("MAX")=max
|
---|
300 | . do ShowLinks(value,.LenCat,.array)
|
---|
301 |
|
---|
302 | quit
|
---|
303 |
|
---|
304 | GetDiff(longName,LenCat)
|
---|
305 | ;"Purpose: for a given longName, return what changes for it's abbreviation
|
---|
306 | ;"Input: longName -- the original name to search for
|
---|
307 | ;" LenCat -- OPTIONAL. Default is "ALL"
|
---|
308 | ;"Results: returns difference between longName and its abbreviation, or "" if none.
|
---|
309 | ;"Results: DiffLong1>DiffShort1^pos1>pos2^DiffLong2>DiffShort2^pos1>pos2^...
|
---|
310 |
|
---|
311 | new result set result=""
|
---|
312 | set LenCat=$get(LenCat,"ALL")
|
---|
313 | new shortName set shortName=$$Read(longName,LenCat)
|
---|
314 | if shortName'="" set result=$$GetDiffStr(longName,shortName)
|
---|
315 | quit result
|
---|
316 |
|
---|
317 |
|
---|
318 | GetDiffStr(longName,shortName)
|
---|
319 | ;"Purpose: for a given longName and it's shortname abbreviation,
|
---|
320 | ;" return what changes for it's abbreviation
|
---|
321 | ;"Results: returns difference between longName and shortName, or "" if none.
|
---|
322 | ;"Results: DiffLong1>DiffShort1^pos1>pos2^DiffLong2>DiffShort2^pos1>pos2^...
|
---|
323 |
|
---|
324 | new DiffStr set DiffStr=""
|
---|
325 | ;"if $get(shortName)="" goto GDSDone
|
---|
326 | new longWords,shortWords
|
---|
327 | new DivCh set DivCh=" "
|
---|
328 | if $length(longName,"/")>3 set DivCh="/"
|
---|
329 | do CleaveToArray^TMGSTUTL(longName,DivCh,.longWords)
|
---|
330 | do CleaveToArray^TMGSTUTL(shortName,DivCh,.shortWords)
|
---|
331 | new temp,i
|
---|
332 | set temp=$$DiffWords^TMGSTUTL(.longWords,.shortWords)
|
---|
333 | for do quit:(temp="")
|
---|
334 | . new origS,destNum
|
---|
335 | . set origS=$piece(temp,"^",1)
|
---|
336 | . set temp=$piece(temp,"^",3,999)
|
---|
337 | . if DiffStr'="" set DiffStr=DiffStr_"^"
|
---|
338 | . set DiffStr=DiffStr_origS
|
---|
339 | GDSDone quit DiffStr
|
---|
340 |
|
---|
341 |
|
---|
342 | ScanAbvs(xstr,showProgress)
|
---|
343 | ;"Purpose: scan abbreviations and execute code
|
---|
344 | ;"Input: xstr -- OPTIONAL. m code to execute for each entry.´
|
---|
345 | ;" showProgress -- OPTIONAL. if 1, progress bar is shown.
|
---|
346 | ;"Note: The following variables will be defined, for use in xstr:
|
---|
347 | ;" longName,shortName,DiffStr,lenCat
|
---|
348 |
|
---|
349 | new longName,shortName,lenCat,DiffStr
|
---|
350 |
|
---|
351 | set longName="",lenCat=""
|
---|
352 |
|
---|
353 | new Itr
|
---|
354 | ;"for set longName=$order(^TMG("ABBREV",longName),-1) quit:(+longName>0) do
|
---|
355 | set longName=$$ItrAInit^TMGITR($name(^TMG("ABBREV")),.Itr,-1)
|
---|
356 | if $get(showProgress)=1 do PrepProgress^TMGITR(.Itr,20,1,"longName")
|
---|
357 | if longName'="" for do quit:(+$$ItrANext^TMGITR(.Itr,.longName,-1)>0)!(longName="")
|
---|
358 | . new shortName
|
---|
359 | . set shortName=$get(^TMG("ABBREV",longName))
|
---|
360 | . set DiffStr=$$GetDiffStr(longName,shortName)
|
---|
361 | . if xstr'="" xecute xstr
|
---|
362 |
|
---|
363 | set lenCat=0
|
---|
364 | for set lenCat=$order(^TMG("ABBREV",lenCat)) quit:(+lenCat'=lenCat) do
|
---|
365 | . if $get(showProgress)=1 write !
|
---|
366 | . ;"set longName=""
|
---|
367 | . ;"for set longName=$order(^TMG("ABBREV",lenCat,longName),-1) quit:(+longName>0)!(longName="") do
|
---|
368 | . set longName=$$ItrAInit^TMGITR($name(^TMG("ABBREV",lenCat)),.Itr,-1)
|
---|
369 | . if $get(showProgress)=1 do PrepProgress^TMGITR(.Itr,20,1,"longName")
|
---|
370 | . if longName'="" for do quit:(+$$ItrANext^TMGITR(.Itr,.longName,-1)>0)!(longName="")
|
---|
371 | . . new shortName set shortName=$get(^TMG("ABBREV",longName))
|
---|
372 | . . set DiffStr=$$GetDiffStr(longName,shortName)
|
---|
373 | . . if xstr'="" xecute xstr
|
---|
374 |
|
---|
375 | quit
|
---|
376 |
|
---|
377 |
|
---|
378 | ShowDiff
|
---|
379 | ;"Purpose: scan and show changes
|
---|
380 |
|
---|
381 | new xstr
|
---|
382 | set xstr="write longName,"" --> ["",DiffStr,""] "",shortName,!"
|
---|
383 | do ScanAbvs(xstr,1)
|
---|
384 | quit
|
---|
385 |
|
---|
386 |
|
---|
387 | ScanDel(Text)
|
---|
388 | ;"Purpose: scan for text and allow deletions.
|
---|
389 |
|
---|
390 | new xstr
|
---|
391 | set xstr="if DiffStr[Text do Del(longName,,1)"
|
---|
392 | do ScanAbvs(xstr)
|
---|
393 | quit
|
---|
394 |
|
---|
395 |
|
---|