source: cprs/branches/tmg-cprs/m_files/TMGNDF1A.m@ 872

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

Initial upload

File size: 58.1 KB
Line 
1TMGNDF1A ;TMG/kst/FDA Import: Compile FDA files into import file ;03/25/06
2 ;;1.0;TMG-LIB;**1**;11/21/06
3
4 ;"FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS
5 ;"Kevin Toppenberg MD
6 ;"GNU General Public License (GPL) applies
7 ;"11-21-2006
8
9 ;"=======================================================================
10 ;" API -- Public Functions.
11 ;"=======================================================================
12 ;"Menu
13 ;"=======================================================================
14 ;"Compile -- collect relevent data from the TMG FDA * files and put into one record
15
16 ;"GetpVAPIndex() -- return a pointer to an index of the VAProduct file
17 ;"ReCompOne(IEN22706d9)
18
19 ;"=======================================================================
20 ;" Private Functions.
21 ;"=======================================================================
22 ;"CompileOne(IEN,Quiet,pIndex,ExclArray,OnlyIfNew)
23 ;"$$MakeCompRec(IEN,Array,Quiet)
24 ;"StuffCompRec(IEN,Array,Quiet,ExclArray,Option)
25 ;"FillGenericName(IEN)
26 ;"MakeGenericName(IEN)
27
28 ;"GetVADrugInfo(IEN,Array)
29 ;"$$GetDrugInfo(IEN,Array,pIndex,noLink)
30
31 ;"GetSingleRec(File,GRef,IEN,Array)
32 ;"GetMultRec(File,GRef,IEN,Array)
33 ;"LinkToVAProd(Array,Results)
34 ;"Link2VAProd(Array,Results,pIndex)
35 ;"CheckLink(IEN,Array,Results)
36 ;"CheckNDCLink(IEN,Array,Results)
37 ;"IndexVAProd(pArray)
38 ;"GetIndexList(Ingredient,pIndex,pArray)
39
40 ;"FixGenerics
41 ;"ScanFor(Name,Array)
42 ;"FindSimNames(Name,Array)
43
44 ;"=======================================================================
45 ;"=======================================================================
46Menu
47 ;"Purpose: To give an interactive menu
48
49 new Menu,UsrSlct
50 set Menu(0)="Pick Option for Compiling FDA Imported Data (1A)"
51 set Menu(1)="Compile/Refresh ALL FDA data into IMPORT file"_$char(9)_"CompileAll"
52 set Menu(2)="Compile/Refresh JUST NEW FDA data into IMPORT file"_$char(9)_"CompileNew"
53 set Menu(3)="Compile/Refresh ONE chosen FDA entry into IMPORT file"_$char(9)_"CompileChosen"
54 set Menu(4)="Read instructions"_$char(9)_"Instructions"
55 set Menu("P")="Prev Stage"_$char(9)_"Prev"
56 set Menu("N")="Next Stage"_$char(9)_"Next"
57
58CD1
59 write #
60 set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^")
61 if UsrSlct="^" goto CDDone
62 if UsrSlct=0 set UsrSlct=""
63
64 if UsrSlct="Prev" goto Menu^TMGNDF0C ;"quit can occur from there...
65 if UsrSlct="Next" goto Menu^TMGNDF1D ;"quit can occur from there...
66 if UsrSlct="CompileAll" do Compile(0) goto CD1
67 if UsrSlct="CompileNew" do Compile(2) goto CD1
68 if UsrSlct="CompileChosen" do Compile(1) goto CD1
69 if UsrSlct="Instructions" do Instructions goto CD1
70 goto CDDone
71CDDone
72 quit
73
74 ;"=======================================================================
75Instructions
76 ;"Purpose: show instructions.
77
78 write !,!
79 write "COMPILATION",!
80 write "===========",!
81 write "The process of compilation takes the various FDA import",!
82 write "tables and compiles them into a format ready for integration",!
83 write "into VistA. The compiled records will be stored in the custom",!
84 write "file TMG FDA IMPORT COMPILED (22706.9).",!,!
85 write "In a subsequent step, you will be asked about excluding certain",!
86 write "drugs from import into VistA. Your choices will be stored in these",!
87 write "compiled records. The point being that overwriting file 22706.9",!
88 write "would lead to a substantial amount of work. Thus the code is",!
89 write "designed to integrate the new download data with prior data.",!
90 write "If prior data is found then the user will be prompted: ",!
91 write "'Import ONLY NEW drugs?' It is recommended that this be answered",!
92 write "with 'YES'.",!
93 write !
94 do PressToCont^TMGUSRIF
95 quit
96
97Compile(Option)
98 ;"Purpose: To collect relevent data from the TMG FDA * files and put into one record
99 ;"Input: Option: OPTIONAL. Default=0.
100 ;" if 0, all records are added
101 ;" If 1, then only ONE record (user chosed) will be compiled.
102 ;" If 2, then only records that are NEW will
103 ;" be added. Existing records in 22706.9 will not be affected
104 ;" If 3, then only record(s) supplied will be compiled.
105 ;" Option(IEN)=""
106 ;" Option(IEN)=""
107 ;" If Option("FIX CHAIN")=1 <--- changes will be propigate forward
108 ;" to file 50, POI, OI, OQV etc.
109 ;"Output: The file 22706.9 (TMG FDA IMPORT COMPILED) has records added.
110 ;"Result: none
111
112 new pIndex set pIndex=$$GetpVAPIndex()
113
114 new abort set abort=0
115 set Option=+$get(Option)
116 set OnlyIfNew=(Option=2)
117 new CompOption set CompOption=OnlyIfNew
118 merge CompOption("FIX CHAIN")=Option("FIX CHAIN")
119
120 new % set %=1
121 new ExclArray
122 if $data(^TMG(22706.9,"VAP1"))>0 do ;"a test for a prior run
123 . if (Option=1)!(Option=2)!(Option=3) quit
124 . write "Prior import processing detected.",!
125 . if Option=0 write "Import ONLY NEW drugs ('YES' Recommended)" do YN^DICN write !
126 . if %=-1 quit
127 . if %=1 set OnlyIfNew=1 quit
128 . write "Choose fields in import file to NOT to OVER WRITE" do YN^DICN write !
129 . if %=1 do GetExclFields(.ExclArray)
130 if %=-1 goto CADone
131
132 write "Compiling FDA data into a unified file, for later import.",!
133 new Itr,IEN
134 if Option=1 do
135 . new X,Y,DIC
136 . set DIC=22706.5,DIC(0)="MAEQ"
137 . set DIC("A")="Select FDA drug for import: "
138 . do ^DIC write !
139 . if +Y'>-1 quit
140 . do CompileOne(+Y,0,pIndex,.ExclArray,.CompOption)
141 . new killthis
142
143 if Option=3 do
144 . set IEN=""
145 . for set IEN=$order(Option(IEN)) quit:(IEN="")!abort do
146 . . if $$UserAborted^TMGUSRIF set abort=1 quit
147 . . do CompileOne(IEN,0,pIndex,.ExclArray,.CompOption)
148 . . new killthis
149
150 else do
151 . set IEN=$$ItrInit^TMGITR(22706.5,.Itr)
152 . do PrepProgress^TMGITR(.Itr,20,0,"IEN")
153 . if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!(abort=1)
154 . . if $$UserAborted^TMGUSRIF set abort=1 quit
155 . . do CompileOne(IEN,0,pIndex,.ExclArray,.CompOption)
156 . . new killthis
157CADone
158 write !,"Done.",!
159 do PressToCont^TMGUSRIF
160 quit
161
162
163ReCompOne(IEN22706d9,Option)
164 ;"Purpose: To recompile a given record in file 22706.9
165 ;"Input: IEN -- IEN from 22706.9
166 ;" OPTION -- Optional. Option("FIX CHAIN")=1 <--- changes will be propigate forward
167 ;" to file DRUG, POI, OI, OQV etc.
168 ;"Results: none
169
170 new fdaIEN
171 set fdaIEN=+$piece($get(^TMG(22706.9,IEN22706d9,0)),"^",1)
172 new pIndex set pIndex=$$GetpVAPIndex()
173 set Option=2 ;"2-> ask for overwrites.
174 do CompileOne(fdaIEN,0,pIndex,,.Option)
175
176 quit
177
178
179CompileOne(IEN,Quiet,pIndex,ExclArray,Option)
180 ;"Purpose: To collect relevent data from the TMG FDA * files, or one entry, and put into one record
181 ;"Input: IEN -- the IEN from file 22706.5 (TMG FDA LISTING) that should be added.
182 ;" Quiet: OPTIONAL (default=1), if 0, then Fileman error messages are displayed.
183 ;" pIndex -- OPTIONAL -- the NAME OF index (as created by IndexVAProd), for faster processing
184 ;" ExclArray --OPTIONAL -- an array with fields to NOT OVERWRITE preexisting fields in. Format:
185 ;" ExclArray(FieldNum)=FieldName <-- data in 22706.9, FieldNum will not be overwritten.
186 ;" ExclArray(FieldNum)=FieldName <-- data in 22706.9, FieldNum will not be overwritten.
187 ;" Option : OPTIONAL. Default=0. PASS BY REFERECE *if* SUBNODES DEFINED
188 ;" 1 -> only records that are NEW will be added. Existing records in 22706.9 will not be affected
189 ;" 2 -> User is prompted for overwrites
190 ;" Option("FIX CHAIN")=1 <--- changes will be propigate forward
191 ;" to file 50, POI, OI, OQV etc.
192 ;"Output: The file 22706.9 (TMG FDA IMPORT COMPILED) may have data/records added.
193 ;"Result: none
194
195 new Array,result
196 set Quiet=$get(Quiet,1)
197 new destIEN
198 set Option=+$get(Option)
199 new OnlyIfNew set OnlyIfNew=(Option=1)
200 new stuffOption set stuffOption=""
201 if Option=2 set stuffOption("ASK OVERWRITE")=1
202
203 if +$get(IEN)'>0 goto C1Done
204 if $$GetDrugInfo(IEN,.Array,.pIndex)=0 goto C1Done ;"returns 0 for error
205 set destIEN=$$FindPriorRec(.Array)
206 if (destIEN>0)&(OnlyIfNew=1) goto C1Done ;"Skip preexisting, don't update, per flag
207 if destIEN'>0 set destIEN=$$MakeCompRec(IEN,.Array,Quiet)
208 if destIEN'>0 goto C1Done
209 if $$StuffCompRec(destIEN,.Array,.Quiet,.ExclArray,.stuffOption)=1 goto C1Done ;"returns 1 for error
210 do FillGenericName(destIEN)
211
212 ;"Set link between COMPILED field in 22706.5 and record in 22706.9
213 new TMGFDA,TMGMSG,PriorErrorFound
214 set TMGFDA(22706.5,IEN_",",8)=destIEN
215 do FILE^DIE("S","TMGFDA","TMGMSG")
216 do ShowIfDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
217
218 if $get(Option("FIX CHAIN"))=1 do
219 . do Fix1Name^TMGNDF1D(IEN)
220 . ;"consider if checking for 1 new ROUTE is need in TMGNDF1F
221 . ;"consider if checking for 1 new FORM is need in TMGNDF2A
222 . do Make1Alt^TMGNDF2G(IEN)
223 . do Check1^TMGNDF2H(IEN)
224 . do Refresh1^TMGNDF3C(IEN,.Option) ;"further chaining to occur from this fn.
225 .;"NOTE: I also need to go through modules and add code to handle DELETIONS
226 . ;" (esp DRUG-->POI etc.)
227
228C1Done
229 quit
230
231
232FindPriorRec(Array)
233 ;"Purpose: To find an entry in file 22706.9 (TMG FDA IMPORT COMPILED) that
234 ;" matches data in Array, meaning that the data has been previously
235 ;" added.
236 ;" Match criteria:
237 ;"Input: Array: PASS BY REEFRENCE. The drug info array, as created by GetDrugInfo()
238 ;"Result: Returns the IEN from 22706.9, or 0 if no prior match found.
239
240 new result set result=0
241 new NDC12 set NDC12=$get(Array("NDC","12DIGIT"))
242 if NDC12>0 set result=$order(^TMG(22706.9,"NDC12",NDC12,""))
243
244 quit result
245
246
247MakeCompRec(IEN,Array,Quiet)
248 ;"Purpose: To create one entry in file 22706.9 (TMG FDA IMPORT COMPILED)
249 ;" entry will be essentially empty, to be filled later by StuffCompRec
250 ;" Array: PASS BY REFERENCE. The drug info array, as created by GetDrugInfo()
251 ;" Quiet: OPTIONAL (default=1), if 0, then Fileman error messages are displayed.
252 ;"Input: IEN
253 ;" Array
254 ;" Quiet
255 ;"Output: The file 22706.9 (TMG FDA IMPORT COMPILED) has one records added or modified.
256 ;"Result: IEN of new record, or 0 if error
257 ;"Note: any pre-existing data is removed from record.
258
259 new TMGFDA,IENS,TMGIEN,TMGMSG
260 new result set result=0 ;"default to failure
261 if +$get(IEN)'>0 goto MCRD
262 set Quiet=$get(Quiet,1)
263 set IENS="+1,"
264 set TMGFDA(22706.9,IENS,.01)=IEN
265 do UPDATE^DIE("S","TMGFDA","TMGIEN","TMGMSG") ;"create new record
266 if $data(TMGMSG) do
267 . if Quiet=1 quit
268 . new PriorErrorFound
269 . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
270 else set result=+$get(TMGIEN(1))
271MCRD quit result
272
273
274GetExclFields(ExclArray)
275 ;"Purpose: to determine if there are fields that should not be overwritten
276 ;" during stuffing of records
277 ;"Input: ExclArray -- PASS BY REFERENCE, AN OUT PARAMETER. FORMAT:
278 ;" ExclArray(FieldNum)=FieldName
279 ;" Any preexisting entries will be KILLED
280
281 kill ExclArray
282
283 new DIC,X,Y
284 set DIC="^DD(22706.9,"
285 set DIC(0)="AEQM"
286 set DIC("S")="IF (Y=.05)!(Y=.05)!(Y=1)!(Y=2)!(Y=3)!(Y=3.4)!(Y=4)!(Y=5)!(Y=7)"
287 set DIC("A")="Pick field to NOT OVERWRITE (^ when done): "
288GEF1 do ^DIC
289 if Y=-1 goto GEF2
290 set ExclArray(+Y)=$piece(Y,"^",2)
291 goto GEF1
292GEF2
293 if $data(ExclArray)=0 goto GEFDone
294 write !!,"Will NOT OVERWRITE any preexisting data in these fields:",!
295 new i set i=""
296 for set i=$order(ExclArray(i)) quit:(i="") do
297 . write " ",ExclArray(i)," (",i,")",!
298 new % set %=1
299 write "OK" do YN^DICN write !
300 if %=1 goto GEFDone
301 kill ExclArray
302 set %=2
303 write "Pick again" do YN^DICN write !
304 if %=1 goto GEF1
305
306GEFDone
307 quit
308
309
310StuffCompRec(IEN,Array,Quiet,ExclArray,Option)
311 ;"Purpose: To fill in data for one entry in file 22706.9 (TMG FDA IMPORT COMPILED)
312 ;"Input: IEN: The IEN of the new record for data to be stuffed into (i.e. IEN22706d9)
313 ;" Array: PASS BY REFERENCE. The drug info array, as created by GetDrugInfo()
314 ;" Quiet: OPTIONAL (default=1), if 0, then Fileman error messages are displayed.
315 ;" ExclArray --OPTIONAL -- an array with fields to NOT OVERWRITE preexisting fields in. Format:
316 ;" ExclArray(FieldNum)=FieldName <-- data in 22706.9, FieldNum will not be overwritten.
317 ;" Option -- OPTIONAL. PASS BY REFERENCE
318 ;" Option("ASK OVERWRITE")=1 --> ask user if overwrites are OK.
319 ;" Option("FIX CHAIN")=1 <--- changes will be propigate forward
320 ;" to file 50, POI, OI, OQV etc.
321 ;"Output: The file 22706.9 (TMG FDA IMPORT COMPILED) has one records added or modified.
322 ;"Result: 0=OK, 1=fatal error encountered
323 ;"Note: any pre-existing data is removed from record. (<--??)
324
325 new TMGFDA,IENS,TMGIEN,TMGMSG,newIENS
326 new result set result=0
327 new dataAdded set dataAdded=0
328 new askOverwrite set askOverwrite=($get(Option("ASK OVERWRITE"))=1)
329
330 set Quiet=$get(Quiet,1)
331 new map
332 set map(.05)=$name(tradeName)
333 set map(1)=$name(Array("STRENGTH"))
334 set map(2)=$name(Array("UNIT"))
335 set map(3)=$name(Array("ROUTE",1,"NAME"))
336 set map(3.4)=$name(Array("DOSE",1,"DOSAGE NAME"))
337 set map(4)=$name(Array("NDC"))
338 set map(5)=$name(Array("NDC","12DIGIT"))
339 set map(7)=$name(codeOTC)
340
341 new codeOTC set codeOTC=$get(Array("RX OR OTC"))
342 if codeOTC["PRESCRIPTION" set codeOTC="R"
343 else if codeOTC["OTC" set codeOTC="O"
344 else set codeOTC=""
345
346 new tradeName set tradeName=$get(Array("TRADENAME"))
347 if $length(tradeName)>64 set tradeName=$extract(tradeName,1,61)_"..."
348
349 set IENS=IEN_","
350
351 new oldData
352 new field set field=""
353 for set field=$order(map(field)) quit:(field="") do
354 . new pVar,value
355 . set pVar=$get(map(field))
356 . set value=$get(@pVar)
357 . if value="" quit
358 . set oldData(field)=$$GET1^DIQ(22706.9,IENS,field)
359 . if ($data(ExclArray(field))'=0)&(oldData(field)'="") quit
360 . set TMGFDA(22706.9,IENS,field)=value
361
362 new untrimFDA merge untrimFDA=TMGFDA
363 set newIENS=$$TrimFDA^TMGDBAPI(.TMGFDA) ;"remove entries for data already present.
364 if $data(TMGFDA)=0 goto SCR1
365
366 new abort set abort=0
367 if askOverwrite do
368 . new field set field=""
369 . for set field=$order(TMGFDA(22706.9,IENS,field)) quit:(field="") do
370 . . write field,": '",$get(oldData(field)),"' --> '",$get(TMGFDA(22706.9,IENS,field)),"'",!
371 . write !,"Stuff this data into file 22706.9, record #",IEN,"? "
372 . new % set %=2 do YN^DICN write !
373 . if %=1 quit
374 . set abort=1
375 if abort=1 goto MCRDone
376
377 do FILE^DIE("ES","TMGFDA","TMGMSG") ;" Fill existing record
378 if $data(TMGMSG) do goto MCRDone
379 . if Quiet=1 quit
380 . new PriorErrorFound
381 . write !,"StuffCompRec^TMGNDF1A",!
382 . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
383 . set result=1
384 else set dataAdded=1
385
386 if $get(Option("FIX CHAIN"))=1 do
387 . new opt
388 . set opt("FIX CHAIN")=1
389 . set opt("FIX CHAIN","IEN22706d9")=IEN ;"used later in chain
390 . ;"pass signal to fix chain forward
391 . do Refresh1^TMGNDF3C(IEN,.opt) ;" no results
392
393SCR1
394 new i,MaxCount,subfile
395 kill TMGFDA,TMGIEN
396 set MaxCount=$get(Array("FILE 50.68 IEN","COUNT"))
397 set subfile=22706.914
398 for i=1:1:MaxCount do quit:(abort=1)
399 . set IENS="+"_i_","_IEN_","
400 . new addIEN set addIEN=$get(Array("FILE 50.68 IEN",i))
401 . if addIEN="" quit ;"This occasionally happens...
402 . set TMGFDA(subfile,IENS,.01)=addIEN
403 . ;"------
404 . set newIENS=$$TrimFDA^TMGDBAPI(.TMGFDA) ;"remove entries for data already present.
405 . if $data(TMGFDA)'>0 quit
406 . if askOverwrite do quit:(abort=1)
407 . . new field set field=""
408 . . for set field=$order(TMGFDA(subfile,IENS,field)) quit:(field="") do
409 . . . write field,": ",$$GET1^DIQ(subfile,IENS,field)," --> ",$get(TMGFDA(subfile,IENS,field)),!
410 . . write !,"Stuff this data into subfile ",subfile,", record #",IENS,"? "
411 . . new % set %=2 do YN^DICN write !
412 . . if %=1 quit
413 . . set abort=1
414 . if newIENS["+" do
415 . . do UPDATE^DIE("S","TMGFDA","TMGIEN","TMGMSG")
416 . else do
417 . . new tempFDA merge tempFDA(subfile,newIENS)=TMGFDA(subfile,IENS)
418 . . kill TMGFDA merge TMGFDA=tempFDA
419 . . do FILE^DIE("KS","TMGFDA","TMGMSG")
420 . if $data(TMGMSG) do
421 . . if Quiet=1 quit
422 . . new PriorErrorFound
423 . . write !,"SCR1^StuffCompRec^TMGNDF1A",!
424 . . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
425 . else set dataAdded=1
426 if abort=1 goto MCRDone
427
428SCR2
429 kill TMGFDA,TMGIEN
430 set MaxCount=$get(Array("FILE 50.68 IEN","POSS MATCH","COUNT"))
431 set subfile=22706.915
432 for i=1:1:MaxCount do quit:(abort=1)
433 . set IENS="+"_i_","_IEN_","
434 . new addIEN set addIEN=$get(Array("FILE 50.68 IEN","POSS MATCH",i))
435 . if addIEN="" quit ;"This occasionally happens...
436 . set TMGFDA(subfile,IENS,.01)=addIEN
437 . set newIENS=$$TrimFDA^TMGDBAPI(.TMGFDA) ;"remove entries for data already present.
438 . if $data(TMGFDA)'>0 quit
439 . if askOverwrite do quit:(abort=1)
440 . . new field set field=""
441 . . for set field=$order(TMGFDA(subfile,IENS,field)) quit:(field="") do
442 . . . write field,": '",$$GET1^DIQ(subfile,IENS,field),"' --> ",$get(TMGFDA(subfile,IENS,field)),!
443 . . write !,"Stuff this data into subfile ",subfile,", record #",IENS,"? "
444 . . new % set %=2 do YN^DICN write !
445 . . if %=1 quit
446 . . set abort=1
447 . if newIENS["+" do
448 . . do UPDATE^DIE("S","TMGFDA","TMGIEN","TMGMSG")
449 . else do
450 . . new tempFDA merge tempFDA(subfile,newIENS)=TMGFDA(subfile,IENS)
451 . . kill TMGFDA merge TMGFDA=tempFDA
452 . . do FILE^DIE("SK","TMGFDA","TMGMSG")
453 . if $data(TMGMSG) do
454 . . if Quiet=1 quit
455 . . new PriorErrorFound
456 . . write !,"SCR1^StuffCompRec^TMGNDF1A",!
457 . . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
458 . else set dataAdded=1
459 if abort=1 goto MCRDone
460
461SCR3
462 kill TMGFDA,TMGIEN
463 set MaxCount=$get(Array("FORMULATION","COUNT"))
464 set subfile=22706.916
465 for i=1:1:MaxCount do
466 . set IENS="+"_i_","_IEN_","
467 . set TMGFDA(subfile,IENS,.01)=i
468 . set TMGFDA(subfile,IENS,2)=$get(Array("FORMULATION",i,"INGREDIENT NAME","FILE 50.416 IEN"))
469 . set TMGFDA(subfile,IENS,3)=$get(Array("FORMULATION",i,"STRENGTH"))
470 . set TMGFDA(subfile,IENS,5)=$get(Array("FORMULATION",i,"UNIT","FILE 50.607 IEN")) ;"should be a ptr
471 . ;"set TMGFDA(subfile,IENS,5)=$get(Array("FORMULATION",2,"UNIT")) ;"should be a ptr
472 . ;"----------------------
473 . set newIENS=$$TrimFDA^TMGDBAPI(.TMGFDA) ;"remove entries for data already present.
474 . if $data(TMGFDA)=0 quit
475 . if askOverwrite do quit:(abort=1)
476 . . new field set field=""
477 . . for set field=$order(TMGFDA(subfile,IENS,field)) quit:(field="") do
478 . . . write field,": '",$$GET1^DIQ(subfile,IENS,field),"' --> ",$get(TMGFDA(subfile,IENS,field)),!
479 . . write !,"Stuff this data into subfile ",subfile,", record #",IENS,"? "
480 . . new % set %=2 do YN^DICN write !
481 . . if %=1 quit
482 . . set abort=1
483 . if newIENS["+" do
484 . . do UPDATE^DIE("S","TMGFDA","TMGIEN","TMGMSG")
485 . else do
486 . . new tempFDA merge tempFDA(subfile,newIENS)=TMGFDA(subfile,IENS)
487 . . kill TMGFDA merge TMGFDA=tempFDA
488 . . do FILE^DIE("SK","TMGFDA","TMGMSG")
489 . if $data(TMGMSG) do
490 . . if Quiet=1 quit
491 . . new PriorErrorFound
492 . . write !,"SCR3^StuffCompRec^TMGNDF1A",!
493 . . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
494 . else set dataAdded=1
495 if abort=1 goto MCRDone
496
497SCR4
498 ;"Add a comment
499 if dataAdded=0 goto MCRDone
500 kill TMGFDA
501 new %DT,X,Y
502 set %DT="T",X="NOW" do ^%DT ;"get current time
503 set IENS="+1,"_IEN_","
504 set TMGFDA(22706.9001,IENS,.01)="UPDATE VIA AUTOMATIC IMPORT COMPILE"
505 set TMGFDA(22706.9001,IENS,1)=Y
506 do UPDATE^DIE("S","TMGFDA","TMGIEN","TMGMSG")
507 if $data(TMGMSG) do
508 . if Quiet=1 quit
509 . new PriorErrorFound
510 . write !,"SCR4^StuffCompRec^TMGNDF1A",!
511 . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
512
513MCRDone
514 if abort=1 set result=1
515 quit result
516
517
518FillGenericName(IEN)
519 ;"Purpose: To create an entry for the GENERIC NAME (field .07) in TMG FDA IMPORT (22706.9)
520 ;"Input: IEN -- the IEN in 22706.9 to alter
521 ;"Output: the record specified by IEN will be altered (if ingredients are known)
522 ;"Result: None
523
524 new name
525 set name=$$MakeGenericName(IEN)
526 if $data(^TMG(22706.9,IEN,0))>0 do
527 . new TMGFDA,TMGMSG
528 . set TMGFDA(22706.9,IEN_",",.07)=name
529 . do FILE^DIE("SK","TMGFDA","TMGMSG")
530 . if $data(TMGMSG) do
531 . . if Quiet=1 quit
532 . . new PriorErrorFound
533 . . write !,"FillGenericName^TMGNDF1A",!
534 . . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
535 . ;"set $piece(^TMG(22706.9,IEN,0),"^",6)=name ;"There is no index on this field, so direct write OK
536 quit
537
538
539MakeGenericName(IEN)
540 ;"Purpose: To create a GENERIC NAME string
541 ;"Input: IEN -- the IEN in 22706.9 to use
542 ;"Result: returns a string for the generic name.
543
544 new Ingredients
545 new i
546 new result set result=""
547
548 set i=$order(^TMG(22706.9,IEN,4,0))
549 if i'="" for do quit:(+i'>0)
550 . new IgdIEN,IgdName
551 . set IgdIEN=+$piece($get(^TMG(22706.9,IEN,4,i,0)),"^",3) ;"get field#2, INGREDIENT (ptr to 50.416)
552 . if IgdIEN>0 do
553 . . set IgdName=$$GET1^DIQ(50.416,IgdIEN,.01)
554 . . set IgdName=$$Substitute^TMGSTUTL(IgdName,"HYDROCHLORIDE","") ;"This is what the VA does...
555 . . new temp set temp=IgdName
556 . . set IgdName=$piece(IgdName,",",1) ;"I will also trim off anything after a comma.
557 . . if $length(IgdName)<5 set IgdName=temp ;"I had problem with: N,N-1 ACETYL.... --> 'N'
558 . . set IgdName=$translate(IgdName,"/","\") ;convert '/' --> '\' ('/' used later to concate ingredients)
559 . . set IgdName=$$Trim^TMGSTUTL(IgdName)
560 . . if IgdName'="" set Ingredients(IgdName)="" ;"will sort alphabetically
561 . set i=$order(^TMG(22706.9,IEN,4,i))
562
563 set i=$order(Ingredients(""))
564 if i'="" for do quit:(i="")
565 . if result'="" set result=result_"/"
566 . set result=result_i
567 . set i=$order(Ingredients(i))
568
569 set result=$extract(result,1,64)
570
571 quit result
572
573
574GetVADrugInfo(IEN,Array)
575 ;"Purpose: To collect info from VA Product file into an array similar (but limited) to
576 ;" that returned from GetDrugInfo
577 ;"Input: IEN -- the IEN from file 50.68 (VA PRODUCT)
578
579 kill Array
580 new DIC,X,Y
581
582 set Array("TRADENAME")=$$GET1^DIQ(50.68,IEN,.01)
583 set Array("STRENGTH")=$$GET1^DIQ(50.68,IEN,2)
584 set Array("UNIT")=$$GET1^DIQ(50.68,IEN,3)
585
586 set DIC=50.67
587 set DIC(0)="M"
588 set X=Array("TRADENAME")
589 do ^DIC
590 set Array("NDC")=$$GET1^DIQ(50.67,+Y_",",1)
591 ;"set Array("NDC 12DIGIT")=ndc (see format below)
592
593 new i,count
594 set count=0
595 set i=$order(^PSNDF(50.68,IEN,2,0))
596 if +i>0 for do quit:(+i'>0)
597 . new node set node=$get(^PSNDF(50.68,IEN,2,i,0))
598 . set count=count+1
599 . set Array("FORMULATION","COUNT")=count
600 . set Array("FORMULATION",count,"INGREDIENT NAME","FILE 50.416 IEN")=$piece(node,"^",1)
601 . set Array("FORMULATION",count,"INGREDIENT NAME")=$$GET1^DIQ(50.416,$piece(node,"^",1),.01)
602 . set Array("FORMULATION",count,"STRENGTH")=$piece(node,"^",2)
603 . set Array("FORMULATION",count,"UNIT","FILE 50.607 IEN")=$piece(node,"^",3)
604 . set Array("FORMULATION",count,"UNIT")=$$GET1^DIQ(50.607,$piece(node,"^",3),.01)
605 . set i=$order(^PSNDF(50.68,IEN,2,i))
606
607 quit
608
609GetDrugInfo(IEN,Array,pIndex,noLink)
610 ;"Purpose: To collect all info about a drug into one array
611 ;"Input: IEN -- the IEN from TMG FDA LISTING file
612 ;" Array -- an OUT parameter. See format below
613 ;" pIndex -- OPTIONAL -- the NAME OF index (as created by IndexVAProd), for faster processing
614 ;" noLink -- OPTIONAL -- default=0. If 1, then linkage to prior VA drugs is NOT attempted.
615 ;"Output: Array will be filled with info as above
616 ;" Array('FILE 50.68 IEN',1)=IEN
617 ;" Array('FILE 50.68 IEN','COUNT')
618 ;" Array('LABEL CODE')
619 ;" Array('PRODUCT CODE')
620 ;" Array('STRENGTH')
621 ;" Array('UNIT')
622 ;" Array('RX OR OTC')
623 ;" Array('FIRM','NAME')
624 ;" Array('FIRM','LABEL CODE')
625 ;" Array('FIRM','ADDRESS HEADER')
626 ;" Array('FIRM','STREET')
627 ;" Array('FIRM','PO BOX')
628 ;" Array('FIRM','FOREIGN ADDRESS')
629 ;" Array('FIRM','CITY')
630 ;" Array('FIRM','STATE')
631 ;" Array('FIRM','ZIP')
632 ;" Array('FIRM','PROVINCE')
633 ;" Array('FIRM','COUNTRY')
634 ;" Array('TRADENAME')
635 ;" Array('PACKAGE',1,'CODE')
636 ;" Array('PACKAGE',1,'SIZE')
637 ;" Array('PACKAGE',1,'TYPE')
638 ;" Array('FORMULATION','COUNT')=1
639 ;" Array('FORMULATION',1,'STRENGTH')
640 ;" Array('FORMULATION',1,'UNIT')
641 ;" Array('FORMULATION',1,'UNIT','FILE 50.607 IEN') ;note may contain -1 if match not found
642 ;" Array('FORMULATION',1,'INGREDIENT NAME')
643 ;" Array('FORMULATION',1,'INGREDIENT NAME','FILE 50.416 IEN) ;note may contain -1 if match not found
644 ;" Array('APPLICATION')
645 ;" Array('PRODUCT NUMBER')
646 ;" Array('ROUTE',1,'CODE'
647 ;" Array('ROUTE',1,'NAME')
648 ;" Array('DOSE',1,'DOSE FORM')
649 ;" Array('DOSE',1,'DO SAGE NAME')
650 ;" Array('NDC')=ndc (see format below)
651 ;" Array('NDC','12DIGIT')=ndc (see format below)
652 ;" Array('FILE 50.68 IEN','COUNT')=1
653 ;" Array('FILE 50.68 IEN',1)=1234
654 ;" Array('FILE 50.68 IEN','POSS MATCH','COUNT')=1
655 ;" Array('FILE 50.68 IEN','POSS MATCH',1)=2345
656 ;"result: 0 if error found, 1 otherwise (i.e. is OKToContinue)
657
658 ;"Note the NDC (national drug code) is comprised as follows:
659 ;"It is a 10 digit number comprised of three segments
660 ;" 1st 4-5 digits - producer/packager <--> field#1 (LABEL CODE) in TMG FDA LISTING
661 ;" next 3-4 digits -- the product code <--> field#2 (PRODUCT CODE) in TMG FDA LISTING
662 ;" next 1-2 digits -- package code, specifying the package size <--> field#1 (CODE) in TMG FDA PACKAGES
663 ;" the grouping will be: 4-4-2, or 5-3-2, or 5-4-1
664
665 ;" Example Array("NDC")="000002-0351-02"
666 ;" Example Array("NDC","12DIGIT")="000002035102"
667
668 new TMGARRAY,TMGMSG
669 new PriorErrorFound,i
670 new IENS set IENS=IEN_","
671 kill Array
672 new result set result=1
673
674 do GETS^DIQ(22706.5,IENS,"*","R","TMGARRAY","TMGMSG")
675
676 if $data(TMGMSG) do
677 . if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("TMGMSG")
678 . if $data(TMGMSG("DIERR"))'=0 do quit
679 . . ;"do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
680 . . set result=0
681
682 if result=0 goto GDIDone
683
684 merge Array=TMGARRAY(22706.5,IENS)
685
686 ;"Now look for entries in TMG FDA APPLICATION (22706.1)
687 do GetSingleRec(22706.1,"^TMG(22706.1,""B"",",IEN,.Array)
688 set Array("STRENGTH")=$translate(Array("STRENGTH"),",","") ;"remove ',''s from numbers
689
690 ;"Now look for entries in TMG FDA DOSAGE FORM (22706.2)
691 do GetMultRec(22706.2,"^TMG(22706.2,""B"",",IEN,.Array,"DOSE")
692
693 ;"Now look for entries in TMG FDA FIRMS (22706.3)
694 do GetSingleRec(22706.3,"^TMG(22706.3,""B"",",IEN,.Array)
695
696 ;"Now look for entries in TMG FDA FORMULATION (22706.4)
697 do
698 . new tempArray,index
699 . do GetMultRec(22706.4,"^TMG(22706.4,""B"",",IEN,.tempArray,"FORMULATION")
700 . ;"Note: I need instead to screen for duplicates ingredient entries
701 . set index=$order(tempArray("FORMULATION",""))
702 . if +index>0 for do quit:(+index'>0)
703 . . new i2 set i2=index+1
704 . . new name1,name2
705 . . set name1=$name(tempArray("FORMULATION",index))
706 . . for do quit:(+i2'>0)
707 . . . set name2=$name(tempArray("FORMULATION",i2))
708 . . . set i2=$order(tempArray("FORMULATION",i2))
709 . . . if $data(@name2)'>0 quit
710 . . . if $$CompArray^TMGMISC(name1,name2) do
711 . . . . kill @name2
712 . . set index=$order(tempArray("FORMULATION",index))
713 . ;"Now put cleaned results of tempArray into Array
714 . set index=$order(tempArray("FORMULATION",""))
715 . new count set count=0
716 . set Array("FORMULATION","COUNT")=0
717 . if +index>0 for do quit:(+index'>0)
718 . . if $data(tempArray("FORMULATION",index)) do
719 . . . set count=count+1
720 . . . merge Array("FORMULATION",count)=tempArray("FORMULATION",index)
721 . . . set Array("FORMULATION","COUNT")=count
722 . . set index=$order(tempArray("FORMULATION",index))
723
724 ;"Now look for entries in TMG FDA PACKAGES (22706.6)
725 do GetMultRec(22706.6,"^TMG(22706.6,""B"",",IEN,.Array,"PACKAGE")
726
727 ;"Now look for entries in TMG FDA ROUTES (22706.7)
728 do GetMultRec(22706.7,"^TMG(22706.7,""B"",",IEN,.Array,"ROUTE")
729 if $length($get(Array("ROUTE",1,"NAME")))>16 do
730 . new temp set temp=$$PShortName^TMGSHORT(Array("ROUTE",1,"NAME"),16,1)
731 . if temp="^" quit
732 . set Array("ROUTE",1,"NAME")=temp
733
734 if $get(Array("FORMULATION","COUNT"),1)=1 do
735 . new strength,str2
736 . new units,units2
737 . set strength=Array("STRENGTH")
738 . set str2=$get(Array("FORMULATION",1,"STRENGTH"))
739 . set units=$get(Array("UNIT"))
740 . set units2=$get(Array("FORMULATION",1,"UNIT"))
741 . if (+str2'>0)!(strength'=str2) do
742 . . set Array("FORMULATION",1,"STRENGTH","OLD")=str2
743 . . set Array("FORMULATION",1,"STRENGTH")=strength
744 . . set Array("FORMULATION",1,"UNIT","OLD")=units2
745 . . set Array("FORMULATION",1,"UNIT")=units
746
747 ;"Now search for IEN in 50.68 of all ingredients, and find IEN for units name(s)
748 new i,X,Y,TMGROOT,TMGMSG
749 for i=1:1:Array("FORMULATION","COUNT") do
750 . new DIC
751 . set X=$get(Array("FORMULATION",i,"INGREDIENT NAME"))
752 . if X="" quit
753 . set Y=$$LookupRx^TMGNDF0C(X)
754 . if +Y>0 set Array("FORMULATION",i,"INGREDIENT NAME","FILE 50.416 IEN")=+Y
755 . ;"look up unit name to find IEN in file 50.607
756 . set DIC(0)="M"
757 . set DIC=50.607
758 . set X=$get(Array("FORMULATION",i,"UNIT"))
759 . if X="" quit
760 . do ^DIC
761 . if +Y>0 set Array("FORMULATION",i,"UNIT","FILE 50.607 IEN")=+Y
762
763 ;"Note the NDC (national drug code) is comprised as follows:
764 ;"It is a 10 digit number comprised of three segments
765 ;" 1st 4-5 digits - producer/packager <--> field#1 (LABEL CODE) in TMG FDA LISTING
766 ;" next 3-4 digits -- the product code <--> field#2 (PRODUCT CODE) in TMG FDA LISTING
767 ;" next 1-2 digits -- package code, specifying the package size <--> field#1 (CODE) in TMG FDA PACKAGES
768 ;" the grouping will be: 4-4-2, or 5-3-2, or 5-4-1
769
770 set Array("NDC")=$get(Array("LABEL CODE"),"????")_"-"
771 set Array("NDC")=Array("NDC")_$get(Array("PRODUCT CODE"),"????")_"-"
772 set Array("NDC")=Array("NDC")_$get(Array("PACKAGE",1,"CODE"),"??")
773
774 set Array("NDC")=$$NewNDC^TMGNDF2E(Array("NDC")) ;"added 5/28/06 //kt
775
776 set Array("NDC","12DIGIT")=$translate(Array("NDC"),"-","")
777 do ;"ensure length=12
778 . new num set num=Array("NDC","12DIGIT")
779 . new l set l=$length(num)
780 . if l>12 set num=$extract(num,l-11,99)
781 . if l<12 set num=$extract("00000000000",1,12-l)_num ;"pad with leading 0's
782 . set Array("NDC","12DIGIT")=num
783
784 if $get(noLink)=1 goto GDIDone ;"Skip linkages if requested.
785
786 ;"Now try to link to pre-existing VistA entries
787 ;"Note--2/12/07 -- I am changing the significance of this link to 50.68
788 ;" I found that many drugs had multiple links to entries in 50.68, i.e.
789 ;" there was a one-to-many relationship. And while it is helpful to
790 ;" have a connection to *similar* drugs (i.e. to obtain missing
791 ;" drug class, ingredients etc.), there is also value from having
792 ;" a link to an EXACT match in 50.68 -- i.e. a one-to-one relationship.
793 ;" I have therefore renamed the field in TMG FDA IMPORT COMPILED where
794 ;" this information is stored to: VA PRODUCT SIMILAR MATCHES, and for
795 ;" less certain matches, renamed it to: VA PRODUCT POSSIBLE MATCHES.
796 ;" I have introduced a new field: 'NDC --> VA PRODUCT LINK' that
797 ;" will hold a pointer to a record with the exact same NDC (national
798 ;" drug code). This link will be established in a later stage.
799 do
800 . new DIC,X,Y
801 . set DIC=50.67
802 . set DIC(0)="M"
803 . ;"set X=""""_Array("NDC","12DIGIT")_""""
804 . set X=Array("NDC","12DIGIT")
805 . do ^DIC
806 . if Y=-1 quit
807 . new tempIEN set tempIEN=$$GET1^DIQ(50.67,+Y_",",5,"I")
808 . new tempResults
809 . ;"do CheckNDCLink(tempIEN,.Array,.tempResults)
810 . ;"if +$get(tempResults("COUNT"))'>0 do quit
811 . ;". set Array("NDC","NOTE")="NDC Conflict found with drug IEN (in 50.68)="_tempIEN
812 . set Array("FILE 50.68 IEN",1)=tempIEN
813 . set Array("FILE 50.68 IEN","COUNT")=1
814
815 if +$get(Array("FILE 50.68 IEN","COUNT"))=0 do
816 . new RArray
817 . new temp
818 . if $get(pIndex)'="" do
819 . . set temp=$$Link2VAProd(.Array,.RArray,pIndex)
820 . else do
821 . . set temp=$$LinkToVAProd(.Array,.RArray)
822 . merge Array("FILE 50.68 IEN")=RArray
823
824GDIDone
825 quit result
826
827
828GetSingleRec(File,GRef,IEN,Array)
829 ;"Purpose: To get the data from single record, that points to IEN, and put in Array
830 ;"Input: File -- the file NUMBER
831 ;" GRef -- the OPEN FORMAT global reference of B xref (e.g. '^TMG(22706.1,"B",' )
832 ;" IEN -- The IEN that is pointed to
833 ;" Array -- an out parameter. PASS BY REFERENCE
834
835 set GRef=GRef_IEN_","""")"
836 set i=$order(@GRef)
837 if +i>0 do
838 . new IENS,TMGARRAY,TMGMSG
839 . set IENS=i_","
840 . do GETS^DIQ(File,IENS,"*","R","TMGARRAY","TMGMSG")
841 . if $data(TMGMSG) do quit
842 . . if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("TMGMSG")
843 . . if $data(TMGMSG("DIERR"))'=0 do quit
844 . . . ;"do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
845 . merge Array=TMGARRAY(File,IENS)
846
847 quit
848
849GetMultRec(File,GRef,IEN,Array,Label)
850 ;"Purpose: To get the data from mult records, that point to IEN, and put in Array
851 ;"Input: File -- the file NUMBER
852 ;" GRef -- the OPEN FORMAT global reference of B xref (e.g. '^TMG(22706.1,"B",' )
853 ;" IEN -- The IEN that is pointed to
854 ;" Array -- an out parameter. PASS BY REFERENCE
855
856 new count set count=1
857 new Ref
858 set Ref=GRef_IEN_","""")"
859 set i=$order(@Ref)
860 if +i>0 for do quit:(+i'>0)
861 . new IENS,TMGARRAY,TMGMSG
862 . set IENS=i_","
863 . do GETS^DIQ(File,IENS,"*","R","TMGARRAY","TMGMSG")
864 . if $data(TMGMSG) do quit
865 . . if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("TMGMSG")
866 . . if $data(TMGMSG("DIERR"))'=0 do quit
867 . . . ;"do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
868 . kill TMGARRAY(File,IENS,"LISTING")
869 . if Label="ROUTE" kill TMGARRAY(File,IENS,"CODE")
870 . if Label="DOSE" kill TMGARRAY(File,IENS,"DOSE FORM")
871 . merge Array(Label,count)=TMGARRAY(File,IENS)
872 . set Ref=GRef_IEN_",i)"
873 . set i=$order(@Ref)
874 . set count=count+1
875
876 quit
877
878
879LinkToVAProd(Array,Results)
880 ;"Purpose: To take a given drug array, and match to an entry in file VA PRODUCT (50.68)
881 ;"Input: Array -- PASS BY REFERENCE. An array holding drug info, as created by GetDrugInfo(IEN,Array)
882 ;" Results -- OPTIONAL, PASS BY REFERENCE, an OUT parameter to receive results array
883 ;" if more than one IEN. e.g.
884 ;" Results("COUNT")=3
885 ;" Results(1)=IEN ;IEN is from file 50.68
886 ;" Results(2)=IEN ;IEN is from file 50.68
887 ;" Results(3)=IEN ;IEN is from file 50.68
888 ;" Because a full match is sometimes not found (i.e. because minor variance), I
889 ;" will return all close (but not necessarily perfect) matches as:
890 ;" Results("POSS MATCH","COUNT")=IEN
891 ;" Results("POSS MATCH",1)=ien
892 ;"Result: Returns IEN in file 50.68, or 0 if not found, or -2 if multiple results found
893 ;" (in which case all matches will be reported in Results array
894 ;"Note: this function will have to scan through tens of thousands of entries in the main
895 ;" drug files, so response may be slow.
896
897 new result set result=0
898 kill Results
899 new lmCount set lmCount=0
900 ;"Cycle through all records in file 50.68 (VA PRODUCT FILE) (global: ^PSNDF(50.68, )
901 new IEN
902 set IEN=$order(^PSNDF(50.68,0))
903 if +IEN>0 for do quit:(IEN'>0)
904 . if ($get(tmgTEST)=1) write IEN,!
905 . do CheckLink(IEN,.Array,.Results)
906 . set IEN=$order(^PSNDF(50.68,IEN))
907
908 if $get(Results("COUNT"))=1 do
909 . set result=$order(Results(""))
910 else if +$get(Results("COUNT"))=0 do
911 . set result=0
912 else if $get(Results("COUNT"))>1 do
913 . set result=-2
914
915 quit result
916
917
918Link2VAProd(Array,Results,pIndex)
919 ;"Purpose: To take a given drug array, and match to an entry in file VA PRODUCT (50.68)
920 ;" -- using a faster index method
921 ;"Input: Array -- PASS BY REFERENCE. An array holding drug info, as created by GetDrugInfo(IEN,Array)
922 ;" Results -- OPTIONAL, PASS BY REFERENCE, an OUT parameter to receive results array
923 ;" if more than one IEN. e.g.
924 ;" Results("COUNT")=3
925 ;" Results(1)=IEN ;IEN is from file 50.68
926 ;" Results(2)=IEN ;IEN is from file 50.68
927 ;" Results(3)=IEN ;IEN is from file 50.68
928 ;" Because a full match is sometimes not found (i.e. because minor variance), I
929 ;" will return all close (but not necessarily perfect) matches as:
930 ;" Results("POSS MATCH","COUNT")=IEN
931 ;" Results("POSS MATCH",1)=ien
932 ;" pIndex -- NAME OF index array to use, as created by IndexVAProd()
933 ;" @pIndex@(IngredientIEN, 50.68 IEN, 50.6814 IEN)=""
934 ;" @pIndex@(IngredientIEN, 50.68 IEN, 50.6814 IEN)=""
935 ;"Result: Returns IEN in file 50.68, or 0 if not found, or -2 if multiple results found
936 ;" (in which case all matches will be reported in Results array
937 ;"Note: this function will have to scan through tens of thousands of entries in the main
938 ;" drug files, so response may be slow.
939
940 new result set result=0
941 kill Results
942 new lmCount set lmCount=0
943
944 new PossMatch ;"an array to list all IENs in 50.68 containing ONE specified ingredient
945 new IngredList ;"an array to hold IENS of all ingredients for drug info held in Array
946 new NumIngredients
947 new i
948 for i=1:1:$get(Array("FORMULATION","COUNT")) do
949 . new IngredIEN
950 . set IngredIEN=$get(Array("FORMULATION",i,"INGREDIENT NAME","FILE 50.416 IEN"))
951 . set IngredList(IngredIEN)=""
952 . do GetIndexList(IngredIEN,pIndex,$name(PossMatch(IngredIEN)))
953 ;"Example of Output from code above:
954 ;" PossMatch(50,3456)=""
955 ;" PossMatch(50,57698)=""
956 ;" PossMatch(50,993)=""
957 ;" PossMatch(99,3456)="" <-- 3456 has ingredient 99 and 50
958 ;" PossMatch(99,3876)=""
959 ;" PossMatch(99,9902)=""
960 set NumIngredients=$$ListCt^TMGMISC("PossMatch")
961
962 ;"Now, add node to array above, with indexes switched.
963 ;" PossMatch("x",3456,50)=""
964 ;" PossMatch("x",3456,99)="" <-- 3456 has ingredient 99 and 50
965 ;" PossMatch("x",57698,50)=""
966 ;" PossMatch("x",993,50)=""
967 ;" PossMatch("x",3876,99)=""
968 ;" PossMatch("x",9902,99)=""
969 new VAPIEN
970 set IngredIEN=$order(PossMatch(""))
971 if +IngredIEN>0 for do quit:(+IngredIEN'>0)
972 . set VAPIEN=$order(PossMatch(IngredIEN,""))
973 . if +VAPIEN>0 for do quit:(+VAPIEN'>0)
974 . . set PossMatch("x",VAPIEN,IngredIEN)=""
975 . . set VAPIEN=$order(PossMatch(IngredIEN,VAPIEN))
976 . set IngredIEN=$order(PossMatch(IngredIEN))
977
978 ;"now find those entries containing ALL given ingredients
979 ;" PossMatch("+",3456)="" <--- only 3456 is a possible match
980 set VAPIEN=$order(PossMatch("x",""))
981 if +VAPIEN>0 for do quit:(+VAPIEN'>0)
982 . if $$ListCt^TMGMISC($name(PossMatch("x",VAPIEN)))'<NumIngredients do
983 . . set PossMatch("+",VAPIEN)=""
984 . set VAPIEN=$order(PossMatch("x",VAPIEN))
985
986 ;"Cycle through all PossMatch("+") entries from file 50.68 (VA PRODUCT FILE)
987 new IEN
988 set IEN=$order(PossMatch("+",""))
989 if +IEN>0 for do quit:(IEN'>0)
990 . do CheckLink(IEN,.Array,.Results)
991 . set IEN=$order(PossMatch("+",IEN))
992
993 if $get(Results("COUNT"))=1 do
994 . set result=$order(Results(""))
995 else if +$get(Results("COUNT"))=0 do
996 . set result=0
997 else if $get(Results("COUNT"))>1 do
998 . set result=-2
999
1000L2VPDone
1001 quit result
1002
1003
1004CheckLink(IEN,Array,Results)
1005 ;"Purpose: To take a given drug array, and check for match to an entry in file VA PRODUCT (50.68)
1006 ;"Input: IEN -- An IEN in file 50.68 to try for a match, seeing if matches info in Array
1007 ;" Array -- PASS BY REFERENCE. An array holding drug info, as created by GetDrugInfo(IEN,Array)
1008 ;" partial reference below (See GetDrugInfo for full reference)
1009 ;" Array('FORMULATION','COUNT')=1
1010 ;" Array('FORMULATION',1,'STRENGTH')
1011 ;" Array('FORMULATION',1,'UNIT')
1012 ;" Array('FORMULATION',1,'UNIT','FILE 50.607 IEN') ;note may contain -1 if match not found
1013 ;" Array('FORMULATION',1,'INGREDIENT NAME')
1014 ;" Array('FORMULATION',1,'INGREDIENT NAME','FILE 50.416 IEN) ;note may contain -1 if match not found
1015 ;" Results -- OPTIONAL, PASS BY REFERENCE, an OUT parameter to receive results array
1016 ;" if more than one IEN. e.g.
1017 ;" Results("COUNT")=3
1018 ;" Results(1)=IEN ;IEN is from file 50.68
1019 ;" Results(2)=IEN ;IEN is from file 50.68
1020 ;" Results(3)=IEN ;IEN is from file 50.68
1021 ;" Because a full match is sometimes not found (i.e. because minor variance), I
1022 ;" will return all close (but not necessarily perfect) matches as:
1023 ;" Results("POSS MATCH","COUNT")=IEN
1024 ;" Results("POSS MATCH",1)=ien
1025 ;"Result: None (but returns results in Results array)
1026
1027 ;"Note: this function will have to scan through tens of thousands of entries in the main
1028 ;" drug files, so response may be slow.
1029
1030 new result set result=0
1031 new lmCount set lmCount=0
1032
1033 new ingredient,igdIEN
1034 new match set match=1 ;"default to true
1035 new numIngredients
1036 set numIngredients=$get(Array("FORMULATION","COUNT"))
1037 if numIngredients=0 set match=0
1038 else for ingredient=1:1 do quit:(+igdIEN'>0)!(match=0)
1039 . set igdIEN=$get(Array("FORMULATION",ingredient,"INGREDIENT NAME","FILE 50.416 IEN"))
1040 . if +igdIEN'>0 do quit
1041 . . if igdIEN="" quit ;"just at end of list of ingredients
1042 . . if igdIEN=-1 set match=0 ;"here igdIEN must =-1 (prior ^DIC failed to find match)
1043 . new node set node=$get(^PSNDF(50.68,IEN,2,igdIEN,0))
1044 . if node="" do quit
1045 . . set match=0 quit ;"no match found
1046 . ;"If we get here, we have a match. Now check for matching strength and units
1047 . set lmCount=lmCount+1
1048 . set Results("POSS MATCH",lmCount)=IEN
1049 . set Results("POSS MATCH","COUNT")=lmCount
1050 . set Results("POSS MATCH","INDEX",IEN)=lmCount
1051 . new strength set strength=$piece(node,"^",2)
1052 . new str2 set str2=$get(Array("FORMULATION",ingredient,"STRENGTH"))
1053 . if +strength'=+str2 do quit
1054 . . set Results("POSS MATCH",lmCount,"PROBLEM")="dosage STRENGTH mis-match"
1055 . . set Results("POSS MATCH",lmCount,"MSG")="Import="_str2_", VistA="_strength
1056 . . set match=0
1057 . new units set units=$piece(node,"^",3)
1058 . new units2 set units2=$get(Array("FORMULATION",ingredient,"UNIT","FILE 50.607 IEN"))
1059 . if units'=units2 do
1060 . . set Results("POSS MATCH",lmCount,"PROBLEM")="dosage UNITS mis-match"
1061 . . new s
1062 . . set s="Import="_$$GET1^DIQ(50.607,units2_",",".01")
1063 . . set s=s_", VistA="_$$GET1^DIQ(50.607,units_",",".01")
1064 . . set Results("POSS MATCH",lmCount,"MSG")=s
1065 . . set match=0
1066 . ;"Now see if VistA drug has more ingredients than import drug.
1067 . new IgdCount set IgdCount=0
1068 . new TempIdx set TempIdx=$order(^PSNDF(50.68,IEN,2,0))
1069 . if TempIdx'="" for do quit:(+TempIdx'>0)
1070 . . set IgdCount=IgdCount+1
1071 . . set TempIdx=$order(^PSNDF(50.68,IEN,2,TempIdx))
1072 . if IgdCount'=numIngredients do quit
1073 . . set Results("POSS MATCH",lmCount,"PROBLEM")="Number of ingredients mismatch"
1074 . . set Results("POSS MATCH",lmCount,"MSG")="Import="_numIngredients_", VistA="_IgdCount
1075 . . set match=0
1076 if match=1 do
1077 . new count set count=$get(Results("COUNT"))+1
1078 . set Results(count)=IEN
1079 . set Results("COUNT")=count
1080
1081 ;"Now, remove entries in POSS MATCH that are actual full matches.
1082 new SomeKilled set SomeKilled=0
1083 new index
1084 for index=1:1:+$get(Results("COUNT")) do
1085 . new matchIEN set matchIEN=$get(Results(index))
1086 . new possEntry set possEntry=$get(Results("POSS MATCH","INDEX",matchIEN))
1087 . kill Results("POSS MATCH",possEntry)
1088 . kill Results("POSS MATCH","INDEX",matchIEN)
1089 . set SomeKilled=1
1090 . set Results("POSS MATCH","COUNT")=$get(Results("POSS MATCH","COUNT"))-1
1091
1092 ;"Now renumber remaining POSS MATCHES
1093 if SomeKilled do
1094 . do ListPack^TMGMISC($name(Results("POSS MATCH")))
1095 . set Results("POSS MATCH","COUNT")=$$ListCt^TMGMISC($name(Results("POSS MATCH")))
1096
1097 ;"set index=$order(Results("POSS MATCH",""))
1098 ;"new newCount set newCount=0
1099 ;"if +index>0 for do quit:(index'>0)
1100 ;". set newCount=newCount+1
1101 ;". merge Results("POSS MATCH 2",newCount)=Results("POSS MATCH",index)
1102 ;". set Results("POSS MATCH 2","COUNT")=$get(Results("POSS MATCH 2","COUNT"))+1
1103 ;". set index=$order(Results("POSS MATCH",index))
1104 ;"if $data(Results("POSS MATCH 2"))>0 do
1105 ;". kill Results("POSS MATCH")
1106 ;". merge Results("POSS MATCH")=Results("POSS MATCH 2")
1107 ;". kill Results("POSS MATCH 2")
1108
1109 quit
1110
1111
1112CheckNDCLink(IEN,Array,Results)
1113 ;"This is like CheckLink, except is it a little bit more lenient about the allowed
1114 ;" variances. For example if UNITS of measure are different (e.g. MG vs. MG/VIAL).
1115 ;"Input: IEN -- An IEN in file 50.68 to try for a match, seeing if matches info in Array
1116 ;" Array -- PASS BY REFERENCE. An array holding drug info, as created by GetDrugInfo(IEN,Array)
1117 ;" Results -- OPTIONAL, PASS BY REFERENCE, an OUT parameter to receive results array
1118 ;" if more than one IEN. e.g.
1119 ;" Results("COUNT")=3
1120 ;" Results(1)=IEN ;IEN is from file 50.68
1121 ;" Results(2)=IEN ;IEN is from file 50.68
1122 ;" Results(3)=IEN ;IEN is from file 50.68
1123 ;" Because a full match is sometimes not found (i.e. because minor variance), I
1124 ;" will return all close (but not necessarily perfect) matches as:
1125 ;" Results("POSS MATCH","COUNT")=IEN
1126 ;" Results("POSS MATCH",1)=ien
1127 ;"Result: None (but returns results in Results array)
1128
1129 ;"Note: this function will have to scan through tens of thousands of entries in the main
1130 ;" drug files, so response may be slow.
1131
1132 new match
1133
1134 do CheckLink(IEN,.Array,.Results)
1135 if +$get(Results("COUNT"))<1 do
1136 . new i,max,done
1137 . set done=0
1138 . set max=$get(Results("POSS MATCH","COUNT"))
1139 . for i=1:1:max do quit:(done=1)
1140 . . if Results("POSS MATCH",i,"PROBLEM")="dosage UNITS mis-match" do
1141 . . . set Results(1)=Results("POSS MATCH",i)
1142 . . . kill Results("POSS MATCH",i)
1143 . . . do ListPack^TMGMISC($name(Results("POSS MATCH")))
1144 . . . set Results("COUNT")=$$ListCt^TMGMISC("Results")
1145 . . . set done=1
1146
1147 quit
1148
1149
1150GetpVAPIndex()
1151 ;"Purpose: to return a pointer to an index of the VAProduct file
1152 ;"Input: none
1153 ;"Output: returns the NAME of index of VAProduct, or ^ for abort
1154
1155 new pIndex set pIndex=$name(^TMG("TMP","indexVAProduct"))
1156 new abort set abort=0
1157 if $data(@pIndex) do
1158 . new % set %=2
1159 . write "Recreate temporary VA PRODUCT file index *IF* there have",!
1160 . write "been any changes made to this file since last index.",!
1161 . write "Re-index" do YN^DICN write !
1162 . if %=1 kill @pIndex
1163 . if %=-1 set abort=1
1164 if abort=1 set pIndex="^" goto GVAPIDone
1165
1166 if $data(@pIndex)=0 do IndexVAProd(pIndex)
1167
1168GVAPIDone
1169 quit pIndex
1170
1171IndexVAProd(pArray)
1172 ;"Purpose: to make a temporary index of the VA PRODUCT file based on the ACTIVE INGREDIENTS field
1173 ;"Input: pArray: the NAME OF the array to store index in
1174 ;"Output: Index will be stored in array like this:
1175 ;" @pArray@(IngredientIEN, 50.68 IEN, 50.6814 IEN)=""
1176 ;"Result: none:
1177 ;"Note: prior values in pArray will NOT be killed.
1178 ;" Also, the VA PRODUCT file is setup such that the 50.6814 IEN will also watch IngredientIEN
1179
1180 new IEN,subIEN,node,Ingredient
1181
1182 ;"set IEN=$order(^PSNDF(50.68,0))
1183 ;"if (+IEN>0) for do quit:(+IEN'>0)
1184
1185 write "Creating a temporary index of VA PRODUCT FILE",!
1186 new Itr,IEN
1187 set IEN=$$ItrInit^TMGITR(50.68,.Itr)
1188 do PrepProgress^TMGITR(.Itr,20,0,"IEN")
1189 if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)
1190 . set subIEN=$order(^PSNDF(50.68,IEN,2,0))
1191 . if (+subIEN>0) for do quit:(+subIEN'>0)
1192 . . set node=$get(^PSNDF(50.68,IEN,2,subIEN,0))
1193 . . set Ingredient=$piece(node,"^",1)
1194 . . if +Ingredient>0 do
1195 . . . set @pArray@(Ingredient,IEN,subIEN)=""
1196 . . . ;"set @pArray@("IEN",IEN,subIEN)=Ingredient
1197 . . set subIEN=$order(^PSNDF(50.68,IEN,2,subIEN))
1198 . ;"set IEN=$order(^PSNDF(50.68,IEN))
1199
1200 write !
1201 quit
1202
1203
1204GetIndexList(Ingredient,pIndex,pArray)
1205 ;"Purpose: for a given Ingredient, return a list of all records containing this ingredient
1206 ;"Input: Ingredient -- the IEN (from file 50.416) to scan for
1207 ;" pIndex -- NAME OF index array, as created by IndexVaProd()
1208 ;" pArray -- NAME OF array to put data into
1209 ;"Output: results will be put in like this:
1210 ;" @pArray@(IEN from 50.68)=""
1211 ;"results: none
1212 ;"Note: any prior data in pArray WILL BE KILLED
1213
1214 kill @pArray
1215 if $get(Ingredient)="" quit
1216 new IEN set IEN=$order(@pIndex@(Ingredient,""))
1217 if +IEN>0 for do quit:(+IEN'>0)
1218 . set @pArray@(IEN)=""
1219 . set IEN=$order(@pIndex@(Ingredient,IEN))
1220
1221 quit
1222
1223
1224FixGenerics
1225 ;"Purpose: After running the Compile function, I found that many records did not have
1226 ;" an entry for the GENERIC NAME field. This seems to happen when a drug has no
1227 ;" Ingredients listed. But often there are other drugs with the same name that DO
1228 ;" have ingredients. If so, then the errent record is essentially a duplicate (except
1229 ;" for different NDC etc), and isn't needed. Therefore the SKIP THIS RECORD field
1230 ;" can be set to 1 (SKIP). But, if there isn't a duplicate record, then the tradename
1231 ;" will be used as the GENERIC name
1232
1233 new IEN,count
1234 new TMGGeneric,TradeName
1235
1236 set IEN=$order(^TMG(22706.9,0))
1237 if IEN'="" for do quit:(+IEN'>0)
1238 . set TMGGeneric=$piece($get(^TMG(22706.9,IEN,0)),"^",6) ;"get field#.07, GENERIC NAME
1239 . if (TMGGeneric="") do
1240 . . set TradeName=$piece($get(^TMG(22706.9,IEN,0)),"^",4) ;"get field#.05, TRADENAME
1241 . . new list
1242 . . do ScanFor(TradeName,.list)
1243 . . set count=$$ListCt^TMGMISC("list")
1244 . . if count=1 do
1245 . . . write "Unique drug, with no ingredients: ",TradeName,!
1246 . . . do FindSimNames(TradeName,.list)
1247 . . . if $data(list) zwr list
1248 . . else do
1249 . . . write "Drug, with no ingredients: ",TradeName," --> ",count," other similar drugs.",!
1250 . set IEN=$order(^TMG(22706.9,IEN))
1251
1252 quit
1253
1254
1255ScanFor(Name,Array)
1256 ;"Purpose: To scan file 22706.9 (TMG FDA IMPORT COMPILED) for records with field TRADENAME
1257 ;" contains to 'TradeName'
1258 ;"Input: Name -- the value to search for
1259 ;" Array -- PASS BY REFERENCE. An OUT parameter for result:
1260 ;" Array(Name,IEN)=""
1261 ;" Array(Name,IEN)=""
1262 ;" Array(Name,IEN)=""
1263 ;"Results: none
1264
1265 new IEN
1266 new TradeName
1267
1268 set IEN=$order(^TMG(22706.9,0))
1269 if IEN'="" for do quit:(+IEN'>0)
1270 . set TradeName=$piece($get(^TMG(22706.9,IEN,0)),"^",4) ;"get field#.05, TRADENAME
1271 . if TradeName[Name do
1272 . . set Array(Name,IEN)=TradeName
1273 . set IEN=$order(^TMG(22706.9,IEN))
1274
1275 quit
1276
1277
1278FindSimNames(Name,Array)
1279 ;"Purpose: to scan TMG FDA IMPORT COMPILED file and return an array of similar entries.
1280 ;"Input: Name: the name of the Name drug name to scan for
1281 ;" Array: PASS BY REFERENCE, and OUT PARAMETER -- prior entries are killed
1282 ;"Result: none (output is in Array)
1283
1284 new i,i2,s
1285 new NumWords,TradeName
1286 set NumWords=$length(Name," ")
1287 kill Array
1288
1289 set i2=$order(^TMG(22706.9,0))
1290 if i2'="" for do quit:(i2="")
1291 . set TradeName=$piece($get(^TMG(22706.9,i2,0)),"^",4) ;"get field#.05, TRADENAME
1292 . new IEN set IEN=i2
1293 . set i2=$order(^TMG(22706.9,i2))
1294 . if NumWords'=$length(TradeName," ") quit
1295 . new temp set temp=TradeName
1296 . for i=1:1:NumWords do quit:(s="")!(temp="")
1297 . . set s=$piece(Name," ",i)
1298 . . set s=$piece(s," ",1) ;"get first word of multi-word drug name
1299 . . if s="" quit
1300 . . if $extract(TradeName,1,$length(s))'=s set temp=""
1301 . if temp'="" do
1302 . . set Array(TradeName)=IEN_"^"_TradeName
1303
1304 new count
1305 set count=$$ListCt^TMGMISC("Array")
1306 if count>1 do
1307 . do NarrowGenMatches^TMGNDF2C(Name,.Array," ")
1308 . if (($$ListCt^TMGMISC("Array")/count)>0.5)&(count>5) do ;"i.e. no improvement
1309 . . kill Array
1310
1311 quit
1312
1313
1314FixLink
1315 ;"Purpose: ask user for entry in 22706.9 to fix, then try to fix link
1316
1317 new IEN
1318 new DIC,X,Y
1319 set DIC=22706.9,DIC(0)="MAEQ"
1320 do ^DIC write !
1321 if +Y>0 do Fix1Link(+Y)
1322 quit
1323
1324
1325Fix1Link(IEN)
1326 ;"Purpose: To attemp to fix an entry that doesn't have a link to a VA PRODUCT entry
1327 ;"Input: IEN -- an IEN from 22706.9
1328
1329 new array,results,vapIEN
1330 new listIEN set listIEN=+$piece($get(^TMG(22706.9,IEN,0)),"^",1)
1331 if listIEN'>0 goto F1LDone
1332
1333 if $$GetDrugInfo(listIEN,.array)=0 goto F1LDone
1334 set vapIEN=$$LinkToVAProd(.array,.results)
1335 write vapIEN,!
1336 if $data(results) zwr results(*)
1337
1338 ;"finish....
1339 ;"
1340F1LDone
1341 quit
1342
1343 ;"=======================================================================
1344
1345Show1Source(IEN)
1346 ;"Purpose: to show the source fields for the record
1347 ;"Input: IEN -- records number from 22706.9
1348 ;"Output: source data for record is dumped to screen.
1349
1350 new fdaIEN
1351 set fdaIEN=$piece($get(^TMG(22706.9,IEN,0)),"^",1)
1352
1353 do Show1Drug^TMGNDF0B(fdaIEN)
1354 quit
Note: See TracBrowser for help on using the repository browser.