source: cprs/branches/tmg-cprs/m_files/TMGNDF2E.m@ 1085

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

Initial upload

File size: 17.0 KB
Line 
1TMGNDF2E ;TMG/kst/FDA Import: Fix ingredients IEN linkages ;03/25/06
2 ;;1.0;TMG-LIB;**1**;11/21/06
3
4 ;" FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS
5 ;" Further processing, after functions in TMGNDF2D
6 ;" Fixing ingredients IEN linkages
7 ;"Kevin Toppenberg MD
8 ;"GNU General Public License (GPL) applies
9 ;"11-21-2006
10
11 ;"=======================================================================
12 ;" API -- Public Functions.
13 ;"=======================================================================
14 ;"Menu
15 ;"=======================================================================
16 ;"FixMissing -- Find and fix missing ingredient IEN's in TMG FDA IMPORT COMPILED
17
18 ;"=======================================================================
19 ;" Private Functions.
20 ;"=======================================================================
21 ;"FindMissing(Array)
22 ;"EasyFix(Array) ;handle the easy fixes from Array (created by FindMissing)
23 ;"HardFix(Array) ;handle the more difficult fixes from Array (created by FindMissing)
24 ;"GetRxIEN(RxName,pDrugInfo) ;get the IEN of the given drug name
25
26 ;"BatchNDCFix -- Scan TMG FDA IMPORT COMPILED file, and fix NDC codes
27 ;"NewNDC(NDC) -- convert an NDC code with invalid formatting into one acceptible to VistA
28
29
30 ;"=======================================================================
31 ;"=======================================================================
32
33 ;"Notes: I have discovered, when I went to actually add entries from
34 ;" TMG NDF IMPORT COMPILED into VA PRODUCT, that many of the ingredients
35 ;" did not have appropriate links to a VA drug. I am not sure how this
36 ;" happened. Perhaps the drugs had not been added at the time that the
37 ;" compiled entry was create? Perhaps it was drug ingredient that I
38 ;" chose to skip? Anyway, the purpose of this code is to fix this problem.
39 ;" And since I don't know at which step the problem occured, and I am
40 ;" unwilling to put the HOURS of classification work in again if I were
41 ;" to start over, I will just fix the problem at this step of the process.
42
43 ;"=======================================================================
44
45Menu
46 ;"Purpose: Provide menu to entry points of main routines
47
48 set XUMF=1 ;"secret programmer's key
49 do Unlock50d416
50 new Menu,UsrSlct
51 set Menu(0)="Pick Option for Fixing Missing Ingredients (2E)"
52 set Menu(1)="Fix UNMATCHED ingredients in import."_$char(9)_"FixMissing"
53 set Menu(2)="Fix MISSING ingredients in import."_$char(9)_"FixMissing2"
54 set Menu("P")="Prev Stage"_$char(9)_"Prev"
55 set Menu("N")="Next Stage"_$char(9)_"Next"
56
57MC1 write #
58 set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^")
59 if UsrSlct="^" goto MCDone
60 if UsrSlct=0 set UsrSlct=""
61
62 if UsrSlct="FixMissing" do FixMissing goto MC1
63 if UsrSlct="FixMissing2" do FixMissing^TMGNDF2F goto MC1
64 if UsrSlct="Prev" goto Menu^TMGNDF2C ;"quit can occur from there...
65 if UsrSlct="Next" goto Menu^TMGNDF2G ;"quit can occur from there...
66 goto MC1
67
68MCDone
69 do Lock50d416
70 quit
71
72
73
74FixMissing
75 ;"Purpose: To find and fix missing ingredient IEN's in TMG FDA IMPORT COMPILED
76
77 new Array
78 write "Gathering missing ingredient link entries...",!
79 do FindMissing(.Array)
80 if $data(Array)=0 do goto FMDone
81 . write !,"No missing entries. Great!",!
82 write "Fixing easy problems...",!
83 do EasyFix(.Array)
84 write "Now to fix the more difficult problems...",!
85 do HardFix(.Array)
86
87FMDone
88 write "Done. Goodbye...",!
89 do PressToCont^TMGUSRIF
90 quit
91
92
93
94FindMissing(Array)
95 ;"Purpose: to scan TMG FDA IMPORT COMPILED and find ingredients that
96 ;" don't have a linkage to a VA drug.
97 ;"Input: Array -- PASS BY REFERENCE, it is an OUT PARAMETER. Format below
98 ;" prior entries in array are NOT KILLED.
99 ;"Output: Array is filled as follows:
100 ;" Array(IEN,subIEN)=UnmatchedIngredientName
101 ;" Array(IEN,subIEN,"FILE 50.416 IEN")=IEN
102 ;" Array(IEN,subIEN)=UnmatchedIngredientName
103 ;" Array(IEN,subIEN,"FILE 50.416 IEN")=IEN
104 ;"Results: none.
105
106 new Itr,IEN
107 set IEN=$$ItrInit^TMGITR(22706.9,.Itr)
108 do PrepProgress^TMGITR(.Itr,20,0,"IEN")
109 if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)
110 . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;" 1=SKIP
111 . new subIEN set subIEN=0
112 . for set subIEN=+$order(^TMG(22706.9,IEN,4,subIEN)) quit:(+subIEN'>0) do
113 . . new node set node=$get(^TMG(22706.9,IEN,4,subIEN,0))
114 . . new ingredients set ingredients=$piece(node,"^",3) ;"INGREDIENTS
115 . . if ingredients="" do
116 . . . new FDAitemNum
117 . . . set FDAitemNum=$piece($get(^TMG(22706.9,IEN,0)),"^",1)
118 . . . new DrugInfo
119 . . . new result
120 . . . set result=$$GetDrugInfo^TMGNDF1A(FDAitemNum,.DrugInfo,"",1)
121 . . . if result=0 do quit
122 . . . . write "Unable to get drug info for entry: ",FDAitemNum,!
123 . . . new ingrName,ingrIEN
124 . . . set ingrName=$get(DrugInfo("FORMULATION",subIEN,"INGREDIENT NAME"))
125 . . . set ingrIEN=$get(DrugInfo("FORMULATION",subIEN,"INGREDIENT NAME","FILE 50.416 IEN"))
126 . . . set Array(IEN,subIEN)=ingrName
127 . . . set Array(IEN,subIEN,"FILE 50.416 IEN")=ingrIEN
128 . . . merge Array(IEN,subIEN,"INFO")=DrugInfo
129 do ProgressDone^TMGITR(.Itr)
130
131 quit
132
133
134EasyFix(Array)
135 ;"Purpose: to handle the easy fixes from Array (created by FindMissing)
136 ;"Input: Array -- array as cread by FindMissing()
137 ;" Array(IEN,subIEN)=UnmatchedIngredientName
138 ;" Array(IEN,subIEN,"FILE 50.416 IEN")=IEN
139 ;" Array(IEN,subIEN)=UnmatchedIngredientName
140 ;" Array(IEN,subIEN,"FILE 50.416 IEN")=IEN
141 ;"Output: Missing information will be stuffed into records
142
143 new IEN,subIEN
144 set IEN=$order(Array(""))
145 if IEN'="" for do quit:IEN=""
146 . set subIEN=$order(Array(IEN,""))
147 . if subIEN'="" for do quit:subIEN=""
148 . . new RxIEN set RxIEN=$get(Array(IEN,subIEN,"FILE 50.416 IEN"))
149 . . if RxIEN'="" do
150 . . . set $piece(^TMG(22706.9,IEN,4,subIEN,0),"^",3)=RxIEN
151 . . set subIEN=$order(Array(IEN,subIEN))
152 . set IEN=$order(Array(IEN))
153
154 quit
155
156
157HardFix(Array)
158 ;"Purpose: to handle the more difficult fixes from Array (created by FindMissing)
159 ;"Input: Array -- array as cread by FindMissing()
160 ;" Array(IEN,subIEN)=UnmatchedIngredientName
161 ;" Array(IEN,subIEN,"FILE 50.416 IEN")=IEN
162 ;" Array(IEN,subIEN)=UnmatchedIngredientName
163 ;" Array(IEN,subIEN,"FILE 50.416 IEN")=IEN
164 ;"Output: Missing information will be stuffed into records
165
166 write !,$$ListCt^TMGMISC("Array")," items to fix.",!
167 new IEN,subIEN,PriorAnswer
168 new abort set abort=0
169 set IEN=$order(Array(""))
170 if IEN'="" for do quit:(IEN="")!(abort=1)
171 . set subIEN=$order(Array(IEN,""))
172 . if subIEN'="" for do quit:(subIEN="")!(abort=1)
173 . . new RxName,RxIEN
174 . . set RxName=$get(Array(IEN,subIEN))
175 . . set RxIEN=+$get(PriorAnswer(RxName))
176 . . if (RxIEN=0)!(RxIEN=-1) do
177 . . . set RxIEN=$$LookupRx^TMGNDF0C(RxName)
178 . . . set PriorAnswer(RxName)=RxIEN
179 . . . if RxIEN=-1 do
180 . . . . set RxIEN=$$GetRxIEN(RxName,$name(Array(IEN,subIEN,"INFO")))
181 . . . . set PriorAnswer(RxName)=RxIEN
182 . . if +RxIEN>0 do
183 . . . new TMGFDA,TMGMSG
184 . . . set TMGFDA(22706.916,subIEN_","_IEN_",",2)=+RxIEN
185 . . . do FILE^DIE("K","TMGFDA","TMGMSG")
186 . . . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
187 . . if RxIEN=-3 set abort=1 quit
188 . . if RxIEN=-2 do
189 . . . set $piece(^TMG(22706.9,IEN,1),"^",4)=1 ;"1=SKIP
190 . . set subIEN=$order(Array(IEN,subIEN))
191 . set IEN=$order(Array(IEN))
192
193 quit
194
195GetRxIEN(RxName,pDrugInfo)
196 ;"Purpose: To get the IEN of the given drug name
197 ;"Input: RxName -- the name of the drug to find.
198 ;" pDrugInfo -- NAME OF array containing drug info (as created by GetDrugInfo^TMGNDF1A
199 ;"Result: IEN of drug found, or 0 if not found,
200 ;" -2 if drug should be excluded from addition to VA PRODUCT file.
201 ;" -3 if abort requested
202
203 new result set result=0
204 new DrugInfo merge DrugInfo=@pDrugInfo
205 new Menu,UsrSlct
206
207 set Menu(1)="Manual lookup"_$char(9)_"1"
208 set Menu(2)="Show info of drug containing this ingredient"_$char(9)_"2"
209 set Menu(3)="Set drug containing this ingredient to NOT BE ADDED to the VA PRODUCT file"_$char(9)_"3"
210 set Menu(4)="NEXT"_$char(9)_"0"
211GRLoop
212 set Menu(0)="Can't find a ingredient match for: "_RxName
213 write #
214 set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^")
215 if UsrSlct="^" goto MCDone
216 if UsrSlct=0 set UsrSlct=""
217
218 if UsrSlct="" set temp="0"
219 if UsrSlct="^" set result=-3 goto GRDone
220 if UsrSlct=0 goto GRDone
221 if UsrSlct=1 do goto:(result>0) GRDone
222 . new DIC,Y
223 . set DIC=50.416
224 . set DIC(0)="AEQML"
225 . do ^DIC
226 . if +Y>0 set result=+Y
227 if UsrSlct=2 do goto GRLoop
228 . do FormatDrug^TMGND2A(.DrugInfo)
229 if UsrSlct=3 do goto GRDone
230 . set result=-2
231 goto GRLoop
232GRDone
233 quit result
234
235Unlock50d416
236 set XUMF=1
237 set PSNDF=1
238 quit
239
240Lock50d416
241 kill XUMF,PSNDF
242 quit
243
244 ;"=======================================================================
245 ;"Code for Fixing NDC's
246 ;"=======================================================================
247 ;"Note: The NDC's given by the FDA database are not always acceptible by the
248 ;" VistA input transform, because they include *'s. The FDA explains
249 ;" this as follows:
250 ;" Here is the official info from fda.gov on NDC codes:
251 ;"
252 ;" NDC Number
253 ;"
254 ;" Each listed drug product listed is assigned a unique 10-digit, 3-segment
255 ;" number. This number, known as the NDC, identifies the labeler, product, and
256 ;" trade package size. The first segment, the labeler code, is assigned by the
257 ;" FDA. A labeler is any firm that manufactures (including repackers or
258 ;" relabelers), or distributes (under its own name) the drug. The second
259 ;" segment, the product code, identifies a specific strength, dosage form, and
260 ;" formulation for a particular firm. The third segment, the package code,
261 ;" identifies package sizes and types. Both the product and package codes are
262 ;" assigned by the firm. The NDC will be in one of the following
263 ;" configurations: 4-4-2, 5-3-2, or 5-4-1.
264 ;"
265 ;" An asterisk may appear in either a product code or a package code. It
266 ;" simply acts as a place holder and indicates the configuration of the NDC.
267 ;" Since the NDC is limited to 10 digits, a firm with a 5 digit labeler code
268 ;" must choose between a 3 digit product code and 2 digit package code, or a 4
269 ;" digit product code and 1 digit package code.
270 ;"
271 ;" Thus, you have either a 5-4-1 or a 5-3-2 configuration for the three
272 ;" segments of the NDC. Because of a conflict with the HIPAA standard of an 11
273 ;" digit NDC, many programs will pad the product code or package code segments
274 ;" of the NDC with a leading zero instead of the asterisk.
275 ;"
276 ;" kt note: I.e. the problem is how to convert 10 digits --> 11 digits.
277 ;" where to put the extra digit?
278 ;"
279 ;" Since a zero can be a valid digit in the NDC, this can lead to confusion
280 ;" when trying to reconstitute the NDC back to its FDA standard. Example:
281 ;" 12345-0678-09 (11 digits) could be 12345-678-09 or 12345-678-90 depending on
282 ;" the firm's configuration.
283 ;"
284 ;" kt note: I think the example is wrong. It should be:
285 ;" Example:
286 ;" 12345-0678-09 (11 digits) could be 12345-678-09 (i.e. 5-3-2)
287 ;" or 12345-0678-9 (5-4-1) depending on the firm's configuration.
288
289 ;" By storing the segments as character data and
290 ;" using the * as place holders we eliminate the confusion. In the example, FDA
291 ;" stores the segments as 12345-*678-09 for a 5-3-2 configuration or
292 ;" 12345-0678-*9 for a 5-4-1
293 ;"
294 ;"
295
296BatchNDCFix
297 ;"Purpose: Scan TMG FDA IMPORT COMPILED file, and fix NDC codes
298 ;"Output: data in file will be changed, NDC and NDC-12-digit fields will be altered.
299
300 new IEN
301 set IEN=$order(^TMG(22706.9,0))
302 if +IEN>0 for do quit:(+IEN'>0)
303 . new node set node=$get(^TMG(22706.9,IEN,1))
304 . new NDC,newNDC
305 . set NDC=$piece(node,"^",1)
306 . set newNDC=$$NewNDC(NDC)
307 . new digits12NDC set digits12NDC=$translate(newNDC,"-","")
308 . new d1
309 . if '$$IsNumeric^TMGMISC(digits12NDC) do
310 . . new name set name=$piece(^TMG(22706.9,IEN,0),"^",4)
311 . . write IEN,". NDC=",NDC," ",name,!
312 . if newNDC'=NDC do
313 . . write IEN,". ",NDC," needs --> ",newNDC,!
314 . . if $length(digits12NDC)<12 do
315 . . . set digits12NDC=$extract("000000",1,12-$length(digits12NDC))_digits12NDC
316BLabel . . new TMGFDA,TMGIEN,TMGMSG
317 . . set TMGFDA(22706.9,IEN_",",4)=newNDC
318 . . set TMGFDA(22706.9,IEN_",",5)=digits12NDC
319 . . do UPDATE^DIE("S","TMGFDA","TMGIEN","TMGMSG")
320 . . if $data(TMGMSG("DIERR")) do
321 . . . set result=0
322 . . . if $get(Quiet)=1 quit
323 . . . new PriorErrorFound
324 . . . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
325 . set IEN=$order(^TMG(22706.9,IEN))
326
327 quit
328
329NewNDC(NDC)
330 ;"Purpose: convert an NDC code with invalid formatting into one acceptible to VistA
331 ;"Input: NDC -- the NDC as provided by FDA, with hyphens ('-'s)
332 ;"Output: the correctly formatted NDC, or "" if not valid conversion possible.
333
334 ;"Examples of conversions:
335 ;" 12345-*678-09 --> 12345-678-09 (5-3-2 digits)
336 ;" 12345-0678-*9 --> 12345-0678-9 (5-4-1 digits)
337
338 ;"Sometimes there are two *'s (i.e. **) (always in the LAST grouping -- the package code
339 ;"Here is some examples of how I will convert them:
340 ;" 057587-*022-** (6-4-2) --> 57587-022-00 (5-3-2)
341 ;" 053360-4189-** (6-4-2) --> 53360-4189-0 (5-4-1)
342 ;" 000034-1025-** (6-4-2) --> 00034-1025-0 (5-4-1)
343 ;" 046672-*122-** (6-4-2) --> 46672-122-00 (5-3-2)
344
345 ;"Also, sometimes the FDA database did not include values for codes.
346 ;"Initially, I converted these to ????'s
347 ;"Now, that won't be acceptible to VistA, so I will convert these to 0's
348 ;"e.g. 000034-????-56 --> 000034-0000-56
349
350 new result,valid,digits
351
352 ;"Setup check for valid digits combo. Allowed combos are:
353 ;" 4-4-2, 5-3-2, 5-4-1, 5-4-2, or 6-4-2
354 set digits("VALID",4,4,2)=1 ;"total of 10 digits
355 set digits("VALID",5,3,2)=1 ;"total of 10 digits
356 set digits("VALID",5,4,1)=1 ;"total of 10 digits
357 set digits("VALID",5,4,2)=1 ;"total of 11 digits
358 set digits("VALID",6,4,2)=1 ;"total of 12 digits
359 ;"set digits("VALID",6,3,1)=1 ;"total of 10 digits
360
361 ;"Remove single *'s
362 set result=$$Substitute^TMGSTUTL(NDC,"**","##") ;"protect double **'s
363 ;" 010130-*124-*1 --> 010130-*124-01
364 if ($piece(result,"-",2)["*")&($piece(result,"-",3)["*") do
365 . set $piece(result,"-",3)=$translate($piece(result,"-",3),"*","0")
366 ;" 010130-*124-01 --> 010130-124-01
367 set result=$translate(result,"*","")
368
369 set result=$$Substitute^TMGSTUTL(result,"##","**")
370
371 ;"Change ?'s into 0's
372 if $length($piece(result,"-",2))=4 do
373 . if $piece(result,"-",3)="??" set $piece(result,"-",3)="0"
374 set result=$translate(result,"?","0")
375
376NNDCL1
377 set digits(1)=$length($piece(result,"-",1))
378 set digits(2)=$length($piece(result,"-",2))
379 set digits(3)=$length($piece(result,"-",3))
380
381 if result["**" do
382 . if digits(2)=3 set result=$$Substitute^TMGSTUTL(result,"**","00")
383 . else if digits(2)=4 set result=$$Substitute^TMGSTUTL(result,"**","0")
384 . else do
385 . . write "Error converting NDC code: ",NDC,!
386 . . set result="",digits(1)=-1
387 . set digits(3)=$length($extract(result,"-",3))
388
389 ;"convert 12345-123-x --> 12345-123-0x
390 if (digits(1)=5)&(digits(2)=3)&(digits(3)=1) do goto NNDCL1
391 . new value set value=+$piece(result,"-",3)
392 . set $piece(result,"-",3)="0"_value
393
394 set digits=digits(1)+digits(2)+digits(3)
395 set valid=+$get(digits("VALID",digits(1),digits(2),digits(3)))
396
397 if (valid'=1)&(digits(1)=6)&($extract(result,1,1)="0") do goto NNDCL1
398 . set result=$extract(result,2,99)
399
400 if valid'=1 set result=""
401
402 quit result
403
Note: See TracBrowser for help on using the repository browser.