source: cprs/branches/tmg-cprs/m_files/TMGNDF0B.m@ 1119

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

Initial upload

File size: 14.4 KB
RevLine 
[796]1TMGNDF0B ;TMG/kst/FDA Import: Display FDA files ;03/25/06
2 ;;1.0;TMG-LIB;**1**;11/21/06
3
4 ;" FDA - NATIONAL DRUG FILES DISPLAY FUNCTIONS
5 ;"Kevin Toppenberg MD
6 ;"GNU General Public License (GPL) applies
7 ;"11-21-2006
8
9 ;"=======================================================================
10 ;" API -- Public Functions.
11 ;"=======================================================================
12 ;"ShowDrug
13 ;"ShowAll
14 ;"CountAll
15 ;"Show1Drug(IEN,Index)
16
17 ;"=======================================================================
18 ;" Private Functions.
19 ;"=======================================================================
20 ;"AskCompile
21 ;"CompByTemplate
22 ;"ShowTemplate
23
24 ;"ShowNDCConflict(Array,IEN2)
25 ;"FormatDrug(Array)
26 ;"Format2Drug(Array)
27 ;"Format3Drug(Array)
28
29
30 ;"=======================================================================
31 ;"=======================================================================
32Menu
33 ;"Purpose: To give an interactive menu
34
35 new Menu,UsrSlct
36 set Menu(0)="Pick Option for Optional Utilities (0B)"
37 set Menu(1)="Show Drugs from FDA Tables"_$char(9)_"ShowAll"
38 set Menu(3)="Show ONE Drug from FDA Tables"_$char(9)_"ShowOne"
39 set Menu(2)="Count Drugs from FDA Tables"_$char(9)_"CountAll"
40 set Menu("P")="Prev Stage"_$char(9)_"Prev"
41 set Menu("N")="Next Stage"_$char(9)_"Next"
42
43CD1
44 write #
45 set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^")
46 if UsrSlct="^" goto CDDone
47 if UsrSlct=0 set UsrSlct=""
48
49 if UsrSlct="Prev" goto Menu^TMGNDF0A ;"quit can occur from there...
50 if UsrSlct="Next" goto Menu^TMGNDF0C ;"quit can occur from there...
51 if UsrSlct="ShowAll" do ShowAll goto CD1
52 if UsrSlct="ShowOne" do ShowDrug goto CD1
53 if UsrSlct="CountAll" do CountAll goto CD1
54 goto CD1
55CDDone
56 quit
57
58 ;"=======================================================================
59
60ShowDrug
61 ;"Purpose: to ask for an IEN, and then show drug
62 ;" i.e. IEN from TMG FDA LISTING
63
64 new IEN,pIndex
65 set pIndex=$$GetpVAPIndex^TMGNDF1A()
66
67loop read "Enter IEN number (^ to quit) ^// ",IEN:$get(DTIME,3600),!
68 if IEN="" set IEN="^"
69 if IEN="^" goto SDDone
70 do Show1Drug(IEN,.Index)
71 goto loop
72
73SDDone
74 quit
75
76
77Show1Drug(IEN,pIndex)
78 ;"Purpose: to show drug from TMG FDA LISTING
79 ;"Input: IEN -- IEN from TMG FDA LISTING file
80 ;" Index -- PASS BY NAME -- OPTIONAL
81 ;" This is an index as returned by IndexVAProd^TMGNDF1A("Index")
82 ;" If not passed, then it will be filled here.
83 ;"Results: none
84
85 new Array,result
86 if $get(pIndex)="" set pIndex=$$GetpVAPIndex^TMGNDF1A()
87
88 set result=$$GetDrugInfo^TMGNDF1A(IEN,.Array,pIndex)
89 if (result=1)&($data(Array)'=0) do
90 . write !,"-----------------------------------------",!
91 . zwr Array(*)
92 quit
93
94
95ShowAll
96 ;"Purpose: to show all drugs
97
98 new count set count=1
99 new Array
100 new temp set temp=" "
101 new result set result=1
102 new Matches
103
104 new pIndex set pIndex=$$GetpVAPIndex^TMGNDF1A()
105
106SADloop
107 kill Array
108
109 ;"2/13/07 note: the call to GetDrugInfo below looks wrong. I have made changes
110 ;" to the location of functions. I think this needs to be reassessed...
111 if $$GetDrugInfo^TMGNDF1A(count,.Array,pIndex) do
112 . new numMatch set numMatch=+$get(Array("FILE 50.68 IEN","COUNT"))
113 . new numPMatch set numPMatch=+$get(Array("FILE 50.68 IEN","POSS MATCH","COUNT"))
114 . set Matches(numMatch,numPMatch)=$get(Matches(numMatch,numPMatch))+1
115 . write count,": "
116 . do Format2Drug(.Array)
117 . quit
118 . write "Type ^ to abort, <SPACE> to pause",!
119 . if +$get(Array("FILE 50.68 IEN","COUNT"))=0 do
120 . . write "No MATCH in VA PRODUCT file",!
121 . else if +$get(Array("FILE 50.68 IEN","COUNT"))>1 do
122 . . write "MULTIPLE matches found in VA PRODUCT file",!
123 . . zwr Array("FILE 50.68 IEN",*)
124 . else if +$get(Array("FILE 50.68 IEN","COUNT"))>1 do
125 . . write "1 match found.",!
126 else set temp="^"
127
128 read temp:0.25
129 if temp=" " do
130 . read "Press <ENTER> to continue (or ^ to abort) ",temp,!
131 set count=count+1
132 if temp="^" goto SD2Done
133
134 goto SADloop
135
136SD2Done
137 write "Here is the cumulative results of couting matches",!
138 write "Matches(Matches,PossMatches)=count",!
139 zwr Matches(*)
140 quit
141
142
143CountAll
144 ;"Purpose: to ask for an IEN, and then show drug
145
146 new count set count=20000
147 new Array
148 new temp set temp=" "
149 new result set result=1
150 new Matches
151 new showCount set showCount=0
152 new MaxIEN set MaxIEN=$piece($get(^TMG(22706.5,0)),"^",3)
153 new abort set abort=0
154
155CADloop
156 for count=1:1:MaxIEN do quit:(abort=1)
157 . kill Array
158 . if $$GetDrugInfo^TMGNDF1A(count,.Array)=1 do
159 . . new numMatch set numMatch=+$get(Array("FILE 50.68 IEN","COUNT"))
160 . . new numPMatch set numPMatch=+$get(Array("FILE 50.68 IEN","POSS MATCH","COUNT"))
161 . . set Matches(numMatch,numPMatch)=$get(Matches(numMatch,numPMatch))+1
162 . . if $get(Array("NDC","NOTE"))'="" do
163 . . . write count,"--> ",Array("NDC","NOTE"),!
164 . . . new badIEN set badIEN=+$piece(Array("NDC","NOTE"),"=",2)
165 . . . do ShowNDCConflict(.Array,badIEN)
166 . . . read temp:0.25
167 . . . if temp=" " do
168 . . . . read "Press <ENTER> to continue (or ^ to abort) ",temp,!
169 . . . . if temp="^" set abort=1
170 . . set showCount=showCount+1
171 . . if showCount=100 do
172 . . . set showCount=0
173 . . . write count,": "
174 . . . do Format2Drug(.Array)
175
176CADDone
177 write "Here is the cumulative results of couting matches",!
178 write "Matches(Matches,PossMatches)=count",!
179 zwr Matches(*)
180 quit
181
182
183
184FormatDrug(Array)
185
186 if '$data(Array) quit
187 new i
188 write $get(Array("TRADENAME")),"; "
189 write $get(Array("STRENGTH")),"; "
190 write $get(Array("UNIT")),"; "
191 set i=$order(Array("DOSE",""))
192 if +i>0 for do quit:(+i'>0)
193 . write $get(Array("DOSE",i,"DOSAGE NAME"))," "
194 . set i=$order(Array("DOSE",i))
195 write !
196 set i=$order(Array("FORMULATION",""))
197 if +i>0 for do quit:(+i'>0)
198 . write " ingredients: ",$get(Array("FORMULATION",i,"INGREDIENT NAME")),"; "
199 . write $get(Array("FORMULATION",i,"STRENGTH")),"; "
200 . write $get(Array("FORMULATION",i,"UNIT")),!
201 . set i=$order(Array("FORMULATION",i))
202
203 quit
204
205Format2Drug(Array)
206
207 new s
208 if '$data(Array) quit
209 new i
210
211 set s="m="_$get(Array("FILE 50.68 IEN","COUNT"),0)_";"
212 set s=s_"lm="_$get(Array("FILE 50.68 IEN","POSS MATCH","COUNT"),0)_" "
213 ;"Array("FILE 50.68 IEN","LOOSE MATCH","COUNT")=1
214 set s=s_$get(Array("TRADENAME"))_" "
215 set s=s_$get(Array("STRENGTH"))_" "
216 set s=s_$get(Array("UNIT"))_" "
217 set i=$order(Array("DOSE",""))
218 if +i>0 for do quit:(+i'>0)
219 . set s=s_$get(Array("DOSE",i,"DOSAGE NAME"))_" "
220 . set i=$order(Array("DOSE",i))
221
222 write $extract(s,1,60),!
223
224
225 if $get(Array("FORMULATION",1,"STRENGTH"))="" do
226 . if $get(Array("STRENGTH"))'="" do
227 . . write "Note: Ingredient #1 strength is empty, but Overall strength="
228 . . write $get(Array("STRENGTH")),!
229
230 quit
231
232
233Format3Drug(Array)
234 ;"Purpose: show match, only if 0 matches and >0 possible matches
235
236 new s
237 if '$data(Array) quit
238 new i
239 if $get(Array("FILE 50.68 IEN","COUNT"),0)'=0 quit
240 if $get(Array("FILE 50.68 IEN","POSS MATCH","COUNT"),0)'>0 quit
241
242 do Format2Drug(.Array)
243
244 set i=$order(Array("FILE 50.68 IEN","POSS MATCH",""))
245 if +i>0 for do quit:(+i'>0)
246 . new Msg set Msg=$get(Array("FILE 50.68 IEN","POSS MATCH",i,"MSG"))
247 . new Problem set Problem=$get(Array("FILE 50.68 IEN","POSS MATCH",i,"PROBLEM"))
248 . new IEN set IEN=$get(Array("FILE 50.68 IEN","POSS MATCH",i))
249 . write IEN,": ",Problem,"(",Msg,")",!
250 . set i=$order(Array("FILE 50.68 IEN","POSS MATCH",i))
251
252 quit
253
254
255ShowNDCConflict(Array,IEN2)
256 ;"Purpose: show two drug entries that have same NDC's, but differing drug properties
257 ;"Input: Array -- PASS BY REFERENECE -- data with DrugIfno (from GetDrugInfo)
258 ;" IEN2: the IEN from file VA PRODUCT (50.68)
259
260
261 write "Here is TMG FDA* data:",!
262 do FormatDrug(.Array)
263 write !
264
265 write "Here is VA Product data:",!
266 new VAArray
267 do GetVADrugInfo^TMGNDF1C(IEN2,.VAArray)
268 do FormatDrug(.VAArray)
269
270 write !!
271 quit
272
273
274AskCompile
275 ;"Purpose: To ask for an Entry number from 22706.5 and add drug to compiled file
276
277 new IEN
278
279 for do quit:(+IEN'=IEN)
280 . read "Type in Entry Number (^ to abort): ",IEN:$get(DTIME,3600),!
281 . if +IEN'=IEN quit
282 . do CompileOne^TMGNDF1C(IEN)
283
284 quit
285
286CompByTemplate
287 ;"Purpose: To ask for a SORT TEMPLATE, and compile the records for IENs stored there.
288
289 new pIndex set pIndex=$$GetpVAPIndex^TMGNDF1A()
290
291 new IEN,Template
292 new DIC,X,Y
293 set DIC=.401
294 set DIC("A")="Enter a SORT TEMPLATE to compile FDA entries from: "
295 set DIC(0)="AEQM"
296 do ^DIC
297 if +Y'>0 goto CBTDone
298 set Template=+Y
299
300 new TMGTOTAL set TMGTOTAL=$$CtTemplate^TMGMISC(Template)
301 new StartTime set StartTime=$H
302 new ProgressFn
303 set ProgressFn="if count#10=1 do ProgressBar^TMGUSRIF(count,""Progress"",0,TMGTOTAL,,StartTime)"
304 set IEN=""
305 new count set count=0
306 for do quit:(+IEN'>0)
307 . set IEN=$$IterTemplate^TMGMISC(Template,IEN)
308 . if +IEN'>0 quit
309 . ;"write IEN,!
310 . do CompileOne^TMGNDF1C(IEN,0,pIndex)
311 . set count=count+1
312 . if $get(ProgressFn)'="" do
313 . . new $etrap set $etrap="w ""??Progress function -- error trapped??"",!"
314 . . xecute ProgressFn
315
316CBTDone
317 quit
318
319
320MkGenAll
321 ;"Purpose: To fill in the GENERIC NAME field for record for all records in file
322 ;"Input: none
323 ;"Output: The file 22706.9 (TMG FDA IMPORT COMPILED) has records added.
324 ;"Result: none
325
326 new IEN set IEN=0
327 new Array,result,temp
328 new Interval set Interval=0
329 new abort set abort=0
330 new TMGTOTAL set TMGTOTAL=$piece($get(^TMG(22706.5,0)),"^",3)
331 new StartTime set StartTime=$H
332 new ProgressFn
333 set ProgressFn="if IEN#10=1 do ProgressBar^TMGUSRIF(IEN,""Progress"",0,TMGTOTAL,,StartTime)"
334
335 for do quit:(IEN'>0)!(abort=1)
336 . set IEN=$order(^TMG(22706.5,IEN))
337 . if +IEN'>0 quit
338 . do FillGenericName^TMGNDF1C(IEN)
339 . if $get(ProgressFn)'="" do
340 . . new $etrap set $etrap="w ""??Progress function -- error trapped??"",!"
341 . . xecute ProgressFn
342
343 quit
344
345
346MkGenByTemplate
347 ;"Purpose: To ask for a SORT TEMPLATE, and fill in the GENERIC NAME field for record
348 ;" -- for all records listed in the template
349 ;"Output: The file 22706.9 (TMG FDA IMPORT COMPILED) has GENERIC NAME firecords added.
350
351 new pIndex set pIndex=$$GetpVAPIndex^TMGNDF1A()
352
353 new IEN,Template
354 new DIC,X,Y
355 set DIC=.401
356 set DIC("A")="Enter a SORT TEMPLATE to compile FDA entries from: "
357 set DIC(0)="AEQM"
358 do ^DIC
359 if +Y'>0 goto MGBTDone
360 set Template=+Y
361
362 new TMGTOTAL set TMGTOTAL=$$CtTemplate^TMGMISC(Template)
363 new StartTime set StartTime=$H
364 new ProgressFn
365 set ProgressFn="if count#10=1 do ProgressBar^TMGUSRIF(count,""Progress"",0,TMGTOTAL,,StartTime)"
366 set IEN=""
367 new count set count=0
368 for do quit:(+IEN'>0)
369 . set IEN=$$IterTemplate^TMGMISC(Template,IEN)
370 . if +IEN'>0 quit
371 . ;"write IEN,!
372 . do FillGenericName^TMGNDF1C(IEN)
373 . set count=count+1
374 . if $get(ProgressFn)'="" do
375 . . new $etrap set $etrap="w ""??Progress function -- error trapped??"",!"
376 . . xecute ProgressFn
377
378MGBTDone
379 quit
380
381
382ShowTemplate
383 ;"Purpose: To ask for a SORT TEMPLATE, and show the records for IENs stored there.
384
385 new IEN,Template
386 new DIC,X,Y
387 set DIC=.401
388 set DIC("A")="Enter a SORT TEMPLATE to compile FDA entries from: "
389 set DIC(0)="AEQM"
390 do ^DIC
391 if +Y'>0 goto STDone
392 set Template=+Y
393
394 set IEN=""
395 new result,Array
396
397 for do quit:(+IEN'>0)
398 . set IEN=$$IterTemplate^TMGMISC(Template,IEN)
399 . if +IEN'>0 quit
400 . write "IEN: ",IEN,!
401 . set result=$$GetDrugInfo^TMGNDF1A(IEN,.Array)
402 . do Format2Drug(.Array)
403
404STDone
405 quit
406
407
408CheckPtrs
409 ;"Purpose: check import files for 0 values for pointers.
410
411 new Info
412 set Info(22706.1,.01)="0;1"
413 set Info(22706.2,.01)="0;1"
414 set Info(22706.2,3)="1;2"
415 set Info(22706.4,.01)="0;1"
416 set Info(22706.5,6)="0;7"
417 set Info(22706.5,8)="0;9"
418 set Info(22706.6,.01)="0;1"
419 set Info(22706.7,.01)="0;1"
420
421 set Info(22706.8,1)="0;2"
422 set Info(22706.8,2)="0;3"
423 set Info(22706.82,1)="0;2"
424 ;"set Info(22703,.01)="0;1" ;"no pointers
425 ;"set Info(22707,.01)="0;1" ;"no pointers
426 ;"set Info(22705,.01)="0;1" ;"ignore this one
427 ;"set Info(22711,.01)="0;1"
428
429 new abort set abort=0
430 new file set file=""
431 for set file=$order(Info(file)) quit:(file="")!abort do
432 . new field set field=""
433 . for set field=$order(Info(file,field)) quit:(field="")!abort do
434 . . new node,pce
435 . . set node=$piece($get(Info(file,field)),";",1)
436 . . set pce=$piece($get(Info(file,field)),";",2)
437 . . if (node="")!(pce="") quit
438 . . new Itr,IEN
439 . . write !,"Scanning file ",file,!
440 . . set IEN=$$ItrInit^TMGITR(file,.Itr)
441 . . do PrepProgress^TMGITR(.Itr,20,0,"IEN")
442 . . if IEN'="" for do quit:(+$$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort
443 . . . if $$UserAborted^TMGUSRIF set abort=1 quit
444 . . . if $piece($get(^TMG(file,IEN,node)),"^",pce)=0 do
445 . . . . write !,file,", IEN: #",IEN," has 0 pointer for the ",field,"field.",!
446
447
448 quit
Note: See TracBrowser for help on using the repository browser.