| 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 |  
 | 
|---|