| [796] | 1 | TMGSHORT ;TMG/kst/Code to Shorten Names ;03/25/06
|
|---|
| 2 | ;;1.0;TMG-LIB;**1**;12/23/06
|
|---|
| 3 |
|
|---|
| 4 | ;" SHORTEN NAMES 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 | ;"ShortNetName(GenericName,TradeName,Strength,Units,MaxLen)
|
|---|
| 14 | ;"$$ShortenArray(Names,Dividers,MaxLen,AllowCut) -- core menus for shortening name
|
|---|
| 15 | ;"$$PShortName(Name,Length,AskUser) -- shorten the drug smartly, using abbreviations
|
|---|
| 16 | ;"$$ShortName(Name,Length,AskUser,DivStr) -- shorten the drug smartly, using abbreviations
|
|---|
| 17 | ;"$$Short2Name(Name,Div1,Div2,.Words,.Dividers) -- Shorten a name to shortest form possible
|
|---|
| 18 | ;"$$Short1Name(Name,MaxLen,Div1,Div2,Words,Dividers) -- An interactive editing of one name
|
|---|
| 19 | ;"$$Cut1Name(Name,MaxLen,Div1,Div2,Words,Dividers) -- A non-interactive cut of one name
|
|---|
| 20 |
|
|---|
| 21 | ;"=======================================================================
|
|---|
| 22 | ;" Private Functions.
|
|---|
| 23 | ;"=======================================================================
|
|---|
| 24 | ;"$$ReadJoin(JoinNum,Len,Words,Dividers) -- read out a phrase of joined words, Len words long
|
|---|
| 25 | ;"SetJoin(JoinNum,Len,Words,Dividers) -- reform the Word and Dividers arrays such that
|
|---|
| 26 | ;" words are joined together. E.g. #1='One' #2='Minute' ==> #1='One Minute'
|
|---|
| 27 | ;"SubDivArray(Words,Dividers,Div1,Div2) -- check and handle if words in Words array need subdivision
|
|---|
| 28 | ;"PackArrays(pNames,pDividers) -- pack the arrays, after items had been deleted.
|
|---|
| 29 | ;"CompArray(Names,Dividers) -- reconstruct the resulting sentence from words in array.
|
|---|
| 30 | ;"AutoShortenArray(.Names,.Dividers,MaxLen,Div1,Div2) -- automatically shorten the words in the array
|
|---|
| 31 | ;"$$CutName(.Names,.Dividers,MaxLen) -- return a non-interactive shortened ('cut') name
|
|---|
| 32 |
|
|---|
| 33 | ;"=======================================================================
|
|---|
| 34 | ;"=======================================================================
|
|---|
| 35 |
|
|---|
| 36 | ShortNetName(GenericName,TradeName,Strength,Units,MaxLen,AllowCut)
|
|---|
| 37 | ;"Purpose: to create a shortened name from parts, not longer than MaxLen
|
|---|
| 38 | ;"Input: GenericName -- Generic portion of name
|
|---|
| 39 | ;" TradeName -- Tradename portion of name
|
|---|
| 40 | ;" Strength -- OPTIONAL Strength portion of name
|
|---|
| 41 | ;" Units -- OPTIONAL units portion of name
|
|---|
| 42 | ;" MaxLen -- the maximum length
|
|---|
| 43 | ;" AllowCut -- OPTIONAL If 1 then name may be cut off with ... to reach target length
|
|---|
| 44 | ;" and user will not be asked for input
|
|---|
| 45 | ;" If 2 then name wil be shortened as far as possible, but it
|
|---|
| 46 | ;" wil not be cut off
|
|---|
| 47 | ;"Result: Returns new shortened name, or "^" for user abort
|
|---|
| 48 |
|
|---|
| 49 | new result,temp
|
|---|
| 50 | set GenericName=$get(GenericName)
|
|---|
| 51 | set TradeName=$get(TradeName)
|
|---|
| 52 | set Strength=$get(Strength)
|
|---|
| 53 | set Units=$get(Units)
|
|---|
| 54 | set MaxLen=$get(MaxLen,16)
|
|---|
| 55 | set AllowCut=$get(AllowCut,0)
|
|---|
| 56 |
|
|---|
| 57 | new Names,Dividers
|
|---|
| 58 | new unitsIdx,GenericIdx set GenericIdx=0,unitsIdx=0
|
|---|
| 59 | ;"sometimes 'Trade Name' is actually an expanded form of the Generic name
|
|---|
| 60 | ;"e.g. ACETAZOLAMIDE (ACETAZOLAMIDE CAP USP) 250
|
|---|
| 61 | ;"In these cases I will delete the duplication
|
|---|
| 62 | SNN0 if $extract(TradeName,1,$length(GenericName))=GenericName set GenericName=""
|
|---|
| 63 | if (TradeName="")!(GenericName="") do
|
|---|
| 64 | . new i set i=0
|
|---|
| 65 | . if TradeName'="" set i=i+1,Names(i)=TradeName,Dividers(i)=" "
|
|---|
| 66 | . if GenericName'="" set i=i+1,Names(i)=GenericName,Dividers(i)=" ",GenericIdx=i
|
|---|
| 67 | . ;"set Names(i)=TradeName,Dividers(i)=" ",i=i+1
|
|---|
| 68 | . if Strength'="" set i=i+1,Names(i)=Strength,Dividers(i)=" "
|
|---|
| 69 | . if Units'="" set i=i+1,Names(i)=Units,unitsIdx=i,Dividers(i)=""
|
|---|
| 70 | . set Names("MAXNODE")=i,Dividers("MAXNODE")=i
|
|---|
| 71 | else do
|
|---|
| 72 | . new i set i=0
|
|---|
| 73 | . set i=i+1,Names(i)=TradeName,Dividers(i)=" ("
|
|---|
| 74 | . set i=i+1,Names(i)=GenericName,GenericIdx=i,Dividers(i)=") "
|
|---|
| 75 | . ;"set i=i+1,Names(i)=GenericName,GenericIdx=i,Dividers(i)=" (" ;changed 10-30-07
|
|---|
| 76 | . ;"set i=i+1,Names(i)=TradeName,Dividers(i)=") "
|
|---|
| 77 | . if Strength'="" set i=i+1,Names(i)=Strength,Dividers(i)=" "
|
|---|
| 78 | . if Units'="" set i=i+1,Names(i)=Units,unitsIdx=i,Dividers(i)=""
|
|---|
| 79 | . set Names("MAXNODE")=i,Dividers("MAXNODE")=i
|
|---|
| 80 |
|
|---|
| 81 | for i=1:1:Names("MAXNODE")-1 do ;"don't cleave units (e.g. MG/ML)
|
|---|
| 82 | . set:(i>1) Names(i)=$translate(Names(i),"/","|")
|
|---|
| 83 | do SubDivArray(.Names,.Dividers," ","/")
|
|---|
| 84 |
|
|---|
| 85 | set result=$$ShortenArray(.Names,.Dividers,MaxLen,AllowCut)
|
|---|
| 86 | if result=0 kill Names,Dividers goto SNN0 ;"honor requested retry
|
|---|
| 87 |
|
|---|
| 88 | ;"If shortening required "...", see if removing parts of name allow goal.
|
|---|
| 89 | if (AllowCut=1)&(result["...") do
|
|---|
| 90 | SNN1 . ;"try removing units first
|
|---|
| 91 | . kill Names(unitsIdx),Dividers(unitsIdx)
|
|---|
| 92 | . do PackArrays("Names","Dividers")
|
|---|
| 93 | . set result=$$ShortenArray(.Names,.Dividers,MaxLen,AllowCut)
|
|---|
| 94 | . if result'["..." quit
|
|---|
| 95 | . if GenericIdx'=0 do
|
|---|
| 96 | . . kill Names(GenericIdx)
|
|---|
| 97 | . . if Dividers(GenericIdx)=" (" set Dividers(GenericIdx+1)=" "
|
|---|
| 98 | . . kill Dividers(GenericIdx)
|
|---|
| 99 | . . do PackArrays("Names","Dividers")
|
|---|
| 100 | . . set result=$$ShortenArray(.Names,.Dividers,MaxLen,AllowCut)
|
|---|
| 101 | . if result'["..." quit
|
|---|
| 102 | . ;"more later... ?
|
|---|
| 103 |
|
|---|
| 104 | SNNDone
|
|---|
| 105 | set result=$$Trim^TMGSTUTL(result)
|
|---|
| 106 | if $extract(result,1,1)="(" do ;"Input transform doesn't allow first chart to be '('
|
|---|
| 107 | . ;"NOTE: I should write better code to change only the LAST ) to "", i.e. not cut out ALL ()'s
|
|---|
| 108 | . set result=$translate(result,"(","")
|
|---|
| 109 | . set result=$translate(result,")","")
|
|---|
| 110 | if (result[")")&(result'["(") set result=$translate(result,")","")
|
|---|
| 111 | set result=$translate(result,"|","/")
|
|---|
| 112 | quit result
|
|---|
| 113 |
|
|---|
| 114 |
|
|---|
| 115 | ShortenArray(Names,Dividers,MaxLen,AllowCut)
|
|---|
| 116 | ;"Purpose: shorten name
|
|---|
| 117 | ;"Input: Names -- PASS BY REFERENCE. An array containing the words
|
|---|
| 118 | ;" Dividers -- PASS BY REFERENCE. An array containing the bits between words
|
|---|
| 119 | ;" MaxLen -- OPTIONAL. Default=1. The length that words must fit within
|
|---|
| 120 | ;" AllowCut -- OPTIONAL. Default=0. Set 1 if automatic shortening is allowed.
|
|---|
| 121 | ;" If 1, MaxLen value SHOULD BE supplied
|
|---|
| 122 | ;" If 2 then name wil be shortened as far as possible, but it
|
|---|
| 123 | ;" wil not be cut off. User will not be asked.
|
|---|
| 124 |
|
|---|
| 125 | ;"Result: returns the shortened name, or "^" for abort, or 0 for requested retry.
|
|---|
| 126 |
|
|---|
| 127 | new result set result=""
|
|---|
| 128 | set MaxLen=$get(MaxLen,1)
|
|---|
| 129 | set AllowCut=$get(AllowCut,0)
|
|---|
| 130 | new UserAsked set UserAsked=0
|
|---|
| 131 | new StartOver set StartOver=0
|
|---|
| 132 | new OrigName set OrigName=$$CompArray(.Names,.Dividers)
|
|---|
| 133 |
|
|---|
| 134 | ;"First try a non-interactive shortening
|
|---|
| 135 | set result=$$AutoShortenArray(.Names,.Dividers,MaxLen,"/"," ")
|
|---|
| 136 | if (AllowCut'=1)&(result["...") goto SNA0
|
|---|
| 137 | if $length(result)'>MaxLen goto SNA1Done
|
|---|
| 138 |
|
|---|
| 139 | SNA0 if AllowCut=1 set result=$$CutName(.Names,.Dividers,MaxLen) goto SNA1Done
|
|---|
| 140 | if AllowCut=2 set result=$$CompArray(.Names,.Dividers) goto SNA1Done
|
|---|
| 141 |
|
|---|
| 142 | SNA1 if result=0 goto SNA2Done ;"requesting retry.
|
|---|
| 143 | set result=$$Trim^TMGSTUTL($$CompArray(.Names,.Dividers))
|
|---|
| 144 | if $length(result)'>MaxLen goto SNA1Done
|
|---|
| 145 |
|
|---|
| 146 | write OrigName,"-->",!
|
|---|
| 147 | write "Current Name:",!
|
|---|
| 148 | write result,!
|
|---|
| 149 | if MaxLen>1 do
|
|---|
| 150 | . new tempS set tempS="Shorten to ---> |"
|
|---|
| 151 | . for i=1:1:MaxLen-$length(tempS) write " "
|
|---|
| 152 | . write tempS
|
|---|
| 153 | . for i=1:1:$length(result)-MaxLen write "x"
|
|---|
| 154 | . write !
|
|---|
| 155 |
|
|---|
| 156 | write "-----------------------",!
|
|---|
| 157 | for i=1:1:Names("MAXNODE") do
|
|---|
| 158 | . if $get(Names(i))="" quit
|
|---|
| 159 | . write i,". ",Names(i)
|
|---|
| 160 | . new temp set temp=$$GetAbvr^TMGABV(Names(i),0)
|
|---|
| 161 | . if (temp'="")&(temp'=Names(i)) write " (<-- Quick Fix: ",temp,")"
|
|---|
| 162 | . write !
|
|---|
| 163 | write "-----------------------",!
|
|---|
| 164 | write " # (or #-#) -- Shorten name(s) Q# (or #-#) -- Use Quick FiX",!
|
|---|
| 165 | write " S# -- Sub-edit name T -- Free text for ALL",!
|
|---|
| 166 | write " S?# -- Sub-edit name (ask for divider character)",!
|
|---|
| 167 | write " Sx# -- Sub-edit name (use any character (i.e. replace 'x') as divider)",!
|
|---|
| 168 | write " J# -- Join word # to word #+1 F# -- Fix erroneous abbrev",!
|
|---|
| 169 | write " D# (or D#-#) -- Delete # X# -- Kill Quick Fix",!
|
|---|
| 170 | write " ! -- toggle debug mode ",$select(($get(TMGDBABV)=1):"OFF",1:"ON"),!
|
|---|
| 171 | write " C -- cut to: ",$$CutName(.Names,.Dividers,MaxLen),!
|
|---|
| 172 | ;"write " ^^ -- Abort",!
|
|---|
| 173 | write "(^ to quit, ^^ to abort): ^//"
|
|---|
| 174 | set UserAsked=1
|
|---|
| 175 | read temp:$get(DTIME,3600),!
|
|---|
| 176 | set temp=$$UP^XLFSTR(temp)
|
|---|
| 177 | if temp="" set temp="^" do goto SNA1Done
|
|---|
| 178 | . set result=$$CompArray(.Names,.Dividers)
|
|---|
| 179 | if temp="^^" set result="^" goto SNA2Done
|
|---|
| 180 | if temp="C" set AllowCut=1 goto SNA0
|
|---|
| 181 | if "S"[$extract(temp,1) do
|
|---|
| 182 | . new num1,s
|
|---|
| 183 | . new nodeDiv set nodeDiv=" "
|
|---|
| 184 | . set s=$extract(temp,2)
|
|---|
| 185 | . if +s'=s do quit:(nodeDiv="^")
|
|---|
| 186 | . . if s="?" do quit:(nodeDiv="^")
|
|---|
| 187 | . . . write "Enter character that divides words (e.g. '/' ',' '|' ';' ' ' etc.)",!
|
|---|
| 188 | . . . read "Divider character? ' '// ",nodeDiv,!
|
|---|
| 189 | . . . if nodeDiv="" set nodeDiv=" "
|
|---|
| 190 | . . else set nodeDiv=s
|
|---|
| 191 | . . set num1=+$extract(temp,3,99)
|
|---|
| 192 | . else set num1=+$extract(temp,2,99)
|
|---|
| 193 | . if num1=0 read "Enter NUMBER of name to edit: ",num1:$get(DTIME,3600),!
|
|---|
| 194 | . set num1=+num1
|
|---|
| 195 | . if (num1'>0)!(num1>Names("MAXNODE")) quit
|
|---|
| 196 | . new temp set temp=$$Short1Name(Names(num1),$length(Names(num1))-1,nodeDiv)
|
|---|
| 197 | . if (temp="^")!(temp="")!(temp=Names(num1)) quit
|
|---|
| 198 | . do Write^TMGABV(Names(num1),temp,,1) ;"1=> confirm
|
|---|
| 199 | . set Names(num1)=temp
|
|---|
| 200 | if temp="T" do goto SNA1Done
|
|---|
| 201 | TX1 . write "Enter text for ENTIRE name (combining all shown parts) (^ to abort):",!
|
|---|
| 202 | . read "> ",input:$get(DTIME,3600),!
|
|---|
| 203 | . if input="^" quit
|
|---|
| 204 | . ;"kill Words,Dividers
|
|---|
| 205 | . kill Names,Dividers
|
|---|
| 206 | . ;"set Words(1)=input,Words("MAXNODE")=1,Dividers(1)=""
|
|---|
| 207 | . set Names(1)=input,Names("MAXNODE")=1,Dividers(1)=""
|
|---|
| 208 | if "J"[$extract(temp,1) do
|
|---|
| 209 | . new JoinNum
|
|---|
| 210 | . set JoinNum=+$extract(temp,2,99)
|
|---|
| 211 | . if JoinNum'>0 read "Enter # to join: ",JoinNum:$get(DTIME,3600),!
|
|---|
| 212 | . if +JoinNum'>0 quit
|
|---|
| 213 | . ;"if JoinNum=Words("MAXNODE") do quit
|
|---|
| 214 | . if JoinNum=Names("MAXNODE") do quit
|
|---|
| 215 | . . write "Enter the # of the FIRST word to be joined.",!
|
|---|
| 216 | JL1 . ;"do SetJoin(JoinNum,2,.Words,.Dividers)
|
|---|
| 217 | . do SetJoin(JoinNum,2,.Names,.Dividers)
|
|---|
| 218 | if (temp="D")!(temp?1"D".N)!(temp?1"D".N1"-".N) do goto SNA1
|
|---|
| 219 | JL2 . new delNum,delNum2,i
|
|---|
| 220 | . set temp=$extract(temp,2,99)
|
|---|
| 221 | . ;"if Words("MAXNODE")=1 set delNum=1,delNum2=1
|
|---|
| 222 | . if $get(Names("MAXNODE"))=1 set delNum=1,delNum2=1
|
|---|
| 223 | . else do
|
|---|
| 224 | . . set delNum=+$piece(temp,"-",1)
|
|---|
| 225 | . . set delNum2=+$piece(temp,"-",2)
|
|---|
| 226 | . . if delNum2<delNum set delNum2=delNum
|
|---|
| 227 | . . if delNum>0 quit
|
|---|
| 228 | . . read "Enter # (or #-#) to delete: ",temp:$get(DTIME,3600),!
|
|---|
| 229 | . . set delNum=+$piece(temp,"-",1)
|
|---|
| 230 | . . set delNum2=+$piece(temp,"-",2)
|
|---|
| 231 | . . if delNum2<delNum set delNum2=delNum
|
|---|
| 232 | . for i=delNum:1:delNum2 do
|
|---|
| 233 | . . ;"if +i>0 kill Words(i),Dividers(i)
|
|---|
| 234 | . . if +i>0 kill Names(i),Dividers(i)
|
|---|
| 235 | . ;"do PackArrays("Words","Dividers")
|
|---|
| 236 | . do PackArrays("Names","Dividers")
|
|---|
| 237 | if "X"[$extract(temp,1) do
|
|---|
| 238 | . new delNum
|
|---|
| 239 | . ;"if Words("MAXNODE")=1 set delNum=1
|
|---|
| 240 | . if Names("MAXNODE")=1 set delNum=1
|
|---|
| 241 | . else do
|
|---|
| 242 | . . set delNum=+$extract(temp,2,99)
|
|---|
| 243 | . . if delNum>0 quit
|
|---|
| 244 | . . read "Enter # of Quick Fix to delete: ",delNum:$get(DTIME,3600),!
|
|---|
| 245 | . ;"if +delNum>0 do Del^TMGABV(Words(delNum))
|
|---|
| 246 | . if +delNum>0 do Del^TMGABV(Names(delNum))
|
|---|
| 247 | if (temp?.N)!(temp?.N1"-".N) do goto SNA1
|
|---|
| 248 | . new num1,num2
|
|---|
| 249 | . set num1=+$piece(temp,"-",1)
|
|---|
| 250 | . set num2=+$piece(temp,"-",2)
|
|---|
| 251 | . if num2=0 set num2=num1
|
|---|
| 252 | . new tempS set tempS=""
|
|---|
| 253 | . for i=num1:1:num2 set tempS=tempS_Names(i)_" "
|
|---|
| 254 | . set tempS=$$Trim^TMGSTUTL(tempS)
|
|---|
| 255 | . set tempS=$$GetAbvr^TMGABV(tempS,1)
|
|---|
| 256 | . for i=num1+1:1:num2 kill Names(i)
|
|---|
| 257 | . for i=num1:1:(num2-1) kill Dividers(i)
|
|---|
| 258 | . set Names(num1)=tempS
|
|---|
| 259 | . do PackArrays("Names","Dividers")
|
|---|
| 260 | if (temp="Q")!(temp?1"Q".N)!(temp?1"Q".N1"-".N) do goto SNA1
|
|---|
| 261 | . new num1,num2
|
|---|
| 262 | . set num1=+$extract(temp,2,99)
|
|---|
| 263 | . if num1=0 do quit:(+num1=0)
|
|---|
| 264 | . . read "Enter NUMBER(S) of Quick Fix to use: ",temp:$get(DTIME,3600),!
|
|---|
| 265 | . . set num1=+$piece(temp,"-",1)
|
|---|
| 266 | . . set num2=+$piece(temp,"-",2)
|
|---|
| 267 | . if +$get(num2)=0 set num2=num1
|
|---|
| 268 | . for i=num1:1:num2 do
|
|---|
| 269 | . . set Names(i)=$$GetAbvr^TMGABV(Names(i),0)
|
|---|
| 270 | if (temp="F")!(temp?1"F"1N) do goto SNA1
|
|---|
| 271 | . new num1 set num1=+$extract(temp,2,99)
|
|---|
| 272 | . if num1=0 do quit:(+num1=0)
|
|---|
| 273 | . . read "Enter NUMBER of abbreviation to fix: ",temp:$get(DTIME,3600),!
|
|---|
| 274 | . . set num1=+temp
|
|---|
| 275 | . new s set s=$$Fix^TMGABV(Names(num1),OrigName)
|
|---|
| 276 | . if s=0 set result=0 quit ;"signal retry
|
|---|
| 277 | . set Names(num1)=s
|
|---|
| 278 | . if Names(num1)="" do
|
|---|
| 279 | . . kill Names(num1)
|
|---|
| 280 | . . ;"do PackArrays("Words","Dividers")
|
|---|
| 281 | . . do PackArrays("Names","Dividers")
|
|---|
| 282 | if (temp="!") do goto SNA1
|
|---|
| 283 | JL5 . if $get(TMGDBABV)=1 kill TMGDBABV
|
|---|
| 284 | . else set TMGDBABV=1
|
|---|
| 285 | . set result=0 ;"signal request for retry.
|
|---|
| 286 | goto SNA1
|
|---|
| 287 |
|
|---|
| 288 | SNA1Done set result=$$Trim^TMGSTUTL(result)
|
|---|
| 289 | SNA2Done
|
|---|
| 290 | if (UserAsked=1)&(+result'=0) write "Using: ",result,!
|
|---|
| 291 | quit result
|
|---|
| 292 |
|
|---|
| 293 |
|
|---|
| 294 | ReadJoin(JoinNum,Len,Words,Dividers)
|
|---|
| 295 | ;"Purpose: To read out a phrase of joined words, Len words long
|
|---|
| 296 | ;"Input: JoinNum -- the index in Words where joining begins
|
|---|
| 297 | ;" Len -- the length to return. e.g. 2 --> two words joined
|
|---|
| 298 | ;" Words -- PASS BY REFERENCE. Array holding words
|
|---|
| 299 | ;" Dividers -- PASS BY REFERENCE. Array holding dividers between words
|
|---|
| 300 | ;"Results: returns string of joined words
|
|---|
| 301 |
|
|---|
| 302 | new result set result=""
|
|---|
| 303 | if (JoinNum+Len-1)>Words("MAXNODE") goto RJDone
|
|---|
| 304 | set result=$get(Words(JoinNum))
|
|---|
| 305 | new i for i=JoinNum:1:(JoinNum+Len-2) do
|
|---|
| 306 | . set result=result_Dividers(i)_$get(Words(i+1))
|
|---|
| 307 | RJDone quit result
|
|---|
| 308 |
|
|---|
| 309 |
|
|---|
| 310 | SetJoin(JoinNum,Len,Words,Dividers)
|
|---|
| 311 | ;"Purpose: To reform the Word and Dividers arrays such that words are
|
|---|
| 312 | ;" joined together. E.g. #1='One' #2='Minute' ==> #1='One Minute'
|
|---|
| 313 | ;"Input: JoinNum -- the index in Words where joining begins
|
|---|
| 314 | ;" Len -- the length to return. e.g. 2 --> two words joined
|
|---|
| 315 | ;" Words -- PASS BY REFERENCE. Array holding words
|
|---|
| 316 | ;" Dividers -- PASS BY REFERENCE. Array holding dividers between words
|
|---|
| 317 | ;"Results: None
|
|---|
| 318 |
|
|---|
| 319 | new temp set temp=$$ReadJoin^TMGSHORT(JoinNum,Len,.Words,.Dividers)
|
|---|
| 320 | new i for i=JoinNum:1:(JoinNum+Len-1) do
|
|---|
| 321 | . if i'=JoinNum kill Words(i)
|
|---|
| 322 | . if i'=(JoinNum+Len-1) kill Dividers(i)
|
|---|
| 323 |
|
|---|
| 324 | set Words(JoinNum)=temp
|
|---|
| 325 | do PackArrays("Words","Dividers")
|
|---|
| 326 |
|
|---|
| 327 | quit
|
|---|
| 328 |
|
|---|
| 329 |
|
|---|
| 330 | Short1Name(Name,MaxLen,Div1,Div2,Words,Dividers)
|
|---|
| 331 | ;"Purpose: An interactive editing of one name
|
|---|
| 332 | ;"Input: Name -- the name (string) to shorten.
|
|---|
| 333 | ;" MaxLen -- OPTIONAL. The Max length of the string.
|
|---|
| 334 | ;" Div1 -- OPTIONAL. The first character used to separate words. Default is " "
|
|---|
| 335 | ;" Div2 -- OPTIONAL. The second character used to separate words. Default is "/"
|
|---|
| 336 | ;" Words -- OPTIONAL. PASS BY REFERENCE, an OUT PARAMETER. Returns Name divided up into words
|
|---|
| 337 | ;" Dividers -- OPTIONAL. PASS BY REFERENCE, an OUT PARAMETER. Returns dividers between words
|
|---|
| 338 | ;"Results: returns shortened name, or "^" for user abort
|
|---|
| 339 |
|
|---|
| 340 | set Div1=$get(Div1," ")
|
|---|
| 341 | set Div2=$get(Div2)
|
|---|
| 342 |
|
|---|
| 343 | S1N0 do CleaveToArray^TMGSTUTL(Name,Div1,.Words)
|
|---|
| 344 | for i=1:1:Words("MAXNODE") set Dividers(i)=Div1
|
|---|
| 345 | set Dividers(Words("MAXNODE"))=""
|
|---|
| 346 | if Div2'="" do SubDivArray(.Words,.Dividers,Div1,Div2)
|
|---|
| 347 |
|
|---|
| 348 | set result=$$ShortenArray^TMGSHORT(.Words,.Dividers,MaxLen,0)
|
|---|
| 349 | if result=0 kill Words,Dividers goto S1N0
|
|---|
| 350 |
|
|---|
| 351 | quit result
|
|---|
| 352 |
|
|---|
| 353 |
|
|---|
| 354 | Cut1Name(Name,MaxLen,Div1,Div2,Words,Dividers)
|
|---|
| 355 | ;"Purpose: A non-interactive cut of one name
|
|---|
| 356 | ;"Input: Name -- the name (string) to shorten.
|
|---|
| 357 | ;" MaxLen -- The length of the string to cut to.
|
|---|
| 358 | ;" Div1 -- OPTIONAL. The first character used to separate words. Default is " "
|
|---|
| 359 | ;" Div2 -- OPTIONAL. The second character used to separate words. Default is "/"
|
|---|
| 360 | ;" Words -- OPTIONAL. PASS BY REFERENCE, an OUT PARAMETER. Returns Name divided up into words
|
|---|
| 361 | ;" Dividers -- OPTIONAL. PASS BY REFERENCE, an OUT PARAMETER. Returns dividers between words
|
|---|
| 362 | ;"Results: returns cut name
|
|---|
| 363 |
|
|---|
| 364 | set Div1=$get(Div1," ")
|
|---|
| 365 | set Div2=$get(Div2)
|
|---|
| 366 |
|
|---|
| 367 | do CleaveToArray^TMGSTUTL(Name,Div1,.Words)
|
|---|
| 368 | for i=1:1:Words("MAXNODE") set Dividers(i)=Div1
|
|---|
| 369 | set Dividers(Words("MAXNODE"))=""
|
|---|
| 370 | if Div2'="" do SubDivArray(.Words,.Dividers,Div1,Div2)
|
|---|
| 371 |
|
|---|
| 372 | set result=$$CutName(.Words,.Dividers,MaxLen)
|
|---|
| 373 |
|
|---|
| 374 | quit result
|
|---|
| 375 |
|
|---|
| 376 |
|
|---|
| 377 | Short2Name(Name,Div1,Div2,Words,Dividers,Category)
|
|---|
| 378 | ;"Purpose: Shorten a name, using abbreviations etc. to shortest form possible
|
|---|
| 379 | ;" Will separate name into individual words, separated by spaces
|
|---|
| 380 | ;" and try to abbreviate each one.
|
|---|
| 381 | ;"Input: Name -- name to shorten
|
|---|
| 382 | ;" Div1 -- OPTIONAL. The first character used to separate words. Default is " "
|
|---|
| 383 | ;" Div2 -- OPTIONAL. The second character used to separate words. Default is "/"
|
|---|
| 384 | ;" Words -- OPTIONAL. PASS BY REFERENCE, an OUT PARAMETER. Returns Name divided up into words
|
|---|
| 385 | ;" Dividers -- OPTIONAL. PASS BY REFERENCE, an OUT PARAMETER. Returns dividers between words
|
|---|
| 386 | ;" Category -- OPTIONAL. a category to look for phrases in
|
|---|
| 387 | ;"Result: returns a shortened form of name
|
|---|
| 388 | ;"Note: no testing of length done.
|
|---|
| 389 | ;"Note: this function is NOT interactive with the user
|
|---|
| 390 | ;"Note: This functions should be called repetatively,using the output from
|
|---|
| 391 | ;" the last run as the input for the next run, until there is not further
|
|---|
| 392 | ;" change, to get the best results.
|
|---|
| 393 |
|
|---|
| 394 | new temp,result,i
|
|---|
| 395 | set result=""
|
|---|
| 396 | if $get(Name)="" goto SN2Don2
|
|---|
| 397 |
|
|---|
| 398 | set result=$$GetAbvr^TMGABV(Name,0)
|
|---|
| 399 | if (result'="")&(result'=Name) goto SN2Done
|
|---|
| 400 |
|
|---|
| 401 | set Div1=$get(Div1," ") if Div1="" set Div1="@@@@"
|
|---|
| 402 | set Div2=$get(Div2,"/") if Div2="" set Div2="@@@@"
|
|---|
| 403 |
|
|---|
| 404 | kill Words,Dividers
|
|---|
| 405 | do CleaveToArray^TMGSTUTL(Name,Div1,.Words)
|
|---|
| 406 | for i=1:1:Words("MAXNODE") set Dividers(i)=Div1
|
|---|
| 407 | set Dividers(Words("MAXNODE"))="" ;"//kt added 10/27/06
|
|---|
| 408 |
|
|---|
| 409 | ;"Note: This purposefully does not keep rechecking for ever shortening
|
|---|
| 410 | ;" Abreviations (or abrv of abrv's) so that the calling function
|
|---|
| 411 | ;" can concat the results from this onto others and determine a
|
|---|
| 412 | ;" total length, and then recall if needed.
|
|---|
| 413 | new count set count=Words("MAXNODE")
|
|---|
| 414 | for i=1:1:count do
|
|---|
| 415 | . new temp,temp2
|
|---|
| 416 | . if Words(i)[Div2 set temp=$$Short2Name(Words(i),Div2)
|
|---|
| 417 | . else set temp=$$GetAbvr^TMGABV(Words(i),0)
|
|---|
| 418 | . set Words(i)=temp
|
|---|
| 419 |
|
|---|
| 420 | ;"Now look for double word matches
|
|---|
| 421 | set Category=$get(Category,0)
|
|---|
| 422 | SNL0 for i=1:1:count do
|
|---|
| 423 | . new temp,temp2
|
|---|
| 424 | . set temp=$$ReadJoin^TMGSHORT(i,2,.Words,.Dividers)
|
|---|
| 425 | . set temp2=$$GetAbvr^TMGABV(temp,Category)
|
|---|
| 426 | . if (temp2'="")&(temp'=temp2) do
|
|---|
| 427 | SNL1 . . ;"write "Found double word match: ",temp,"-->",temp2,!
|
|---|
| 428 | . . do SetJoin^TMGSHORT(i,2,.Words,.Dividers)
|
|---|
| 429 | . . set Words(i)=temp2
|
|---|
| 430 | . . ;"zwr Words(*)
|
|---|
| 431 | . . set i=0,count=Words("MAXNODE")
|
|---|
| 432 |
|
|---|
| 433 | set result=$$CompArray(.Words,.Dividers)
|
|---|
| 434 |
|
|---|
| 435 | SN2Done set result=$$Trim^TMGSTUTL(result)
|
|---|
| 436 | if (Name'=result) do Write^TMGABV(Name,result)
|
|---|
| 437 |
|
|---|
| 438 | SN2Don2 quit result
|
|---|
| 439 |
|
|---|
| 440 |
|
|---|
| 441 | SubDivArray(Words,Dividers,Div1,Div2)
|
|---|
| 442 | ;"Purpose: To see if any words in Words array needs to be subdivided,
|
|---|
| 443 | ;" and to handle if needed.
|
|---|
| 444 | ;"Input: Words -- PASS BY REFERENCE. Array of words
|
|---|
| 445 | ;" Dividers -- PASS BY REFERENCE. Array of dividing parts
|
|---|
| 446 | ;" Div1 -- the first division character, e.g. "/" or " "
|
|---|
| 447 | ;" Div2 -- the second division character, e.g. " " or "/"
|
|---|
| 448 | ;"Results: none
|
|---|
| 449 |
|
|---|
| 450 | new i
|
|---|
| 451 | for i=1:1:Words("MAXNODE") do
|
|---|
| 452 | . if Words(i)[Div2 do
|
|---|
| 453 | . . new tempWords,j
|
|---|
| 454 | . . do CleaveToArray^TMGSTUTL(Words(i),Div2,.tempWords)
|
|---|
| 455 | . . for j=1:1:tempWords("MAXNODE") do
|
|---|
| 456 | . . . set Words(+(i_"."_j))=tempWords(j)
|
|---|
| 457 | . . . if j'=tempWords("MAXNODE") set Dividers(+(i_"."_j))=Div2
|
|---|
| 458 | . . . else set Dividers(+(i_"."_j))=Div1
|
|---|
| 459 | . . kill Words(i),Dividers(i)
|
|---|
| 460 | do PackArrays("Words","Dividers")
|
|---|
| 461 |
|
|---|
| 462 | quit
|
|---|
| 463 |
|
|---|
| 464 |
|
|---|
| 465 | PackArrays(pNames,pDividers)
|
|---|
| 466 | ;"Purpose: to pack the arrays, after items had been deleted.
|
|---|
| 467 | ;"Input: Names -- PASS BY NAME. Array of words
|
|---|
| 468 | ;" Dividers -- PASS BY NAME. Array of dividing parts
|
|---|
| 469 | ;"Result: none
|
|---|
| 470 |
|
|---|
| 471 | do ListPack^TMGMISC(pNames)
|
|---|
| 472 | do ListPack^TMGMISC(pDividers)
|
|---|
| 473 | set @pNames@("MAXNODE")=$$ListCt^TMGMISC(pNames)
|
|---|
| 474 | set @pDividers@("MAXNODE")=$$ListCt^TMGMISC(pDividers)
|
|---|
| 475 | quit
|
|---|
| 476 |
|
|---|
| 477 |
|
|---|
| 478 | CompArray(Names,Dividers)
|
|---|
| 479 | ;"Purpose: to reconstruct the resulting sentence from words in array.
|
|---|
| 480 | ;"Input: Names -- PASS BY REFERENCE. Array of words
|
|---|
| 481 | ;" Dividers -- PASS BY REFERENCE. Array of dividing parts
|
|---|
| 482 | ;"Result: returns the compiled result
|
|---|
| 483 |
|
|---|
| 484 | new result,j
|
|---|
| 485 | set result=""
|
|---|
| 486 | for j=1:1:Names("MAXNODE") do
|
|---|
| 487 | . set result=result_Names(j)
|
|---|
| 488 | . if Names(j)'="" set result=result_Dividers(j)
|
|---|
| 489 | quit result
|
|---|
| 490 |
|
|---|
| 491 |
|
|---|
| 492 | AutoShortenArray(Names,Dividers,MaxLen,Div1,Div2)
|
|---|
| 493 | ;"Purpose: To automatically shorten the words in the array
|
|---|
| 494 | ;"Input: Names -- PASS BY REFERENCE. Array of words
|
|---|
| 495 | ;" Dividers -- PASS BY REFERENCE. Array of dividing parts
|
|---|
| 496 | ;" Div1 -- the first division character, e.g. "/" or " "
|
|---|
| 497 | ;" Div2 -- the second division character, e.g. " " or "/"
|
|---|
| 498 |
|
|---|
| 499 | new result,newName,changeMade
|
|---|
| 500 | set result=""
|
|---|
| 501 |
|
|---|
| 502 | new temp set temp=$$CompArray(.Names,.Dividers)
|
|---|
| 503 | set result=$$GetAbvr^TMGABV(temp,0)
|
|---|
| 504 | if result="^" set result="" do Del^TMGABV(temp)
|
|---|
| 505 | if (result'="")&($length(result)'>MaxLen) goto ASADone
|
|---|
| 506 |
|
|---|
| 507 | for do quit:(changeMade=0)!($length(result)'>MaxLen)
|
|---|
| 508 | . set changeMade=0
|
|---|
| 509 | . for i=1:1:Names("MAXNODE") do
|
|---|
| 510 | . . set newName=$$Short2Name(Names(i),.Div1,.Div2)
|
|---|
| 511 | . . ;"there was a loop where a name was repeatitively being replace with longer names --> crash
|
|---|
| 512 | . . if (newName'=Names(i))&($length(newName)<$length(Names(i))) do
|
|---|
| 513 | . . . set Names(i)=newName
|
|---|
| 514 | . . . set changeMade=1
|
|---|
| 515 | . set result=$$CompArray(.Names,.Dividers)
|
|---|
| 516 |
|
|---|
| 517 | ASADone
|
|---|
| 518 | quit result
|
|---|
| 519 |
|
|---|
| 520 |
|
|---|
| 521 | CutName(Names,Dividers,MaxLen)
|
|---|
| 522 | ;"Purpose: To return a non-interactive shortened ('cut') name
|
|---|
| 523 | ;"Input: Names - PASS BY REFERENCE. As created in ShortNetName
|
|---|
| 524 | ;" This is an array with the various words in the name
|
|---|
| 525 | ;" Dividers -- PASS BY REFERENCE As created in ShortNetName
|
|---|
| 526 | ;" This is an array with the spaces or punctiation separating words
|
|---|
| 527 | ;" MaxLen -- The target length for result
|
|---|
| 528 | ;"Result: returns the shortened name
|
|---|
| 529 |
|
|---|
| 530 | new partA,partB,Max,i,lenA
|
|---|
| 531 | new result
|
|---|
| 532 |
|
|---|
| 533 | set Max=$get(Names("MAXNODE"))
|
|---|
| 534 |
|
|---|
| 535 | if Max'>3 do goto CutDone
|
|---|
| 536 | . set result=$$CompArray(.Names,.Dividers)
|
|---|
| 537 | . set result=$extract(result,1,MaxLen)
|
|---|
| 538 |
|
|---|
| 539 | set partB=$get(Dividers(Max-3))
|
|---|
| 540 | for i=Max-2:1:Max do
|
|---|
| 541 | . set partB=partB_Names(i)
|
|---|
| 542 | . if Names(i)'="" set partB=partB_Dividers(i)
|
|---|
| 543 | set partB=$$Trim^TMGSTUTL(partB)
|
|---|
| 544 | set partA=""
|
|---|
| 545 | for i=1:1:Max-3 set partA=partA_Names(i) set:(i<(Max-3))&(Names(i)'="") partA=partA_Dividers(i)
|
|---|
| 546 | new allowedALen set allowedALen=MaxLen-$length(partB)
|
|---|
| 547 | set lenA=$length(partA)
|
|---|
| 548 | if lenA>allowedALen do
|
|---|
| 549 | . set allowedALen=allowedALen-4
|
|---|
| 550 | . if lenA=0 set partA="" quit
|
|---|
| 551 | . if (allowedALen/lenA)<0.4 set partA="" quit
|
|---|
| 552 | . if allowedALen<4 set partA="" quit
|
|---|
| 553 | . set partA=$extract(partA,1,allowedALen)_"... "
|
|---|
| 554 | set result=$$Trim^TMGSTUTL(partA_partB)
|
|---|
| 555 | if $length(result)>MaxLen do
|
|---|
| 556 | . if partA="" do
|
|---|
| 557 | . . set partB="" ;"$get(Dividers(Max-2))
|
|---|
| 558 | . . for i=Max-1:1:Max do
|
|---|
| 559 | . . . set partB=partB_Names(i)
|
|---|
| 560 | . . . if Names(i)'="" set partB=partB_Dividers(i)
|
|---|
| 561 | . . set partB=$$Trim^TMGSTUTL(partB)
|
|---|
| 562 | . . set partA=Names(Max-2)
|
|---|
| 563 | . . new allowedALen set allowedALen=MaxLen-$length(partB)-4
|
|---|
| 564 | . . set partA=$extract(partA,1,allowedALen)_"... "
|
|---|
| 565 | . . set result=partA_partB
|
|---|
| 566 | . else set result=$extract(result,1,MaxLen)
|
|---|
| 567 |
|
|---|
| 568 | CutDone
|
|---|
| 569 | quit result
|
|---|
| 570 |
|
|---|
| 571 |
|
|---|
| 572 | PShortName(Name,Length,AskUser)
|
|---|
| 573 | ;"Purpose: To shorten the drug smartly, using abbreviations
|
|---|
| 574 | ;" This function differs from ShortName (see below) because it smartly
|
|---|
| 575 | ;" 'P'icks whether to use '/' or ' ' as a divider str.
|
|---|
| 576 | ;"Input: Name -- the drug name to shorten
|
|---|
| 577 | ;" Expected format is that found in file 50.6 field .01,
|
|---|
| 578 | ;" i.e. INGREDIENT/INGREDIENT/INGREDIENT...
|
|---|
| 579 | ;" Length -- The desired string length
|
|---|
| 580 | ;" AskUser -- OPTIONAL. Default=0.
|
|---|
| 581 | ;" If 1 then user is asked to supply abreviations if needed.
|
|---|
| 582 | ;" If 2 then name is shortened as much as possible, but it
|
|---|
| 583 | ;" might be longer than Length, it is not cut, and user is
|
|---|
| 584 | ;" not asked.
|
|---|
| 585 | ;"Result : returns shortened name, "^" for abort.
|
|---|
| 586 |
|
|---|
| 587 | new DivStr,result
|
|---|
| 588 | if $length(Name,"/")>2 set DivStr="/"
|
|---|
| 589 | else set DivStr=" "
|
|---|
| 590 |
|
|---|
| 591 | set result=$$ShortName(.Name,.Length,.AskUser,DivStr)
|
|---|
| 592 | quit result
|
|---|
| 593 |
|
|---|
| 594 | ShortName(Name,Length,AskUser,DivStr)
|
|---|
| 595 | ;"Purpose: To shorten the drug smartly, using abbreviations
|
|---|
| 596 | ;"Input: Name -- the drug name to shorten
|
|---|
| 597 | ;" Expected format is that found in file 50.6 field .01,
|
|---|
| 598 | ;" i.e. INGREDIENT/INGREDIENT/INGREDIENT...
|
|---|
| 599 | ;" Length -- The desired string length
|
|---|
| 600 | ;" AskUser -- OPTIONAL. Default=0.
|
|---|
| 601 | ;" If 1 then user is asked to supply abreviations if needed.
|
|---|
| 602 | ;" If 2 then name is shortened as much as possible, but it
|
|---|
| 603 | ;" might be longer than Length, it is not cut, and user is
|
|---|
| 604 | ;" not asked.
|
|---|
| 605 | ;" DivStr -- the divider that separates parts. Default="/"
|
|---|
| 606 | ;"Result : returns shortened name, "^" for abort.
|
|---|
| 607 |
|
|---|
| 608 | new temp,Words,Dividers
|
|---|
| 609 | set AskUser=$get(AskUser,0)
|
|---|
| 610 | set DivStr=$get(DivStr,"/")
|
|---|
| 611 |
|
|---|
| 612 | if Name="" set temp="^" goto SNDone
|
|---|
| 613 | set temp=$$Read^TMGABV(Name,Length)
|
|---|
| 614 |
|
|---|
| 615 | if (temp'="")&($length(temp)'>Length) goto SNDone
|
|---|
| 616 |
|
|---|
| 617 | ;"Note: $$ShortName does NOT check length
|
|---|
| 618 | new oldTemp,done
|
|---|
| 619 | set temp=Name,done=0
|
|---|
| 620 | for do quit:done!($length(temp)'>Length)
|
|---|
| 621 | . set oldTemp=temp
|
|---|
| 622 | . set temp=$$Short2Name(temp,DivStr,"",.Words,.Dividers,Length)
|
|---|
| 623 | . if temp=oldTemp set done=1 quit
|
|---|
| 624 | . if ($length(temp)'>Length) set done=1 ;"don't quit yet
|
|---|
| 625 | . if (temp["...")&(AskUser=1) write !,"Remove '...' from name",! set done=0
|
|---|
| 626 |
|
|---|
| 627 | if (($length(temp)>Length)&(AskUser=1)) do
|
|---|
| 628 | SNm0 . new killthis set killthis=0
|
|---|
| 629 | . write "IEN 50.6=",$get(IEN50d6,"?")," IEN 50.606=",$get(IEN50d606,"?")
|
|---|
| 630 | . write " Dose=",$get(Dose,"?")," IEN 50=",$get(IEN50,"?"),!
|
|---|
| 631 | . write Name,!
|
|---|
| 632 | SNm1 . set temp=$$Short1Name(temp,Length,DivStr,"",.Words,.Dividers)
|
|---|
| 633 | . if (temp'="")&(temp'="^")&(temp'=Name) do
|
|---|
| 634 | . . do Write^TMGABV(Name,temp,Length,(AskUser=1))
|
|---|
| 635 | . write !
|
|---|
| 636 |
|
|---|
| 637 | if ($length(temp)>Length)&(AskUser'=2) do
|
|---|
| 638 | . if ($data(Words)=0)!($data(Dividers)=0) do quit
|
|---|
| 639 | . . set temp=$extract(temp,1,Length)
|
|---|
| 640 | . set temp=$$CutName(.Words,.Dividers,Length)
|
|---|
| 641 | SNDone
|
|---|
| 642 | if $extract(temp,1)="/" set temp=$extract(temp,2,Length)
|
|---|
| 643 | quit temp
|
|---|
| 644 |
|
|---|
| 645 |
|
|---|
