source: cprs/branches/tmg-cprs/m_files/TMGNDF3A.m@ 1176

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

Initial upload
File size: 104.7 KB
RevLine 
[796]1TMGNDF3A ;TMG/kst/FDA Import: Drug class stuff ;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 TMGNDF2C
6 ;" Primarily working VA DRUG CLASS stuff.
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 ;"FillFromVADrugClass -- ensure that all the entries in TMG FDA IMPORT COMPILED
17 ;" have a value for field VA DRUG CLASS
18 ;"HandleEmptyClasses -- allow classification of all unclassified drugs (ones
19 ;" with no potential match found in VistA database as a
20 ;" starting point)
21
22 ;"=======================================================================
23 ;" Private Functions.
24 ;"=======================================================================
25 ;"ShowClasses -- Display all the drug classes, in a heirarchy.
26 ;"GetClasses(Array) -- Purpose: To get an array back the shows the heirarchy of all VA DRUG classes
27 ;"KillIntro(Array) One of the drug classes is AA000, INTRODUCTION. This will kill entry from the Array
28 ;"GetClHeirarchy(ClassIEN,Array) -- get an array back the shows the heirarchy of one VA DRUG class
29 ;"FixClasses -- fix VA DRUG CLASS records which are not properly linked into the heirarchy.
30 ;"Fix1Class(IEN) -- fix the parent entry of one erroneous class, in the VA DRUG CLASS heirarchy.
31 ;"GetInfo(IEN,Array) -- fill record from VA DRUG CLASS file into a usable array
32 ;"TestSelectClass
33 ;"$$SelectClass(Array,AskSub) -- Allow user to browse Array and select drug class
34 ;"Search4Class() -- use Fileman to search for a drug class
35 ;"$$SelectFrom(pRef) -- Allow user to browse Array and select drug class
36 ;"SrchItems(input,Items) -- Search through Items array for input, and return index number if found
37 ;"TestGather
38 ;"GatherClasses(Array)
39 ;"GetPossClass(IEN,Array) -- gather, from a list of possible drug matches, a list of possible VA DRUG CLASSESS
40 ;"VerifyClasses(Array) -- allow user to accept or reject proposed drug class for new drugs.
41 ;"ShowInstructions()
42 ;"LookupHelp()
43 ;"FindHelp()
44 ;"SimHelp()
45 ;"ShowList(Array,Answers,CompactMode,ShowBoth) -- To display the list generated by GatherClasses, by class orginization
46 ;"DoSetClass(Array,Answers,List) -- add ClassIEN to field .09 (VA DRUG CLASS) in file TMG FDA IMPORT COMPILED
47 ;"ShowInfo(Array,Answers,Num) -- show more about the specified drug
48 ;"DoRemove(Array,Answers,List,ByTradeName,FromECode,Cancelled) -- remove entries from Array and Answers
49 ;"DoLookup(Array,Answers,Classes,List,Cancelled) -- Manually lookup class for entries
50 ;"WriteClass(ClassIEN,Array,Answers,List) -- do the actual setting of the class
51 ;"ClrAnswers(Array,Answers,List,FromECode,UndoArray) -- remove entries from Array and Answers array.
52 ;"VerifyWrite(ClassName,Answers,List) -- display list of entries and ask user if class set is desired
53 ;"Disp2List(Answers,List,ByTradeName,ShowBoth) -- interfact to DisplayList function, to allow easier input.
54 ;"DisplayList(Answers,List,Piece,AlsoPiece) -- display list of entries
55 ;"SimilarPick(Array,Answers,List,Cancelled) -- allow user to specify that a set of numbers should use the same class as
56 ;"FindPick(Array,Answers,List,FromECode,Cancelled) -- allow user to look up a drug already in the VistA database, and use the
57
58 ;"GatherEmpties(Array) -- scan through all records in TMG FDA IMPORT COMPILED, and create an array of
59 ;"ShowEList(Array,Answers,CompactMode,ByTradeName,ShowBoth) -- display the list of 'Empty' classes generated by GatherEmpties
60 ;"ClassEClasses(Array) -- allow user to classify drugs with empty (none) VA Drug Class
61 ;"DoGuess(Array,Answers,EntryList,Cancelled,Classes) -- a wrapper for DoEGuess
62 ;"DoEGuess(Array,Answers,List,ByTradeName,ShowBoth,Cancelled,FormECode,Classes) - guess as classification for entries.
63 ;"GGuessList(Array,Answers,List,Results) -- gather a guessing list of possible classes for each entry in List
64 ;"AutoEClassification(Array) -- attempt to automatically classiffy drugs that have not potential match
65 ;"Guess1(Array,Answers,List) -- return a guessed class, IF there is only one possible guess.
66 ;"DoSetTools(Array,Answers,List,EntryS,ByTradeName,ShowBoth) -- tools for managing SETS to be worked on (List)
67 ;"MkSrchList(Answers,List,ByTradeName,ShowBoth) -- search through Answers for string
68
69 ;"=======================================================================
70 ;"=======================================================================
71
72 ;"This block of code will deal with establishing the VA DRUG CLASS
73
74Menu
75 ;"Purpose: Provide menu to entry points of main routines
76
77 new Menu,UsrSlct
78 set Menu(0)="Pick Option for Filling Import Drug Class (3A)"
79 set Menu(1)="Set class by Linked VA PRODUCT entry if Possible"_$char(9)_"FillByLink"
80 set Menu(2)="Fill DRUG class for IMPORT entries from best guess."_$char(9)_"FillFromVADrugClass"
81 set Menu(3)="Fill DRUG class for IMPORT entries with no guess."_$char(9)_"HandleEmptyClasses"
82 set Menu(4)="Use SELECTOR to browse and edit IMPORT classes"_$char(9)_"SelEdClasses"
83 set Menu(5)="Pick just 1 import and edit drug Class"_$char(9)_"Edit1"
84 set Menu(6)="Pick imports to SKIP based on their drug CLASS"_$char(9)_"PickSkips"
85 set Menu("P")="Prev Stage"_$char(9)_"Prev"
86 set Menu("N")="Next Stage"_$char(9)_"Next"
87
88MC1
89 write #
90 set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^")
91 if UsrSlct="^" goto MCDone
92 if UsrSlct=0 set UsrSlct=""
93
94 if UsrSlct="FillFromVADrugClass" do FillFromVADrugClass goto MC1
95 if UsrSlct="HandleEmptyClasses" do HandleEmptyClasses goto MC1
96 if UsrSlct="FillByLink" do FillByLink goto MC1
97 if UsrSlct="SelEdClasses" do SelEdClasses goto MC1
98 if UsrSlct="Edit1" do Ed1Classes goto MC1
99
100 if UsrSlct="PickSkips" do PickSkips^TMGNDF3B goto MC1
101
102 if UsrSlct="Prev" goto Menu^TMGNDF2H ;"quit can occur from there...
103 if UsrSlct="Next" goto Menu^TMGNDF3C ;"quit can occur from there...
104
105 goto MC1
106MCDone
107 quit
108
109
110
111FillFromVADrugClass
112 ;"Purpose: to provide a high-level entry point for ensuring that all the entries
113 ;" in TMG FDA IMPORT COMPILED have a value for field VA DRUG CLASS
114
115 write #
116 write "======================================================",!
117 write "Link FDA import entries to proper VA DRUG CLASS",!
118 write "======================================================",!,!
119
120 ;"do FillByLink ;"see if any easy links are all ready to go...
121 new list
122 new % set %=2
123 if $data(^TMG("TMP","DRUGS NEEDING CLASS"))>0 do
124 . write !,"Infomation from a prior run found.",!
125 . write "Use older info (recommended only during the same import cycle)"
126 . set %=1 do YN^DICN write !
127 . if %=1 do
128 . . write "Loading... "
129 . . merge list=^TMG("TMP","DRUGS NEEDING CLASS")
130 . . write "Done.",!
131 if (%=-1) goto FDCDone
132 if (%=2) do
133 . write "Scanning drug file...",!
134 . do GatherClasses(.list)
135 . do AutoEClassification(.list)
136 do VerifyClasses(.list)
137
138 set %=1
139 write "Save information for future use"
140 do YN^DICN write !
141 if %=1 do SaveList(.list)
142
143FDCDone write "Done.",!
144 quit
145
146
147SaveList(List)
148 ;"Purpse: save list
149 kill ^TMG("TMP","DRUGS NEEDING CLASS")
150 merge ^TMG("TMP","DRUGS NEEDING CLASS")=list
151
152 quit
153
154
155FillByLink
156 ;"Purpose: Fill Drug class for any drug that has an empty class, but points to
157 ;" an entry in 50.68
158
159 write "Setting DRUG CLASS of imports from VA PRODUCT link, if possible.",!
160 new count set count=0
161 new Itr,IEN
162 set IEN=$$ItrInit^TMGITR(22706.9,.Itr)
163 do PrepProgress^TMGITR(.Itr,20,0,"IEN")
164 if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)
165 . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;"1=SKIP
166 . new CurClass,newClass
167 . set CurClass=+$piece($get(^TMG(22706.9,IEN,1)),"^",5)
168 . if CurClass=0 do
169 . . new vapIEN set vapIEN=+$piece($get(^TMG(22706.9,IEN,2,1,0)),"^",1)
170 . . if vapIEN=0 quit
171 . . set newClass=+$piece($get(^PSDNF(50.68,vapIEN,3)),"^",1)
172 . . if newClass'=0 do
173 . . . ;"write IEN," can be loaded with class: ",newClass,!
174 . . . new TMGFDA,TMGMSG
175 . . . set TMGFDA(22706.9,IEN_",",.09)=newClass
176 . . . ;"set $piece(^TMG(22706.9,IEN,1),"^",5)=newClass
177 . . . do FILE^DIE("K","TMGFDA","TMGMSG")
178 . . . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
179 . . . set count=count+1
180 do ProgressDone^TMGITR(.Itr)
181
182 write count," entries modified.",!
183 do PressToCont^TMGUSRIF
184 quit
185
186
187ShowClasses
188 ;"Purpose: to display all the drug classes, in a heirarchy.
189
190 new Array
191 do GetClasses(.Array)
192 do ArrayDump^TMGDEBUG("Array")
193 quit
194
195
196GetClasses(Array)
197 ;"Purpose: To get an array back the shows the heirarchy of all VA DRUG classes
198 ;" Array -- PASS BY REFERENCE, and OUT PARAMETER
199 ;"Output: Array will be filled as follows:
200 ;" Array(GGF-IEN)=e.g. ""AD000^ANTIDOTES,DETERRENTS AND POISON CONTROL"
201 ;" Array(GGF-IEN,GF-IEN)=e.g. "AD100^ALCOHOL DETERRENTS"
202 ;" Array(GGF-IEN,GF-IEN,F-IEN)=e.g. "AD150^ALCOHOL DETERRENTS -- GENERAL TYPE 1"
203 ;" Array(GGF-IEN,GF-IEN,F-IEN,IEN)=e.g. "AD152^ALCOHOL DETERRENTS -- GENERAL TYPE 1b"
204 ;" Note: prior entries in Array are NOT killed.
205 ;"Results: none
206
207 new IEN
208 set IEN=$order(^PS(50.605,0))
209 if +IEN>0 for do quit:(+IEN'>0)
210 . do GetClHeirarchy(IEN,.Array)
211 . set IEN=$order(^PS(50.605,IEN))
212
213 quit
214
215KillIntro(Array)
216 ;"Purpose: One of the drug classes is AA000, INTRODUCTION. This will kill this
217 ;" entry from the Array
218 ;"Input: Array -- Array, as created by GetClasses
219
220 new IEN
221 set IEN=$order(Array(""))
222 if IEN'="" for do quit:(IEN="")
223 . new temp set temp=IEN
224 . set IEN=$order(Array(IEN))
225 . if $piece(Array(temp),"^",1)="AA000" kill Array(temp)
226
227 quit
228
229
230GetClHeirarchy(ClassIEN,Array)
231 ;"Purpose: To get an array back the shows the heirarchy of one VA DRUG class
232 ;"Input: ClassIEN -- the IEN in file VA DRUG CLASS (50.605)
233 ;" Array -- PASS BY REFERENCE, and OUT PARAMETER
234 ;"Output: Array will be filled as follows:
235 ;" Array(GGF-IEN)=e.g. ""AD000^ANTIDOTES,DETERRENTS AND POISON CONTROL"
236 ;" Array(GGF-IEN,GF-IEN)=e.g. "AD100^ALCOHOL DETERRENTS"
237 ;" Array(GGF-IEN,GF-IEN,F-IEN)=e.g. "AD150^ALCOHOL DETERRENTS -- GENERAL TYPE 1"
238 ;" Array(GGF-IEN,GF-IEN,F-IEN,IEN)=e.g. "AD152^ALCOHOL DETERRENTS -- GENERAL TYPE 1b"
239 ;" Note: prior entries in Array are NOT killed.
240 ;"Results: none
241
242 new ParentClass,indent
243 new ResultArray
244
245 if (+ClassIEN'=0) for do quit:(+ClassIEN=0)
246 . new tempArray
247 . if $data(ResultArray) do
248 . . new temp merge temp=ResultArray
249 . . kill ResultArray
250 . . merge ResultArray(ClassIEN)=temp
251 . new Curnode,Code,Name,CodeNum
252 . set Curnode=$get(^PS(50.605,ClassIEN,0))
253 . set Code=$piece(Curnode,"^",1)
254 . set CodeNum=+$extract(Code,3,5)
255 . set Name=$piece(Curnode,"^",2)
256 . set tempArray(ClassIEN)=Code_"^"_Name
257 . set ParentClass=$piece(Curnode,"^",3)
258 . if ParentClass=ClassIEN set ParentClass=0 ;"I found at least one circular ref.
259 . if (ParentClass=0)&(CodeNum'=0) do
260 . . write IEN,": ",Name," appears broken: ",Code," Will fix...",!
261 . . do Fix1Class(IEN)
262 . set ClassIEN=ParentClass
263 . merge ResultArray=tempArray
264
265 merge Array=ResultArray
266
267 quit
268
269
270FixClasses
271 ;"Purpose: I have found a few instances in the VA DRUG CLASS file where records are
272 ;" not properly linked into the heirarchy. They either give themselves as
273 ;" their own parents, or list no parent, though one should be present.
274 ;" If any such entries exist, this function will fix them.
275
276 new IEN
277 set IEN=$order(^PS(50.605,0))
278 if +IEN>0 for do quit:(+IEN'>0)
279 . new Curnode,Code,CodeNum,Name
280 . set Curnode=$get(^PS(50.605,IEN,0))
281 . set Code=$piece(Curnode,"^",1)
282 . set CodeNum=+$extract(Code,3,5)
283 . set Name=$piece(Curnode,"^",2)
284 . set ParentClass=+$piece(Curnode,"^",3)
285 . if ParentClass=IEN set ParentClass=0
286 . if (ParentClass=0)&(CodeNum'=0) do
287 . . write IEN,": ",Name," appears broken: ",Code," Will fix...",!
288 . . do Fix1Class(IEN)
289 . set IEN=$order(^PS(50.605,IEN))
290
291 quit
292
293
294Fix1Class(IEN)
295 ;"Purpose: To fix the parent entry of one erroneous class, in the VA DRUG CLASS heirarchy.
296 ;"Input: IEN -- the record number in VA DRUG CLASS to fix
297 ;"Output: the database will be changed
298 ;"Results: none.
299
300 new Curnode,Code,CodeNum,ParentCode
301 new ParentClass,NewParentClass
302
303 set Curnode=$get(^PS(50.605,IEN,0))
304 set Code=$piece(Curnode,"^",1)
305 set ParentClass=+$piece(Curnode,"^",3)
306
307 set ParentCode=$extract(Code,1,2)_"000"
308 set NewParentClass=+$order(^PS(50.605,"B",ParentCode,""))
309
310 if NewParentClass'=0 do
311 . set $piece(^PS(50.605,IEN,0),"^",3)=NewParentClass
312
313 quit
314
315
316GetInfo(IEN,Array)
317 ;"Purpose: to fill record from VA DRUG CLASS file into a usable array
318 ;"Input: IEN -- the IEN from VA DRUG CLASS file to get info for
319 ;" Array -- PASS BY REFERENCE, to be filled in with data. Old data is KILLED.
320 ;"Output: Array is filled with data:
321 ;" Array("NAME")=name
322 ;" Array("CODE")=code
323 ;" Array("PARENT IEN")=parent IEN
324 ;"Result: none
325
326 new Curnode
327 kill Array
328
329 set Curnode=$get(^PS(50.605,IEN,0))
330 set Array("CODE")=$piece(Curnode,"^",1)
331 set Array("NAME")=$piece(Curnode,"^",2)
332 set Array("PARENT IEN")=+$piece(Curnode,"^",3)
333
334 quit
335
336 ;"----------------------
337TestSelectClass
338
339 new Array,IEN
340
341 do GetClasses(.Array)
342 do KillIntro(.Array)
343 set IEN=$$SelectClass(.Array,1)
344
345 write "IEN=",IEN,!
346
347 quit
348
349
350SelectClass(Array,AskSub)
351 ;"Purpose: Allow user to browse Array and select drug class
352 ;"Input: Array -- An Array containing Drug Class info, as created by GetClasses()
353 ;" AskSub -- OPTIONAL. If 1, user is asked if they want to browse sub-class (auto otherwise)
354 ;"Results: Returns IEN of selected class, or 0 if not selected
355
356 new IEN,done
357 set done=0
358 set AskSub=$get(AskSub,0) ;"default=automatic browse of subclasses
359 new pRef set pRef=$name(Array)
360
361 for do quit:(done=1)
362 . set IEN=$$SelectFrom(pRef)
363 . if IEN=0 do quit
364 . . if $qlength(pRef)>0 do
365 . . . set pRef=$name(@pRef,$qlength(pRef)-1)
366 . . else set done=1
367 . new skipSub set skipSub=0
368 . if (AskSub=1)&($data(Array(IEN))>1) do
369 . . new %
370 . . write "Browse sub-categories"
371 . . set %=1 do YN^DICN write !
372 . . if %'=1 set skipSub=1
373 . if ($data(Array(IEN))>1)&(skipSub=0) set pRef=$name(@pRef@(IEN))
374 . else do
375 . . new info,%
376 . . do GetInfo(IEN,.info)
377 . . write "Select: ",info("NAME")
378 . . set %=1 do YN^DICN write !
379 . . if %=1 set done=1
380
381 quit IEN
382
383
384Search4Class()
385 ;"Purpose: to use Fileman to search for a drug class
386 ;"Results: Returns IEN of selected class, or 0 if not selected
387
388 new DIC,X,Y
389 set DIC=50.605
390 set DIC(0)="AEQM"
391 set DIC("A")="Enter a DRUG CLASS to search for // "
392 do ^DIC write !
393 new result set result=0
394 if +Y>0 set result=+Y
395 quit result
396
397
398SelectFrom(pRef)
399 ;"Purpose: Allow user to browse Array and select drug class
400 ;"Input: pRef -- NAME OF part of array to browse, containing Drug Class info
401 ;"Results: Returns IEN of selected class, or 0 if not selected
402
403 new tempList,Items,Answers,name
404 new i,count
405 new result set result=0
406
407 set i=""
408 for set i=$order(@pRef@(i)) quit:(+i'>0) do
409 . set name=$piece($get(@pRef@(i)),"^",2) quit:(name="")
410 . new class set class=$piece($get(@pRef@(i)),"^",1) quit:(class="")
411 . set tempList(name)=i
412 . set tempList(name,class)=""
413
414 set count=1
415 set name=$order(tempList(""))
416 if name'="" for do quit:(name="")
417 . set Items(count)=name
418 . set Items(count,"CLASS")=$order(tempList(name,""))
419 . set Answers(count)=$get(tempList(name))
420 . set count=count+1
421 . set name=$order(tempList(name))
422
423 new done set done=0
424 for do quit:(done=1)
425 . new name set name=$piece($get(@pRef),"^",2)
426 . if name="" set name="Major Drug Classes"
427 . write !,"Select from one of these ",name,!
428 . set i=$order(Items(0))
429 . if +i>0 for do quit:(+i'>0)
430 . . write i,". "
431 . . new class set class=$get(Items(i,"CLASS"))
432 . . if class'="" write class,": "
433 . . write Items(i),!
434 . . set i=$order(Items(i))
435 . write !,"Enter # of Drug Class to Pick (^ to Backup, S to Search): ^// "
436 . new input
437 . read input:$get(DTIME,3600),!
438 . set input=$$UP^XLFSTR(input)
439 . if input="" set input="^"
440 . if input="S" do quit:(done=1)
441 . . new UsrIEN set UsrIEN=$$Search4Class
442 . . if UsrIEN>0 set result=UsrIEN,done=1
443 . if input="?" do quit
444 . . do LookupHelp()
445 . . new temp read "-- Press ENTER to continue --",temp:$get(DTIME,3600),!
446 . if input="" set input="^"
447 . if input="^" set done=1 quit
448 . if +input=input do
449 . . set result=Answers(input)
450 . . set done=1
451 . else do
452 . . new temp set temp=$$SrchItems(input,.Items)
453 . . if +temp>0 set result=Answers(temp),done=1
454 . . else write "Invalid input. Please try again.",!
455
456 quit result
457
458
459SrchItems(input,Items)
460 ;"Purpose: to Search through Items array for input, and return index number if found
461 ;"Input: input -- the user input -- may be a partial match for the name.
462 ;" Items -- PASS BY REFERENCE -- Input array, as created in SelectFrom()
463 ;" Items(1)=value
464 ;" Items(2)=value
465 ;" Items(3)=value
466 ;"
467 ;"Result: returns index of the FIRST match
468
469 new result set result=""
470 new done set done=0
471 new value
472 set input=$$UP^XLFSTR($get(input))
473 new i set i=$order(Items(""))
474 if i'="" for do quit:(i="")!(done=1)
475 . set value=$get(Items(i))
476 . set value=$extract(value,1,$length(input))
477 . if input=value set result=i,done=1
478 . set i=$order(Items(i))
479
480 quit result
481
482
483 ;"=============================================
484GatherClasses(Array)
485 ;"Purpose: To scan through all records in TMG FDA IMPORT COMPILED, and create an array of
486 ;" possible entries for VA DRUG CLASS
487 ;"Input: Array -- PASS BY REFERENCE, and OUT PARAMETER
488 ;"Output: Array will be filled as follows:
489 ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode
490 ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode
491 ;" Array(DrugIEN,"?")=""
492 ;" Array("?",DrugIEN)=""
493 ;"Results: none
494 ;"Note: if SKIP THIS RECORD field is set, then record will be skipped.
495 ;" Also, if there is already an antry for the VA DRUG CLASS field, then will be skipped.
496
497 write "Gathering information about entries with no current DRUG CLASS",!
498 new Itr,IEN
499 set IEN=$$ItrInit^TMGITR(22706.9,.Itr)
500 do PrepProgress^TMGITR(.Itr,20,0,"IEN")
501 if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)
502 . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;"1=SKIP
503 . new PriorClass set PriorClass=+$piece($get(^TMG(22706.9,IEN,1)),"^",5)
504 . if PriorClass>0 quit
505 . new numRecs set numRecs=+$piece($get(^TMG(22706.9,IEN,3,0)),"^",4) ;"VA PRODUCT POSS MATCH
506 . if numRecs=0 quit
507 . do GetPossClass(IEN,.Array)
508 do ProgressDone^TMGITR(.Itr)
509
510 quit
511
512
513GetPossClass(IEN,Array)
514 ;"Purpose: To gather, from a list of possible drug matches, a list of possible VA DRUG CLASSESS
515 ;"Input: IEN -- IEN from TMG FDA IMPORT COMPILED (22706.9) file, to check.
516 ;" Array -- PASS BY REFERENCE. An OUT PARAMETER
517 ;"Output: Array filled as follows:
518 ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose
519 ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose
520 ;" Array(DrugIEN,"?")=""
521 ;" Array("?",DrugIEN)=""
522
523 new subIEN
524 new TMGTradename set TMGTradename=$piece($get(^TMG(22706.9,IEN,0)),"^",4)
525 set subIEN=$order(^TMG(22706.9,IEN,3,0))
526 new Dose set Dose=$piece($get(^TMG(22706.9,IEN,0)),"^",2)
527 new Units set Units=$piece($get(^TMG(22706.9,IEN,0)),"^",3)
528
529 if +subIEN>0 for do quit:(+subIEN'>0)
530 . new DrugIEN set DrugIEN=+$get(^TMG(22706.9,IEN,3,subIEN,0))
531 . set subIEN=$order(^TMG(22706.9,IEN,3,subIEN))
532 . if DrugIEN=0 set Array(IEN,"?")="" quit
533 . new ClassIEN set ClassIEN=+$get(^PSNDF(50.68,DrugIEN,3))
534 . if ClassIEN=0 set Array(IEN,"??")="" quit
535 . new Info
536 . do GetInfo(ClassIEN,.Info)
537 . set Array("POSS MATCH",$get(Info("NAME")),TMGTradename,IEN)=ClassIEN_"^"_$get(Info("CODE"))_"^"_Dose_" "_Units
538 else do
539 . set Array(IEN,"?")=""
540 . set Array("?",IEN)=""
541
542 quit
543
544
545
546VerifyClasses(Array)
547 ;"Purpose: To allow user to accept or reject proposed drug class for new drugs.
548 ;"Input: Array -- PASS BY REFERENCE the array generated by GatherClasses
549 ;"Output: Database is changed, by adding data to field .09 (VA DRUG CLASS)
550 ;"Results: none
551
552 new done set done=0
553 new input set input="R"
554 new Answers
555 new CompactMode set CompactMode=1 ;" (list display mode: 1=compact, 0=verb
556 new ShowBoth set ShowBoth=1
557 new ByIngred set ByIngred=0
558 new EntryList,EntryS,Fn,Cancelled
559 set Cancelled=0
560
561 new Classes
562 do GetClasses(.Classes)
563 do KillIntro(.Classes)
564
565 for do quit:(done=1)
566 . if input="R" do
567 . . write !!
568 . . write "--------------------------------------------------",!
569 . . write "Specify which drugs are in the correct DRUG CLASS",!
570 . . write "--------------------------------------------------",!
571 . . do ShowList(.Array,.Answers,CompactMode,ShowBoth,ByIngred)
572 . . do SaveList(.Array) ;"1/31/07 I got tired of loosing work after crashes, so will save each time...
573 . . write "--------------------------------------------------",!
574 . . write "Specify which drugs are in the correct DRUG CLASS",!
575 . . write "--------------------------------------------------",!
576 . . write " R to refresh, L lookup, ? for instructions, U to undo, V saVe",!
577 . . write " X remove from list, N iNfo, S similar, F find",!
578 . . write " C turn compact display ",$select((CompactMode=1):"OFF",1:"ON"),", B turn show Both names ",$select((ShowBoth=1):"OFF",1:"ON"),!
579 . . write " I turn sort by Ingredients ",$select((ByIngred=1):"OFF",1:"ON")," G Guess class",!
580 . . if $get(EntryS)'="" write " Current SET #'s: ",EntryS,", D to delete SET",!
581 . . write " # or #-# or #,#-#,# etc., ^ done, ",!
582 . write "Enter number(s) to ACCEPT drug class (or codes listed above): ^//"
583 . read input:$get(DTIME,3600),!
584 . if input="" set input="^"
585 . set input=$$UP^XLFSTR(input)
586 . if input="^" set done=1 quit
587 . else if (input="?") do
588 . . do ShowInstructions()
589 . . set input="R"
590 . else if input="N" do quit
591 . . read "Enter number of drug to get info about: ^//",input,!
592 . . do ShowInfo(.Array,.Answers,+input)
593 . . set input="R"
594 . else if input="C" do quit
595 . . set CompactMode='CompactMode
596 . . set input="R"
597 . else if input="D" do quit;"---- delete set
598 . . kill EntryList,EntryS
599 . . set input="R"
600 . else if input="U" do quit
601 . . do Undo(.Array)
602 . . set input="R"
603 . else if input="V" do quit
604 . . do SaveList(.Array)
605 . . write "List Saved.",!
606 . else if input="I" do quit
607 . . set ByIngred='ByIngred
608 . . set input="R"
609 . else if input="B" do quit
610 . . set ShowBoth='ShowBoth
611 . . set input="R"
612 . else if input="L" do quit;"<----- Lookup manually
613 . . set Fn="do DoLookup(.Array,.Answers,.Classes,.EntryList,0,.Cancelled)"
614 . . do XMenuOption("lookup manually",Fn,"LookupHelp",.EntryList,.EntryS)
615 . else if input="G" do quit;" ---- guess drugs
616 . . set Fn="do DoGuess(.Array,.Answers,.EntryList,.Cancelled,.Classes)"
617 . . do XMenuOption("Guess Class",Fn,"LookupHelp",.EntryList,.EntryS)
618 . else if input="S" do quit
619 . . set Fn="do SimilarPick(.Array,.Answers,.EntryList,.Cancelled)"
620 . . do XMenuOption("classify by SIMILARITY","do SimilarPick(.Array,.Answers,.EntryList)","LookupHelp",.EntryList,.EntryS)
621 . else if input="X" do quit
622 . . set Fn="do DoRemove(.Array,.Answers,.EntryList,0,0,.Cancelled)"
623 . . do XMenuOption("REMOVE from list",Fn,"SimHelp",.EntryList,.EntryS)
624 . else if input="F" do quit
625 . . set Fn="do FindPick(.Array,.Answers,.EntryList,0,.Cancelled)"
626 . . do XMenuOption("classify by FINDING a similar drug",Fn,"FindHelp",.EntryList,.EntryS)
627 . else do ;"default is ACCEPT
628 . . set Cancelled=0
629 . . set Fn="do DoSetClass(.Array,.Answers,.EntryList)"
630 . . do XMenuOption("",Fn,"",.EntryList,.EntryS)
631 quit
632
633XMenuOption(Prompt,FnStr,HlpFn,EntryList,EntryS)
634 ;"Purpose: To carry out the various menu functions
635 ;"Input: Prompt: the message to use to prompt user to enter numbers etc.
636 ;" "Enter the Number(s) to" will be automatically provided
637 ;" and ": (? help) ^// " will be added at end
638 ;" FnStr: -- code to execute, e.g. "do DoLookup(.Array,.Answers,.Classes,.EntryList)"
639 ;" HlpFn: e.g. FindHelp, SimHelp, LookupHelp, etc Don't add () to name
640 ;" EntryList -- PASS BY REFERENCE
641 ;" EntryS -- PASS BY REFERENCE. a string showing current set as a string
642 ;"Note: makes use of global scope of 'input', and 'CompactMode', 'Cancelled'
643 ;"Result: none.
644
645 if $get(EntryS)="" do quit:(valid=0)
646 . if Prompt'="" do
647XMO1 . . write "Enter the Number(s) to ",Prompt,": (? help) ^// "
648 . . read input,!
649 . . if input="?" do goto XMO1
650 . . . new Code set Code="do "_HlpFn_"()"
651 . . . Xecute code
652 . set valid=$$MkMultList^TMGMISC(input,.EntryList)
653 . if valid set EntryS=input
654 Xecute FnStr
655 if CompactMode=1 set input="R"
656 if Cancelled=0 kill EntryList,EntryS
657
658 quit
659
660ShowInstructions()
661 ;"Purpose: to explain the matching proces
662
663 new temp
664 write !,"Instruction:",!!
665 write "Each drug that is to be added to the VistA database should have a drug CLASS.",!
666 write "This class is used by VistA for drug interaction and drug allergy screening.",!
667 write "As drugs are imported from the FDA database, the program attempts to determine",!
668 write "the class automatically by comparing the drug to other drugs that have already",!
669 write "been classified. This process is far from perfect and often produces incorrect",!
670 write "matches. A knowledgable user (you) must review each of these potential ",!
671 write "classifications and either accept them if accurate, or manually correct them.",!!
672 write "If a match is correct, it may be accepted by simply entering the number of the entry.",!
673 write "Multiple correct entries may be accepted at once by entering a range of numbers,",!
674 write "e.g. 3-18. A list may also be entered, e.g. 3,7,9,15. A combination of these may",!
675 write "also be entered, e.g. 1-20,32-45,50,75-100 etc.",!
676 write !
677 write "The list of drugs to be reviewed can be quite long (i.e. tens of thousands of ",!
678 write "drugs long), so a 'compact' mode is provided. When compact mode is ON, only",!
679 write "the last classifaction grouping is shown. This mode may be turned on or off by",!
680 write "entering 'C'",!
681 write !
682 read " --- Press ENTER to continue --",temp:$get(DTIME,3600),!
683 write #
684 write !,"Instruction (continued):",!!
685 write "Because many drug names may be unfamiliar, one may need to review the details of the",!
686 write "drug entry before being able to classify it. This may be done by typing 'I'. This",!
687 write "makes use of a standard Fileman record inquiry tool. Accept the default answers to",!
688 write "the questions 'STANDARD CAPTIONED OUTPUT?' and 'Include COMPUTED fields?'. The",!
689 write "entry in the file TMG FDA IMPORT COMPILED (a temporary file) will be displayed.",!
690 write "After displaying the info, it will ask to select another entry to display.",!
691 write "Just press enter exit and return to the matching process.",!
692 write !
693 write "A faster way to review the ingredients of drug entries is to turn on the ingredient-",!
694 write "display mode with 'G'. This will display the ingredient list after each drug in",!
695 write "the display.",!
696 write !
697 write "Once one is ready to correct a classification, a variety of tools are provided.",!
698 write "Each tool will first ask for the drug entry or entries that are to be classified.",!
699 write !
700 read " --- Press ENTER to continue --",temp:$get(DTIME,3600),!
701 write #
702 write !,"Instruction (continued):",!!
703 write "The first classification tool is the 'F' (find) command."
704 do FindHelp()
705 read " --- Press ENTER to continue --",temp:$get(DTIME,3600),!
706 write #
707 write !,"Instruction (continued):",!!
708 write "The next classification tool is the 'L' (lookup) command.",!
709 do LookupHelp()
710
711 read " --- Press ENTER to continue --",temp:$get(DTIME,3600),!
712 write #
713 write !,"Instruction (continued):",!!
714 write "The next tool is the 'S' (similarity) command."
715 do SimHelp()
716
717 read " --- Press ENTER to continue --",temp:$get(DTIME,3600),!
718 write #
719 write !,"Instruction (continued):",!!
720 write "And lastly entries may simply be removed from the list with the 'X' command.",!
721 write "They may be removed perminantly from consideration for addition to the Vista",!
722 write "database. This is appropriate for a drug that will never be used at your",!
723 write "location. Or, the drug may be just removed from the current work list.",!
724 write "This will leave the drugs unclassified and may cause DANGEROUS drug interactions",!
725 write "or drug allergies to be UNDETECTED when this drug is prescribed for a patient",!
726 write "later",!
727 write !
728 read " --- Press ENTER to continue --",temp:$get(DTIME,3600),!
729
730 quit
731
732
733LookupHelp()
734 ;"Purpose: Show help for the Lookup functionality
735
736 write "A list of drug classifications is shown to pick from. The VA DRUG CLASS system",!
737 write "arranges drug classes into a heirarchy. And initially only the highest level",!
738 write "classes are shown. Enter the number of a class to select it. If that class has",!
739 write "subclasses, then these will be shown. Select the subclass, and then verify it.",!
740 write "To backup, press ENTER or ^.",!
741 write !
742 quit
743
744
745FindHelp()
746 ;"Purpose: to show help for the FIND functionality
747
748 write !
749 write "This command allows one to find a drug already in the VistA database, and use",!
750 write "it's classification for the new drug in question.",!
751 write "For example, if one is asked to classify POTASSIUM GLUCONATE ELIXIR 20 MEQ,",!
752 write "there is a high likelihood that a similar drug already exists, and the matching",!
753 write "process failed to find it. So search for the drug as follows:",!
754 write "Enter drug name with desired DRUG CLASS// potassium gluc <--partial name entered",!
755 write " 1 POTASSIUM GLUCONATE 2.2MEQ TAB",!
756 write " 2 POTASSIUM GLUCONATE 2.6MEQ TAB",!
757 write " 3 POTASSIUM GLUCONATE 20MEQ/15ML (SF) ELIXIR",!
758 write " 4 POTASSIUM GLUCONATE 20MEQ/15ML ELIXIR",!
759 write " 5 POTASSIUM GLUCONATE 20MEQ/15ML LIQUID",!
760 write " Press <RETURN> to see more, '^' to exit this list, OR",!
761 write " CHOOSE 1-5: 4 POTASSIUM GLUCONATE 20MEQ/15ML ELIXIR <-- 4 entered",!
762 write !
763 write " DRUG CLASS: POTASSIUM",!
764 write " Use this for drug(s) below?:",!
765 write " entry: POTASSIUM GLUCONATE ELIXIR",!
766 write " --------------------------------------",!
767 write " Use DRUG CLASS [POTASSIUM] for drug(s) above? Yes// (Yes)",!!
768 quit
769
770SimHelp()
771 ;"Purpose: To show help for the Find Similar functionality
772
773 write !
774 write "This command allows one to set the drug class of the drug in question to be",!
775 write "the same as another drug shown in the display. For example:",!
776 write !
777 write "CLASS: CEPHALOSPORIN 3RD GENERATION",!
778 write "6068. TAZICEF FOR INJECTION 1 GM/VIAL",!
779 write !
780 write "CLASS: DENTIFRICES",!
781 write "7113. ALBION D PASTE DESENSITIZING DENTAL PROPHYLACTIC PASTE 8 %",!
782 write "7114. PLUS + WHITE DESENTIZING FLUORIDE TOOTHPASTE",!
783 write "7115. TAZICEF FOR INJECTION 1 GM",!
784 write !
785 write "Here it would be useful to specify that entry 7115 is SIMILAR to 6068.",!
786 write "This would set the class of 7155 to be CEPHALOSPORIN 3RD GENERATION.",!!
787 quit
788
789
790Undo(Array)
791 ;"Purpose: To allow user to undo an action that was done in error
792 ;"Input: Array -- PASS BY REFERENCE the array containing the data, AND UNDO info
793 ;" Array("UNDO","COUNT")=number of undo steps avail
794 ;" Array("UNDO",Event#,part#)=code to be eXecuted to reverse step.
795
796 ;"Note: Later, I may allow user to choose which items to undo, but for now, will
797 ;" just undo the very LAST action
798
799 new UndoCt set UndoCt=$get(Array("UNDO","COUNT"))
800 new i set i=$order(Array("UNDO",UndoCt,""))
801 if i'="" for do quit:(i="")
802 . new code set code=$get(Array("UNDO",UndoCt,i))
803 . do
804 . . new $etrap set $etrap="w ""??Progress function -- error trapped??"",!"
805 . . write code,!!
806 . . xecute code
807 . new oldI set oldI=i
808 . set i=$order(Array("UNDO",UndoCt,i))
809 . kill Array("UNDO",UndoCt,oldI)
810 . set Array("UNDO","COUNT")=UndoCt-1
811
812 quit
813
814
815ShowList(Array,Answers,CompactMode,ShowBoth,ByIngred)
816 ;"Purpose: To display the list generated by GatherClasses, by class orginization
817 ;"Input: Array -- the array containing the data
818 ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose
819 ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose
820 ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN,"INGRED")=Ingredients <--- optional
821 ;" Answers -- PASS BY REFERENCE. An array that will like display numbers with IENs
822 ;" Answer(count)=DrugIEN^DrugName^ClassIEN^ClassName
823 ;" Answer(count)=DrugIEN^DrugName^ClassIEN^ClassName
824 ;" CompactMode -- OPTIONAL, if value=1, then only the LAST drug class will be
825 ;" expanded (a potientially long list). Others will just show heading.
826 ;" ShowBoth -- OPTIONAL, if value=1, then VA GENERIC field & Tradename will be shown for each entry
827 ;" ByIngred -- OPTIONAL, if value=1, then list is shown sorted by Generic Name
828 ;"Output: List is shown, and the Answers array is established and passed back.
829 ;" Sometimes array is modified such that ingredient node is added
830 ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN,"INGRED")=Ingredients <--- optional
831 ;"Results: none.
832
833 new someShown set someShown=0
834 new count,ClassName,LastClass
835 set count=1
836 kill Answers
837 set CompactMode=$get(CompactMode,0)
838 set ShowBoth=$get(ShowBoth,0)
839 set ByIngred=$get(ByIngred,0)
840
841 if ByIngred=0 goto SL1 ;"Rather than try to merge the two processes, I just duplicated and modified
842
843 ;"Display sorted by ingredients
844
845 ;"First, resort array, by ingredients
846 ;" IngredArray format:
847 ;" IngredArray(ClassName,Ingred,IEN)=ClassIEN^ClassCode^DrugDose^TradeName
848 ;" IngredArray(ClassName,Ingred,IEN)=ClassIEN^ClassCode^DrugDose^TradeName
849 new IngredArray
850 set LastClass=$order(Array("POSS MATCH",""),-1)
851 set ClassName=$order(Array("POSS MATCH",""))
852 if ClassName'="" for do quit:(ClassName="")
853 . write !,"CLASS: ",ClassName,!
854 . new TMGTradeName
855 . new tempCount set tempCount=0
856 . set TMGTradeName=$order(Array("POSS MATCH",ClassName,""))
857 . if (CompactMode=1)&(ClassName'=LastClass) set TMGTradeName=""
858 . if TMGTradeName'="" for do quit:(TMGTradeName="")
859 . . new IEN,ClassIEN
860 . . set IEN=$order(Array("POSS MATCH",ClassName,TMGTradeName,""))
861 . . if IEN>0 for do quit:(IEN'>0)
862 . . . new Ingred,value,dose
863 . . . set value=$get(Array("POSS MATCH",ClassName,TMGTradeName,IEN))
864 . . . set Ingred=$get(Array("POSS MATCH",ClassName,TMGTradeName,IEN,"INGRED"))
865 . . . if Ingred="" do
866 . . . . set Ingred=$$GET1^DIQ(22706.9,IEN,.08)
867 . . . . set Array("POSS MATCH",ClassName,TMGTradeName,IEN,"INGRED")=Ingred
868 . . . if Ingred="" do
869 . . . . write "Couldn't find an ingredient name for file 22706.9, IEN=",IEN,!
870 . . . . set Ingred="?"
871 . . . if Ingred'="" do
872 . . . . set IngredArray(ClassName,Ingred,IEN)=value
873 . . . . set $piece(IngredArray(ClassName,Ingred,IEN),"^",4)=TMGTradeName
874 . . . set IEN=$order(Array("POSS MATCH",ClassName,TMGTradeName,IEN))
875 . . set TMGTradeName=$order(Array("POSS MATCH",ClassName,TMGTradeName))
876 . set ClassName=$order(Array("POSS MATCH",ClassName))
877
878
879 ;"Now display IngredArray
880 ;" IngredArray format:
881 ;" IngredArray(ClassName,Ingred,IEN)=ClassIEN^ClassCode^DrugDose^TradeName
882 ;" IngredArray(ClassName,Ingred,IEN)=ClassIEN^ClassCode^DrugDose^TradeName
883 set LastClass=$order(IngredArray(""),-1)
884 set ClassName=$order(IngredArray(""))
885 if ClassName'="" for do quit:(ClassName="")
886 . write !,"CLASS: ",ClassName,!
887 . new IngredName
888 . new tempCount set tempCount=0
889 . set IngredName=$order(IngredArray(ClassName,""))
890 . if (CompactMode=1)&(ClassName'=LastClass) set IngredName=""
891 . if IngredName'="" for do quit:(IngredName="")
892 . . new IEN,ClassIEN
893 . . set IEN=$order(IngredArray(ClassName,IngredName,""))
894 . . if IEN>0 for do quit:(IEN'>0)
895 . . . new value,dose,TMGTradeName
896 . . . set value=$get(IngredArray(ClassName,IngredName,IEN))
897 . . . set ClassIEN=$piece(value,"^",1)
898 . . . set dose=$piece(value,"^",3)
899 . . . set TMGTradeName=$piece(value,"^",4)
900 . . . write count,". ",IngredName," ",dose
901 . . . if ShowBoth write " (#",IEN,")"
902 . . . write !
903 . . . set tempCount=tempCount+1
904 . . . if (ShowBoth)&(TMGTradeName'="") write " (",TMGTradeName,")",!
905 . . . set Answers(count)=IEN_"^"_TMGTradeName_"^"_ClassIEN_"^"_ClassName
906 . . . set count=count+1
907 . . . set someShown=1
908 . . . set IEN=$order(IngredArray(ClassName,IngredName,IEN))
909 . . set IngredName=$order(IngredArrayArray(ClassName,IngredName))
910 . if tempCount>20 do
911 . . write "END CLASS: ",ClassName,!
912 . . set tempCount=0
913 . set ClassName=$order(IngredArray(ClassName))
914
915 goto SL2
916
917SL1 ;"Display sorted by tradename
918 set LastClass=$order(Array("POSS MATCH",""),-1)
919 set ClassName=$order(Array("POSS MATCH",""))
920 if ClassName'="" for do quit:(ClassName="")
921 . write !,"CLASS: ",ClassName,!
922 . new TMGTradeName
923 . new tempCount set tempCount=0
924 . set TMGTradeName=$order(Array("POSS MATCH",ClassName,""))
925 . if (CompactMode=1)&(ClassName'=LastClass) set TMGTradeName=""
926 . if TMGTradeName'="" for do quit:(TMGTradeName="")
927 . . new IEN,ClassIEN
928 . . set IEN=$order(Array("POSS MATCH",ClassName,TMGTradeName,""))
929 . . if IEN>0 for do quit:(IEN'>0)
930 . . . new value set value=$get(Array("POSS MATCH",ClassName,TMGTradeName,IEN))
931 . . . set ClassIEN=$piece(value,"^",1)
932 . . . new dose set dose=$piece(value,"^",3)
933 . . . ;"write count,". (",IEN,") ",TMGTradeName," ",dose,!
934 . . . write count,". ",TMGTradeName," ",dose
935 . . . if ShowBoth write " (#",IEN,")"
936 . . . write !
937 . . . set tempCount=tempCount+1
938 . . . if ShowBoth do
939 . . . . new Ingred
940 . . . . set Ingred=$get(Array("POSS MATCH",ClassName,TMGTradeName,IEN,"INGRED"))
941 . . . . if Ingred="" do
942 . . . . . set Ingred=$$GET1^DIQ(22706.9,IEN,.08)
943 . . . . . set Array("POSS MATCH",ClassName,TMGTradeName,IEN,"INGRED")=Ingred
944 . . . . if Ingred'="" write " (Same class as: ",Ingred,")",!
945 . . . set Answers(count)=IEN_"^"_TMGTradeName_"^"_ClassIEN_"^"_ClassName
946 . . . set count=count+1
947 . . . set someShown=1
948 . . . set IEN=$order(Array("POSS MATCH",ClassName,TMGTradeName,IEN))
949 . . set TMGTradeName=$order(Array("POSS MATCH",ClassName,TMGTradeName))
950 . if tempCount>20 do
951 . . write "END CLASS: ",ClassName,!
952 . . set tempCount=0
953 . set ClassName=$order(Array("POSS MATCH",ClassName))
954
955SL2 if 'someShown write " --- (List is Empty) ---",!
956
957SLDone quit
958
959
960DoSetClass(Array,Answers,List)
961 ;"Purpose: To add ClassIEN to field .09 (VA DRUG CLASS) in file TMG FDA IMPORT COMPILED
962 ;"Input: Array -- PASS BY REFERENCE, array holding data, As created by Gather Classes
963 ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose
964 ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose
965 ;" Array(DrugIEN,"?")=""
966 ;" Array("?",DrugIEN)=""
967 ;" Answers -- PASS BY REFERENCE, an array linking display number to IENS.
968 ;" Array should be the one created by ShowList
969 ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName
970 ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName
971 ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to process.
972 ;" Format as follows.
973 ;" List(Entry number)=""
974 ;" List(Entry number)=""
975 ;"Results: none
976
977 new DrugIEN,DrugName,ClassIEN,ClassName
978
979 new i
980 set i=$order(List(""))
981 if i'="" for do quit:(i="")
982 . set DrugIEN=+$piece($get(Answers(i)),"^",1)
983 . set DrugName=$piece($get(Answers(i)),"^",2)
984 . set ClassIEN=+$piece($get(Answers(i)),"^",3)
985 . set ClassName=$piece($get(Answers(i)),"^",4)
986 . if (DrugIEN'=0)&(ClassIEN'=0) do
987 . . new UndoCt set UndoCt=+$get(Array("UNDO","COUNT"))+1
988 . . new OldValue set OldValue=$piece($get(^TMG(22706.9,DrugIEN,1)),"^",5)
989 . . if OldValue="" set OldValue=""""""
990 . . if +OldValue'=OldValue set OldValue=""""_OldValue_""""
991 . . set Array("UNDO",UndoCt,1)="set $piece(^TMG(22706.9,"_DrugIEN_",1),""^"",5)="_OldValue
992 . . set $piece(^TMG(22706.9,DrugIEN,1),"^",5)=ClassIEN ;"I own file, and there are no XREF, so OK to direct set.
993 . . kill Answers(i)
994 . . set OldValue=$get(Array("POSS MATCH",ClassName,DrugName,DrugIEN))
995 . . if OldValue="" set OldValue=""""""
996 . . if +OldValue'=OldValue set OldValue=""""_OldValue_""""
997 . . set Array("UNDO",UndoCt,2)="set Array(""POSS MATCH"","""_ClassName_""","""_DrugName_""","_DrugIEN_")="_OldValue
998 . . set Array("UNDO","COUNT")=UndoCt
999 . . kill Array("POSS MATCH",ClassName,DrugName,DrugIEN)
1000 . set i=$order(List(i))
1001
1002 quit
1003
1004
1005ShowInfo(Array,Answers,Num)
1006 ;"Purpose: to show more about the specified drug
1007 ;"Input: Array -- PASS BY REFERENCE, array holding data, As created by Gather Classes
1008 ;" Answers -- PASS BY REFERENCE, an array linking display number to IENS.
1009 ;" Array should be the one created by ShowList
1010 ;" Num -- entry number to show
1011
1012 new DrugIEN set DrugIEN=+$piece($get(Answers(Num)),"^",1)
1013 if DrugIEN=0 quit
1014 do DumpRec^TMGDEBUG(22706.9,DrugIEN)
1015 quit
1016
1017
1018DoRemove(Array,Answers,List,ByTradeName,FromECode,Cancelled)
1019 ;"Purpose: To remove entries from Empty-class Array
1020 ;"Input: Array -- PASS BY REFERENCE, array holding data, As created by Gather Classes
1021 ;" Array("GENERIC NAME",VA GENERIC Name,DrugIEN)=""
1022 ;" Array("TRADE NAME",TradeName,DrugIEN)=""
1023 ;" Array("LINK GENERIC TO TRADE",TMGGeneric)=TradeName
1024 ;" Array("LINK TRADE TO GENERIC",TradeName)=TMGGeneric
1025 ;" Answers -- PASS BY REFERENCE, an array linking display number to IENS.
1026 ;" Array should be the one created by ShowEList
1027 ;" Answer(count)=DrugIEN^GenericDrugName^TradeName
1028 ;" Answer(count)=DrugIEN^GenericDrugName^TradeName
1029 ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to process.
1030 ;" Format as follows.
1031 ;" List(Entry number)=""
1032 ;" List(Entry number)=""
1033 ;" ByTradeName -- OPTIONAL, if value=1, then values are shown by TradeName
1034 ;" FromECode -- OPTIONAL, if value=1, then code is handled as if called from the 'empty'
1035 ;" code modules (ie HandleEmptyClasses)
1036 ;" Cancelled -- OPTIONAL, PASS BY REFERENCE, will be set to 1 if user cancelled.
1037 ;"Results: none
1038
1039 set ByTradeName=$get(ByTradeName,0)
1040 set Cancelled=1 ;"default is cancellation
1041
1042 write !,"Remove these drugs perminantly (i.e. don't add to VistA database)?",!
1043 do Disp2List(.Answers,.List,.ByTradeName)
1044
1045 write "Remove these drugs perminantly (i.e. don't add to VistA database)"
1046 new % set %=1 do YN^DICN write !
1047 new SetSkipFlag set SetSkipFlag=(%=1)
1048
1049 if %=2 do
1050 . write "Temporarily remove drugs from category listing"
1051 . do YN^DICN write !
1052 if %=2 goto DERMDone
1053
1054 new UndoArray
1055 new DrugIEN,DrugName,TradeName
1056 new i set i=$order(List(""))
1057 if i'="" for do quit:(i="")
1058 . set DrugIEN=+$piece($get(Answers(i)),"^",1)
1059 . new UndoCt set UndoCt=$order(UndoArray(i,""),-1)+1
1060 . if (DrugIEN>0)&(SetSkipFlag) do
1061 . . new OldValue set OldValue=$piece(^TMG(22706.9,DrugIEN,1),"^",4)
1062 . . if OldValue="" set OldValue=""""""
1063 . . if +OldValue'=OldValue set OldValue=""""_OldValue_""""
1064 . . set UndoArray(i,UndoCt)="set $piece(^TMG(22706.9,"_DrugIEN_",1),""^"",4)="_OldValue
1065 . . set $piece(^TMG(22706.9,DrugIEN,1),"^",4)=1 ;"I own file, and there are no XREF, so OK to direct set.
1066 . if (SetSkipFlag=0)&(FromECode=0) do
1067 . . set UndoArray(i,UndoCt)="kill Array("_DrugIEN_",""?"")"
1068 . . set UndoArray(i,UndoCt+1)="kill Array(""?"","_DrugIEN_")"
1069 . . set Array(DrugIEN,"?")=""
1070 . . set Array("?",DrugIEN)=""
1071 . set i=$order(List(i))
1072
1073 do ClrAnswers(.Array,.Answers,.List,.FromECode,.UndoArray)
1074
1075 new UndoCt set UndoCt=$get(Array("UNDO","COUNT"))
1076 set i=""
1077 for set i=$order(UndoArray(i)) quit:(i="") do
1078 . merge Array("UNDO",UndoCt)=UndoArray(i)
1079 . set UndoCt=UndoCt+1
1080 set Array("UNDO","COUNT")=UndoCt
1081
1082 set Cancelled=0 ;"set success here
1083
1084DERMDone
1085 quit
1086
1087
1088DoLookup(Array,Answers,Classes,List,FromECode,Cancelled)
1089 ;"Purpose: To Manually lookup class for entries
1090 ;"Input: Array -- PASS BY REFERENCE, array holding data, As created by Gather Classes
1091 ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose
1092 ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose
1093 ;" Array(DrugIEN,"?")=""
1094 ;" Array("?",DrugIEN)=""
1095 ;" Answers -- PASS BY REFERENCE, an array linking display number to IENS.
1096 ;" Array should be the one created by ShowList
1097 ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName
1098 ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName
1099 ;" Classes -- PASS BY REFERENCE, an array containing classes
1100 ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to process.
1101 ;" Format as follows.
1102 ;" List(Entry number)=""
1103 ;" List(Entry number)=""
1104 ;" FromECode -- OPTIONAL, if value=1, then code is handled as if called from the 'empty'
1105 ;" code modules (ie HandleEmptyClasses)
1106 ;" Cancelled -- OPTIONAL, PASS BY REFERENCE, will be set to 1 if user cancelled.
1107 ;"Results: none
1108
1109 set Cancelled=1 ;"default to cancellation
1110
1111 new UsrClassIEN
1112 set UsrClassIEN=$$SelectClass(.Classes)
1113 if UsrClassIEN=0 goto DLUDone
1114
1115 new ClassName set ClassName=$$GET1^DIQ(50.605,UsrClassIEN,1)
1116
1117 if $$VerifyWrite(ClassName,.Answers,.List)=0 goto DLUDone
1118
1119 do WriteClass(UsrClassIEN,.Array,.Answers,.List,.FromECode)
1120 set Cancelled=0 ;"set success here
1121
1122DLUDone
1123 quit
1124
1125
1126WriteClass(ClassIEN,Array,Answers,List,FromECode)
1127 ;"Purpose: To do the actual setting of the class
1128 ;"Input: ClassIEN -- the IEN of the class to set.
1129 ;" Array -- PASS BY REFERENCE, array holding data, As created by Gather Classes
1130 ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose
1131 ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose
1132 ;" Array(DrugIEN,"?")=""
1133 ;" Array("?",DrugIEN)=""
1134 ;" Note: Only needed to clear out entries that are no longer needed.
1135 ;" OR, if FromECode=1, then this Array format is used:
1136 ;" Array("GENERIC NAME",VA GENERIC Name,DrugIEN)=""
1137 ;" Array("TRADE NAME",TradeName,DrugIEN)=""
1138 ;" Array("LINK GENERIC TO TRADE",TMGGeneric)=TradeName
1139 ;" Array("LINK TRADE TO GENERIC",TradeName)=TMGGeneric
1140 ;" Answers -- PASS BY REFERENCE, an array linking display number to IENS.
1141 ;" Array should be the one created by ShowList
1142 ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName
1143 ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName
1144 ;" OR, if FromECode=1, then this format is used:
1145 ;" Answer(count)=DrugIEN^GenericDrugName^TradeName
1146 ;" Answer(count)=DrugIEN^GenericDrugName^TradeName
1147 ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to process.
1148 ;" Format as follows.
1149 ;" List(Entry number)=""
1150 ;" List(Entry number)=""
1151 ;" FromECode -- OPTIONAL, if value=1, then code is handled as if called from the 'empty'
1152 ;" code modules (ie HandleEmptyClasses)
1153 ;"Output: Data will be altered in file 22706.9
1154 ;" Array will be modified: Undo information will be added:
1155 ;" Array("UNDO","COUNT")=number of undo steps avail
1156 ;" Array("UNDO",Event#,part#)=code to be eXecuted to reverse step.
1157 ;"Results: none
1158
1159 new DrugIEN,DrugName,ClassName
1160 new UndoArray set UndoArray("")=""
1161 new i set i=$order(List(""))
1162 if i'="" for do quit:(i="")
1163 . set DrugIEN=+$piece($get(Answers(i)),"^",1)
1164 . if DrugIEN=0 goto WC1
1165 . new UndoCt set UndoCt=$order(UndoArray(i,""))+1
1166 . new OldValue set OldValue=$piece(^TMG(22706.9,DrugIEN,1),"^",5)
1167 . if OldValue="" set OldValue=""""""
1168 . if +OldValue'=OldValue set OldValue=""""_OldValue_""""
1169 . set UndoArray(i,UndoCt)="set $piece(^TMG(22706.9,"_DrugIEN_",1),""^"",5)="_OldValue
1170 . set $piece(^TMG(22706.9,DrugIEN,1),"^",5)=ClassIEN ;"I own file, and there are no XREF, so OK to direct set.
1171WC1 . set i=$order(List(i))
1172
1173 do ClrAnswers(.Array,.Answers,.List,.FromECode,.UndoArray)
1174
1175 set i=$order(UndoArray(""))
1176 new UndoCt set UndoCt=$get(Array("UNDO","COUNT"))
1177 if i'="" for do quit:(i="")
1178 . merge Array("UNDO",UndoCt)=UndoArray(i)
1179 . set UndoCt=UndoCt+1
1180 . set i=$order(UndoArray(i))
1181 set Array("UNDO","COUNT")=UndoCt
1182
1183WCDone
1184 quit
1185
1186
1187ClrAnswers(Array,Answers,List,FromECode,UndoArray)
1188 ;"Purpose: To remove entries from Array and Answers array.
1189 ;"Input: Array -- PASS BY REFERENCE, array holding data, As created by Gather Classes
1190 ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose
1191 ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose
1192 ;" Array(DrugIEN,"?")=""
1193 ;" Array("?",DrugIEN)=""
1194 ;" Note: Only needed to clear out entries that are no longer needed.
1195 ;" OR, if FromECode=1, then this Array format is used:
1196 ;" Array("GENERIC NAME",VA GENERIC Name,DrugIEN)=""
1197 ;" Array("TRADE NAME",TradeName,DrugIEN)=""
1198 ;" Array("LINK GENERIC TO TRADE",TMGGeneric)=TradeName
1199 ;" Array("LINK TRADE TO GENERIC",TradeName)=TMGGeneric
1200 ;" Answers -- PASS BY REFERENCE, an array linking display number to IENS.
1201 ;" Array should be the one created by ShowList
1202 ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName
1203 ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName
1204 ;" OR, if FromECode=1, then this format is used:
1205 ;" Answer(count)=DrugIEN^GenericDrugName^TradeName
1206 ;" Answer(count)=DrugIEN^GenericDrugName^TradeName
1207 ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to process.
1208 ;" Format as follows.
1209 ;" List(Entry number)=""
1210 ;" List(Entry number)=""
1211 ;" FromECode -- OPTIONAL, if value=1, then code is handled as if called from the 'empty'
1212 ;" code modules (ie HandleEmptyClasses)
1213 ;" UndoArray -- PASS BY REFERENCE -- an array to be filled with undo info
1214 ;" format as follows:
1215 ;" Array(list#,step#)=CodeToBeExecuted
1216 ;" Array(list#,step#)=CodeToBeExecuted
1217 ;"Output: Entries will be removed from list.
1218
1219 ;"Results: none
1220
1221 new DrugIEN,DrugName,ClassName
1222 new i
1223 set i=$order(List(""))
1224 if i'="" for do quit:(i="")
1225 . set DrugIEN=+$piece($get(Answers(i)),"^",1)
1226 . if DrugIEN=0 goto CA1
1227 . new UndoCt set UndoCt=$order(UndoArray(i,""))+1
1228 . if $get(FromECode)=1 do
1229 . . new GenericName,TradeName
1230 . . set GenericName=$piece($get(Answers(i)),"^",2)
1231 . . set TradeName=$piece($get(Answers(i)),"^",3)
1232 . . ;"save info for possible undo in the future
1233 . . new OldValue set OldValue=$get(Array("GENERIC NAME",GenericName,DrugIEN))
1234 . . if OldValue="" set OldValue=""""""
1235 . . if +OldValue'=OldValue set OldValue=""""_OldValue_""""
1236 . . set UndoArray(i,UndoCt)="set Array(""GENERIC NAME"","_GenericName_","_DrugIEN_")="_OldValue
1237 . . set UndoCt=UndoCt+1
1238 . . new OldValue set OldValue=$get(Array("TRADE NAME",TradeName,DrugIEN))
1239 . . if OldValue="" set OldValue=""""""
1240 . . if +OldValue'=OldValue set OldValue=""""_OldValue_""""
1241 . . set UndoArray(i,UndoCt)="set Array(""TRADE NAME"","_TradeName_","_DrugIEN_")="_OldValue
1242 . . ;"Now do real removal
1243 . . kill Array("GENERIC NAME",GenericName,DrugIEN)
1244 . . kill Array("TRADE NAME",TradeName,DrugIEN)
1245 . else do
1246 . . set DrugName=$piece($get(Answers(i)),"^",2)
1247 . . set ClassName=$piece($get(Answers(i)),"^",4)
1248 . . new OldValue set OldValue=$get(Array("POSS MATCH",ClassName,DrugName,DrugIEN))
1249 . . if OldValue="" set OldValue=""""""
1250 . . if +OldValue'=OldValue set OldValue=""""_OldValue_""""
1251 . . set UndoArray(i,UndoCt)="set Array(""POSS MATCH"","_ClassName_","_DrugName_","_DrugIEN_")="_OldValue
1252 . . kill Array("POSS MATCH",ClassName,DrugName,DrugIEN)
1253 . kill Answers(i) ;"I'm not sure how to undo this part. I think it's regenerated with each display of list
1254CA1 . set i=$order(List(i))
1255
1256 quit
1257
1258
1259VerifyWrite(ClassName,Answers,List,ByTradeName,ShowBoth)
1260 ;"Purpose: To display list of entries and ask user if class set is desired
1261 ;"Input: ClassName -- the name of the VA DRUG CLASS
1262 ;" Answers -- PASS BY REFERENCE, an array linking display number to IENS.
1263 ;" Array should be the one created by ShowList
1264 ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName
1265 ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName
1266 ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to process.
1267 ;" Format as follows.
1268 ;" List(Entry number)=""
1269 ;" List(Entry number)=""
1270 ;" ByTradeName -- OPTIONAL, if value=1, then values are shown by TradeName
1271 ;" ShowBoth -- OPTIONAL, if value=1 then trade name and generic names both shown.
1272 ;"Result: 1 if writing is OK, other 0
1273
1274 write !,"DRUG CLASS: ",ClassName,!
1275 write "Use this for drug(s) below?: ",!
1276 do Disp2List(.Answers,.List,.ByTradeName,.ShowBoth)
1277 write "Use DRUG CLASS [",ClassName,"] for drug(s) above"
1278 new % set %=1 do YN^DICN write !
1279
1280 quit (%=1)
1281
1282
1283Disp2List(Answers,List,ByTradeName,ShowBoth)
1284 ;"Purpose: An interfact to DisplayList function, to allow easier input.
1285 ;"Input: Answers -- PASS BY REFERENCE, an array linking display number to IENS. See DisplayList
1286 ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to process. See DisplayList
1287 ;" ByTradeName -- OPTIONAL, if value=1, then values are shown by TradeName
1288 ;" ShowBoth -- OPTIONAL, if value=1 then trade name and generic names both shown.
1289
1290 set ByTradeName=$get(ByTradeName,0)
1291 set ShowBoth=$get(ShowBoth,0)
1292 new part,alsoPart
1293 set alsoPart=0
1294
1295 if ByTradeName=1 do
1296 . set part=3 ;"i.e. show TradeName
1297 . if ShowBoth set alsoPart=2
1298 else do
1299 . set part=2 ;"i.e. show GenericName
1300 . if ShowBoth set alsoPart=3
1301
1302 do DisplayList(.Answers,.List,part,alsoPart)
1303
1304 quit
1305
1306DisplayList(Answers,List,Piece,AlsoPiece)
1307 ;"Purpose: To display list of entries
1308 ;"Input: Answers -- PASS BY REFERENCE, an array linking display number to IENS.
1309 ;" Array should be the one created by ShowList
1310 ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName
1311 ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName
1312 ;" OR, Array as created by ShowEList
1313 ;" Answer(count)=DrugIEN^GenericDrugName^TradeName
1314 ;" Answer(count)=DrugIEN^GenericDrugName^TradeName
1315
1316 ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to process.
1317 ;" Format as follows.
1318 ;" List(Entry number)=""
1319 ;" List(Entry number)=""
1320 ;" Piece -- OPTIONAL, default=2. The piece number of Answer value to show.
1321 ;" AlsoPiece -- OPTIONAL, default="", If specified, then this piece of the Answer
1322 ;" will also be shown in paretheses under the original answer.
1323 ;"Result: none
1324
1325 new someShown set someShown=0
1326 set Piece=$get(Piece,2)
1327 new i
1328 set i=$order(List(""))
1329 if i'="" for do quit:(i="")
1330 . write " ",i,". ",$piece($get(Answers(i)),"^",Piece),!
1331 . set someShown=1
1332 . if +$get(AlsoPiece)>0 do
1333 . . write " (",$piece($get(Answers(i)),"^",AlsoPiece),")",!
1334 . set i=$order(List(i))
1335
1336 if someShown=0 write " -- List is EMPTY -- ",!
1337 write "--------------------------------------",!
1338 quit
1339
1340
1341SimilarPick(Array,Answers,List,FromECode,Cancelled)
1342 ;"Purpose: To allow user to specify that a set of numbers should use the same class as
1343 ;" another entry.
1344 ;"Input: Array -- PASS BY REFERENCE, array holding data, As created by Gather Classes
1345 ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose
1346 ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose
1347 ;" Array(DrugIEN,"?")=""
1348 ;" Array("?",DrugIEN)=""
1349 ;" Answers -- PASS BY REFERENCE, an array linking display number to IENS.
1350 ;" Array should be the one created by ShowList
1351 ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName
1352 ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName
1353 ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to process.
1354 ;" Format as follows.
1355 ;" List(Entry number)=""
1356 ;" List(Entry number)=""
1357 ;" FromECode -- OPTIONAL, if value=1, then code is handled as if called from the 'empty'
1358 ;" code modules (ie HandleEmptyClasses)
1359 ;"Results: none
1360
1361 set Cancelled=1 ;"default to cancellation
1362
1363 new input
1364 read "Which entry has the CORRECT CLASS? ",input:$get(DTIME,3600),!
1365 if +input'=input goto SPDone
1366
1367 new SimClName set SimClName=$piece($get(Answers(input)),"^",4)
1368 new SimClIEN set SimClIEN=+$piece($get(Answers(input)),"^",3)
1369
1370 if $$VerifyWrite(SimClName,.Answers,.List)=1 goto SPDone
1371 do WriteClass(SimClIEN,.Array,.Answers,.List,.FromECode)
1372 set Cancelled=0 ;"signal success
1373
1374SPDone
1375 quit
1376
1377
1378
1379FindPick(Array,Answers,List,FromECode,Cancelled)
1380 ;"Purpose: To allow user to look up a drug already in the VistA database, and use the
1381 ;" VA DRUG CLASS assigned to that drug.
1382 ;" another entry.
1383 ;"Input: Array -- PASS BY REFERENCE, array holding data, As created by Gather Classes
1384 ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose
1385 ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose
1386 ;" Array(DrugIEN,"?")=""
1387 ;" Array("?",DrugIEN)=""
1388 ;" Answers -- PASS BY REFERENCE, an array linking display number to IENS.
1389 ;" Array should be the one created by ShowList
1390 ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName
1391 ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName
1392 ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to process.
1393 ;" Format as follows.
1394 ;" List(Entry number)=""
1395 ;" List(Entry number)=""
1396 ;" FromECode -- OPTIONAL, if value=1, then code is handled as if called from the 'empty'
1397 ;" code modules (ie HandleEmptyClasses)
1398 ;" Cancelled -- OPTIONAL, PASS BY REFERENCE, will be set to 1 if user cancelled.
1399 ;"Results: none
1400
1401 set Cancelled=1 ;"default is cancellation
1402 write "Classify drug by finding ANOTHER drug in the SAME CLASS",!
1403FPLoop
1404 new DIC,X,Y
1405 set DIC=50.68
1406 set DIC(0)="AEQM"
1407 set DIC("A")="Enter DRUG NAME OF EXAMPLE with desired CLASS// "
1408 do ^DIC write !
1409 if +Y'>0 do goto FPDone
1410 . write "No usable value found.",!
1411 . do PressToCont^TMGUSRIF
1412
1413 new SimClName,SimClIEN
1414 set SimClIEN=$$GET1^DIQ(50.68,+Y,15,"I") ;"50.68=VA PRODUCT file
1415 if SimClIEN'>0 do goto FPDone
1416 . write "No usable value found.",!
1417 . do PressToCont^TMGUSRIF
1418 set SimClName=$$GET1^DIQ(50.605,SimClIEN,1) ;"50.605 is VA DRUG CLASS
1419
1420 new IsOK set IsOK=$$VerifyWrite(SimClName,.Answers,.List)
1421 new TryAgain set TryAgain=0
1422 if IsOK=1 do
1423 . do WriteClass(SimClIEN,.Array,.Answers,.List,.FromECode)
1424 . set Cancelled=0 ;"set success here
1425 else do
1426 . write "Pick another DRUG CLASS"
1427 . new % set %=1 do YN^DICN write !
1428 . set TryAgain=(%=1)
1429 if TryAgain=1 goto FPLoop
1430
1431FPDone
1432 quit
1433
1434 ;"=======================================================================
1435 ;"=======================================================================
1436
1437HandleEmptyClasses
1438 ;"Purpose: To allow classification of all unclassified drugs (ones with not potential
1439 ;" match found in VistA database as a starting point)
1440
1441 new array
1442 write "Gathering information...",!
1443 do GatherEmpties(.array)
1444 do ClassEClasses(.array)
1445
1446 quit
1447
1448
1449
1450GatherEmpties(Array)
1451 ;"Purpose: To scan through all records in TMG FDA IMPORT COMPILED, and create an array of
1452 ;" possible entries for VA DRUG CLASS, from ones that have NO possible VA PRODUCT MATCH
1453 ;"Input: Array -- PASS BY REFERENCE, and OUT PARAMETER
1454 ;"Output: Array will be filled as follows:
1455 ;" Array("GENERIC NAME",VA GENERIC Name,DrugIEN)=""
1456 ;" Array("TRADE NAME",TradeName,DrugIEN)=""
1457 ;" Array("LINK GENERIC TO TRADE",TMGGeneric)=TradeName
1458 ;" Array("LINK TRADE TO GENERIC",TradeName)=TMGGeneric
1459 ;"Results: none
1460 ;"Note: if SKIP THIS RECORD field is set, then record will be skipped.
1461 ;" Also, if there is already an antry for the VA DRUG CLASS field, then will be skipped.
1462
1463 new Itr,IEN
1464 set IEN=$$ItrInit^TMGITR(22706.9,.Itr)
1465 do PrepProgress^TMGITR(.Itr,20,0,"IEN")
1466 if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)
1467 . new tempIEN set IEN=IEN
1468 . new skipFlag set skipFlag=+$piece($get(^TMG(22706.9,IEN,1)),"^",4)
1469 . new PriorClass set PriorClass=+$piece($get(^TMG(22706.9,IEN,1)),"^",5)
1470 . ;"write IEN," --> ",PriorClass,!
1471 . if skipFlag=1 quit
1472 . if PriorClass>0 quit
1473 . new TMGGeneric set TMGGeneric=$piece($get(^TMG(22706.9,IEN,0)),"^",6) ;"GENERIC NAME
1474 . new TradeName set TradeName=$piece($get(^TMG(22706.9,IEN,0)),"^",4) ;"TRADENAME
1475 . if TMGGeneric'="" set Array("GENERIC NAME",TMGGeneric,IEN)=""
1476 . if TradeName'="" set Array("TRADE NAME",TradeName,IEN)=""
1477 . if (TMGGeneric'="")&(TradeName'="") do
1478 . . set Array("LINK GENERIC TO TRADE",TMGGeneric)=TradeName
1479 . . set Array("LINK TRADE TO GENERIC",TradeName)=TMGGeneric
1480 do ProgressDone^TMGITR(.Itr)
1481
1482 quit
1483
1484ShowEList(Array,Answers,CompactMode,ByTradeName,ShowBoth)
1485 ;"Purpose: To display the list of 'Empty' classes generated by GatherEmpties
1486 ;"Input: Array -- the array containing the data
1487 ;" Array("GENERIC NAME",VA GENERIC Name,DrugIEN)=""
1488 ;" Array("TRADE NAME",TradeName,DrugIEN)=""
1489 ;" Array("LINK GENERIC TO TRADE",TMGGeneric)=TradeName
1490 ;" Array("LINK TRADE TO GENERIC",TradeName)=TMGGeneric
1491 ;" Answers -- PASS BY REFERENCE. An OUT PARAMATER.
1492 ;" Array will receive display numbers with IENs
1493 ;" Answer(count)=DrugIEN^GenericDrugName^TradeName
1494 ;" Answer(count)=DrugIEN^GenericDrugName^TradeName
1495 ;" CompactMode -- OPTIONAL, if value=1, then only the LAST drug class will be
1496 ;" expanded (a potientially long list). Others will just show heading.
1497 ;" ByTradeName -- OPTIONAL, if value=1, then values are shown by TradeName
1498 ;" ShowBoth -- OPTIONAL, if value=1 then both Generic and TradeName shown.
1499 ;"Output: List is shown, and the Answers array is established and passed back.
1500 ;"Results: none.
1501
1502 new someShown set someShown=0
1503 new count set count=1
1504 kill Answers
1505 set CompactMode=$get(CompactMode,0)
1506 set ByTradeName=$get(ByTradeName,0)
1507 set ShowBoth=$get(ShowBoth,0)
1508 new IEN
1509 new GenericName,TradeName,DrugName
1510 new CountLimit set CountLimit=99999
1511 if CompactMode=1 do
1512 . if ShowBoth=1 set CountLimit=8
1513 . else set CountLimit=10
1514 new Label set Label="GENERIC NAME"
1515 if ByTradeName=1 set Label="TRADE NAME"
1516
1517 set DrugName=$order(Array(Label,""))
1518 if DrugName'="" for do quit:(DrugName="")!(count>CountLimit)
1519 . set IEN=$order(Array(Label,DrugName,""))
1520 . if IEN'="" for do quit:(IEN="")!(count>CountLimit)
1521 . . write count,". ",DrugName,!
1522 . . new OtherName
1523 . . if ByTradeName=0 do
1524 . . . set GenericName=DrugName
1525 . . . set TradeName=$get(Array("LINK GENERIC TO TRADE",GenericName))
1526 . . . set OtherName=TradeName
1527 . . else do
1528 . . . set TradeName=DrugName
1529 . . . set GenericName=$get(Array("LINK TRADE TO GENERIC",TradeName))
1530 . . . set OtherName=GenericName
1531 . . if ShowBoth=1 write " (",OtherName,")",!
1532 . . set Answers(count)=IEN_"^"_GenericName_"^"_TradeName
1533 . . set count=count+1
1534 . . set IEN=$order(Array(Label,DrugName,IEN))
1535 . set DrugName=$order(Array(Label,DrugName))
1536 . set someShown=1
1537
1538 if 'someShown write " --- (List is Empty) ---",!
1539 quit
1540
1541
1542
1543ClassEClasses(Array)
1544 ;"Purpose: To allow user to classify drugs with empty (none) VA Drug Class
1545 ;"Input: Array -- PASS BY REFERENCE the array generated by GatherEmpties
1546 ;" Array("GENERIC NAME",VA GENERIC Name,DrugIEN)=""
1547 ;" Array("TRADE NAME",TradeName,DrugIEN)=""
1548 ;"Output: Database is changed, by adding data to field .09 (VA DRUG CLASS)
1549 ;"Results: none
1550
1551 new done set done=0
1552 new input set input="R"
1553 new Answers
1554 new CompactMode set CompactMode=1 ;" (list display mode: 1=compact, 0=verb
1555 new ShowBoth set ShowBoth=0
1556 new ByTrade set ByTrade=1
1557 new EntryList,EntryS
1558
1559 new Classes
1560 do GetClasses(.Classes)
1561 do KillIntro(.Classes)
1562
1563 for do quit:(done=1)
1564 . if input="R" do
1565 . . write !!
1566 . . write "--------------------------------------------------",!
1567 . . write "Pick drug(s) to specify a DRUG CLASS",!
1568 . . write "--------------------------------------------------",!
1569 . . do ShowEList(.Array,.Answers,CompactMode,ByTrade,ShowBoth)
1570 . . write "--------------------------------------------------",!
1571 . . write "Pick drug(s) to specify a DRUG CLASS",!
1572 . write "--------------------------------------------------",!
1573 . write " R=refresh, ?=instructions, X=remove from list, I=info, F=find",!
1574 . write " G=Guess, L Lookup",!
1575 . write " C=set Compact ",$select((CompactMode=1):"OFF",1:"ON"),", "
1576 . write "T=set TradeName ",$select((ByTrade=1):"OFF",1:"ON"),", B=set Both names ",$select((ShowBoth=1):"OFF",1:"ON")
1577 . write ", ",!
1578 . write " # or #-# or #,#-#,# etc., S=SET tools, ^ done, ",!
1579 . if $get(EntryS)'="" write " Current SET #'s: ",EntryS,", D to delete SET",!
1580 . write "Enter number(s) to LOOKUP drug class (or codes listed above): R//"
1581 . read input:$get(DTIME,3600),!
1582 . if input="" set input="R"
1583 . set input=$$UP^XLFSTR(input)
1584 . if input="^" set done=1 quit
1585 . else if (input="?") do ;"---- instructions
1586 . . ;"do ShowInstructions()
1587 . . set input="R"
1588 . else if input="I" do ;" ---- drug info
1589 . . read "...Enter number of drug to get info about: ^//",input,!
1590 . . do ShowInfo(.Array,.Answers,+input)
1591 . . set input="R"
1592 . else if input="C" do ;"--- toggle compact mode
1593 . . set CompactMode='CompactMode
1594 . . set input="R"
1595 . else if input="T" do ;"---- toggle display by tradename
1596 . . set ByTrade='ByTrade
1597 . . set input="R"
1598 . else if input="B" do ;" ---- toggle display of both names.
1599 . . set ShowBoth='ShowBoth
1600 . . set input="R"
1601 . else if input="D" do ;"---- delete set
1602 . . kill EntryList,EntryS
1603 . . set input="R"
1604 . else if input="X" do ;" ---- delete entries
1605 . . new valid set valid=1
1606 . . if $get(EntryS)="" do quit:(valid=0)
1607 . . . read "...Enter number(s) to REMOVE from list: ^// ",input,!
1608 . . . set valid=$$MkMultList^TMGMISC(input,.EntryList)
1609 . . . if valid set EntryS=input
1610 . . if CompactMode=1 set input="R"
1611 . . new Cancelled
1612 . . do DoRemove(.Array,.Answers,.EntryList,ByTrade,1,.Cancelled)
1613 . . if Cancelled=0 kill EntryList,EntryS
1614 . else if input="S" do ;"---- set tools
1615 . . do DoSetTools(.Array,.Answers,.EntryList,.EntryS,.ByTrade,.ShowBoth)
1616 . . if CompactMode=1 set input="R"
1617 . else if input="F" do ;" ---- find drugs
1618 . . new valid set valid=1
1619 . . if $get(EntryS)="" do quit:(valid=0)
1620EFL . . . read "...Enter number(s) to classify by FINDING a similar drug: (? help) ^// ",input,!
1621 . . . if input="?" do FindHelp() goto EFL
1622 . . . set valid=$$MkMultList^TMGMISC(input,.EntryList)
1623 . . . if valid set EntryS=input
1624 . . if CompactMode=1 set input="R"
1625 . . new Cancelled
1626 . . do FindPick(.Array,.Answers,.EntryList,1,.Cancelled)
1627 . . if Cancelled=0 kill EntryList,EntryS
1628 . else if (input="L")!(+input>0) do ;" ----- lookup drugs
1629 . . new valid set valid=1
1630 . . if $get(EntryS)="" do quit:(valid=0)
1631 . . . if input="L" read "...Enter number(s) to LOOKUP from list: ^// ",input,!
1632 . . . set valid=$$MkMultList^TMGMISC(input,.EntryList)
1633 . . . if valid set EntryS=input
1634 . . if CompactMode=1 set input="R"
1635 . . new Cancelled
1636 . . do DoLookup(.Array,.Answers,.Classes,.EntryList,1,.Cancelled)
1637 . . if Cancelled=0 kill EntryList,EntryS
1638 . else if input="G" do ;" ---- guess drugs
1639 . . new valid set valid=1
1640 . . if $get(EntryS)="" do quit:(valid=0)
1641EGL . . . read "...Enter number(s) to classify by GUESSING: (? help) ^// ",input,!
1642 . . . if input="?" do FindHelp() goto EFL
1643 . . . set valid=$$MkMultList^TMGMISC(input,.EntryList)
1644 . . . if valid set EntryS=input
1645 . . if CompactMode=1 set input="R"
1646 . . new Cancelled
1647 . . do DoEGuess(.Array,.Answers,.EntryList,ByTrade,ShowBoth,.Cancelled,1,.Classes)
1648 . . if Cancelled=0 kill EntryList,EntryS
1649 . else if input'="R" do ;"---- accept numeric input etc.
1650 . . if $$MkMultList^TMGMISC(input,.EntryList)=0 quit
1651 . . set EntryS=input
1652 . . if CompactMode=1 set input="R"
1653
1654 quit
1655
1656
1657DoGuess(Array,Answers,EntryList,Cancelled,Classes)
1658 ;"Purpose: A wrapper for DoEGuess, with some automatically provided paremeters
1659 do DoEGuess(.Array,.Answers,.EntryList,0,0,.Cancelled,0,.Classes)
1660 quit
1661
1662DoEGuess(Array,Answers,List,ByTradeName,ShowBoth,Cancelled,FromECode,Classes)
1663 ;"Purpose: To guess as classification for entries.
1664 ;"Input: Array -- PASS BY REFERENCE, array holding data, As created by GatherEmpties(Array)
1665 ;" Array("GENERIC NAME",VA GENERIC Name,DrugIEN)=""
1666 ;" Array("TRADE NAME",TradeName,DrugIEN)=""
1667 ;" Array("LINK GENERIC TO TRADE",TMGGeneric)=TradeName
1668 ;" Array("LINK TRADE TO GENERIC",TradeName)=TMGGeneric
1669 ;" Answers -- PASS BY REFERENCE, an array linking display number to IENS.
1670 ;" Array should be the one created by ShowEList
1671 ;" Answer(count)=DrugIEN^GenericDrugName^TradeName
1672 ;" Answer(count)=DrugIEN^GenericDrugName^TradeName
1673 ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to process.
1674 ;" Format as follows.
1675 ;" List(Entry number)=""
1676 ;" List(Entry number)=""
1677 ;" ByTradeName -- OPTIONAL, if value=1, then values are shown by TradeName
1678 ;" ShowBoth -- OPTIONAL, if value=1 then trade name and generic names both shown.
1679 ;" Cancelled -- OPTIONAL, PASS BY REFERENCE, will be set to 1 if user cancelled.
1680 ;" FromECode -- OPTIONAL, if value=1, then code is handled as if called from the 'empty'
1681 ;" code modules (ie HandleEmptyClasses). Default=0
1682 ;" Classes -- PASS BY REFERENCE -- An array holding classes.
1683 ;"Results: none
1684
1685 set FromECode=$get(FromECode,0)
1686 set Cancelled=1 ;"default to cancellation
1687
1688 new Results
1689 write "Searching for guesses...",$char(10)
1690
1691 do GGuessList(.Array,.Answers,.List,.Results)
1692 ;" Results(Entry Number,"NAME",VASimilarDrugName,vapIEN)=ClassIEN^ClassCode^ClassName_vapIEN
1693 ;" Results(Entry Number,"NAME",VASimilarDrugName,vapIEN)=ClassIEN^ClassCode^ClassName_vapIEN
1694 ;" Results(Entry Number,"CLASS",ClassIEN,vapIEN)=ClassIEN^ClassCode^ClassName_vapIEN
1695 ;" Results(Entry Number,"CLASS",ClassIEN,vapIEN)=ClassIEN^ClassCode^ClassName_vapIEN
1696 ;" Results("ALL CLASSES",ClassIEN)=ClassIEN_"^"_ClassCode_"^"_ClassName
1697 ;" Results("ALL CLASSES",ClassIEN,matchName,vapIEN)=""
1698
1699 new showExamples set showExamples=1
1700
1701DEGL0 write !,"GUESSES of class for these drugs: ",!
1702 do Disp2List(.Answers,.List,.ByTradeName,.ShowBoth)
1703
1704 new subAnswers
1705 new someShown set someShown=0
1706 new count set count=0
1707 new classIEN set classIEN=""
1708 for set classIEN=+$order(Results("ALL CLASSES",classIEN)) quit:(classIEN'>0) do
1709 . set count=count+1
1710 . new node set node=$get(Results("ALL CLASSES",classIEN))
1711 . write " ",count,". CLASS: ",$piece(node,"^",3),!
1712 . set someShown=1
1713 . set subAnswers(count)=node
1714 . new matchName set matchName=""
1715 . new temp set temp=0
1716 . for set matchName=$order(Results("ALL CLASSES",classIEN,matchName)) quit:(matchName="")!(temp>5) do
1717 . . new vapIEN set vapIEN=""
1718 . . for set vapIEN=+$order(Results("ALL CLASSES",classIEN,matchName,vapIEN)) quit:(vapIEN'>0)!(temp>5) do
1719 . . . if showExamples=0 quit
1720 . . . write " e.g. ",matchName," (",vapIEN,")",!
1721 . . . set temp=temp+1
1722
1723 if someShown=0 do goto DEGDone
1724 . write " -- (None Suggestions found) -- ",!!
1725 . new temp read "Press ENTER to continue.",temp,!
1726
1727 new input,UsrClassIEN,className
1728 new defInput set defInput="^"
1729 if count=1 set defInput=1
1730 new fixing
1731DEGL1
1732 set fixing=0
1733 write "[Enter F to fix (change) the class of a drug listed above.]",!
1734 write "[Enter E to toggle Examples ON/OFF]",!
1735 write "Enter number of CLASS to select (^ to abort): "_defInput_"// "
1736 read input:$get(DTIME,3600),!
1737 if input="" set input=defInput
1738 set input=$$UP^XLFSTR(input)
1739 if input="^" goto DEGDone
1740 if input="E" do goto DEGL0
1741 . set showExamples='showExamples
1742 if input="F" do goto:(input="^") DEGL1
1743 . set fixing=1
1744 . write !,"Enter number of CLASS containing erroneously classified drug (^ to abort): "_defInput_"// "
1745 . read input:$get(DTIME,3600) write !
1746 . if input="" set input=defInput
1747 set UsrClassIEN=+$get(subAnswers(input))
1748 if UsrClassIEN'>0 goto DEGL1
1749 if fixing=1 do goto DEGL0
1750 . do FixBadClass(.Results,UsrClassIEN,.Classes)
1751 set className=$piece($get(subAnswers(input)),"^",3)
1752 write !!
1753 if $$VerifyWrite(className,.Answers,.List,ByTradeName,ShowBoth)=0 goto DEGDone
1754 do WriteClass(UsrClassIEN,.Array,.Answers,.List,FromECode)
1755 set Cancelled=0 ;"set success here.
1756DEGDone
1757 quit
1758
1759
1760FixBadClass(GuessArray,UsrClassIEN,Classes)
1761 ;"Purpose: If guessing reveals that an existing drug has been misclassified, then
1762 ;" this function will allow correction of that drug (50.68 entry)
1763 ;"Input: GuessArray -- PASS BY REFERENCE. Format:
1764 ;" GuessArray(Entry Number,"NAME",VASimilarDrugName)=ClassIEN^ClassCode^ClassName^vapIEN
1765 ;" GuessArray(Entry Number,"CLASS",ClassIEN)=ClassIEN^ClassCode^ClassName
1766 ;" GuessArray("ALL CLASSES",classIEN)=classIEN_"^"_classCode_"^"_className
1767 ;" GuessArray("ALL CLASSES",classIEN,matchName)=vapIEN
1768
1769 ;" GuessArray(Entry Number,"NAME",VASimilarDrugName,vapIEN)=ClassIEN^ClassCode^ClassName_vapIEN
1770 ;" GuessArray(Entry Number,"CLASS",ClassIEN,vapIEN)=ClassIEN^ClassCode^ClassName_vapIEN
1771 ;" GuessArray("ALL CLASSES",ClassIEN)=ClassIEN_"^"_ClassCode_"^"_ClassName
1772 ;" GuessArray("ALL CLASSES",ClassIEN,matchName,vapIEN)=""
1773
1774
1775 ;" UsrClassIEN -- The class containing the incorrectly classified drug
1776 ;" Classes -- PASS BY REFERENCE. An array holding classes.
1777
1778 if $get(UsrClassIEN)="" goto FBCDone
1779 new className
1780 set className=$piece($get(GuessArray("ALL CLASSES",UsrClassIEN)),"^",3)
1781
1782 new Menu,UsrSlct
1783 new menuNum set menuNum=0
1784 new matchName set matchName=""
1785 new lastMatchName,lastvapIEN
1786 new AllArray,IENArray,vapIEN
1787 set Menu(0)="Pick Which Drug does NOT belong in class: "_className
1788 for set matchName=$order(GuessArray("ALL CLASSES",UsrClassIEN,matchName)) quit:(matchName="") do
1789 . set vapIEN=""
1790 . for set vapIEN=$order(GuessArray("ALL CLASSES",UsrClassIEN,matchName,vapIEN)) quit:(vapIEN="") do
1791 . . set menuNum=menuNum+1
1792 . . set Menu(menuNum)=matchName_" (#"_vapIEN_")"_$char(9)_"@^"_vapIEN_"^"_matchName
1793 . . set AllArray(vapIEN)=matchName
1794 . . set AllArray("NAME",matchName,vapIEN)=""
1795 . . set lastMatchName=matchName,lastvapIEN=vapIEN
1796 if menuNum>1 do
1797 . set menuNum=menuNum+1
1798 . set Menu(menuNum)="ALL of the above drugs"_$char(9)_"ALL"
1799 . if menuNum'>3 quit
1800 . set menuNum=menuNum+1
1801 . set Menu(menuNum)="OR you may enter #-#, or #,#,#-#,# etc."_$char(9)_"#"
1802
1803FBCMC1
1804 if menuNum>1 do
1805 . write ! set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^") ;"@^vapIEN^matchName
1806 else do
1807 . set UsrSlct="@^"_lastvapIEN_"^"_lastMatchName
1808
1809 if UsrSlct="ALL" do
1810 . merge IENArray=AllArray
1811 else if +UsrSlct>0 do
1812 . new EntryList,Entry
1813 . if $$MkMultList^TMGMISC(UsrSlct,.EntryList)>0 do
1814 . . set Entry=""
1815 . . for set Entry=$order(EntryList(Entry)) quit:(Entry="") do
1816 . . . new vapIEN,vapName,s
1817 . . . set s=$piece(Menu(Entry),$char(9),2)
1818 . . . if s="" quit
1819 . . . set vapIEN=$piece(s,"^",2),vapName=$piece(s,"^",3)
1820 . . . set IENArray(vapIEN)=vapName
1821 . . . set IENArray("NAME",vapIEN)=""
1822 else if $piece(UsrSlct,"^",1)="@" do
1823 . set IENArray($piece(UsrSlct,"^",2))=$piece(UsrSlct,"^",3)
1824 . set IENArray("NAME",$piece(UsrSlct,"^",3),$piece(UsrSlct,"^",2))=""
1825 else if UsrSlct="^" goto FBCDone
1826 else if UsrSlct=0 set UsrSlct=""
1827 else if UsrSlct="??" do goto FBCDone
1828 . write !,"For some reason, IEN of selected drug couldn't be found. Sorry.",!
1829 else if menuNum>1 goto FBCMC1
1830 else goto FBCDone
1831
1832 write "Now pick CORRECT drug class for the chosen drug(s)",!
1833 do PressToCont^TMGUSRIF
1834 new newClassIEN set newClassIEN=$$SelectClass(.Classes,0)
1835 if newClassIEN=0 goto FBCDone
1836 ;"new className set className=$$GET1^DIQ(50.605,newClassIEN,1)
1837 ;"write "Set CLASS for VA PRODUCT entry: "_$piece(UsrSlct,"^",2),!
1838 ;"write "to be: ",className,"?"
1839 ;"new % set %=1
1840 ;"do YN^DICN write !
1841 ;"if %=-1 goto FBCDone
1842
1843 new vapName set vapName=""
1844 for set vapName=$order(IENArray("NAME",vapName)) quit:(vapName="") do
1845 . new entryNum set entryNum=""
1846 . ;" GuessArray(Entry Number,"NAME",VASimilarDrugName,vapIEN)=ClassIEN^ClassCode^ClassName_vapIEN
1847 . for set entryNum=$order(GuessArray(entryNum)) quit:(+entryNum'>0) do
1848 . . set vapIEN=""
1849 . . for set vapIEN=$order(GuessArray(entryNum,"NAME",vapName,vapIEN)) quit:(vapIEN="") do
1850 . . . new s set s=$get(GuessArray(entryNum,"NAME",vapName,vapIEN))
1851 . . . if s="" quit
1852 . . . new classIEN set classIEN=+s
1853 . . . if classIEN=newClassIEN quit ;"already at correct class
1854 . . . set IENArray(vapIEN)=vapName
1855
1856 set vapIEN=""
1857 for set vapIEN=$order(IENArray(vapIEN)) quit:(+vapIEN'>0) do
1858 . new TMGFDA,TMGMSG
1859 . set TMGFDA(50.68,vapIEN_",",15)=newClassIEN ;"className
1860 . do FILE^DIE("I","TMGFDA","TMGMSG")
1861 . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
1862 . kill GuessArray("ALL CLASSES",UsrClassIEN,$get(IENArray(vapIEN),"xx"))
1863
1864FBCDone
1865 quit
1866
1867GGuessList(Array,Answers,List,Results)
1868 ;"Purpose: To gather a guessing list of possible classes for each entry in List
1869 ;"Input: Array -- PASS BY REFERENCE, array holding data, As created by Gather Classes
1870 ;" Array("GENERIC NAME",VA GENERIC Name,DrugIEN)=""
1871 ;" Array("TRADE NAME",TradeName,DrugIEN)=""
1872 ;" Array("LINK GENERIC TO TRADE",TMGGeneric)=TradeName
1873 ;" Array("LINK TRADE TO GENERIC",TradeName)=TMGGeneric
1874 ;" Answers -- PASS BY REFERENCE, an array linking display number to IENS.
1875 ;" Array should be the one created by ShowEList
1876 ;" Answer(count)=DrugIEN^GenericDrugName^TradeName
1877 ;" Answer(count)=DrugIEN^GenericDrugName^TradeName
1878 ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to process.
1879 ;" Format as follows.
1880 ;" List(Entry number)=""
1881 ;" List(Entry number)=""
1882 ;" Results -- PASS BY REFERENCE -- and OUT PARAMETER to receive results, as follows:
1883 ;" Results(Entry Number,"NAME",VASimilarDrugName,vapIEN)=ClassIEN^ClassCode^ClassName_vapIEN
1884 ;" Results(Entry Number,"NAME",VASimilarDrugName,vapIEN)=ClassIEN^ClassCode^ClassName_vapIEN
1885 ;" Results(Entry Number,"CLASS",ClassIEN,vapIEN)=ClassIEN^ClassCode^ClassName_vapIEN
1886 ;" Results(Entry Number,"CLASS",ClassIEN,vapIEN)=ClassIEN^ClassCode^ClassName_vapIEN
1887 ;" Results("ALL CLASSES",ClassIEN)=ClassIEN_"^"_ClassCode_"^"_ClassName
1888 ;" Results("ALL CLASSES",ClassIEN,matchName,vapIEN)=""
1889 ;"Results: none
1890
1891 new Guesses,GenericName,TradeName
1892 new i
1893 set i=$order(List(""))
1894 if i'="" for do quit:(i="")
1895 . set GenericName=$piece($get(Answers(i)),"^",2)
1896 . set TradeName=$piece($get(Answers(i)),"^",3)
1897 . set i=$order(List(i))
1898 . if $data(Guesses("TRY",TradeName))>0 quit
1899 . set Guesses("TRY",TradeName)=1
1900 . new name
1901 . new j,p,done set done=0
1902 . new X,TMGARRAY,TMGMSG
1903 . for j=$length(GenericName,"/"):-1:1 do
1904 . . set name=$piece(GenericName,"/",j)
1905 . . for p=$length(name," "):-1:1 do quit:(done=1)
1906 . . . new TMGSRCH set TMGSRCH=$piece(name," ",1,p)
1907 . . . do FIND^DIC(50.68,"","","",TMGSRCH,"*","","","","TMGARRAY","TMGMSG")
1908 . . . if +$get(TMGARRAY("DILIST",0))>0 do
1909 . . . . merge Guesses("POS MATCH",GenericName,TMGSRCH,"NAME")=TMGARRAY("DILIST",1)
1910 . . . . merge Guesses("POS MATCH",GenericName,TMGSRCH,"IEN")=TMGARRAY("DILIST",2)
1911 . . . . set done=1
1912 kill Guesses("TRY") ;"temporary use of those items already searched.
1913
1914 ;"Now convert matching IENs into drug classes.
1915 set GenericName=""
1916 for set GenericName=$order(Guesses("POS MATCH",GenericName)) quit:(GenericName="") do
1917 . new namePart set namePart=""
1918 . for set namePart=$order(Guesses("POS MATCH",GenericName,namePart)) quit:(namePart="") do
1919 . . new j set j=0
1920 . . for set j=$order(Guesses("POS MATCH",GenericName,namePart,"IEN",j)) quit:(j'>0) do
1921 . . . new vapIEN set vapIEN=+$get(Guesses("POS MATCH",GenericName,namePart,"IEN",j))
1922 . . . if vapIEN>0 do
1923 . . . . new classIEN,matchName
1924 . . . . set classIEN=+$$GET1^DIQ(50.68,vapIEN,15,"I")
1925 . . . . set matchName=$$GET1^DIQ(50.68,vapIEN,.01) ;"was 5 (print name)
1926 . . . . if (classIEN'>0)!(matchName="") quit
1927 . . . . set Guesses("POS MATCH",GenericName,"CLASS",matchName,classIEN,vapIEN)=""
1928
1929 ;"Now compose results
1930 set i=""
1931 for set i=$order(List(i)) quit:(i="") do
1932 . set GenericName=$piece($get(Answers(i)),"^",2)
1933 . set TradeName=$piece($get(Answers(i)),"^",3)
1934 . new matchName set matchName=""
1935 . for set matchName=$order(Guesses("POS MATCH",GenericName,"CLASS",matchName)) quit:(matchName="") do
1936 . . new classIEN set classIEN=""
1937 . . for set classIEN=+$order(Guesses("POS MATCH",GenericName,"CLASS",matchName,classIEN)) quit:(classIEN'>0) do
1938 . . . new classCode,className
1939 . . . set classCode=$$GET1^DIQ(50.605,classIEN,.01)
1940 . . . set className=$$GET1^DIQ(50.605,classIEN,1)
1941 . . . new vapIEN set vapIEN=""
1942 . . . for set vapIEN=+$order(Guesses("POS MATCH",GenericName,"CLASS",matchName,classIEN,vapIEN)) quit:(vapIEN'>0) do
1943 . . . . set Results(i,"NAME",matchName,vapIEN)=classIEN_"^"_classCode_"^"_className_"^"_vapIEN
1944 . . . . set Results(i,"CLASS",classIEN,vapIEN)=classIEN_"^"_classCode_"^"_className_"^"_vapIEN
1945 . . . . set Results("ALL CLASSES",classIEN)=classIEN_"^"_classCode_"^"_className
1946 . . . . set Results("ALL CLASSES",classIEN,matchName,vapIEN)=""
1947
1948 quit
1949
1950
1951
1952AutoEClassification(Array)
1953 ;"Purpose: To attempt to automatically classify drugs that have not potential match
1954 ;"Input: -- Array PASS BY REFERENCE, an OUT PARAMETER. Prior entries are NOT killed.
1955 ;"Output: Array will be filled as follows:
1956 ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode
1957 ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode
1958 ;" Array(DrugIEN,"?")=""
1959 ;" Array("?",DrugIEN)=""
1960 ;"Results: none
1961
1962 new tempArray
1963 new Classes
1964 new Answers
1965 write "Gathering drugs with no CLASS information and no existing match...",!
1966
1967 new CompactMode set CompactMode=0 ;" (list display mode: 1=compact, 0=verb
1968 new ShowBoth set ShowBoth=0
1969 new ByTrade set ByTrade=1
1970
1971 do GatherEmpties(.tempArray)
1972 ;" Array("GENERIC NAME",VA GENERIC Name,DrugIEN)=""
1973 ;" Array("TRADE NAME",TradeName,DrugIEN)=""
1974 ;" Array("LINK GENERIC TO TRADE",TMGGeneric)=TradeName
1975 ;" Array("LINK TRADE TO GENERIC",TradeName)=TMGGeneric
1976
1977 do GetClasses(.Classes)
1978 do KillIntro(.Classes)
1979
1980 do ShowEList(.tempArray,.Answers,CompactMode,ByTrade,ShowBoth)
1981 ;" Answer(count)=DrugIEN^GenericDrugName^TradeName
1982 ;" Answer(count)=DrugIEN^GenericDrugName^TradeName
1983
1984 write !,"Now scanning unclassified drugs for possible CLASS matches...",!
1985
1986 new TMGTOTAL set TMGTOTAL=$$ListCt^TMGMISC("Answers")
1987 new TMGCUR
1988 new StartTime set StartTime=$H
1989 new ProgressFn
1990 set ProgressFn="if TMGCUR#10=1 do ProgressBar^TMGUSRIF(TMGCUR,""Progress"",0,TMGTOTAL,,StartTime)"
1991 new abort set abort=0
1992 new i set i=$order(Answers(""))
1993 if i'="" for do quit:(i="")!abort
1994 . if $$KeyPressed^TMGUSRIF()=27 do quit:abort=1
1995 . . new % set %=2
1996 . . write !,"Abort" do YN^DICN write !
1997 . . if %=1 set abort=1
1998 . new List set List(i)=""
1999 . new class set class=$$Guess1(.Array,.Answers,.List)
2000 . if +class>0 do
2001 . . new ClassName,ClassCode,ClassIEN,TMGTradeName,DrugIEN
2002 . . set ClassName=$piece(class,"^",3)
2003 . . set ClassCode=$piece(class,"^",2)
2004 . . set ClassIEN=$piece(class,"^",1)
2005 . . set TMGTradeName=$piece(Answers(i),"^",3)
2006 . . set DrugIEN=$piece(Answers(i),"^",1)
2007 . . set Array("POSS MATCH",ClassName,TMGTradeName,DrugIEN)=ClassIEN_"^"_ClassCode
2008 . . do CUU^TMGTERM(2) write !
2009 . . new s set s="Found: "_TMGTradeName_" --> "_ClassName
2010 . . set s=s_" "
2011 . . write $extract(s,1,79),!
2012 . if $get(ProgressFn)'="" do
2013 . . set TMGCUR=i
2014 . . new $etrap set $etrap="w ""??Progress function -- error trapped??"",!"
2015 . . xecute ProgressFn
2016 . set i=$order(Answers(i))
2017
2018 quit
2019
2020
2021
2022Guess1(Array,Answers,List)
2023 ;"Purpose: To return a guessed class, IF there is only one possible guess.
2024 ;"Input: Array -- PASS BY REFERENCE, array holding data, As created by Gather Classes
2025 ;" Array("GENERIC NAME",VA GENERIC Name,DrugIEN)=""
2026 ;" Array("TRADE NAME",TradeName,DrugIEN)=""
2027 ;" Array("LINK GENERIC TO TRADE",TMGGeneric)=TradeName
2028 ;" Array("LINK TRADE TO GENERIC",TradeName)=TMGGeneric
2029 ;" Answers -- PASS BY REFERENCE, an array linking display number to IENS.
2030 ;" Array should be the one created by ShowEList
2031 ;" Answer(count)=DrugIEN^GenericDrugName^TradeName
2032 ;" Answer(count)=DrugIEN^GenericDrugName^TradeName
2033 ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to process.
2034 ;" Format as follows.
2035 ;" List(Entry number)=""
2036 ;" List(Entry number)=""
2037 ;"Results: If only 1 matching class found, then classIEN^classCode^className, otherwise 0
2038
2039 new ResultArray
2040 new result set result=0
2041 do GGuessList(.Array,.Answers,.List,.ResultArray)
2042 ;" Results(Entry Number,"NAME",VASimilarDrugName)=ClassIEN^ClassCode^ClassName
2043 ;" Results(Entry Number,"CLASS",ClassIEN)=ClassIEN^ClassCode^ClassName
2044 ;" Results("ALL CLASSES",classIEN)=classIEN_"^"_classCode_"^"_className
2045 ;" Results("ALL CLASSES",classIEN,matchName)=""
2046
2047 ;" Results(Entry Number,"NAME",VASimilarDrugName,vapIEN)=ClassIEN^ClassCode^ClassName_vapIEN
2048 ;" Results(Entry Number,"CLASS",ClassIEN,vapIEN)=ClassIEN^ClassCode^ClassName_vapIEN
2049 ;" Results("ALL CLASSES",ClassIEN)=ClassIEN_"^"_ClassCode_"^"_ClassName
2050 ;" Results("ALL CLASSES",ClassIEN,matchName,vapIEN)=""
2051
2052
2053 if $$ListCt^TMGMISC($name(ResultArray("ALL CLASSES")))=1 do
2054 . new classIEN
2055 . set classIEN=$order(ResultArray("ALL CLASSES",""))
2056 . set result=$get(ResultArray("ALL CLASSES",classIEN))
2057
2058 quit result
2059
2060
2061DoSetTools(Array,Answers,List,EntryS,ByTradeName,ShowBoth)
2062 ;"Purpose: to provide tools for managing SETS to be worked on (List)
2063 ;"Input: Array -- PASS BY REFERENCE, array holding data, As created by Gather Classes
2064 ;" Array("GENERIC NAME",VA GENERIC Name,DrugIEN)=""
2065 ;" Array("TRADE NAME",TradeName,DrugIEN)=""
2066 ;" Array("LINK GENERIC TO TRADE",TMGGeneric)=TradeName
2067 ;" Array("LINK TRADE TO GENERIC",TradeName)=TMGGeneric
2068 ;" Answers -- PASS BY REFERENCE, an array linking display number to IENS.
2069 ;" Array should be the one created by ShowEList
2070 ;" Answer(count)=DrugIEN^GenericDrugName^TradeName
2071 ;" Answer(count)=DrugIEN^GenericDrugName^TradeName
2072 ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to modify.
2073 ;" EntryS -- PASS BY REFERENCE -- a string representing the current set.
2074 ;" ByTradeName -- OPTIONAL, PASS BY REFERENCE, if value=1, then values are shown by TradeName
2075 ;" ShowBoth -- OPTIONAL, PASS BY REFERENCE, if value=1 then trade name and generic names both shown.
2076
2077 set ByTradeName=$get(ByTradeName,0)
2078 set ShowBoth=$get(ShowBoth,0)
2079
2080 new input,done
2081 set EntryS=$get(EntryS)
2082 set done=0
2083
2084 for do quit:(done=1)
2085 . write !,"Tools to modify SET of entry numbers",!
2086 . write "------------------------------------",!
2087 . write "A=Add, X=Remove from SET, C=Clear, D=Display, S=Search, ^ Return",!
2088 . write "T=set TradeName ",$select((ByTrade=1):"OFF",1:"ON"),", B=set Both names ",$select((ShowBoth=1):"OFF",1:"ON"),!
2089 . read "Enter Option: ^// ",input:$get(DTIME,3600),!
2090 . if input="" set input="^"
2091 . set input=$$UP^XLFSTR(input)
2092 . if input="^" write ! set done=1 quit
2093 . if (input="?") do
2094 . . ;"do ShowInstructions()
2095 . . set input="R"
2096 . else if input="A" do
2097 . . read "Enter number(s) to ADD to list: ",input:$get(DTIME,3600),!
2098 . . if $$MkMultList^TMGMISC(input,.List) set EntryS=EntryS_" & "_input
2099 . else if input="X" do
2100 . . new tempList
2101 . . read "Enter number(s) to REMOVE to list: ",input:$get(DTIME,3600),!
2102 . . if $$MkMultList^TMGMISC(input,.tempList)=0 quit
2103 . . new i set i=$order(tempList(""))
2104 . . if i'="" for do quit:(i="")
2105 . . . kill List(i)
2106 . . . set i=$order(tempList(i))
2107 . . set EntryS=EntryS_" - "_input
2108 . else if input="C" do
2109 . . kill List set EntryS=""
2110 . . set input="D"
2111 . else if input="S" do
2112 . . if $$MkSrchList(.Answers,.List,.ByTradeName,.ShowBoth)=1 do
2113 . . . if EntryS'="" set EntryS=EntryS_" & "
2114 . . . set EntryS=EntryS_" (SEARCH)"
2115 . . set input="D"
2116 . else if input="T" do
2117 . . set ByTrade='ByTrade
2118 . . set input="D"
2119 . else if input="B" do
2120 . . set ShowBoth='ShowBoth
2121 . . set input="D"
2122 . if input="D" do
2123 . . write !,"Here is the current SET: ",EntryS,!
2124 . . do Disp2List(.Answers,.List,.ByTradeName,.ShowBoth)
2125 . . ;"new temp read " -- Press [ENTER] to Continue --",temp:$get(DTIME,3600),!
2126
2127 quit
2128
2129MkSrchList(Answers,List,ByTradeName,ShowBoth)
2130 ;"Purpose: to search through Answers for string
2131 ;"Input: Answers -- PASS BY REFERENCE, an array linking display number to IENS.
2132 ;" Array should be the one created by ShowEList
2133 ;" Answer(count)=DrugIEN^GenericDrugName^TradeName
2134 ;" Answer(count)=DrugIEN^GenericDrugName^TradeName
2135 ;" List -- PASS BY REFERENCE -- an OUT PARAMETER, to hold array of entries (user input values)
2136 ;" prior entries are NOT KILLED
2137 ;" ByTradeName -- OPTIONAL, if value=1, then values are shown by TradeName
2138 ;" ShowBoth -- OPTIONAL, if value=1 then trade name and generic names both shown.
2139 ;"Results: 1=some added to list, 0=none added to list.
2140
2141 set ByTradeName=$get(ByTradeName,0)
2142 set ShowBoth=$get(ShowBoth,0)
2143 new result set result=0
2144
2145 new input
2146 write !,"Search in ",$select((ByTradeName=1):"TRADE NAME",1:"GENRIC NAME")
2147 if ShowBoth write " and ",$select((ByTradeName=0):"TRADE NAME",1:"GENRIC NAME")
2148 read !,"Entry text to SEARCH for in entries: ^// ",input:$get(DTIME,3600),!
2149 if input="" set input="^"
2150 set input=$$UP^XLFSTR(input)
2151 if input="^" goto MSLDone
2152 new i set i=$order(Answers(""))
2153 if i'="" for do quit:(i="")
2154 . new TradeName,GenericName
2155 . set GenericName=$$UP^XLFSTR($piece($get(Answers(i)),"^",2))
2156 . set TradeName=$$UP^XLFSTR($piece($get(Answers(i)),"^",3))
2157 . if (ByTradeName=1)!(ShowBoth=1) do
2158 . . if TradeName[input set List(i)="",result=1
2159 . if (ByTradeName=0)!(ShowBoth=1) do
2160 . . if GenericName[input set List(i)="",result=1
2161 . set i=$order(Answers(i))
2162
2163MSLDone
2164 quit result
2165
2166 ;"=================================================================
2167
2168SelEdClasses
2169 ;"Purpose: Allow user to browse classes with selector
2170 ;"Input: none
2171 ;"Results: none
2172
2173 new Options,IEN
2174 set Options("FIELDS",1)=".09:1^VA DRUG CLASS^24"
2175 set Options("FIELDS",1,"LOOKUP FN")="$$SECLookup^TMGNDF3A()"
2176 set Options("FIELDS",2)=".05^TRADENAME^24"
2177 set Options("FIELDS",2,"NO EDIT")=1 ;"i.e. show for browsing, but don't allow edit
2178 set Options("FIELDS",3)=".07^GENERIC NAME^24"
2179 set Options("FIELDS",3,"NO EDIT")=1 ;"i.e. show for browsing, but don't allow edit
2180 set Options("FIELDS","MAX NUM")=3
2181 set Options("FILE")="22706.9^TMG FDA IMPORT COMPILED"
2182 ;"Get all records with SKIP THIS RECORD = 0 (KEEP)
2183
2184 write "Finding records not marked to be skipped...",!
2185 do GetFldValue^TMGSELED(22706.9,6,0,$name(Options("IEN LIST")))
2186
2187SEC1
2188 if $$SELED^TMGSELED(.Options)'=2 goto SECDone
2189 if $$GetIENs^TMGSELED(.Options)=0 goto SECDone
2190 goto SEC1
2191
2192SECDone quit
2193
2194
2195Ed1Classes
2196 ;"Purpose: Allow user to browse classes with selector
2197 ;"Input: none
2198 ;"Results: none
2199
2200 new Options,IEN
2201 set Options("FIELDS",1)=".09:1^VA DRUG CLASS^24"
2202 set Options("FIELDS",1,"LOOKUP FN")="$$SECLookup^TMGNDF3A()"
2203 set Options("FIELDS",2)=".05^TRADENAME^24"
2204 set Options("FIELDS",2,"NO EDIT")=1 ;"i.e. show for browsing, but don't allow edit
2205 set Options("FIELDS",3)=".07^GENERIC NAME^24"
2206 set Options("FIELDS",3,"NO EDIT")=1 ;"i.e. show for browsing, but don't allow edit
2207 set Options("FIELDS","MAX NUM")=3
2208 set Options("FILE")="22706.9^TMG FDA IMPORT COMPILED"
2209 ;"Get all records with SKIP THIS RECORD = 0 (KEEP)
2210
2211 new DIC,X,Y
2212 set DIC=22706.9
2213 set DIC(0)="MAEQ"
2214 do ^DIC write !
2215 if +Y'>0 goto E1Done
2216 set Options("IEN LIST",+Y)=""
2217
2218E1
2219 if $$SELED^TMGSELED(.Options)'=2 goto E1Done
2220 if $$GetIENs^TMGSELED(.Options)=0 goto E1Done
2221 goto E1
2222
2223E1Done quit
2224
2225
2226SECLookup()
2227 ;"Purpose: A custom call-back function that the selector will use
2228 ;" for looking up class of a given record or list of records.
2229 ;"Input: None (because this is to be used only for ONE field)
2230 ;"Results: Returns IEN for Class, or 0 if not found or abort.
2231
2232 new Classes,UsrClassIEN
2233
2234 do GetClasses(.Classes)
2235 do KillIntro(.Classes)
2236 set UsrClassIEN=$$SelectClass(.Classes)
2237
2238 quit UsrClassIEN
Note: See TracBrowser for help on using the repository browser.