close Warning: Can't use blame annotator: 
svn blame failed on cprs/branches/tmg-cprs/m_files/TMGNDF2F.m: 'GenericSWIGWrapper' object has no attribute '_wrap'

source: cprs/branches/tmg-cprs/m_files/TMGNDF2F.m@ 859

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

Initial upload
File size: 40.3 KB
RevLine 
1TMGNDF2F ;TMG/kst/FDA Import: Fix drugs with missing ingredients ;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 TMGNDF2E
6 ;" Fixing drugs with missing ingredients (i.e. not provided by FDA database)
7 ;"Kevin Toppenberg MD
8 ;"GNU General Public License (GPL) applies
9 ;"11-21-2006
10
11 ;"=======================================================================
12 ;" API -- Public Functions.
13 ;"=======================================================================
14 ;" //no Menu -- will launch FixMissing from Menu^TMGNDF2E
15 ;"=======================================================================
16 ;"FixMissing -- Fix entries in file 22706.9 that don't have any ingredients,
17 ;" either by finding similar drugs already present, and using
18 ;" their ingredients, or asking user.
19
20 ;"=======================================================================
21 ;" Private Functions.
22 ;"=======================================================================
23 ;"GetMissing(List) -- Gather list of drugs that have no ingredients
24 ;"GetSuggestions(List) -- expand list such that it contains suggested ingredients
25 ;"Suggest1(IEN,Array) -- find a suggested answer for one record
26 ;"SgstFromVAP(IEN,vapIEN,Array) -- Return list of ingredient IENs based on IEN from VA PRODUCT
27 ;"SgstByName(IEN,Array) -- find suggested ingredients of one drug, based on IEN from 22706.9
28 ;"ShowList(Array,Answers,ShowBoth,ByGeneric,ShowIngred,CompactMode) -- display the list generated by GetSuggestions
29 ;"HandleList(Array) -- allow user to manipulate and fix problems found
30 ;"XMenuOption(Prompt,FnStr,HlpFn,EntryList,EntryS) -- carry out the various menu functions
31 ;"SetSkip(Array,Answers,EntryList) -- remove entries from consideration for adding to 50.68
32 ;"ShowInfo(Array,Answers,EntryList) -- allow user to explore existing entries in 22706.9 file
33 ;"Lookup(Array,Answers,EntryList) -- allow user to explore existing entries in 50.68 file
34 ;"FixItems(Array,Answers,EntryList) -- Fix one item
35 ;"AskFix1Item(Array,IEN) -- fix one entry, with user input
36 ;"Show1(Array,IEN,Answers,ShowIgd) -- display the list generated by GetSuggestions
37 ;"Look2Fix(IEN,Array) -- allow user to find a match to use for fixing.
38 ;"KillMatch(IEN,Array,Answers,EntryList) -- remove VA PRODUCT matches from consideration
39 ;"ArrayKill(IEN,Array) -- remove entry IEN from the Array of drugs to be fixed
40 ;"Fix1From(IEN,vapIEN,Array,NoVerify) -- use rec in VA PRODUCT file to fix rec in TMG FDA IMPORT COMPILED
41 ;"VerifySource(vapIEN) -- show the drug name, and the drug's ingredients, and ask user to verify choice
42 ;"Copy1(vapIEN,IEN) -- fill in missing answers in the record in 22706.9, from record in 50.68
43 ;"ManIngredients(Array,Answers,EntryList) -- Manually Add ingredients to a list of records
44 ;"AskManIngred(IEN,IngredArray) -- ask user for a list of ingredients, then add to record in 22706.9
45 ;"ShowIngreds(IngredArray) -- Show list of ingredients in array
46 ;"Add1Ingredients(IEN,IngredArray) -- put a list of ingredients into one (1) record in 22706.9
47
48 ;"=======================================================================
49 ;"=======================================================================
50
51 ;"Note: The FDA database lists some drugs that do not have ingredients specified.
52 ;" Some such drugs may not be wanted, and some others might have easily
53 ;" identifiable ingredients (i.e. Lasix -->can figure out ingredient of furosemide)
54 ;" So the purpose of this module is to handle those drugs that don't have
55 ;" enough information for addition into the VistA system.
56
57FixMissing
58 ;"Purpose: Fix entries in file 22706.9 that don't have any ingredients,
59 ;" either by finding similar drugs already present, and using
60 ;" their ingredients, or asking user.
61
62 new List,Answers
63 write "Scanning TMG FDA IMPORT COMPILED file for drugs with missing information.",!
64 do GetMissing(.List)
65 write !
66 write "Searching for potential fixes for each drug with missing information",!
67 do GetSuggestions(.List)
68 write !
69 do HandleList(.List)
70
71 ;"do ShowList(.List,.Answers,1,0)
72
73 quit
74
75
76GetMissing(List)
77 ;"Purpose: Gather list of drugs that have no ingredients
78 ;"Input: List -- PASS BY REFERENCE, an OUT PARAMETER
79 ;" format:
80 ;" List(IEN)=TMGTradeName^TMGGeneric
81 ;" List(IEN)=TMGTradeName^TMGGeneric
82 ;" List("BY GENERIC",TMGGeneric,IEN)=TMGTradeName
83 ;" List("BY TRADE",TMGTradeName,IEN)=TMGGeneric
84 ;"results: none
85
86 new Itr,IEN
87 set IEN=$$ItrInit^TMGITR(22706.9,.Itr)
88 do PrepProgress^TMGITR(.Itr,2)
89 if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)
90 . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;" 1;4=SKIP THIS RECORD
91 . if +$piece($get(@Itr@(IEN,4,0)),"^",4)=0 do ;"4;0 -> header of INGREDIENTS subfile, part 4=rec count
92 . . new TMGTradeName set TMGTradeName=$$GET1^DIQ(22706.9,IEN,.05)
93 . . set TMGTradeName=$translate(TMGTradeName,"""","'")
94 . . if TMGTradeName="" set TMGTradeName="?"
95 . . new TMGGeneric set TMGGeneric=$$GET1^DIQ(22706.9,IEN,.07)
96 . . set TMGGeneric=$translate(TMGGeneric,"""","'")
97 . . if TMGGeneric="" set TMGGeneric="?"
98 . . set List(IEN)=TMGTradeName_"^"_TMGGeneric
99 . . if TMGGeneric'="?" set List("BY GENERIC",TMGGeneric,IEN)=TMGTradeName
100 . . set List("BY TRADE",TMGTradeName,IEN)=TMGGeneric
101
102 quit
103
104
105GetSuggestions(List)
106 ;"Purpose: expand list such that it contains suggested ingredients
107 ;"Input: List -- PASS BY REFERENCE,
108 ;" List(IEN)=TMGTradeName^VAGeneric
109 ;" List(IEN)=TMGTradeName^VAGeneric
110 ;" List("BY GENERIC",TMGGeneric,IEN)=TMGTradeName
111 ;" List("BY TRADE",TMGTradeName,IEN)=TMGGeneric
112 ;"Output: List is filled in, as follows:
113 ;" List(IEN,"POSS IGD MATCH",igdIEN)=IngredientName
114 ;" List(IEN,"POSS IGD MATCH"igdIEN)=IngredientName
115 ;" List(IEN,"POSS RX MATCH",RxIEN)=vapEntryName
116 ;" List(IEN,"POSS RX MATCH",RxIEN)=vapEntryName
117 ;" List(IEN)=TMGTradeName^VAGeneric
118 ;" List(IEN)=TMGTradeName^VAGeneric
119 ;" List("BY GENERIC",TMGGeneric,IEN)=TMGTradeName
120 ;" List("BY TRADE",TMGTradeName,IEN)=TMGGeneric
121
122 new IEN,Itr
123 set IEN=$$ItrAInit^TMGITR("List",.Itr)
124 do PrepProgress^TMGITR(.Itr,10)
125 if IEN'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN)'>0)
126 . do Suggest1(IEN,.List)
127
128 quit
129
130
131Suggest1(IEN,Array)
132 ;"Purpose: To find a suggested answer for one record
133 ;"Input: IEN -- the IEN in file 22706.9 to find answer for
134 ;" Array -- PASS BY REFERENCE, an OUT PARAMETER. FORMAT:
135 ;" Array(IEN)=TMGTradeName^VAGeneric
136 ;" Array(IEN)=TMGTradeName^VAGeneric
137 ;"Output: Array is returned
138 ;" Note: RxIEN is IEN in file 50.416
139 ;" Array(IEN)=TMGTradeName^VAGeneric
140 ;" Array(IEN)=TMGTradeName^VAGeneric
141 ;" List(IEN,"POSS IGD MATCH",igdIEN)=IngredientName
142 ;" List(IEN,"POSS IGD MATCH"igdIEN)=IngredientName
143 ;" List(IEN,"POSS RX MATCH",RxIEN)=vapEntryName
144 ;" List(IEN,"POSS RX MATCH",RxIEN)=vapEntryName
145 ;"Results: none
146
147 new Itr,RxIEN,vapIEN
148 set vapIEN=$$ItrFInit^TMGITR(22706.914,.Itr,.RxIEN,.01,IEN,"I")
149 if vapIEN'="" for do quit:($$ItrFNext^TMGITR(.Itr,.RxIEN,.vapIEN)'>0)
150 . do SgstFromVAP(IEN,vapIEN,.Array)
151
152 kill Itr
153 set RxIEN=$$ItrFInit^TMGITR(22706.915,.Itr,.RxIEN,.01,IEN,"I")
154 if RxIEN'="" for do quit:($$ItrFNext^TMGITR(.Itr,.RxIEN,.vapIEN)'>0)
155 . do SgstFromVAP(IEN,RxIEN,.Array)
156
157 do SgstByName(IEN,.Array)
158
159 quit
160
161
162SgstFromVAP(IEN,vapIEN,Array)
163 ;"Purpose: Return list of ingredient IENs based on IEN from VA PRODUCT
164 ;"Input: IEN -- the IEN in file 22706.9
165 ;" vapIEN -- an IEN to file 50.68 (VA PRODUCT)
166 ;" Array -- PASS BY REFERENCE, an OUT PARAMETER. format:
167 ;" Note: RxIEN is IEN in file 50.416
168 ;" Array(IEN)=TMGTradeName^TMGGeneric
169 ;"Output: Array is filled with data, if found
170 ;" Note: RxIEN is IEN in file 50.416
171 ;" Array(IEN)=TMGTradeName^TMGGeneric
172 ;" Array(IEN)=TMGTradeName^TMGGeneric
173 ;" Array(IEN,"POSS IGD MATCH",igdIEN)=IngredientName
174 ;" Array(IEN,"POSS IGD MATCH"igdIEN)=IngredientName
175 ;" Array(IEN,"POSS RX MATCH",RxIEN)=vapEntryName
176 ;" Array(IEN,"POSS RX MATCH",RxIEN)=vapEntryName
177 ;"Results: none.
178
179 new Itr,igdIEN,IEN2
180 set igdIEN=$$ItrFInit^TMGITR(50.6814,.Itr,.IEN2,.01,vapIEN,"I")
181 if igdIEN'="" for do quit:($$ItrFNext^TMGITR(.Itr,.IEN2,.igdIEN)'>0)
182 . if igdIEN'=0 do
183 . . new IENS set IENS=igdIEN_","_IEN_","
184 . . new IngredName set IngredName=$$GET1^DIQ(50.416,IENS,.01)
185 . . set Array(IEN,"POSS IGD MATCH",igdIEN)=IngredName
186
187 quit
188
189
190SgstByName(IEN,Array)
191 ;"Purpose: to find suggested ingredients of one drug, based on IEN from 22706.9
192 ;"Input: IEN -- IEN from 22706.9
193 ;" Array -- PASS BY REFERENCE, an OUT PARAMETER. format:
194 ;" Note: RxIEN is IEN in file 50.416
195 ;" Array(IEN)=TMGTradeName^TMGGeneric
196 ;"Output: Array is filled with data, if found
197 ;" Note: RxIEN is IEN in file 50.416
198 ;" Array(IEN)=TMGTradeName^TMGGeneric
199 ;" Array(IEN)=TMGTradeName^TMGGeneric
200 ;" Array(IEN,"POSS IGD MATCH",igdIEN)=IngredientName
201 ;" Array(IEN,"POSS IGD MATCH"igdIEN)=IngredientName
202 ;" Array(IEN,"POSS RX MATCH",RxIEN)=vapEntryName
203 ;" Array(IEN,"POSS RX MATCH",RxIEN)=vapEntryName
204 ;"Results: none.
205
206 new TMGTradeName,TMGFDA,TMGMSG,PriorErrorFound
207 set TMGTradeName=$piece($get(Array(IEN)),"^",1)
208 if (TMGTradeName="")!(TMGTradeName="?") goto SBNDone
209 new Value set Value=$piece(TMGTradeName," ",1)
210 do FIND^DIC(50.68,,.01,"M",Value,"*",,,,"TMGFDA","TMGMSG")
211 if $data(TMGMSG("DIERR"))'=0 do goto SBNDone
212 . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
213
214 ;"Now gather ingredient list from results found
215 new i,vapIEN
216 for i=1:1:$piece($get(TMGFDA("DILIST",0)),"^",1) do
217 . set vapIEN=+$get(TMGFDA("DILIST",2,i))
218 . new vapName set vapName=$$GET1^DIQ(50.68,vapIEN,.01)
219 . set Array(IEN,"POSS RX MATCH",vapIEN)=vapName
220 . do SgstFromVAP(IEN,vapIEN,.Array)
221
222SBNDone
223 quit
224
225 ;"=======================================================================
226
227ShowList(Array,Answers,ShowBoth,ByGeneric,ShowIngred,CompactMode)
228 ;"Purpose: To display the list generated by GetSuggestions
229 ;"Input: Array -- PASS BY REFERENCE. Array with data. Format:
230 ;" note IEN is from 22706.9
231 ;" Array(IEN)=TMGTradeName^TMGGeneric
232 ;" Array(IEN)=TMGTradeName^TMGGeneric
233 ;" Array("BY GENERIC",TMGGeneric,IEN)=TMGTradeName
234 ;" Array("BY TRADE",TMGTradeName,IEN)=TMGGeneric
235 ;" Array(IEN,"POSS IGD MATCH",igdIEN)=IngredientName
236 ;" Array(IEN,"POSS IGD MATCH"igdIEN)=IngredientName
237 ;" Array(IEN,"POSS RX MATCH",RxIEN)=vapEntryName
238 ;" Array(IEN,"POSS RX MATCH",RxIEN)=vapEntryName
239 ;" Answers -- PASS BY REFERENCE, and OUT PARAMETER
240 ;" An array that will link display numbers with IENs
241 ;" Answer(count)=IEN^TMGTradeName^TMGGeneric
242 ;" Answer(count)=IEN^TMGTradeName^TMGGeneric
243 ;" ShowBoth -- OPTIONAL, if value=1, thenTMGGeneric & TMGTrade names will both be shown. Default=0
244 ;" ByGeneric -- OPTIONAL, if value=1, then list is shown sorted by Generic Name. Default=0
245 ;" ShowIngred -- OPTIONAL, if value=1 then all possible ingredients are shown. Default=0
246 ;" CompactMode -- OPTIONAL, if value=1 then only 20 entries are shown.
247 ;"Output: List is shown, and the Answers array is established and passed back.
248 ;"Results: none.
249
250 new someShown set someShown=0
251 new count
252 set count=1
253 kill Answers
254 set ShowBoth=$get(ShowBoth,0)
255 set ByGeneric=$get(ByGeneric,0)
256 set ShowIngred=$get(ShowIngred,0)
257 set CompactMode=$get(CompactMode,0)
258 new NodeName set NodeName="BY TRADE"
259 if ByGeneric=1 set NodeName="BY GENERIC"
260 new ShortLen set ShortLen=25
261
262 write NodeName,!
263
264 new done set done=0
265 new Itr,RxName,OtherName,IEN
266 set RxName=$$ItrAInit^TMGITR("Array("""_NodeName_""")",.Itr)
267 if RxName'="" for do quit:($$ItrANext^TMGITR(.Itr,.RxName)="")!(done=1)
268 . new Itr2
269 . set IEN=$$ItrAInit^TMGITR("Array("""_NodeName_""","""_RxName_""")",.Itr2)
270 . if IEN'="" for do quit:($$ItrANext^TMGITR(.Itr2,.IEN)'>0)!(done=1)
271 . . set OtherName=$get(Array(NodeName,RxName,IEN))
272 . . set Answers(count)=IEN
273 . . if (CompactMode=0)!(count'>ShortLen) do
274 . . . new NumMatches set NumMatches=$$ListCt^TMGMISC("Array("""_IEN_""",""POSS RX MATCH"")")
275 . . . write count,". ",RxName
276 . . . if (ShowBoth)&(OtherName'="?") write " (",OtherName,")"
277 . . . write " (",NumMatches," possible matches)",!
278 . . set someShown=1
279 . . set count=count+1
280 . . if (CompactMode=1)&(count>ShortLen) quit
281 . . new Itr3,IngredIEN set IngredIEN=""
282 . . if ShowIngred=0 quit
283 . . set IngredIEN=$$ItrAInit^TMGITR("Array("""_IEN_""",""POSS IGD MATCH"")",.Itr3)
284 . . if IngredIEN'="" for do quit:($$ItrANext^TMGITR(.Itr3,.IngredIEN)="")
285 . . . new IngredName set IngredName=$get(Array(IEN,"POSS IGD MATCH",IngredIEN))
286 . . . if IngredName'="" write " -- ",IngredName,!
287 if (CompactMode=1)&(count>ShortLen) do
288 . write "... ",(count-ShortLen-1)," other items truncated.",!
289
290SL2 if 'someShown write " --- (List is Empty) ---",!
291
292SLDone quit
293
294
295HandleList(Array)
296 ;"Purpose: to allow user to manipulate and fix problems found
297 ;"Input: Array -- PASS BY REFERENCE. The list as created by GetSuggestions()
298 ;" note IEN is from 22706.9
299 ;" Array(IEN)=TMGTradeName^TMGGeneric
300 ;" Array(IEN)=TMGTradeName^TMGGeneric
301 ;" Array("BY GENERIC",TMGGeneric,IEN)=TMGTradeName
302 ;" Array("BY TRADE",TMGTradeName,IEN)=TMGGeneric
303 ;" Array(IEN,"POSS IGD MATCH",igdIEN)=IngredientName
304 ;" Array(IEN,"POSS IGD MATCH"igdIEN)=IngredientName
305 ;" Array(IEN,"POSS RX MATCH",RxIEN)=vapEntryName
306 ;" Array(IEN,"POSS RX MATCH",RxIEN)=vapEntryName
307
308 new done set done=0
309 new input set input="R"
310 new Answers
311 new CompactMode set CompactMode=1 ;" (list display mode: 1=compact, 0=verbose)
312 new ShowBoth set ShowBoth=0
313 new ShowIngred set ShowIngred=0
314 new ByGeneric set ByGeneric=0
315 new EntryList,EntryS,Fn,Cancelled
316 new CompactMode set CompactMode=1
317 set Cancelled=0
318
319 for do quit:(done=1)
320 . if input="R" do
321 . . write !!
322 . . write "--------------------------------------------------",!
323 . . write "Specify which drugs to FIX",!
324 . . write "--------------------------------------------------",!
325 . . do ShowList(.Array,.Answers,ShowBoth,ByGeneric,ShowIngred,CompactMode)
326 . . write "--------------------------------------------------",!
327 . . write "Specify which drugs to FIX",!
328 . . write "--------------------------------------------------",!
329 . . write " R to refresh, L lookup X remove from list, N iNfo",!
330 . . write " M to Manually add Ingredients",!
331 . . write " C turn Compact display ",$select((CompactMode=1):"OFF",1:"ON")
332 . . write " I turn Show Ingredients display ",$select((ShowIngred=1):"OFF",1:"ON"),!
333 . . if $get(EntryS)'="" write " Current SET #'s: ",EntryS,", D to delete SET",!
334 . . write " # or #-# or #,#-#,# etc., ^ done, ",!
335 . write "Enter number(s) to Fix (or codes listed above): ^//"
336 . read input:$get(DTIME,3600),!
337 . if input="" set input="^"
338 . set input=$$UP^XLFSTR(input)
339 . if input="^" set done=1 quit
340 . if input="R" quit
341 . else if input="I" do quit
342 . . set ShowIngred='ShowIngred
343 . . set input="R"
344 . else if input="C" do quit
345 . . set CompactMode='CompactMode
346 . . set input="R"
347 . else if input="M" do quit;"<----- Manual add Ingredients
348 . . set Fn="do ManIngredients(.Array,.Answers,.EntryList)"
349 . . do XMenuOption("MANUALLY add INGREDIENTS to",Fn,"",.EntryList,.EntryS)
350 . . set input="R"
351 . else if input="D" do quit;"---- delete set
352 . . kill EntryList,EntryS
353 . . set input="R"
354 . else if input="L" do quit;"<----- Do Lookup
355 . . set input=1 ;"a dummy entry, not needed.
356 . . set Fn="do Lookup(.Array,.Answers,.EntryList)"
357 . . do XMenuOption("",Fn,"",.EntryList,.EntryS)
358 . else if input="N" do quit;"<----- Show Info
359 . . set Fn="do ShowInfo(.Array,.Answers,.EntryList)"
360 . . do XMenuOption("show INFO about",Fn,"",.EntryList,.EntryS)
361 . else if input="X" do quit;"<----- Set Skip
362 . . set Fn="do SetSkip(.Array,.Answers,.EntryList)"
363 . . do XMenuOption("specify NOT to ADD",Fn,"",.EntryList,.EntryS)
364 . . set input="R"
365 . else do ;"default is ACCEPT
366 . . set Cancelled=0
367 . . set Fn="do FixItems(.Array,.Answers,.EntryList)"
368 . . do XMenuOption("",Fn,"",.EntryList,.EntryS)
369 . . set input="R"
370
371 quit
372
373
374XMenuOption(Prompt,FnStr,HlpFn,EntryList,EntryS)
375 ;"Purpose: To carry out the various menu functions
376 ;"Input: Prompt: the message to use to prompt user to enter numbers etc.
377 ;" "Enter the Number(s) to" will be automatically provided
378 ;" and ": (? help) ^// " will be added at end
379 ;" FnStr: -- code to execute, e.g. "do DoLookup(.Array,.Answers,.Classes,.EntryList)"
380 ;" HlpFn: e.g. FindHelp, SimHelp, LookupHelp, etc Don't add () to name
381 ;" EntryList -- PASS BY REFERENCE
382 ;" EntryS -- PASS BY REFERENCE. a string showing current set as a string
383 ;"Note: makes use of global scope of 'input', and 'CompactMode', 'Cancelled'
384 ;"Result: none.
385
386 if $get(EntryS)="" do quit:(valid=0)
387 . if Prompt'="" do
388XMO1 . . write "Enter the Number(s) to ",Prompt,": (? help) ^// "
389 . . read input,!
390 . . if (input="?") do goto XMO1
391 . . . if Hlpfn="" write "(Sorry, no help available)",! quit
392 . . . new Code set Code="do "_HlpFn_"()"
393 . . . Xecute code
394 . set valid=$$MkMultList^TMGMISC(input,.EntryList)
395 . if valid set EntryS=input
396 Xecute FnStr
397 if $get(CompactMode)=1 set input="R"
398 if $get(Cancelled)=0 kill EntryList,EntryS
399
400 quit
401
402
403SetSkip(Array,Answers,EntryList)
404 ;"Purpose: To remove entries from consideration for adding to 50.68
405 ;"Input: Array -- PASS BY REFERENCE. Array with data. Format same as for HandleList
406 ;" Answers -- PASS BY REFERENCE
407 ;" An array that will link display numbers with IENs
408 ;" Answers(count)=IEN^TMGTradeName^TMGGeneric
409 ;" Answers(count)=IEN^TMGTradeName^TMGGeneric
410 ;" EntryList -- PASS BY REFERENCE -- an array of entries (user input values) to process.
411 ;" Format as follows.
412 ;" EntryList(Entry number)="" (same as count above)
413 ;" EntryList(Entry number)=""
414 ;"Results: none
415
416 new Itr,Count,IEN
417 set Count=$$ItrAInit^TMGITR("EntryList",.Itr)
418 if Count>0 for do quit:($$ItrANext^TMGITR(.Itr,.Count)'>0)
419 . set IEN=$piece($get(Answers(Count)),"^",1)
420 . if IEN="" quit
421 . new TMGTradeName,TMGGeneric
422 . set TMGTradeName=$piece($get(Array(IEN)),"^",1)
423 . set TMGGeneric=$piece($get(Array(IEN)),"^",2)
424 . ;"I could put in some undo code here...
425 . set $piece(^TMG(22706.9,IEN,1),"^",4)=1 ;"set skipflag to true
426 . ;"Now delete data from display data
427 . kill Array(IEN)
428 . if (TMGGeneric'="") kill Array("BY GENERIC",TMGGeneric,IEN)
429 . if (TMGTradeName'="") kill Array("BY TRADE",TMGTradeName,IEN)
430
431 quit
432
433
434ShowInfo(Array,Answers,EntryList)
435 ;"Purpose: To allow user to explore existing entries in 22706.9 file
436 ;"Input: Array -- PASS BY REFERENCE. Array with data. Format same as for HandleList
437 ;" Answers -- PASS BY REFERENCE,
438 ;" An array that will link display numbers with IENs
439 ;" Answer(count)=IEN
440 ;" EntryList -- PASS BY REFERENCE -- an array of entries (user input values) to process.
441 ;" Format as follows.
442 ;" EntryList(Entry number)="" (same as count above)
443
444 new Itr,Count,IEN
445 set Count=$$ItrAInit^TMGITR("EntryList",.Itr)
446 if Count>0 for do quit:($$ItrANext^TMGITR(.Itr,.Count)'>0)
447 . set IEN=$piece($get(Answers(Count)),"^",1)
448 . do DumpRec2^TMGDEBUG(22706.9,IEN,0)
449 . do PressToCont^TMGUSRIF
450
451 quit
452
453
454Lookup(Array,Answers,EntryList)
455 ;"Purpose: To allow user to explore existing entries in 50.68 file
456 ;"Input: Array -- PASS BY REFERENCE. Array with data. Format same as for HandleList
457 ;" Answers -- PASS BY REFERENCE,
458 ;" An array that will link display numbers with IENs
459 ;" Answer(count)=IEN
460 ;" EntryList -- PASS BY REFERENCE -- an array of entries (user input values) to process.
461 ;" Format as follows.
462 ;" EntryList(Entry number)="" (same as count above)
463
464 new DIC,Y
465 set DIC=50.68
466 set DIC(0)="MAEQ"
467 do ^DIC write !
468 if +Y>0 do
469 . do DumpRec2^TMGDEBUG(50.68,+Y,0)
470 . do PressToCont^TMGUSRIF
471
472 quit
473
474FixItems(Array,Answers,EntryList)
475 ;"Purpose: To Fix one item
476 ;"Input: Array -- PASS BY REFERENCE. Array with data. Format same as for HandleList
477 ;" Answers -- PASS BY REFERENCE
478 ;" An array that will link display numbers with IENs
479 ;" Answers(count)=IEN^TMGTradeName^TMGGeneric
480 ;" Answers(count)=IEN^TMGTradeName^TMGGeneric
481 ;" EntryList -- PASS BY REFERENCE -- an array of entries (user input values) to process.
482 ;" Format as follows.
483 ;" EntryList(Entry number)="" (same as count above)
484 ;" EntryList(Entry number)=""
485 ;"Results: none
486
487 new Itr,Count,IEN
488 new done set done=0
489 new vapIEN set vapIEN=0 ;"for first cycle, no ready answer available.
490
491 set Count=$$ItrAInit^TMGITR("EntryList",.Itr)
492 if Count>0 for do quit:($$ItrANext^TMGITR(.Itr,.Count)'>0)!(done=1)
493 . set IEN=$piece($get(Answers(Count)),"^",1)
494 . if vapIEN'=0 do ;"If we've already fixed on, use same answer for rest of list
495 . . if $$Fix1From(IEN,vapIEN,.Array,1)=0 set done=1
496 . else do
497 . . set vapIEN=$$AskFix1Item(.Array,IEN)
498 . . if vapIEN=0 set done=1
499 . if done=1 quit
500 . do ArrayKill(IEN,.Array) ;"delete data from display data
501
502 quit
503
504
505AskFix1Item(Array,IEN)
506 ;"Purpose: to fix one entry, with user input
507 ;"Input: Array -- PASS BY REFERENCE. Array with data. Format same as for HandleList
508 ;" IEN -- the Record to fix.
509 ;"Results: 1 if item Fixed, 0 if not
510
511 ;"First, ask if the drug is similar enough that a copy of that other drug
512 ;" is allowed
513 ;"Next, (if above fails), ask for matching of possible ingredients
514 ;"If no ingredient found, even consider adding a new ingredient to INGREDIENT file
515
516 new done set done=0
517 new input set input="R"
518 new Answers,Fn
519 new CompactMode set CompactMode=1 ;" (list display mode: 1=compact, 0=verbose)
520 new ShowBoth set ShowBoth=0
521 new ShowIngred set ShowIngred=0
522 new ByGeneric set ByGeneric=0
523 new EntryList,EntryS,Fn,Cancelled
524 new FixedWithIEN set FixedWithIEN=0
525
526 for do quit:(done=1)
527 . if input="R" do
528 . . write !!
529 . . write "--------------------------------------------------",!
530 . . write "Specify CLOSEST MATCH (IGNORE DOSE & FORM)",!
531 . . do Show1(.Array,IEN,.Answers,0)
532 . . if $$ListCt^TMGMISC("Answers")>20 do
533 . . . write "--------------------------------------------------",!
534 . . . write "Specify CLOSEST MATCH (IGNORE DOSE & FORM)",!
535 . . write "--------------------------------------------------",!
536 . . write " R to refresh, F to find Match",!
537 . . write " X to remove from list",!
538 . . if $get(EntryS)'="" write " Current SET #'s: ",EntryS,", D to delete SET",!
539 . . write " ^ if done, ",!
540 . write "Enter number to ACCEPT (or codes listed above): ^//"
541 . read input:$get(DTIME,3600),!
542 . if input="" set input="^"
543 . set input=$$UP^XLFSTR(input)
544 . if input="^" set done=1 quit
545 . if input="R" quit
546 . else if input="D" do quit;"---- delete set
547 . . kill EntryList,EntryS
548 . . set input="R"
549 . else if input="F" do quit;"<----- Look for answer
550 . . set FixedWithIEN=$$Look2Fix(IEN,.Array)
551 . . if FixedWithIEN'=0 set done=1
552 . . else set input="R"
553 . else if input="X" do quit;"<----- Set Skip
554 . . set Fn="do KillMatch(IEN,.Array,.Answers,.EntryList)"
555 . . do XMenuOption("specify match NOT to USE",Fn,"",.EntryList,.EntryS)
556 . else do ;"default is ACCEPT
557 . . if (input["-")!(input[",") write "ENTER ONLY *ONE* ENTRY NUMBER",! quit
558 . . new vapIEN set vapIEN=+$get(Answers(+input))
559 . . if vapIEN>0 set FixedWithIEN=$$Fix1From(IEN,vapIEN,.Array)
560 . . if FixedWithIEN'=0 set done=1
561 . . else set input="R"
562
563 quit FixedWithIEN
564
565
566Show1(Array,IEN,Answers,ShowIgd)
567 ;"Purpose: To display the list generated by GetSuggestions
568 ;"Input: Array -- PASS BY REFERENCE. Array with data. Format same as for HandleList
569 ;" IEN -- the One entry to display
570 ;" Answers -- PASS BY REFERENCE, and OUT PARAMETER
571 ;" An array that will link display numbers with IENs
572 ;" Answer(count)=IEN
573 ;" Answer(count)=IEN
574 ;" ShowIgd -- OPTIONAL, if value=1 then ingredients will be shown, otherwise
575 ;" matches in VA PRODUCT FILE are shown.
576 ;"Output: List is shown, and the Answers array is established and passed back.
577 ;"Results: none.
578
579 new someShown set someShown=0
580 new count set count=1
581 kill Answers
582 new NodeName set NodeName="POSS RX MATCH"
583 if $get(ShowIgd)=1 set NodeName="POSS IGD MATCH"
584
585 new Itr,subIEN
586 new TMGTradeName,TMGGeneric
587
588 set TMGTradeName=$piece($get(Array(IEN)),"^",1)
589 set TMGGeneric=$piece($get(Array(IEN)),"^",2)
590 write " For: ",TMGTradeName
591 if (TMGGeneric'="?")&(TMGGeneric'="") write " (",TMGGeneric,")"
592 write !
593 write "--------------------------------------------------",!
594
595 if $get(IEN)="" goto S1Done
596
597 set subIEN=$$ItrAInit^TMGITR("Array("_IEN_","""_NodeName_""")",.Itr)
598 if subIEN'="" for do quit:($$ItrANext^TMGITR(.Itr,.subIEN)="")
599 . set Answers(count)=subIEN
600 . new Name set Name=$get(Array(IEN,NodeName,subIEN))
601 . write count,". ",Name,!
602 . set count=count+1
603 . set someShown=1
604
605S1Done
606 if 'someShown write " --- (List is Empty) ---",!
607 quit
608
609
610Look2Fix(IEN,Array)
611 ;"Purpose: To allow user to find a match to use for fixing.
612 ;"Input: IEN -- the IEN to fix
613 ;" Array -- PASS BY REFERENCE. Array with data. Format same as for HandleList
614 ;"Result: 0 if no fix, or vapIEN (IEN in 50.68) otherwise
615
616 new result set result=0 ;"default to failure
617
618 write "SEARCH for a drug that can be used to fix incomplete entry.",!
619 new DIC,Y
620 set DIC=50.68
621 set DIC(0)="MAEQ"
622 do ^DIC write !
623 if +Y>0 do
624 . if $$Fix1From(IEN,+Y,.Array)=1 set result=+Y
625
626 quit result
627
628
629KillMatch(IEN,Array,Answers,EntryList)
630 ;"Purpose: To remove VA PRODUCT matches from consideration
631 ;"Input: IEN -- the IEN in 22706.9,
632 ;" Array -- PASS BY REFERENCE. Array with data. Format same as for HandleList
633 ;" Answers -- PASS BY REFERENCE,
634 ;" An array that will link display numbers with IENs
635 ;" Answer(count)=IEN
636 ;" EntryList -- PASS BY REFERENCE -- an array of entries (user input values) to process.
637 ;" Format as follows.
638 ;" EntryList(Entry number)="" (same as count above)
639
640 new Itr,Count,subIEN
641 set Count=$$ItrAInit^TMGITR("EntryList",.Itr)
642 if Count>0 for do quit:($$ItrANext^TMGITR(.Itr,.Count)'>0)
643 . set subIEN=$piece($get(Answers(Count)),"^",1)
644 . new TMGTradeName,TMGGeneric
645 . set TMGTradeName=$piece($get(Array(IEN)),"^",1)
646 . set TMGGeneric=$piece($get(Array(IEN)),"^",2)
647 . ;"I could put in some undo code here...
648 . ;"Now delete data from display data
649 . ;"kill Array(IEN,"POSS RX MATCH",subIEN)
650 . do ArrayKill(IEN,.Array)
651 quit
652
653
654ArrayKill(IEN,Array)
655 ;"Purpose: to remove entry IEN from the Array of drugs to be fixed
656 ;"Input: IEN -- the IEN to remove
657 ;" Array -- the array with the drug info. Format as follows:
658 ;" Array(IEN)=TMGTradeName^TMGGeneric
659 ;" Array(IEN)=TMGTradeName^TMGGeneric
660 ;" Array("BY GENERIC",TMGGeneric,IEN)=TMGTradeName
661 ;" Array("BY TRADE",TMGTradeName,IEN)=TMGGeneric
662 ;" Array(IEN,"POSS IGD MATCH",igdIEN)=IngredientName
663 ;" Array(IEN,"POSS IGD MATCH"igdIEN)=IngredientName
664 ;" Array(IEN,"POSS RX MATCH",RxIEN)=vapEntryName
665 ;" Array(IEN,"POSS RX MATCH",RxIEN)=vapEntryName
666
667 new TMGTradeName,TMGGeneric
668 set TMGTradeName=$piece($get(Array(IEN)),"^",1)
669 set TMGGeneric=$piece($get(Array(IEN)),"^",2)
670 if TMGTradeName="" set TMGTradeName="?"
671 if TMGGeneric="" set TMGGeneric="?"
672 kill Array(IEN)
673 kill Array("BY TRADE",TMGTradeName,IEN)
674 kill Array("BY GENERIC",TMGGeneric,IEN)
675
676 quit
677
678
679Fix1From(IEN,vapIEN,Array,NoVerify)
680 ;"Purpose: To take a record in VA PRODUCT file (50.68) and use this to fix record in
681 ;" TMG FDA IMPORT COMPILED (22706.9)
682 ;"Input: IEN -- the IEN in 22706.9,
683 ;" vapIEN -- the IEN in 50.68 to fix from
684 ;" Array -- PASS BY REFERENCE. Array with data. Format same as for HandleList
685 ;" NoVerify -- OPTIONAL, if value=1 no user verification asked. Default=0
686 ;"result: 1 if OK to continue, 0 if user abort
687
688 new result set result=0 ;"default to failure
689
690 if $get(NoVerify,0)=0,$$VerifySource(vapIEN)=0 goto F1FDone
691 ;"I could put in some undo code here... BUT undoing changes from Copy1 would be HARD
692 if $$Copy1(vapIEN,IEN)=0 goto F1FDone
693 do ArrayKill(IEN,.Array)
694 set result=1 ;"success
695
696F1FDone
697 quit result
698
699
700VerifySource(vapIEN)
701 ;"Purpose: to show the drug name, and the drug's ingredients, and ask user to verify choice
702 ;"Input: vapIEN -- IEN in file 50.68
703 ;"Result: 1 if OK to use this drug. 0 if don't use
704
705 new PriorErrorFound
706 new result set result=0
707 write "-------------------------------------------------",!
708 write "Drug Information:",!
709 write "-------------------------------------------------",!
710 ;"write "NAME: ",$$GET1^DIQ(50.68,vapIEN,.01),!
711 write "GENERIC NAME: ",$$GET1^DIQ(50.68,vapIEN,.05),!
712 write "INGREDIENTS:",!
713 new TMGMSG,TMGFDA
714 do LIST^DIC(50.6814,","_vapIEN_",",".01;1","","*",,,,,,"TMGFDA","TMGMSG")
715 if $data(TMGMSG("DIERR"))'=0 do goto VSDone
716 . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
717 new i
718 for i=1:1:+$get(TMGFDA("DILIST",0)) do
719 . write " ",$get(TMGFDA("DILIST",1,i)),!
720 write "-------------------------------------------------",!
721 write "Use this drug to fix entry in FDA database"
722 new % set %=1
723 do YN^DICN write !
724 if %=1 set result=1
725
726VSDone
727 quit result
728
729
730Copy1(vapIEN,IEN)
731 ;"Purpose: to fill in missing answers in the record in 22706.9, from record in 50.68
732 ;"Input: vapIEN -- IEN in 50.68
733 ;" IEN -- IEN in 22706.9
734 ;"Result: 1 if OK to continue, 0 if error
735
736 new result set result=0 ;"default to failure
737 new error set error=0
738 new PriorErrorFound
739
740 new CompFields set CompFields=".08;.05^.09;15"
741 new TMGFDA,TMGMSG
742 new i,TMGField,vapField
743 for i=1:1:$length(CompFields,"^") do
744 . new field1,field2,comp
745 . new Value1,Value2
746 . set comp=$piece(CompFields,"^",i)
747 . set field1=$piece(comp,";",1)
748 . set field2=$piece(comp,";",2)
749 . set Value1=$$GET1^DIQ(22706.9,IEN,field1)
750 . set Value2=$$GET1^DIQ(50.68,vapIEN,field2)
751 . if (Value1="")&(Value2'="") do
752 . . set TMGFDA(22706.9,IEN_",",field1)=Value2
753
754 if $data(TMGFDA) do goto:(error=1) C1Done
755 . do FILE^DIE("EK","TMGFDA","TMGMSG")
756 . if $data(TMGMSG("DIERR"))'=0 do
757 . . set error=1
758 . . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
759
760 ;"Now prep to copy over ingredients...
761X1 new Itr,subIEN,IngredArray,tempIEN
762 set subIEN=$$ItrInit^TMGITR(50.6814,.Itr,vapIEN)
763 if subIEN>0 for do quit:($$ItrNext^TMGITR(.Itr,.subIEN)'>0)!(error=1)
764 . set tempIEN=+$piece($get(^PSNDF(50.68,vapIEN,2,subIEN,0)),"^",1)
765 . if tempIEN'>0 quit
766 . kill TMGFDA
767 . do FIND^DIC(22706.916,","_IEN_",",".01","AQ",tempIEN,"*",,,,"TMGFDA","TMGMSG")
768 . if $data(TMGMSG("DIERR"))'=0 do quit
769 . . set error=1
770 . . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
771 . if $get(TMGFDA("DILIST",0))>0 quit
772 . set IngredArray(tempIEN)="" ;"store ingredients. Next I'll see if they are new
773
774 set result=$$Add1Ingredients(IEN,.IngredArray)
775
776C1Done
777 quit result
778
779
780ManIngredients(Array,Answers,EntryList)
781 ;"Purpose: to Manually Add ingredients to a list of records
782 ;"Input: Array -- PASS BY REFERENCE. Array with data. Format same as for HandleList
783 ;" Answers -- PASS BY REFERENCE,
784 ;" An array that will link display numbers with IENs
785 ;" Answer(count)=IEN
786 ;" EntryList -- PASS BY REFERENCE -- an array of entries (user input values) to process.
787 ;" Format as follows.
788 ;" EntryList(Entry number)="" (same as count above)
789 ;"Result: None
790
791 new Itr,Count,IEN
792 new IngredArray
793 new result set result=1
794
795 set Count=$$ItrAInit^TMGITR("EntryList",.Itr)
796 if Count>0 for do quit:($$ItrANext^TMGITR(.Itr,.Count)'>0)
797 . set IEN=$piece($get(Answers(Count)),"^",1)
798 . if $data(IngredArray)=0 do
799 . . set result=$$AskManIngred(IEN,.IngredArray)
800 . else do
801 . . set result=$$Add1Ingredients(IEN,.IngredArray)
802 . ;"I could put in some undo code here...
803 . if result=0 kill IngredArray quit
804 . do ArrayKill(IEN,.Array)
805
806 quit
807
808
809AskManIngred(IEN,IngredArray)
810 ;"Purpose: To ask user for a list of ingredients, then add to record in 22706.9
811 ;"Input: IEN -- the IEN in 22706.9 to have ingredients added to
812 ;" IngredArray -- OPTIONAL. PASS BY REFERENCE, an OUT PARAMETER
813 ;" Ised to pass back out list of ingredients, so they can be used for other enteries
814 ;" Any former entries in list will be killed
815 ;"Result: 1 = OK To Continue, 0 if abort
816
817 new result set result=0
818 kill IngredArray
819
820 new DIC,Y
821 set DIC=50.416,DIC(0)="AEQML"
822 set DIC("A")="Enter a drug INGREDIENT to add (^ when done): "
823
824 for do quit:(+Y'>0)
825 . do ^DIC
826 . if +Y>0 set IngredArray(+Y)=""
827 . else write ! quit
828 . write " ... OK, added.",!
829
830 if $data(IngredArray)=0 goto AMIDone
831
832 write "Done adding new ingredients.",!!
833 new % set %=1
834 write "Ingredient List:",!
835 write "------------------------------",!
836 do ShowIngreds(.IngredArray)
837 write "Add INGREDIENT(S) to selected drugs:"
838 do YN^DICN write !
839 if %'=1 goto AMIDone
840
841 set result=$$Add1Ingredients(IEN,.IngredArray)
842
843AMIDone
844 quit result
845
846
847ShowIngreds(IngredArray)
848 ;"Purpose: to Show list of ingredients in array
849
850 new IEN,Itr
851 set IEN=$$ItrAInit^TMGITR("IngredArray",.Itr)
852 if IEN>0 for do quit:($$ItrANext^TMGITR(.Itr,.IEN)'>0)
853 . write " ",$$GET1^DIQ(50.416,IEN,.01),!
854
855 quit
856
857
858Add1Ingredients(IEN,IngredArray)
859 ;"Purpose: To put a list of ingredients into one (1) record in 22706.9
860 ;"Input: IEN -- the IEN in 22706.9 to load ingredients into
861 ;" IngredArray -- array with list of ingredients. Format as follows:
862 ;" IngredArray(ingredIEN)=""
863 ;" IngredArray(ingredIEN)=""
864 ;"Output: Ingredients will be added to 22706.9. Note: If ingredients are already present, they
865 ;" will be added a second time.
866 ;" Also, FillGenericName will be called to fill in TMGGeneric Name
867 ;"Results: 1 if OK to continue, 0 if error
868
869 new Itr,TMGFDA,TMGMSG,tempIEN
870 new result set result=0 ;"default to failure
871 new error set error=0
872
873 ;"Cycle through IngredArray, and set up FDA for adding to 22706.9
874 kill Itr,TMGFDA
875 set tempIEN=$$ItrAInit^TMGITR("IngredArray",.Itr)
876 if tempIEN'="" for do quit:(+$$ItrANext^TMGITR(.Itr,.tempIEN)'>0)
877 . new IENS set IENS="+"_tempIEN_","_IEN_"," ;" +# format with # as arbitrary unique number
878 . set TMGFDA(22706.916,IENS,.01)=tempIEN ;"an arbitrary index number
879 . set TMGFDA(22706.916,IENS,2)=tempIEN ;"a pointer to the ingredent
880
881 ;"Call UPDATE^DIE with FDA
882 if $data(TMGFDA) do goto:(error=1) ADIDone
883 . new TMGIEN
884 . do UPDATE^DIE("","TMGFDA","TMGIEN","TMGMSG")
885 . if $data(TMGMSG("DIERR"))'=0 do
886 . . set error=1
887 . . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
888
889 ;"Create a generic name from ingredients
890 do FillGenericName^TMGNDF1C(IEN)
891
892 set result=1 ;"success
893ADIDone
894 quit result
Note: See TracBrowser for help on using the repository browser.