TMGNDF1A ;TMG/kst/FDA Import: Compile FDA files into import file ;03/25/06 ;;1.0;TMG-LIB;**1**;11/21/06 ;"FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS ;"Kevin Toppenberg MD ;"GNU General Public License (GPL) applies ;"11-21-2006 ;"======================================================================= ;" API -- Public Functions. ;"======================================================================= ;"Menu ;"======================================================================= ;"Compile -- collect relevent data from the TMG FDA * files and put into one record ;"GetpVAPIndex() -- return a pointer to an index of the VAProduct file ;"ReCompOne(IEN22706d9) ;"======================================================================= ;" Private Functions. ;"======================================================================= ;"CompileOne(IEN,Quiet,pIndex,ExclArray,OnlyIfNew) ;"$$MakeCompRec(IEN,Array,Quiet) ;"StuffCompRec(IEN,Array,Quiet,ExclArray,Option) ;"FillGenericName(IEN) ;"MakeGenericName(IEN) ;"GetVADrugInfo(IEN,Array) ;"$$GetDrugInfo(IEN,Array,pIndex,noLink) ;"GetSingleRec(File,GRef,IEN,Array) ;"GetMultRec(File,GRef,IEN,Array) ;"LinkToVAProd(Array,Results) ;"Link2VAProd(Array,Results,pIndex) ;"CheckLink(IEN,Array,Results) ;"CheckNDCLink(IEN,Array,Results) ;"IndexVAProd(pArray) ;"GetIndexList(Ingredient,pIndex,pArray) ;"FixGenerics ;"ScanFor(Name,Array) ;"FindSimNames(Name,Array) ;"======================================================================= ;"======================================================================= Menu ;"Purpose: To give an interactive menu new Menu,UsrSlct set Menu(0)="Pick Option for Compiling FDA Imported Data (1A)" set Menu(1)="Compile/Refresh ALL FDA data into IMPORT file"_$char(9)_"CompileAll" set Menu(2)="Compile/Refresh JUST NEW FDA data into IMPORT file"_$char(9)_"CompileNew" set Menu(3)="Compile/Refresh ONE chosen FDA entry into IMPORT file"_$char(9)_"CompileChosen" set Menu(4)="Read instructions"_$char(9)_"Instructions" set Menu("P")="Prev Stage"_$char(9)_"Prev" set Menu("N")="Next Stage"_$char(9)_"Next" CD1 write # set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^") if UsrSlct="^" goto CDDone if UsrSlct=0 set UsrSlct="" if UsrSlct="Prev" goto Menu^TMGNDF0C ;"quit can occur from there... if UsrSlct="Next" goto Menu^TMGNDF1D ;"quit can occur from there... if UsrSlct="CompileAll" do Compile(0) goto CD1 if UsrSlct="CompileNew" do Compile(2) goto CD1 if UsrSlct="CompileChosen" do Compile(1) goto CD1 if UsrSlct="Instructions" do Instructions goto CD1 goto CDDone CDDone quit ;"======================================================================= Instructions ;"Purpose: show instructions. write !,! write "COMPILATION",! write "===========",! write "The process of compilation takes the various FDA import",! write "tables and compiles them into a format ready for integration",! write "into VistA. The compiled records will be stored in the custom",! write "file TMG FDA IMPORT COMPILED (22706.9).",!,! write "In a subsequent step, you will be asked about excluding certain",! write "drugs from import into VistA. Your choices will be stored in these",! write "compiled records. The point being that overwriting file 22706.9",! write "would lead to a substantial amount of work. Thus the code is",! write "designed to integrate the new download data with prior data.",! write "If prior data is found then the user will be prompted: ",! write "'Import ONLY NEW drugs?' It is recommended that this be answered",! write "with 'YES'.",! write ! do PressToCont^TMGUSRIF quit Compile(Option) ;"Purpose: To collect relevent data from the TMG FDA * files and put into one record ;"Input: Option: OPTIONAL. Default=0. ;" if 0, all records are added ;" If 1, then only ONE record (user chosed) will be compiled. ;" If 2, then only records that are NEW will ;" be added. Existing records in 22706.9 will not be affected ;" If 3, then only record(s) supplied will be compiled. ;" Option(IEN)="" ;" Option(IEN)="" ;" If Option("FIX CHAIN")=1 <--- changes will be propigate forward ;" to file 50, POI, OI, OQV etc. ;"Output: The file 22706.9 (TMG FDA IMPORT COMPILED) has records added. ;"Result: none new pIndex set pIndex=$$GetpVAPIndex() new abort set abort=0 set Option=+$get(Option) set OnlyIfNew=(Option=2) new CompOption set CompOption=OnlyIfNew merge CompOption("FIX CHAIN")=Option("FIX CHAIN") new % set %=1 new ExclArray if $data(^TMG(22706.9,"VAP1"))>0 do ;"a test for a prior run . if (Option=1)!(Option=2)!(Option=3) quit . write "Prior import processing detected.",! . if Option=0 write "Import ONLY NEW drugs ('YES' Recommended)" do YN^DICN write ! . if %=-1 quit . if %=1 set OnlyIfNew=1 quit . write "Choose fields in import file to NOT to OVER WRITE" do YN^DICN write ! . if %=1 do GetExclFields(.ExclArray) if %=-1 goto CADone write "Compiling FDA data into a unified file, for later import.",! new Itr,IEN if Option=1 do . new X,Y,DIC . set DIC=22706.5,DIC(0)="MAEQ" . set DIC("A")="Select FDA drug for import: " . do ^DIC write ! . if +Y'>-1 quit . do CompileOne(+Y,0,pIndex,.ExclArray,.CompOption) . new killthis if Option=3 do . set IEN="" . for set IEN=$order(Option(IEN)) quit:(IEN="")!abort do . . if $$UserAborted^TMGUSRIF set abort=1 quit . . do CompileOne(IEN,0,pIndex,.ExclArray,.CompOption) . . new killthis else do . set IEN=$$ItrInit^TMGITR(22706.5,.Itr) . do PrepProgress^TMGITR(.Itr,20,0,"IEN") . if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!(abort=1) . . if $$UserAborted^TMGUSRIF set abort=1 quit . . do CompileOne(IEN,0,pIndex,.ExclArray,.CompOption) . . new killthis CADone write !,"Done.",! do PressToCont^TMGUSRIF quit ReCompOne(IEN22706d9,Option) ;"Purpose: To recompile a given record in file 22706.9 ;"Input: IEN -- IEN from 22706.9 ;" OPTION -- Optional. Option("FIX CHAIN")=1 <--- changes will be propigate forward ;" to file DRUG, POI, OI, OQV etc. ;"Results: none new fdaIEN set fdaIEN=+$piece($get(^TMG(22706.9,IEN22706d9,0)),"^",1) new pIndex set pIndex=$$GetpVAPIndex() set Option=2 ;"2-> ask for overwrites. do CompileOne(fdaIEN,0,pIndex,,.Option) quit CompileOne(IEN,Quiet,pIndex,ExclArray,Option) ;"Purpose: To collect relevent data from the TMG FDA * files, or one entry, and put into one record ;"Input: IEN -- the IEN from file 22706.5 (TMG FDA LISTING) that should be added. ;" Quiet: OPTIONAL (default=1), if 0, then Fileman error messages are displayed. ;" pIndex -- OPTIONAL -- the NAME OF index (as created by IndexVAProd), for faster processing ;" ExclArray --OPTIONAL -- an array with fields to NOT OVERWRITE preexisting fields in. Format: ;" ExclArray(FieldNum)=FieldName <-- data in 22706.9, FieldNum will not be overwritten. ;" ExclArray(FieldNum)=FieldName <-- data in 22706.9, FieldNum will not be overwritten. ;" Option : OPTIONAL. Default=0. PASS BY REFERECE *if* SUBNODES DEFINED ;" 1 -> only records that are NEW will be added. Existing records in 22706.9 will not be affected ;" 2 -> User is prompted for overwrites ;" Option("FIX CHAIN")=1 <--- changes will be propigate forward ;" to file 50, POI, OI, OQV etc. ;"Output: The file 22706.9 (TMG FDA IMPORT COMPILED) may have data/records added. ;"Result: none new Array,result set Quiet=$get(Quiet,1) new destIEN set Option=+$get(Option) new OnlyIfNew set OnlyIfNew=(Option=1) new stuffOption set stuffOption="" if Option=2 set stuffOption("ASK OVERWRITE")=1 if +$get(IEN)'>0 goto C1Done if $$GetDrugInfo(IEN,.Array,.pIndex)=0 goto C1Done ;"returns 0 for error set destIEN=$$FindPriorRec(.Array) if (destIEN>0)&(OnlyIfNew=1) goto C1Done ;"Skip preexisting, don't update, per flag if destIEN'>0 set destIEN=$$MakeCompRec(IEN,.Array,Quiet) if destIEN'>0 goto C1Done if $$StuffCompRec(destIEN,.Array,.Quiet,.ExclArray,.stuffOption)=1 goto C1Done ;"returns 1 for error do FillGenericName(destIEN) ;"Set link between COMPILED field in 22706.5 and record in 22706.9 new TMGFDA,TMGMSG,PriorErrorFound set TMGFDA(22706.5,IEN_",",8)=destIEN do FILE^DIE("S","TMGFDA","TMGMSG") do ShowIfDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) if $get(Option("FIX CHAIN"))=1 do . do Fix1Name^TMGNDF1D(IEN) . ;"consider if checking for 1 new ROUTE is need in TMGNDF1F . ;"consider if checking for 1 new FORM is need in TMGNDF2A . do Make1Alt^TMGNDF2G(IEN) . do Check1^TMGNDF2H(IEN) . do Refresh1^TMGNDF3C(IEN,.Option) ;"further chaining to occur from this fn. .;"NOTE: I also need to go through modules and add code to handle DELETIONS . ;" (esp DRUG-->POI etc.) C1Done quit FindPriorRec(Array) ;"Purpose: To find an entry in file 22706.9 (TMG FDA IMPORT COMPILED) that ;" matches data in Array, meaning that the data has been previously ;" added. ;" Match criteria: ;"Input: Array: PASS BY REEFRENCE. The drug info array, as created by GetDrugInfo() ;"Result: Returns the IEN from 22706.9, or 0 if no prior match found. new result set result=0 new NDC12 set NDC12=$get(Array("NDC","12DIGIT")) if NDC12>0 set result=$order(^TMG(22706.9,"NDC12",NDC12,"")) quit result MakeCompRec(IEN,Array,Quiet) ;"Purpose: To create one entry in file 22706.9 (TMG FDA IMPORT COMPILED) ;" entry will be essentially empty, to be filled later by StuffCompRec ;" Array: PASS BY REFERENCE. The drug info array, as created by GetDrugInfo() ;" Quiet: OPTIONAL (default=1), if 0, then Fileman error messages are displayed. ;"Input: IEN ;" Array ;" Quiet ;"Output: The file 22706.9 (TMG FDA IMPORT COMPILED) has one records added or modified. ;"Result: IEN of new record, or 0 if error ;"Note: any pre-existing data is removed from record. new TMGFDA,IENS,TMGIEN,TMGMSG new result set result=0 ;"default to failure if +$get(IEN)'>0 goto MCRD set Quiet=$get(Quiet,1) set IENS="+1," set TMGFDA(22706.9,IENS,.01)=IEN do UPDATE^DIE("S","TMGFDA","TMGIEN","TMGMSG") ;"create new record if $data(TMGMSG) do . if Quiet=1 quit . new PriorErrorFound . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) else set result=+$get(TMGIEN(1)) MCRD quit result GetExclFields(ExclArray) ;"Purpose: to determine if there are fields that should not be overwritten ;" during stuffing of records ;"Input: ExclArray -- PASS BY REFERENCE, AN OUT PARAMETER. FORMAT: ;" ExclArray(FieldNum)=FieldName ;" Any preexisting entries will be KILLED kill ExclArray new DIC,X,Y set DIC="^DD(22706.9," set DIC(0)="AEQM" set DIC("S")="IF (Y=.05)!(Y=.05)!(Y=1)!(Y=2)!(Y=3)!(Y=3.4)!(Y=4)!(Y=5)!(Y=7)" set DIC("A")="Pick field to NOT OVERWRITE (^ when done): " GEF1 do ^DIC if Y=-1 goto GEF2 set ExclArray(+Y)=$piece(Y,"^",2) goto GEF1 GEF2 if $data(ExclArray)=0 goto GEFDone write !!,"Will NOT OVERWRITE any preexisting data in these fields:",! new i set i="" for set i=$order(ExclArray(i)) quit:(i="") do . write " ",ExclArray(i)," (",i,")",! new % set %=1 write "OK" do YN^DICN write ! if %=1 goto GEFDone kill ExclArray set %=2 write "Pick again" do YN^DICN write ! if %=1 goto GEF1 GEFDone quit StuffCompRec(IEN,Array,Quiet,ExclArray,Option) ;"Purpose: To fill in data for one entry in file 22706.9 (TMG FDA IMPORT COMPILED) ;"Input: IEN: The IEN of the new record for data to be stuffed into (i.e. IEN22706d9) ;" Array: PASS BY REFERENCE. The drug info array, as created by GetDrugInfo() ;" Quiet: OPTIONAL (default=1), if 0, then Fileman error messages are displayed. ;" ExclArray --OPTIONAL -- an array with fields to NOT OVERWRITE preexisting fields in. Format: ;" ExclArray(FieldNum)=FieldName <-- data in 22706.9, FieldNum will not be overwritten. ;" Option -- OPTIONAL. PASS BY REFERENCE ;" Option("ASK OVERWRITE")=1 --> ask user if overwrites are OK. ;" Option("FIX CHAIN")=1 <--- changes will be propigate forward ;" to file 50, POI, OI, OQV etc. ;"Output: The file 22706.9 (TMG FDA IMPORT COMPILED) has one records added or modified. ;"Result: 0=OK, 1=fatal error encountered ;"Note: any pre-existing data is removed from record. (<--??) new TMGFDA,IENS,TMGIEN,TMGMSG,newIENS new result set result=0 new dataAdded set dataAdded=0 new askOverwrite set askOverwrite=($get(Option("ASK OVERWRITE"))=1) set Quiet=$get(Quiet,1) new map set map(.05)=$name(tradeName) set map(1)=$name(Array("STRENGTH")) set map(2)=$name(Array("UNIT")) set map(3)=$name(Array("ROUTE",1,"NAME")) set map(3.4)=$name(Array("DOSE",1,"DOSAGE NAME")) set map(4)=$name(Array("NDC")) set map(5)=$name(Array("NDC","12DIGIT")) set map(7)=$name(codeOTC) new codeOTC set codeOTC=$get(Array("RX OR OTC")) if codeOTC["PRESCRIPTION" set codeOTC="R" else if codeOTC["OTC" set codeOTC="O" else set codeOTC="" new tradeName set tradeName=$get(Array("TRADENAME")) if $length(tradeName)>64 set tradeName=$extract(tradeName,1,61)_"..." set IENS=IEN_"," new oldData new field set field="" for set field=$order(map(field)) quit:(field="") do . new pVar,value . set pVar=$get(map(field)) . set value=$get(@pVar) . if value="" quit . set oldData(field)=$$GET1^DIQ(22706.9,IENS,field) . if ($data(ExclArray(field))'=0)&(oldData(field)'="") quit . set TMGFDA(22706.9,IENS,field)=value new untrimFDA merge untrimFDA=TMGFDA set newIENS=$$TrimFDA^TMGDBAPI(.TMGFDA) ;"remove entries for data already present. if $data(TMGFDA)=0 goto SCR1 new abort set abort=0 if askOverwrite do . new field set field="" . for set field=$order(TMGFDA(22706.9,IENS,field)) quit:(field="") do . . write field,": '",$get(oldData(field)),"' --> '",$get(TMGFDA(22706.9,IENS,field)),"'",! . write !,"Stuff this data into file 22706.9, record #",IEN,"? " . new % set %=2 do YN^DICN write ! . if %=1 quit . set abort=1 if abort=1 goto MCRDone do FILE^DIE("ES","TMGFDA","TMGMSG") ;" Fill existing record if $data(TMGMSG) do goto MCRDone . if Quiet=1 quit . new PriorErrorFound . write !,"StuffCompRec^TMGNDF1A",! . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) . set result=1 else set dataAdded=1 if $get(Option("FIX CHAIN"))=1 do . new opt . set opt("FIX CHAIN")=1 . set opt("FIX CHAIN","IEN22706d9")=IEN ;"used later in chain . ;"pass signal to fix chain forward . do Refresh1^TMGNDF3C(IEN,.opt) ;" no results SCR1 new i,MaxCount,subfile kill TMGFDA,TMGIEN set MaxCount=$get(Array("FILE 50.68 IEN","COUNT")) set subfile=22706.914 for i=1:1:MaxCount do quit:(abort=1) . set IENS="+"_i_","_IEN_"," . new addIEN set addIEN=$get(Array("FILE 50.68 IEN",i)) . if addIEN="" quit ;"This occasionally happens... . set TMGFDA(subfile,IENS,.01)=addIEN . ;"------ . set newIENS=$$TrimFDA^TMGDBAPI(.TMGFDA) ;"remove entries for data already present. . if $data(TMGFDA)'>0 quit . if askOverwrite do quit:(abort=1) . . new field set field="" . . for set field=$order(TMGFDA(subfile,IENS,field)) quit:(field="") do . . . write field,": ",$$GET1^DIQ(subfile,IENS,field)," --> ",$get(TMGFDA(subfile,IENS,field)),! . . write !,"Stuff this data into subfile ",subfile,", record #",IENS,"? " . . new % set %=2 do YN^DICN write ! . . if %=1 quit . . set abort=1 . if newIENS["+" do . . do UPDATE^DIE("S","TMGFDA","TMGIEN","TMGMSG") . else do . . new tempFDA merge tempFDA(subfile,newIENS)=TMGFDA(subfile,IENS) . . kill TMGFDA merge TMGFDA=tempFDA . . do FILE^DIE("KS","TMGFDA","TMGMSG") . if $data(TMGMSG) do . . if Quiet=1 quit . . new PriorErrorFound . . write !,"SCR1^StuffCompRec^TMGNDF1A",! . . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) . else set dataAdded=1 if abort=1 goto MCRDone SCR2 kill TMGFDA,TMGIEN set MaxCount=$get(Array("FILE 50.68 IEN","POSS MATCH","COUNT")) set subfile=22706.915 for i=1:1:MaxCount do quit:(abort=1) . set IENS="+"_i_","_IEN_"," . new addIEN set addIEN=$get(Array("FILE 50.68 IEN","POSS MATCH",i)) . if addIEN="" quit ;"This occasionally happens... . set TMGFDA(subfile,IENS,.01)=addIEN . set newIENS=$$TrimFDA^TMGDBAPI(.TMGFDA) ;"remove entries for data already present. . if $data(TMGFDA)'>0 quit . if askOverwrite do quit:(abort=1) . . new field set field="" . . for set field=$order(TMGFDA(subfile,IENS,field)) quit:(field="") do . . . write field,": '",$$GET1^DIQ(subfile,IENS,field),"' --> ",$get(TMGFDA(subfile,IENS,field)),! . . write !,"Stuff this data into subfile ",subfile,", record #",IENS,"? " . . new % set %=2 do YN^DICN write ! . . if %=1 quit . . set abort=1 . if newIENS["+" do . . do UPDATE^DIE("S","TMGFDA","TMGIEN","TMGMSG") . else do . . new tempFDA merge tempFDA(subfile,newIENS)=TMGFDA(subfile,IENS) . . kill TMGFDA merge TMGFDA=tempFDA . . do FILE^DIE("SK","TMGFDA","TMGMSG") . if $data(TMGMSG) do . . if Quiet=1 quit . . new PriorErrorFound . . write !,"SCR1^StuffCompRec^TMGNDF1A",! . . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) . else set dataAdded=1 if abort=1 goto MCRDone SCR3 kill TMGFDA,TMGIEN set MaxCount=$get(Array("FORMULATION","COUNT")) set subfile=22706.916 for i=1:1:MaxCount do . set IENS="+"_i_","_IEN_"," . set TMGFDA(subfile,IENS,.01)=i . set TMGFDA(subfile,IENS,2)=$get(Array("FORMULATION",i,"INGREDIENT NAME","FILE 50.416 IEN")) . set TMGFDA(subfile,IENS,3)=$get(Array("FORMULATION",i,"STRENGTH")) . set TMGFDA(subfile,IENS,5)=$get(Array("FORMULATION",i,"UNIT","FILE 50.607 IEN")) ;"should be a ptr . ;"set TMGFDA(subfile,IENS,5)=$get(Array("FORMULATION",2,"UNIT")) ;"should be a ptr . ;"---------------------- . set newIENS=$$TrimFDA^TMGDBAPI(.TMGFDA) ;"remove entries for data already present. . if $data(TMGFDA)=0 quit . if askOverwrite do quit:(abort=1) . . new field set field="" . . for set field=$order(TMGFDA(subfile,IENS,field)) quit:(field="") do . . . write field,": '",$$GET1^DIQ(subfile,IENS,field),"' --> ",$get(TMGFDA(subfile,IENS,field)),! . . write !,"Stuff this data into subfile ",subfile,", record #",IENS,"? " . . new % set %=2 do YN^DICN write ! . . if %=1 quit . . set abort=1 . if newIENS["+" do . . do UPDATE^DIE("S","TMGFDA","TMGIEN","TMGMSG") . else do . . new tempFDA merge tempFDA(subfile,newIENS)=TMGFDA(subfile,IENS) . . kill TMGFDA merge TMGFDA=tempFDA . . do FILE^DIE("SK","TMGFDA","TMGMSG") . if $data(TMGMSG) do . . if Quiet=1 quit . . new PriorErrorFound . . write !,"SCR3^StuffCompRec^TMGNDF1A",! . . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) . else set dataAdded=1 if abort=1 goto MCRDone SCR4 ;"Add a comment if dataAdded=0 goto MCRDone kill TMGFDA new %DT,X,Y set %DT="T",X="NOW" do ^%DT ;"get current time set IENS="+1,"_IEN_"," set TMGFDA(22706.9001,IENS,.01)="UPDATE VIA AUTOMATIC IMPORT COMPILE" set TMGFDA(22706.9001,IENS,1)=Y do UPDATE^DIE("S","TMGFDA","TMGIEN","TMGMSG") if $data(TMGMSG) do . if Quiet=1 quit . new PriorErrorFound . write !,"SCR4^StuffCompRec^TMGNDF1A",! . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) MCRDone if abort=1 set result=1 quit result FillGenericName(IEN) ;"Purpose: To create an entry for the GENERIC NAME (field .07) in TMG FDA IMPORT (22706.9) ;"Input: IEN -- the IEN in 22706.9 to alter ;"Output: the record specified by IEN will be altered (if ingredients are known) ;"Result: None new name set name=$$MakeGenericName(IEN) if $data(^TMG(22706.9,IEN,0))>0 do . new TMGFDA,TMGMSG . set TMGFDA(22706.9,IEN_",",.07)=name . do FILE^DIE("SK","TMGFDA","TMGMSG") . if $data(TMGMSG) do . . if Quiet=1 quit . . new PriorErrorFound . . write !,"FillGenericName^TMGNDF1A",! . . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) . ;"set $piece(^TMG(22706.9,IEN,0),"^",6)=name ;"There is no index on this field, so direct write OK quit MakeGenericName(IEN) ;"Purpose: To create a GENERIC NAME string ;"Input: IEN -- the IEN in 22706.9 to use ;"Result: returns a string for the generic name. new Ingredients new i new result set result="" set i=$order(^TMG(22706.9,IEN,4,0)) if i'="" for do quit:(+i'>0) . new IgdIEN,IgdName . set IgdIEN=+$piece($get(^TMG(22706.9,IEN,4,i,0)),"^",3) ;"get field#2, INGREDIENT (ptr to 50.416) . if IgdIEN>0 do . . set IgdName=$$GET1^DIQ(50.416,IgdIEN,.01) . . set IgdName=$$Substitute^TMGSTUTL(IgdName,"HYDROCHLORIDE","") ;"This is what the VA does... . . new temp set temp=IgdName . . set IgdName=$piece(IgdName,",",1) ;"I will also trim off anything after a comma. . . if $length(IgdName)<5 set IgdName=temp ;"I had problem with: N,N-1 ACETYL.... --> 'N' . . set IgdName=$translate(IgdName,"/","\") ;convert '/' --> '\' ('/' used later to concate ingredients) . . set IgdName=$$Trim^TMGSTUTL(IgdName) . . if IgdName'="" set Ingredients(IgdName)="" ;"will sort alphabetically . set i=$order(^TMG(22706.9,IEN,4,i)) set i=$order(Ingredients("")) if i'="" for do quit:(i="") . if result'="" set result=result_"/" . set result=result_i . set i=$order(Ingredients(i)) set result=$extract(result,1,64) quit result GetVADrugInfo(IEN,Array) ;"Purpose: To collect info from VA Product file into an array similar (but limited) to ;" that returned from GetDrugInfo ;"Input: IEN -- the IEN from file 50.68 (VA PRODUCT) kill Array new DIC,X,Y set Array("TRADENAME")=$$GET1^DIQ(50.68,IEN,.01) set Array("STRENGTH")=$$GET1^DIQ(50.68,IEN,2) set Array("UNIT")=$$GET1^DIQ(50.68,IEN,3) set DIC=50.67 set DIC(0)="M" set X=Array("TRADENAME") do ^DIC set Array("NDC")=$$GET1^DIQ(50.67,+Y_",",1) ;"set Array("NDC 12DIGIT")=ndc (see format below) new i,count set count=0 set i=$order(^PSNDF(50.68,IEN,2,0)) if +i>0 for do quit:(+i'>0) . new node set node=$get(^PSNDF(50.68,IEN,2,i,0)) . set count=count+1 . set Array("FORMULATION","COUNT")=count . set Array("FORMULATION",count,"INGREDIENT NAME","FILE 50.416 IEN")=$piece(node,"^",1) . set Array("FORMULATION",count,"INGREDIENT NAME")=$$GET1^DIQ(50.416,$piece(node,"^",1),.01) . set Array("FORMULATION",count,"STRENGTH")=$piece(node,"^",2) . set Array("FORMULATION",count,"UNIT","FILE 50.607 IEN")=$piece(node,"^",3) . set Array("FORMULATION",count,"UNIT")=$$GET1^DIQ(50.607,$piece(node,"^",3),.01) . set i=$order(^PSNDF(50.68,IEN,2,i)) quit GetDrugInfo(IEN,Array,pIndex,noLink) ;"Purpose: To collect all info about a drug into one array ;"Input: IEN -- the IEN from TMG FDA LISTING file ;" Array -- an OUT parameter. See format below ;" pIndex -- OPTIONAL -- the NAME OF index (as created by IndexVAProd), for faster processing ;" noLink -- OPTIONAL -- default=0. If 1, then linkage to prior VA drugs is NOT attempted. ;"Output: Array will be filled with info as above ;" Array('FILE 50.68 IEN',1)=IEN ;" Array('FILE 50.68 IEN','COUNT') ;" Array('LABEL CODE') ;" Array('PRODUCT CODE') ;" Array('STRENGTH') ;" Array('UNIT') ;" Array('RX OR OTC') ;" Array('FIRM','NAME') ;" Array('FIRM','LABEL CODE') ;" Array('FIRM','ADDRESS HEADER') ;" Array('FIRM','STREET') ;" Array('FIRM','PO BOX') ;" Array('FIRM','FOREIGN ADDRESS') ;" Array('FIRM','CITY') ;" Array('FIRM','STATE') ;" Array('FIRM','ZIP') ;" Array('FIRM','PROVINCE') ;" Array('FIRM','COUNTRY') ;" Array('TRADENAME') ;" Array('PACKAGE',1,'CODE') ;" Array('PACKAGE',1,'SIZE') ;" Array('PACKAGE',1,'TYPE') ;" Array('FORMULATION','COUNT')=1 ;" Array('FORMULATION',1,'STRENGTH') ;" Array('FORMULATION',1,'UNIT') ;" Array('FORMULATION',1,'UNIT','FILE 50.607 IEN') ;note may contain -1 if match not found ;" Array('FORMULATION',1,'INGREDIENT NAME') ;" Array('FORMULATION',1,'INGREDIENT NAME','FILE 50.416 IEN) ;note may contain -1 if match not found ;" Array('APPLICATION') ;" Array('PRODUCT NUMBER') ;" Array('ROUTE',1,'CODE' ;" Array('ROUTE',1,'NAME') ;" Array('DOSE',1,'DOSE FORM') ;" Array('DOSE',1,'DO SAGE NAME') ;" Array('NDC')=ndc (see format below) ;" Array('NDC','12DIGIT')=ndc (see format below) ;" Array('FILE 50.68 IEN','COUNT')=1 ;" Array('FILE 50.68 IEN',1)=1234 ;" Array('FILE 50.68 IEN','POSS MATCH','COUNT')=1 ;" Array('FILE 50.68 IEN','POSS MATCH',1)=2345 ;"result: 0 if error found, 1 otherwise (i.e. is OKToContinue) ;"Note the NDC (national drug code) is comprised as follows: ;"It is a 10 digit number comprised of three segments ;" 1st 4-5 digits - producer/packager <--> field#1 (LABEL CODE) in TMG FDA LISTING ;" next 3-4 digits -- the product code <--> field#2 (PRODUCT CODE) in TMG FDA LISTING ;" next 1-2 digits -- package code, specifying the package size <--> field#1 (CODE) in TMG FDA PACKAGES ;" the grouping will be: 4-4-2, or 5-3-2, or 5-4-1 ;" Example Array("NDC")="000002-0351-02" ;" Example Array("NDC","12DIGIT")="000002035102" new TMGARRAY,TMGMSG new PriorErrorFound,i new IENS set IENS=IEN_"," kill Array new result set result=1 do GETS^DIQ(22706.5,IENS,"*","R","TMGARRAY","TMGMSG") if $data(TMGMSG) do . if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("TMGMSG") . if $data(TMGMSG("DIERR"))'=0 do quit . . ;"do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) . . set result=0 if result=0 goto GDIDone merge Array=TMGARRAY(22706.5,IENS) ;"Now look for entries in TMG FDA APPLICATION (22706.1) do GetSingleRec(22706.1,"^TMG(22706.1,""B"",",IEN,.Array) set Array("STRENGTH")=$translate(Array("STRENGTH"),",","") ;"remove ',''s from numbers ;"Now look for entries in TMG FDA DOSAGE FORM (22706.2) do GetMultRec(22706.2,"^TMG(22706.2,""B"",",IEN,.Array,"DOSE") ;"Now look for entries in TMG FDA FIRMS (22706.3) do GetSingleRec(22706.3,"^TMG(22706.3,""B"",",IEN,.Array) ;"Now look for entries in TMG FDA FORMULATION (22706.4) do . new tempArray,index . do GetMultRec(22706.4,"^TMG(22706.4,""B"",",IEN,.tempArray,"FORMULATION") . ;"Note: I need instead to screen for duplicates ingredient entries . set index=$order(tempArray("FORMULATION","")) . if +index>0 for do quit:(+index'>0) . . new i2 set i2=index+1 . . new name1,name2 . . set name1=$name(tempArray("FORMULATION",index)) . . for do quit:(+i2'>0) . . . set name2=$name(tempArray("FORMULATION",i2)) . . . set i2=$order(tempArray("FORMULATION",i2)) . . . if $data(@name2)'>0 quit . . . if $$CompArray^TMGMISC(name1,name2) do . . . . kill @name2 . . set index=$order(tempArray("FORMULATION",index)) . ;"Now put cleaned results of tempArray into Array . set index=$order(tempArray("FORMULATION","")) . new count set count=0 . set Array("FORMULATION","COUNT")=0 . if +index>0 for do quit:(+index'>0) . . if $data(tempArray("FORMULATION",index)) do . . . set count=count+1 . . . merge Array("FORMULATION",count)=tempArray("FORMULATION",index) . . . set Array("FORMULATION","COUNT")=count . . set index=$order(tempArray("FORMULATION",index)) ;"Now look for entries in TMG FDA PACKAGES (22706.6) do GetMultRec(22706.6,"^TMG(22706.6,""B"",",IEN,.Array,"PACKAGE") ;"Now look for entries in TMG FDA ROUTES (22706.7) do GetMultRec(22706.7,"^TMG(22706.7,""B"",",IEN,.Array,"ROUTE") if $length($get(Array("ROUTE",1,"NAME")))>16 do . new temp set temp=$$PShortName^TMGSHORT(Array("ROUTE",1,"NAME"),16,1) . if temp="^" quit . set Array("ROUTE",1,"NAME")=temp if $get(Array("FORMULATION","COUNT"),1)=1 do . new strength,str2 . new units,units2 . set strength=Array("STRENGTH") . set str2=$get(Array("FORMULATION",1,"STRENGTH")) . set units=$get(Array("UNIT")) . set units2=$get(Array("FORMULATION",1,"UNIT")) . if (+str2'>0)!(strength'=str2) do . . set Array("FORMULATION",1,"STRENGTH","OLD")=str2 . . set Array("FORMULATION",1,"STRENGTH")=strength . . set Array("FORMULATION",1,"UNIT","OLD")=units2 . . set Array("FORMULATION",1,"UNIT")=units ;"Now search for IEN in 50.68 of all ingredients, and find IEN for units name(s) new i,X,Y,TMGROOT,TMGMSG for i=1:1:Array("FORMULATION","COUNT") do . new DIC . set X=$get(Array("FORMULATION",i,"INGREDIENT NAME")) . if X="" quit . set Y=$$LookupRx^TMGNDF0C(X) . if +Y>0 set Array("FORMULATION",i,"INGREDIENT NAME","FILE 50.416 IEN")=+Y . ;"look up unit name to find IEN in file 50.607 . set DIC(0)="M" . set DIC=50.607 . set X=$get(Array("FORMULATION",i,"UNIT")) . if X="" quit . do ^DIC . if +Y>0 set Array("FORMULATION",i,"UNIT","FILE 50.607 IEN")=+Y ;"Note the NDC (national drug code) is comprised as follows: ;"It is a 10 digit number comprised of three segments ;" 1st 4-5 digits - producer/packager <--> field#1 (LABEL CODE) in TMG FDA LISTING ;" next 3-4 digits -- the product code <--> field#2 (PRODUCT CODE) in TMG FDA LISTING ;" next 1-2 digits -- package code, specifying the package size <--> field#1 (CODE) in TMG FDA PACKAGES ;" the grouping will be: 4-4-2, or 5-3-2, or 5-4-1 set Array("NDC")=$get(Array("LABEL CODE"),"????")_"-" set Array("NDC")=Array("NDC")_$get(Array("PRODUCT CODE"),"????")_"-" set Array("NDC")=Array("NDC")_$get(Array("PACKAGE",1,"CODE"),"??") set Array("NDC")=$$NewNDC^TMGNDF2E(Array("NDC")) ;"added 5/28/06 //kt set Array("NDC","12DIGIT")=$translate(Array("NDC"),"-","") do ;"ensure length=12 . new num set num=Array("NDC","12DIGIT") . new l set l=$length(num) . if l>12 set num=$extract(num,l-11,99) . if l<12 set num=$extract("00000000000",1,12-l)_num ;"pad with leading 0's . set Array("NDC","12DIGIT")=num if $get(noLink)=1 goto GDIDone ;"Skip linkages if requested. ;"Now try to link to pre-existing VistA entries ;"Note--2/12/07 -- I am changing the significance of this link to 50.68 ;" I found that many drugs had multiple links to entries in 50.68, i.e. ;" there was a one-to-many relationship. And while it is helpful to ;" have a connection to *similar* drugs (i.e. to obtain missing ;" drug class, ingredients etc.), there is also value from having ;" a link to an EXACT match in 50.68 -- i.e. a one-to-one relationship. ;" I have therefore renamed the field in TMG FDA IMPORT COMPILED where ;" this information is stored to: VA PRODUCT SIMILAR MATCHES, and for ;" less certain matches, renamed it to: VA PRODUCT POSSIBLE MATCHES. ;" I have introduced a new field: 'NDC --> VA PRODUCT LINK' that ;" will hold a pointer to a record with the exact same NDC (national ;" drug code). This link will be established in a later stage. do . new DIC,X,Y . set DIC=50.67 . set DIC(0)="M" . ;"set X=""""_Array("NDC","12DIGIT")_"""" . set X=Array("NDC","12DIGIT") . do ^DIC . if Y=-1 quit . new tempIEN set tempIEN=$$GET1^DIQ(50.67,+Y_",",5,"I") . new tempResults . ;"do CheckNDCLink(tempIEN,.Array,.tempResults) . ;"if +$get(tempResults("COUNT"))'>0 do quit . ;". set Array("NDC","NOTE")="NDC Conflict found with drug IEN (in 50.68)="_tempIEN . set Array("FILE 50.68 IEN",1)=tempIEN . set Array("FILE 50.68 IEN","COUNT")=1 if +$get(Array("FILE 50.68 IEN","COUNT"))=0 do . new RArray . new temp . if $get(pIndex)'="" do . . set temp=$$Link2VAProd(.Array,.RArray,pIndex) . else do . . set temp=$$LinkToVAProd(.Array,.RArray) . merge Array("FILE 50.68 IEN")=RArray GDIDone quit result GetSingleRec(File,GRef,IEN,Array) ;"Purpose: To get the data from single record, that points to IEN, and put in Array ;"Input: File -- the file NUMBER ;" GRef -- the OPEN FORMAT global reference of B xref (e.g. '^TMG(22706.1,"B",' ) ;" IEN -- The IEN that is pointed to ;" Array -- an out parameter. PASS BY REFERENCE set GRef=GRef_IEN_","""")" set i=$order(@GRef) if +i>0 do . new IENS,TMGARRAY,TMGMSG . set IENS=i_"," . do GETS^DIQ(File,IENS,"*","R","TMGARRAY","TMGMSG") . if $data(TMGMSG) do quit . . if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("TMGMSG") . . if $data(TMGMSG("DIERR"))'=0 do quit . . . ;"do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) . merge Array=TMGARRAY(File,IENS) quit GetMultRec(File,GRef,IEN,Array,Label) ;"Purpose: To get the data from mult records, that point to IEN, and put in Array ;"Input: File -- the file NUMBER ;" GRef -- the OPEN FORMAT global reference of B xref (e.g. '^TMG(22706.1,"B",' ) ;" IEN -- The IEN that is pointed to ;" Array -- an out parameter. PASS BY REFERENCE new count set count=1 new Ref set Ref=GRef_IEN_","""")" set i=$order(@Ref) if +i>0 for do quit:(+i'>0) . new IENS,TMGARRAY,TMGMSG . set IENS=i_"," . do GETS^DIQ(File,IENS,"*","R","TMGARRAY","TMGMSG") . if $data(TMGMSG) do quit . . if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("TMGMSG") . . if $data(TMGMSG("DIERR"))'=0 do quit . . . ;"do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) . kill TMGARRAY(File,IENS,"LISTING") . if Label="ROUTE" kill TMGARRAY(File,IENS,"CODE") . if Label="DOSE" kill TMGARRAY(File,IENS,"DOSE FORM") . merge Array(Label,count)=TMGARRAY(File,IENS) . set Ref=GRef_IEN_",i)" . set i=$order(@Ref) . set count=count+1 quit LinkToVAProd(Array,Results) ;"Purpose: To take a given drug array, and match to an entry in file VA PRODUCT (50.68) ;"Input: Array -- PASS BY REFERENCE. An array holding drug info, as created by GetDrugInfo(IEN,Array) ;" Results -- OPTIONAL, PASS BY REFERENCE, an OUT parameter to receive results array ;" if more than one IEN. e.g. ;" Results("COUNT")=3 ;" Results(1)=IEN ;IEN is from file 50.68 ;" Results(2)=IEN ;IEN is from file 50.68 ;" Results(3)=IEN ;IEN is from file 50.68 ;" Because a full match is sometimes not found (i.e. because minor variance), I ;" will return all close (but not necessarily perfect) matches as: ;" Results("POSS MATCH","COUNT")=IEN ;" Results("POSS MATCH",1)=ien ;"Result: Returns IEN in file 50.68, or 0 if not found, or -2 if multiple results found ;" (in which case all matches will be reported in Results array ;"Note: this function will have to scan through tens of thousands of entries in the main ;" drug files, so response may be slow. new result set result=0 kill Results new lmCount set lmCount=0 ;"Cycle through all records in file 50.68 (VA PRODUCT FILE) (global: ^PSNDF(50.68, ) new IEN set IEN=$order(^PSNDF(50.68,0)) if +IEN>0 for do quit:(IEN'>0) . if ($get(tmgTEST)=1) write IEN,! . do CheckLink(IEN,.Array,.Results) . set IEN=$order(^PSNDF(50.68,IEN)) if $get(Results("COUNT"))=1 do . set result=$order(Results("")) else if +$get(Results("COUNT"))=0 do . set result=0 else if $get(Results("COUNT"))>1 do . set result=-2 quit result Link2VAProd(Array,Results,pIndex) ;"Purpose: To take a given drug array, and match to an entry in file VA PRODUCT (50.68) ;" -- using a faster index method ;"Input: Array -- PASS BY REFERENCE. An array holding drug info, as created by GetDrugInfo(IEN,Array) ;" Results -- OPTIONAL, PASS BY REFERENCE, an OUT parameter to receive results array ;" if more than one IEN. e.g. ;" Results("COUNT")=3 ;" Results(1)=IEN ;IEN is from file 50.68 ;" Results(2)=IEN ;IEN is from file 50.68 ;" Results(3)=IEN ;IEN is from file 50.68 ;" Because a full match is sometimes not found (i.e. because minor variance), I ;" will return all close (but not necessarily perfect) matches as: ;" Results("POSS MATCH","COUNT")=IEN ;" Results("POSS MATCH",1)=ien ;" pIndex -- NAME OF index array to use, as created by IndexVAProd() ;" @pIndex@(IngredientIEN, 50.68 IEN, 50.6814 IEN)="" ;" @pIndex@(IngredientIEN, 50.68 IEN, 50.6814 IEN)="" ;"Result: Returns IEN in file 50.68, or 0 if not found, or -2 if multiple results found ;" (in which case all matches will be reported in Results array ;"Note: this function will have to scan through tens of thousands of entries in the main ;" drug files, so response may be slow. new result set result=0 kill Results new lmCount set lmCount=0 new PossMatch ;"an array to list all IENs in 50.68 containing ONE specified ingredient new IngredList ;"an array to hold IENS of all ingredients for drug info held in Array new NumIngredients new i for i=1:1:$get(Array("FORMULATION","COUNT")) do . new IngredIEN . set IngredIEN=$get(Array("FORMULATION",i,"INGREDIENT NAME","FILE 50.416 IEN")) . set IngredList(IngredIEN)="" . do GetIndexList(IngredIEN,pIndex,$name(PossMatch(IngredIEN))) ;"Example of Output from code above: ;" PossMatch(50,3456)="" ;" PossMatch(50,57698)="" ;" PossMatch(50,993)="" ;" PossMatch(99,3456)="" <-- 3456 has ingredient 99 and 50 ;" PossMatch(99,3876)="" ;" PossMatch(99,9902)="" set NumIngredients=$$ListCt^TMGMISC("PossMatch") ;"Now, add node to array above, with indexes switched. ;" PossMatch("x",3456,50)="" ;" PossMatch("x",3456,99)="" <-- 3456 has ingredient 99 and 50 ;" PossMatch("x",57698,50)="" ;" PossMatch("x",993,50)="" ;" PossMatch("x",3876,99)="" ;" PossMatch("x",9902,99)="" new VAPIEN set IngredIEN=$order(PossMatch("")) if +IngredIEN>0 for do quit:(+IngredIEN'>0) . set VAPIEN=$order(PossMatch(IngredIEN,"")) . if +VAPIEN>0 for do quit:(+VAPIEN'>0) . . set PossMatch("x",VAPIEN,IngredIEN)="" . . set VAPIEN=$order(PossMatch(IngredIEN,VAPIEN)) . set IngredIEN=$order(PossMatch(IngredIEN)) ;"now find those entries containing ALL given ingredients ;" PossMatch("+",3456)="" <--- only 3456 is a possible match set VAPIEN=$order(PossMatch("x","")) if +VAPIEN>0 for do quit:(+VAPIEN'>0) . if $$ListCt^TMGMISC($name(PossMatch("x",VAPIEN)))'0 for do quit:(IEN'>0) . do CheckLink(IEN,.Array,.Results) . set IEN=$order(PossMatch("+",IEN)) if $get(Results("COUNT"))=1 do . set result=$order(Results("")) else if +$get(Results("COUNT"))=0 do . set result=0 else if $get(Results("COUNT"))>1 do . set result=-2 L2VPDone quit result CheckLink(IEN,Array,Results) ;"Purpose: To take a given drug array, and check for match to an entry in file VA PRODUCT (50.68) ;"Input: IEN -- An IEN in file 50.68 to try for a match, seeing if matches info in Array ;" Array -- PASS BY REFERENCE. An array holding drug info, as created by GetDrugInfo(IEN,Array) ;" partial reference below (See GetDrugInfo for full reference) ;" Array('FORMULATION','COUNT')=1 ;" Array('FORMULATION',1,'STRENGTH') ;" Array('FORMULATION',1,'UNIT') ;" Array('FORMULATION',1,'UNIT','FILE 50.607 IEN') ;note may contain -1 if match not found ;" Array('FORMULATION',1,'INGREDIENT NAME') ;" Array('FORMULATION',1,'INGREDIENT NAME','FILE 50.416 IEN) ;note may contain -1 if match not found ;" Results -- OPTIONAL, PASS BY REFERENCE, an OUT parameter to receive results array ;" if more than one IEN. e.g. ;" Results("COUNT")=3 ;" Results(1)=IEN ;IEN is from file 50.68 ;" Results(2)=IEN ;IEN is from file 50.68 ;" Results(3)=IEN ;IEN is from file 50.68 ;" Because a full match is sometimes not found (i.e. because minor variance), I ;" will return all close (but not necessarily perfect) matches as: ;" Results("POSS MATCH","COUNT")=IEN ;" Results("POSS MATCH",1)=ien ;"Result: None (but returns results in Results array) ;"Note: this function will have to scan through tens of thousands of entries in the main ;" drug files, so response may be slow. new result set result=0 new lmCount set lmCount=0 new ingredient,igdIEN new match set match=1 ;"default to true new numIngredients set numIngredients=$get(Array("FORMULATION","COUNT")) if numIngredients=0 set match=0 else for ingredient=1:1 do quit:(+igdIEN'>0)!(match=0) . set igdIEN=$get(Array("FORMULATION",ingredient,"INGREDIENT NAME","FILE 50.416 IEN")) . if +igdIEN'>0 do quit . . if igdIEN="" quit ;"just at end of list of ingredients . . if igdIEN=-1 set match=0 ;"here igdIEN must =-1 (prior ^DIC failed to find match) . new node set node=$get(^PSNDF(50.68,IEN,2,igdIEN,0)) . if node="" do quit . . set match=0 quit ;"no match found . ;"If we get here, we have a match. Now check for matching strength and units . set lmCount=lmCount+1 . set Results("POSS MATCH",lmCount)=IEN . set Results("POSS MATCH","COUNT")=lmCount . set Results("POSS MATCH","INDEX",IEN)=lmCount . new strength set strength=$piece(node,"^",2) . new str2 set str2=$get(Array("FORMULATION",ingredient,"STRENGTH")) . if +strength'=+str2 do quit . . set Results("POSS MATCH",lmCount,"PROBLEM")="dosage STRENGTH mis-match" . . set Results("POSS MATCH",lmCount,"MSG")="Import="_str2_", VistA="_strength . . set match=0 . new units set units=$piece(node,"^",3) . new units2 set units2=$get(Array("FORMULATION",ingredient,"UNIT","FILE 50.607 IEN")) . if units'=units2 do . . set Results("POSS MATCH",lmCount,"PROBLEM")="dosage UNITS mis-match" . . new s . . set s="Import="_$$GET1^DIQ(50.607,units2_",",".01") . . set s=s_", VistA="_$$GET1^DIQ(50.607,units_",",".01") . . set Results("POSS MATCH",lmCount,"MSG")=s . . set match=0 . ;"Now see if VistA drug has more ingredients than import drug. . new IgdCount set IgdCount=0 . new TempIdx set TempIdx=$order(^PSNDF(50.68,IEN,2,0)) . if TempIdx'="" for do quit:(+TempIdx'>0) . . set IgdCount=IgdCount+1 . . set TempIdx=$order(^PSNDF(50.68,IEN,2,TempIdx)) . if IgdCount'=numIngredients do quit . . set Results("POSS MATCH",lmCount,"PROBLEM")="Number of ingredients mismatch" . . set Results("POSS MATCH",lmCount,"MSG")="Import="_numIngredients_", VistA="_IgdCount . . set match=0 if match=1 do . new count set count=$get(Results("COUNT"))+1 . set Results(count)=IEN . set Results("COUNT")=count ;"Now, remove entries in POSS MATCH that are actual full matches. new SomeKilled set SomeKilled=0 new index for index=1:1:+$get(Results("COUNT")) do . new matchIEN set matchIEN=$get(Results(index)) . new possEntry set possEntry=$get(Results("POSS MATCH","INDEX",matchIEN)) . kill Results("POSS MATCH",possEntry) . kill Results("POSS MATCH","INDEX",matchIEN) . set SomeKilled=1 . set Results("POSS MATCH","COUNT")=$get(Results("POSS MATCH","COUNT"))-1 ;"Now renumber remaining POSS MATCHES if SomeKilled do . do ListPack^TMGMISC($name(Results("POSS MATCH"))) . set Results("POSS MATCH","COUNT")=$$ListCt^TMGMISC($name(Results("POSS MATCH"))) ;"set index=$order(Results("POSS MATCH","")) ;"new newCount set newCount=0 ;"if +index>0 for do quit:(index'>0) ;". set newCount=newCount+1 ;". merge Results("POSS MATCH 2",newCount)=Results("POSS MATCH",index) ;". set Results("POSS MATCH 2","COUNT")=$get(Results("POSS MATCH 2","COUNT"))+1 ;". set index=$order(Results("POSS MATCH",index)) ;"if $data(Results("POSS MATCH 2"))>0 do ;". kill Results("POSS MATCH") ;". merge Results("POSS MATCH")=Results("POSS MATCH 2") ;". kill Results("POSS MATCH 2") quit CheckNDCLink(IEN,Array,Results) ;"This is like CheckLink, except is it a little bit more lenient about the allowed ;" variances. For example if UNITS of measure are different (e.g. MG vs. MG/VIAL). ;"Input: IEN -- An IEN in file 50.68 to try for a match, seeing if matches info in Array ;" Array -- PASS BY REFERENCE. An array holding drug info, as created by GetDrugInfo(IEN,Array) ;" Results -- OPTIONAL, PASS BY REFERENCE, an OUT parameter to receive results array ;" if more than one IEN. e.g. ;" Results("COUNT")=3 ;" Results(1)=IEN ;IEN is from file 50.68 ;" Results(2)=IEN ;IEN is from file 50.68 ;" Results(3)=IEN ;IEN is from file 50.68 ;" Because a full match is sometimes not found (i.e. because minor variance), I ;" will return all close (but not necessarily perfect) matches as: ;" Results("POSS MATCH","COUNT")=IEN ;" Results("POSS MATCH",1)=ien ;"Result: None (but returns results in Results array) ;"Note: this function will have to scan through tens of thousands of entries in the main ;" drug files, so response may be slow. new match do CheckLink(IEN,.Array,.Results) if +$get(Results("COUNT"))<1 do . new i,max,done . set done=0 . set max=$get(Results("POSS MATCH","COUNT")) . for i=1:1:max do quit:(done=1) . . if Results("POSS MATCH",i,"PROBLEM")="dosage UNITS mis-match" do . . . set Results(1)=Results("POSS MATCH",i) . . . kill Results("POSS MATCH",i) . . . do ListPack^TMGMISC($name(Results("POSS MATCH"))) . . . set Results("COUNT")=$$ListCt^TMGMISC("Results") . . . set done=1 quit GetpVAPIndex() ;"Purpose: to return a pointer to an index of the VAProduct file ;"Input: none ;"Output: returns the NAME of index of VAProduct, or ^ for abort new pIndex set pIndex=$name(^TMG("TMP","indexVAProduct")) new abort set abort=0 if $data(@pIndex) do . new % set %=2 . write "Recreate temporary VA PRODUCT file index *IF* there have",! . write "been any changes made to this file since last index.",! . write "Re-index" do YN^DICN write ! . if %=1 kill @pIndex . if %=-1 set abort=1 if abort=1 set pIndex="^" goto GVAPIDone if $data(@pIndex)=0 do IndexVAProd(pIndex) GVAPIDone quit pIndex IndexVAProd(pArray) ;"Purpose: to make a temporary index of the VA PRODUCT file based on the ACTIVE INGREDIENTS field ;"Input: pArray: the NAME OF the array to store index in ;"Output: Index will be stored in array like this: ;" @pArray@(IngredientIEN, 50.68 IEN, 50.6814 IEN)="" ;"Result: none: ;"Note: prior values in pArray will NOT be killed. ;" Also, the VA PRODUCT file is setup such that the 50.6814 IEN will also watch IngredientIEN new IEN,subIEN,node,Ingredient ;"set IEN=$order(^PSNDF(50.68,0)) ;"if (+IEN>0) for do quit:(+IEN'>0) write "Creating a temporary index of VA PRODUCT FILE",! new Itr,IEN set IEN=$$ItrInit^TMGITR(50.68,.Itr) do PrepProgress^TMGITR(.Itr,20,0,"IEN") if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0) . set subIEN=$order(^PSNDF(50.68,IEN,2,0)) . if (+subIEN>0) for do quit:(+subIEN'>0) . . set node=$get(^PSNDF(50.68,IEN,2,subIEN,0)) . . set Ingredient=$piece(node,"^",1) . . if +Ingredient>0 do . . . set @pArray@(Ingredient,IEN,subIEN)="" . . . ;"set @pArray@("IEN",IEN,subIEN)=Ingredient . . set subIEN=$order(^PSNDF(50.68,IEN,2,subIEN)) . ;"set IEN=$order(^PSNDF(50.68,IEN)) write ! quit GetIndexList(Ingredient,pIndex,pArray) ;"Purpose: for a given Ingredient, return a list of all records containing this ingredient ;"Input: Ingredient -- the IEN (from file 50.416) to scan for ;" pIndex -- NAME OF index array, as created by IndexVaProd() ;" pArray -- NAME OF array to put data into ;"Output: results will be put in like this: ;" @pArray@(IEN from 50.68)="" ;"results: none ;"Note: any prior data in pArray WILL BE KILLED kill @pArray if $get(Ingredient)="" quit new IEN set IEN=$order(@pIndex@(Ingredient,"")) if +IEN>0 for do quit:(+IEN'>0) . set @pArray@(IEN)="" . set IEN=$order(@pIndex@(Ingredient,IEN)) quit FixGenerics ;"Purpose: After running the Compile function, I found that many records did not have ;" an entry for the GENERIC NAME field. This seems to happen when a drug has no ;" Ingredients listed. But often there are other drugs with the same name that DO ;" have ingredients. If so, then the errent record is essentially a duplicate (except ;" for different NDC etc), and isn't needed. Therefore the SKIP THIS RECORD field ;" can be set to 1 (SKIP). But, if there isn't a duplicate record, then the tradename ;" will be used as the GENERIC name new IEN,count new TMGGeneric,TradeName set IEN=$order(^TMG(22706.9,0)) if IEN'="" for do quit:(+IEN'>0) . set TMGGeneric=$piece($get(^TMG(22706.9,IEN,0)),"^",6) ;"get field#.07, GENERIC NAME . if (TMGGeneric="") do . . set TradeName=$piece($get(^TMG(22706.9,IEN,0)),"^",4) ;"get field#.05, TRADENAME . . new list . . do ScanFor(TradeName,.list) . . set count=$$ListCt^TMGMISC("list") . . if count=1 do . . . write "Unique drug, with no ingredients: ",TradeName,! . . . do FindSimNames(TradeName,.list) . . . if $data(list) zwr list . . else do . . . write "Drug, with no ingredients: ",TradeName," --> ",count," other similar drugs.",! . set IEN=$order(^TMG(22706.9,IEN)) quit ScanFor(Name,Array) ;"Purpose: To scan file 22706.9 (TMG FDA IMPORT COMPILED) for records with field TRADENAME ;" contains to 'TradeName' ;"Input: Name -- the value to search for ;" Array -- PASS BY REFERENCE. An OUT parameter for result: ;" Array(Name,IEN)="" ;" Array(Name,IEN)="" ;" Array(Name,IEN)="" ;"Results: none new IEN new TradeName set IEN=$order(^TMG(22706.9,0)) if IEN'="" for do quit:(+IEN'>0) . set TradeName=$piece($get(^TMG(22706.9,IEN,0)),"^",4) ;"get field#.05, TRADENAME . if TradeName[Name do . . set Array(Name,IEN)=TradeName . set IEN=$order(^TMG(22706.9,IEN)) quit FindSimNames(Name,Array) ;"Purpose: to scan TMG FDA IMPORT COMPILED file and return an array of similar entries. ;"Input: Name: the name of the Name drug name to scan for ;" Array: PASS BY REFERENCE, and OUT PARAMETER -- prior entries are killed ;"Result: none (output is in Array) new i,i2,s new NumWords,TradeName set NumWords=$length(Name," ") kill Array set i2=$order(^TMG(22706.9,0)) if i2'="" for do quit:(i2="") . set TradeName=$piece($get(^TMG(22706.9,i2,0)),"^",4) ;"get field#.05, TRADENAME . new IEN set IEN=i2 . set i2=$order(^TMG(22706.9,i2)) . if NumWords'=$length(TradeName," ") quit . new temp set temp=TradeName . for i=1:1:NumWords do quit:(s="")!(temp="") . . set s=$piece(Name," ",i) . . set s=$piece(s," ",1) ;"get first word of multi-word drug name . . if s="" quit . . if $extract(TradeName,1,$length(s))'=s set temp="" . if temp'="" do . . set Array(TradeName)=IEN_"^"_TradeName new count set count=$$ListCt^TMGMISC("Array") if count>1 do . do NarrowGenMatches^TMGNDF2C(Name,.Array," ") . if (($$ListCt^TMGMISC("Array")/count)>0.5)&(count>5) do ;"i.e. no improvement . . kill Array quit FixLink ;"Purpose: ask user for entry in 22706.9 to fix, then try to fix link new IEN new DIC,X,Y set DIC=22706.9,DIC(0)="MAEQ" do ^DIC write ! if +Y>0 do Fix1Link(+Y) quit Fix1Link(IEN) ;"Purpose: To attemp to fix an entry that doesn't have a link to a VA PRODUCT entry ;"Input: IEN -- an IEN from 22706.9 new array,results,vapIEN new listIEN set listIEN=+$piece($get(^TMG(22706.9,IEN,0)),"^",1) if listIEN'>0 goto F1LDone if $$GetDrugInfo(listIEN,.array)=0 goto F1LDone set vapIEN=$$LinkToVAProd(.array,.results) write vapIEN,! if $data(results) zwr results(*) ;"finish.... ;" F1LDone quit ;"======================================================================= Show1Source(IEN) ;"Purpose: to show the source fields for the record ;"Input: IEN -- records number from 22706.9 ;"Output: source data for record is dumped to screen. new fdaIEN set fdaIEN=$piece($get(^TMG(22706.9,IEN,0)),"^",1) do Show1Drug^TMGNDF0B(fdaIEN) quit