source: cprs/branches/tmg-cprs/m_files/TMGNDF2H.m@ 1742

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

Initial upload

File size: 33.2 KB
RevLine 
[796]1TMGNDF2H ;TMG/kst/FDA Import: Fill VA Product entries ;03/25/06
2 ;;1.0;TMG-LIB;**1**;11/21/06
3
4 ;" FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS
5 ;" Addition of records from TMG FDA IMPORT COMPILED into VA PRODUCT file.
6 ;"Kevin Toppenberg MD
7 ;"GNU General Public License (GPL) applies
8 ;"11-21-2006
9
10 ;"=======================================================================
11 ;" API -- Public Functions.
12 ;"=======================================================================
13 ;"Menu
14
15 ;"=======================================================================
16 ;"Link2VAP -- fill file 22706.9, field 5.5 in with link 50.68 with SAME NDC
17 ;"Batch2VAP -- Batch add drugs to VA PRODUCT file (50.68) and NDC/UPC
18
19 ;"=======================================================================
20 ;" Private Functions.
21 ;"=======================================================================
22 ;"Add2VAProd(IEN,Quiet)
23 ;"EnsureNDC(IEN) Make record in NDC/UPN file (50.67).
24 ;"EnsureUnits(UnitS) -- ensure that the UnitS is valid in file 50.607
25 ;"Unlock50dot607
26 ;"Lock50dot607
27
28
29 ;"=======================================================================
30 ;"=======================================================================
31
32Menu
33 new Menu,UsrSlct
34 set Menu(0)="Pick Option to Add imports to VA PRODUCT & NDC/UPN file (2H)"
35 set Menu(1)="Link imports to VA PRODUCT via NDC-- *DO THIS FIRST*"_$char(9)_"Link2VAP"
36 set Menu(2)="ADD unlinked imports to VA PRODUCT file."_$char(9)_"Batch2VAP"
37 set Menu(3)="Synchronize VA PRODUCT file with import data."_$char(9)_"Sync2VAP"
38 ;"set Menu(3)="Fix Names with '...'s (SHOULD run AFTER Batch Add)"_$char(9)_"FixNames"
39 ;"set Menu(4)="Check/Fix ALL Names (May be run AFTER Batch Add)"_$char(9)_"FixNames2"
40 set Menu("P")="Prev Stage"_$char(9)_"Prev"
41 set Menu("N")="Next Stage"_$char(9)_"Next"
42
43M1 write #
44 set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^")
45
46 if UsrSlct="Link2VAP" do Link2VAP goto M1
47 if UsrSlct="Batch2VAP" do Batch2VAP goto M1
48 if UsrSlct="Sync2VAP" do Sync2VAP goto M1
49 ;"if UsrSlct="FixNames" do FixNames(0) goto M1
50 ;"if UsrSlct="FixNames2" do FixNames(1) goto M1
51 if UsrSlct="Prev" goto Menu^TMGNDF2G ;"quit can occur from there...
52 if UsrSlct="Next" goto Menu^TMGNDF3A ;"quit can occur from there...
53 if UsrSlct="^" goto MenuDone
54 goto M1
55
56MenuDone
57 quit
58
59
60 ;"==========================================================================
61
62
63Batch2VAP
64 ;"Purpose: To scan through all records in TMG FDA IMPORT COMPILED, and create an array of
65 ;" possible entries for addition to VA PRODUCT, also creating an entry in
66 ;" the NDC/UPC file.
67 ;"Input: none
68 ;"Output: database will be filled with data (records added to VA PRODUCT file)
69 ;"Results: none
70
71 ;"Note: After making this function, I changed the function MakeName such that it is better
72 ;" at shortening long names to fit into the field limits.
73 ;" So I wrote the code FixNames to go back and correct the names for better fits.
74 ;" The problem is that it takes user interaction to do this well (asking for abbreviations etc)
75 ;" And this is best done in a batch manner (i.e. not asking each drug, one at a time).
76 ;" So this function was modified such that it shortens the names non-interactively
77 ;" (i.e. AllowCut=1), and then FixNames can be run to review all of the abbreviations
78 ;" are appropriate
79
80
81 new AddList
82 do GetAddList(.AddList)
83 new count set count=$$ListCt^TMGMISC("AddList")
84 if count=0 do goto B2VDone
85 . write "No entries need to be be added to VA PRODUCT file.",!
86 . do PressToCont^TMGUSRIF
87 write count," entries will now be added to VA PRODUCT file.",!
88 new % set %=1
89 write "Continue" do YN^DICN write !
90 if %=1 do DoAdd(.AddList)
91B2VDone
92 quit
93
94
95Check1(IEN)
96 ;"Purpose: to check one record in TMG FDA IMPORT COMPILED (22706.9)
97 ;"NOTE: this just checks if one exists, NOT if correct link is present.
98 ;"Input: IEN -- IEN in 22706.9
99
100 new AddList,vapIEN,syncList
101
102 set vapIEN=+$piece($get(^TMG(22706.9,IEN,6)),"^",2)
103 set AddList(IEN)=""
104 if vapIEN=0 set vapIEN=$$Add2VAProd(IEN)
105 set syncList(IEN)=vapIEN
106 do DoSync(.syncList)
107
108C1Done quit
109
110
111Sync2VAP
112 ;"Purpose: To scan through all records in TMG FDA IMPORT COMPILED (22706.9)
113 ;" and synchronize data with records in VA PRODUCT.
114 ;"Input: none
115 ;"Output: database will be modified with data from 22706.9
116 ;"Results: none
117
118 new SyncList
119 do GetSyncList(.SyncList)
120 new count set count=$$ListCt^TMGMISC("SyncList")
121 if count=0 do goto S2VDone
122 . write "No entries available to update VA PRODUCT file with.",!
123 . do PressToCont^TMGUSRIF
124 write count," entries will now be used to update VA PRODUCT file.",!
125 new % set %=1
126 write "Continue" do YN^DICN write !
127 if %=1 do DoSync(.SyncList)
128S2VDone
129 quit
130
131
132GetAddList(AddList)
133 ;"Purpose: to create a list of IEN's that need addition
134 ;"Input: AddList-- PASS BY REFERENCE. An OUT PARAMETER.
135 ;"Output: AddList is filled: Format:
136 ;" AddList(IEN)="" ;IEN is from file 22706.9
137 ;" AddList(IEN)=""
138 ;"Results: none.
139
140 write "Scanning for imports to be added into VA PRODUCT file...",!
141 new Itr,IEN,success
142 new abort set abort=0
143 set IEN=$$ItrInit^TMGITR(22706.9,.Itr)
144 do PrepProgress^TMGITR(.Itr,20,0,"IEN")
145 if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort
146 . if $$UserAborted^TMGUSRIF set abort=1 quit
147 . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;"1=SKIP
148 . if $piece($get(^TMG(22706.9,IEN,6)),"^",2)>0 quit ;"IEN of linked entry in 50.68
149 . set AddList(IEN)=""
150 do ProgressDone^TMGITR(.Itr)
151
152 quit
153
154
155GetSyncList(SyncList)
156 ;"Purpose: to create a list of IEN's can be used for syncing data
157 ;"Input: SyncList-- PASS BY REFERENCE. An OUT PARAMETER.
158 ;"Output: SyncList is filled: Format:
159 ;" SyncList(IEN22706d9)=vapIEN
160 ;"Results: none.
161
162 write "Scanning for imports to be synchronized with VA PRODUCT file...",!
163 new Itr,IEN,success
164 new abort set abort=0
165 set IEN=$$ItrInit^TMGITR(22706.9,.Itr)
166 do PrepProgress^TMGITR(.Itr,20,0,"IEN")
167 if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort
168 . if $$UserAborted^TMGUSRIF set abort=1 quit
169 . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;"1=SKIP
170 . new vapIEN set vapIEN=$piece($get(^TMG(22706.9,IEN,6)),"^",2) ;"IEN of linked entry in 50.68
171 . if vapIEN=0 quit
172 . set SyncList(IEN)=vapIEN
173 do ProgressDone^TMGITR(.Itr)
174
175 quit
176
177
178DoAdd(AddList)
179 ;"Purpose: To process the AddList, doing actual adds.
180 ;"Input: AddList-- PASS BY REFERENCE. Format:
181 ;" AddList(IEN)="" ;IEN is from file 22706.9
182 ;" AddList(IEN)=""
183 ;"Results: none.
184
185 do Unlock50dot607
186 do Unlock50^TMGNDF3C
187
188 write "Adding records into VA PRODUCT file from import information...",!
189 new count set count=0
190 new Itr,IEN,success,addedIEN
191 new abort set abort=0
192 set IEN=$$ItrAInit^TMGITR("AddList",.Itr)
193 do PrepProgress^TMGITR(.Itr,1,1,"IEN")
194 if IEN'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN)="")!abort
195 . if $$UserAborted^TMGUSRIF set abort=1 quit
196L1 . set addedIEN=$$Add2VAProd(IEN,0,1) ;"0=not quiet, 1=quiet,Allow Cut automatically
197 . if addedIEN>0 do
198 . . set count=count+1
199 . . new TMGFDA,TMGMSG
200 . . set TMGFDA(22706.9,IEN_",",5.5)=addedIEN
201 . . do FILE^DIE("K","TMGFDA","TMGMSG")
202 . . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
203 . else do
204 . . write !,"Unable to add record# ",IEN," from file 22706.9 to file 50.68.",!
205 do ProgressDone^TMGITR(.Itr)
206
207 do Lock50dot607
208 do Lock50^TMGNDF3C
209
210 write count," imports added to VA PRODUCT (file 50.68 )",!
211 do PressToCont^TMGUSRIF
212
213 quit
214
215
216DoSync(SyncList)
217 ;"Purpose: To process the SyncList, doing actual synchronization.
218 ;"Input: SyncList-- PASS BY REFERENCE. Format:
219 ;" SyncList(IEN)=vapIEN ;IEN is from file 22706.9; vapIEN=IEN 50.68
220 ;"Results: none.
221
222 do Unlock50dot607
223 do Unlock50^TMGNDF3C
224
225 write "Synchronizing VA PRODUCT file from import information...",!
226 new count set count=0
227 new Itr,IEN,success
228 new abort set abort=0
229 set IEN=$$ItrAInit^TMGITR("SyncList",.Itr)
230 do PrepProgress^TMGITR(.Itr,1,1,"IEN")
231 if IEN'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN)="")!abort
232 . if $$UserAborted^TMGUSRIF set abort=1 quit
233 . new vapIEN set vapIEN=+$get(SyncList(IEN))
234 . if +vapIEN=0 quit
235 . set success=$$Sync1Rec(IEN,vapIEN)
236 do ProgressDone^TMGITR(.Itr)
237
238 do Lock50dot607
239 do Lock50^TMGNDF3C
240
241 do PressToCont^TMGUSRIF
242
243 quit
244
245
246Add2VAProd(IEN,Quiet,AllowCut)
247 ;"Purpose: to take drug information from Array and use this to create a new entry
248 ;" in file #50.68 (VA PRODUCT)--and any supporting files needed.
249 ;"Input: IEN -- IEN from file 22706.9 (TMG FDA IMPORT COMPILED) to add
250 ;" Quiet -- OPTIONAL -- default = 1 (quiet), if 1 no output generated to console.
251 ;" AllowCut -- OPTIONAL -- default = 0 (no cut).
252 ;" If value=1 then names will be shortened to needed length without
253 ;" asking user for abbreviations etc.
254 ;"Output: A new record will be created in 50.68, and any supporint files (such as
255 ;" drug manufacturer, package type etc if needed)
256 ;"Result: the IEN in 50.68 of added record, 0 if error
257
258
259 new TMGFDA,TMGIEN,TMGMSG
260 set IENS="+1,"
261 do SetupFDA(IEN,IENS,.TMGFDA)
262
263ALabel
264 do UPDATE^DIE("E","TMGFDA","TMGIEN","TMGMSG")
265 if $data(TMGMSG("DIERR")) do goto A2VPDone
266 . set result=0
267 . if Quiet=1 quit
268 . write !,"Error adding new record to 50.68",!
269 . new PriorErrorFound
270 . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
271
272 ;"Check that record was added, then then add subfile entries: active ingredients...
273 new AddedIEN set AddedIEN=$get(TMGIEN(1)) ;"also used to create NDC/UPC record;
274 if +AddedIEN=0 do goto A2VPDone
275 . set result=0 if Quiet=1 quit
276 . write !,"Can't find record number of added record to 50.68",!
277 . do PressToCont^TMGUSRIF
278
279 set result=$$EnsureIngredients(IEN,AddedIEN) if result=0 goto A2VPDone
280
281BLabel ;"set result=$$Add2NDC(IEN,.DrugInfo)
282 set result=$$EnsureNDC(IEN) if result=0 goto A2VPDone
283
284A2VPDone
285 ;"1=OK to continue, 0 if error
286 if result=1 set result=+$get(AddedIEN)
287 quit result ;"changed to return IEN in 50.68
288
289
290Sync1Rec(IEN,vapIEN)
291 ;"Purpose: to take drug information from Array and use this to create a new entry
292 ;" in file #50.68 (VA PRODUCT)--and any supporting files needed.
293 ;"Input: IEN -- IEN from file 22706.9 (TMG FDA IMPORT COMPILED) to add
294 ;" vapIEN -- IEN in 50.68 that is the target of the synchronization.
295 ;"Output: data in VA PRODUCT will be updated as needed to match the info in
296 ;" file 22706.9
297 ;"Result: 1 if OK, 0 if error
298
299 new result set result=0
300 new TMGFDA,TMGIEN,TMGMSG
301 set IENS=vapIEN_","
302 do SetupFDA(IEN,IENS,.TMGFDA)
303 new temp set temp=$$TrimFDA^TMGDBAPI(.TMGFDA)
304
305 if $data(TMGFDA) do
306 . do FILE^DIE("EK","TMGFDA","TMGMSG")
307 . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
308
309 set result=$$EnsureIngredients(IEN,vapIEN)
310 if result=0 goto S2VPDone
311 set result=$$EnsureNDC(IEN) if result=0 goto S2VPDone
312S2VPDone
313 quit result ;"changed to return IEN in 50.68
314
315
316SetupFDA(IEN,IENS,TMGFDA,vapIEN)
317 ;"Purpose: to set up FDA for data in a#50.68 (VA PRODUCT) entry
318 ;"Input: IEN -- IEN from file 22706.9 (TMG FDA IMPORT COMPILED) to add
319 ;" IENS -- a standard FM IENS for FDA to use
320 ;" TMGFDA -- PASS BY REFEERNCE. A standard FM FDA
321 ;" vapIEN -- OPTIONAL. If provided, then the FDA wil be trimmed to contain
322 ;" only those fields that need to be changed
323 ;"Output: TMGFDA is filled
324 ;"Result: none
325
326 ;"NOTE: this function will create an FDA in EXTERNAL form
327
328 ;"VA PRODUCT FILE RECORD STRUCTURE
329 ;"-----------------------------------
330 ;" .01 NAME [RFa]
331 ;" e.g. NAME: DILTIAZEM (CARDIZEM CD) 240MG SA CAP
332 ;" .05 VA GENERIC NAME <-Pntr [P50.6'a]
333 ;" e.g. VA GENERIC NAME: DILTIAZEM
334 ;" 1 DOSAGE FORM <-Pntr [P50.606'a]
335 ;" e.g. DOSAGE FORM: CAP,SA
336 ;" 2 STRENGTH [Fa]
337 ;" e.g. STRENGTH: 240
338 ;" 3 UNITS <-Pntr [P50.607'a]
339 ;" e.g. UNITS: MG
340 ;" 4 NATIONAL FORMULARY NAME [Fa]
341 ;" e.g. NATIONAL FORMULARY NAME: DILTIAZEM CAP,SA
342 ;" 5 VA PRINT NAME [Fa]
343 ;" e.g. VA PRINT NAME: DILTIAZEM (CARDIZEM CD) 240MG SA CAP
344 ;" 6 VA PRODUCT IDENTIFIER [Fa] <--- will use to store "0^TMG ADDED"
345 ;" e.g. VA PRODUCT IDENTIFIER: D0230
346 ;" 8 VA DISPENSE UNIT <-Pntr [P50.64a]
347 ;" e.g. VA DISPENSE UNIT: CAPNSE UNIT <-Pntr [P50.64a] <-- plan to leave blank, for CMOP use
348 ;" 14 ACTIVE INGREDIENTS W:^ D:^ <-Mult [50.6814P]
349 ;" .01 -ACTIVE INGREDIENTS <-Pntr [P50.416'Xa]
350 ;" e.g. ACTIVE INGREDIENTS: DILTIAZEM HYDROCHLORIDE
351 ;" 1 -STRENGTH [Fa]
352 ;" e.g. STRENGTH: 240
353 ;" 2 -UNITS <-Pntr [P50.607'a]
354 ;" e.g. UNITS: MG
355 ;" 15 PRIMARY VA DRUG CLASS <-Pntr [P50.605'a]
356 ;" e.g. PRIMARY VA DRUG CLASS: CV200
357 ;" 16 SECONDARY VA DRUG CLASS W:^ D:^ <-Mult [50.6816P]
358 ;" .01 -SECONDARY VA DRUG CLASS <-Pntr [MP50.605'aX]
359 ;" 17 NATIONAL FORMULARY INDICATOR [Sa]
360 ;" e.g. NATIONAL FORMULARY INDICATOR: NO
361 ;" 18 NATIONAL FORMULARY RESTRICTIONW:^ D:^ <-WP [50.6818]
362 ;" .01 -NATIONAL FORMULARY RESTRICTION [W]
363 ;" 19 CS FEDERAL SCHEDULE [Sa]
364 ;" 20 SINGLE/MULTI SOURCE PRODUCT [Sa]
365 ;" 21 INACTIVATION DATE [Da]
366 ;" 23 EXCLUDE DRG-DRG INTERACTION CK [S]
367 ;" 25 MAX SINGLE DOSE [NJ13,4a]
368 ;" 26 MIN SINGLE DOSE [NJ13,4a]
369 ;" 27 MAX DAILY DOSE [NJ13,4a]
370 ;" 28 MIN DAILY DOSE [NJ13,4a]
371 ;" 29 MAX CUMULATIVE DOSE [NJ13,4a]
372 ;" 30 DSS NUMBER [NJ6,0a]
373
374 ;"---------------------------------------------------------
375
376
377 ;"File: TMG FDA IMPORT COMPILED Branch: 1
378 ;"REF NODE;PIECE FLD NUM FIELD NAME
379 ;"===============================================================================
380 ;" 1 0;1 .01 TMG FDA LISTING ENTRY <-Pntr [RP22706.5']
381 ;" e.g. TMG FDA LISTING ENTRY: 154001
382 ;" 2 0;4 .05 TRADENAME [F]
383 ;" e.g. TRADENAME: DILTIAZEM HCL SR CAPSULES
384 ;" 3 0;6 .07 GENERIC NAME [F]
385 ;" 4 1;3 .08 VA GENERIC <-Pntr [P50.6']
386 ;" 5 1;5 .09 VA DRUG CLASS <-Pntr [P50.605']
387 ;" 6 0;2 1 STRENGTH [F]
388 ;" e.g. STRENGTH: 240
389 ;" 7 0;3 2 UNIT [F]
390 ;" e.g. UNIT: MG
391 ;" 8 0;5 3 ROUTE [F]
392 ;" e.g. ???
393 ;" 9 0;7 3.5 DOSAGE FORM <-Pntr [P50.606]
394 ;" 9 1;1 4 NDC [F]
395 ;" e.g. NDC: 053978-3062-*3
396 ;" 10 1;2 5 NDC 12-DIGIT [F]
397 ;" e.g. NDC: 0539783062*3
398 ;" 11 1;4 6 SKIP THIS RECORD [S]
399 ;" 12 1;7 7 DONE ADDING TO 50.68 [S]
400 ;" 2;0 14 VA PRODUCT MATCHES <-Mult [22706.914P]
401 ;" 13 -0;1 .01 -ONE MATCH <-Pntr [P50.68']
402 ;" e.g. ONE MATCH: DILTIAZEM (DILACOR XR) 240MG SA CAP
403 ;" e.g. ONE MATCH: DILTIAZEM (CARDIZEM CD) 240MG SA CAP
404 ;" e.g. ONE MATCH: DILTIAZEM (TIAZAC) 240MG SA CAP
405 ;" e.g. ONE MATCH: DILTIAZEM (WATSON-XR) 240MG SA CAP
406 ;" e.g. ONE MATCH: DILTIAZEM (TIAZAC) 240MG SA CAP,UD
407 ;" e.g. ONE MATCH: DILTIAZEM (CARDIZEM CD) 240MG SA CAP,UD
408 ;" 3;0 15 VA PRODUCT POSS MATCH <-Mult [22706.915P]
409 ;" 14 -0;1 .01 -POSS MATCH <-Pntr [P50.68']
410 ;" 4;0 16 INGREDIENTS <-Mult [22706.916]
411 ;" 15 -0;1 .01 -NUMBER [NJ3,0]
412 ;" e.g. NUMBER: 1
413 ;" 17 -0;3 2 -INGREDIENT <-Pntr [P50.416']
414 ;" e.g. INGREDIENT: DILTIAZEM HYDROCHLORIDE
415 ;" 18 -0;4 3 -STRENGTH [F]
416 ;" e.g. STRENGTH: 240
417 ;" 19 -0;6 5 -UNIT <-Pntr [P50.607']
418 ;" e.g. ???
419 ;"
420 ;"===============================================================================
421 ;"<> 'n',I=FldDD DA=Data F=Find G=Goto N=Node P=Pointer VGL=VGL ?=Help
422 ;"
423
424 ;"new FDAitemNum
425 ;"set FDAitemNum=$$GET1^DIQ(22706.9,IEN,.01)
426 ;"new DrugInfo
427 ;"set result=$$GetDrugInfo^TMGNDF1A(FDAitemNum,.DrugInfo,"",1)
428 ;"if result=0 do goto A2VPDone
429 ;". if Quiet=1 quit
430 ;". write !,"Unable to Get Drug Info for record: ",FDAitemNum,!
431
432 ;".01 NAME [RFa]
433 ;" e.g. NAME: DILTIAZEM (CARDIZEM CD) 240MG SA CAP
434 set tempS=$piece($get(^TMG(22706.9,IEN,7)),"^",6) ;"7;6= field .04 LONG NAME
435 set TMGFDA(50.68,IENS,.01)=tempS ;".01 NAME [RFa] ;e.g. NAME: DILTIAZEM (CARDIZEM CD) 240MG SA CAP
436 ;"set DrugInfo("ADDED","GENERIC+BRAND")=tempS
437
438 ;".05 VA GENERIC NAME <-Pntr [P50.6'a]
439 ;" e.g. VA GENERIC NAME: DILTIAZEM
440 set TMGFDA(50.68,IENS,.05)=$$GET1^DIQ(22706.9,IEN,.08)
441
442 ;"1 DOSAGE FORM <-Pntr [P50.606'a]
443 ;" e.g. DOSAGE FORM: CAP,SA
444 set TMGFDA(50.68,IENS,1)=$$GET1^DIQ(22706.9,IEN,3.5)
445
446 ;"2 STRENGTH [Fa]
447 ;" e.g. STRENGTH: 240
448 set TMGFDA(50.68,IENS,2)=$$GET1^DIQ(22706.9,IEN,1)
449
450 ;"3 UNITS <-Pntr [P50.607'a]
451 ;" e.g. UNITS: MG
452 new tempUnits set tempUnits=$$GET1^DIQ(22706.9,IEN,2)
453 if tempUnits'="" do
454 . do EnsureUnits(tempUnits)
455 . set TMGFDA(50.68,IENS,3)=tempUnits
456
457 ;"5 VA PRINT NAME [Fa]
458 ;" e.g. VA PRINT NAME: DILTIAZEM (CARDIZEM CD) 240MG SA CAP
459 ;"set tempS=$$MakeName(IEN,40,AllowCut)
460 ;"if tempS="^" set result=0 goto A2VPDone
461 set tempS=$piece($get(^TMG(22706.9,IEN,7)),"^",3) ;"7;3 = .055 TRADEBANE - 40
462 set TMGFDA(50.68,IENS,5)=tempS ;" 5=VA PRINT NAME
463
464 ;"6 VA PRODUCT IDENTIFIER [Fa] <--- will use to store "0;TMG"
465 ;" e.g. VA PRODUCT IDENTIFIER: D0230
466 set TMGFDA(50.68,IENS,6)="0;TMG"
467
468 ;"14 ACTIVE INGREDIENTS W:^ D:^ <-Mult [50.6814P]
469 ;"(multiple/subfile, add after this record added)
470
471 ;"15 PRIMARY VA DRUG CLASS <-Pntr [P50.605'a]
472 ;" e.g. PRIMARY VA DRUG CLASS: CV200
473 set TMGFDA(50.68,IENS,15)=$$GET1^DIQ(22706.9,IEN,.09)
474
475 quit
476
477
478EnsureIngredients(fdaIEN,vapIEN)
479 ;"Purpose: to ensure that all the ingredients from the FDA record (22706.9) are in the
480 ;" VA PRODUCT record (50.68)
481 ;"Input: fdaIEN -- the IEN from 22706.9
482 ;" vapIEN -- the target IEN in 50.68
483 ;"result: 1= OK to continue, 0=error
484
485 new result set result=1 ;"default to success
486 new recNum set recNum=1
487 ;"new IENS set IENS=fdaIEN_","
488 new IENS set IENS=vapIEN_","
489 new TMGFDA,TMGMSG,TMGIEN
490
491 new subIEN set subIEN=0 ;"INGREDIENTS
492 for set subIEN=+$order(^TMG(22706.9,fdaIEN,4,subIEN)) quit:(+subIEN'>0) do
493 . new node set node=$get(^TMG(22706.9,fdaIEN,4,subIEN,0))
494 . new pIngredients,strength,units
495 . set pIngredients=$piece(node,"^",3) ;"INGREDIENTS (a POINTER)
496 . set strength=$piece(node,"^",4) ;"STRENGTH
497 . set units=$piece(node,"^",6) ;"UNITS
498 . ;"First search to ensure ingredient is not already present.
499 . new subIEN2 set subIEN2=0
500 . new found set found=0
501 . for set subIEN2=$order(^PSNDF(50.68,vapIEN,2,subIEN2)) quit:(+subIEN2'>0)!found do
502 . . new ptr set ptr=$piece($get(^PSNDF(50.68,vapIEN,2,subIEN2,0)),"^",1)
503 . . if ptr=pIngredients set found=1
504 . if found=1 quit
505 . if pIngredients="" do quit
506 . . write !,"Ingredient entry is missing actual ingredient, so that subpart was DELETED.",!
507 . . new TMGFDA,TMGMSG
508 . . set TMGFDA(22706.916,subIEN_","_fdaIEN_",",.01)="@" ;"delete entry.
509 . . do FILE^DIE("E","TMGFDA","TMGMSG")
510 . . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
511 . set TMGFDA(50.6814,"+"_recNum_","_IENS,.01)=pIngredients
512 . if strength'="" set TMGFDA(50.6814,"+"_recNum_","_IENS,1)=strength
513 . if units'="" set TMGFDA(50.6814,"+"_recNum_","_IENS,2)=units
514 . set recNum=recNum+1
515
516 if $data(TMGFDA)=0 goto EIDone
517 do UPDATE^DIE("S","TMGFDA","TMGIEN","TMGMSG")
518 if $data(TMGMSG("DIERR")) do goto A2VPDone
519 . set result=0 if $get(Quiet)=1 quit
520 . write !,"Error adding ingredients subrecord. IEN in 22706.9=",fdaIEN,!
521 . new PriorErrorFound
522 . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
523EIDone
524 quit result
525
526
527EnsureNDC(IEN)
528 ;"Purpose: Ensure record exists in NDC/UPN file (50.67).
529 ;"Input: IEN -- IEN from file 22706.9 (TMG FDA IMPORT COMPILED) to add from
530 ;"Output: An entry to be added to file 50.67
531 ;"Result: 1=OK to continue, 0 if error
532
533 ;"Make record in NDC/UPN file (50.67).
534 ;"File: NDC/UPN Branch: 1
535 ;"REF NODE;PIECE FLD NUM FIELD NAME
536 ;"===============================================================================
537 ;" 1 0;1 .01 SEQUENCE NUMBER [RNJ9,0aX]
538 ;" 2 0;2 1 NDC [Fa]
539 ;" 3 0;3 2 UPN [Fa]
540 ;" 4 0;4 3 MANUFACTURER <-Pntr [P55.95'a]
541 ;" 5 0;5 4 TRADE NAME [Fa]
542 ;" 6 0;6 5 VA PRODUCT NAME <-Pntr [P50.68'a]
543 ;" 1;0 6 ROUTE OF ADMINISTRATION W:^ D:^ <-Mult [50.676A]
544 ;" 7 -0;1 .01 -ROUTE OF ADMINISTRATION [FaX]
545 ;" 8 0;7 7 INACTIVATION DATE [Da]
546 ;" 9 0;8 8 PACKAGE SIZE <-Pntr [P50.609'a]
547 ;" 10 0;9 9 PACKAGE TYPE <-Pntr [P50.608'a]
548 ;" 11 0;10 10 OTX/RX INDICATOR [Sa]
549 ;" 2;0 11 PREVIOUS NDC W:^ D:^ <-Mult [50.6711A]
550 ;" 12 -0;1 .01 -PREVIOUS NDC [Fa]
551 ;" 3;0 12 PREVIOUS UPN W:^ D:^ <-Mult [50.6712A]
552 ;" 13 -0;1 .01 -PREVIOUS UPN [Fa]
553 ;" <> <> <>
554
555 new result set result=0 ;" default to failure
556
557 new TMGFDA,TMGMSG,TMGIEN
558
559 new NDC set NDC=$piece($get(^TMG(22706.9,IEN,1)),"^",2) ;"1;2= field 5, NDC 12 digit
560 new ndcIEN set ndcIEN=$order(^PSNDF(50.67,"NDC",NDC,""))
561 if +ndcIEN>0 set IENS=ndcIEN_"," goto EN1
562
563 ;"Below is for NEW records. DINUM at play here...
564 new newIEN set newIEN=""
565 for set newIEN=$order(^PSNDF(50.67,newIEN),-1) quit:(+newIEN=newIEN)!(newIEN="")
566 if +newIEN=0 do write "Unable to create NDF entry for ",IEN,! goto ENDone
567 set newIEN=newIEN+1
568 set TMGFDA(50.67,IENS,.01)=newIEN ;" .01 SEQUENCE NUMBER
569 set IENS="+1,"
570
571EN1 if NDC'="" set TMGFDA(50.67,IENS,1)=NDC ;"1=NDC
572
573 ;"**Must add manufacturer if to be used!
574 ;" 3 MANUFACTURER <-Pntr [P55.95'a]
575 ;"new Firm set Firm=$get(DrugInfo("FIRM","NAME"))
576 ;"if Firm'="" set TMGFDA(50.67,IENS,3)=Firm
577
578 new tName set tName=$piece($get(^TMG(22706.9,IEN,7)),"^",3) ;"7;3 = TRADE NAME - 40
579 if tName'="" set TMGFDA(50.67,IENS,4)=tName ;" 4 TRADE NAME
580
581 new vapIEN set vapIEN=+$piece($get(^TMG(22706.9,IEN,6)),"^",2) ;"6;2=field 5.5, VA PRODUCT LINK
582 if vapIEN>0 set TMGFDA(50.67,IENS,5)=vapIEN;" 5 VA PRODUCT NAME --pointer to newly added 50.68 record
583
584 ;" 10 OTX/RX INDICATOR
585 new codeOTC set codeOTC=$piece($get(^TMG(22706.9,IEN,7)),"^",5) ;"7;5= field 7, RX or OTC
586 if codeOTC'="" set TMGFDA(50.67,IENS,10)=codeOTC
587
588 ;"If I decide to add this, must do it after adding parent record.
589 ;" 1;0 6 ROUTE OF ADMINISTRATION W:^ D:^ <-Mult [50.676A]
590 ;" 7 -0;1 .01 -ROUTE OF ADMINISTRATION [FaX]
591
592 if IENS'["+" do goto EN2 ;"update existing record
593 . new temp set temp=$$TrimFDA^TMGDBAPI(.TMGFDA)
594 . if $data(TMGFDA)=0 quit
595 . do FILE^DIE("K","TMGFDA","TMGMSG") ;"FDA is in INTERNAL format
596
597 else do ;"add new record
598 . do UPDATE^DIE("","TMGFDA","TMGIEN","TMGMSG")
599EN2
600 if $data(TMGMSG("DIERR")) do goto ENDone
601 . set result=0
602 . new PriorErrorFound
603 . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
604
605 set result=1 ;"ensure we are at success.
606
607ENDone
608 quit result
609
610
611 ;"==========================================================
612 ;"==========================================================
613EnsureUnits(UnitS)
614 ;"Purpose: to ensure that the UnitS is valid in file 50.607
615 ;"Input: UnitS -- the string such as "mg;mg"
616 ;"Output: If UnitS is not found in 50.607, then it will be added
617 ;"Results: none
618
619 new TMGROOT,TMGMSG
620
621 ;"Finish later...
622
623 ;"do FIND^DIC(50.607,"","","",UnitS,"*",,,,"TMGROOT","TMGMSG")
624 ;"if +$get(TMGROOT("DILIST",0))=1 goto EUDone
625 ;"goto EUDone
626
627 ;"Note: if there are duplicate entries (i.e. 2 entries for MG/0.5ML), then Y=-1
628 new X,Y,DIC
629 set DIC=50.607
630 set DIC(0)="XML"
631 set X=UnitS
632 do ^DIC
633 if +Y'>0 do
634 . if $get(Quiet)=1 quit
635 . write !,"Can't find or add: ",UnitS,!
636
637EUDone
638 quit
639
640Unlock50dot607
641 ;"Purpose to allow deletion in file 50.607
642
643 kill ^DD(50.607,.01,8.5)
644 kill ^DD(50.607,.01,9)
645
646 quit
647
648Lock50dot607
649 ;"Purpose: to restore lock on file 50.607
650
651 set ^DD(50.607,.01,8.5)="^"
652 set ^DD(50.607,.01,9)="^"
653
654 quit
655
656Link2VAP
657 ;"Purpose: to fill file 22706.9, field 5.5 in with link to a record
658 ;" in VA PRODUCT file (50.68) that has the SAME national drug
659 ;" code (NDC). It checks for and handles situations where there
660 ;" are multiple entries in 50.68 with the same NDC. It picks
661 ;" the entry with the closest name as the one to use.
662 ;" --It also removes such a link from the VA PRODUCT SIMILAR MATCHES
663 ;" field. I.e. it is not a 'similar' match if it is an exact match.
664 ;" --It also removes such a link from the VA PRODUCT POSSIBLE MATCHES
665 ;" field. I.e. it is not a 'possible' match if it is an exact match.
666 ;"Results: none.
667
668 ;"new pNDCIndex
669 ;"set pNDCIndex=$name(^TMG("TMP","INDEX NDC-->VAP"))
670 set pNDCIndex=$name(^PSNDF(50.67,"NDC"))
671
672 new Itr,IEN,success
673 new abort set abort=0
674 new modCount set modCount=0
675 set IEN=$$ItrInit^TMGITR(22706.9,.Itr)
676 do PrepProgress^TMGITR(.Itr,20,0,"IEN")
677 if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort
678 . if $$UserAborted^TMGUSRIF set abort=1 quit
679 . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;"1=SKIP THIS RECORD
680 . new NDC set NDC=$piece($get(^TMG(22706.9,IEN,1)),"^",2)
681 . if NDC="" quit ;"Can't link if no NDC. Fix later?
682 . new count set count=$$ListCt^TMGMISC($name(@pNDCIndex@(NDC)))
683 . new VAP set VAP=0
684 . if count=1 do
685 . . new ndcP1
686 . . set ndcP1=+$order(@pNDCIndex@(NDC,""))
687 . . set VAP=+$piece($get(^PSNDF(50.67,ndcP1,0)),"^",6)
688 . else do
689 . . new vap1,s1,fdaS,ndcP1
690 . . new bestScore set bestScore=0
691 . . new bestVAP set bestVAP=0
692 . . new bestS set bestS=""
693 . . set fdaS=$piece($get(^TMG(22706.9,IEN,0)),"^",4) ;"TradeName, field .05
694 . . set ndcP1=+$order(@pNDCIndex@(NDC,""))
695 . . for do set ndcP1=+$order(@pNDCIndex@(NDC,ndcP1)) quit:(+ndcP1'>0)
696 . . . set vap1=+$piece($get(^PSNDF(50.67,ndcP1,0)),"^",6)
697 . . . set s1=$piece($get(^PSNDF(50.68,vap1,0)),"^",1)
698 . . . new tempScore set tempScore=$$Comp2Strs^TMGSTUTL(fdaS,s1)
699 . . . if tempScore>bestScore set bestScore=tempScore,bestVAP=vap1,bestS=s1
700 . . if bestScore'>1 set bestVAP=0
701 . . set VAP=bestVAP
702 . if VAP=0 quit
703 . if $piece($get(^TMG(22706.9,IEN,6)),"^",2)'=VAP do
704 . . new TMGFDA,TMGMSG
705 . . set TMGFDA(22706.9,IEN_",",5.5)=VAP
706 . . do FILE^DIE("K","TMGFDA","TMGMSG")
707 . . do ShowIfDIERR^TMGDEBUG("TMGMSG")
708 . . set modCount=modCount+1
709 . new subIEN set subIEN=0
710 . for set subIEN=$order(^TMG(22706.9,IEN,2,subIEN)) quit:(+subIEN'>0) do
711 . . new nearVAP set nearVAP=$piece($get(^TMG(22706.9,IEN,2,subIEN,0)),"^",1)
712 . . if nearVAP'=VAP quit
713 . . ;"write "SIMILAR MATCH contains this link. Deleting...",!
714 . . new TMGFDA,TMGMSG
715 . . set TMGFDA(22706.914,subIEN_","_IEN_",",.01)="@"
716 . . do FILE^DIE("K","TMGFDA","TMGMSG")
717 . . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
718 . . set modCount=modCount+1
719 . for set subIEN=$order(^TMG(22706.9,IEN,3,subIEN)) quit:(+subIEN'>0) do
720 . . new nearVAP set nearVAP=$piece($get(^TMG(22706.9,IEN,3,subIEN,0)),"^",1)
721 . . if nearVAP'=VAP quit
722 . . ;"write "POSS SIMILAR MATCH contains this link. Deleting...",!
723 . . new TMGFDA,TMGMSG
724 . . set TMGFDA(22706.915,subIEN_","_IEN_",",.01)="@"
725 . . do FILE^DIE("K","TMGFDA","TMGMSG")
726 . . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
727 . . set modCount=modCount+1
728 do ProgressDone^TMGITR(.Itr)
729
730 write modCount," modifications made.",!
731 do PressToCont^TMGUSRIF
732 quit
733
Note: See TracBrowser for help on using the repository browser.