TMGNDF2B ;TMG/kst/FDA Import: Ensure DRUG INGREDIENTS ;03/25/06 ;;1.0;TMG-LIB;**1**;11/21/06 ;" FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS ;" -- FILLING DRUG INGREDIENTS FILE WITH NEW VALUES ;"Kevin Toppenberg MD ;"GNU General Public License (GPL) applies ;"11-21-2006 ;"======================================================================= ;" API -- Public Functions. ;"======================================================================= ;"Menu -- Provide menu to entry points of main routines ;"======================================================================= ;"CheckIngredients -- To cycle through ingredients and ensure that there is an extry in the ;" DRUG INGREDIENTS file. This has to be an interactive process. ;"======================================================================= ;" Private Functions. ;"======================================================================= ;"ShowInstructions ;"LookupRx(ingredient) ;"ShowMatches(Array,max,Label) ;"AddRangeMatch(ScanArray,Label,StartN,EndN) ;"AddMatch(ScanArray,Label,number) ;"ULRangeMatch(ScanArray,StartN,EndN) ;"ULMatch(ScanArray,number) ;"AddOneIngredient(Name) ;"FindIgdMatch(Name,Interactive) ;"DoAddIgd(Name,ParentIEN) ;"======================================================================= ;"======================================================================= Menu ;"Purpose: Provide menu to entry points of main routines new Menu,UsrSlct set Menu(0)="Pick Option for Checking Import Ingredients (0C)" set Menu(1)="Check for NEW ingredients to ADD."_$char(9)_"CheckIngredients" 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="CheckIngredients" do CheckIngredients goto MC1 if UsrSlct="Prev" goto Menu^TMGNDF0B ;"quit can occur from there... if UsrSlct="Next" goto Menu^TMGNDF1A ;"quit can occur from there... goto MC1 MCDone quit CheckIngredients ;"Purpose: To cycle through ingredients and ensure that there is an extry in the ;" DRUG INGREDIENTS file. This has to be an interactive process. ;"Input: none ;"Results: none ;"Note: if record in 22706.9 (TMG FDA IMPORT COMPILED) for a given listing ;" has been marked for SKIPPING, or DONE ADDING, then listing will be skipped. new Answers,index,ingredient write "Collecting list of INGREDIENTS that need to be added to database...",! new count set count=1 new MissingArray new Itr,IEN new abort set abort=0 set index=$$ItrInit^TMGITR(22706.4,.Itr) do PrepProgress^TMGITR(.Itr,20,0,"index") if index'="" for do quit:(+$$ItrNext^TMGITR(.Itr,.index)'>0)!abort . if $$UserAborted^TMGUSRIF set abort=1 quit . new listingIEN set listingIEN=+$piece($get(^TMG(22706.4,index,0)),"^",1) ;"Not required... . if (listingIEN>0),$piece($get(^TMG(22706.9,listingIEN,1)),"^",4)=1 quit ;"1=SKIP . set ingredient=$piece($get(^TMG(22706.4,index,0)),"^",4) . set ingredient=$extract(ingredient,1,64) . if $get(Answers(ingredient))="" do . . set Y=$$LookupRx(ingredient) . . if +Y'>0 set MissingArray(ingredient)="" . . if +Y>0 set Answers(ingredient)=+Y do ProgressDone^TMGITR(.Itr) do HandleMissing(.MissingArray) quit Check1(IEN) ;"finish later ;"Purpose: to scan the ingredients for 1 entry in 22706.9 ;"Input: IEN -- IEN in 22706.9 new ingredient new MissingArray new fdaIEN,Y set fdaIEN=+$piece($get(^TMG(22706.9,IEN,0)),"^",1) set ingredient=$piece($get(^TMG(22706.4,fdaIEN,0)),"^",4) set ingredient=$extract(ingredient,1,64) set Y=$$LookupRx(ingredient) if +Y'>0 do . set MissingArray(ingredient)="" . do HandleMissing(.MissingArray) quit HandleMissing(MissingArray) ;"Purpose: To handle and process the array of missing ingredients ;"Input: MissingArray(ingredient)="" ;" MissingArray(ingredient)="" ;"Result: none new max set max=$$ListCt^TMGMISC("MissingArray") write !,"Found ",max," missing INGREDIENTS.",! new ScanArray,count write "Summarizing list...",! set count=1 set ingredient="" new startTime set startTime=$H new abort set abort=0 for set ingredient=$order(MissingArray(ingredient)) quit:(ingredient="")!abort do . if count#10=1 do ProgressBar^TMGUSRIF(count,ingredient,1,max,80,startTime) . if ingredient["ALLERGENIC EXTRACT" do . . set Y=$$DoAddIgd(ingredient,0) . else do . . set Y=$$FindIgdMatch(ingredient,0) . . if +Y>0 set ScanArray("MATCHED",count,ingredient)=Y . . else set ScanArray("UNMATCHED",count,ingredient)="" . set count=count+1 . set abort=$$UserAborted^TMGUSRIF write ! new done set done=0 new input set input="R" new displaySet set displaySet="MATCHED" for do quit:(done=1) . if input="R" do . . write !!,"Now pick which potential matches are ",displaySet,! . . do ShowMatches(.ScanArray,max,displaySet) . write " (R to refresh, C custom handle, UL to UnLink)",! . write " (# or #-#, ^ to continue, ? for instructions, " . if displaySet="MATCHED" write "U show Unmatched)",! . else write "M show Matched)",! . write "Enter number(s) to ACCEPT (or codes listed above): ?//" . read input,! . if input="" set input="?" . set input=$$UP^XLFSTR(input) . if input="^" set done=1 . if (input="U") do . . set displaySet="UNMATCHED" . . set input="R" . if (input="M") do . . set displaySet="MATCHED" . . set input="R" . if (input="A") do . . set displaySet="MATCHED" . . set input="R" . if (input="?") do . . do ShowInstructions . . set input="R" . if +input=input do . . do AddMatch(.ScanArray,displaySet,+input) . . set input="R" . if input["-" do . . new N1,N2 . . set N1=$piece(input,"-",1) . . set N2=$piece(input,"-",2) . . do AddRangeMatch(.ScanArray,displaySet,N1,N2) . . set input="R" . if input="C" do . . read "Enter number for Custom Handling: ",input,! . . if +input'=input quit . . set ingredient=$order(ScanArray(displaySet,+input,"")) . . set Y=$$AddOneIngredient(ingredient) . . if +Y>0 kill ScanArray(displaySet,+input,ingredient) . . set input="R" . if input="UL" do . . read "Enter number to Unlink (# or #-#): ",input,! . . if +input=input do . . . do ULMatch(.ScanArray,input) . . else if input["-" do . . . new N1,N2 . . . set N1=$piece(input,"-",1) . . . set N2=$piece(input,"-",2) . . . do ULRangeMatch(.ScanArray,N1,N2) . . set input="R" quit ShowInstructions write !!,"INSTRUCTIONS:",! write "----------------------------------------------------------------------------",! write "Before adding any medicines or drugs into the database, the underlying",! write "INGREDIENTS must be entered. Each drug will have one or more ingredients",! write "that will be linked to these new entries. DRUG INTERACTIONS are based on",! write "ingredients rather than on the name of the drug itself.",!! write "Often, the name supplied is more specific than an entry already in the",! write "database. For example:",! write " CAFFEINE <-- already in database",! write " CAFFEINE CITRATE <-- new import",! write "Clearly, these two compounds are related, and it could be said that:",! write "CAFFEINE is the PRIMARY INGREDIENT in CAFFEINE CITRATE, or as will be",! write "seen shortly, summarized like this:",! write "CAFFEINE <-- CAFFEINE CITRATE",!! do PressToCont^TMGUSRIF write "What follows next will be a listing of all the ingredients to be added into",! write "the database. The computer will have made a best guess at linking the new",! write "entries to parent compounds (i.e. PRIMARY INGREDIENTS). But not all of these",! write "guesses will be correct. IT IS YOUR JOB TO SCREEN THESE.",!! write "If a linkage or matching is correct, just type in its number to ACCEPT it.",! write "If a linkage or matching is NOT correct, it shoud be UNLINKED.",! write "If you feel you can search for a better match, attempt a CUSTOM handling.",!! write "When you are done with accepting or rejecting the computers matches, you should",! write "then process all the UNMATCHED entries, by selecting 'U' to show UNMATCHED.",! write "These very likely may all be accepted at once by entering a range number (e.g.",! write "1-1000).",!! write "When you have completed processing all the matched and unmatched entries, enter",! write "^ to continue.",! new temp read "Press to continue.",temp:$get(DTIME,3600),! quit LookupRx(ingredient) ;"Purpose: To look up ingredient in the DRUG INGREDIENTS file ;"Input: ingredient -- the name of the ingredient to lookup ;"Result: -1 if not fount, or 1234^ingredientname format new DIC,X,Y set DIC=50.416 set DIC(0)="M" new TMGROOT,TMGMSG set Y=-1 do FIND^DIC(50.416,,".01E","M",ingredient,"*",,,,"TMGROOT","TMGMSG") if +$get(TMGROOT("DILIST",0))>0 do . set Y=$get(TMGROOT("DILIST",2,1),-1)_"^"_$get(TMGROOT("DILIST",1,1)) . if +Y'>0 do . . set X=ingredient . . do ^DIC quit Y ShowMatches(Array,max,Label) new count,ingredient,value new someShown set someShown=0 for count=1:1:max do . set ingredient=$order(ScanArray(Label,count,"")) . if ingredient="" quit . set someShown=1 . set value=$get(ScanArray(Label,count,ingredient)) . write " ",count,". " . if +value>0 write $piece(value,"^",2) . else write "(no parent ingredient)" . write " <--child of-- ",ingredient,! if someShown=0 do . write " --- (List is Empty) ---",! quit AddRangeMatch(ScanArray,Label,StartN,EndN) new num for num=StartN:1:EndN do . do AddMatch(.ScanArray,Label,num) quit AddMatch(ScanArray,Label,number) new ingredient,Y set ingredient=$order(ScanArray(Label,number,"")) set Y=$get(ScanArray(Label,number,ingredient)) if (ingredient'="") do . set Y=$$DoAddIgd(ingredient,Y) . kill ScanArray(Label,number,ingredient) quit ULRangeMatch(ScanArray,StartN,EndN) new num for num=StartN:1:EndN do . do ULMatch(.ScanArray,num) quit ULMatch(ScanArray,number) new ingredient,Y set ingredient=$order(ScanArray("MATCHED",number,"")) if (ingredient'="") set ScanArray("UNMATCHED",number,ingredient)="" kill ScanArray("MATCHED",number) quit AddOneIngredient(Name) ;"Purpose: To add ingredient name to the DRUG INGREDIENTS -- will try to find a parent ;" ingredient interactively ;"Input: Name -- the name of the ingredient to be added. ;"Output: DRUG INGREDIENTS file will have records added. ;"Results: Will return record number (IEN) of newly added record, or 0 if error ;"Note: This function assumes that the ingredient does not already exist in the file. new result set result=0 if $get(Name)="" goto AOIDone new Y set Y=$$FindIgdMatch(Name,1) new % set %=1 ;"1=YES if +Y'>0 do . write "A parent primary ingredient was not found for ",! . write " ",Name," <-- UNMATCHED COMPOUND (Add Now)",! . write "Add Now? " . do YN^DICN ;"returns result in % . write ! if %=1 do . set result=$$DoAddIgd(Name,Y) AOIDone quit result FindIgdMatch(Name,Interactive) ;"Purpose: To find a match for Name from DRUG INGREDIENTS ;"Input: Name -- the name of the ingredient to be added. ;" Interactive -- OPTIONAL, default=1 ;" if 1 then user is asked question, ;" if 0 then best guess is returned. ;"Results: -1 if not found ;" or 1234^Name if $get(Name)="" goto FMDone set Interactive=$get(Interactive,1) if Interactive do . write "------------------------------------------",! . write "Looking for a parent, PRIMARY INGREDIENT for: ",! . write " ",Name," <-- UNMATCHED COMPOUND",! new DIC,X,Y,% set DIC=50.416 set DIC(0)="M" new parent set parent=$$Substitute^TMGSTUTL(Name,", "," ") set parent=$translate(parent,","," ") for do quit:(+Y>0)!(parent="") . new temp . set temp=$$ParseLast^TMGMISC(parent,.parent," ") ;"cut last word off from drug name . set X=$$Trim^TMGSTUTL(parent) . do ^DIC . if Interactive'=1 quit . if +Y>0 do . . ;"At this point, we either have possible match (+Y>0), or no match (parent="") . . write " '"_$piece(Y,"^",2)_"' <-- ?? MATCH ??",! . . write "Use this as the PRIMARY INGREDIENT? " . . set %=1 ;"1=YES . . do YN^DICN ;"returns result in % . . write ! . . if %'=1 set Y=0 . else do . . if X'="" write " ",X," <-- (not found).",! if (+Y'>0)&(Interactive) do . write " No match found. Let's try a generic lookup..." . set DIC(0)="AEQM" . set DIC("A")=" LOOKUP: Enter PRIMARY INGREDIENT (or ^ to continue) ^// " . do ^DIC . write ! FMDone quit Y DoAddIgd(Name,ParentIEN) ;"Purpose: to do the actual addition to the DRUG INGREDIENTS file ;"Input: Name -- the string of the drug name ;" ParentIEN -- a value as returned from DIC (i.e. 1234^Name) ;"Results: IEN of added value, or 0 if not added. new result set result=0 new TMGFDA,TMGIEN,TMGMSG new PrimIngred set PrimIngred=$get(ParentIEN) set TMGFDA(50.416,"+1,",.01)=$extract(Name,1,64) if +PrimIngred>0 set TMGFDA(50.416,"+1,",2)=$piece(PrimIngred,"^",1) new temp set temp=$get(DUZ(0)) set DUZ(0)="^" ;"needed for file permission new tempLaygo merge tempLaygo=^DD(50.416,.01,"LAYGO") kill ^DD(50.416,.01,"LAYGO") ;"temporarily remove lock-down do UPDATE^DIE("","TMGFDA","TMGIEN","TMGMSG") set DUZ(0)=temp merge ^DD(50.416,.01,"LAYGO")=tempLaygo if $data(TMGMSG)&(+$get(Quiet)=0) do . new PriorErrorFound . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) set result=$get(TMGIEN(1)) quit result