TMGNDF2E ;TMG/kst/FDA Import: Fix ingredients IEN linkages ;03/25/06 ;;1.0;TMG-LIB;**1**;11/21/06 ;" FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS ;" Further processing, after functions in TMGNDF2D ;" Fixing ingredients IEN linkages ;"Kevin Toppenberg MD ;"GNU General Public License (GPL) applies ;"11-21-2006 ;"======================================================================= ;" API -- Public Functions. ;"======================================================================= ;"Menu ;"======================================================================= ;"FixMissing -- Find and fix missing ingredient IEN's in TMG FDA IMPORT COMPILED ;"======================================================================= ;" Private Functions. ;"======================================================================= ;"FindMissing(Array) ;"EasyFix(Array) ;handle the easy fixes from Array (created by FindMissing) ;"HardFix(Array) ;handle the more difficult fixes from Array (created by FindMissing) ;"GetRxIEN(RxName,pDrugInfo) ;get the IEN of the given drug name ;"BatchNDCFix -- Scan TMG FDA IMPORT COMPILED file, and fix NDC codes ;"NewNDC(NDC) -- convert an NDC code with invalid formatting into one acceptible to VistA ;"======================================================================= ;"======================================================================= ;"Notes: I have discovered, when I went to actually add entries from ;" TMG NDF IMPORT COMPILED into VA PRODUCT, that many of the ingredients ;" did not have appropriate links to a VA drug. I am not sure how this ;" happened. Perhaps the drugs had not been added at the time that the ;" compiled entry was create? Perhaps it was drug ingredient that I ;" chose to skip? Anyway, the purpose of this code is to fix this problem. ;" And since I don't know at which step the problem occured, and I am ;" unwilling to put the HOURS of classification work in again if I were ;" to start over, I will just fix the problem at this step of the process. ;"======================================================================= Menu ;"Purpose: Provide menu to entry points of main routines set XUMF=1 ;"secret programmer's key do Unlock50d416 new Menu,UsrSlct set Menu(0)="Pick Option for Fixing Missing Ingredients (2E)" set Menu(1)="Fix UNMATCHED ingredients in import."_$char(9)_"FixMissing" set Menu(2)="Fix MISSING ingredients in import."_$char(9)_"FixMissing2" 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="FixMissing" do FixMissing goto MC1 if UsrSlct="FixMissing2" do FixMissing^TMGNDF2F goto MC1 if UsrSlct="Prev" goto Menu^TMGNDF2C ;"quit can occur from there... if UsrSlct="Next" goto Menu^TMGNDF2G ;"quit can occur from there... goto MC1 MCDone do Lock50d416 quit FixMissing ;"Purpose: To find and fix missing ingredient IEN's in TMG FDA IMPORT COMPILED new Array write "Gathering missing ingredient link entries...",! do FindMissing(.Array) if $data(Array)=0 do goto FMDone . write !,"No missing entries. Great!",! write "Fixing easy problems...",! do EasyFix(.Array) write "Now to fix the more difficult problems...",! do HardFix(.Array) FMDone write "Done. Goodbye...",! do PressToCont^TMGUSRIF quit FindMissing(Array) ;"Purpose: to scan TMG FDA IMPORT COMPILED and find ingredients that ;" don't have a linkage to a VA drug. ;"Input: Array -- PASS BY REFERENCE, it is an OUT PARAMETER. Format below ;" prior entries in array are NOT KILLED. ;"Output: Array is filled as follows: ;" Array(IEN,subIEN)=UnmatchedIngredientName ;" Array(IEN,subIEN,"FILE 50.416 IEN")=IEN ;" Array(IEN,subIEN)=UnmatchedIngredientName ;" Array(IEN,subIEN,"FILE 50.416 IEN")=IEN ;"Results: none. 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 subIEN set subIEN=0 . for set subIEN=+$order(^TMG(22706.9,IEN,4,subIEN)) quit:(+subIEN'>0) do . . new node set node=$get(^TMG(22706.9,IEN,4,subIEN,0)) . . new ingredients set ingredients=$piece(node,"^",3) ;"INGREDIENTS . . if ingredients="" do . . . new FDAitemNum . . . set FDAitemNum=$piece($get(^TMG(22706.9,IEN,0)),"^",1) . . . new DrugInfo . . . new result . . . set result=$$GetDrugInfo^TMGNDF1A(FDAitemNum,.DrugInfo,"",1) . . . if result=0 do quit . . . . write "Unable to get drug info for entry: ",FDAitemNum,! . . . new ingrName,ingrIEN . . . set ingrName=$get(DrugInfo("FORMULATION",subIEN,"INGREDIENT NAME")) . . . set ingrIEN=$get(DrugInfo("FORMULATION",subIEN,"INGREDIENT NAME","FILE 50.416 IEN")) . . . set Array(IEN,subIEN)=ingrName . . . set Array(IEN,subIEN,"FILE 50.416 IEN")=ingrIEN . . . merge Array(IEN,subIEN,"INFO")=DrugInfo do ProgressDone^TMGITR(.Itr) quit EasyFix(Array) ;"Purpose: to handle the easy fixes from Array (created by FindMissing) ;"Input: Array -- array as cread by FindMissing() ;" Array(IEN,subIEN)=UnmatchedIngredientName ;" Array(IEN,subIEN,"FILE 50.416 IEN")=IEN ;" Array(IEN,subIEN)=UnmatchedIngredientName ;" Array(IEN,subIEN,"FILE 50.416 IEN")=IEN ;"Output: Missing information will be stuffed into records new IEN,subIEN set IEN=$order(Array("")) if IEN'="" for do quit:IEN="" . set subIEN=$order(Array(IEN,"")) . if subIEN'="" for do quit:subIEN="" . . new RxIEN set RxIEN=$get(Array(IEN,subIEN,"FILE 50.416 IEN")) . . if RxIEN'="" do . . . set $piece(^TMG(22706.9,IEN,4,subIEN,0),"^",3)=RxIEN . . set subIEN=$order(Array(IEN,subIEN)) . set IEN=$order(Array(IEN)) quit HardFix(Array) ;"Purpose: to handle the more difficult fixes from Array (created by FindMissing) ;"Input: Array -- array as cread by FindMissing() ;" Array(IEN,subIEN)=UnmatchedIngredientName ;" Array(IEN,subIEN,"FILE 50.416 IEN")=IEN ;" Array(IEN,subIEN)=UnmatchedIngredientName ;" Array(IEN,subIEN,"FILE 50.416 IEN")=IEN ;"Output: Missing information will be stuffed into records write !,$$ListCt^TMGMISC("Array")," items to fix.",! new IEN,subIEN,PriorAnswer new abort set abort=0 set IEN=$order(Array("")) if IEN'="" for do quit:(IEN="")!(abort=1) . set subIEN=$order(Array(IEN,"")) . if subIEN'="" for do quit:(subIEN="")!(abort=1) . . new RxName,RxIEN . . set RxName=$get(Array(IEN,subIEN)) . . set RxIEN=+$get(PriorAnswer(RxName)) . . if (RxIEN=0)!(RxIEN=-1) do . . . set RxIEN=$$LookupRx^TMGNDF0C(RxName) . . . set PriorAnswer(RxName)=RxIEN . . . if RxIEN=-1 do . . . . set RxIEN=$$GetRxIEN(RxName,$name(Array(IEN,subIEN,"INFO"))) . . . . set PriorAnswer(RxName)=RxIEN . . if +RxIEN>0 do . . . new TMGFDA,TMGMSG . . . set TMGFDA(22706.916,subIEN_","_IEN_",",2)=+RxIEN . . . do FILE^DIE("K","TMGFDA","TMGMSG") . . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) . . if RxIEN=-3 set abort=1 quit . . if RxIEN=-2 do . . . set $piece(^TMG(22706.9,IEN,1),"^",4)=1 ;"1=SKIP . . set subIEN=$order(Array(IEN,subIEN)) . set IEN=$order(Array(IEN)) quit GetRxIEN(RxName,pDrugInfo) ;"Purpose: To get the IEN of the given drug name ;"Input: RxName -- the name of the drug to find. ;" pDrugInfo -- NAME OF array containing drug info (as created by GetDrugInfo^TMGNDF1A ;"Result: IEN of drug found, or 0 if not found, ;" -2 if drug should be excluded from addition to VA PRODUCT file. ;" -3 if abort requested new result set result=0 new DrugInfo merge DrugInfo=@pDrugInfo new Menu,UsrSlct set Menu(1)="Manual lookup"_$char(9)_"1" set Menu(2)="Show info of drug containing this ingredient"_$char(9)_"2" set Menu(3)="Set drug containing this ingredient to NOT BE ADDED to the VA PRODUCT file"_$char(9)_"3" set Menu(4)="NEXT"_$char(9)_"0" GRLoop set Menu(0)="Can't find a ingredient match for: "_RxName write # set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^") if UsrSlct="^" goto MCDone if UsrSlct=0 set UsrSlct="" if UsrSlct="" set temp="0" if UsrSlct="^" set result=-3 goto GRDone if UsrSlct=0 goto GRDone if UsrSlct=1 do goto:(result>0) GRDone . new DIC,Y . set DIC=50.416 . set DIC(0)="AEQML" . do ^DIC . if +Y>0 set result=+Y if UsrSlct=2 do goto GRLoop . do FormatDrug^TMGND2A(.DrugInfo) if UsrSlct=3 do goto GRDone . set result=-2 goto GRLoop GRDone quit result Unlock50d416 set XUMF=1 set PSNDF=1 quit Lock50d416 kill XUMF,PSNDF quit ;"======================================================================= ;"Code for Fixing NDC's ;"======================================================================= ;"Note: The NDC's given by the FDA database are not always acceptible by the ;" VistA input transform, because they include *'s. The FDA explains ;" this as follows: ;" Here is the official info from fda.gov on NDC codes: ;" ;" NDC Number ;" ;" Each listed drug product listed is assigned a unique 10-digit, 3-segment ;" number. This number, known as the NDC, identifies the labeler, product, and ;" trade package size. The first segment, the labeler code, is assigned by the ;" FDA. A labeler is any firm that manufactures (including repackers or ;" relabelers), or distributes (under its own name) the drug. The second ;" segment, the product code, identifies a specific strength, dosage form, and ;" formulation for a particular firm. The third segment, the package code, ;" identifies package sizes and types. Both the product and package codes are ;" assigned by the firm. The NDC will be in one of the following ;" configurations: 4-4-2, 5-3-2, or 5-4-1. ;" ;" An asterisk may appear in either a product code or a package code. It ;" simply acts as a place holder and indicates the configuration of the NDC. ;" Since the NDC is limited to 10 digits, a firm with a 5 digit labeler code ;" must choose between a 3 digit product code and 2 digit package code, or a 4 ;" digit product code and 1 digit package code. ;" ;" Thus, you have either a 5-4-1 or a 5-3-2 configuration for the three ;" segments of the NDC. Because of a conflict with the HIPAA standard of an 11 ;" digit NDC, many programs will pad the product code or package code segments ;" of the NDC with a leading zero instead of the asterisk. ;" ;" kt note: I.e. the problem is how to convert 10 digits --> 11 digits. ;" where to put the extra digit? ;" ;" Since a zero can be a valid digit in the NDC, this can lead to confusion ;" when trying to reconstitute the NDC back to its FDA standard. Example: ;" 12345-0678-09 (11 digits) could be 12345-678-09 or 12345-678-90 depending on ;" the firm's configuration. ;" ;" kt note: I think the example is wrong. It should be: ;" Example: ;" 12345-0678-09 (11 digits) could be 12345-678-09 (i.e. 5-3-2) ;" or 12345-0678-9 (5-4-1) depending on the firm's configuration. ;" By storing the segments as character data and ;" using the * as place holders we eliminate the confusion. In the example, FDA ;" stores the segments as 12345-*678-09 for a 5-3-2 configuration or ;" 12345-0678-*9 for a 5-4-1 ;" ;" BatchNDCFix ;"Purpose: Scan TMG FDA IMPORT COMPILED file, and fix NDC codes ;"Output: data in file will be changed, NDC and NDC-12-digit fields will be altered. new IEN set IEN=$order(^TMG(22706.9,0)) if +IEN>0 for do quit:(+IEN'>0) . new node set node=$get(^TMG(22706.9,IEN,1)) . new NDC,newNDC . set NDC=$piece(node,"^",1) . set newNDC=$$NewNDC(NDC) . new digits12NDC set digits12NDC=$translate(newNDC,"-","") . new d1 . if '$$IsNumeric^TMGMISC(digits12NDC) do . . new name set name=$piece(^TMG(22706.9,IEN,0),"^",4) . . write IEN,". NDC=",NDC," ",name,! . if newNDC'=NDC do . . write IEN,". ",NDC," needs --> ",newNDC,! . . if $length(digits12NDC)<12 do . . . set digits12NDC=$extract("000000",1,12-$length(digits12NDC))_digits12NDC BLabel . . new TMGFDA,TMGIEN,TMGMSG . . set TMGFDA(22706.9,IEN_",",4)=newNDC . . set TMGFDA(22706.9,IEN_",",5)=digits12NDC . . do UPDATE^DIE("S","TMGFDA","TMGIEN","TMGMSG") . . if $data(TMGMSG("DIERR")) do . . . set result=0 . . . if $get(Quiet)=1 quit . . . new PriorErrorFound . . . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) . set IEN=$order(^TMG(22706.9,IEN)) quit NewNDC(NDC) ;"Purpose: convert an NDC code with invalid formatting into one acceptible to VistA ;"Input: NDC -- the NDC as provided by FDA, with hyphens ('-'s) ;"Output: the correctly formatted NDC, or "" if not valid conversion possible. ;"Examples of conversions: ;" 12345-*678-09 --> 12345-678-09 (5-3-2 digits) ;" 12345-0678-*9 --> 12345-0678-9 (5-4-1 digits) ;"Sometimes there are two *'s (i.e. **) (always in the LAST grouping -- the package code ;"Here is some examples of how I will convert them: ;" 057587-*022-** (6-4-2) --> 57587-022-00 (5-3-2) ;" 053360-4189-** (6-4-2) --> 53360-4189-0 (5-4-1) ;" 000034-1025-** (6-4-2) --> 00034-1025-0 (5-4-1) ;" 046672-*122-** (6-4-2) --> 46672-122-00 (5-3-2) ;"Also, sometimes the FDA database did not include values for codes. ;"Initially, I converted these to ????'s ;"Now, that won't be acceptible to VistA, so I will convert these to 0's ;"e.g. 000034-????-56 --> 000034-0000-56 new result,valid,digits ;"Setup check for valid digits combo. Allowed combos are: ;" 4-4-2, 5-3-2, 5-4-1, 5-4-2, or 6-4-2 set digits("VALID",4,4,2)=1 ;"total of 10 digits set digits("VALID",5,3,2)=1 ;"total of 10 digits set digits("VALID",5,4,1)=1 ;"total of 10 digits set digits("VALID",5,4,2)=1 ;"total of 11 digits set digits("VALID",6,4,2)=1 ;"total of 12 digits ;"set digits("VALID",6,3,1)=1 ;"total of 10 digits ;"Remove single *'s set result=$$Substitute^TMGSTUTL(NDC,"**","##") ;"protect double **'s ;" 010130-*124-*1 --> 010130-*124-01 if ($piece(result,"-",2)["*")&($piece(result,"-",3)["*") do . set $piece(result,"-",3)=$translate($piece(result,"-",3),"*","0") ;" 010130-*124-01 --> 010130-124-01 set result=$translate(result,"*","") set result=$$Substitute^TMGSTUTL(result,"##","**") ;"Change ?'s into 0's if $length($piece(result,"-",2))=4 do . if $piece(result,"-",3)="??" set $piece(result,"-",3)="0" set result=$translate(result,"?","0") NNDCL1 set digits(1)=$length($piece(result,"-",1)) set digits(2)=$length($piece(result,"-",2)) set digits(3)=$length($piece(result,"-",3)) if result["**" do . if digits(2)=3 set result=$$Substitute^TMGSTUTL(result,"**","00") . else if digits(2)=4 set result=$$Substitute^TMGSTUTL(result,"**","0") . else do . . write "Error converting NDC code: ",NDC,! . . set result="",digits(1)=-1 . set digits(3)=$length($extract(result,"-",3)) ;"convert 12345-123-x --> 12345-123-0x if (digits(1)=5)&(digits(2)=3)&(digits(3)=1) do goto NNDCL1 . new value set value=+$piece(result,"-",3) . set $piece(result,"-",3)="0"_value set digits=digits(1)+digits(2)+digits(3) set valid=+$get(digits("VALID",digits(1),digits(2),digits(3))) if (valid'=1)&(digits(1)=6)&($extract(result,1,1)="0") do goto NNDCL1 . set result=$extract(result,2,99) if valid'=1 set result="" quit result