source: cprs/branches/tmg-cprs/m_files/TMGNDF0A.m@ 1682

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

Initial upload
File size: 42.1 KB
Line 
1TMGNDF0A ;TMG/kst/FDA Import: Load FDA data files ;03/25/06
2 ;;1.0;TMG-LIB;**1**;11/21/06
3
4 ;" FDA - NATIONAL DRUG FILES IMPORT FUNCTIONS
5 ;"Kevin Toppenberg MD
6 ;"GNU General Public License (GPL) applies
7 ;"11-21-2006
8
9 ;"Purpose: to import the National Drug Files, as distributed by:
10 ;" http://www.fda.gov/cder/ndc/ in format as of 10/17/2005
11 ;" List of files imported:
12 ;" TMG FDA APPLICATION (22706.1) <--> applicat.TXT
13 ;" TMG FDA DOSAGE FORM (22706.2) <--> dosform.TXT
14 ;" TMG FDA FIRMS (22706.3) <--> FIRMS.TXT ;was firms.txt
15 ;" TMG FDA FORMULATION (22706.4) <--> FORMULAT.TXT
16 ;" TMG FDA LISTING (22706.5) <--> listings.TXT ;was listings.txt
17 ;" TMG FDA PACKAGES (22706.6) <--> packages.txt
18 ;" TMG FDA ROUTES (22706.7) <--> ROUTES.TXT ;was routes.txt
19 ;" TMG FDA UNIT ABBREVIATIONS (22706.8) <--> TBLUNIT.TXT ; was tblunit.txt
20
21 ;"=======================================================================
22 ;" API -- Public Functions.
23 ;"=======================================================================
24 ;"Menu -- The starting menu for the import process
25
26 ;"=======================================================================
27 ;" API -- Semi-Public Functions.
28 ;"=======================================================================
29 ;"ImportNDF
30 ;"$$DataImport(Info,ProgressFN)
31 ;"Backup
32
33 ;"=======================================================================
34 ;" Private Functions.
35 ;"=======================================================================
36 ;"SetLoadDir(LoadDir)
37 ;"$$LoadApplication(LoadDir)
38 ;"$$LoadDosageForm(LoadDir)
39 ;"$$LoadFirms(LoadDir)
40 ;"$$LoadFormulation(LoadDir)
41 ;"$$LoadListing(LoadDir)
42 ;"$$LoadPackages(LoadDir)
43 ;"$$LoadRoutes(LoadDir)
44 ;"$$LoadUnitAbbr(LoadDir)
45 ;"SetSkipFlag
46
47 ;"=======================================================================
48 ;"=======================================================================
49Menu
50 ;"Purpose: To give an interactive menu
51
52 new Menu,UsrSlct
53 set Menu(0)="Pick Option for Parsing FDA Tables (0A)"
54 set Menu(1)="Review instructions"_$char(9)_"Instructions"
55 set Menu(2)="Parse FDA tables into corresponding Fileman Tables"_$char(9)_"ParseAll"
56 ;"set Menu("P")="Prev Stage"_$char(9)_"Prev"
57 set Menu("N")="Next Stage"_$char(9)_"Next"
58
59CD1
60 write #
61 set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^")
62 if UsrSlct="^" goto CDDone
63 if UsrSlct=0 set UsrSlct=""
64
65 ;"if UsrSlct="Prev" goto Menu^TMGNDF1D ;"quit can occur from there...
66 if UsrSlct="Next" goto Menu^TMGNDF0B ;"quit can occur from there...
67 if UsrSlct="Instructions" do Instructions goto CD1
68 if UsrSlct="ParseAll" do ImportNDF goto CD1
69 goto CD1
70CDDone
71 quit
72
73 ;"=======================================================================
74
75Instructions
76 ;"Purpose: to show some instructions
77
78 write !!
79 write "The individual tables from the FDA should be downloaded from: ",!
80 write " www.fda.gov/cder/ndc",!
81 write !
82 write "Reloading these files will NOT immediately overwrite changes made",!
83 write "the COMPILED import data. It will simply get the FDA tables",!
84 write "into a format for later compilation.",!
85 write "The choices made later (or perhaps on a previous cycle) will NOT",!
86 write "be lost by reloading these files. There really is no need to",!
87 write "be cautious on this step.",!
88 write !
89 write "Note: the instructions on the FDA website should be compared to the",!
90 write "parsing code in TMGNDF0A.m to ensure that the FDA table format has",!
91 write "not changed.",!,!
92
93 do PressToCont^TMGUSRIF
94 quit
95
96 ;"=======================================================================
97 ;"Note: these files were downloaded from:
98 ;" www.fda.gov/cder/ndc
99
100ImportNDF
101 ;"Purpose: to import the National Drug Files, as distributed by:
102 ;" http://www.fda.gov/cder/ndc/, in format as of 10/17/2005
103 ;" List of files imported:
104 ;" TMG FDA APPLICATION <--> applicat.TXT
105 ;" TMG FDA DOSAGE FORM <--> dosform.TXT
106 ;" TMG FDA FIRMS <--> FIRMS.TXT ;was firms.txt
107 ;" TMG FDA FORMULATION <--> FORMULAT.TXT
108 ;" TMG FDA LISTING <--> listings.TXT ;was listings.txt
109 ;" TMG FDA PACKAGES <--> packages.txt
110 ;" TMG FDA ROUTES <--> ROUTES.TXT ;was routes.txt
111 ;" TMG FDA UNIT ABBREVIATIONS <--> TBLUNIT.TXT ; was tblunit.txt
112 ;"Prerequisites: Must have Fileman files created to import into
113
114 new LoadDir
115 new PriorErrorFound
116 new ProgressFn
117 set ProgressFn="if TMGCUR#100=1 do ProgressBar^TMGUSRIF(TMGCUR,""Progress"",0,TMGTOTAL,,StartTime)"
118
119 write "Custom FDA Drug Files Importer",!!
120 write "This will DELETE all exsting entries in TMG FDA * files,",!
121 write "and then reload them from source text files.",!
122 write "These are temporary files, not VistA files.",!
123 write "Do you want to proceed? "
124 set %=2 ;"2=NO default
125 do YN^DICN
126 write !
127 if %'=1 goto INDFError
128 if $$SetLoadDir(.LoadDir)=0 goto INDFError
129
130 new skip set skip=0
131 write "Loading TMG FDA APPLICATIONS",!
132 if 'skip if $$LoadApplication(LoadDir)=0 goto INDFError
133 write "Loading TMG FDA DOSAGE FORMS",!
134 if 'skip if $$LoadDosageForm(LoadDir)=0 goto INDFError
135 write "Loading TMG FDA firms",!
136 if 'skip if $$LoadFirms(LoadDir)=0 goto INDFError
137 write "Loading TMG FDA FORMULATIONS",!
138 if 'skip if $$LoadFormulation(LoadDir)=0 goto INDFError
139 write "Loading TMG FDA PACKAGES",!
140 if 'skip if $$LoadPackages(LoadDir)=0 goto INDFError
141 write "Loading TMG FDA ROUTES",!
142 if 'skip if $$LoadRoutes(LoadDir)=0 goto INDFError
143 write "Loading TMG FDA UNIT ABBREVIATIONS",!
144 if 'skip if $$LoadUnitAbbr(LoadDir)=0 goto INDFError
145 write "Loading TMG FDA LISTINGS",!
146 if 'skip if $$LoadListing(LoadDir)=0 goto INDFError
147
148 write "All done. Import Successful.",!
149 goto INDFDone
150
151INDFError
152 Write "Import was NOT successful. Quitting.",!
153
154INDFDone
155 quit
156
157
158SetLoadDir(LoadDir)
159 ;"Purpose to ensure that LoadDir is set properly
160 ;"LoadDir -- PASS BY REFERENCE, an OUT parameter
161 ;"Result: 1=success, 0=error
162
163 new Msg
164 new result set result=1
165 set Msg="Please Pick ANY file in the directory containing NDF files"
166 new defDir set defDir="/home/kdt0p/downloads/FDA-NDC-Files/"
167 if $$GetFName^TMGIOUTL(Msg,defDir,,,.LoadDir)="" do
168 . set result=0
169
170 quit result
171
172
173LoadApplication(LoadDir)
174 ;"Purpose: to load from applicat.TXT
175 ;"Input: LoadDir -- the directory in HFS to get files from
176 ;"Output: Kills any prior entries in TMG FDA APPLICATION
177 ;"NOTICE: any pointers to this fill might me made invalid via kills
178 ;"Result: 1=success, 0=error
179
180 ;" Info("HFS DIR")=<directory name in HFS to load from>
181 ;" Info("HFS FILE")=<file name in HFS to load from>
182 ;" Info("DEST FILE")=<file name or number>
183 ;" Info(x)=field# (or "IEN" if data should be used to determine record number
184 ;" Info(x,"START")=starting column
185 ;" Info(x,"END")=ending column
186
187 ;"FDA documentation for 9/12/2007,4/6/09 file:
188 ;"=====================================
189 ;"MAY OCCUR MORE THAN ONCE PER LISTING SEQ NO.
190 ;"LISTING_SEQ_NO NOT NULL NUM(7) COL:1-7
191 ;" Linking field to LISTINGS.
192 ;"APPL_NO NULL CHAR(6) COL:9-14
193 ;" Number of New Drug Application if applicable. If none has been
194 ;" provided by the firm then the value ‘Other’ is used.
195 ;"PROD_NO NULL CHAR(3) COL:16-18
196 ;" Number used to identify the products of a New Drug Application.
197 ;"=====================================
198 ;"Log:
199 ;" 10/20/07 -- modified for 9/12/07 database
200 ;" 4/8/09 -- no changes needed for 4/6/09 version of file
201
202 new Info
203 new result
204
205 ;"Note: should Kill all prior records...
206 ;"Note: This will blow away ALL records, cross references etc.
207 ;" This is not considered good programming practice!
208 new temp set temp=$get(^TMG(22706.1,0))
209 kill ^TMG(22706.1)
210 set $piece(temp,"^",3)=""
211 set $piece(temp,"^",4)=0
212 set ^TMG(22706.1,0)=temp ;"fix up the 0 node
213
214 set Info("HFS DIR")=$get(LoadDir)
215 set Info("HFS FILE")="applicat.txt" ;" was applicat.TXT before
216 set Info("DEST FILE")="TMG FDA APPLICATION"
217
218 new tempFile set tempFile=Info("HFS DIR")_Info("HFS FILE")
219 set result=$$Dos2Unix^TMGIOUTL(tempFile)
220 if result>0 set result=0 goto LADone
221
222 ;"LISTING_SEQ_NO NOT NULL NUM(7) COL:1-7
223 ;"Linking field to LISTINGS.
224 set Info(.01)=.01 ;"Listing, pointer to 22706.5
225 set Info(.01,"START")=1 ;"was 1
226 set Info(.01,"END")=7 ;"was 8
227
228 ;"APPL_NO NULL CHAR(6) COL:10-15
229 ;"Number of New Drug Application if applicable.
230 ;"If none has been provided by the firm then the value ‘Other’ is used.
231 set Info(1)=1 ;"Application
232 set Info(1,"START")=9 ;"was 10 <-- was 9
233 set Info(1,"END")=14 ;"was 15 <-- was 15
234
235 ;"PROD_NO NULL CHAR(3) COL:17-19
236 ;"Number used to identify the products of a New Drug Application. .
237 set Info(2)=2 ;"Product Number
238 set Info(2,"START")=16 ;"was 17 <-- was 16
239 set Info(2,"END")=18 ;"was 19 <-- was 22
240
241 new StartTime set StartTime=$H
242 set result=$$DataImport(.Info,ProgressFn)
243 do ProgressBar^TMGUSRIF(100,"Progress",0,100)
244
245LADone
246 quit result
247
248
249LoadDosageForm(LoadDir)
250 ;"Purpose: to load TMG FDA DOSAGE FORM <--> doseform.TXT
251 ;"Input: LoadDir -- the directory in HFS to get files from
252 ;"Output: Kills any prior entries in TMG FDA DOSAGE FORM
253 ;"NOTICE: any pointers to this fill might me made invalid via kills
254 ;"Result: 1=success, 0=error
255
256 ;"FDA documentation for 9/12/2007,4/6/09 file:
257 ;"=====================================
258 ;"MAY OCCUR MULTIPLE TIMES PER LISTING SEQ NO.
259 ;"LISTING_SEQ_NO NOT NULL NUM(7) COL:1-7
260 ;" Linking field to LISTINGS.
261 ;"DOSEFORM NULL CHAR(3) COL:9-11
262 ;" The code for the route of administration. File will allow all assigned values for this element.
263 ;"DOSAGE_NAME NULL CHAR(240) COL:13-252
264 ;" The translation for the route of administration code.
265 ;"=====================================
266 ;"Log:
267 ;" 10/20/07 -- no modification needed for 9/12/07 database
268 ;" 4/8/09 -- no changes needed for 4/6/09 version of file
269
270 new Info
271 new result
272
273 ;"Note: should Kill all prior records...
274 ;"Note: This will blow away ALL records, cross references etc.
275 ;" This is not considered good programming practice!
276 new temp set temp=$get(^TMG(22706.2,0))
277 kill ^TMG(22706.2)
278 set $piece(temp,"^",3)=""
279 set $piece(temp,"^",4)=0
280 set ^TMG(22706.2,0)=temp ;"fix up the 0 node
281
282 set Info("HFS DIR")=$get(LoadDir)
283 set Info("HFS FILE")="doseform.TXT"
284 set Info("DEST FILE")="TMG FDA DOSAGE FORM"
285
286 new tempFile set tempFile=Info("HFS DIR")_Info("HFS FILE")
287 set result=$$Dos2Unix^TMGKERNL(tempFile)
288 if result>0 set result=0 goto LDsDone
289
290 ;"LISTING_SEQ_NO NOT NULL NUM(7) COL:1-7
291 ;"Linking field to LISTINGS.
292 set Info(.01)=.01 ;"Listing, pointer to 22706.5
293 set Info(.01,"START")=1 ;"was 1
294 set Info(.01,"END")=7 ;"was 8
295
296 ;"DOSEFORM NULL CHAR(3) COL:9-11
297 ;"The code for the route of administration. File will allow all assigned values for this element.
298 set Info(1)=1 ;"Dosage form
299 set Info(1,"START")=9 ;"was 9
300 set Info(1,"END")=11 ;"was 12
301
302 ;"DOSAGE_NAME NULL CHAR(240) COL:13-252
303 ;"The translation for the route of administration code.
304 set Info(2)=2 ;"Dosage Name
305 set Info(2,"START")=13 ;"was 13
306 set Info(2,"END")=252 ;"was 128
307
308LDL2
309 new StartTime set StartTime=$H
310 set result=$$DataImport(.Info,ProgressFn)
311 do ProgressBar^TMGUSRIF(100,"Progress",0,100)
312
313LDsDone
314 quit result
315
316
317LoadFirms(LoadDir)
318 ;"Purpose: to load TMG FDA FIRMS <--> FIRMS.TXT ;was firms.txt
319 ;"Input: LoadDir -- the directory in HFS to get files from
320 ;"Output: Kills any prior entries in TMG FDA FIRMS
321 ;"NOTICE: any pointers to this fill might me made invalid via kills
322 ;"Result: 1=success, 0=error
323
324 ;"FDA documentation for 9/12/2007,4/6/09 file:
325 ;"=====================================
326 ;"EACH FIRM HAS A UNIQUE FIRM SEQ NO WHICH CAN OCCUR MULTIPLE TIMES IN THE LISTINGS FILE.
327 ;"Contains the firm's full name, and compliance address. The compliance address is the mailing address where the FDA sends listing information to the firm.
328 ;"LBLCODE NOT NULL NUM(6) COL:1-6
329 ;" FDA generated identification number for each firm. The number is padded to the left with zeroes to fill out to length 6.
330 ;"FIRM_NAME NOT NULL CHAR(65) COL:8-72
331 ;" Firm name as reported by the firm.
332 ;"ADDR_HEADER NULL CHAR(40) COL:74-113
333 ;" Address Heading as reported by the firm.
334 ;"STREET NULL CHAR(40) COL:115-154
335 ;" Street Address as reported by firm.
336 ;"PO_BOX NULL CHAR(9) COL:156-164
337 ;" Post office box number as reported by firm.
338 ;"FOREIGN_ADDR NULL CHAR(40) COL:166-205
339 ;" Address information report by firm for foreign countries that does not fit the U.S. Postal service configuration.
340 ;"CITY NULL CHAR(30) COL:207-236
341 ;"STATE NULL CHAR(2) COL:238-239
342 ;"ZIP NULL CHAR(9) COL:241-249
343 ;"USPS Zip code.
344 ;"PROVINCE NULL CHAR(30) COL:251-280
345 ;" Province of Foreign country if appropriate.
346 ;"COUNTRY_NAME NOT NULL CHAR(40) COL:282-321
347 ;"=====================================
348 ;"Log:
349 ;" 10/20/07 -- no modification needed for 9/12/07 database
350 ;" 4/8/09 -- no changes needed for 4/6/09 version of file
351
352 new Info
353 new result
354
355 ;"Note: should Kill all prior records...
356 ;"Note: This will blow away ALL records, cross references etc.
357 ;" This is not considered good programming practice!
358 new temp set temp=$get(^TMG(22706.3,0))
359 kill ^TMG(22706.3)
360 set $piece(temp,"^",3)=""
361 set $piece(temp,"^",4)=0
362 set ^TMG(22706.3,0)=temp ;"fix up the 0 node
363
364 set Info("HFS DIR")=$get(LoadDir)
365 set Info("HFS FILE")="FIRMS.TXT" ;"was firms.txt
366 set Info("DEST FILE")="TMG FDA FIRMS"
367
368 new tempFile set tempFile=Info("HFS DIR")_Info("HFS FILE")
369 set result=$$Dos2Unix^TMGIOUTL(tempFile)
370 if result>0 set result=0 goto LFrDone
371
372 ;"LBLCODE NOT NULL NUM(6) COL:1-6
373 ;"FDA generated identification number for each firm.
374 ;"The number is padded to the left with zeroes to fill out to length 6.
375 set Info(1)=1 ;"Label Code
376 set Info(1,"START")=1
377 set Info(1,"END")=6
378
379 ;"FIRM_NAME NOT NULL CHAR(65) COL:8-72
380 ;"Firm name as reported by the firm.
381 set Info(.01)=.01 ;"Name
382 set Info(.01,"START")=8
383 set Info(.01,"END")=72
384
385 ;"ADDR_HEADER NULL CHAR(40) COL:74-113
386 ;"Address Heading as reported by the firm.
387 set Info(2)=2 ;"Address Header
388 set Info(2,"START")=74
389 set Info(2,"END")=113
390
391 ;"STREET NULL CHAR(40) COL:115-154
392 ;"Street Address as reported by firm.
393 set Info(3)=3 ;"Street
394 set Info(3,"START")=115
395 set Info(3,"END")=154
396
397 ;"PO_BOX NULL CHAR(9) COL:156-164
398 ;"Post office box number as reported by firm.
399 set Info(4)=4 ;"PO Box
400 set Info(4,"START")=156
401 set Info(4,"END")=164
402
403 ;"FOREIGN_ADDR NULL CHAR(40) COL:166-205
404 ;"Address information report by firm for foreign
405 ;"countries that does not fit the U.S. Postal service configuration.
406 set Info(5)=5 ;"Foreign Address
407 set Info(5,"START")=166
408 set Info(5,"END")=205
409
410 ;"CITY NULL CHAR(30) COL:207-236
411 set Info(6)=6 ;"City
412 set Info(6,"START")=207
413 set Info(6,"END")=236
414
415 ;"STATE NULL CHAR(2) COL:238-239
416 set Info(7)=7 ;"State
417 set Info(7,"START")=238
418 set Info(7,"END")=239
419
420 ;"ZIP NULL CHAR(9) COL:241-249
421 ;"USPS Zip code.
422 set Info(8)=8 ;"ZIP
423 set Info(8,"START")=241
424 set Info(8,"END")=249
425
426 ;"PROVINCE NULL CHAR(30) COL:251-280
427 ;"Province of Foreign country if appropriate.
428 set Info(9)=9 ;"Province
429 set Info(9,"START")=251
430 set Info(9,"END")=280
431
432 ;"COUNTRY_NAME NOT NULL CHAR(40) COL:282-321
433 set Info(10)=10 ;"Country
434 set Info(10,"START")=282
435 set Info(10,"END")=321
436
437 new StartTime set StartTime=$H
438 set result=$$DataImport(.Info,ProgressFn)
439 do ProgressBar^TMGUSRIF(100,"Progress",0,100)
440
441LFrDone
442 quit result
443
444
445LoadFormulation(LoadDir)
446 ;"Purpose: to load TMG FDA FORMULATION <--> FORMULAT.TXT
447 ;"Input: LoadDir -- the directory in HFS to get files from
448 ;"Output: Kills any prior entries in TMG FDA FIRMS
449 ;"NOTICE: any pointers to this fill might me made invalid via kills
450 ;"Result: 1=success, 0=error
451
452 ;"FDA documentation for 9/12/2007,4/6/09 file:
453 ;"=====================================
454 ;"MAY OCCUR MULTIPLE TIMES PER LISTING SEQ NO.
455 ;"Lists active ingredients contained in product's formulation.
456 ;"LISTING_SEQ_NO NOT NULL NUM(7) COL: 1-7
457 ;" Linking field to LISTINGS.
458 ;"STRENGTH NULL CHAR(10) COL: 9-18
459 ;" This is the potency of the active ingredient.
460 ;"UNIT NULL CHAR(5) COL: 20-24
461 ;" Unit of measure corresponding to strength.
462 ;"INGREDIENT_NAME NOT NULL CHAR(100) COL: 26-125
463 ;" Truncated preferred term for the active ingredient.
464 ;"=====================================
465 ;"Log:
466 ;" 10/20/07 -- no modification needed for 9/12/07 database
467 ;" 4/8/09 -- no changes needed for 4/6/09 version of file
468
469 new Info
470 new result
471
472 ;"Note: should Kill all prior records...
473 ;"Note: This will blow away ALL records, cross references etc.
474 ;" This is not considered good programming practice!
475 new temp set temp=$get(^TMG(22706.4,0))
476 kill ^TMG(22706.4)
477 set $piece(temp,"^",3)=""
478 set $piece(temp,"^",4)=0
479 set ^TMG(22706.4,0)=temp ;"fix up the 0 node
480
481 set Info("HFS DIR")=$get(LoadDir)
482 set Info("HFS FILE")="FORMULAT.TXT"
483 set Info("DEST FILE")="TMG FDA FORMULATION"
484
485 new tempFile set tempFile=Info("HFS DIR")_Info("HFS FILE")
486 set result=$$Dos2Unix^TMGIOUTL(tempFile)
487 if result>0 set result=0 goto LFmDone
488
489 ;"LISTING_SEQ_NO NOT NULL NUM(7) COL: 1-7
490 ;"Linking field to LISTINGS.
491 set Info(.01)=.01 ;"Listing
492 set Info(.01,"START")=1
493 set Info(.01,"END")=7
494
495 ;"STRENGTH NULL CHAR(10) COL: 9-18
496 ;"This is the potency of the active ingredient.
497 set Info(1)=1 ;"Strength
498 set Info(1,"START")=9
499 set Info(1,"END")=18
500
501 ;"UNIT NULL CHAR(5) COL: 20-24
502 ;"Unit of measure corresponding to strength.
503 set Info(2)=2 ;"Unit
504 set Info(2,"START")=20
505 set Info(2,"END")=24
506
507 ;"INGREDIENT_NAME NOT NULL CHAR(100) COL: 26-125
508 ;"Truncated preferred term for the active ingredient.
509 set Info(3)=3 ;"Ingredient Name
510 set Info(3,"START")=26
511 set Info(3,"END")=125
512
513 new StartTime set StartTime=$H
514 set result=$$DataImport(.Info,ProgressFn)
515 do ProgressBar^TMGUSRIF(100,"Progress",0,100)
516
517LFmDone
518 quit result
519
520
521LoadPackages(LoadDir)
522 ;"Purpose: to load TMG FDA PACKAGES <--> packages.txt
523 ;"Input: LoadDir -- the directory in HFS to get files from
524 ;"Output: Kills any prior entries in TMG FDA FIRMS
525 ;"NOTICE: any pointers to this fill might me made invalid via kills
526 ;"Result: 1=success, 0=error
527
528 ;"FDA documentation for 9/12/2007,4/6/09 file:
529 ;"=====================================
530 ;"MAY OCCUR MULTIPLE TIMES PER LISTING SEQ NO
531 ;"Stores packages for an individual listing. The packages table includes all packages for a corresponding listing. The PKGCODE field contains the last one or two digit segment of the NDC.
532 ;"LISTING_SEQ_NO NOT NULL NUM(7) COL: 1-7
533 ;" Linking field to LISTINGS.
534 ;"PKGCODE NULL CHAR(2) COL: 9-10
535 ;" The package code portion of NDC code. The package code is the last segment of the NDC.
536 ;"PACKSIZE NOT NULL CHAR(25) COL: 12-36
537 ;" The unit or number of units which make up a package.
538 ;"PACKTYPE NOT NULL CHAR(25) COL: 38-62
539 ;" Package type, i.e., box, bottle, vial, plastic, or glass.
540 ;"=====================================
541 ;"Log:
542 ;" 10/20/07 -- no modification needed for 9/12/07 database
543 ;" 4/8/09 -- no changes needed for 4/6/09 version of file
544
545 new Info
546 new result
547
548 ;"Note: should Kill all prior records...
549 ;"Note: This will blow away ALL records, cross references etc.
550 ;" This is not considered good programming practice!
551 new temp set temp=$get(^TMG(22706.6,0))
552 kill ^TMG(22706.6)
553 set $piece(temp,"^",3)=""
554 set $piece(temp,"^",4)=0
555 set ^TMG(22706.6,0)=temp ;"fix up the 0 node
556
557 set Info("HFS DIR")=$get(LoadDir)
558 set Info("HFS FILE")="packages.txt"
559 set Info("DEST FILE")="TMG FDA PACKAGES"
560
561 new tempFile set tempFile=Info("HFS DIR")_Info("HFS FILE")
562 set result=$$Dos2Unix^TMGIOUTL(tempFile)
563 if result>0 set result=0 goto LPkDone
564
565 ;"LISTING_SEQ_NO NOT NULL NUM(7) COL: 1-7
566 ;"Linking field to LISTINGS.
567 set Info(.01)=.01 ;"Listing
568 set Info(.01,"START")=1
569 set Info(.01,"END")=7
570
571 ;"PKGCODE NULL CHAR(2) COL: 9-10
572 ;"The package code portion of NDC code. The package
573 ;"code is the last segment of the NDC.
574 set Info(1)=1 ;"Code
575 set Info(1,"START")=9
576 set Info(1,"END")=10
577
578 ;"PACKSIZE NOT NULL CHAR(25) COL: 12-36
579 ;"The unit or number of units which make up a package.
580 set Info(2)=2 ;"Size
581 set Info(2,"START")=12
582 set Info(2,"END")=36
583
584 ;"PACKTYPE NOT NULL CHAR(25) COL: 38-62
585 ;"Package type, i.e., box, bottle, vial, plastic, or glass.
586 set Info(3)=3 ;"Type
587 set Info(3,"START")=38
588 set Info(3,"END")=62
589
590 new StartTime set StartTime=$H
591 set result=$$DataImport(.Info,ProgressFn)
592 do ProgressBar^TMGUSRIF(100,"Progress",0,100)
593
594LPkDone
595 quit result
596
597
598LoadRoutes(LoadDir)
599 ;"Purpose: to load TMG FDA ROUTES <--> ROUTES.TXT ;was routes.txt
600 ;"Input: LoadDir -- the directory in HFS to get files from
601 ;"Output: Kills any prior entries in TMG FDA FIRMS
602 ;"NOTICE: any pointers to this fill might me made invalid via kills
603 ;"Result: 1=success, 0=error
604
605 ;"FDA documentation for 9/12/2007,4/6/09 file:
606 ;"=====================================
607 ;"LISTING_SEQ_NO NOT NULL NUM(7) COL:1-7
608 ;" Linking field to LISTINGS.
609 ;"ROUTE_CODE NULL CHAR(3) COL:9-11
610 ;" The code for the route of administration. File will allow all assigned values for this element.
611 ;"ROUTE_NAME NULL CHAR(240) COL:13-252
612 ;" The translation for the route of administration code.
613 ;"=====================================
614 ;"Log:
615 ;" 10/20/07 -- no modification needed for 9/12/07 database
616 ;" 4/8/09 -- no changes needed for 4/6/09 version of file
617
618 new Info
619 new result
620
621 ;"Note: should Kill all prior records...
622 ;"Note: This will blow away ALL records, cross references etc.
623 ;" This is not considered good programming practice!
624 new temp set temp=$get(^TMG(22706.7,0))
625 kill ^TMG(22706.7)
626 set $piece(temp,"^",3)=""
627 set $piece(temp,"^",4)=0
628 set ^TMG(22706.7,0)=temp ;"fix up the 0 node
629
630 set Info("HFS DIR")=$get(LoadDir)
631 set Info("HFS FILE")="ROUTES.TXT" ;"was routes.txt
632 set Info("DEST FILE")="TMG FDA ROUTES"
633
634 new tempFile set tempFile=Info("HFS DIR")_Info("HFS FILE")
635 set result=$$Dos2Unix^TMGIOUTL(tempFile)
636 if result>0 set result=0 goto LRtDone
637
638 ;"LISTING_SEQ_NO NOT NULL NUM(7) COL:1-7
639 ;"Linking field to LISTINGS.
640 set Info(.01)=.01 ;"Listing
641 set Info(.01,"START")=1
642 set Info(.01,"END")=7
643
644 ;"ROUTE_CODE NULL CHAR(3) COL:9-11
645 ;"The code for the route of administration.
646 ;"File will allow all assigned values for this element.
647 set Info(1)=1 ;"Code
648 set Info(1,"START")=9
649 set Info(1,"END")=11
650
651 ;"ROUTE_NAME NULL CHAR(240) COL:13-252
652 ;"The translation for the route of administration code.
653 set Info(2)=2 ;"Name
654 set Info(2,"START")=13
655 set Info(2,"END")=252
656
657 new StartTime set StartTime=$H
658 set result=$$DataImport(.Info,ProgressFn)
659 do ProgressBar^TMGUSRIF(100,"Progress",0,100)
660
661LRtDone
662 quit result
663
664
665LoadUnitAbbr(LoadDir)
666 ;"Purpose: to load FDA UNIT ABBREVIATIONS <--> TBLUNIT.TXT ; was tblunit.txt
667 ;"Input: LoadDir -- the directory in HFS to get files from
668 ;"Output: Kills any prior entries in TMG FDA FIRMS
669 ;"NOTICE: any pointers to this fill might me made invalid via kills
670 ;"Result: 1=success, 0=error
671
672 ;"FDA documentation for 9/12/2007,4/6/09 file:
673 ;"=====================================
674 ;"THIS FILE CONTAINS A COMPLETE LIST OF THE POTENCY UNIT ABBREVIATIONS USED IN THE DIRECTORY.
675 ;"UNIT CHAR(15) COL:1-15
676 ;" The potency unit abbreviations used in the directory.
677 ;"TRANSLATION CHAR(100) COL:17-115
678 ;" The translation for the UNIT abbreviations.
679 ;"=====================================
680 ;"Log:
681 ;" 10/20/07 -- no modification needed for 9/12/07 database
682
683 new Info
684 new result
685
686 ;"Note: should Kill all prior records...
687 ;"Note: This will blow away ALL records, cross references etc.
688 ;" This is not considered good programming practice!
689 new temp set temp=$get(^TMG(22706.8,0))
690 kill ^TMG(22706.8)
691 set $piece(temp,"^",3)=""
692 set $piece(temp,"^",4)=0
693 set ^TMG(22706.8,0)=temp ;"fix up the 0 node
694
695 set Info("HFS DIR")=$get(LoadDir)
696 set Info("HFS FILE")="TBLUNIT.TXT" ;"was tblunit.txt
697 set Info("DEST FILE")="FDA UNIT ABBREVIATIONS"
698
699 new tempFile set tempFile=Info("HFS DIR")_Info("HFS FILE")
700 set result=$$Dos2Unix^TMGIOUTL(tempFile)
701 if result>0 set result=0 goto LUADone
702
703 ;"UNIT CHAR(15) COL:1-15
704 ;"The potency unit abbreviations used in the directory.
705 set Info(.01)=.01 ;"Abbreviation
706 set Info(.01,"START")=1
707 set Info(.01,"END")=15
708
709 ;"TRANSLATION CHAR(100) COL:17-115
710 ;"The translation for the UNIT abbreviations.
711 set Info(1)=1 ;"Description
712 set Info(1,"START")=17
713 set Info(1,"END")=115 ;"was 250 before
714
715 new StartTime set StartTime=$H
716 set result=$$DataImport(.Info,ProgressFn)
717 do ProgressBar^TMGUSRIF(100,"Progress",0,100)
718
719LUADone
720 quit result
721
722
723LoadListing(LoadDir)
724 ;"Purpose: to load TMG FDA LISTING <--> listings.TXT ;was listings.txt
725 ;"Input: LoadDir -- the directory in HFS to get files from
726 ;"Output: Kills any prior entries in TMG FDA FIRMS
727 ;"NOTICE: any pointers to this fill might me made invalid via kills
728 ;"Result: 1=success, 0=error
729
730 ;"FDA documentation for 9/12/2007,4/6/09 file:
731 ;"=====================================
732 ;"EACH PRODUCT HAS A UNIQUE LISTING SEQ NO;
733 ;" EACH FIRM SEQ NO CAN HAVE MULTIPLE LISTING SEQ NO'S.
734 ;" Each line in this file represents a product for an individual firm.
735 ;" The listing includes such information as the product's name, firm's
736 ;" seq number, dose form(s), and Rx/OTC.
737 ;"LISTING_SEQ_NO NOT NULL NUM(7) COL: 1-7
738 ;" FDA generated unique identification number for each product.
739 ;"LBLCODE NOT NULL CHAR(6) COL: 9-14
740 ;" Labeler code portion of NDC; assigned by FDA to firm.
741 ;" The labeler code is the first segment of the National Drug Code.
742 ;" While always displayed as 6 digits in this file; for labeler codes 2 through 9999,
743 ;" some systems display it as 4 digits; for labeler codes 10,000 through 99,999 it is 5 digits.
744 ;" Can be used to link to the FIRMS.TXT file to obtain firm name.
745 ;"PRODCODE NOT NULL CHAR(4) COL: 16-19
746 ;" Product code assigned by firm. The prodcode is the second segment of the National
747 ;" Drug Code. It may be a 3-digit or 4-digit code depending upon the NDC configuration
748 ;" selected by the firm.
749 ;"STRENGTH NULL CHAR(10) COL: 21-30
750 ;" For single entity products, this is the potency of the active ingredient. For combination
751 ;" products, it may be null or a number or combination of numbers, e.g., Inderide 40/25.
752 ;"UNIT NULL CHAR(10) COL: 32-41
753 ;" Unit of measure corresponding to strength. This non-mandatory field contains the unit
754 ;" code for a single entity product, e.g., MG, %VV.
755 ;"RX_OTC NOT NULL CHAR(1) COL: 43
756 ;" Indicates whether product is labeled for Rx or OTC use (R/O).
757 ;"TRADENAME NOT NULL CHAR(100) COL: 45-144
758 ;" Product's name as it appears on the labeling.
759 ;"=====================================
760 ;"Log:
761 ;" 10/20/07 -- no modification needed for 9/12/07 database
762 ;" 4/8/09 -- no changes needed for 4/6/09 version of file
763
764 new Info
765 new result
766
767 ;"Note: should Kill all prior records...
768 ;"Note: This will blow away ALL records, cross references etc.
769 ;" This is not considered good programming practice!
770 new temp set temp=$get(^TMG(22706.5,0))
771 kill ^TMG(22706.5)
772 set $piece(temp,"^",3)=""
773 set $piece(temp,"^",4)=0
774 set ^TMG(22706.5,0)=temp ;"fix up the 0 node
775
776 set Info("HFS DIR")=$get(LoadDir)
777 set Info("HFS FILE")="listings.TXT" ;"was listings.txt
778 set Info("DEST FILE")="TMG FDA LISTING"
779
780 new tempFile set tempFile=Info("HFS DIR")_Info("HFS FILE")
781 set result=$$Dos2Unix^TMGIOUTL(tempFile)
782 if result>0 set result=0 goto LLsDone
783
784 ;"LISTING_SEQ_NO NOT NULL NUM(7) COL: 1-7
785 ;"FDA generated unique identification number for each product.
786 set Info(.001)="IEN" ;"Sequence number
787 set Info(.001,"START")=1
788 set Info(.001,"END")=7
789
790 set Info(.01)=.01 ;"Sequence number
791 set Info(.01,"START")=1
792 set Info(.01,"END")=7
793
794 ;"LBLCODE NOT NULL CHAR(6) COL: 9-14
795 ;"Labeler code portion of NDC; assigned by FDA to firm.
796 ;"The labeler code is the first segment of the National
797 ;"Drug Code. While always displayed as 6 digits in this file;
798 ;"for labeler codes 2 through 9999, some systems display it as
799 ;"4 digits; for labeler codes 10,000 through 99,999 it is 5 digits.
800 ;"Can be used to link to the FIRMS.TXT file to obtain firm name.
801 set Info(1)=1 ;"Label Code
802 set Info(1,"START")=9
803 set Info(1,"END")=14
804
805 ;"PRODCODE NOT NULL CHAR(4) COL: 16-19
806 ;"Product code assigned by firm. The prodcode is the second segment
807 ;"of the National Drug Code (NDC). It may be a 3-digit or 4-digit
808 ;"code depending upon the NDC configuration selected by the firm.
809 set Info(2)=2 ;"Product Code
810 set Info(2,"START")=16
811 set Info(2,"END")=19
812
813 ;"STRENGTH NULL CHAR(10) COL: 21-30
814 ;"For single entity products, this is the potency of the active ingredient.
815 ;"For combination products, it may be null or a number or combination of
816 ;"numbers, e.g., Inderide 40/25.
817 set Info(3)=3 ;"Strength
818 set Info(3,"START")=21
819 set Info(3,"END")=30
820
821 ;"UNIT NULL CHAR(10) COL: 32-41
822 ;"Unit of measure corresponding to strength. This non-mandatory field
823 ;"contains the unit code for a single entity product, e.g., MG, %VV.
824 set Info(4)=4 ;"Unit
825 set Info(4,"START")=32
826 set Info(4,"END")=41
827
828 ;"RX_OTC NOT NULL CHAR(1) COL: 43
829 ;"Indicates whether product is labeled for Rx or OTC use (R/O).
830 set Info(5)=5 ;"Rx or OTC
831 set Info(5,"START")=43
832 set Info(5,"END")=43
833
834 ;"TRADENAME NOT NULL CHAR(100) COL: 45-144
835 ;"Product's name as it appears on the labeling.
836 set Info(7)=7 ;"Trade name
837 set Info(7,"START")=45
838 set Info(7,"END")=144
839
840 ;"NOTE: This field will be left blank, as it is not included in FDA
841 ;" file here. It is really the same info as LBLCODE, i.e. the
842 ;" Firm that makes drug can be determined from LBL code.
843 ;"set Info(6)=6 ;"Firm
844 ;"set Info(6,"START")=45
845 ;"set Info(6,"END")=51
846
847 new StartTime set StartTime=$H
848 set result=$$DataImport(.Info,ProgressFn)
849 do ProgressBar^TMGUSRIF(100,"Progress",0,100)
850
851LLL3
852 ;"Fix Firms Pointer
853 ;"Note: the latest FDA export does not explicitly specify the Firm,
854 ;" and only gives the label code. Thus the label code must be
855 ;" used to look up the IEN for the firm, and this put into the
856 ;" FIRM fiels (#6)
857
858 new Itr,IEN
859 set IEN=$$ItrInit^TMGITR(22706.5,.Itr)
860 do PrepProgress^TMGITR(.Itr,20,0,"IEN")
861 if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)
862 . new lblCode
863 . set lblCode=$piece($get(^TMG(22706.5,IEN,0)),"^",2)
864 . if lblCode="" quit
865 . set lblCode=$$RJ^XLFSTR(lblCode,6,"0")
866 . new IEN2 set IEN2=+$order(^TMG(22706.3,"C",lblCode,""))
867 . if IEN2'>0 quit
868 . set $piece(^TMG(22706.5,IEN,0),"^",7)=IEN2
869
870LLsDone
871 quit result
872
873
874DataImport(Info,ProgressFN)
875 ;"Purpose: to provide a generic loading utility, for importing data from a text file.
876 ;" Note: this is more specific than code found in DDMP.m
877 ;"Assumptions: that all data for one record is found on one line, with a given
878 ;" number of columns for each field (i.e. not Comma-Separated-Values).
879 ;"Input: Info, an array with relevent info. PASS BY REFERENCE
880 ;" Format as follows:
881 ;" Info("HFS DIR")=<directory name in HFS to load from>
882 ;" Info("HFS FILE")=<file name in HFS to load from>
883 ;" Info("DEST FILE")=<file name or number>
884 ;" Info(x)=field# (or "IEN" if data should be used to determine record number
885 ;" Info(x,"START")=starting column
886 ;" Info(x,"END")=ending column
887 ;" ProgressFN: optional. If not "", then this will be XECUTED after each line
888 ;" The following variables will be defined:
889 ;" TMGTOTAL -- total number of records
890 ;" TMGCUR -- current index of record being processed
891 ;"Result: 1 if OK to continue, 0 if error
892
893 ;"Note: input Data array will be formated like this:
894 ;" Data(0,cFile)="1234.1" <-- "NEW PERSON" Note conversion
895 ;" Data(0,cFile,cGlobal)="^DIC(200)" <-- note, NOT "^DIC(200,"
896 ;" Data(0,cRecNum)=2 <-- only if user-specified.
897 ;" Data(0,cEntries)=1
898 ;" Data(1,".01")="MyData1"
899 ;" Data(1,".01",cMatchValue)="MyData1"
900 ;" Data(1,".02")="Bill"
901 ;" Data(1,".02",cMatchValue)="John"
902 ;" Data(1,".03")="MyData3"
903 ;" Data(1,".04")="MyData4"
904 ;" Data(1,".06")="MyData5" <-- note "NAME" was converted to ".06"
905 ;" Data(1,".07",0,cEntries)=2 <-- "ITEM" converted to ".07"
906 ;" Data(1,".07",1,".01")="SubEntry1"
907 ;" Data(1,".07",1,".02")="SE1"
908 ;" Data(1,".07",1,".03")="'Some Info'"
909 ;" Data(1,".07",2,".01")="SubEntry2"
910 ;" Data(1,".07",2,".02")="SE2"
911 ;" Data(1,".07",2,".04",0,cEntries)=1 ;"TEXT converted to .04
912 ;" Data(1,".07",2,".04",1,".01")="JD"
913 ;" Data(1,".07",2,".04",1,".02")="DOE,JOHN"
914 ;" ADDENDUM
915 ;" Data(1,".01",cFlags)=any flags specified for given field.
916 ;" only present if user specified.
917
918 new cFile set cFile="FILE"
919 new cRecNum set cRecNum="RECNUM"
920 new result set result=1
921 new TMGTOTAL,TMGCUR
922
923 new GRef set GRef=$name(^TMP("TMG","DATAIMPORT",$J))
924 new GRef1 set GRef1=$name(@GRef@(1)) ;"I have to use this to load file
925 kill @GRef
926
927 new result
928 new dir set dir=$get(Info("HFS DIR"))
929 new HFSfile set HFSfile=$get(Info("HFS FILE"))
930 set result=$$FTG^%ZISH(dir,HFSfile,GRef1,4)
931 if result=0 goto DIDone
932 set TMGTOTAL=$order(@GRef@(""),-1)
933 new file set file=$get(Info("DEST FILE"))
934 if +file=0 set file=$$GetFileNum^TMGDBAPI(file)
935
936 new index
937 set index=$order(@GRef@(""))
938 for do quit:(+index=0)!(result=0)
939 . new RecData,TMGFDA
940 . set RecData(0,cFile)=file
941 . new line set line=$get(@GRef@(index))
942 . if $data(@GRef@(index,"OVF")) do
943 . . new i set i=$order(@GRef@(index,"OVF",""))
944 . . for do quit:(+i=0)
945 . . . set line=line_$get(@GRef@(index,"OVF",i)) ;"note strings can be longer than 255 now
946 . . . set i=$order(@GRef@(index,"OVF",i))
947 . new fields set fields=$order(Info(""))
948 . new IEN set IEN=""
949 . for do quit:(+fields=0)!(result=0)
950 . . new fieldNum set fieldNum=$get(Info(fields)) ;"could be number or 'IEN'
951 . . new oneField
952 . . set oneField=$extract(line,$get(Info(fields,"START")),$get(Info(fields,"END")))
953 . . set oneField=$$Trim^TMGSTUTL(oneField)
954 . . if fieldNum="IEN" do
955 . . . set RecData(0,cRecNum)=oneField
956 . . . set IEN=oneField
957 . . else do
958 . . . set RecData(1,fieldNum)=oneField
959 . . set fields=$order(Info(fields))
960 . new MarkNum set MarkNum=0
961 . new MsgArray
962 . set result=$$SetupFDA^TMGDBAPI(.RecData,.TMGFDA,,"+",.MarkNum,.MsgArray)
963 . if result=0 quit
964 . new TMGIEN
965 . if IEN'=0 do
966 . . if +IEN>0 set TMGIEN(1)=IEN
967 . . set result=$$dbWrite^TMGDBAPI(.TMGFDA,0,.TMGIEN," ")
968 . if result=0 quit
969 . if $get(ProgressFN)'="" do
970 . . set TMGCUR=index
971 . . new $etrap set $etrap="w ""??Progress function -- error trapped??"",!"
972 . . xecute ProgressFN
973 . set index=$order(@GRef@(index))
974
975DIDone
976 kill @GRef
977 quit result
978
979
980SetSkipFlag
981 ;"Purpose: To review entries in TMG FDA IMPORT COMPILED and determine which
982 ;" of those need to have the SKIP THIS RECORD flag set.
983 ;" The following records will be SKIPPED:
984 ;" -- If there is an entry in the VA PRODUCT MATCHES field. This would
985 ;" mean that there is ALREADY an entry in the database for this
986 ;" drug, and it will not need to be added.
987 ;" -- If there are no entries in the INGREDIENTS field. This is because if
988 ;" the FDA database does not list ingredients for a drug, I believe it
989 ;" is because it is not an active drug (otherwise the FDA would require
990 ;" full information), and there is very likely another drug entry for
991 ;" this same drug that DOES have the ingredients.
992 ;"Note: This function is planned to be run after CompileAll^TMGNDF2AA
993
994 new IEN
995 new NumSkipped,NumNotSkipped,NoIngreds
996 set NumSkipped=0,NumNotSkipped=0,NoIngreds=0
997
998 set IEN=$order(^TMG(22706.9,0))
999 if +IEN>0 for do quit:(+IEN'>0)
1000 . new name set name=$piece($get(^TMG(22706.9,IEN,0)),"^",4)
1001 . new NumIngreds set NumIngreds=0
1002 . new SkipThisOne set SkipThisOne=0
1003 . ;"See if there are entries in the VA PRODUCT MATCHES field (node 2)
1004 . new ProdMatches set ProdMatches=+$piece($get(^TMG(22706.9,IEN,2,0)),"^",4) ;"piece 4 of 0 node is number of entries.
1005 . if ProdMatches>0 set SkipThisOne=1
1006 . ;"See if there are NO entries in the INGREDIENTS field (node 4)
1007 . set NumIngreds=+$piece($get(^TMG(22706.9,IEN,4,0)),"^",4) ;"piece 4 of 0 node is number of entries.
1008 . if NumIngreds=0 set SkipThisOne=1,NoIngreds=NoIngreds+1
1009 . if SkipThisOne set NumSkipped=NumSkipped+1
1010 . else set NumNotSkipped=NumNotSkipped+1
1011 . set $piece(^TMG(22706.9,IEN,1),"^",4)=SkipThisOne
1012 . ;"write " matches=",ProdMatches," ingredients=",NumIngreds," ",name,!
1013 . set IEN=$order(^TMG(22706.9,IEN))
1014
1015 write !,"There are ",NumSkipped," entries that are will be skipped.",!
1016 write " (",NoIngreds," with no ingredients)",!
1017 write " (",NumSkipped-NoIngreds," already in the database)",!
1018 write "There are ",NumNotSkipped," new entries to be added.",!
1019
1020 quit
1021
1022
1023Backup
1024 ;"Purpose: To backup files to a temporary global
1025
1026 new dateCode set dateCode="1/15/07"
1027
1028 new src,dest,i
1029
1030 for i=1:1:8 do
1031 . set src="^TMG(22706."_i_")"
1032 . set dest=$name(^TMG("TMP",src_" "_dateCode))
1033 . write "merging ",src," into ",dest,!
1034 . merge @dest=@src
1035
1036 quit
Note: See TracBrowser for help on using the repository browser.