| [796] | 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 |  
 | 
|---|