TMGNDF3A ;TMG/kst/FDA Import: Drug class stuff ;03/25/06 ;;1.0;TMG-LIB;**1**;11/21/06 ;" FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS ;" Further processing, after functions in TMGNDF2C ;" Primarily working VA DRUG CLASS stuff. ;"Kevin Toppenberg MD ;"GNU General Public License (GPL) applies ;"11-21-2006 ;"======================================================================= ;" API -- Public Functions. ;"======================================================================= ;"Menu ;"======================================================================= ;"FillFromVADrugClass -- ensure that all the entries in TMG FDA IMPORT COMPILED ;" have a value for field VA DRUG CLASS ;"HandleEmptyClasses -- allow classification of all unclassified drugs (ones ;" with no potential match found in VistA database as a ;" starting point) ;"======================================================================= ;" Private Functions. ;"======================================================================= ;"ShowClasses -- Display all the drug classes, in a heirarchy. ;"GetClasses(Array) -- Purpose: To get an array back the shows the heirarchy of all VA DRUG classes ;"KillIntro(Array) One of the drug classes is AA000, INTRODUCTION. This will kill entry from the Array ;"GetClHeirarchy(ClassIEN,Array) -- get an array back the shows the heirarchy of one VA DRUG class ;"FixClasses -- fix VA DRUG CLASS records which are not properly linked into the heirarchy. ;"Fix1Class(IEN) -- fix the parent entry of one erroneous class, in the VA DRUG CLASS heirarchy. ;"GetInfo(IEN,Array) -- fill record from VA DRUG CLASS file into a usable array ;"TestSelectClass ;"$$SelectClass(Array,AskSub) -- Allow user to browse Array and select drug class ;"Search4Class() -- use Fileman to search for a drug class ;"$$SelectFrom(pRef) -- Allow user to browse Array and select drug class ;"SrchItems(input,Items) -- Search through Items array for input, and return index number if found ;"TestGather ;"GatherClasses(Array) ;"GetPossClass(IEN,Array) -- gather, from a list of possible drug matches, a list of possible VA DRUG CLASSESS ;"VerifyClasses(Array) -- allow user to accept or reject proposed drug class for new drugs. ;"ShowInstructions() ;"LookupHelp() ;"FindHelp() ;"SimHelp() ;"ShowList(Array,Answers,CompactMode,ShowBoth) -- To display the list generated by GatherClasses, by class orginization ;"DoSetClass(Array,Answers,List) -- add ClassIEN to field .09 (VA DRUG CLASS) in file TMG FDA IMPORT COMPILED ;"ShowInfo(Array,Answers,Num) -- show more about the specified drug ;"DoRemove(Array,Answers,List,ByTradeName,FromECode,Cancelled) -- remove entries from Array and Answers ;"DoLookup(Array,Answers,Classes,List,Cancelled) -- Manually lookup class for entries ;"WriteClass(ClassIEN,Array,Answers,List) -- do the actual setting of the class ;"ClrAnswers(Array,Answers,List,FromECode,UndoArray) -- remove entries from Array and Answers array. ;"VerifyWrite(ClassName,Answers,List) -- display list of entries and ask user if class set is desired ;"Disp2List(Answers,List,ByTradeName,ShowBoth) -- interfact to DisplayList function, to allow easier input. ;"DisplayList(Answers,List,Piece,AlsoPiece) -- display list of entries ;"SimilarPick(Array,Answers,List,Cancelled) -- allow user to specify that a set of numbers should use the same class as ;"FindPick(Array,Answers,List,FromECode,Cancelled) -- allow user to look up a drug already in the VistA database, and use the ;"GatherEmpties(Array) -- scan through all records in TMG FDA IMPORT COMPILED, and create an array of ;"ShowEList(Array,Answers,CompactMode,ByTradeName,ShowBoth) -- display the list of 'Empty' classes generated by GatherEmpties ;"ClassEClasses(Array) -- allow user to classify drugs with empty (none) VA Drug Class ;"DoGuess(Array,Answers,EntryList,Cancelled,Classes) -- a wrapper for DoEGuess ;"DoEGuess(Array,Answers,List,ByTradeName,ShowBoth,Cancelled,FormECode,Classes) - guess as classification for entries. ;"GGuessList(Array,Answers,List,Results) -- gather a guessing list of possible classes for each entry in List ;"AutoEClassification(Array) -- attempt to automatically classiffy drugs that have not potential match ;"Guess1(Array,Answers,List) -- return a guessed class, IF there is only one possible guess. ;"DoSetTools(Array,Answers,List,EntryS,ByTradeName,ShowBoth) -- tools for managing SETS to be worked on (List) ;"MkSrchList(Answers,List,ByTradeName,ShowBoth) -- search through Answers for string ;"======================================================================= ;"======================================================================= ;"This block of code will deal with establishing the VA DRUG CLASS Menu ;"Purpose: Provide menu to entry points of main routines new Menu,UsrSlct set Menu(0)="Pick Option for Filling Import Drug Class (3A)" set Menu(1)="Set class by Linked VA PRODUCT entry if Possible"_$char(9)_"FillByLink" set Menu(2)="Fill DRUG class for IMPORT entries from best guess."_$char(9)_"FillFromVADrugClass" set Menu(3)="Fill DRUG class for IMPORT entries with no guess."_$char(9)_"HandleEmptyClasses" set Menu(4)="Use SELECTOR to browse and edit IMPORT classes"_$char(9)_"SelEdClasses" set Menu(5)="Pick just 1 import and edit drug Class"_$char(9)_"Edit1" set Menu(6)="Pick imports to SKIP based on their drug CLASS"_$char(9)_"PickSkips" set Menu("P")="Prev Stage"_$char(9)_"Prev" set Menu("N")="Next Stage"_$char(9)_"Next" MC1 write # set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^") if UsrSlct="^" goto MCDone if UsrSlct=0 set UsrSlct="" if UsrSlct="FillFromVADrugClass" do FillFromVADrugClass goto MC1 if UsrSlct="HandleEmptyClasses" do HandleEmptyClasses goto MC1 if UsrSlct="FillByLink" do FillByLink goto MC1 if UsrSlct="SelEdClasses" do SelEdClasses goto MC1 if UsrSlct="Edit1" do Ed1Classes goto MC1 if UsrSlct="PickSkips" do PickSkips^TMGNDF3B goto MC1 if UsrSlct="Prev" goto Menu^TMGNDF2H ;"quit can occur from there... if UsrSlct="Next" goto Menu^TMGNDF3C ;"quit can occur from there... goto MC1 MCDone quit FillFromVADrugClass ;"Purpose: to provide a high-level entry point for ensuring that all the entries ;" in TMG FDA IMPORT COMPILED have a value for field VA DRUG CLASS write # write "======================================================",! write "Link FDA import entries to proper VA DRUG CLASS",! write "======================================================",!,! ;"do FillByLink ;"see if any easy links are all ready to go... new list new % set %=2 if $data(^TMG("TMP","DRUGS NEEDING CLASS"))>0 do . write !,"Infomation from a prior run found.",! . write "Use older info (recommended only during the same import cycle)" . set %=1 do YN^DICN write ! . if %=1 do . . write "Loading... " . . merge list=^TMG("TMP","DRUGS NEEDING CLASS") . . write "Done.",! if (%=-1) goto FDCDone if (%=2) do . write "Scanning drug file...",! . do GatherClasses(.list) . do AutoEClassification(.list) do VerifyClasses(.list) set %=1 write "Save information for future use" do YN^DICN write ! if %=1 do SaveList(.list) FDCDone write "Done.",! quit SaveList(List) ;"Purpse: save list kill ^TMG("TMP","DRUGS NEEDING CLASS") merge ^TMG("TMP","DRUGS NEEDING CLASS")=list quit FillByLink ;"Purpose: Fill Drug class for any drug that has an empty class, but points to ;" an entry in 50.68 write "Setting DRUG CLASS of imports from VA PRODUCT link, if possible.",! new count set count=0 new Itr,IEN set IEN=$$ItrInit^TMGITR(22706.9,.Itr) do PrepProgress^TMGITR(.Itr,20,0,"IEN") if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0) . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;"1=SKIP . new CurClass,newClass . set CurClass=+$piece($get(^TMG(22706.9,IEN,1)),"^",5) . if CurClass=0 do . . new vapIEN set vapIEN=+$piece($get(^TMG(22706.9,IEN,2,1,0)),"^",1) . . if vapIEN=0 quit . . set newClass=+$piece($get(^PSDNF(50.68,vapIEN,3)),"^",1) . . if newClass'=0 do . . . ;"write IEN," can be loaded with class: ",newClass,! . . . new TMGFDA,TMGMSG . . . set TMGFDA(22706.9,IEN_",",.09)=newClass . . . ;"set $piece(^TMG(22706.9,IEN,1),"^",5)=newClass . . . do FILE^DIE("K","TMGFDA","TMGMSG") . . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) . . . set count=count+1 do ProgressDone^TMGITR(.Itr) write count," entries modified.",! do PressToCont^TMGUSRIF quit ShowClasses ;"Purpose: to display all the drug classes, in a heirarchy. new Array do GetClasses(.Array) do ArrayDump^TMGDEBUG("Array") quit GetClasses(Array) ;"Purpose: To get an array back the shows the heirarchy of all VA DRUG classes ;" Array -- PASS BY REFERENCE, and OUT PARAMETER ;"Output: Array will be filled as follows: ;" Array(GGF-IEN)=e.g. ""AD000^ANTIDOTES,DETERRENTS AND POISON CONTROL" ;" Array(GGF-IEN,GF-IEN)=e.g. "AD100^ALCOHOL DETERRENTS" ;" Array(GGF-IEN,GF-IEN,F-IEN)=e.g. "AD150^ALCOHOL DETERRENTS -- GENERAL TYPE 1" ;" Array(GGF-IEN,GF-IEN,F-IEN,IEN)=e.g. "AD152^ALCOHOL DETERRENTS -- GENERAL TYPE 1b" ;" Note: prior entries in Array are NOT killed. ;"Results: none new IEN set IEN=$order(^PS(50.605,0)) if +IEN>0 for do quit:(+IEN'>0) . do GetClHeirarchy(IEN,.Array) . set IEN=$order(^PS(50.605,IEN)) quit KillIntro(Array) ;"Purpose: One of the drug classes is AA000, INTRODUCTION. This will kill this ;" entry from the Array ;"Input: Array -- Array, as created by GetClasses new IEN set IEN=$order(Array("")) if IEN'="" for do quit:(IEN="") . new temp set temp=IEN . set IEN=$order(Array(IEN)) . if $piece(Array(temp),"^",1)="AA000" kill Array(temp) quit GetClHeirarchy(ClassIEN,Array) ;"Purpose: To get an array back the shows the heirarchy of one VA DRUG class ;"Input: ClassIEN -- the IEN in file VA DRUG CLASS (50.605) ;" Array -- PASS BY REFERENCE, and OUT PARAMETER ;"Output: Array will be filled as follows: ;" Array(GGF-IEN)=e.g. ""AD000^ANTIDOTES,DETERRENTS AND POISON CONTROL" ;" Array(GGF-IEN,GF-IEN)=e.g. "AD100^ALCOHOL DETERRENTS" ;" Array(GGF-IEN,GF-IEN,F-IEN)=e.g. "AD150^ALCOHOL DETERRENTS -- GENERAL TYPE 1" ;" Array(GGF-IEN,GF-IEN,F-IEN,IEN)=e.g. "AD152^ALCOHOL DETERRENTS -- GENERAL TYPE 1b" ;" Note: prior entries in Array are NOT killed. ;"Results: none new ParentClass,indent new ResultArray if (+ClassIEN'=0) for do quit:(+ClassIEN=0) . new tempArray . if $data(ResultArray) do . . new temp merge temp=ResultArray . . kill ResultArray . . merge ResultArray(ClassIEN)=temp . new Curnode,Code,Name,CodeNum . set Curnode=$get(^PS(50.605,ClassIEN,0)) . set Code=$piece(Curnode,"^",1) . set CodeNum=+$extract(Code,3,5) . set Name=$piece(Curnode,"^",2) . set tempArray(ClassIEN)=Code_"^"_Name . set ParentClass=$piece(Curnode,"^",3) . if ParentClass=ClassIEN set ParentClass=0 ;"I found at least one circular ref. . if (ParentClass=0)&(CodeNum'=0) do . . write IEN,": ",Name," appears broken: ",Code," Will fix...",! . . do Fix1Class(IEN) . set ClassIEN=ParentClass . merge ResultArray=tempArray merge Array=ResultArray quit FixClasses ;"Purpose: I have found a few instances in the VA DRUG CLASS file where records are ;" not properly linked into the heirarchy. They either give themselves as ;" their own parents, or list no parent, though one should be present. ;" If any such entries exist, this function will fix them. new IEN set IEN=$order(^PS(50.605,0)) if +IEN>0 for do quit:(+IEN'>0) . new Curnode,Code,CodeNum,Name . set Curnode=$get(^PS(50.605,IEN,0)) . set Code=$piece(Curnode,"^",1) . set CodeNum=+$extract(Code,3,5) . set Name=$piece(Curnode,"^",2) . set ParentClass=+$piece(Curnode,"^",3) . if ParentClass=IEN set ParentClass=0 . if (ParentClass=0)&(CodeNum'=0) do . . write IEN,": ",Name," appears broken: ",Code," Will fix...",! . . do Fix1Class(IEN) . set IEN=$order(^PS(50.605,IEN)) quit Fix1Class(IEN) ;"Purpose: To fix the parent entry of one erroneous class, in the VA DRUG CLASS heirarchy. ;"Input: IEN -- the record number in VA DRUG CLASS to fix ;"Output: the database will be changed ;"Results: none. new Curnode,Code,CodeNum,ParentCode new ParentClass,NewParentClass set Curnode=$get(^PS(50.605,IEN,0)) set Code=$piece(Curnode,"^",1) set ParentClass=+$piece(Curnode,"^",3) set ParentCode=$extract(Code,1,2)_"000" set NewParentClass=+$order(^PS(50.605,"B",ParentCode,"")) if NewParentClass'=0 do . set $piece(^PS(50.605,IEN,0),"^",3)=NewParentClass quit GetInfo(IEN,Array) ;"Purpose: to fill record from VA DRUG CLASS file into a usable array ;"Input: IEN -- the IEN from VA DRUG CLASS file to get info for ;" Array -- PASS BY REFERENCE, to be filled in with data. Old data is KILLED. ;"Output: Array is filled with data: ;" Array("NAME")=name ;" Array("CODE")=code ;" Array("PARENT IEN")=parent IEN ;"Result: none new Curnode kill Array set Curnode=$get(^PS(50.605,IEN,0)) set Array("CODE")=$piece(Curnode,"^",1) set Array("NAME")=$piece(Curnode,"^",2) set Array("PARENT IEN")=+$piece(Curnode,"^",3) quit ;"---------------------- TestSelectClass new Array,IEN do GetClasses(.Array) do KillIntro(.Array) set IEN=$$SelectClass(.Array,1) write "IEN=",IEN,! quit SelectClass(Array,AskSub) ;"Purpose: Allow user to browse Array and select drug class ;"Input: Array -- An Array containing Drug Class info, as created by GetClasses() ;" AskSub -- OPTIONAL. If 1, user is asked if they want to browse sub-class (auto otherwise) ;"Results: Returns IEN of selected class, or 0 if not selected new IEN,done set done=0 set AskSub=$get(AskSub,0) ;"default=automatic browse of subclasses new pRef set pRef=$name(Array) for do quit:(done=1) . set IEN=$$SelectFrom(pRef) . if IEN=0 do quit . . if $qlength(pRef)>0 do . . . set pRef=$name(@pRef,$qlength(pRef)-1) . . else set done=1 . new skipSub set skipSub=0 . if (AskSub=1)&($data(Array(IEN))>1) do . . new % . . write "Browse sub-categories" . . set %=1 do YN^DICN write ! . . if %'=1 set skipSub=1 . if ($data(Array(IEN))>1)&(skipSub=0) set pRef=$name(@pRef@(IEN)) . else do . . new info,% . . do GetInfo(IEN,.info) . . write "Select: ",info("NAME") . . set %=1 do YN^DICN write ! . . if %=1 set done=1 quit IEN Search4Class() ;"Purpose: to use Fileman to search for a drug class ;"Results: Returns IEN of selected class, or 0 if not selected new DIC,X,Y set DIC=50.605 set DIC(0)="AEQM" set DIC("A")="Enter a DRUG CLASS to search for // " do ^DIC write ! new result set result=0 if +Y>0 set result=+Y quit result SelectFrom(pRef) ;"Purpose: Allow user to browse Array and select drug class ;"Input: pRef -- NAME OF part of array to browse, containing Drug Class info ;"Results: Returns IEN of selected class, or 0 if not selected new tempList,Items,Answers,name new i,count new result set result=0 set i="" for set i=$order(@pRef@(i)) quit:(+i'>0) do . set name=$piece($get(@pRef@(i)),"^",2) quit:(name="") . new class set class=$piece($get(@pRef@(i)),"^",1) quit:(class="") . set tempList(name)=i . set tempList(name,class)="" set count=1 set name=$order(tempList("")) if name'="" for do quit:(name="") . set Items(count)=name . set Items(count,"CLASS")=$order(tempList(name,"")) . set Answers(count)=$get(tempList(name)) . set count=count+1 . set name=$order(tempList(name)) new done set done=0 for do quit:(done=1) . new name set name=$piece($get(@pRef),"^",2) . if name="" set name="Major Drug Classes" . write !,"Select from one of these ",name,! . set i=$order(Items(0)) . if +i>0 for do quit:(+i'>0) . . write i,". " . . new class set class=$get(Items(i,"CLASS")) . . if class'="" write class,": " . . write Items(i),! . . set i=$order(Items(i)) . write !,"Enter # of Drug Class to Pick (^ to Backup, S to Search): ^// " . new input . read input:$get(DTIME,3600),! . set input=$$UP^XLFSTR(input) . if input="" set input="^" . if input="S" do quit:(done=1) . . new UsrIEN set UsrIEN=$$Search4Class . . if UsrIEN>0 set result=UsrIEN,done=1 . if input="?" do quit . . do LookupHelp() . . new temp read "-- Press ENTER to continue --",temp:$get(DTIME,3600),! . if input="" set input="^" . if input="^" set done=1 quit . if +input=input do . . set result=Answers(input) . . set done=1 . else do . . new temp set temp=$$SrchItems(input,.Items) . . if +temp>0 set result=Answers(temp),done=1 . . else write "Invalid input. Please try again.",! quit result SrchItems(input,Items) ;"Purpose: to Search through Items array for input, and return index number if found ;"Input: input -- the user input -- may be a partial match for the name. ;" Items -- PASS BY REFERENCE -- Input array, as created in SelectFrom() ;" Items(1)=value ;" Items(2)=value ;" Items(3)=value ;" ;"Result: returns index of the FIRST match new result set result="" new done set done=0 new value set input=$$UP^XLFSTR($get(input)) new i set i=$order(Items("")) if i'="" for do quit:(i="")!(done=1) . set value=$get(Items(i)) . set value=$extract(value,1,$length(input)) . if input=value set result=i,done=1 . set i=$order(Items(i)) quit result ;"============================================= GatherClasses(Array) ;"Purpose: To scan through all records in TMG FDA IMPORT COMPILED, and create an array of ;" possible entries for VA DRUG CLASS ;"Input: Array -- PASS BY REFERENCE, and OUT PARAMETER ;"Output: Array will be filled as follows: ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode ;" Array(DrugIEN,"?")="" ;" Array("?",DrugIEN)="" ;"Results: none ;"Note: if SKIP THIS RECORD field is set, then record will be skipped. ;" Also, if there is already an antry for the VA DRUG CLASS field, then will be skipped. write "Gathering information about entries with no current DRUG CLASS",! new Itr,IEN set IEN=$$ItrInit^TMGITR(22706.9,.Itr) do PrepProgress^TMGITR(.Itr,20,0,"IEN") if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0) . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;"1=SKIP . new PriorClass set PriorClass=+$piece($get(^TMG(22706.9,IEN,1)),"^",5) . if PriorClass>0 quit . new numRecs set numRecs=+$piece($get(^TMG(22706.9,IEN,3,0)),"^",4) ;"VA PRODUCT POSS MATCH . if numRecs=0 quit . do GetPossClass(IEN,.Array) do ProgressDone^TMGITR(.Itr) quit GetPossClass(IEN,Array) ;"Purpose: To gather, from a list of possible drug matches, a list of possible VA DRUG CLASSESS ;"Input: IEN -- IEN from TMG FDA IMPORT COMPILED (22706.9) file, to check. ;" Array -- PASS BY REFERENCE. An OUT PARAMETER ;"Output: Array filled as follows: ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose ;" Array(DrugIEN,"?")="" ;" Array("?",DrugIEN)="" new subIEN new TMGTradename set TMGTradename=$piece($get(^TMG(22706.9,IEN,0)),"^",4) set subIEN=$order(^TMG(22706.9,IEN,3,0)) new Dose set Dose=$piece($get(^TMG(22706.9,IEN,0)),"^",2) new Units set Units=$piece($get(^TMG(22706.9,IEN,0)),"^",3) if +subIEN>0 for do quit:(+subIEN'>0) . new DrugIEN set DrugIEN=+$get(^TMG(22706.9,IEN,3,subIEN,0)) . set subIEN=$order(^TMG(22706.9,IEN,3,subIEN)) . if DrugIEN=0 set Array(IEN,"?")="" quit . new ClassIEN set ClassIEN=+$get(^PSNDF(50.68,DrugIEN,3)) . if ClassIEN=0 set Array(IEN,"??")="" quit . new Info . do GetInfo(ClassIEN,.Info) . set Array("POSS MATCH",$get(Info("NAME")),TMGTradename,IEN)=ClassIEN_"^"_$get(Info("CODE"))_"^"_Dose_" "_Units else do . set Array(IEN,"?")="" . set Array("?",IEN)="" quit VerifyClasses(Array) ;"Purpose: To allow user to accept or reject proposed drug class for new drugs. ;"Input: Array -- PASS BY REFERENCE the array generated by GatherClasses ;"Output: Database is changed, by adding data to field .09 (VA DRUG CLASS) ;"Results: none new done set done=0 new input set input="R" new Answers new CompactMode set CompactMode=1 ;" (list display mode: 1=compact, 0=verb new ShowBoth set ShowBoth=1 new ByIngred set ByIngred=0 new EntryList,EntryS,Fn,Cancelled set Cancelled=0 new Classes do GetClasses(.Classes) do KillIntro(.Classes) for do quit:(done=1) . if input="R" do . . write !! . . write "--------------------------------------------------",! . . write "Specify which drugs are in the correct DRUG CLASS",! . . write "--------------------------------------------------",! . . do ShowList(.Array,.Answers,CompactMode,ShowBoth,ByIngred) . . do SaveList(.Array) ;"1/31/07 I got tired of loosing work after crashes, so will save each time... . . write "--------------------------------------------------",! . . write "Specify which drugs are in the correct DRUG CLASS",! . . write "--------------------------------------------------",! . . write " R to refresh, L lookup, ? for instructions, U to undo, V saVe",! . . write " X remove from list, N iNfo, S similar, F find",! . . write " C turn compact display ",$select((CompactMode=1):"OFF",1:"ON"),", B turn show Both names ",$select((ShowBoth=1):"OFF",1:"ON"),! . . write " I turn sort by Ingredients ",$select((ByIngred=1):"OFF",1:"ON")," G Guess class",! . . if $get(EntryS)'="" write " Current SET #'s: ",EntryS,", D to delete SET",! . . write " # or #-# or #,#-#,# etc., ^ done, ",! . write "Enter number(s) to ACCEPT drug class (or codes listed above): ^//" . read input:$get(DTIME,3600),! . if input="" set input="^" . set input=$$UP^XLFSTR(input) . if input="^" set done=1 quit . else if (input="?") do . . do ShowInstructions() . . set input="R" . else if input="N" do quit . . read "Enter number of drug to get info about: ^//",input,! . . do ShowInfo(.Array,.Answers,+input) . . set input="R" . else if input="C" do quit . . set CompactMode='CompactMode . . set input="R" . else if input="D" do quit;"---- delete set . . kill EntryList,EntryS . . set input="R" . else if input="U" do quit . . do Undo(.Array) . . set input="R" . else if input="V" do quit . . do SaveList(.Array) . . write "List Saved.",! . else if input="I" do quit . . set ByIngred='ByIngred . . set input="R" . else if input="B" do quit . . set ShowBoth='ShowBoth . . set input="R" . else if input="L" do quit;"<----- Lookup manually . . set Fn="do DoLookup(.Array,.Answers,.Classes,.EntryList,0,.Cancelled)" . . do XMenuOption("lookup manually",Fn,"LookupHelp",.EntryList,.EntryS) . else if input="G" do quit;" ---- guess drugs . . set Fn="do DoGuess(.Array,.Answers,.EntryList,.Cancelled,.Classes)" . . do XMenuOption("Guess Class",Fn,"LookupHelp",.EntryList,.EntryS) . else if input="S" do quit . . set Fn="do SimilarPick(.Array,.Answers,.EntryList,.Cancelled)" . . do XMenuOption("classify by SIMILARITY","do SimilarPick(.Array,.Answers,.EntryList)","LookupHelp",.EntryList,.EntryS) . else if input="X" do quit . . set Fn="do DoRemove(.Array,.Answers,.EntryList,0,0,.Cancelled)" . . do XMenuOption("REMOVE from list",Fn,"SimHelp",.EntryList,.EntryS) . else if input="F" do quit . . set Fn="do FindPick(.Array,.Answers,.EntryList,0,.Cancelled)" . . do XMenuOption("classify by FINDING a similar drug",Fn,"FindHelp",.EntryList,.EntryS) . else do ;"default is ACCEPT . . set Cancelled=0 . . set Fn="do DoSetClass(.Array,.Answers,.EntryList)" . . do XMenuOption("",Fn,"",.EntryList,.EntryS) quit XMenuOption(Prompt,FnStr,HlpFn,EntryList,EntryS) ;"Purpose: To carry out the various menu functions ;"Input: Prompt: the message to use to prompt user to enter numbers etc. ;" "Enter the Number(s) to" will be automatically provided ;" and ": (? help) ^// " will be added at end ;" FnStr: -- code to execute, e.g. "do DoLookup(.Array,.Answers,.Classes,.EntryList)" ;" HlpFn: e.g. FindHelp, SimHelp, LookupHelp, etc Don't add () to name ;" EntryList -- PASS BY REFERENCE ;" EntryS -- PASS BY REFERENCE. a string showing current set as a string ;"Note: makes use of global scope of 'input', and 'CompactMode', 'Cancelled' ;"Result: none. if $get(EntryS)="" do quit:(valid=0) . if Prompt'="" do XMO1 . . write "Enter the Number(s) to ",Prompt,": (? help) ^// " . . read input,! . . if input="?" do goto XMO1 . . . new Code set Code="do "_HlpFn_"()" . . . Xecute code . set valid=$$MkMultList^TMGMISC(input,.EntryList) . if valid set EntryS=input Xecute FnStr if CompactMode=1 set input="R" if Cancelled=0 kill EntryList,EntryS quit ShowInstructions() ;"Purpose: to explain the matching proces new temp write !,"Instruction:",!! write "Each drug that is to be added to the VistA database should have a drug CLASS.",! write "This class is used by VistA for drug interaction and drug allergy screening.",! write "As drugs are imported from the FDA database, the program attempts to determine",! write "the class automatically by comparing the drug to other drugs that have already",! write "been classified. This process is far from perfect and often produces incorrect",! write "matches. A knowledgable user (you) must review each of these potential ",! write "classifications and either accept them if accurate, or manually correct them.",!! write "If a match is correct, it may be accepted by simply entering the number of the entry.",! write "Multiple correct entries may be accepted at once by entering a range of numbers,",! write "e.g. 3-18. A list may also be entered, e.g. 3,7,9,15. A combination of these may",! write "also be entered, e.g. 1-20,32-45,50,75-100 etc.",! write ! write "The list of drugs to be reviewed can be quite long (i.e. tens of thousands of ",! write "drugs long), so a 'compact' mode is provided. When compact mode is ON, only",! write "the last classifaction grouping is shown. This mode may be turned on or off by",! write "entering 'C'",! write ! read " --- Press ENTER to continue --",temp:$get(DTIME,3600),! write # write !,"Instruction (continued):",!! write "Because many drug names may be unfamiliar, one may need to review the details of the",! write "drug entry before being able to classify it. This may be done by typing 'I'. This",! write "makes use of a standard Fileman record inquiry tool. Accept the default answers to",! write "the questions 'STANDARD CAPTIONED OUTPUT?' and 'Include COMPUTED fields?'. The",! write "entry in the file TMG FDA IMPORT COMPILED (a temporary file) will be displayed.",! write "After displaying the info, it will ask to select another entry to display.",! write "Just press enter exit and return to the matching process.",! write ! write "A faster way to review the ingredients of drug entries is to turn on the ingredient-",! write "display mode with 'G'. This will display the ingredient list after each drug in",! write "the display.",! write ! write "Once one is ready to correct a classification, a variety of tools are provided.",! write "Each tool will first ask for the drug entry or entries that are to be classified.",! write ! read " --- Press ENTER to continue --",temp:$get(DTIME,3600),! write # write !,"Instruction (continued):",!! write "The first classification tool is the 'F' (find) command." do FindHelp() read " --- Press ENTER to continue --",temp:$get(DTIME,3600),! write # write !,"Instruction (continued):",!! write "The next classification tool is the 'L' (lookup) command.",! do LookupHelp() read " --- Press ENTER to continue --",temp:$get(DTIME,3600),! write # write !,"Instruction (continued):",!! write "The next tool is the 'S' (similarity) command." do SimHelp() read " --- Press ENTER to continue --",temp:$get(DTIME,3600),! write # write !,"Instruction (continued):",!! write "And lastly entries may simply be removed from the list with the 'X' command.",! write "They may be removed perminantly from consideration for addition to the Vista",! write "database. This is appropriate for a drug that will never be used at your",! write "location. Or, the drug may be just removed from the current work list.",! write "This will leave the drugs unclassified and may cause DANGEROUS drug interactions",! write "or drug allergies to be UNDETECTED when this drug is prescribed for a patient",! write "later",! write ! read " --- Press ENTER to continue --",temp:$get(DTIME,3600),! quit LookupHelp() ;"Purpose: Show help for the Lookup functionality write "A list of drug classifications is shown to pick from. The VA DRUG CLASS system",! write "arranges drug classes into a heirarchy. And initially only the highest level",! write "classes are shown. Enter the number of a class to select it. If that class has",! write "subclasses, then these will be shown. Select the subclass, and then verify it.",! write "To backup, press ENTER or ^.",! write ! quit FindHelp() ;"Purpose: to show help for the FIND functionality write ! write "This command allows one to find a drug already in the VistA database, and use",! write "it's classification for the new drug in question.",! write "For example, if one is asked to classify POTASSIUM GLUCONATE ELIXIR 20 MEQ,",! write "there is a high likelihood that a similar drug already exists, and the matching",! write "process failed to find it. So search for the drug as follows:",! write "Enter drug name with desired DRUG CLASS// potassium gluc <--partial name entered",! write " 1 POTASSIUM GLUCONATE 2.2MEQ TAB",! write " 2 POTASSIUM GLUCONATE 2.6MEQ TAB",! write " 3 POTASSIUM GLUCONATE 20MEQ/15ML (SF) ELIXIR",! write " 4 POTASSIUM GLUCONATE 20MEQ/15ML ELIXIR",! write " 5 POTASSIUM GLUCONATE 20MEQ/15ML LIQUID",! write " Press to see more, '^' to exit this list, OR",! write " CHOOSE 1-5: 4 POTASSIUM GLUCONATE 20MEQ/15ML ELIXIR <-- 4 entered",! write ! write " DRUG CLASS: POTASSIUM",! write " Use this for drug(s) below?:",! write " entry: POTASSIUM GLUCONATE ELIXIR",! write " --------------------------------------",! write " Use DRUG CLASS [POTASSIUM] for drug(s) above? Yes// (Yes)",!! quit SimHelp() ;"Purpose: To show help for the Find Similar functionality write ! write "This command allows one to set the drug class of the drug in question to be",! write "the same as another drug shown in the display. For example:",! write ! write "CLASS: CEPHALOSPORIN 3RD GENERATION",! write "6068. TAZICEF FOR INJECTION 1 GM/VIAL",! write ! write "CLASS: DENTIFRICES",! write "7113. ALBION D PASTE DESENSITIZING DENTAL PROPHYLACTIC PASTE 8 %",! write "7114. PLUS + WHITE DESENTIZING FLUORIDE TOOTHPASTE",! write "7115. TAZICEF FOR INJECTION 1 GM",! write ! write "Here it would be useful to specify that entry 7115 is SIMILAR to 6068.",! write "This would set the class of 7155 to be CEPHALOSPORIN 3RD GENERATION.",!! quit Undo(Array) ;"Purpose: To allow user to undo an action that was done in error ;"Input: Array -- PASS BY REFERENCE the array containing the data, AND UNDO info ;" Array("UNDO","COUNT")=number of undo steps avail ;" Array("UNDO",Event#,part#)=code to be eXecuted to reverse step. ;"Note: Later, I may allow user to choose which items to undo, but for now, will ;" just undo the very LAST action new UndoCt set UndoCt=$get(Array("UNDO","COUNT")) new i set i=$order(Array("UNDO",UndoCt,"")) if i'="" for do quit:(i="") . new code set code=$get(Array("UNDO",UndoCt,i)) . do . . new $etrap set $etrap="w ""??Progress function -- error trapped??"",!" . . write code,!! . . xecute code . new oldI set oldI=i . set i=$order(Array("UNDO",UndoCt,i)) . kill Array("UNDO",UndoCt,oldI) . set Array("UNDO","COUNT")=UndoCt-1 quit ShowList(Array,Answers,CompactMode,ShowBoth,ByIngred) ;"Purpose: To display the list generated by GatherClasses, by class orginization ;"Input: Array -- the array containing the data ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN,"INGRED")=Ingredients <--- optional ;" Answers -- PASS BY REFERENCE. An array that will like display numbers with IENs ;" Answer(count)=DrugIEN^DrugName^ClassIEN^ClassName ;" Answer(count)=DrugIEN^DrugName^ClassIEN^ClassName ;" CompactMode -- OPTIONAL, if value=1, then only the LAST drug class will be ;" expanded (a potientially long list). Others will just show heading. ;" ShowBoth -- OPTIONAL, if value=1, then VA GENERIC field & Tradename will be shown for each entry ;" ByIngred -- OPTIONAL, if value=1, then list is shown sorted by Generic Name ;"Output: List is shown, and the Answers array is established and passed back. ;" Sometimes array is modified such that ingredient node is added ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN,"INGRED")=Ingredients <--- optional ;"Results: none. new someShown set someShown=0 new count,ClassName,LastClass set count=1 kill Answers set CompactMode=$get(CompactMode,0) set ShowBoth=$get(ShowBoth,0) set ByIngred=$get(ByIngred,0) if ByIngred=0 goto SL1 ;"Rather than try to merge the two processes, I just duplicated and modified ;"Display sorted by ingredients ;"First, resort array, by ingredients ;" IngredArray format: ;" IngredArray(ClassName,Ingred,IEN)=ClassIEN^ClassCode^DrugDose^TradeName ;" IngredArray(ClassName,Ingred,IEN)=ClassIEN^ClassCode^DrugDose^TradeName new IngredArray set LastClass=$order(Array("POSS MATCH",""),-1) set ClassName=$order(Array("POSS MATCH","")) if ClassName'="" for do quit:(ClassName="") . write !,"CLASS: ",ClassName,! . new TMGTradeName . new tempCount set tempCount=0 . set TMGTradeName=$order(Array("POSS MATCH",ClassName,"")) . if (CompactMode=1)&(ClassName'=LastClass) set TMGTradeName="" . if TMGTradeName'="" for do quit:(TMGTradeName="") . . new IEN,ClassIEN . . set IEN=$order(Array("POSS MATCH",ClassName,TMGTradeName,"")) . . if IEN>0 for do quit:(IEN'>0) . . . new Ingred,value,dose . . . set value=$get(Array("POSS MATCH",ClassName,TMGTradeName,IEN)) . . . set Ingred=$get(Array("POSS MATCH",ClassName,TMGTradeName,IEN,"INGRED")) . . . if Ingred="" do . . . . set Ingred=$$GET1^DIQ(22706.9,IEN,.08) . . . . set Array("POSS MATCH",ClassName,TMGTradeName,IEN,"INGRED")=Ingred . . . if Ingred="" do . . . . write "Couldn't find an ingredient name for file 22706.9, IEN=",IEN,! . . . . set Ingred="?" . . . if Ingred'="" do . . . . set IngredArray(ClassName,Ingred,IEN)=value . . . . set $piece(IngredArray(ClassName,Ingred,IEN),"^",4)=TMGTradeName . . . set IEN=$order(Array("POSS MATCH",ClassName,TMGTradeName,IEN)) . . set TMGTradeName=$order(Array("POSS MATCH",ClassName,TMGTradeName)) . set ClassName=$order(Array("POSS MATCH",ClassName)) ;"Now display IngredArray ;" IngredArray format: ;" IngredArray(ClassName,Ingred,IEN)=ClassIEN^ClassCode^DrugDose^TradeName ;" IngredArray(ClassName,Ingred,IEN)=ClassIEN^ClassCode^DrugDose^TradeName set LastClass=$order(IngredArray(""),-1) set ClassName=$order(IngredArray("")) if ClassName'="" for do quit:(ClassName="") . write !,"CLASS: ",ClassName,! . new IngredName . new tempCount set tempCount=0 . set IngredName=$order(IngredArray(ClassName,"")) . if (CompactMode=1)&(ClassName'=LastClass) set IngredName="" . if IngredName'="" for do quit:(IngredName="") . . new IEN,ClassIEN . . set IEN=$order(IngredArray(ClassName,IngredName,"")) . . if IEN>0 for do quit:(IEN'>0) . . . new value,dose,TMGTradeName . . . set value=$get(IngredArray(ClassName,IngredName,IEN)) . . . set ClassIEN=$piece(value,"^",1) . . . set dose=$piece(value,"^",3) . . . set TMGTradeName=$piece(value,"^",4) . . . write count,". ",IngredName," ",dose . . . if ShowBoth write " (#",IEN,")" . . . write ! . . . set tempCount=tempCount+1 . . . if (ShowBoth)&(TMGTradeName'="") write " (",TMGTradeName,")",! . . . set Answers(count)=IEN_"^"_TMGTradeName_"^"_ClassIEN_"^"_ClassName . . . set count=count+1 . . . set someShown=1 . . . set IEN=$order(IngredArray(ClassName,IngredName,IEN)) . . set IngredName=$order(IngredArrayArray(ClassName,IngredName)) . if tempCount>20 do . . write "END CLASS: ",ClassName,! . . set tempCount=0 . set ClassName=$order(IngredArray(ClassName)) goto SL2 SL1 ;"Display sorted by tradename set LastClass=$order(Array("POSS MATCH",""),-1) set ClassName=$order(Array("POSS MATCH","")) if ClassName'="" for do quit:(ClassName="") . write !,"CLASS: ",ClassName,! . new TMGTradeName . new tempCount set tempCount=0 . set TMGTradeName=$order(Array("POSS MATCH",ClassName,"")) . if (CompactMode=1)&(ClassName'=LastClass) set TMGTradeName="" . if TMGTradeName'="" for do quit:(TMGTradeName="") . . new IEN,ClassIEN . . set IEN=$order(Array("POSS MATCH",ClassName,TMGTradeName,"")) . . if IEN>0 for do quit:(IEN'>0) . . . new value set value=$get(Array("POSS MATCH",ClassName,TMGTradeName,IEN)) . . . set ClassIEN=$piece(value,"^",1) . . . new dose set dose=$piece(value,"^",3) . . . ;"write count,". (",IEN,") ",TMGTradeName," ",dose,! . . . write count,". ",TMGTradeName," ",dose . . . if ShowBoth write " (#",IEN,")" . . . write ! . . . set tempCount=tempCount+1 . . . if ShowBoth do . . . . new Ingred . . . . set Ingred=$get(Array("POSS MATCH",ClassName,TMGTradeName,IEN,"INGRED")) . . . . if Ingred="" do . . . . . set Ingred=$$GET1^DIQ(22706.9,IEN,.08) . . . . . set Array("POSS MATCH",ClassName,TMGTradeName,IEN,"INGRED")=Ingred . . . . if Ingred'="" write " (Same class as: ",Ingred,")",! . . . set Answers(count)=IEN_"^"_TMGTradeName_"^"_ClassIEN_"^"_ClassName . . . set count=count+1 . . . set someShown=1 . . . set IEN=$order(Array("POSS MATCH",ClassName,TMGTradeName,IEN)) . . set TMGTradeName=$order(Array("POSS MATCH",ClassName,TMGTradeName)) . if tempCount>20 do . . write "END CLASS: ",ClassName,! . . set tempCount=0 . set ClassName=$order(Array("POSS MATCH",ClassName)) SL2 if 'someShown write " --- (List is Empty) ---",! SLDone quit DoSetClass(Array,Answers,List) ;"Purpose: To add ClassIEN to field .09 (VA DRUG CLASS) in file TMG FDA IMPORT COMPILED ;"Input: Array -- PASS BY REFERENCE, array holding data, As created by Gather Classes ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose ;" Array(DrugIEN,"?")="" ;" Array("?",DrugIEN)="" ;" Answers -- PASS BY REFERENCE, an array linking display number to IENS. ;" Array should be the one created by ShowList ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to process. ;" Format as follows. ;" List(Entry number)="" ;" List(Entry number)="" ;"Results: none new DrugIEN,DrugName,ClassIEN,ClassName new i set i=$order(List("")) if i'="" for do quit:(i="") . set DrugIEN=+$piece($get(Answers(i)),"^",1) . set DrugName=$piece($get(Answers(i)),"^",2) . set ClassIEN=+$piece($get(Answers(i)),"^",3) . set ClassName=$piece($get(Answers(i)),"^",4) . if (DrugIEN'=0)&(ClassIEN'=0) do . . new UndoCt set UndoCt=+$get(Array("UNDO","COUNT"))+1 . . new OldValue set OldValue=$piece($get(^TMG(22706.9,DrugIEN,1)),"^",5) . . if OldValue="" set OldValue="""""" . . if +OldValue'=OldValue set OldValue=""""_OldValue_"""" . . set Array("UNDO",UndoCt,1)="set $piece(^TMG(22706.9,"_DrugIEN_",1),""^"",5)="_OldValue . . set $piece(^TMG(22706.9,DrugIEN,1),"^",5)=ClassIEN ;"I own file, and there are no XREF, so OK to direct set. . . kill Answers(i) . . set OldValue=$get(Array("POSS MATCH",ClassName,DrugName,DrugIEN)) . . if OldValue="" set OldValue="""""" . . if +OldValue'=OldValue set OldValue=""""_OldValue_"""" . . set Array("UNDO",UndoCt,2)="set Array(""POSS MATCH"","""_ClassName_""","""_DrugName_""","_DrugIEN_")="_OldValue . . set Array("UNDO","COUNT")=UndoCt . . kill Array("POSS MATCH",ClassName,DrugName,DrugIEN) . set i=$order(List(i)) quit ShowInfo(Array,Answers,Num) ;"Purpose: to show more about the specified drug ;"Input: Array -- PASS BY REFERENCE, array holding data, As created by Gather Classes ;" Answers -- PASS BY REFERENCE, an array linking display number to IENS. ;" Array should be the one created by ShowList ;" Num -- entry number to show new DrugIEN set DrugIEN=+$piece($get(Answers(Num)),"^",1) if DrugIEN=0 quit do DumpRec^TMGDEBUG(22706.9,DrugIEN) quit DoRemove(Array,Answers,List,ByTradeName,FromECode,Cancelled) ;"Purpose: To remove entries from Empty-class Array ;"Input: Array -- PASS BY REFERENCE, array holding data, As created by Gather Classes ;" Array("GENERIC NAME",VA GENERIC Name,DrugIEN)="" ;" Array("TRADE NAME",TradeName,DrugIEN)="" ;" Array("LINK GENERIC TO TRADE",TMGGeneric)=TradeName ;" Array("LINK TRADE TO GENERIC",TradeName)=TMGGeneric ;" Answers -- PASS BY REFERENCE, an array linking display number to IENS. ;" Array should be the one created by ShowEList ;" Answer(count)=DrugIEN^GenericDrugName^TradeName ;" Answer(count)=DrugIEN^GenericDrugName^TradeName ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to process. ;" Format as follows. ;" List(Entry number)="" ;" List(Entry number)="" ;" ByTradeName -- OPTIONAL, if value=1, then values are shown by TradeName ;" FromECode -- OPTIONAL, if value=1, then code is handled as if called from the 'empty' ;" code modules (ie HandleEmptyClasses) ;" Cancelled -- OPTIONAL, PASS BY REFERENCE, will be set to 1 if user cancelled. ;"Results: none set ByTradeName=$get(ByTradeName,0) set Cancelled=1 ;"default is cancellation write !,"Remove these drugs perminantly (i.e. don't add to VistA database)?",! do Disp2List(.Answers,.List,.ByTradeName) write "Remove these drugs perminantly (i.e. don't add to VistA database)" new % set %=1 do YN^DICN write ! new SetSkipFlag set SetSkipFlag=(%=1) if %=2 do . write "Temporarily remove drugs from category listing" . do YN^DICN write ! if %=2 goto DERMDone new UndoArray new DrugIEN,DrugName,TradeName new i set i=$order(List("")) if i'="" for do quit:(i="") . set DrugIEN=+$piece($get(Answers(i)),"^",1) . new UndoCt set UndoCt=$order(UndoArray(i,""),-1)+1 . if (DrugIEN>0)&(SetSkipFlag) do . . new OldValue set OldValue=$piece(^TMG(22706.9,DrugIEN,1),"^",4) . . if OldValue="" set OldValue="""""" . . if +OldValue'=OldValue set OldValue=""""_OldValue_"""" . . set UndoArray(i,UndoCt)="set $piece(^TMG(22706.9,"_DrugIEN_",1),""^"",4)="_OldValue . . set $piece(^TMG(22706.9,DrugIEN,1),"^",4)=1 ;"I own file, and there are no XREF, so OK to direct set. . if (SetSkipFlag=0)&(FromECode=0) do . . set UndoArray(i,UndoCt)="kill Array("_DrugIEN_",""?"")" . . set UndoArray(i,UndoCt+1)="kill Array(""?"","_DrugIEN_")" . . set Array(DrugIEN,"?")="" . . set Array("?",DrugIEN)="" . set i=$order(List(i)) do ClrAnswers(.Array,.Answers,.List,.FromECode,.UndoArray) new UndoCt set UndoCt=$get(Array("UNDO","COUNT")) set i="" for set i=$order(UndoArray(i)) quit:(i="") do . merge Array("UNDO",UndoCt)=UndoArray(i) . set UndoCt=UndoCt+1 set Array("UNDO","COUNT")=UndoCt set Cancelled=0 ;"set success here DERMDone quit DoLookup(Array,Answers,Classes,List,FromECode,Cancelled) ;"Purpose: To Manually lookup class for entries ;"Input: Array -- PASS BY REFERENCE, array holding data, As created by Gather Classes ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose ;" Array(DrugIEN,"?")="" ;" Array("?",DrugIEN)="" ;" Answers -- PASS BY REFERENCE, an array linking display number to IENS. ;" Array should be the one created by ShowList ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName ;" Classes -- PASS BY REFERENCE, an array containing classes ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to process. ;" Format as follows. ;" List(Entry number)="" ;" List(Entry number)="" ;" FromECode -- OPTIONAL, if value=1, then code is handled as if called from the 'empty' ;" code modules (ie HandleEmptyClasses) ;" Cancelled -- OPTIONAL, PASS BY REFERENCE, will be set to 1 if user cancelled. ;"Results: none set Cancelled=1 ;"default to cancellation new UsrClassIEN set UsrClassIEN=$$SelectClass(.Classes) if UsrClassIEN=0 goto DLUDone new ClassName set ClassName=$$GET1^DIQ(50.605,UsrClassIEN,1) if $$VerifyWrite(ClassName,.Answers,.List)=0 goto DLUDone do WriteClass(UsrClassIEN,.Array,.Answers,.List,.FromECode) set Cancelled=0 ;"set success here DLUDone quit WriteClass(ClassIEN,Array,Answers,List,FromECode) ;"Purpose: To do the actual setting of the class ;"Input: ClassIEN -- the IEN of the class to set. ;" Array -- PASS BY REFERENCE, array holding data, As created by Gather Classes ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose ;" Array(DrugIEN,"?")="" ;" Array("?",DrugIEN)="" ;" Note: Only needed to clear out entries that are no longer needed. ;" OR, if FromECode=1, then this Array format is used: ;" Array("GENERIC NAME",VA GENERIC Name,DrugIEN)="" ;" Array("TRADE NAME",TradeName,DrugIEN)="" ;" Array("LINK GENERIC TO TRADE",TMGGeneric)=TradeName ;" Array("LINK TRADE TO GENERIC",TradeName)=TMGGeneric ;" Answers -- PASS BY REFERENCE, an array linking display number to IENS. ;" Array should be the one created by ShowList ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName ;" OR, if FromECode=1, then this format is used: ;" Answer(count)=DrugIEN^GenericDrugName^TradeName ;" Answer(count)=DrugIEN^GenericDrugName^TradeName ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to process. ;" Format as follows. ;" List(Entry number)="" ;" List(Entry number)="" ;" FromECode -- OPTIONAL, if value=1, then code is handled as if called from the 'empty' ;" code modules (ie HandleEmptyClasses) ;"Output: Data will be altered in file 22706.9 ;" Array will be modified: Undo information will be added: ;" Array("UNDO","COUNT")=number of undo steps avail ;" Array("UNDO",Event#,part#)=code to be eXecuted to reverse step. ;"Results: none new DrugIEN,DrugName,ClassName new UndoArray set UndoArray("")="" new i set i=$order(List("")) if i'="" for do quit:(i="") . set DrugIEN=+$piece($get(Answers(i)),"^",1) . if DrugIEN=0 goto WC1 . new UndoCt set UndoCt=$order(UndoArray(i,""))+1 . new OldValue set OldValue=$piece(^TMG(22706.9,DrugIEN,1),"^",5) . if OldValue="" set OldValue="""""" . if +OldValue'=OldValue set OldValue=""""_OldValue_"""" . set UndoArray(i,UndoCt)="set $piece(^TMG(22706.9,"_DrugIEN_",1),""^"",5)="_OldValue . set $piece(^TMG(22706.9,DrugIEN,1),"^",5)=ClassIEN ;"I own file, and there are no XREF, so OK to direct set. WC1 . set i=$order(List(i)) do ClrAnswers(.Array,.Answers,.List,.FromECode,.UndoArray) set i=$order(UndoArray("")) new UndoCt set UndoCt=$get(Array("UNDO","COUNT")) if i'="" for do quit:(i="") . merge Array("UNDO",UndoCt)=UndoArray(i) . set UndoCt=UndoCt+1 . set i=$order(UndoArray(i)) set Array("UNDO","COUNT")=UndoCt WCDone quit ClrAnswers(Array,Answers,List,FromECode,UndoArray) ;"Purpose: To remove entries from Array and Answers array. ;"Input: Array -- PASS BY REFERENCE, array holding data, As created by Gather Classes ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose ;" Array(DrugIEN,"?")="" ;" Array("?",DrugIEN)="" ;" Note: Only needed to clear out entries that are no longer needed. ;" OR, if FromECode=1, then this Array format is used: ;" Array("GENERIC NAME",VA GENERIC Name,DrugIEN)="" ;" Array("TRADE NAME",TradeName,DrugIEN)="" ;" Array("LINK GENERIC TO TRADE",TMGGeneric)=TradeName ;" Array("LINK TRADE TO GENERIC",TradeName)=TMGGeneric ;" Answers -- PASS BY REFERENCE, an array linking display number to IENS. ;" Array should be the one created by ShowList ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName ;" OR, if FromECode=1, then this format is used: ;" Answer(count)=DrugIEN^GenericDrugName^TradeName ;" Answer(count)=DrugIEN^GenericDrugName^TradeName ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to process. ;" Format as follows. ;" List(Entry number)="" ;" List(Entry number)="" ;" FromECode -- OPTIONAL, if value=1, then code is handled as if called from the 'empty' ;" code modules (ie HandleEmptyClasses) ;" UndoArray -- PASS BY REFERENCE -- an array to be filled with undo info ;" format as follows: ;" Array(list#,step#)=CodeToBeExecuted ;" Array(list#,step#)=CodeToBeExecuted ;"Output: Entries will be removed from list. ;"Results: none new DrugIEN,DrugName,ClassName new i set i=$order(List("")) if i'="" for do quit:(i="") . set DrugIEN=+$piece($get(Answers(i)),"^",1) . if DrugIEN=0 goto CA1 . new UndoCt set UndoCt=$order(UndoArray(i,""))+1 . if $get(FromECode)=1 do . . new GenericName,TradeName . . set GenericName=$piece($get(Answers(i)),"^",2) . . set TradeName=$piece($get(Answers(i)),"^",3) . . ;"save info for possible undo in the future . . new OldValue set OldValue=$get(Array("GENERIC NAME",GenericName,DrugIEN)) . . if OldValue="" set OldValue="""""" . . if +OldValue'=OldValue set OldValue=""""_OldValue_"""" . . set UndoArray(i,UndoCt)="set Array(""GENERIC NAME"","_GenericName_","_DrugIEN_")="_OldValue . . set UndoCt=UndoCt+1 . . new OldValue set OldValue=$get(Array("TRADE NAME",TradeName,DrugIEN)) . . if OldValue="" set OldValue="""""" . . if +OldValue'=OldValue set OldValue=""""_OldValue_"""" . . set UndoArray(i,UndoCt)="set Array(""TRADE NAME"","_TradeName_","_DrugIEN_")="_OldValue . . ;"Now do real removal . . kill Array("GENERIC NAME",GenericName,DrugIEN) . . kill Array("TRADE NAME",TradeName,DrugIEN) . else do . . set DrugName=$piece($get(Answers(i)),"^",2) . . set ClassName=$piece($get(Answers(i)),"^",4) . . new OldValue set OldValue=$get(Array("POSS MATCH",ClassName,DrugName,DrugIEN)) . . if OldValue="" set OldValue="""""" . . if +OldValue'=OldValue set OldValue=""""_OldValue_"""" . . set UndoArray(i,UndoCt)="set Array(""POSS MATCH"","_ClassName_","_DrugName_","_DrugIEN_")="_OldValue . . kill Array("POSS MATCH",ClassName,DrugName,DrugIEN) . kill Answers(i) ;"I'm not sure how to undo this part. I think it's regenerated with each display of list CA1 . set i=$order(List(i)) quit VerifyWrite(ClassName,Answers,List,ByTradeName,ShowBoth) ;"Purpose: To display list of entries and ask user if class set is desired ;"Input: ClassName -- the name of the VA DRUG CLASS ;" Answers -- PASS BY REFERENCE, an array linking display number to IENS. ;" Array should be the one created by ShowList ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to process. ;" Format as follows. ;" List(Entry number)="" ;" List(Entry number)="" ;" ByTradeName -- OPTIONAL, if value=1, then values are shown by TradeName ;" ShowBoth -- OPTIONAL, if value=1 then trade name and generic names both shown. ;"Result: 1 if writing is OK, other 0 write !,"DRUG CLASS: ",ClassName,! write "Use this for drug(s) below?: ",! do Disp2List(.Answers,.List,.ByTradeName,.ShowBoth) write "Use DRUG CLASS [",ClassName,"] for drug(s) above" new % set %=1 do YN^DICN write ! quit (%=1) Disp2List(Answers,List,ByTradeName,ShowBoth) ;"Purpose: An interfact to DisplayList function, to allow easier input. ;"Input: Answers -- PASS BY REFERENCE, an array linking display number to IENS. See DisplayList ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to process. See DisplayList ;" ByTradeName -- OPTIONAL, if value=1, then values are shown by TradeName ;" ShowBoth -- OPTIONAL, if value=1 then trade name and generic names both shown. set ByTradeName=$get(ByTradeName,0) set ShowBoth=$get(ShowBoth,0) new part,alsoPart set alsoPart=0 if ByTradeName=1 do . set part=3 ;"i.e. show TradeName . if ShowBoth set alsoPart=2 else do . set part=2 ;"i.e. show GenericName . if ShowBoth set alsoPart=3 do DisplayList(.Answers,.List,part,alsoPart) quit DisplayList(Answers,List,Piece,AlsoPiece) ;"Purpose: To display list of entries ;"Input: Answers -- PASS BY REFERENCE, an array linking display number to IENS. ;" Array should be the one created by ShowList ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName ;" OR, Array as created by ShowEList ;" Answer(count)=DrugIEN^GenericDrugName^TradeName ;" Answer(count)=DrugIEN^GenericDrugName^TradeName ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to process. ;" Format as follows. ;" List(Entry number)="" ;" List(Entry number)="" ;" Piece -- OPTIONAL, default=2. The piece number of Answer value to show. ;" AlsoPiece -- OPTIONAL, default="", If specified, then this piece of the Answer ;" will also be shown in paretheses under the original answer. ;"Result: none new someShown set someShown=0 set Piece=$get(Piece,2) new i set i=$order(List("")) if i'="" for do quit:(i="") . write " ",i,". ",$piece($get(Answers(i)),"^",Piece),! . set someShown=1 . if +$get(AlsoPiece)>0 do . . write " (",$piece($get(Answers(i)),"^",AlsoPiece),")",! . set i=$order(List(i)) if someShown=0 write " -- List is EMPTY -- ",! write "--------------------------------------",! quit SimilarPick(Array,Answers,List,FromECode,Cancelled) ;"Purpose: To allow user to specify that a set of numbers should use the same class as ;" another entry. ;"Input: Array -- PASS BY REFERENCE, array holding data, As created by Gather Classes ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose ;" Array(DrugIEN,"?")="" ;" Array("?",DrugIEN)="" ;" Answers -- PASS BY REFERENCE, an array linking display number to IENS. ;" Array should be the one created by ShowList ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to process. ;" Format as follows. ;" List(Entry number)="" ;" List(Entry number)="" ;" FromECode -- OPTIONAL, if value=1, then code is handled as if called from the 'empty' ;" code modules (ie HandleEmptyClasses) ;"Results: none set Cancelled=1 ;"default to cancellation new input read "Which entry has the CORRECT CLASS? ",input:$get(DTIME,3600),! if +input'=input goto SPDone new SimClName set SimClName=$piece($get(Answers(input)),"^",4) new SimClIEN set SimClIEN=+$piece($get(Answers(input)),"^",3) if $$VerifyWrite(SimClName,.Answers,.List)=1 goto SPDone do WriteClass(SimClIEN,.Array,.Answers,.List,.FromECode) set Cancelled=0 ;"signal success SPDone quit FindPick(Array,Answers,List,FromECode,Cancelled) ;"Purpose: To allow user to look up a drug already in the VistA database, and use the ;" VA DRUG CLASS assigned to that drug. ;" another entry. ;"Input: Array -- PASS BY REFERENCE, array holding data, As created by Gather Classes ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose ;" Array(DrugIEN,"?")="" ;" Array("?",DrugIEN)="" ;" Answers -- PASS BY REFERENCE, an array linking display number to IENS. ;" Array should be the one created by ShowList ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to process. ;" Format as follows. ;" List(Entry number)="" ;" List(Entry number)="" ;" FromECode -- OPTIONAL, if value=1, then code is handled as if called from the 'empty' ;" code modules (ie HandleEmptyClasses) ;" Cancelled -- OPTIONAL, PASS BY REFERENCE, will be set to 1 if user cancelled. ;"Results: none set Cancelled=1 ;"default is cancellation write "Classify drug by finding ANOTHER drug in the SAME CLASS",! FPLoop new DIC,X,Y set DIC=50.68 set DIC(0)="AEQM" set DIC("A")="Enter DRUG NAME OF EXAMPLE with desired CLASS// " do ^DIC write ! if +Y'>0 do goto FPDone . write "No usable value found.",! . do PressToCont^TMGUSRIF new SimClName,SimClIEN set SimClIEN=$$GET1^DIQ(50.68,+Y,15,"I") ;"50.68=VA PRODUCT file if SimClIEN'>0 do goto FPDone . write "No usable value found.",! . do PressToCont^TMGUSRIF set SimClName=$$GET1^DIQ(50.605,SimClIEN,1) ;"50.605 is VA DRUG CLASS new IsOK set IsOK=$$VerifyWrite(SimClName,.Answers,.List) new TryAgain set TryAgain=0 if IsOK=1 do . do WriteClass(SimClIEN,.Array,.Answers,.List,.FromECode) . set Cancelled=0 ;"set success here else do . write "Pick another DRUG CLASS" . new % set %=1 do YN^DICN write ! . set TryAgain=(%=1) if TryAgain=1 goto FPLoop FPDone quit ;"======================================================================= ;"======================================================================= HandleEmptyClasses ;"Purpose: To allow classification of all unclassified drugs (ones with not potential ;" match found in VistA database as a starting point) new array write "Gathering information...",! do GatherEmpties(.array) do ClassEClasses(.array) quit GatherEmpties(Array) ;"Purpose: To scan through all records in TMG FDA IMPORT COMPILED, and create an array of ;" possible entries for VA DRUG CLASS, from ones that have NO possible VA PRODUCT MATCH ;"Input: Array -- PASS BY REFERENCE, and OUT PARAMETER ;"Output: Array will be filled as follows: ;" Array("GENERIC NAME",VA GENERIC Name,DrugIEN)="" ;" Array("TRADE NAME",TradeName,DrugIEN)="" ;" Array("LINK GENERIC TO TRADE",TMGGeneric)=TradeName ;" Array("LINK TRADE TO GENERIC",TradeName)=TMGGeneric ;"Results: none ;"Note: if SKIP THIS RECORD field is set, then record will be skipped. ;" Also, if there is already an antry for the VA DRUG CLASS field, then will be skipped. new Itr,IEN set IEN=$$ItrInit^TMGITR(22706.9,.Itr) do PrepProgress^TMGITR(.Itr,20,0,"IEN") if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0) . new tempIEN set IEN=IEN . new skipFlag set skipFlag=+$piece($get(^TMG(22706.9,IEN,1)),"^",4) . new PriorClass set PriorClass=+$piece($get(^TMG(22706.9,IEN,1)),"^",5) . ;"write IEN," --> ",PriorClass,! . if skipFlag=1 quit . if PriorClass>0 quit . new TMGGeneric set TMGGeneric=$piece($get(^TMG(22706.9,IEN,0)),"^",6) ;"GENERIC NAME . new TradeName set TradeName=$piece($get(^TMG(22706.9,IEN,0)),"^",4) ;"TRADENAME . if TMGGeneric'="" set Array("GENERIC NAME",TMGGeneric,IEN)="" . if TradeName'="" set Array("TRADE NAME",TradeName,IEN)="" . if (TMGGeneric'="")&(TradeName'="") do . . set Array("LINK GENERIC TO TRADE",TMGGeneric)=TradeName . . set Array("LINK TRADE TO GENERIC",TradeName)=TMGGeneric do ProgressDone^TMGITR(.Itr) quit ShowEList(Array,Answers,CompactMode,ByTradeName,ShowBoth) ;"Purpose: To display the list of 'Empty' classes generated by GatherEmpties ;"Input: Array -- the array containing the data ;" Array("GENERIC NAME",VA GENERIC Name,DrugIEN)="" ;" Array("TRADE NAME",TradeName,DrugIEN)="" ;" Array("LINK GENERIC TO TRADE",TMGGeneric)=TradeName ;" Array("LINK TRADE TO GENERIC",TradeName)=TMGGeneric ;" Answers -- PASS BY REFERENCE. An OUT PARAMATER. ;" Array will receive display numbers with IENs ;" Answer(count)=DrugIEN^GenericDrugName^TradeName ;" Answer(count)=DrugIEN^GenericDrugName^TradeName ;" CompactMode -- OPTIONAL, if value=1, then only the LAST drug class will be ;" expanded (a potientially long list). Others will just show heading. ;" ByTradeName -- OPTIONAL, if value=1, then values are shown by TradeName ;" ShowBoth -- OPTIONAL, if value=1 then both Generic and TradeName shown. ;"Output: List is shown, and the Answers array is established and passed back. ;"Results: none. new someShown set someShown=0 new count set count=1 kill Answers set CompactMode=$get(CompactMode,0) set ByTradeName=$get(ByTradeName,0) set ShowBoth=$get(ShowBoth,0) new IEN new GenericName,TradeName,DrugName new CountLimit set CountLimit=99999 if CompactMode=1 do . if ShowBoth=1 set CountLimit=8 . else set CountLimit=10 new Label set Label="GENERIC NAME" if ByTradeName=1 set Label="TRADE NAME" set DrugName=$order(Array(Label,"")) if DrugName'="" for do quit:(DrugName="")!(count>CountLimit) . set IEN=$order(Array(Label,DrugName,"")) . if IEN'="" for do quit:(IEN="")!(count>CountLimit) . . write count,". ",DrugName,! . . new OtherName . . if ByTradeName=0 do . . . set GenericName=DrugName . . . set TradeName=$get(Array("LINK GENERIC TO TRADE",GenericName)) . . . set OtherName=TradeName . . else do . . . set TradeName=DrugName . . . set GenericName=$get(Array("LINK TRADE TO GENERIC",TradeName)) . . . set OtherName=GenericName . . if ShowBoth=1 write " (",OtherName,")",! . . set Answers(count)=IEN_"^"_GenericName_"^"_TradeName . . set count=count+1 . . set IEN=$order(Array(Label,DrugName,IEN)) . set DrugName=$order(Array(Label,DrugName)) . set someShown=1 if 'someShown write " --- (List is Empty) ---",! quit ClassEClasses(Array) ;"Purpose: To allow user to classify drugs with empty (none) VA Drug Class ;"Input: Array -- PASS BY REFERENCE the array generated by GatherEmpties ;" Array("GENERIC NAME",VA GENERIC Name,DrugIEN)="" ;" Array("TRADE NAME",TradeName,DrugIEN)="" ;"Output: Database is changed, by adding data to field .09 (VA DRUG CLASS) ;"Results: none new done set done=0 new input set input="R" new Answers new CompactMode set CompactMode=1 ;" (list display mode: 1=compact, 0=verb new ShowBoth set ShowBoth=0 new ByTrade set ByTrade=1 new EntryList,EntryS new Classes do GetClasses(.Classes) do KillIntro(.Classes) for do quit:(done=1) . if input="R" do . . write !! . . write "--------------------------------------------------",! . . write "Pick drug(s) to specify a DRUG CLASS",! . . write "--------------------------------------------------",! . . do ShowEList(.Array,.Answers,CompactMode,ByTrade,ShowBoth) . . write "--------------------------------------------------",! . . write "Pick drug(s) to specify a DRUG CLASS",! . write "--------------------------------------------------",! . write " R=refresh, ?=instructions, X=remove from list, I=info, F=find",! . write " G=Guess, L Lookup",! . write " C=set Compact ",$select((CompactMode=1):"OFF",1:"ON"),", " . write "T=set TradeName ",$select((ByTrade=1):"OFF",1:"ON"),", B=set Both names ",$select((ShowBoth=1):"OFF",1:"ON") . write ", ",! . write " # or #-# or #,#-#,# etc., S=SET tools, ^ done, ",! . if $get(EntryS)'="" write " Current SET #'s: ",EntryS,", D to delete SET",! . write "Enter number(s) to LOOKUP drug class (or codes listed above): R//" . read input:$get(DTIME,3600),! . if input="" set input="R" . set input=$$UP^XLFSTR(input) . if input="^" set done=1 quit . else if (input="?") do ;"---- instructions . . ;"do ShowInstructions() . . set input="R" . else if input="I" do ;" ---- drug info . . read "...Enter number of drug to get info about: ^//",input,! . . do ShowInfo(.Array,.Answers,+input) . . set input="R" . else if input="C" do ;"--- toggle compact mode . . set CompactMode='CompactMode . . set input="R" . else if input="T" do ;"---- toggle display by tradename . . set ByTrade='ByTrade . . set input="R" . else if input="B" do ;" ---- toggle display of both names. . . set ShowBoth='ShowBoth . . set input="R" . else if input="D" do ;"---- delete set . . kill EntryList,EntryS . . set input="R" . else if input="X" do ;" ---- delete entries . . new valid set valid=1 . . if $get(EntryS)="" do quit:(valid=0) . . . read "...Enter number(s) to REMOVE from list: ^// ",input,! . . . set valid=$$MkMultList^TMGMISC(input,.EntryList) . . . if valid set EntryS=input . . if CompactMode=1 set input="R" . . new Cancelled . . do DoRemove(.Array,.Answers,.EntryList,ByTrade,1,.Cancelled) . . if Cancelled=0 kill EntryList,EntryS . else if input="S" do ;"---- set tools . . do DoSetTools(.Array,.Answers,.EntryList,.EntryS,.ByTrade,.ShowBoth) . . if CompactMode=1 set input="R" . else if input="F" do ;" ---- find drugs . . new valid set valid=1 . . if $get(EntryS)="" do quit:(valid=0) EFL . . . read "...Enter number(s) to classify by FINDING a similar drug: (? help) ^// ",input,! . . . if input="?" do FindHelp() goto EFL . . . set valid=$$MkMultList^TMGMISC(input,.EntryList) . . . if valid set EntryS=input . . if CompactMode=1 set input="R" . . new Cancelled . . do FindPick(.Array,.Answers,.EntryList,1,.Cancelled) . . if Cancelled=0 kill EntryList,EntryS . else if (input="L")!(+input>0) do ;" ----- lookup drugs . . new valid set valid=1 . . if $get(EntryS)="" do quit:(valid=0) . . . if input="L" read "...Enter number(s) to LOOKUP from list: ^// ",input,! . . . set valid=$$MkMultList^TMGMISC(input,.EntryList) . . . if valid set EntryS=input . . if CompactMode=1 set input="R" . . new Cancelled . . do DoLookup(.Array,.Answers,.Classes,.EntryList,1,.Cancelled) . . if Cancelled=0 kill EntryList,EntryS . else if input="G" do ;" ---- guess drugs . . new valid set valid=1 . . if $get(EntryS)="" do quit:(valid=0) EGL . . . read "...Enter number(s) to classify by GUESSING: (? help) ^// ",input,! . . . if input="?" do FindHelp() goto EFL . . . set valid=$$MkMultList^TMGMISC(input,.EntryList) . . . if valid set EntryS=input . . if CompactMode=1 set input="R" . . new Cancelled . . do DoEGuess(.Array,.Answers,.EntryList,ByTrade,ShowBoth,.Cancelled,1,.Classes) . . if Cancelled=0 kill EntryList,EntryS . else if input'="R" do ;"---- accept numeric input etc. . . if $$MkMultList^TMGMISC(input,.EntryList)=0 quit . . set EntryS=input . . if CompactMode=1 set input="R" quit DoGuess(Array,Answers,EntryList,Cancelled,Classes) ;"Purpose: A wrapper for DoEGuess, with some automatically provided paremeters do DoEGuess(.Array,.Answers,.EntryList,0,0,.Cancelled,0,.Classes) quit DoEGuess(Array,Answers,List,ByTradeName,ShowBoth,Cancelled,FromECode,Classes) ;"Purpose: To guess as classification for entries. ;"Input: Array -- PASS BY REFERENCE, array holding data, As created by GatherEmpties(Array) ;" Array("GENERIC NAME",VA GENERIC Name,DrugIEN)="" ;" Array("TRADE NAME",TradeName,DrugIEN)="" ;" Array("LINK GENERIC TO TRADE",TMGGeneric)=TradeName ;" Array("LINK TRADE TO GENERIC",TradeName)=TMGGeneric ;" Answers -- PASS BY REFERENCE, an array linking display number to IENS. ;" Array should be the one created by ShowEList ;" Answer(count)=DrugIEN^GenericDrugName^TradeName ;" Answer(count)=DrugIEN^GenericDrugName^TradeName ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to process. ;" Format as follows. ;" List(Entry number)="" ;" List(Entry number)="" ;" ByTradeName -- OPTIONAL, if value=1, then values are shown by TradeName ;" ShowBoth -- OPTIONAL, if value=1 then trade name and generic names both shown. ;" Cancelled -- OPTIONAL, PASS BY REFERENCE, will be set to 1 if user cancelled. ;" FromECode -- OPTIONAL, if value=1, then code is handled as if called from the 'empty' ;" code modules (ie HandleEmptyClasses). Default=0 ;" Classes -- PASS BY REFERENCE -- An array holding classes. ;"Results: none set FromECode=$get(FromECode,0) set Cancelled=1 ;"default to cancellation new Results write "Searching for guesses...",$char(10) do GGuessList(.Array,.Answers,.List,.Results) ;" Results(Entry Number,"NAME",VASimilarDrugName,vapIEN)=ClassIEN^ClassCode^ClassName_vapIEN ;" Results(Entry Number,"NAME",VASimilarDrugName,vapIEN)=ClassIEN^ClassCode^ClassName_vapIEN ;" Results(Entry Number,"CLASS",ClassIEN,vapIEN)=ClassIEN^ClassCode^ClassName_vapIEN ;" Results(Entry Number,"CLASS",ClassIEN,vapIEN)=ClassIEN^ClassCode^ClassName_vapIEN ;" Results("ALL CLASSES",ClassIEN)=ClassIEN_"^"_ClassCode_"^"_ClassName ;" Results("ALL CLASSES",ClassIEN,matchName,vapIEN)="" new showExamples set showExamples=1 DEGL0 write !,"GUESSES of class for these drugs: ",! do Disp2List(.Answers,.List,.ByTradeName,.ShowBoth) new subAnswers new someShown set someShown=0 new count set count=0 new classIEN set classIEN="" for set classIEN=+$order(Results("ALL CLASSES",classIEN)) quit:(classIEN'>0) do . set count=count+1 . new node set node=$get(Results("ALL CLASSES",classIEN)) . write " ",count,". CLASS: ",$piece(node,"^",3),! . set someShown=1 . set subAnswers(count)=node . new matchName set matchName="" . new temp set temp=0 . for set matchName=$order(Results("ALL CLASSES",classIEN,matchName)) quit:(matchName="")!(temp>5) do . . new vapIEN set vapIEN="" . . for set vapIEN=+$order(Results("ALL CLASSES",classIEN,matchName,vapIEN)) quit:(vapIEN'>0)!(temp>5) do . . . if showExamples=0 quit . . . write " e.g. ",matchName," (",vapIEN,")",! . . . set temp=temp+1 if someShown=0 do goto DEGDone . write " -- (None Suggestions found) -- ",!! . new temp read "Press ENTER to continue.",temp,! new input,UsrClassIEN,className new defInput set defInput="^" if count=1 set defInput=1 new fixing DEGL1 set fixing=0 write "[Enter F to fix (change) the class of a drug listed above.]",! write "[Enter E to toggle Examples ON/OFF]",! write "Enter number of CLASS to select (^ to abort): "_defInput_"// " read input:$get(DTIME,3600),! if input="" set input=defInput set input=$$UP^XLFSTR(input) if input="^" goto DEGDone if input="E" do goto DEGL0 . set showExamples='showExamples if input="F" do goto:(input="^") DEGL1 . set fixing=1 . write !,"Enter number of CLASS containing erroneously classified drug (^ to abort): "_defInput_"// " . read input:$get(DTIME,3600) write ! . if input="" set input=defInput set UsrClassIEN=+$get(subAnswers(input)) if UsrClassIEN'>0 goto DEGL1 if fixing=1 do goto DEGL0 . do FixBadClass(.Results,UsrClassIEN,.Classes) set className=$piece($get(subAnswers(input)),"^",3) write !! if $$VerifyWrite(className,.Answers,.List,ByTradeName,ShowBoth)=0 goto DEGDone do WriteClass(UsrClassIEN,.Array,.Answers,.List,FromECode) set Cancelled=0 ;"set success here. DEGDone quit FixBadClass(GuessArray,UsrClassIEN,Classes) ;"Purpose: If guessing reveals that an existing drug has been misclassified, then ;" this function will allow correction of that drug (50.68 entry) ;"Input: GuessArray -- PASS BY REFERENCE. Format: ;" GuessArray(Entry Number,"NAME",VASimilarDrugName)=ClassIEN^ClassCode^ClassName^vapIEN ;" GuessArray(Entry Number,"CLASS",ClassIEN)=ClassIEN^ClassCode^ClassName ;" GuessArray("ALL CLASSES",classIEN)=classIEN_"^"_classCode_"^"_className ;" GuessArray("ALL CLASSES",classIEN,matchName)=vapIEN ;" GuessArray(Entry Number,"NAME",VASimilarDrugName,vapIEN)=ClassIEN^ClassCode^ClassName_vapIEN ;" GuessArray(Entry Number,"CLASS",ClassIEN,vapIEN)=ClassIEN^ClassCode^ClassName_vapIEN ;" GuessArray("ALL CLASSES",ClassIEN)=ClassIEN_"^"_ClassCode_"^"_ClassName ;" GuessArray("ALL CLASSES",ClassIEN,matchName,vapIEN)="" ;" UsrClassIEN -- The class containing the incorrectly classified drug ;" Classes -- PASS BY REFERENCE. An array holding classes. if $get(UsrClassIEN)="" goto FBCDone new className set className=$piece($get(GuessArray("ALL CLASSES",UsrClassIEN)),"^",3) new Menu,UsrSlct new menuNum set menuNum=0 new matchName set matchName="" new lastMatchName,lastvapIEN new AllArray,IENArray,vapIEN set Menu(0)="Pick Which Drug does NOT belong in class: "_className for set matchName=$order(GuessArray("ALL CLASSES",UsrClassIEN,matchName)) quit:(matchName="") do . set vapIEN="" . for set vapIEN=$order(GuessArray("ALL CLASSES",UsrClassIEN,matchName,vapIEN)) quit:(vapIEN="") do . . set menuNum=menuNum+1 . . set Menu(menuNum)=matchName_" (#"_vapIEN_")"_$char(9)_"@^"_vapIEN_"^"_matchName . . set AllArray(vapIEN)=matchName . . set AllArray("NAME",matchName,vapIEN)="" . . set lastMatchName=matchName,lastvapIEN=vapIEN if menuNum>1 do . set menuNum=menuNum+1 . set Menu(menuNum)="ALL of the above drugs"_$char(9)_"ALL" . if menuNum'>3 quit . set menuNum=menuNum+1 . set Menu(menuNum)="OR you may enter #-#, or #,#,#-#,# etc."_$char(9)_"#" FBCMC1 if menuNum>1 do . write ! set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^") ;"@^vapIEN^matchName else do . set UsrSlct="@^"_lastvapIEN_"^"_lastMatchName if UsrSlct="ALL" do . merge IENArray=AllArray else if +UsrSlct>0 do . new EntryList,Entry . if $$MkMultList^TMGMISC(UsrSlct,.EntryList)>0 do . . set Entry="" . . for set Entry=$order(EntryList(Entry)) quit:(Entry="") do . . . new vapIEN,vapName,s . . . set s=$piece(Menu(Entry),$char(9),2) . . . if s="" quit . . . set vapIEN=$piece(s,"^",2),vapName=$piece(s,"^",3) . . . set IENArray(vapIEN)=vapName . . . set IENArray("NAME",vapIEN)="" else if $piece(UsrSlct,"^",1)="@" do . set IENArray($piece(UsrSlct,"^",2))=$piece(UsrSlct,"^",3) . set IENArray("NAME",$piece(UsrSlct,"^",3),$piece(UsrSlct,"^",2))="" else if UsrSlct="^" goto FBCDone else if UsrSlct=0 set UsrSlct="" else if UsrSlct="??" do goto FBCDone . write !,"For some reason, IEN of selected drug couldn't be found. Sorry.",! else if menuNum>1 goto FBCMC1 else goto FBCDone write "Now pick CORRECT drug class for the chosen drug(s)",! do PressToCont^TMGUSRIF new newClassIEN set newClassIEN=$$SelectClass(.Classes,0) if newClassIEN=0 goto FBCDone ;"new className set className=$$GET1^DIQ(50.605,newClassIEN,1) ;"write "Set CLASS for VA PRODUCT entry: "_$piece(UsrSlct,"^",2),! ;"write "to be: ",className,"?" ;"new % set %=1 ;"do YN^DICN write ! ;"if %=-1 goto FBCDone new vapName set vapName="" for set vapName=$order(IENArray("NAME",vapName)) quit:(vapName="") do . new entryNum set entryNum="" . ;" GuessArray(Entry Number,"NAME",VASimilarDrugName,vapIEN)=ClassIEN^ClassCode^ClassName_vapIEN . for set entryNum=$order(GuessArray(entryNum)) quit:(+entryNum'>0) do . . set vapIEN="" . . for set vapIEN=$order(GuessArray(entryNum,"NAME",vapName,vapIEN)) quit:(vapIEN="") do . . . new s set s=$get(GuessArray(entryNum,"NAME",vapName,vapIEN)) . . . if s="" quit . . . new classIEN set classIEN=+s . . . if classIEN=newClassIEN quit ;"already at correct class . . . set IENArray(vapIEN)=vapName set vapIEN="" for set vapIEN=$order(IENArray(vapIEN)) quit:(+vapIEN'>0) do . new TMGFDA,TMGMSG . set TMGFDA(50.68,vapIEN_",",15)=newClassIEN ;"className . do FILE^DIE("I","TMGFDA","TMGMSG") . do ShowIfDIERR^TMGDEBUG(.TMGMSG) . kill GuessArray("ALL CLASSES",UsrClassIEN,$get(IENArray(vapIEN),"xx")) FBCDone quit GGuessList(Array,Answers,List,Results) ;"Purpose: To gather a guessing list of possible classes for each entry in List ;"Input: Array -- PASS BY REFERENCE, array holding data, As created by Gather Classes ;" Array("GENERIC NAME",VA GENERIC Name,DrugIEN)="" ;" Array("TRADE NAME",TradeName,DrugIEN)="" ;" Array("LINK GENERIC TO TRADE",TMGGeneric)=TradeName ;" Array("LINK TRADE TO GENERIC",TradeName)=TMGGeneric ;" Answers -- PASS BY REFERENCE, an array linking display number to IENS. ;" Array should be the one created by ShowEList ;" Answer(count)=DrugIEN^GenericDrugName^TradeName ;" Answer(count)=DrugIEN^GenericDrugName^TradeName ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to process. ;" Format as follows. ;" List(Entry number)="" ;" List(Entry number)="" ;" Results -- PASS BY REFERENCE -- and OUT PARAMETER to receive results, as follows: ;" Results(Entry Number,"NAME",VASimilarDrugName,vapIEN)=ClassIEN^ClassCode^ClassName_vapIEN ;" Results(Entry Number,"NAME",VASimilarDrugName,vapIEN)=ClassIEN^ClassCode^ClassName_vapIEN ;" Results(Entry Number,"CLASS",ClassIEN,vapIEN)=ClassIEN^ClassCode^ClassName_vapIEN ;" Results(Entry Number,"CLASS",ClassIEN,vapIEN)=ClassIEN^ClassCode^ClassName_vapIEN ;" Results("ALL CLASSES",ClassIEN)=ClassIEN_"^"_ClassCode_"^"_ClassName ;" Results("ALL CLASSES",ClassIEN,matchName,vapIEN)="" ;"Results: none new Guesses,GenericName,TradeName new i set i=$order(List("")) if i'="" for do quit:(i="") . set GenericName=$piece($get(Answers(i)),"^",2) . set TradeName=$piece($get(Answers(i)),"^",3) . set i=$order(List(i)) . if $data(Guesses("TRY",TradeName))>0 quit . set Guesses("TRY",TradeName)=1 . new name . new j,p,done set done=0 . new X,TMGARRAY,TMGMSG . for j=$length(GenericName,"/"):-1:1 do . . set name=$piece(GenericName,"/",j) . . for p=$length(name," "):-1:1 do quit:(done=1) . . . new TMGSRCH set TMGSRCH=$piece(name," ",1,p) . . . do FIND^DIC(50.68,"","","",TMGSRCH,"*","","","","TMGARRAY","TMGMSG") . . . if +$get(TMGARRAY("DILIST",0))>0 do . . . . merge Guesses("POS MATCH",GenericName,TMGSRCH,"NAME")=TMGARRAY("DILIST",1) . . . . merge Guesses("POS MATCH",GenericName,TMGSRCH,"IEN")=TMGARRAY("DILIST",2) . . . . set done=1 kill Guesses("TRY") ;"temporary use of those items already searched. ;"Now convert matching IENs into drug classes. set GenericName="" for set GenericName=$order(Guesses("POS MATCH",GenericName)) quit:(GenericName="") do . new namePart set namePart="" . for set namePart=$order(Guesses("POS MATCH",GenericName,namePart)) quit:(namePart="") do . . new j set j=0 . . for set j=$order(Guesses("POS MATCH",GenericName,namePart,"IEN",j)) quit:(j'>0) do . . . new vapIEN set vapIEN=+$get(Guesses("POS MATCH",GenericName,namePart,"IEN",j)) . . . if vapIEN>0 do . . . . new classIEN,matchName . . . . set classIEN=+$$GET1^DIQ(50.68,vapIEN,15,"I") . . . . set matchName=$$GET1^DIQ(50.68,vapIEN,.01) ;"was 5 (print name) . . . . if (classIEN'>0)!(matchName="") quit . . . . set Guesses("POS MATCH",GenericName,"CLASS",matchName,classIEN,vapIEN)="" ;"Now compose results set i="" for set i=$order(List(i)) quit:(i="") do . set GenericName=$piece($get(Answers(i)),"^",2) . set TradeName=$piece($get(Answers(i)),"^",3) . new matchName set matchName="" . for set matchName=$order(Guesses("POS MATCH",GenericName,"CLASS",matchName)) quit:(matchName="") do . . new classIEN set classIEN="" . . for set classIEN=+$order(Guesses("POS MATCH",GenericName,"CLASS",matchName,classIEN)) quit:(classIEN'>0) do . . . new classCode,className . . . set classCode=$$GET1^DIQ(50.605,classIEN,.01) . . . set className=$$GET1^DIQ(50.605,classIEN,1) . . . new vapIEN set vapIEN="" . . . for set vapIEN=+$order(Guesses("POS MATCH",GenericName,"CLASS",matchName,classIEN,vapIEN)) quit:(vapIEN'>0) do . . . . set Results(i,"NAME",matchName,vapIEN)=classIEN_"^"_classCode_"^"_className_"^"_vapIEN . . . . set Results(i,"CLASS",classIEN,vapIEN)=classIEN_"^"_classCode_"^"_className_"^"_vapIEN . . . . set Results("ALL CLASSES",classIEN)=classIEN_"^"_classCode_"^"_className . . . . set Results("ALL CLASSES",classIEN,matchName,vapIEN)="" quit AutoEClassification(Array) ;"Purpose: To attempt to automatically classify drugs that have not potential match ;"Input: -- Array PASS BY REFERENCE, an OUT PARAMETER. Prior entries are NOT killed. ;"Output: Array will be filled as follows: ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode ;" Array(DrugIEN,"?")="" ;" Array("?",DrugIEN)="" ;"Results: none new tempArray new Classes new Answers write "Gathering drugs with no CLASS information and no existing match...",! new CompactMode set CompactMode=0 ;" (list display mode: 1=compact, 0=verb new ShowBoth set ShowBoth=0 new ByTrade set ByTrade=1 do GatherEmpties(.tempArray) ;" Array("GENERIC NAME",VA GENERIC Name,DrugIEN)="" ;" Array("TRADE NAME",TradeName,DrugIEN)="" ;" Array("LINK GENERIC TO TRADE",TMGGeneric)=TradeName ;" Array("LINK TRADE TO GENERIC",TradeName)=TMGGeneric do GetClasses(.Classes) do KillIntro(.Classes) do ShowEList(.tempArray,.Answers,CompactMode,ByTrade,ShowBoth) ;" Answer(count)=DrugIEN^GenericDrugName^TradeName ;" Answer(count)=DrugIEN^GenericDrugName^TradeName write !,"Now scanning unclassified drugs for possible CLASS matches...",! new TMGTOTAL set TMGTOTAL=$$ListCt^TMGMISC("Answers") new TMGCUR new StartTime set StartTime=$H new ProgressFn set ProgressFn="if TMGCUR#10=1 do ProgressBar^TMGUSRIF(TMGCUR,""Progress"",0,TMGTOTAL,,StartTime)" new abort set abort=0 new i set i=$order(Answers("")) if i'="" for do quit:(i="")!abort . if $$KeyPressed^TMGUSRIF()=27 do quit:abort=1 . . new % set %=2 . . write !,"Abort" do YN^DICN write ! . . if %=1 set abort=1 . new List set List(i)="" . new class set class=$$Guess1(.Array,.Answers,.List) . if +class>0 do . . new ClassName,ClassCode,ClassIEN,TMGTradeName,DrugIEN . . set ClassName=$piece(class,"^",3) . . set ClassCode=$piece(class,"^",2) . . set ClassIEN=$piece(class,"^",1) . . set TMGTradeName=$piece(Answers(i),"^",3) . . set DrugIEN=$piece(Answers(i),"^",1) . . set Array("POSS MATCH",ClassName,TMGTradeName,DrugIEN)=ClassIEN_"^"_ClassCode . . do CUU^TMGTERM(2) write ! . . new s set s="Found: "_TMGTradeName_" --> "_ClassName . . set s=s_" " . . write $extract(s,1,79),! . if $get(ProgressFn)'="" do . . set TMGCUR=i . . new $etrap set $etrap="w ""??Progress function -- error trapped??"",!" . . xecute ProgressFn . set i=$order(Answers(i)) quit Guess1(Array,Answers,List) ;"Purpose: To return a guessed class, IF there is only one possible guess. ;"Input: Array -- PASS BY REFERENCE, array holding data, As created by Gather Classes ;" Array("GENERIC NAME",VA GENERIC Name,DrugIEN)="" ;" Array("TRADE NAME",TradeName,DrugIEN)="" ;" Array("LINK GENERIC TO TRADE",TMGGeneric)=TradeName ;" Array("LINK TRADE TO GENERIC",TradeName)=TMGGeneric ;" Answers -- PASS BY REFERENCE, an array linking display number to IENS. ;" Array should be the one created by ShowEList ;" Answer(count)=DrugIEN^GenericDrugName^TradeName ;" Answer(count)=DrugIEN^GenericDrugName^TradeName ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to process. ;" Format as follows. ;" List(Entry number)="" ;" List(Entry number)="" ;"Results: If only 1 matching class found, then classIEN^classCode^className, otherwise 0 new ResultArray new result set result=0 do GGuessList(.Array,.Answers,.List,.ResultArray) ;" Results(Entry Number,"NAME",VASimilarDrugName)=ClassIEN^ClassCode^ClassName ;" Results(Entry Number,"CLASS",ClassIEN)=ClassIEN^ClassCode^ClassName ;" Results("ALL CLASSES",classIEN)=classIEN_"^"_classCode_"^"_className ;" Results("ALL CLASSES",classIEN,matchName)="" ;" Results(Entry Number,"NAME",VASimilarDrugName,vapIEN)=ClassIEN^ClassCode^ClassName_vapIEN ;" Results(Entry Number,"CLASS",ClassIEN,vapIEN)=ClassIEN^ClassCode^ClassName_vapIEN ;" Results("ALL CLASSES",ClassIEN)=ClassIEN_"^"_ClassCode_"^"_ClassName ;" Results("ALL CLASSES",ClassIEN,matchName,vapIEN)="" if $$ListCt^TMGMISC($name(ResultArray("ALL CLASSES")))=1 do . new classIEN . set classIEN=$order(ResultArray("ALL CLASSES","")) . set result=$get(ResultArray("ALL CLASSES",classIEN)) quit result DoSetTools(Array,Answers,List,EntryS,ByTradeName,ShowBoth) ;"Purpose: to provide tools for managing SETS to be worked on (List) ;"Input: Array -- PASS BY REFERENCE, array holding data, As created by Gather Classes ;" Array("GENERIC NAME",VA GENERIC Name,DrugIEN)="" ;" Array("TRADE NAME",TradeName,DrugIEN)="" ;" Array("LINK GENERIC TO TRADE",TMGGeneric)=TradeName ;" Array("LINK TRADE TO GENERIC",TradeName)=TMGGeneric ;" Answers -- PASS BY REFERENCE, an array linking display number to IENS. ;" Array should be the one created by ShowEList ;" Answer(count)=DrugIEN^GenericDrugName^TradeName ;" Answer(count)=DrugIEN^GenericDrugName^TradeName ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to modify. ;" EntryS -- PASS BY REFERENCE -- a string representing the current set. ;" ByTradeName -- OPTIONAL, PASS BY REFERENCE, if value=1, then values are shown by TradeName ;" ShowBoth -- OPTIONAL, PASS BY REFERENCE, if value=1 then trade name and generic names both shown. set ByTradeName=$get(ByTradeName,0) set ShowBoth=$get(ShowBoth,0) new input,done set EntryS=$get(EntryS) set done=0 for do quit:(done=1) . write !,"Tools to modify SET of entry numbers",! . write "------------------------------------",! . write "A=Add, X=Remove from SET, C=Clear, D=Display, S=Search, ^ Return",! . write "T=set TradeName ",$select((ByTrade=1):"OFF",1:"ON"),", B=set Both names ",$select((ShowBoth=1):"OFF",1:"ON"),! . read "Enter Option: ^// ",input:$get(DTIME,3600),! . if input="" set input="^" . set input=$$UP^XLFSTR(input) . if input="^" write ! set done=1 quit . if (input="?") do . . ;"do ShowInstructions() . . set input="R" . else if input="A" do . . read "Enter number(s) to ADD to list: ",input:$get(DTIME,3600),! . . if $$MkMultList^TMGMISC(input,.List) set EntryS=EntryS_" & "_input . else if input="X" do . . new tempList . . read "Enter number(s) to REMOVE to list: ",input:$get(DTIME,3600),! . . if $$MkMultList^TMGMISC(input,.tempList)=0 quit . . new i set i=$order(tempList("")) . . if i'="" for do quit:(i="") . . . kill List(i) . . . set i=$order(tempList(i)) . . set EntryS=EntryS_" - "_input . else if input="C" do . . kill List set EntryS="" . . set input="D" . else if input="S" do . . if $$MkSrchList(.Answers,.List,.ByTradeName,.ShowBoth)=1 do . . . if EntryS'="" set EntryS=EntryS_" & " . . . set EntryS=EntryS_" (SEARCH)" . . set input="D" . else if input="T" do . . set ByTrade='ByTrade . . set input="D" . else if input="B" do . . set ShowBoth='ShowBoth . . set input="D" . if input="D" do . . write !,"Here is the current SET: ",EntryS,! . . do Disp2List(.Answers,.List,.ByTradeName,.ShowBoth) . . ;"new temp read " -- Press [ENTER] to Continue --",temp:$get(DTIME,3600),! quit MkSrchList(Answers,List,ByTradeName,ShowBoth) ;"Purpose: to search through Answers for string ;"Input: Answers -- PASS BY REFERENCE, an array linking display number to IENS. ;" Array should be the one created by ShowEList ;" Answer(count)=DrugIEN^GenericDrugName^TradeName ;" Answer(count)=DrugIEN^GenericDrugName^TradeName ;" List -- PASS BY REFERENCE -- an OUT PARAMETER, to hold array of entries (user input values) ;" prior entries are NOT KILLED ;" ByTradeName -- OPTIONAL, if value=1, then values are shown by TradeName ;" ShowBoth -- OPTIONAL, if value=1 then trade name and generic names both shown. ;"Results: 1=some added to list, 0=none added to list. set ByTradeName=$get(ByTradeName,0) set ShowBoth=$get(ShowBoth,0) new result set result=0 new input write !,"Search in ",$select((ByTradeName=1):"TRADE NAME",1:"GENRIC NAME") if ShowBoth write " and ",$select((ByTradeName=0):"TRADE NAME",1:"GENRIC NAME") read !,"Entry text to SEARCH for in entries: ^// ",input:$get(DTIME,3600),! if input="" set input="^" set input=$$UP^XLFSTR(input) if input="^" goto MSLDone new i set i=$order(Answers("")) if i'="" for do quit:(i="") . new TradeName,GenericName . set GenericName=$$UP^XLFSTR($piece($get(Answers(i)),"^",2)) . set TradeName=$$UP^XLFSTR($piece($get(Answers(i)),"^",3)) . if (ByTradeName=1)!(ShowBoth=1) do . . if TradeName[input set List(i)="",result=1 . if (ByTradeName=0)!(ShowBoth=1) do . . if GenericName[input set List(i)="",result=1 . set i=$order(Answers(i)) MSLDone quit result ;"================================================================= SelEdClasses ;"Purpose: Allow user to browse classes with selector ;"Input: none ;"Results: none new Options,IEN set Options("FIELDS",1)=".09:1^VA DRUG CLASS^24" set Options("FIELDS",1,"LOOKUP FN")="$$SECLookup^TMGNDF3A()" set Options("FIELDS",2)=".05^TRADENAME^24" set Options("FIELDS",2,"NO EDIT")=1 ;"i.e. show for browsing, but don't allow edit set Options("FIELDS",3)=".07^GENERIC NAME^24" set Options("FIELDS",3,"NO EDIT")=1 ;"i.e. show for browsing, but don't allow edit set Options("FIELDS","MAX NUM")=3 set Options("FILE")="22706.9^TMG FDA IMPORT COMPILED" ;"Get all records with SKIP THIS RECORD = 0 (KEEP) write "Finding records not marked to be skipped...",! do GetFldValue^TMGSELED(22706.9,6,0,$name(Options("IEN LIST"))) SEC1 if $$SELED^TMGSELED(.Options)'=2 goto SECDone if $$GetIENs^TMGSELED(.Options)=0 goto SECDone goto SEC1 SECDone quit Ed1Classes ;"Purpose: Allow user to browse classes with selector ;"Input: none ;"Results: none new Options,IEN set Options("FIELDS",1)=".09:1^VA DRUG CLASS^24" set Options("FIELDS",1,"LOOKUP FN")="$$SECLookup^TMGNDF3A()" set Options("FIELDS",2)=".05^TRADENAME^24" set Options("FIELDS",2,"NO EDIT")=1 ;"i.e. show for browsing, but don't allow edit set Options("FIELDS",3)=".07^GENERIC NAME^24" set Options("FIELDS",3,"NO EDIT")=1 ;"i.e. show for browsing, but don't allow edit set Options("FIELDS","MAX NUM")=3 set Options("FILE")="22706.9^TMG FDA IMPORT COMPILED" ;"Get all records with SKIP THIS RECORD = 0 (KEEP) new DIC,X,Y set DIC=22706.9 set DIC(0)="MAEQ" do ^DIC write ! if +Y'>0 goto E1Done set Options("IEN LIST",+Y)="" E1 if $$SELED^TMGSELED(.Options)'=2 goto E1Done if $$GetIENs^TMGSELED(.Options)=0 goto E1Done goto E1 E1Done quit SECLookup() ;"Purpose: A custom call-back function that the selector will use ;" for looking up class of a given record or list of records. ;"Input: None (because this is to be used only for ONE field) ;"Results: Returns IEN for Class, or 0 if not found or abort. new Classes,UsrClassIEN do GetClasses(.Classes) do KillIntro(.Classes) set UsrClassIEN=$$SelectClass(.Classes) quit UsrClassIEN