source: cprs/branches/tmg-cprs/m_files/TMGNDF1D.m@ 861

Last change on this file since 861 was 796, checked in by Kevin Toppenberg, 15 years ago

Initial upload

File size: 28.8 KB
RevLine 
[796]1TMGNDF1D ;TMG/kst/FDA Import: Import name cleanup ;03/25/06
2 ;;1.0;TMG-LIB;**1**;01/23/07
3
4 ;"FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS
5 ;"Code for cleaning up names.
6 ;"Kevin Toppenberg MD
7 ;"GNU General Public License (GPL) applies
8 ;"1-23-07
9
10 ;"=======================================================================
11 ;" API -- Public Functions.
12 ;"=======================================================================
13 ;"Menu
14 ;"Fix1Name(IEN) -- perform this units fixes for just 1 record
15
16 ;"=======================================================================
17 ;" Private Functions.
18 ;"=======================================================================
19 ;"PickSkips -- select records to mark as to be skipped.
20 ;"RemoveDups -- Set duplicate records to be skipped
21 ;"=======================================================================
22
23Menu
24 ;"Purpose: To give an interactive menu of tools to clean up data.
25
26 new Menu,UsrSlct
27 new i set i=0
28 set Menu(i)="Pick Option for Cleaning Up FDA Imported Data (1D)",i=i+1
29 set Menu(i)="Fix common misspellings etc. in Trade Names"_$char(9)_"NormalizeNames",i=i+1
30 set Menu(i)="SEARCH and REPLACE words in drug TRADE NAME"_$char(9)_"SEARCHd05",i=i+1
31 set Menu(i)="SEARCH and REPLACE words in drug STRENGTH"_$char(9)_"SEARCH1",i=i+1
32 set Menu(i)="SEARCH and REPLACE words in drug UNITS"_$char(9)_"SEARCH2",i=i+1
33 set Menu(i)="Fix dose decimals (e.g. '.5;.125' --> '0.5;0.125')"_$char(9)_"DECIMAL",i=i+1
34 set Menu(i)="Fix units decimals (e.g. 'MG/.5 ML;' --> 'MG/0.5ML')"_$char(9)_"UNITS",i=i+1
35 set Menu(i)="Remove unwanted DOSES from TRADE NAME"_$char(9)_"ScrubDoses",i=i+1
36 set Menu(i)="Edit import TRADE NAME (Caution)"_$char(9)_"EditTradeName",i=i+1
37 set Menu(i)="HELP"_$char(9)_"?"
38 set Menu("P")="Prev Stage"_$char(9)_"Prev"
39 set Menu("N")="Next Stage"_$char(9)_"Next"
40
41CD1
42 write #
43 set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^")
44 if UsrSlct="^" goto CDDone
45 if UsrSlct=0 set UsrSlct=""
46
47 if UsrSlct="Prev" goto Menu^TMGNDF1A ;"quit can occur from there...
48 if UsrSlct="Next" goto Menu^TMGNDF1E ;"quit can occur from there...
49
50 if UsrSlct="NormalizeNames" do NormalizeNames goto CD1
51 if UsrSlct="SEARCHd05" do Srch5Replace goto CD1
52 if UsrSlct="SEARCH1" do Srch1Replace goto CD1
53 if UsrSlct="SEARCH2" do Srch2Replace goto CD1
54 if UsrSlct="DECIMAL" do FixDecimals goto CD1
55 if UsrSlct="UNITS" do FixUnits goto CD1
56 if UsrSlct="ScrubDoses" do ScrubDoses goto CD1
57 if UsrSlct="EditTradeName" do EditTradename() goto CD1
58 if UsrSlct="?" do ShowHelp goto CD1
59 goto CDDone
60CDDone
61 quit
62
63ShowHelp
64 ;"Purpose: to display help instructions
65
66 write #,!
67 write "Q: Why does the data need clean up?",!
68 write "A: The FDA database seems to consist of data provided",!
69 write " by vendors. As such, there is a big variety in the",!
70 write " formats of drug names and in the dose specifications,",!
71 write " and also accuracy (many drugs are missing information.)",!
72 write !
73 write "Q: Are inaccurate or unwanted drug records deleted?",!
74 write "A: No. They are kept so that with the NEXT import, their",!
75 write " unwanted status will be remembered. Instead, they are",!
76 write " flagged with a SKIP THIS RECORD marker. They will be",!
77 write " ignored during further processing.",!
78 write !
79 write "Q: How do I flag an unwanted record to be SKIPPED?",!
80 write "A: Drug records are browsed in a 'selector' (more below)",!
81 write " and all the drugs to be skipped are selected. Then the",!
82 write " selector is exited by typing [ESC][ESC], and one is ",!
83 write " given a chance to mark all to be SKIPPED at once.",!
84 write !
85 do PressToCont^TMGUSRIF
86 write !
87 write "Q: How do I use the selector?",!
88 write "A: The selector is a tool from the VPE library. It has its",!
89 write " own help. A quick answer is to move the cursor up and down",!
90 write " and press SPACE to select or deselect a record. I recommend",!
91 write " using the '+' feature to select all records matching a",!
92 write " specified pattern.",!
93 write !
94 write "... more later...",!
95
96 do PressToCont^TMGUSRIF
97 quit
98
99
100Fix1Name(IEN)
101 ;"Purpose: perform this units fixes for just 1 record
102 ;"Input: IEN -- IEN in 22706.9
103 ;"results: none
104
105 new temp
106
107 set temp=$$Fix1Dec(IEN)
108 set temp=$$Fix1Unit(IEN)
109 set temp=$$Norm1Name(IEN)
110 set temp=$$Scrub1Dose(IEN)
111
112 quit
113
114
115FixDecimals
116 ;"Purpose: To convert bare decimals (e.g. '.5' --> '0.5') in STRENGTH
117
118 new Itr,IEN,strength,abort,count,newStr
119 set abort=0,count=0
120 set IEN=$$ItrInit^TMGITR(22706.9,.Itr)
121 do PrepProgress^TMGITR(.Itr,20,0,"IEN")
122 if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort
123 . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;"1=SKIP
124 . if $$KeyPressed^TMGUSRIF=27 set abort=1 quit
125 . set count=count+$$Fix1Dec(IEN)
126
127 write !,count," records changed",!
128 do PressToCont^TMGUSRIF
129
130 quit
131
132Fix1Dec(IEN)
133 ;"Purpose: To convert bare decimals (e.g. '.5' --> '0.5') in STRENGTH
134 ;"Input: IEN -- IEN in 22706.9
135 ;"Results: 1 if modified, 0 if not
136
137 new result set result=0
138 set strength=$piece($get(^TMG(22706.9,IEN,0)),"^",2)
139 if strength'["." goto F1DD
140 set newStr=$$FixNum(strength)
141 if newStr'=strength do
142 . new TMGFDA,TMGMSG
143 . set TMGFDA(22706.9,IEN_",",1)=newStr
144 . do FILE^DIE("K","TMGFDA","TMGMSG")
145 . do ShowIfDIERR^TMGDEBUG(.TMGMSG,.result)
146
147F1DD quit result
148
149
150FixUnits
151 ;"Purpose: To fix errors in Units (remove spaces, fix hanging decimals)
152
153 new Itr,IEN,strength,abort,count,newStr
154 set abort=0,count=0
155 set IEN=$$ItrInit^TMGITR(22706.9,.Itr)
156 do PrepProgress^TMGITR(.Itr,20,0,"IEN")
157 if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort
158 . if $$KeyPressed^TMGUSRIF=27 set abort=1 quit
159 . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;"1=SKIP
160 . set count=count+$$Fix1Unit(IEN)
161 write !,count," records changed",!
162 do PressToCont^TMGUSRIF
163
164 quit
165
166
167Fix1Unit(IEN)
168 ;"Purpose: To fix errors in Units (remove spaces, fix hanging decimals)
169 ;"Input: IEN -- IEN in 22706.9
170 ;"Results: 1 if changed, 0 if not
171
172 new result set result=0
173 set units=$piece($get(^TMG(22706.9,IEN,0)),"^",3)
174 set newStr=$$FixNum(units)
175 set newStr=$$Substitute^TMGSTUTL(newStr,"/PER","/")
176 set newStr=$$Substitute^TMGSTUTL(newStr,"/VIL","/VIAL")
177 set newStr=$translate(newStr," ","")
178 if $extract(newStr,$length(newStr))=";" set newStr=$extract(newStr,1,$length(newStr)-1)
179 if newStr'=units do
180 . new TMGFDA,TMGMSG
181 . set TMGFDA(22706.9,IEN_",",2)=newStr
182 . do FILE^DIE("K","TMGFDA","TMGMSG")
183 . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
184 . set result=1
185
186 quit result
187
188
189FixNum(numStr)
190 ;"Purpose: to fix hanging decimals in numStr (e.g. '.5' --> '0.5')
191 ;"Input: numStr -- the string to be fixed
192 ;"Results: returns fixed string
193 new result set result=numStr
194 new i for i=1:1:$length(result,".")-1 do
195 . new p set p=$$Pos^TMGSTUTL(".",result,i)
196 . new priorCh set priorCh=$extract(result,p-1)
197 . if +priorCh=priorCh quit
198 . if (p=1) do
199 . . set result="0"_result
200 . else do
201 . . new sA,sB
202 . . set sA=$extract(result,1,p-1),sB=$extract(result,p,9999)
203 . . set result=sA_"0"_sB
204
205 quit result
206
207Srch5Replace
208 ;"Purpose: To provide a mechanism for altering the drug trade names (.05 field)
209 ;" e.g. TETRACYCLINE HYDROCHLORIDE --> TETRACYCLINE HCL
210 ;" or LISINOPRIL/HYDROCHLOROTHIAZIDE --> LISINOPRIL/HCTZ
211 ;" The reason for this is that many drugs are put in BOTH WAYS, leading to
212 ;" duplicate entries, differing only in the expansion of these words.
213
214 do SrchReplace^TMGMISC(22706.9,.05,"SEARCH & REPLACE in Trade Name of FDA Imported Drugs")
215 quit
216
217Srch2Replace
218 ;"Purpose: To provide a mechanism for altering the drug UNITS (field 2)
219 ;" The reason for this is that many drugs are put in BOTH WAYS, leading to
220 ;" duplicate entries, differing only in the expansion of these words.
221
222 do SrchReplace^TMGMISC(22706.9,2,"SEARCH & REPLACE in UNITS of FDA Imported Drugs")
223 quit
224
225Srch1Replace
226 ;"Purpose: To provide a mechanism for altering the drug STRENGTH (field 1)
227 ;" The reason for this is that many drugs are put in BOTH WAYS, leading to
228 ;" duplicate entries, differing only in the expansion of these words.
229
230 do SrchReplace^TMGMISC(22706.9,1,"SEARCH & REPLACE in STRENGTH of FDA Imported Drugs")
231 quit
232
233
234NormalizeNames
235 ;"Purpose: To 'normalize' names, meaning replacing common misspellings etc.
236
237 new map ;"These are numbered to preserve their order
238 do SetupMap(.map)
239
240 new Itr,IEN,count
241 set count=0
242 new abort set abort=0
243 set IEN=$$ItrInit^TMGITR(22706.9,.Itr)
244 do PrepProgress^TMGITR(.Itr,20,0,"IEN")
245 if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort
246 . if $$UserAborted^TMGUSRIF set abort=1 quit
247 . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;"1=SKIP
248 . set count=count+$$Norm1Name(IEN,.map)
249
250 do ProgressDone^TMGITR(.Itr)
251
252 write count," Trade names (.05 field) modified.",!
253 if count>1 write "Because some changes are interdependant, please run this option again.",!
254 do PressToCont^TMGUSRIF
255
256 quit
257
258
259Norm1Name(IEN,map)
260 ;"Purpose: To 'normalize' names, meaning replacing common misspellings etc. for 1 record
261 ;"Input: IEN -- IEN in 22706.9
262 ;" map -- OPTIONAL. Array of changes to be made. If not provided, then
263 ;" it will be created here.
264 ;"Results: 1 if modified, 0 if not
265
266 if $data(map)=0 do SetupMap(.map)
267
268 new result set result=0
269 new TradeName set TradeName=$piece($get(^TMG(22706.9,IEN,0)),"^",4) ;"field .05
270 new oldName set oldName=TradeName
271 new num set num=""
272 for set num=$order(map(num)) quit:(num="") do
273 . set srchS=$order(map(num,"")) quit:(srchS="")
274 . if TradeName'[srchS quit
275 . write !,srchS,"-->",$get(map(num,srchS)),!
276 . set TradeName=$$Substitute^TMGSTUTL(TradeName,srchS,$get(map(num,srchS)))
277
278 if TradeName'=oldName do
279 . new TMGFDA,TMGMSG
280 . set TMGFDA(22706.9,IEN_",",.05)=TradeName
281 . do FILE^DIE("K","TMGFDA","TMGMSG")
282 . set result=1
283 . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
284
285 quit result
286
287
288SetupMap(map)
289 ;"Purpose: to set up mapping of spelling corrections to be made.
290 ;"Input: map -- PASS BY REFERENCE. An OUT parameter.
291
292 ;"NOTE: These are numbered to preserve their order
293 new i set i=0
294 set i=i+1,map(i,"SOLUTION")="SOLN"
295 set i=i+1,map(i,"OINTMENT")="OINT"
296 set i=i+1,map(i,"CAPSULES")="CAP"
297 set i=i+1,map(i,"CAPSULE")="CAP"
298 set i=i+1,map(i,"TALBETS")="TAB"
299 set i=i+1,map(i,"INJECTION")="INJ"
300 set i=i+1,map(i,"FOR INJ")="INJ"
301 set i=i+1,map(i,"EXTENDED")="EXT"
302 set i=i+1,map(i,"RELEASE")="REL"
303 set i=i+1,map(i,"INH ")="IHNL "
304 set i=i+1,map(i,"INHALATION")="INHL"
305 set i=i+1,map(i,"SUSPENSION")="SUSP"
306 set i=i+1,map(i,"OPHTHALMIC")="OPHTH"
307 set i=i+1,map(i,"HYDROCHLORIDE")="HCL"
308 set i=i+1,map(i,"FOR INJECTABLE SUSPENSION")="INJ"
309 set i=i+1,map(i,"CODEINE PHOSPHATE")="CODEINE"
310 set i=i+1,map(i,"WITH CODEINE")="CODEINE"
311 set i=i+1,map(i,"SOLN FOR INJ")="INJ SOLN"
312 set i=i+1,map(i,"POWDER FOR INJ")="INJ POWDER"
313 set i=i+1,map(i,"SOLN OPHTH")="OPHTH SOLN"
314 set i=i+1,map(i," SUFATE")=" SULFATE"
315 set i=i+1,map(i,"ALBUTEROL SULFATE")="ALBUTEROL"
316 set i=i+1,map(i,"FOR INHL")="INHL"
317 set i=i+1,map(i,"SOLN INHL")="INHL SOLN"
318 set i=i+1,map(i,"SUSTAINED")="SUST"
319 set i=i+1,map(i," BITART ")=" BITARTRATE "
320 set i=i+1,map(i," BITARTRATERATER")=" BITARTRATER"
321 set i=i+1,map(i," BITARTRATER ")=" BITARTRATE "
322 set i=i+1,map(i," BITRATE")=" BITARTRATE"
323 set i=i+1,map(i,"BITARTARATE")="BITARTRATE"
324 set i=i+1,map(i,"BITARTRATERATE")="BITARTRATE"
325 set i=i+1,map(i,"HYDROCODONEARATE")="HYDROCODONE"
326 set i=i+1,map(i,"HYDROCODONE ACET")="HYDROCODONE APAP"
327 set i=i+1,map(i,"HYDROCODONE BITARTRATE")="HYDROCODONE"
328 set i=i+1,map(i,"DIHYDROCODEINE BITARTRATE")="DIHYDROCODEINE"
329 set i=i+1,map(i,"WITH HYDROCODONE")="HYDROCODONE"
330 set i=i+1,map(i,"SOLN FOR IRRIGATION")="IRRIGATION SOLN"
331 set i=i+1,map(i,"CAPLETS")="CAP"
332 set i=i+1,map(i,"TABLET")="TAB"
333 set i=i+1,map(i,"POWDER")="PWDR"
334 set i=i+1,map(i,"TAB EXT REL")="EXT REL TAB"
335 set i=i+1,map(i,"SOLN ORAL")="ORAL SOLN"
336 set i=i+1,map(i,"TAB SUST REL")="SUST REL TAB"
337 set i=i+1,map(i,"RELD ")="REL "
338 set i=i+1,map(i," ")=" "
339 set i=i+1,map(i," SULFATE")=""
340 set i=i+1,map(i,"HYDROCHLOROTHIAZIDE")="HCTZ"
341 set i=i+1,map(i," AND ")=" "
342 set i=i+1,map(i,"HYDROCLORIDE")="HCL"
343 set i=i+1,map(i,"HYDROCLOROTHIAZIDE")="HCTZ"
344 set i=i+1,map(i,"HYDROCHLORITHIZIDE")="HCTZ"
345 set i=i+1,map(i,"HYDROCHLOROHIAZIDE")="HCTZ"
346 set i=i+1,map(i,"HYDROCLORTHIAZIDE")="HCTZ"
347 set i=i+1,map(i,"HYDROCLORIDE")="HCTZ"
348 set i=i+1,map(i,"HYDROCHLORIRDE")="HCTZ"
349 set i=i+1,map(i," HCT ")=" HCTZ "
350 set i=i+1,map(i,"HYDROCHLORIC ACID")="HCL"
351 set i=i+1,map(i,"HYDROCHORIDE")="HCL"
352 set i=i+1,map(i,"HYDROCHLORITHIAZIDE")="HCTZ"
353 set i=i+1,map(i,"HYDROCHLOROTIAZIDE")="HCTZ"
354 set i=i+1,map(i,"HYDROCHOROTHIAZIDE")="HCTZ"
355 set i=i+1,map(i,"HYDROCHLOROTHIAZED")="HCTZ"
356 set i=i+1,map(i,"HYDROCHLOROYTHIAZIDE")="HCTZ"
357 set i=i+1,map(i,"HYDROCHLOROTHIZED")="HCYZ"
358 set i=i+1,map(i,"HYDROCHLROTHIAZIDE")=""
359 set i=i+1,map(i,"HYDROCHOLRIDE")="HCL"
360 set i=i+1,map(i,"HYDROCHOLORIDE")="HCL"
361 set i=i+1,map(i,"HYDROCHLORTHIAZIDE")="HCTZ"
362 set i=i+1,map(i,"HYDROCHOLIRDE")="HCL"
363 set i=i+1,map(i,"HYDROCHLROIDE")="HCL"
364 set i=i+1,map(i,"HYDROCHLORIE")="HCL"
365 set i=i+1,map(i,"HYDROCHLORINE")="HCL"
366 set i=i+1,map(i,"CODIENE")="CODEINE"
367 set i=i+1,map(i,"SOLN INJ")="INJ SOLN"
368 set i=i+1,map(i,"SUBSTAINED")="SUST"
369 set i=i+1,map(i,"SODIM")="SODIUM"
370 set i=i+1,map(i,"CAP EXT REL")="EXT REL CAP"
371 set i=i+1,map(i,"CAP SUST REL")="SUST REL CAP"
372 set i=i+1,map(i,"INHAL ")="INHL "
373 set i=i+1,map(i,"FOR ORAL SOLN")="ORAL SOLN"
374 set i=i+1,map(i," I V ")=" IV "
375 set i=i+1,map(i,"INTRAVENOUS")="IV"
376 set i=i+1,map(i,"FOR ORAL SUSP")="ORAL SUSP"
377 set i=i+1,map(i,"CAPLET")="CAP"
378 set i=i+1,map(i,"WITH HCTZ")="HCTZ"
379 set i=i+1,map(i," HCL ")=" "
380 set i=i+1,map(i," HCL/")=""
381 set i=i+1,map(i,"SUST REL")="SR"
382 set i=i+1,map(i,"SR SR")="SR"
383 set i=i+1,map(i,"SUPENSION")="SUSP"
384 set i=i+1,map(i,"FOR SUSP")="SUSP"
385 set i=i+1,map(i,"SUSP ORAL")="ORAL SUSP"
386 set i=i+1,map(i," USP")=""
387 set i=i+1,map(i,"PHOSPHATE")="PHOS"
388 set i=i+1,map(i,"PHOSPHATES")="PHOS"
389 set i=i+1,map(i,"METROPROLOL")="METOPROLOL"
390 set i=i+1,map(i,"EXT-REL")="EXT REL"
391 set i=i+1,map(i," HCLT")=" HCL"
392 set i=i+1,map(i," HCLM")=" HCL"
393 set i=i+1,map(i," HCL")=""
394 set i=i+1,map(i,"INJECTABLE")="INJ"
395 set i=i+1,map(i,"HYDROCHODONE")="HYDROCODONE"
396 set i=i+1,map(i,"HYDROCHLOROTHAZIDE")="HCTZ"
397 set i=i+1,map(i,"HYDROCHLOROIDE")="HCL"
398 set i=i+1,map(i,"SODIUM CHLORIDE")="NACL"
399 set i=i+1,map(i," NAD ")=" AND "
400 set i=i+1,map(i," SODIUM")=""
401 set i=i+1,map(i,"LEVOYHYROXINE")="LEVOTHYROXINE"
402 set i=i+1,map(i," ACETAMINOPHEN")=" APAP"
403 set i=i+1,map(i,"NAPSLATE")="NAPSYLATE"
404 set i=i+1,map(i,"NAPSULATE")="NAPSYLATE"
405 set i=i+1,map(i," NAPSYLATE")=""
406 set i=i+1,map(i,"DARVOCET-N")="DARVOCET N"
407 set i=i+1,map(i,"PROPOX NAP")="PROPOXYPHENE"
408 set i=i+1,map(i,"PROPOX ")="PROPOXYPHENE "
409 set i=i+1,map(i,"PROPOXY ")="PROPOXYPHENE "
410 set i=i+1,map(i,"PROPOXYPHEN ")="PROPOXYPHENE "
411 set i=i+1,map(i,"PROPACET ")="PROPOXYPHENE APAP "
412 set i=i+1,map(i,"CLAULNATE ")="CLAVULANATE "
413 set i=i+1,map(i,"ASPPIRIN ")="ASPIRIN "
414
415 set i=i+1,map(i," &")=""
416 set i=i+1,map(i," / ")=" "
417 set i=i+1,map(i," CAFFINE")=" CAFFEINE"
418 set i=i+1,map(i,"MGAPAP")="MG APAP"
419 set i=i+1,map(i,"5MG")="5 MG"
420 set i=i+1,map(i,"0MG")="0 MG"
421
422 quit
423
424
425ScrubDoses
426 ;"Purpose: To remove doses from Tradename
427 ;"
428
429 new skips,ignore,PreSelArray
430 do SetScrubMaps(.skips,.ignore)
431
432 new Itr,IEN,count
433 set count=0
434 new abort set abort=0
435 write "Gathering a list of suggested name changes, removing #'s and doses...",!
436 set IEN=$$ItrInit^TMGITR(22706.9,.Itr)
437 do PrepProgress^TMGITR(.Itr,20,0,"IEN")
438 if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort
439 . if $$UserAborted^TMGUSRIF set abort=1 quit
440 . set count=count+$$Scrub1Dose(IEN,.skips,.ignore,0,.PreSelArray)
441 do ProgressDone^TMGITR(.Itr)
442
443 if $data(PreSelArray)=0 goto SDDone
444 new DelArray
445 do SelRxList("PreSelArray","DelArray","SELECT ALLOWED NAME CHANGES (COLUMN 1=OLD,2=NEW) ESC ESC WHEN DONE",3)
446 if $data(DelArray)=0 goto SDDone
447
448 new NewName set NewName=""
449 for set NewName=$order(DelArray(NewName)) quit:(NewName="") do
450 . new IEN set IEN=0
451 . for set IEN=$order(DelArray(NewName,IEN)) quit:(+IEN'>0) do
452 . . new TMGFDA,TMGMSG
453 . . set TMGFDA(22706.9,IEN_",",.05)=NewName
454 . . do FILE^DIE("K","TMGFDA","TMGMSG")
455 . . set count=count+1
456 . . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
457
458SDDone
459 write count," Trade names (.05 field) modified.",!
460 do PressToCont^TMGUSRIF
461
462 quit
463
464
465Scrub1Dose(IEN,skips,ignore,askuser,PreSelArray)
466 ;"Purpose: To remove doses from Tradename from 1 record
467 ;"Input: skips -- PASS BY REFERENCE. OPTIONAL
468 ;" ignore -- PASS BY REFERENCE. OPTIONAL
469 ;" askuser -- if 1, then user is asked. Default=1
470 ;" Otherwise, PreSelArray is filled with questions for user
471 ;" PreSelArray -- PASS BY REFERENCE. OPTIONAL
472 ;"Results: 1 if modified, 0 if not (including options put into PreSelArray)
473
474 new result set result=0
475 if ($data(skips)=0)!($data(ignore)=0) do
476 . kill skips,ignore
477 . do SetScrubMaps(.skips,.ignore)
478 set askuser=+$get(askuser,1)
479
480 new TradeName set TradeName=$piece($get(^TMG(22706.9,IEN,0)),"^",4) ;"field .05
481 new j set j=0
482 new ignore1 set ignore1=0
483 for set j=$order(ignore(j)) quit:(j="") do
484 . if TradeName[ignore(j) set ignore1=1
485 if ignore1 goto S1DD
486 set j=0
487 for set j=$order(skips(j)) quit:(j="") do
488 . new srchS set srchS=$get(skips(j))
489 . if TradeName'[srchS quit
490 . set TradeName=$$Substitute^TMGSTUTL(TradeName,srchS,"@@@"_$char(64+j)_"@@@")
491 new oldName set oldName=TradeName
492 set TradeName=$$ScrubNumeric^TMGSTUTL(TradeName)
493 if TradeName=oldName goto S1DD
494 if TradeName="" goto S1DD
495 if TradeName["@@@" do
496 . new j set j=$ascii($piece(TradeName,"@@@",2))-64
497 . set TradeName=$piece(TradeName,"@@@",1)_$get(skips(j))_$piece(TradeName,"@@@",3)
498 . set oldName=$piece(oldName,"@@@",1)_$get(skips(j))_$piece(oldName,"@@@",3)
499 ;"
500 if askuser'=1 set PreSelArray(TradeName,IEN)="" goto S1DD ;"bypass user asking...
501 ;"------------------
502 write !,IEN,": '",oldName,"' --> '",TradeName,"'",!
503 new % set %=2
504 write "Accept Change" do YN^DICN write !
505 if %=-1 set abort=1 goto S1DD
506 if %'=1 goto S1DD
507 if TradeName'=oldName do
508 . new TMGFDA,TMGMSG
509 . set TMGFDA(22706.9,IEN_",",.05)=TradeName
510 . do FILE^DIE("K","TMGFDA","TMGMSG")
511 . set result=1
512 . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
513
514S1DD quit result
515
516
517SetScrubMaps(skips,ignore)
518 ;"Purpose: setup arrays for removing doses from Tradename
519 ;"Input: skips -- PASS BY REFERENCE
520 ;" ignore -- PASS BY REFERENCE
521 ;"result
522
523 new i
524 set i=0 ;"NOTE!!! ASCII encoding only allow i up to 63!!
525 set i=i+1,skips(i)="5% DEXTROSE"
526 set i=i+1,skips(i)="5 % DEXTROSE"
527 set i=i+1,skips(i)="10% DEXTROSE"
528 set i=i+1,skips(i)="0.9% NA"
529 set i=i+1,skips(i)=".9% NA"
530 set i=i+1,skips(i)="0.45% NA"
531 set i=i+1,skips(i)="7 7 7"
532 set i=i+1,skips(i)="70 30"
533 set i=i+1,skips(i)="7.4"
534 set i=i+1,skips(i)="3 MONTH"
535 set i=i+1,skips(i)="4 MONTH"
536 set i=i+1,skips(i)="28 TAB"
537 set i=i+1,skips(i)="I 131"
538 set i=i+1,skips(i)="I-131"
539 set i=i+1,skips(i)="I 123"
540 set i=i+1,skips(i)="7 VAGINAL"
541 set i=i+1,skips(i)="3 VAGINAL"
542 set i=i+1,skips(i)="0.3% NACL"
543 set i=i+1,skips(i)="0.2% NACL"
544 set i=i+1,skips(i)="B12"
545 set i=i+1,skips(i)="B6"
546 set i=i+1,skips(i)="TC 99M"
547 set i=i+1,skips(i)="TC99M"
548 set i=i+1,skips(i)="THEO 24"
549 set i=i+1,skips(i)="24 H"
550 set i=i+1,skips(i)="12 H"
551 set i=i+1,skips(i)=" 12 "
552 set i=i+1,skips(i)=" 24 "
553 set i=i+1,skips(i)="VITAMIN K1"
554 set i=i+1,skips(i)="PH7"
555
556 ;"Put entries here when the presence of a word is enough to ignore entire drug name.
557 ;"if TradeName[ingore(x) then no further check done
558 set i=0 ;"no limit on # here...
559 set i=i+1,ignore(i)="TERAZOL"
560 set i=i+1,ignore(i)="ORTHO "
561 set i=i+1,ignore(i)="DARVOCET"
562 set i=i+1,ignore(i)="DEMULEN"
563 set i=i+1,ignore(i)="LEVLEN"
564 set i=i+1,ignore(i)="LEVLITE"
565 set i=i+1,ignore(i)="LOESTRIN"
566 set i=i+1,ignore(i)="NECON"
567 set i=i+1,ignore(i)=" MT "
568 set i=i+1,ignore(i)="ORTHOCEPT"
569 set i=i+1,ignore(i)="GYNAZOLE"
570 set i=i+1,ignore(i)="OVCON"
571 set i=i+1,ignore(i)="MONISTAT"
572 set i=i+1,ignore(i)="MICROGESTIN"
573 set i=i+1,ignore(i)="ULTRASE"
574 set i=i+1,ignore(i)="MTE "
575 set i=i+1,ignore(i)="M T E "
576 set i=i+1,ignore(i)="INSULIN"
577
578 quit
579
580
581CautionMsg
582 ;"Purpose: To show a caution message.
583
584 write !,"**NOTICE**",!
585 write "This will use the MULTI-selector to pick imports to be",!
586 write "be edited. BE VERY CAREFUL not to select more than one",!
587 write "drug before exiting to enter the edit screen.",!
588 write "For example: If 3 different drugs were selected, and then",!
589 write "ESC ESC pressed, then one will be presented with an opportunity",!
590 write "to edit the drug name. BUT NOTE: one would be editing ALL THREE",!
591 write "drugs AT ONCE, very likely creating an error in 2 of the drugs.",!
592 write !
593
594 do PressToCont^TMGUSRIF
595 quit
596
597
598EditTradename(SkipValue)
599 ;"Purpose: to select records to mark as to be skipped.
600 ;"Input: SkipValue: OPTIONAL. Default=0.
601 ;" 0=show only values NOT marked to be skipped
602 ;" 1=show only values MARKED to be skipped
603 ;" ALL=show BOTH skip and non-skipped fields.
604 ;"Output: User may alter the value of SKIP THIS RECORD field for all records
605 ;"Results: none
606
607 do CautionMsg
608
609 new Options,IEN
610 set Options("FIELDS",1)=".04^LONG NAME^25"
611 set Options("FIELDS",1,"NO EDIT")=1 ;"i.e. show for browsing, but don't allow edit
612 set Options("FIELDS",2)=".05^TRADENAME^64"
613 set Options("FIELDS","MAX NUM")=2
614 set Options("FILE")="22706.9^TMG FDA IMPORT COMPILED"
615
616 set SkipValue=$get(SkipValue,0) ;"0=NOT SKIPPED
617 ;"Get all records with chosed SKIP THIS RECORD value
618 do GetFldValue^TMGSELED(22706.9,6,SkipValue,$name(Options("IEN LIST")))
619
620PSK1 if $$SELED^TMGSELED(.Options)'=2 goto ETNDone
621 if $$GetIENs^TMGSELED(.Options)=0 goto ETNDone
622 goto PSK1
623
624ETNDone quit
625
626
627
628
629SelRxList(pList,pSelList,HdrText,mode)
630 ;"Purpose: To display the Drug list, and allow user to select from the list.
631 ;"Input: pList -- PASS BY NAME -- list of drugs to be added, as created by FillList(pList)
632 ;" @pList@(drugName,IEN)=""
633 ;" pSelList -- PASS BY NAME, an OUT PARAMETER.
634 ;" Returns list of selected items
635 ;" @pSelList@(drugName,IEN)="" ;IEN is from 22706.9
636 ;" @pSelList@(drugName,IEN)=""
637 ;" HdrText -- optional, some text to show on top of selector
638 ;" mode -- OPTIONAL. Default=1
639 ;" 1 --> Display by LONG NAME .04 name
640 ;" 2 --> Display by VA PRODUCT (50.68) .01 name
641 ;" 3 --> Display by FDA import name
642 ;" 4 --> Display by VA GENERIC name
643
644 ;"Results: none
645
646 new ref set ref="^TMP(""VEE"",$J)"
647 kill @ref
648 new count set count=1
649 set mode=$get(mode,1)
650
651 ;"new pNDCIndex set pNDCIndex=$$GetNDCIndex^TMGNDF4A(1)
652
653 write "Prepping to display list...",!
654 ;"First convert list to a display format
655 new name,IEN,Itr
656
657 set name=$$ItrAInit^TMGITR(pList,.Itr)
658 do PrepProgress^TMGITR(.Itr,20,1,"name")
659 if name'="" for do quit:($$ItrANext^TMGITR(.Itr,.name)="")
660 . new addedArray,showName
661 . set IEN=0
662 . for set IEN=$order(@pList@(name,IEN)) quit:(IEN="") do
663 . . new NameInfo do GetInfo^TMGNDF3B(IEN,.NameInfo)
664 . . new IdxName set IdxName=$get(NameInfo("MODES",mode))
665 . . if mode=3 do ;"Display by FDA import name (TradeName)
666 . . . set showName=""
667 . . . for set showName=$order(NameInfo(IdxName,showName)) quit:(showName="") do
668 . . . . set @ref@(count)=name_"^"_IEN_$char(9)
669 . . . . new newShowName set newShowName=$extract(showName,1,35)
670 . . . . set newShowName=$$LJ^XLFSTR(newShowName,35," ")
671 . . . . new newName set newName=$extract(name,1,35)
672 . . . . set newName=$$LJ^XLFSTR(newName,35," ")
673 . . . . set @ref@(count)=@ref@(count)_newShowName_"|"_newName
674 . . . . set count=count+1
675 . . . set showName="" ;"prevent duplicate addition below
676 . . else if (mode>0)&(mode<5) set showName=$order(NameInfo(IdxName,""))
677 . . if (showName'="") set @ref@(count)=name_"^"_IEN_$char(9)_showName set count=count+1
678
679 set @ref@("HD")=$get(HdrText,"MENU")
680
681 ;"Note: Rules of use:
682 ;" ref must=^TMP("VEE",$J)
683 ;" Each line should be in this format:
684 ;" @ref@(number)=ReturnValue_$char(9)_DisplayValue
685 ;" @ref@(number)=ReturnValue_$char(9)_DisplayValue
686 ;" @ref@(number)=ReturnValue_$char(9)_DisplayValue
687 ;" Results come back in:
688 ;" ^TMP("VPE","SELECT",$J,number)=ReturnValue_$char(9)_DisplayValue
689 ;" ^TMP("VPE","SELECT",$J,number)=ReturnValue_$char(9)_DisplayValue
690 ;" ^TMP("VPE","SELECT",$J,number)=ReturnValue_$char(9)_DisplayValue
691
692 write !,"Passing off to Selector..."
693 D SELECT^%ZVEMKT(ref)
694
695 set ref="^TMP(""VPE"",""SELECT"","_$J_")"
696 new number set number=""
697 for set number=$order(@ref@(number)) quit:(number="") do
698 . new ReturnValue set ReturnValue=$piece(@ref@(number),$char(9),1)
699 . new drugName set drugName=$piece(ReturnValue,"^",1)
700 . new IEN set IEN=$piece(ReturnValue,"^",2)
701 . set @pSelList@(drugName,IEN)=""
702
703 quit
704
705 ;"========================================================
706PickEdit
707 ;"Purpose: ask user to pick record, and then edit.
708
709 new DIC,X,Y
710 set DIC=22706.9
711 set DIC(0)="MAEQ"
712 set DIC("A")="Enter Imported Drug to Edit (^ to abort): "
713PE1
714 do ^DIC write !
715 if +Y>0 do Edit1(+Y) goto PE1
716
717 quit
718
719
720Edit1(IEN)
721 ;"Purpose: To edit one record in 22706.9
722 ;"Input: IEN -- IEN in 22706.9
723 ;"Results: none
724
725 new Options,IENlist
726 set IENlist(IEN)=""
727 set Options("FILE")=22706.9
728 new temp
729 set temp=$$GetFields^TMGSELED(.Options)
730 if temp=1 set temp=$$EditRecs^TMGSELED("IENlist",.Options)
731
732 quit
733
734
Note: See TracBrowser for help on using the repository browser.