| 1 | TMGNDF2G ;TMG/kst/FDA Import: Setup shortened drug names ;03/25/06
|
|---|
| 2 | ;;1.0;TMG-LIB;**1**;02/24/07
|
|---|
| 3 |
|
|---|
| 4 | ;" FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS
|
|---|
| 5 | ;" Creation of shortened version of drug names
|
|---|
| 6 | ;"Kevin Toppenberg MD
|
|---|
| 7 | ;"GNU General Public License (GPL) applies
|
|---|
| 8 | ;"2-24-2007
|
|---|
| 9 |
|
|---|
| 10 | ;"=======================================================================
|
|---|
| 11 | ;" API -- Public Functions.
|
|---|
| 12 | ;"=======================================================================
|
|---|
| 13 |
|
|---|
| 14 | ;"Menu -- Ensure other version of drug names available.
|
|---|
| 15 |
|
|---|
| 16 | ;"=======================================================================
|
|---|
| 17 | ;" Private Functions.
|
|---|
| 18 | ;"=======================================================================
|
|---|
| 19 | ;"MakeAltNames -- scan through all entries and set up shortened names.
|
|---|
| 20 | ;"Make1Alt(IEN) --fix the names for just 1 record in 22706.9
|
|---|
| 21 | ;"GetIENArray(Array) -- Gather IENS to work on
|
|---|
| 22 | ;"GetPrepArray(IENArray,PrepArray) -- Prepare names for addition into 40 length fields
|
|---|
| 23 | ;"PrepNames(IEN,Value55,Value56,Value75,Value76,PrepArray,AllowCut) -- Get names for IEN
|
|---|
| 24 | ;"AskArray(IENArray,PrepArray) -- get array with possible fixes for 1 record
|
|---|
| 25 | ;"Write1(IEN,name55,name56,name75,namd76) --write 1 record in 22706.9 file
|
|---|
| 26 | ;"DispFixArray(PrepArray,MapArray,compactMode) -- Display values in PrepArray
|
|---|
| 27 |
|
|---|
| 28 |
|
|---|
| 29 | ;"=======================================================================
|
|---|
| 30 |
|
|---|
| 31 | Menu
|
|---|
| 32 | ;"Purpose: -- Ensure shortened version of drug names available.
|
|---|
| 33 |
|
|---|
| 34 | new Menu,UsrSlct
|
|---|
| 35 | set Menu(0)="Pick Option to Ensure All Versions of Names (2G)"
|
|---|
| 36 | set Menu(1)="Ensure all drug names are ready"_$char(9)_"MakeAltNames"
|
|---|
| 37 | set Menu(2)="Check for blank names"_$char(9)_"CheckForBlanks"
|
|---|
| 38 | set Menu(3)="Check for BAD names"_$char(9)_"ScanBadName"
|
|---|
| 39 | set Menu(4)="Ask and fix name for ONE import"_$char(9)_"FixOneName"
|
|---|
| 40 | set Menu("P")="Prev Stage"_$char(9)_"Prev"
|
|---|
| 41 | set Menu("N")="Next Stage"_$char(9)_"Next"
|
|---|
| 42 |
|
|---|
| 43 | M1 write #
|
|---|
| 44 | set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^")
|
|---|
| 45 |
|
|---|
| 46 | if UsrSlct="MakeAltNames" do MakeAltNames goto M1
|
|---|
| 47 | if UsrSlct="CheckForBlanks" do CheckForBlanks goto M1
|
|---|
| 48 | if UsrSlct="FixOneName" do AskMake1 goto M1
|
|---|
| 49 | if UsrSlct="ScanBadName" do ScanBadName goto M1
|
|---|
| 50 | if UsrSlct="Prev" goto Menu^TMGNDF2E ;"quit can occur from there...
|
|---|
| 51 | if UsrSlct="Next" goto Menu^TMGNDF2H ;"quit can occur from there...
|
|---|
| 52 | if UsrSlct="^" goto MenuDone
|
|---|
| 53 | if UsrSlct=0 set UsrSlct=""
|
|---|
| 54 | goto M1
|
|---|
| 55 |
|
|---|
| 56 | MenuDone
|
|---|
| 57 | quit
|
|---|
| 58 |
|
|---|
| 59 | ;"=======================================================================================
|
|---|
| 60 |
|
|---|
| 61 |
|
|---|
| 62 | ;"=======================================================================================
|
|---|
| 63 | MakeAltNames
|
|---|
| 64 | ;"Purpose: To scan through all entries and set up alternative names.
|
|---|
| 65 | ;"Input: none
|
|---|
| 66 | ;"Results: none.
|
|---|
| 67 | ;"Output: Fields .055, .056, .075, .076 will be filled
|
|---|
| 68 | ;"Results: none
|
|---|
| 69 |
|
|---|
| 70 | new IENArray,PrepArray
|
|---|
| 71 | write "Scanning existing names of imports not skipped...",!
|
|---|
| 72 | do GetIENArray(.IENArray)
|
|---|
| 73 |
|
|---|
| 74 | write "Preparing suggested names...",!
|
|---|
| 75 | do GetPrepArray(.IENArray,.PrepArray)
|
|---|
| 76 |
|
|---|
| 77 | if $data(PrepArray)=0 do goto MKSNDone
|
|---|
| 78 | . write "No fixes required. Great!",!
|
|---|
| 79 | . do PressToCont^TMGUSRIF
|
|---|
| 80 |
|
|---|
| 81 | do AskArray(.IENArray,.PrepArray)
|
|---|
| 82 |
|
|---|
| 83 | MKSNDone
|
|---|
| 84 | write "Goodbye.",!
|
|---|
| 85 | quit
|
|---|
| 86 |
|
|---|
| 87 |
|
|---|
| 88 | AskMake1
|
|---|
| 89 | ;"Purpose: Ask user for record in 22706.9, and then fix
|
|---|
| 90 |
|
|---|
| 91 | new DIC,X,Y
|
|---|
| 92 | set DIC=22706.9,DIC(0)="MAEQ"
|
|---|
| 93 | do ^DIC write !
|
|---|
| 94 | if +Y>0 do Make1Alt(+Y)
|
|---|
| 95 | quit
|
|---|
| 96 |
|
|---|
| 97 |
|
|---|
| 98 | Make1Alt(IEN,Option)
|
|---|
| 99 | ;"Purpose: to fix the names for just 1 record in 22706.9
|
|---|
| 100 | ;"Input: IEN -- IEN in 22706.9
|
|---|
| 101 | ;" Option -- OPTIONAL. Format:
|
|---|
| 102 | ;" Option("FIX CHAIN")=1 <--- changes will be propigate forward
|
|---|
| 103 | ;" to file 50, POI, OI, OQV etc.
|
|---|
| 104 | ;" OPTION("FIX CHAIN","IEN22706d9")=Source IEN
|
|---|
| 105 | ;"Note: ignores if drug is to be skipped.
|
|---|
| 106 |
|
|---|
| 107 | new IENArray,PrepArray
|
|---|
| 108 |
|
|---|
| 109 | set IENArray(IEN,.04)=$piece($get(^TMG(22706.9,IEN,7)),"^",6) ;" .04, LONG NAME
|
|---|
| 110 | set IENArray(IEN,.055)=$piece($get(^TMG(22706.9,IEN,7)),"^",3) ;".055, TRADENAME - 40
|
|---|
| 111 | set IENArray(IEN,.056)=$piece($get(^TMG(22706.9,IEN,8)),"^",1) ;".056, TRADENAME DOSE UNIT FORM - 40
|
|---|
| 112 | set IENArray(IEN,.075)=$piece($get(^TMG(22706.9,IEN,7)),"^",4) ;".075, GENERIC NAME - 40
|
|---|
| 113 | set IENArray(IEN,.076)=$piece($get(^TMG(22706.9,IEN,8)),"^",1) ;".076 GENERICNAME DOSE UNT FORM - 40
|
|---|
| 114 |
|
|---|
| 115 | do GetPrepArray(.IENArray,.PrepArray,0) ;"0=no allow cut
|
|---|
| 116 |
|
|---|
| 117 | if $data(PrepArray)=0 do goto MKSNDone
|
|---|
| 118 | . write "No drug name fixes required. Great!",!
|
|---|
| 119 | . do PressToCont^TMGUSRIF
|
|---|
| 120 |
|
|---|
| 121 | do AskArray(.IENArray,.PrepArray)
|
|---|
| 122 |
|
|---|
| 123 | if $get(Option("FIX CHAIN"))=1 do
|
|---|
| 124 | . set OPTION("FIX CHAIN","IEN22706d9")=IEN
|
|---|
| 125 | . do Refresh1^TMGNDF3C(IEN22706d9,.Option)
|
|---|
| 126 |
|
|---|
| 127 | M1ADone
|
|---|
| 128 | write "Goodbye.",!
|
|---|
| 129 | quit
|
|---|
| 130 |
|
|---|
| 131 |
|
|---|
| 132 |
|
|---|
| 133 | GetIENArray(Array)
|
|---|
| 134 | ;"Purpose: Gather IENS to work on
|
|---|
| 135 | ;"Input: Array -- PASS BY REFERENCE Output Format:
|
|---|
| 136 | ;" Note: IEN is from file 22706.9
|
|---|
| 137 | ;" Array(IEN,.04)=currentValue
|
|---|
| 138 | ;" Array(IEN,.05)=currentValue
|
|---|
| 139 | ;" Array(IEN,.055)=currentValue
|
|---|
| 140 | ;" Array(IEN,.056)=currentValue
|
|---|
| 141 | ;" Array(IEN,.07)=currentValue
|
|---|
| 142 | ;" Array(IEN,.075)=currentValue
|
|---|
| 143 | ;" Array(IEN,.076)=currentValue
|
|---|
| 144 | ;"Results: none
|
|---|
| 145 |
|
|---|
| 146 | new Itr,IEN
|
|---|
| 147 | new abort set abort=0
|
|---|
| 148 | set IEN=$$ItrInit^TMGITR(22706.9,.Itr)
|
|---|
| 149 | do PrepProgress^TMGITR(.Itr,20,0,"IEN")
|
|---|
| 150 | if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort
|
|---|
| 151 | . if $$UserAborted^TMGUSRIF set abort=1 quit
|
|---|
| 152 | . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;"1=SKIP
|
|---|
| 153 | . new s0,s7,s8
|
|---|
| 154 | . set s0=$get(^TMG(22706.9,IEN,0))
|
|---|
| 155 | . set s7=$get(^TMG(22706.9,IEN,7))
|
|---|
| 156 | . set s8=$get(^TMG(22706.9,IEN,8))
|
|---|
| 157 | . set Array(IEN,.04)=$piece(s7,"^",6) ;" .04 LONG NAME
|
|---|
| 158 | . set Array(IEN,.05)=$piece(s0,"^",4) ;" .05 TRADENAME
|
|---|
| 159 | . set Array(IEN,.055)=$piece(s7,"^",3) ;".055 TRADENAME - 40
|
|---|
| 160 | . set Array(IEN,.056)=$piece(s8,"^",1) ;".056 TRADENAME DOSE UNIT FORM - 40
|
|---|
| 161 | . set Array(IEN,.07)=$piece(s0,"^",6) ;" .07 GENERIC NAME
|
|---|
| 162 | . set Array(IEN,.075)=$piece(s7,"^",4) ;".075 GENERIC NAME - 40
|
|---|
| 163 | . set Array(IEN,.076)=$piece(s8,"^",2) ;".076 GENERICNAME DOSE UNT FORM - 40
|
|---|
| 164 |
|
|---|
| 165 | quit
|
|---|
| 166 |
|
|---|
| 167 |
|
|---|
| 168 | GetPrepArray(IENArray,PrepArray,AllowCut)
|
|---|
| 169 | ;"Purpose: Prepare names for addition into .055 (TRADENAME - 40)
|
|---|
| 170 | ;" and .075 (GENERIC NAME - 40) fields
|
|---|
| 171 | ;"Input: IENArray -- PASS BY REFERENCE Format:
|
|---|
| 172 | ;" Array(IEN,.04)=currentValue
|
|---|
| 173 | ;" Array(IEN,.055)=currentValue
|
|---|
| 174 | ;" Array(IEN,.075)=currentValue
|
|---|
| 175 | ;" PrepArray -- PASS BY REFERENCE Format:
|
|---|
| 176 | ;" PrepArray(IEN1,.04)=Name for .04
|
|---|
| 177 | ;" PrepArray(IEN1,.055)=Name for .055
|
|---|
| 178 | ;" PrepArray(IEN1,.056)=Name for .056
|
|---|
| 179 | ;" PrepArray(IEN1,.075)=Name for .075
|
|---|
| 180 | ;" PrepArray(IEN1,.076)=Name for .076
|
|---|
| 181 | ;" AllowCut -- OPTIONAL. Default=1. If 1, then automatic shortening of names allowed
|
|---|
| 182 | ;"Output: PrepArray is Filled
|
|---|
| 183 | ;"Results: none
|
|---|
| 184 |
|
|---|
| 185 | set AllowCut=$get(AllowCut,1)
|
|---|
| 186 | new Itr,IEN,abort
|
|---|
| 187 | set abort=0
|
|---|
| 188 | set IEN=$$ItrAInit^TMGITR("IENArray",.Itr)
|
|---|
| 189 | do PrepProgress^TMGITR(.Itr,20,1,"IEN")
|
|---|
| 190 | if IEN'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN)="")!abort
|
|---|
| 191 | . if $$UserAborted^TMGUSRIF() set abort=1 quit
|
|---|
| 192 | . new Cur04Value set Cur04Value=$get(IENArray(IEN,.04))
|
|---|
| 193 | . new Cur55Value set Cur55Value=$get(IENArray(IEN,.055))
|
|---|
| 194 | . new Cur56Value set Cur56Value=$get(IENArray(IEN,.056))
|
|---|
| 195 | . new Cur75Value set Cur75Value=$get(IENArray(IEN,.075))
|
|---|
| 196 | . new Cur76Value set Cur76Value=$get(IENArray(IEN,.076))
|
|---|
| 197 | . set abort=$$PrepNames(IEN,Cur04Value,Cur55Value,Cur56Value,Cur75Value,Cur76Value,.PrepArray,AllowCut)
|
|---|
| 198 | do ProgressDone^TMGITR(.Itr)
|
|---|
| 199 |
|
|---|
| 200 | quit
|
|---|
| 201 |
|
|---|
| 202 |
|
|---|
| 203 | PrepNames(IEN,Value04,Value55,Value56,Value75,Value76,PrepArray,AllowCut)
|
|---|
| 204 | ;"Purpose: To get names for IEN
|
|---|
| 205 | ;"Input: IEN -- the ien in file 22706.9
|
|---|
| 206 | ;" Value04 -- the current value for field .04
|
|---|
| 207 | ;" Value55 -- the current value for field .055
|
|---|
| 208 | ;" Value56 -- the current value for field .056
|
|---|
| 209 | ;" Value75 -- the current value for field .075
|
|---|
| 210 | ;" Value76 -- the current value for field .076
|
|---|
| 211 | ;" PrepArray -- PASS BY REFERENCE. and OUT PARAMETER.
|
|---|
| 212 | ;" Format:
|
|---|
| 213 | ;" PrepArray(IEN,.04)=Name for .04
|
|---|
| 214 | ;" PrepArray(IEN,.055)=Name for .055
|
|---|
| 215 | ;" PrepArray(IEN,.056)=Name for .056
|
|---|
| 216 | ;" PrepArray(IEN,.075)=Name for .075
|
|---|
| 217 | ;" PrepArray(IEN,.076)=Name for .076
|
|---|
| 218 | ;" AllowCut -- OPTIONAL. Default=1. If 1 then user not prompted to shorten names
|
|---|
| 219 | ;"Output: PrepArray is Filled
|
|---|
| 220 | ;"Results: 0=OK to Continue, 1=abort
|
|---|
| 221 |
|
|---|
| 222 | new result set result=0
|
|---|
| 223 | set AllowCut=$get(AllowCut,1)
|
|---|
| 224 | new MaxLen set MaxLen=40
|
|---|
| 225 |
|
|---|
| 226 | ;"==Set up .04 Name (LONG NAME) ==========================
|
|---|
| 227 | new New04Value set New04Value=$$MakeName(IEN,63,AllowCut,1) ;",1) Mode=Full Name
|
|---|
| 228 | if New04Value="^" set result=1 goto PNDone
|
|---|
| 229 | if $length(New04Value)>63 do
|
|---|
| 230 | . set New04Value=$extract(New04Value,1,63-3)_"..."
|
|---|
| 231 | if (New04Value["...")&(Value04'["...")&(Value04'="") set New04Value=""
|
|---|
| 232 | if (New04Value'=Value04)&(New04Value'="") do
|
|---|
| 233 | . set PrepArray(IEN,.04)=New04Value
|
|---|
| 234 |
|
|---|
| 235 | ;"==Set up .075 Name (GENERIC NAME & FORM - 40)===========
|
|---|
| 236 | new New75Value set New75Value=$$MakeName(IEN,MaxLen,AllowCut,5) ;",5) Mode=Generic Name
|
|---|
| 237 | if New75Value="^" set result=1 goto PNDone
|
|---|
| 238 | if $length(New75Value)>MaxLen do
|
|---|
| 239 | . set New75Value=$extract(New75Value,1,MaxLen-3)_"..."
|
|---|
| 240 | if (New75Value["...")&(Value75'["...")&(Value75'="") set New75Value=""
|
|---|
| 241 | if (New75Value'=Value75)&(New75Value'="") do
|
|---|
| 242 | . set PrepArray(IEN,.075)=New75Value
|
|---|
| 243 |
|
|---|
| 244 | ;"==Set up .076 Name (GENERICNAME FORM DOSE UNT - 40) ====
|
|---|
| 245 | new New76Value set New76Value=$$MakeName(IEN,MaxLen,AllowCut,3) ;"3 -> GenericName DrugForm Strength Units
|
|---|
| 246 | if New76Value="^" set result=1 goto PNDone
|
|---|
| 247 | if $length(New76Value)>MaxLen do
|
|---|
| 248 | . set New76Value=$extract(New76Value,1,MaxLen-3)_"..."
|
|---|
| 249 | if (New76Value["...")&(Value76'["...")&(Value76'="") set New76Value=""
|
|---|
| 250 | if (New76Value'=Value76)&(New76Value'="") do
|
|---|
| 251 | . set PrepArray(IEN,.076)=New76Value
|
|---|
| 252 |
|
|---|
| 253 | ;"==Set up .055 Name (TRADE NAME & FORM - 40) ============
|
|---|
| 254 | new New55Value set New55Value=$$MakeName(IEN,MaxLen,AllowCut,4) ;",4) Mode=TradeName
|
|---|
| 255 | if New55Value="^" set result=1 goto PNDone
|
|---|
| 256 | if $length(New55Value)>MaxLen do
|
|---|
| 257 | . set New55Value=$extract(New55Value,1,MaxLen-3)_"..."
|
|---|
| 258 | if (New55Value["...")&(Value55'["...")&(Value55'="") set New55Value=""
|
|---|
| 259 | if New55Value=New75Value set New55Value="<DUPLICATE>" ;"WAS "@"
|
|---|
| 260 | if (New55Value'=Value55)&(New55Value'="") do
|
|---|
| 261 | . ;"if (New55Value="@")&(Value55="") quit
|
|---|
| 262 | . set PrepArray(IEN,.055)=New55Value
|
|---|
| 263 |
|
|---|
| 264 | ;"==Set up .056 Name (TRADENAME FORM DOSE UNIT - 40) ====
|
|---|
| 265 | new New56Value set New56Value=$$MakeName(IEN,MaxLen,AllowCut,6) ;"6 -> TradeName DrugForm Strength Units
|
|---|
| 266 | if New56Value="^" set result=1 goto PNDone
|
|---|
| 267 | if $length(New56Value)>MaxLen do
|
|---|
| 268 | . set New56Value=$extract(New56Value,1,MaxLen-3)_"..."
|
|---|
| 269 | if (New56Value["...")&(Value56'["...")&(Value56'="") set New56Value=""
|
|---|
| 270 | if New56Value=New76Value set New56Value="<DUPLICATE>" ;"WAS "@"
|
|---|
| 271 | if (New56Value'=Value56)&(New56Value'="") do
|
|---|
| 272 | . ;"if (New56Value="@")&(Value56="") quit
|
|---|
| 273 | . set PrepArray(IEN,.056)=New56Value
|
|---|
| 274 |
|
|---|
| 275 | PNDone quit result
|
|---|
| 276 |
|
|---|
| 277 |
|
|---|
| 278 | MakeName(IEN,MaxLen,AllowCut,Mode)
|
|---|
| 279 | ;"Purpose: to make a special name from drug info
|
|---|
| 280 | ;"Input: IEN -- IEN in file 22706.9
|
|---|
| 281 | ;" MaxLen -- OPTIONAL. default=256. The maximum length
|
|---|
| 282 | ;" AllowCut -- OPTIONAL If 1 then name may be cut off with ... to reach target length
|
|---|
| 283 | ;" If 2 then name will be shorteneded as much as possible, but the
|
|---|
| 284 | ;" name will NOT be cut off to reach MaxLen
|
|---|
| 285 | ;" default=1
|
|---|
| 286 | ;" Mode -- OPTIONAL. Default=1.
|
|---|
| 287 | ;" //1 -> GenericName (TradeName) Strength Units
|
|---|
| 288 | ;" 1 -> TradeName (GenericName) Strength Units ;changed 10/30/07
|
|---|
| 289 | ;" 2 -> TradeName Strength Units
|
|---|
| 290 | ;" 3 -> GenericName DrugForm Strength Units
|
|---|
| 291 | ;" 4 -> TradeName (includes Drug Form)
|
|---|
| 292 | ;" 5 -> GenericName DrugForm
|
|---|
| 293 | ;" 6 -> TradeName DrugForm Strength Units
|
|---|
| 294 | ;"results: special composite name, or "^" for user abort
|
|---|
| 295 |
|
|---|
| 296 | set AllowCut=$get(AllowCut,1)
|
|---|
| 297 | set MaxLen=$get(MaxLen,256)
|
|---|
| 298 | set Mode=$get(Mode,1)
|
|---|
| 299 | new TMGunits,TMGstrength,TMGTradeName,tempS
|
|---|
| 300 | new vaGeneric,vagIEN
|
|---|
| 301 | set vagIEN=$piece($get(^TMG(22706.9,IEN,1)),"^",3) ;"VA GENERIC <-Pntr [P50.6']
|
|---|
| 302 | set vaGeneric=$$GET1^DIQ(50.6,vagIEN,.01)
|
|---|
| 303 | if vaGeneric="" set vaGeneric=$piece($get(^TMG(22706.9,IEN,0)),"^",6)
|
|---|
| 304 | set TMGTradeName=$piece($get(^TMG(22706.9,IEN,0)),"^",4) ;".05 TRADENAME [F] ;e.g. DILTIAZEM HCL SR CAPSULES
|
|---|
| 305 | if $extract(TMGTradeName,1)="." set TMGTradeName="0"_TMGTradeName ;".9% saline (rejected) --> 0.9% (acceptible)
|
|---|
| 306 | if TMGTradeName["..." set TMGTradeName=$$Substitute^TMGSTUTL(TMGTradeName,"...","")
|
|---|
| 307 |
|
|---|
| 308 | set TMGstrength=$piece($get(^TMG(22706.9,IEN,0)),"^",2) ;"1 STRENGTH [F] ;e.g. 240
|
|---|
| 309 |
|
|---|
| 310 | set TMGunits=$piece($get(^TMG(22706.9,IEN,0)),"^",3) ;"2 UNIT [F] ;e.g. MG
|
|---|
| 311 |
|
|---|
| 312 | new vadfIEN set vadfIEN=+$piece($get(^TMG(22706.9,IEN,0)),"^",7) ;"3.5 VA DOSAGE FORM
|
|---|
| 313 | new vaDoseForm
|
|---|
| 314 | if vadfIEN>0 set vaDoseForm=$piece($get(^PS(50.606,vadfIEN,0)),"^",1) ;".01 NAME
|
|---|
| 315 | else set vaDoseForm=""
|
|---|
| 316 |
|
|---|
| 317 | new hideGeneric set hideGeneric=0
|
|---|
| 318 | new tempS
|
|---|
| 319 | if Mode=1 do ;"1 -> TradeName (GenericName) Strength Units
|
|---|
| 320 | . ;"if $extract(TMGTradeName,1,$length(vaGenericName))=vaGenericName do
|
|---|
| 321 | . if $extract(TMGTradeName,1,$length(vaGeneric))=vaGeneric do
|
|---|
| 322 | . . set tempS=TMGTradeName
|
|---|
| 323 | . . if TMGstrength'="" set tempS=tempS_" "_TMGstrength
|
|---|
| 324 | . . if TMGunits'="" set tempS=tempS_" "_TMGunits
|
|---|
| 325 | . . set hideGeneric=1
|
|---|
| 326 | . else do
|
|---|
| 327 | . . ;"set tempS=vaGeneric_" ("_TMGTradeName_")"
|
|---|
| 328 | . . set tempS=TMGTradeName_" ("_vaGeneric_")"
|
|---|
| 329 | . . if TMGstrength'="" set tempS=tempS_" "_TMGstrength
|
|---|
| 330 | . . if TMGunits'="" set tempS=tempS_" "_TMGunits
|
|---|
| 331 | . if $length(tempS)>MaxLen do
|
|---|
| 332 | . . set tempS=$$ShortNetName^TMGSHORT(vaGeneric,TMGTradeName,TMGstrength,TMGunits,MaxLen,.AllowCut)
|
|---|
| 333 | if Mode=2 do ;"2 -> TradeName Strength Units
|
|---|
| 334 | . set tempS=TMGTradeName
|
|---|
| 335 | . if TMGstrength'="" set tempS=tempS_" "_TMGstrength
|
|---|
| 336 | . if TMGunits'="" set tempS=tempS_" "_TMGunits
|
|---|
| 337 | . if $length(tempS)>MaxLen do
|
|---|
| 338 | . . set tempS=$$ShortNetName^TMGSHORT(,TMGTradeName,TMGstrength,TMGunits,MaxLen,.AllowCut)
|
|---|
| 339 | if Mode=3 do ;"3 -> GenericName DrugForm Strength Units
|
|---|
| 340 | . set tempS=vaGeneric
|
|---|
| 341 | . if vaDoseForm'="" set tempS=tempS_" "_vaDoseForm
|
|---|
| 342 | . if TMGstrength'="" set tempS=tempS_" "_TMGstrength
|
|---|
| 343 | . if TMGunits'="" set tempS=tempS_" "_TMGunits
|
|---|
| 344 | . if $length(tempS)>MaxLen do
|
|---|
| 345 | . . set tempS=$$ShortNetName^TMGSHORT(vaGeneric,,TMGstrength,TMGunits,MaxLen,.AllowCut)
|
|---|
| 346 | if Mode=4 do ;"4 -> TradeName (includes Drug Form)
|
|---|
| 347 | . set tempS=TMGTradeName
|
|---|
| 348 | . if $length(tempS)>MaxLen do
|
|---|
| 349 | . . set tempS=$$ShortNetName^TMGSHORT(,TMGTradeName,,,MaxLen,.AllowCut)
|
|---|
| 350 | if Mode=5 do ;"5 -> GenericName DrugForm
|
|---|
| 351 | . set tempS=vaGeneric
|
|---|
| 352 | . if vaDoseForm'="" set tempS=tempS_" "_vaDoseForm
|
|---|
| 353 | . if $length(tempS)>MaxLen do
|
|---|
| 354 | . . set tempS=$$ShortNetName^TMGSHORT(tempS,,,,MaxLen,.AllowCut)
|
|---|
| 355 | if Mode=6 do ;" 6 -> TradeName DrugForm Strength Units
|
|---|
| 356 | . set tempS=TMGTradeName ;"Note: TradeName includes Drug Form
|
|---|
| 357 | . if TMGstrength'="" set tempS=tempS_" "_TMGstrength
|
|---|
| 358 | . if TMGunits'="" set tempS=tempS_" "_TMGunits
|
|---|
| 359 | . if $length(tempS)>MaxLen do
|
|---|
| 360 | . . set tempS=$$ShortNetName^TMGSHORT(,TMGTradeName,TMGstrength,TMGunits,MaxLen,.AllowCut)
|
|---|
| 361 |
|
|---|
| 362 | set tempS=$$Trim^TMGSTUTL(tempS)
|
|---|
| 363 | if $extract(tempS,1,1)="(" do ;"Input transform doesn't allow first chart to be '('
|
|---|
| 364 | . ;"NOTE: I should write better code to change only the LAST ) to "", i.e. not cut out ALL ()'s
|
|---|
| 365 | . set tempS=$translate(tempS,"(","")
|
|---|
| 366 | . set tempS=$translate(tempS,")","")
|
|---|
| 367 | if $extract(tempS,1,1)="/" do ;"Input transform doesn't allow first chart to be '/'
|
|---|
| 368 | . set tempS=$extract(tempS,2,999)
|
|---|
| 369 |
|
|---|
| 370 | set tempS=$translate(tempS,";",":") ;"some input transforms don't allow ';' character
|
|---|
| 371 | quit tempS
|
|---|
| 372 |
|
|---|
| 373 |
|
|---|
| 374 | AskArray(IENArray,PrepArray)
|
|---|
| 375 | ;"Purpose: to get array with possible fixes for one record in 22706.9 file
|
|---|
| 376 | ;"Input: Array -- PASS BY REFERENCE (Used if rescanning needed)
|
|---|
| 377 | ;" Array(IEN)=""
|
|---|
| 378 | ;" Array(IEN)=""
|
|---|
| 379 | ;" FixArray -- PASS BY REFERENCE. Format:
|
|---|
| 380 | ;" FixArray(IEN,.04)=Name for .04
|
|---|
| 381 | ;" FixArray(IEN,.055)=Name for .055
|
|---|
| 382 | ;" FixArray(IEN,.056)=Name for .056
|
|---|
| 383 | ;" FixArray(IEN,.075)=Name for .075
|
|---|
| 384 | ;" FixArray(IEN,.076)=Name for .076
|
|---|
| 385 | ;"Results: None
|
|---|
| 386 | ;"Output: records in 50.68 will be changed, field .055,.056,.075, and .076 will be checked and fixed
|
|---|
| 387 |
|
|---|
| 388 | new input,list
|
|---|
| 389 | new cmd,nums
|
|---|
| 390 | new compactMode set compactMode=1
|
|---|
| 391 | new MapArray
|
|---|
| 392 | AA1
|
|---|
| 393 | do DispFixArray(.PrepArray,.MapArray,compactMode)
|
|---|
| 394 | write !,"E to manually edit entries; D to delete (skip) entries",!
|
|---|
| 395 | write "R to rescan; A To accept entries",!
|
|---|
| 396 | write "C turn Compact display ",$select((compactMode=1):"OFF",1:"ON"),!
|
|---|
| 397 | write "ALL to accept all entries WITHOUT any '...'s",!!
|
|---|
| 398 | read "Enter Option: ^// ",input:$get(DTIME,3600),!
|
|---|
| 399 | if input="" set input="^"
|
|---|
| 400 | set input=$$UP^XLFSTR(input)
|
|---|
| 401 | if input="^" goto AADone
|
|---|
| 402 | set nums=""
|
|---|
| 403 | set cmd=input
|
|---|
| 404 | if cmd="E" do goto AA1
|
|---|
| 405 | . if nums="" do
|
|---|
| 406 | . . write "Enter number(s) to edit (#,#-#, etc; ^ to quit): "
|
|---|
| 407 | . . read nums:$get(DTIME,3600),!
|
|---|
| 408 | . if '$$MkMultList^TMGMISC(nums,.list) quit
|
|---|
| 409 | . new num set num=""
|
|---|
| 410 | . for set num=$order(list(num)) quit:(num="") do
|
|---|
| 411 | . . new IEN,name04,name55,name75,result
|
|---|
| 412 | . . set IEN=$get(MapArray(num)) if IEN="" quit
|
|---|
| 413 | . . set name04=$get(PrepArray(IEN,.04))
|
|---|
| 414 | . . set name55=$get(PrepArray(IEN,.055))
|
|---|
| 415 | . . set name56=$get(PrepArray(IEN,.056))
|
|---|
| 416 | . . set name75=$get(PrepArray(IEN,.075))
|
|---|
| 417 | . . set name76=$get(PrepArray(IEN,.076))
|
|---|
| 418 | AA2 . . set result=$$PrepNames(IEN,name04,name55,name56,name75,name76,.PrepArray,0)
|
|---|
| 419 | . . if result=1 quit
|
|---|
| 420 | . . new new04Name set new04Name=$get(PrepArray(IEN,.004))
|
|---|
| 421 | . . new new55Name set new55Name=$get(PrepArray(IEN,.055))
|
|---|
| 422 | . . new new56Name set new56Name=$get(PrepArray(IEN,.056))
|
|---|
| 423 | . . new new75Name set new75Name=$get(PrepArray(IEN,.075))
|
|---|
| 424 | . . new new76Name set new76Name=$get(PrepArray(IEN,.076))
|
|---|
| 425 | . . if new04Name=name04 set new04Name=""
|
|---|
| 426 | . . if new55Name=name55 set new55Name=""
|
|---|
| 427 | . . if new56Name=name56 set new56Name=""
|
|---|
| 428 | . . if new75Name=name75 set new75Name=""
|
|---|
| 429 | . . if new76Name=name76 set new76Name=""
|
|---|
| 430 | . . set result=$$Write1(IEN,new04Name,new55Name,new56Name,new75Name,new76Name)
|
|---|
| 431 | . . if result=0 kill PrepArray(IEN)
|
|---|
| 432 | if cmd="C" do goto AA1
|
|---|
| 433 | . set compactMode='compactMode
|
|---|
| 434 | if cmd="ALL" do GOTO AA1
|
|---|
| 435 | . new Itr,IEN,abort
|
|---|
| 436 | . set abort=0
|
|---|
| 437 | . set IEN=$$ItrAInit^TMGITR("PrepArray",.Itr)
|
|---|
| 438 | . write "Storing accepted names for future use...",!
|
|---|
| 439 | . do PrepProgress^TMGITR(.Itr,20,1,"IEN")
|
|---|
| 440 | . if IEN'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN)="")!abort
|
|---|
| 441 | . . if $$UserAborted^TMGUSRIF() set abort=1 quit
|
|---|
| 442 | . . new name04,name55,name56,name75,name76,result
|
|---|
| 443 | . . set name04=$get(PrepArray(IEN,.04))
|
|---|
| 444 | . . set name55=$get(PrepArray(IEN,.055))
|
|---|
| 445 | . . set name56=$get(PrepArray(IEN,.056))
|
|---|
| 446 | . . set name75=$get(PrepArray(IEN,.075))
|
|---|
| 447 | . . set name76=$get(PrepArray(IEN,.076))
|
|---|
| 448 | . . if name04["..." set name04=""
|
|---|
| 449 | . . if name55["..." set name55=""
|
|---|
| 450 | . . if name56["..." set name56=""
|
|---|
| 451 | . . if name75["..." set name75=""
|
|---|
| 452 | . . if name76["..." set name76=""
|
|---|
| 453 | . . if (name04="")&(name55="")&(name56="")&(name75="")&(name76="") quit ;"avoid delete of names with ...
|
|---|
| 454 | . . set result=$$Write1(IEN,name04,name55,name56,name75,name76)
|
|---|
| 455 | . . if result=0 kill IENArray(IEN),PrepArray(IEN)
|
|---|
| 456 | . do ProgressDone^TMGITR(.Itr)
|
|---|
| 457 | ;"if (cmd="A")!(+cmd=cmd) do goto AA1
|
|---|
| 458 | if (cmd="A") do goto AA1
|
|---|
| 459 | . if nums="" do
|
|---|
| 460 | . . write "Enter number(s) to accept (#,#-#, etc; ^ to quit): "
|
|---|
| 461 | . . read nums:$get(DTIME,3600),!
|
|---|
| 462 | . if '$$MkMultList^TMGMISC(nums,.list) quit
|
|---|
| 463 | . new num set num=""
|
|---|
| 464 | . for set num=$order(list(num)) quit:(num="") do
|
|---|
| 465 | . . new IEN set IEN=$get(MapArray(num)) if IEN="" quit
|
|---|
| 466 | . . new name04,name55,name75,result
|
|---|
| 467 | . . set name04=$get(PrepArray(IEN,.04))
|
|---|
| 468 | . . set name55=$get(PrepArray(IEN,.055))
|
|---|
| 469 | . . set name56=$get(PrepArray(IEN,.056))
|
|---|
| 470 | . . set name75=$get(PrepArray(IEN,.075))
|
|---|
| 471 | . . set name76=$get(PrepArray(IEN,.076))
|
|---|
| 472 | . . new result set result=$$Write1(IEN,name04,name55,name56,name75,name76)
|
|---|
| 473 | . . if result=0 kill IENArray(IEN),PrepArray(IEN)
|
|---|
| 474 | else if $extract(cmd,1)="D" do goto AA1
|
|---|
| 475 | . new Perm,% set Perm=0,%=2
|
|---|
| 476 | . write "Will remove from display list.",!
|
|---|
| 477 | . write "Also perminantly mark drug so be SKIPPED"
|
|---|
| 478 | . do YN^DICN write !
|
|---|
| 479 | . if %=-1 quit
|
|---|
| 480 | . if %=1 set Perm=1
|
|---|
| 481 | . set nums=$extract(cmd,2,999)
|
|---|
| 482 | . if nums="" do
|
|---|
| 483 | . . write "Enter number(s) to delete (#,#-#, etc; ^ to quit): "
|
|---|
| 484 | . . read nums:$get(DTIME,3600),!
|
|---|
| 485 | . if '$$MkMultList^TMGMISC(nums,.list) quit
|
|---|
| 486 | . new num set num=""
|
|---|
| 487 | . for set num=$order(list(num)) quit:(num="") do
|
|---|
| 488 | . . new IEN set IEN=+$get(MapArray(num)) if IEN="" quit
|
|---|
| 489 | . . kill PrepArray(IEN),IENArray(IEN)
|
|---|
| 490 | . . if (Perm=1)&(IEN>0) set $piece(^TMG(22706.9,IEN,1),"^",4)=1 ;"1=SKIP
|
|---|
| 491 | else if cmd="R" do goto AA1
|
|---|
| 492 | . kill PrepArray
|
|---|
| 493 | . do GetPrepArray(.IENArray,.PrepArray)
|
|---|
| 494 |
|
|---|
| 495 | goto AA1
|
|---|
| 496 | AADone
|
|---|
| 497 | quit
|
|---|
| 498 |
|
|---|
| 499 |
|
|---|
| 500 | Write1(IEN,name04,name55,name56,name75,name76)
|
|---|
| 501 | ;"Purpose to write 1 record in 22706.9 file
|
|---|
| 502 | ;"Input: IEN -- the ien in file 22706.9
|
|---|
| 503 | ;" name04 -- OPTIONAL name for .04 field
|
|---|
| 504 | ;" name55 -- OPTIONAL name for .055 field
|
|---|
| 505 | ;" name56 -- OPTIONAL name for .056 field
|
|---|
| 506 | ;" name75 -- OPTIONAL name for .075 field
|
|---|
| 507 | ;" name76 -- OPTIONAL name for .076 field
|
|---|
| 508 | ;"Output: records in 22706.9 will be changed, field .055 and .075 will be checked and fixed
|
|---|
| 509 | ;"Results: 0 = OK. -1=error
|
|---|
| 510 |
|
|---|
| 511 | new result set result=0 ;"default to success
|
|---|
| 512 | new TMGFDA,TMGIEN,TMGMSG,IENS
|
|---|
| 513 | set IENS=IEN_","
|
|---|
| 514 |
|
|---|
| 515 | if $get(name04)'="" set TMGFDA(22706.9,IENS,.04)=name04
|
|---|
| 516 | if $get(name55)'="" set TMGFDA(22706.9,IENS,.055)=name55
|
|---|
| 517 | if $get(name56)'="" set TMGFDA(22706.9,IENS,.056)=name56
|
|---|
| 518 | if $get(name75)'="" set TMGFDA(22706.9,IENS,.075)=name75
|
|---|
| 519 | if $get(name76)'="" set TMGFDA(22706.9,IENS,.076)=name76
|
|---|
| 520 |
|
|---|
| 521 | if $data(TMGFDA)>0 do FILE^DIE("EK","TMGFDA","TMGMSG")
|
|---|
| 522 | if $data(TMGMSG("DIERR")) do goto W1NDone
|
|---|
| 523 | . set result=-1
|
|---|
| 524 | . if $get(Quiet)=1 quit
|
|---|
| 525 | . write !,"Error writing names to file 22706.9, record# ",IEN,!
|
|---|
| 526 | . new PriorErrorFound
|
|---|
| 527 | . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
|
|---|
| 528 |
|
|---|
| 529 | set result=0
|
|---|
| 530 |
|
|---|
| 531 | W1NDone
|
|---|
| 532 | quit result
|
|---|
| 533 |
|
|---|
| 534 |
|
|---|
| 535 |
|
|---|
| 536 | DispFixArray(PrepArray,MapArray,compactMode)
|
|---|
| 537 | ;"Purpose: to Display values in PrepArray
|
|---|
| 538 | ;"Input: PrepArray array will be filled as follows:
|
|---|
| 539 | ;" PrepArray(IEN1,.04)=Name for .04
|
|---|
| 540 | ;" PrepArray(IEN1,.055)=Name for .055
|
|---|
| 541 | ;" PrepArray(IEN1,.056)=Name for .056
|
|---|
| 542 | ;" PrepArray(IEN1,.075)=Name for .075
|
|---|
| 543 | ;" PrepArray(IEN1,.076)=Name for .076
|
|---|
| 544 | ;" MapArray PASS BY REFERENCE, an OUT PARAMETER
|
|---|
| 545 | ;" MapPrep(1)=IEN
|
|---|
| 546 | ;" MapPrep(2)=IEN
|
|---|
| 547 | ;" MapPrep(3)=IEN
|
|---|
| 548 | ;" MapPrep(4)=IEN
|
|---|
| 549 | ;" compactMode -- OPTIONAL. Default=1
|
|---|
| 550 | ;" if =1, then only end of list shown
|
|---|
| 551 | ;"Output: will dump array
|
|---|
| 552 | ;"Result: none
|
|---|
| 553 |
|
|---|
| 554 | write !
|
|---|
| 555 | write "--------------------",!
|
|---|
| 556 | kill MapArray
|
|---|
| 557 | new IEN,Num
|
|---|
| 558 | set Num=1
|
|---|
| 559 | set compactMode=$get(compactMode,1)
|
|---|
| 560 | new someShown set someShown=0
|
|---|
| 561 | if compactMode=0 do
|
|---|
| 562 | set IEN=$order(PrepArray(""))
|
|---|
| 563 | else do
|
|---|
| 564 | . new i
|
|---|
| 565 | . set IEN=""
|
|---|
| 566 | . for i=1:1:10 do quit:(IEN="")
|
|---|
| 567 | . . set IEN=$order(PrepArray(IEN),-1)
|
|---|
| 568 | . if IEN="" set IEN=$order(PrepArray(""))
|
|---|
| 569 | if +IEN>0 for do quit:(IEN="")
|
|---|
| 570 | . new s,s2,name04,name55,name56,name75,name76
|
|---|
| 571 | . set MapArray(Num)=IEN
|
|---|
| 572 | . set someShown=1
|
|---|
| 573 | . set s=Num_". "
|
|---|
| 574 | . set s=s_"["_IEN_"] " ;"temporary
|
|---|
| 575 | . set s2=$extract(" ",1,$length(s))
|
|---|
| 576 | . set name04=$get(PrepArray(IEN,.04))
|
|---|
| 577 | . set name55=$get(PrepArray(IEN,.055))
|
|---|
| 578 | . set name56=$get(PrepArray(IEN,.056))
|
|---|
| 579 | . set name75=$get(PrepArray(IEN,.075))
|
|---|
| 580 | . set name76=$get(PrepArray(IEN,.076))
|
|---|
| 581 | . write s
|
|---|
| 582 | . if name04'="" do
|
|---|
| 583 | . . write name04,!
|
|---|
| 584 | . . if name55'="" write s2
|
|---|
| 585 | . if name55'="" do
|
|---|
| 586 | . . write name55,!
|
|---|
| 587 | . . if name75'="" write s2
|
|---|
| 588 | . if name75'="" write name75,!
|
|---|
| 589 | . if name56'="" write name56,!
|
|---|
| 590 | . if name76'="" write name76,!
|
|---|
| 591 | . set IEN=$order(PrepArray(IEN))
|
|---|
| 592 | . set Num=Num+1
|
|---|
| 593 | if someShown=0 write " (List is empty)",!
|
|---|
| 594 | write "--------------------",!
|
|---|
| 595 |
|
|---|
| 596 | quit
|
|---|
| 597 |
|
|---|
| 598 |
|
|---|
| 599 | CheckForBlanks
|
|---|
| 600 | new IENArray,BlankArray
|
|---|
| 601 | new PrepArray
|
|---|
| 602 | write "Scanning existing names of imports not skipped...",!
|
|---|
| 603 | do GetIENArray(.IENArray)
|
|---|
| 604 |
|
|---|
| 605 | write "Checking for blank names...",!
|
|---|
| 606 | do Check4Blanks(.IENArray,.BlankArray)
|
|---|
| 607 |
|
|---|
| 608 | new fixNeeded set fixNeeded=0
|
|---|
| 609 |
|
|---|
| 610 | if $data(BlankArray)'=0 do
|
|---|
| 611 | . write "Preparing suggested names...",!
|
|---|
| 612 | . do GetPrepArray(.BlankArray,.PrepArray)
|
|---|
| 613 | . if $data(PrepArray)'=0 do
|
|---|
| 614 | . . set fixNeeded=1
|
|---|
| 615 | . . do AskArray(.BlankArray,.PrepArray)
|
|---|
| 616 |
|
|---|
| 617 | if fixNeeded=0 do
|
|---|
| 618 | . write "No fixes required. Great!",!
|
|---|
| 619 | . do PressToCont^TMGUSRIF
|
|---|
| 620 |
|
|---|
| 621 | quit
|
|---|
| 622 |
|
|---|
| 623 |
|
|---|
| 624 | Check4Blanks(IENArray,BlankArray)
|
|---|
| 625 | ;"Purpose: Check if any of the fields are blank and allow fixing
|
|---|
| 626 | ;"Input: IENArray -- PASS BY REFERENCE (Used if rescanning needed)
|
|---|
| 627 | ;" IENArray(IEN,.04)=currentValue
|
|---|
| 628 | ;" IENArray(IEN,.055)=currentValue
|
|---|
| 629 | ;" IENArray(IEN,.056)=currentValue
|
|---|
| 630 | ;" IENArray(IEN,.075)=currentValue
|
|---|
| 631 | ;" IENArray(IEN,.076)=currentValue
|
|---|
| 632 | ;" BlankArray -- PASS BY REFERENCE. An OUT PARAMETER. Format:
|
|---|
| 633 | ;" BlankArray(IEN,.04)=Name for .04
|
|---|
| 634 | ;" BlankArray(IEN,.055)=Name for .055
|
|---|
| 635 | ;" BlankArray(IEN,.056)=Name for .056
|
|---|
| 636 | ;" BlankArray(IEN,.075)=Name for .075
|
|---|
| 637 | ;" BlankArray(IEN,.076)=Name for .076
|
|---|
| 638 | ;"Results: none
|
|---|
| 639 |
|
|---|
| 640 | new Itr,IEN,abort
|
|---|
| 641 | set abort=0
|
|---|
| 642 | set IEN=$$ItrAInit^TMGITR("IENArray",.Itr)
|
|---|
| 643 | do PrepProgress^TMGITR(.Itr,20,0,"IEN")
|
|---|
| 644 | if IEN'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN)="")!abort
|
|---|
| 645 | . if $$UserAborted^TMGUSRIF() set abort=1 quit
|
|---|
| 646 | . new Cur04Value set Cur04Value=$get(IENArray(IEN,.04))
|
|---|
| 647 | . new Cur55Value set Cur55Value=$get(IENArray(IEN,.055))
|
|---|
| 648 | . new Cur56Value set Cur56Value=$get(IENArray(IEN,.056))
|
|---|
| 649 | . new Cur75Value set Cur75Value=$get(IENArray(IEN,.075))
|
|---|
| 650 | . new Cur76Value set Cur76Value=$get(IENArray(IEN,.076))
|
|---|
| 651 | . if (Cur04Value="")!(Cur55Value="")!(Cur56Value="")!(Cur75Value="")!(Cur76Value="") do
|
|---|
| 652 | . . write IEN,?8," .04 (LONG NAME) = ",Cur04Value,!
|
|---|
| 653 | . . write ?8,".055 (TRADENAME) = ",Cur55Value,!
|
|---|
| 654 | . . write ?8,".056 (TRADENAME FORM DOSE UNIT)= ",Cur56Value,!
|
|---|
| 655 | . . write ?8,".075 (GENERIC NAME & FORM) = ",Cur75Value,!
|
|---|
| 656 | . . write ?8,".076 (GENERICNAME FORM DOSE UNT) = ",Cur76Value,!
|
|---|
| 657 | . . merge BlankArray(IEN)=IENArray(IEN)
|
|---|
| 658 |
|
|---|
| 659 | do ProgressDone^TMGITR(.Itr)
|
|---|
| 660 |
|
|---|
| 661 | quit
|
|---|
| 662 |
|
|---|
| 663 | ;"==========================================
|
|---|
| 664 |
|
|---|
| 665 | ScanBadName
|
|---|
| 666 | ;"Purpose: scan for bad names, and debug the problem.
|
|---|
| 667 | ;"Input: none
|
|---|
| 668 | ;"Results: none
|
|---|
| 669 |
|
|---|
| 670 | new IENArray,PrepArray
|
|---|
| 671 | write "Scanning existing names of imports not skipped...",!
|
|---|
| 672 | do GetIENArray(.IENArray)
|
|---|
| 673 |
|
|---|
| 674 | new Menu,UsrSlct
|
|---|
| 675 | set Menu(0)="Pick Which Name to Examine (2G)"
|
|---|
| 676 | set Menu(1)=" .04 LONG NAME"_$char(9)_"LongName"
|
|---|
| 677 | set Menu(2)=" .05 TRADENAME"_$char(9)_"TradeName"
|
|---|
| 678 | set Menu(3)=".055 TRADE NAME & FORM - 40"_$char(9)_"TradeF"
|
|---|
| 679 | set Menu(4)=".056 TRADENAME FORM DOSE UNIT - 40"_$char(9)_"TradeFDU"
|
|---|
| 680 | set Menu(5)=" .07 GENERIC NAME"_$char(9)_"Generic"
|
|---|
| 681 | set Menu(6)=".075 GENERIC NAME & FORM - 40"_$char(9)_"GenericF"
|
|---|
| 682 | set Menu(7)=".076 GENERICNAME FORM DOSE UNT - 40"_$char(9)_"GenrcFDU"
|
|---|
| 683 |
|
|---|
| 684 | SBN1 write #
|
|---|
| 685 | set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^")
|
|---|
| 686 |
|
|---|
| 687 | if UsrSlct="LongName" do Scan(.IENArray,.04,"LONG NAME") goto SBN1
|
|---|
| 688 | if UsrSlct="TradeName" do Scan(.IENArray,.055,"TRADENAME") goto SBN1
|
|---|
| 689 | if UsrSlct="TradeF" do Scan(.IENArray,.055,"TRADE NAME & FORM - 40") goto SBN1
|
|---|
| 690 | if UsrSlct="TradeFDU" do Scan(.IENArray,.056,"TRADENAME FORM DOSE UNIT - 40") goto SBN1
|
|---|
| 691 | if UsrSlct="Generic" do Scan(.IENArray,.07,"GENERIC NAME") goto SBN1
|
|---|
| 692 | if UsrSlct="GenericF" do Scan(.IENArray,.075,"GENERIC NAME & FORM - 40") goto SBN1
|
|---|
| 693 | if UsrSlct="GenrcFDU" do Scan(.IENArray,.076,"GENERICNAME FORM DOSE UNT - 40") goto SBN1
|
|---|
| 694 | if UsrSlct="^" goto SBN2
|
|---|
| 695 | goto SBN1
|
|---|
| 696 |
|
|---|
| 697 | SBN2 quit
|
|---|
| 698 |
|
|---|
| 699 |
|
|---|
| 700 | Scan(IENArray,FieldNum,FldName)
|
|---|
| 701 | ;"Purpose: to do scan
|
|---|
| 702 | ;"Input: -- IENArray -- PASS BY REFERENCE. Format:
|
|---|
| 703 | ;" Note: IEN is from file 22706.9
|
|---|
| 704 | ;" Array(IEN,.04)=currentValue
|
|---|
| 705 | ;" Array(IEN,.05)=currentValue
|
|---|
| 706 | ;" Array(IEN,.055)=currentValue
|
|---|
| 707 | ;" Array(IEN,.056)=currentValue
|
|---|
| 708 | ;" Array(IEN,.07)=currentValue
|
|---|
| 709 | ;" Array(IEN,.075)=currentValue
|
|---|
| 710 | ;" Array(IEN,.076)=currentValue
|
|---|
| 711 |
|
|---|
| 712 | new SrchRec
|
|---|
| 713 | new Itr,IEN,abort
|
|---|
| 714 | set abort=0
|
|---|
| 715 | set IEN=$$ItrAInit^TMGITR("IENArray",.Itr)
|
|---|
| 716 | do PrepProgress^TMGITR(.Itr,20,0,"IEN")
|
|---|
| 717 | if IEN'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN)="")!abort
|
|---|
| 718 | . if $$UserAborted^TMGUSRIF() set abort=1 quit
|
|---|
| 719 | . new s set s=$get(IENArray(IEN,FieldNum))
|
|---|
| 720 | . if (s="")!(s="<DUPLICATE>") quit
|
|---|
| 721 | . set SrchRec(s_" (#"_IEN_")",IEN_"^22706.9")=""
|
|---|
| 722 | do ProgressDone^TMGITR(.Itr)
|
|---|
| 723 |
|
|---|
| 724 | new Results
|
|---|
| 725 | write "Passing off to selector...",!
|
|---|
| 726 | do Slctor2^TMGUSRIF("SrchRec","Results","Pick Example(s) of Bad Drugs Names. [ESC][ESC] when done.")
|
|---|
| 727 |
|
|---|
| 728 | do HandleChain^TMGNDF4G(.Results) ;"Show forward array
|
|---|
| 729 |
|
|---|
| 730 | write "Done.",!
|
|---|
| 731 | do PressToCont^TMGUSRIF
|
|---|
| 732 |
|
|---|
| 733 | quit
|
|---|
