1 | TMGNDF2B ;TMG/kst/FDA Import: Ensure DRUG INGREDIENTS ;03/25/06
|
---|
2 | ;;1.0;TMG-LIB;**1**;11/21/06
|
---|
3 |
|
---|
4 | ;" FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS
|
---|
5 | ;" -- FILLING DRUG INGREDIENTS FILE WITH NEW VALUES
|
---|
6 | ;"Kevin Toppenberg MD
|
---|
7 | ;"GNU General Public License (GPL) applies
|
---|
8 | ;"11-21-2006
|
---|
9 |
|
---|
10 | ;"=======================================================================
|
---|
11 | ;" API -- Public Functions.
|
---|
12 | ;"=======================================================================
|
---|
13 | ;"Menu -- Provide menu to entry points of main routines
|
---|
14 | ;"=======================================================================
|
---|
15 | ;"CheckIngredients -- To cycle through ingredients and ensure that there is an extry in the
|
---|
16 | ;" DRUG INGREDIENTS file. This has to be an interactive process.
|
---|
17 |
|
---|
18 | ;"=======================================================================
|
---|
19 | ;" Private Functions.
|
---|
20 | ;"=======================================================================
|
---|
21 | ;"ShowInstructions
|
---|
22 | ;"LookupRx(ingredient)
|
---|
23 | ;"ShowMatches(Array,max,Label)
|
---|
24 | ;"AddRangeMatch(ScanArray,Label,StartN,EndN)
|
---|
25 | ;"AddMatch(ScanArray,Label,number)
|
---|
26 | ;"ULRangeMatch(ScanArray,StartN,EndN)
|
---|
27 | ;"ULMatch(ScanArray,number)
|
---|
28 | ;"AddOneIngredient(Name)
|
---|
29 | ;"FindIgdMatch(Name,Interactive)
|
---|
30 | ;"DoAddIgd(Name,ParentIEN)
|
---|
31 |
|
---|
32 | ;"=======================================================================
|
---|
33 | ;"=======================================================================
|
---|
34 | Menu
|
---|
35 | ;"Purpose: Provide menu to entry points of main routines
|
---|
36 |
|
---|
37 | new Menu,UsrSlct
|
---|
38 | set Menu(0)="Pick Option for Checking Import Ingredients (0C)"
|
---|
39 | set Menu(1)="Check for NEW ingredients to ADD."_$char(9)_"CheckIngredients"
|
---|
40 | set Menu("P")="Prev Stage"_$char(9)_"Prev"
|
---|
41 | set Menu("N")="Next Stage"_$char(9)_"Next"
|
---|
42 |
|
---|
43 | MC1 write #
|
---|
44 | set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^")
|
---|
45 | if UsrSlct="^" goto MCDone
|
---|
46 | if UsrSlct=0 set UsrSlct=""
|
---|
47 |
|
---|
48 | if UsrSlct="CheckIngredients" do CheckIngredients goto MC1
|
---|
49 | if UsrSlct="Prev" goto Menu^TMGNDF0B ;"quit can occur from there...
|
---|
50 | if UsrSlct="Next" goto Menu^TMGNDF1A ;"quit can occur from there...
|
---|
51 | goto MC1
|
---|
52 |
|
---|
53 | MCDone
|
---|
54 | quit
|
---|
55 |
|
---|
56 |
|
---|
57 | CheckIngredients
|
---|
58 | ;"Purpose: To cycle through ingredients and ensure that there is an extry in the
|
---|
59 | ;" DRUG INGREDIENTS file. This has to be an interactive process.
|
---|
60 | ;"Input: none
|
---|
61 | ;"Results: none
|
---|
62 | ;"Note: if record in 22706.9 (TMG FDA IMPORT COMPILED) for a given listing
|
---|
63 | ;" has been marked for SKIPPING, or DONE ADDING, then listing will be skipped.
|
---|
64 |
|
---|
65 | new Answers,index,ingredient
|
---|
66 | write "Collecting list of INGREDIENTS that need to be added to database...",!
|
---|
67 | new count set count=1
|
---|
68 | new MissingArray
|
---|
69 |
|
---|
70 | new Itr,IEN
|
---|
71 | new abort set abort=0
|
---|
72 | set index=$$ItrInit^TMGITR(22706.4,.Itr)
|
---|
73 | do PrepProgress^TMGITR(.Itr,20,0,"index")
|
---|
74 | if index'="" for do quit:(+$$ItrNext^TMGITR(.Itr,.index)'>0)!abort
|
---|
75 | . if $$UserAborted^TMGUSRIF set abort=1 quit
|
---|
76 | . new listingIEN set listingIEN=+$piece($get(^TMG(22706.4,index,0)),"^",1) ;"Not required...
|
---|
77 | . if (listingIEN>0),$piece($get(^TMG(22706.9,listingIEN,1)),"^",4)=1 quit ;"1=SKIP
|
---|
78 | . set ingredient=$piece($get(^TMG(22706.4,index,0)),"^",4)
|
---|
79 | . set ingredient=$extract(ingredient,1,64)
|
---|
80 | . if $get(Answers(ingredient))="" do
|
---|
81 | . . set Y=$$LookupRx(ingredient)
|
---|
82 | . . if +Y'>0 set MissingArray(ingredient)=""
|
---|
83 | . . if +Y>0 set Answers(ingredient)=+Y
|
---|
84 | do ProgressDone^TMGITR(.Itr)
|
---|
85 |
|
---|
86 | do HandleMissing(.MissingArray)
|
---|
87 | quit
|
---|
88 |
|
---|
89 |
|
---|
90 | Check1(IEN) ;"finish later
|
---|
91 | ;"Purpose: to scan the ingredients for 1 entry in 22706.9
|
---|
92 | ;"Input: IEN -- IEN in 22706.9
|
---|
93 |
|
---|
94 | new ingredient
|
---|
95 | new MissingArray
|
---|
96 |
|
---|
97 | new fdaIEN,Y
|
---|
98 | set fdaIEN=+$piece($get(^TMG(22706.9,IEN,0)),"^",1)
|
---|
99 | set ingredient=$piece($get(^TMG(22706.4,fdaIEN,0)),"^",4)
|
---|
100 | set ingredient=$extract(ingredient,1,64)
|
---|
101 | set Y=$$LookupRx(ingredient)
|
---|
102 | if +Y'>0 do
|
---|
103 | . set MissingArray(ingredient)=""
|
---|
104 | . do HandleMissing(.MissingArray)
|
---|
105 | quit
|
---|
106 |
|
---|
107 |
|
---|
108 | HandleMissing(MissingArray)
|
---|
109 | ;"Purpose: To handle and process the array of missing ingredients
|
---|
110 | ;"Input: MissingArray(ingredient)=""
|
---|
111 | ;" MissingArray(ingredient)=""
|
---|
112 | ;"Result: none
|
---|
113 |
|
---|
114 | new max set max=$$ListCt^TMGMISC("MissingArray")
|
---|
115 | write !,"Found ",max," missing INGREDIENTS.",!
|
---|
116 |
|
---|
117 | new ScanArray,count
|
---|
118 | write "Summarizing list...",!
|
---|
119 | set count=1
|
---|
120 | set ingredient=""
|
---|
121 | new startTime set startTime=$H
|
---|
122 | new abort set abort=0
|
---|
123 | for set ingredient=$order(MissingArray(ingredient)) quit:(ingredient="")!abort do
|
---|
124 | . if count#10=1 do ProgressBar^TMGUSRIF(count,ingredient,1,max,80,startTime)
|
---|
125 | . if ingredient["ALLERGENIC EXTRACT" do
|
---|
126 | . . set Y=$$DoAddIgd(ingredient,0)
|
---|
127 | . else do
|
---|
128 | . . set Y=$$FindIgdMatch(ingredient,0)
|
---|
129 | . . if +Y>0 set ScanArray("MATCHED",count,ingredient)=Y
|
---|
130 | . . else set ScanArray("UNMATCHED",count,ingredient)=""
|
---|
131 | . set count=count+1
|
---|
132 | . set abort=$$UserAborted^TMGUSRIF
|
---|
133 | write !
|
---|
134 |
|
---|
135 | new done set done=0
|
---|
136 | new input set input="R"
|
---|
137 | new displaySet set displaySet="MATCHED"
|
---|
138 | for do quit:(done=1)
|
---|
139 | . if input="R" do
|
---|
140 | . . write !!,"Now pick which potential matches are ",displaySet,!
|
---|
141 | . . do ShowMatches(.ScanArray,max,displaySet)
|
---|
142 | . write " (R to refresh, C custom handle, UL to UnLink)",!
|
---|
143 | . write " (# or #-#, ^ to continue, ? for instructions, "
|
---|
144 | . if displaySet="MATCHED" write "U show Unmatched)",!
|
---|
145 | . else write "M show Matched)",!
|
---|
146 | . write "Enter number(s) to ACCEPT (or codes listed above): ?//"
|
---|
147 | . read input,!
|
---|
148 | . if input="" set input="?"
|
---|
149 | . set input=$$UP^XLFSTR(input)
|
---|
150 | . if input="^" set done=1
|
---|
151 | . if (input="U") do
|
---|
152 | . . set displaySet="UNMATCHED"
|
---|
153 | . . set input="R"
|
---|
154 | . if (input="M") do
|
---|
155 | . . set displaySet="MATCHED"
|
---|
156 | . . set input="R"
|
---|
157 | . if (input="A") do
|
---|
158 | . . set displaySet="MATCHED"
|
---|
159 | . . set input="R"
|
---|
160 | . if (input="?") do
|
---|
161 | . . do ShowInstructions
|
---|
162 | . . set input="R"
|
---|
163 | . if +input=input do
|
---|
164 | . . do AddMatch(.ScanArray,displaySet,+input)
|
---|
165 | . . set input="R"
|
---|
166 | . if input["-" do
|
---|
167 | . . new N1,N2
|
---|
168 | . . set N1=$piece(input,"-",1)
|
---|
169 | . . set N2=$piece(input,"-",2)
|
---|
170 | . . do AddRangeMatch(.ScanArray,displaySet,N1,N2)
|
---|
171 | . . set input="R"
|
---|
172 | . if input="C" do
|
---|
173 | . . read "Enter number for Custom Handling: ",input,!
|
---|
174 | . . if +input'=input quit
|
---|
175 | . . set ingredient=$order(ScanArray(displaySet,+input,""))
|
---|
176 | . . set Y=$$AddOneIngredient(ingredient)
|
---|
177 | . . if +Y>0 kill ScanArray(displaySet,+input,ingredient)
|
---|
178 | . . set input="R"
|
---|
179 | . if input="UL" do
|
---|
180 | . . read "Enter number to Unlink (# or #-#): ",input,!
|
---|
181 | . . if +input=input do
|
---|
182 | . . . do ULMatch(.ScanArray,input)
|
---|
183 | . . else if input["-" do
|
---|
184 | . . . new N1,N2
|
---|
185 | . . . set N1=$piece(input,"-",1)
|
---|
186 | . . . set N2=$piece(input,"-",2)
|
---|
187 | . . . do ULRangeMatch(.ScanArray,N1,N2)
|
---|
188 | . . set input="R"
|
---|
189 |
|
---|
190 | quit
|
---|
191 |
|
---|
192 |
|
---|
193 | ShowInstructions
|
---|
194 | write !!,"INSTRUCTIONS:",!
|
---|
195 | write "----------------------------------------------------------------------------",!
|
---|
196 | write "Before adding any medicines or drugs into the database, the underlying",!
|
---|
197 | write "INGREDIENTS must be entered. Each drug will have one or more ingredients",!
|
---|
198 | write "that will be linked to these new entries. DRUG INTERACTIONS are based on",!
|
---|
199 | write "ingredients rather than on the name of the drug itself.",!!
|
---|
200 | write "Often, the name supplied is more specific than an entry already in the",!
|
---|
201 | write "database. For example:",!
|
---|
202 | write " CAFFEINE <-- already in database",!
|
---|
203 | write " CAFFEINE CITRATE <-- new import",!
|
---|
204 | write "Clearly, these two compounds are related, and it could be said that:",!
|
---|
205 | write "CAFFEINE is the PRIMARY INGREDIENT in CAFFEINE CITRATE, or as will be",!
|
---|
206 | write "seen shortly, summarized like this:",!
|
---|
207 | write "CAFFEINE <-- CAFFEINE CITRATE",!!
|
---|
208 | do PressToCont^TMGUSRIF
|
---|
209 | write "What follows next will be a listing of all the ingredients to be added into",!
|
---|
210 | write "the database. The computer will have made a best guess at linking the new",!
|
---|
211 | write "entries to parent compounds (i.e. PRIMARY INGREDIENTS). But not all of these",!
|
---|
212 | write "guesses will be correct. IT IS YOUR JOB TO SCREEN THESE.",!!
|
---|
213 | write "If a linkage or matching is correct, just type in its number to ACCEPT it.",!
|
---|
214 | write "If a linkage or matching is NOT correct, it shoud be UNLINKED.",!
|
---|
215 | write "If you feel you can search for a better match, attempt a CUSTOM handling.",!!
|
---|
216 | write "When you are done with accepting or rejecting the computers matches, you should",!
|
---|
217 | write "then process all the UNMATCHED entries, by selecting 'U' to show UNMATCHED.",!
|
---|
218 | write "These very likely may all be accepted at once by entering a range number (e.g.",!
|
---|
219 | write "1-1000).",!!
|
---|
220 | write "When you have completed processing all the matched and unmatched entries, enter",!
|
---|
221 | write "^ to continue.",!
|
---|
222 |
|
---|
223 | new temp
|
---|
224 | read "Press <ENTER> to continue.",temp:$get(DTIME,3600),!
|
---|
225 | quit
|
---|
226 |
|
---|
227 |
|
---|
228 | LookupRx(ingredient)
|
---|
229 | ;"Purpose: To look up ingredient in the DRUG INGREDIENTS file
|
---|
230 | ;"Input: ingredient -- the name of the ingredient to lookup
|
---|
231 | ;"Result: -1 if not fount, or 1234^ingredientname format
|
---|
232 |
|
---|
233 | new DIC,X,Y
|
---|
234 | set DIC=50.416
|
---|
235 | set DIC(0)="M"
|
---|
236 | new TMGROOT,TMGMSG
|
---|
237 |
|
---|
238 | set Y=-1
|
---|
239 | do FIND^DIC(50.416,,".01E","M",ingredient,"*",,,,"TMGROOT","TMGMSG")
|
---|
240 | if +$get(TMGROOT("DILIST",0))>0 do
|
---|
241 | . set Y=$get(TMGROOT("DILIST",2,1),-1)_"^"_$get(TMGROOT("DILIST",1,1))
|
---|
242 | . if +Y'>0 do
|
---|
243 | . . set X=ingredient
|
---|
244 | . . do ^DIC
|
---|
245 |
|
---|
246 | quit Y
|
---|
247 |
|
---|
248 |
|
---|
249 | ShowMatches(Array,max,Label)
|
---|
250 | new count,ingredient,value
|
---|
251 | new someShown set someShown=0
|
---|
252 | for count=1:1:max do
|
---|
253 | . set ingredient=$order(ScanArray(Label,count,""))
|
---|
254 | . if ingredient="" quit
|
---|
255 | . set someShown=1
|
---|
256 | . set value=$get(ScanArray(Label,count,ingredient))
|
---|
257 | . write " ",count,". "
|
---|
258 | . if +value>0 write $piece(value,"^",2)
|
---|
259 | . else write "(no parent ingredient)"
|
---|
260 | . write " <--child of-- ",ingredient,!
|
---|
261 | if someShown=0 do
|
---|
262 | . write " --- (List is Empty) ---",!
|
---|
263 |
|
---|
264 | quit
|
---|
265 |
|
---|
266 | AddRangeMatch(ScanArray,Label,StartN,EndN)
|
---|
267 | new num
|
---|
268 | for num=StartN:1:EndN do
|
---|
269 | . do AddMatch(.ScanArray,Label,num)
|
---|
270 | quit
|
---|
271 |
|
---|
272 | AddMatch(ScanArray,Label,number)
|
---|
273 | new ingredient,Y
|
---|
274 | set ingredient=$order(ScanArray(Label,number,""))
|
---|
275 | set Y=$get(ScanArray(Label,number,ingredient))
|
---|
276 | if (ingredient'="") do
|
---|
277 | . set Y=$$DoAddIgd(ingredient,Y)
|
---|
278 | . kill ScanArray(Label,number,ingredient)
|
---|
279 | quit
|
---|
280 |
|
---|
281 | ULRangeMatch(ScanArray,StartN,EndN)
|
---|
282 | new num
|
---|
283 | for num=StartN:1:EndN do
|
---|
284 | . do ULMatch(.ScanArray,num)
|
---|
285 | quit
|
---|
286 |
|
---|
287 | ULMatch(ScanArray,number)
|
---|
288 | new ingredient,Y
|
---|
289 | set ingredient=$order(ScanArray("MATCHED",number,""))
|
---|
290 | if (ingredient'="") set ScanArray("UNMATCHED",number,ingredient)=""
|
---|
291 | kill ScanArray("MATCHED",number)
|
---|
292 | quit
|
---|
293 |
|
---|
294 |
|
---|
295 | AddOneIngredient(Name)
|
---|
296 | ;"Purpose: To add ingredient name to the DRUG INGREDIENTS -- will try to find a parent
|
---|
297 | ;" ingredient interactively
|
---|
298 | ;"Input: Name -- the name of the ingredient to be added.
|
---|
299 | ;"Output: DRUG INGREDIENTS file will have records added.
|
---|
300 | ;"Results: Will return record number (IEN) of newly added record, or 0 if error
|
---|
301 | ;"Note: This function assumes that the ingredient does not already exist in the file.
|
---|
302 |
|
---|
303 | new result set result=0
|
---|
304 | if $get(Name)="" goto AOIDone
|
---|
305 |
|
---|
306 | new Y
|
---|
307 | set Y=$$FindIgdMatch(Name,1)
|
---|
308 |
|
---|
309 | new % set %=1 ;"1=YES
|
---|
310 | if +Y'>0 do
|
---|
311 | . write "A parent primary ingredient was not found for ",!
|
---|
312 | . write " ",Name," <-- UNMATCHED COMPOUND (Add Now)",!
|
---|
313 | . write "Add Now? "
|
---|
314 | . do YN^DICN ;"returns result in %
|
---|
315 | . write !
|
---|
316 |
|
---|
317 | if %=1 do
|
---|
318 | . set result=$$DoAddIgd(Name,Y)
|
---|
319 |
|
---|
320 | AOIDone
|
---|
321 | quit result
|
---|
322 |
|
---|
323 |
|
---|
324 | FindIgdMatch(Name,Interactive)
|
---|
325 | ;"Purpose: To find a match for Name from DRUG INGREDIENTS
|
---|
326 | ;"Input: Name -- the name of the ingredient to be added.
|
---|
327 | ;" Interactive -- OPTIONAL, default=1
|
---|
328 | ;" if 1 then user is asked question,
|
---|
329 | ;" if 0 then best guess is returned.
|
---|
330 | ;"Results: -1 if not found
|
---|
331 | ;" or 1234^Name
|
---|
332 |
|
---|
333 | if $get(Name)="" goto FMDone
|
---|
334 |
|
---|
335 | set Interactive=$get(Interactive,1)
|
---|
336 |
|
---|
337 | if Interactive do
|
---|
338 | . write "------------------------------------------",!
|
---|
339 | . write "Looking for a parent, PRIMARY INGREDIENT for: ",!
|
---|
340 | . write " ",Name," <-- UNMATCHED COMPOUND",!
|
---|
341 |
|
---|
342 | new DIC,X,Y,%
|
---|
343 | set DIC=50.416
|
---|
344 | set DIC(0)="M"
|
---|
345 |
|
---|
346 | new parent set parent=$$Substitute^TMGSTUTL(Name,", "," ")
|
---|
347 | set parent=$translate(parent,","," ")
|
---|
348 | for do quit:(+Y>0)!(parent="")
|
---|
349 | . new temp
|
---|
350 | . set temp=$$ParseLast^TMGMISC(parent,.parent," ") ;"cut last word off from drug name
|
---|
351 | . set X=$$Trim^TMGSTUTL(parent)
|
---|
352 | . do ^DIC
|
---|
353 | . if Interactive'=1 quit
|
---|
354 | . if +Y>0 do
|
---|
355 | . . ;"At this point, we either have possible match (+Y>0), or no match (parent="")
|
---|
356 | . . write " '"_$piece(Y,"^",2)_"' <-- ?? MATCH ??",!
|
---|
357 | . . write "Use this as the PRIMARY INGREDIENT? "
|
---|
358 | . . set %=1 ;"1=YES
|
---|
359 | . . do YN^DICN ;"returns result in %
|
---|
360 | . . write !
|
---|
361 | . . if %'=1 set Y=0
|
---|
362 | . else do
|
---|
363 | . . if X'="" write " ",X," <-- (not found).",!
|
---|
364 |
|
---|
365 | if (+Y'>0)&(Interactive) do
|
---|
366 | . write " No match found. Let's try a generic lookup..."
|
---|
367 | . set DIC(0)="AEQM"
|
---|
368 | . set DIC("A")=" LOOKUP: Enter PRIMARY INGREDIENT (or ^ to continue) ^// "
|
---|
369 | . do ^DIC
|
---|
370 | . write !
|
---|
371 |
|
---|
372 | FMDone
|
---|
373 | quit Y
|
---|
374 |
|
---|
375 |
|
---|
376 | DoAddIgd(Name,ParentIEN)
|
---|
377 | ;"Purpose: to do the actual addition to the DRUG INGREDIENTS file
|
---|
378 | ;"Input: Name -- the string of the drug name
|
---|
379 | ;" ParentIEN -- a value as returned from DIC (i.e. 1234^Name)
|
---|
380 | ;"Results: IEN of added value, or 0 if not added.
|
---|
381 |
|
---|
382 | new result set result=0
|
---|
383 | new TMGFDA,TMGIEN,TMGMSG
|
---|
384 | new PrimIngred set PrimIngred=$get(ParentIEN)
|
---|
385 | set TMGFDA(50.416,"+1,",.01)=$extract(Name,1,64)
|
---|
386 | if +PrimIngred>0 set TMGFDA(50.416,"+1,",2)=$piece(PrimIngred,"^",1)
|
---|
387 | new temp set temp=$get(DUZ(0))
|
---|
388 | set DUZ(0)="^" ;"needed for file permission
|
---|
389 | new tempLaygo merge tempLaygo=^DD(50.416,.01,"LAYGO")
|
---|
390 | kill ^DD(50.416,.01,"LAYGO") ;"temporarily remove lock-down
|
---|
391 | do UPDATE^DIE("","TMGFDA","TMGIEN","TMGMSG")
|
---|
392 | set DUZ(0)=temp
|
---|
393 | merge ^DD(50.416,.01,"LAYGO")=tempLaygo
|
---|
394 | if $data(TMGMSG)&(+$get(Quiet)=0) do
|
---|
395 | . new PriorErrorFound
|
---|
396 | . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
|
---|
397 | set result=$get(TMGIEN(1))
|
---|
398 |
|
---|
399 | quit result
|
---|
400 |
|
---|