TMGNDF2H ;TMG/kst/FDA Import: Fill VA Product entries ;03/25/06 ;;1.0;TMG-LIB;**1**;11/21/06 ;" FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS ;" Addition of records from TMG FDA IMPORT COMPILED into VA PRODUCT file. ;"Kevin Toppenberg MD ;"GNU General Public License (GPL) applies ;"11-21-2006 ;"======================================================================= ;" API -- Public Functions. ;"======================================================================= ;"Menu ;"======================================================================= ;"Link2VAP -- fill file 22706.9, field 5.5 in with link 50.68 with SAME NDC ;"Batch2VAP -- Batch add drugs to VA PRODUCT file (50.68) and NDC/UPC ;"======================================================================= ;" Private Functions. ;"======================================================================= ;"Add2VAProd(IEN,Quiet) ;"EnsureNDC(IEN) Make record in NDC/UPN file (50.67). ;"EnsureUnits(UnitS) -- ensure that the UnitS is valid in file 50.607 ;"Unlock50dot607 ;"Lock50dot607 ;"======================================================================= ;"======================================================================= Menu new Menu,UsrSlct set Menu(0)="Pick Option to Add imports to VA PRODUCT & NDC/UPN file (2H)" set Menu(1)="Link imports to VA PRODUCT via NDC-- *DO THIS FIRST*"_$char(9)_"Link2VAP" set Menu(2)="ADD unlinked imports to VA PRODUCT file."_$char(9)_"Batch2VAP" set Menu(3)="Synchronize VA PRODUCT file with import data."_$char(9)_"Sync2VAP" ;"set Menu(3)="Fix Names with '...'s (SHOULD run AFTER Batch Add)"_$char(9)_"FixNames" ;"set Menu(4)="Check/Fix ALL Names (May be run AFTER Batch Add)"_$char(9)_"FixNames2" set Menu("P")="Prev Stage"_$char(9)_"Prev" set Menu("N")="Next Stage"_$char(9)_"Next" M1 write # set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^") if UsrSlct="Link2VAP" do Link2VAP goto M1 if UsrSlct="Batch2VAP" do Batch2VAP goto M1 if UsrSlct="Sync2VAP" do Sync2VAP goto M1 ;"if UsrSlct="FixNames" do FixNames(0) goto M1 ;"if UsrSlct="FixNames2" do FixNames(1) goto M1 if UsrSlct="Prev" goto Menu^TMGNDF2G ;"quit can occur from there... if UsrSlct="Next" goto Menu^TMGNDF3A ;"quit can occur from there... if UsrSlct="^" goto MenuDone goto M1 MenuDone quit ;"========================================================================== Batch2VAP ;"Purpose: To scan through all records in TMG FDA IMPORT COMPILED, and create an array of ;" possible entries for addition to VA PRODUCT, also creating an entry in ;" the NDC/UPC file. ;"Input: none ;"Output: database will be filled with data (records added to VA PRODUCT file) ;"Results: none ;"Note: After making this function, I changed the function MakeName such that it is better ;" at shortening long names to fit into the field limits. ;" So I wrote the code FixNames to go back and correct the names for better fits. ;" The problem is that it takes user interaction to do this well (asking for abbreviations etc) ;" And this is best done in a batch manner (i.e. not asking each drug, one at a time). ;" So this function was modified such that it shortens the names non-interactively ;" (i.e. AllowCut=1), and then FixNames can be run to review all of the abbreviations ;" are appropriate new AddList do GetAddList(.AddList) new count set count=$$ListCt^TMGMISC("AddList") if count=0 do goto B2VDone . write "No entries need to be be added to VA PRODUCT file.",! . do PressToCont^TMGUSRIF write count," entries will now be added to VA PRODUCT file.",! new % set %=1 write "Continue" do YN^DICN write ! if %=1 do DoAdd(.AddList) B2VDone quit Check1(IEN) ;"Purpose: to check one record in TMG FDA IMPORT COMPILED (22706.9) ;"NOTE: this just checks if one exists, NOT if correct link is present. ;"Input: IEN -- IEN in 22706.9 new AddList,vapIEN,syncList set vapIEN=+$piece($get(^TMG(22706.9,IEN,6)),"^",2) set AddList(IEN)="" if vapIEN=0 set vapIEN=$$Add2VAProd(IEN) set syncList(IEN)=vapIEN do DoSync(.syncList) C1Done quit Sync2VAP ;"Purpose: To scan through all records in TMG FDA IMPORT COMPILED (22706.9) ;" and synchronize data with records in VA PRODUCT. ;"Input: none ;"Output: database will be modified with data from 22706.9 ;"Results: none new SyncList do GetSyncList(.SyncList) new count set count=$$ListCt^TMGMISC("SyncList") if count=0 do goto S2VDone . write "No entries available to update VA PRODUCT file with.",! . do PressToCont^TMGUSRIF write count," entries will now be used to update VA PRODUCT file.",! new % set %=1 write "Continue" do YN^DICN write ! if %=1 do DoSync(.SyncList) S2VDone quit GetAddList(AddList) ;"Purpose: to create a list of IEN's that need addition ;"Input: AddList-- PASS BY REFERENCE. An OUT PARAMETER. ;"Output: AddList is filled: Format: ;" AddList(IEN)="" ;IEN is from file 22706.9 ;" AddList(IEN)="" ;"Results: none. write "Scanning for imports to be added into VA PRODUCT file...",! new Itr,IEN,success new abort set abort=0 set IEN=$$ItrInit^TMGITR(22706.9,.Itr) do PrepProgress^TMGITR(.Itr,20,0,"IEN") if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort . if $$UserAborted^TMGUSRIF set abort=1 quit . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;"1=SKIP . if $piece($get(^TMG(22706.9,IEN,6)),"^",2)>0 quit ;"IEN of linked entry in 50.68 . set AddList(IEN)="" do ProgressDone^TMGITR(.Itr) quit GetSyncList(SyncList) ;"Purpose: to create a list of IEN's can be used for syncing data ;"Input: SyncList-- PASS BY REFERENCE. An OUT PARAMETER. ;"Output: SyncList is filled: Format: ;" SyncList(IEN22706d9)=vapIEN ;"Results: none. write "Scanning for imports to be synchronized with VA PRODUCT file...",! new Itr,IEN,success new abort set abort=0 set IEN=$$ItrInit^TMGITR(22706.9,.Itr) do PrepProgress^TMGITR(.Itr,20,0,"IEN") if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort . if $$UserAborted^TMGUSRIF set abort=1 quit . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;"1=SKIP . new vapIEN set vapIEN=$piece($get(^TMG(22706.9,IEN,6)),"^",2) ;"IEN of linked entry in 50.68 . if vapIEN=0 quit . set SyncList(IEN)=vapIEN do ProgressDone^TMGITR(.Itr) quit DoAdd(AddList) ;"Purpose: To process the AddList, doing actual adds. ;"Input: AddList-- PASS BY REFERENCE. Format: ;" AddList(IEN)="" ;IEN is from file 22706.9 ;" AddList(IEN)="" ;"Results: none. do Unlock50dot607 do Unlock50^TMGNDF3C write "Adding records into VA PRODUCT file from import information...",! new count set count=0 new Itr,IEN,success,addedIEN new abort set abort=0 set IEN=$$ItrAInit^TMGITR("AddList",.Itr) do PrepProgress^TMGITR(.Itr,1,1,"IEN") if IEN'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN)="")!abort . if $$UserAborted^TMGUSRIF set abort=1 quit L1 . set addedIEN=$$Add2VAProd(IEN,0,1) ;"0=not quiet, 1=quiet,Allow Cut automatically . if addedIEN>0 do . . set count=count+1 . . new TMGFDA,TMGMSG . . set TMGFDA(22706.9,IEN_",",5.5)=addedIEN . . do FILE^DIE("K","TMGFDA","TMGMSG") . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) . else do . . write !,"Unable to add record# ",IEN," from file 22706.9 to file 50.68.",! do ProgressDone^TMGITR(.Itr) do Lock50dot607 do Lock50^TMGNDF3C write count," imports added to VA PRODUCT (file 50.68 )",! do PressToCont^TMGUSRIF quit DoSync(SyncList) ;"Purpose: To process the SyncList, doing actual synchronization. ;"Input: SyncList-- PASS BY REFERENCE. Format: ;" SyncList(IEN)=vapIEN ;IEN is from file 22706.9; vapIEN=IEN 50.68 ;"Results: none. do Unlock50dot607 do Unlock50^TMGNDF3C write "Synchronizing VA PRODUCT file from import information...",! new count set count=0 new Itr,IEN,success new abort set abort=0 set IEN=$$ItrAInit^TMGITR("SyncList",.Itr) do PrepProgress^TMGITR(.Itr,1,1,"IEN") if IEN'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN)="")!abort . if $$UserAborted^TMGUSRIF set abort=1 quit . new vapIEN set vapIEN=+$get(SyncList(IEN)) . if +vapIEN=0 quit . set success=$$Sync1Rec(IEN,vapIEN) do ProgressDone^TMGITR(.Itr) do Lock50dot607 do Lock50^TMGNDF3C do PressToCont^TMGUSRIF quit Add2VAProd(IEN,Quiet,AllowCut) ;"Purpose: to take drug information from Array and use this to create a new entry ;" in file #50.68 (VA PRODUCT)--and any supporting files needed. ;"Input: IEN -- IEN from file 22706.9 (TMG FDA IMPORT COMPILED) to add ;" Quiet -- OPTIONAL -- default = 1 (quiet), if 1 no output generated to console. ;" AllowCut -- OPTIONAL -- default = 0 (no cut). ;" If value=1 then names will be shortened to needed length without ;" asking user for abbreviations etc. ;"Output: A new record will be created in 50.68, and any supporint files (such as ;" drug manufacturer, package type etc if needed) ;"Result: the IEN in 50.68 of added record, 0 if error new TMGFDA,TMGIEN,TMGMSG set IENS="+1," do SetupFDA(IEN,IENS,.TMGFDA) ALabel do UPDATE^DIE("E","TMGFDA","TMGIEN","TMGMSG") if $data(TMGMSG("DIERR")) do goto A2VPDone . set result=0 . if Quiet=1 quit . write !,"Error adding new record to 50.68",! . new PriorErrorFound . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) ;"Check that record was added, then then add subfile entries: active ingredients... new AddedIEN set AddedIEN=$get(TMGIEN(1)) ;"also used to create NDC/UPC record; if +AddedIEN=0 do goto A2VPDone . set result=0 if Quiet=1 quit . write !,"Can't find record number of added record to 50.68",! . do PressToCont^TMGUSRIF set result=$$EnsureIngredients(IEN,AddedIEN) if result=0 goto A2VPDone BLabel ;"set result=$$Add2NDC(IEN,.DrugInfo) set result=$$EnsureNDC(IEN) if result=0 goto A2VPDone A2VPDone ;"1=OK to continue, 0 if error if result=1 set result=+$get(AddedIEN) quit result ;"changed to return IEN in 50.68 Sync1Rec(IEN,vapIEN) ;"Purpose: to take drug information from Array and use this to create a new entry ;" in file #50.68 (VA PRODUCT)--and any supporting files needed. ;"Input: IEN -- IEN from file 22706.9 (TMG FDA IMPORT COMPILED) to add ;" vapIEN -- IEN in 50.68 that is the target of the synchronization. ;"Output: data in VA PRODUCT will be updated as needed to match the info in ;" file 22706.9 ;"Result: 1 if OK, 0 if error new result set result=0 new TMGFDA,TMGIEN,TMGMSG set IENS=vapIEN_"," do SetupFDA(IEN,IENS,.TMGFDA) new temp set temp=$$TrimFDA^TMGDBAPI(.TMGFDA) if $data(TMGFDA) do . do FILE^DIE("EK","TMGFDA","TMGMSG") . do ShowIfDIERR^TMGDEBUG(.TMGMSG) set result=$$EnsureIngredients(IEN,vapIEN) if result=0 goto S2VPDone set result=$$EnsureNDC(IEN) if result=0 goto S2VPDone S2VPDone quit result ;"changed to return IEN in 50.68 SetupFDA(IEN,IENS,TMGFDA,vapIEN) ;"Purpose: to set up FDA for data in a#50.68 (VA PRODUCT) entry ;"Input: IEN -- IEN from file 22706.9 (TMG FDA IMPORT COMPILED) to add ;" IENS -- a standard FM IENS for FDA to use ;" TMGFDA -- PASS BY REFEERNCE. A standard FM FDA ;" vapIEN -- OPTIONAL. If provided, then the FDA wil be trimmed to contain ;" only those fields that need to be changed ;"Output: TMGFDA is filled ;"Result: none ;"NOTE: this function will create an FDA in EXTERNAL form ;"VA PRODUCT FILE RECORD STRUCTURE ;"----------------------------------- ;" .01 NAME [RFa] ;" e.g. NAME: DILTIAZEM (CARDIZEM CD) 240MG SA CAP ;" .05 VA GENERIC NAME <-Pntr [P50.6'a] ;" e.g. VA GENERIC NAME: DILTIAZEM ;" 1 DOSAGE FORM <-Pntr [P50.606'a] ;" e.g. DOSAGE FORM: CAP,SA ;" 2 STRENGTH [Fa] ;" e.g. STRENGTH: 240 ;" 3 UNITS <-Pntr [P50.607'a] ;" e.g. UNITS: MG ;" 4 NATIONAL FORMULARY NAME [Fa] ;" e.g. NATIONAL FORMULARY NAME: DILTIAZEM CAP,SA ;" 5 VA PRINT NAME [Fa] ;" e.g. VA PRINT NAME: DILTIAZEM (CARDIZEM CD) 240MG SA CAP ;" 6 VA PRODUCT IDENTIFIER [Fa] <--- will use to store "0^TMG ADDED" ;" e.g. VA PRODUCT IDENTIFIER: D0230 ;" 8 VA DISPENSE UNIT <-Pntr [P50.64a] ;" e.g. VA DISPENSE UNIT: CAPNSE UNIT <-Pntr [P50.64a] <-- plan to leave blank, for CMOP use ;" 14 ACTIVE INGREDIENTS W:^ D:^ <-Mult [50.6814P] ;" .01 -ACTIVE INGREDIENTS <-Pntr [P50.416'Xa] ;" e.g. ACTIVE INGREDIENTS: DILTIAZEM HYDROCHLORIDE ;" 1 -STRENGTH [Fa] ;" e.g. STRENGTH: 240 ;" 2 -UNITS <-Pntr [P50.607'a] ;" e.g. UNITS: MG ;" 15 PRIMARY VA DRUG CLASS <-Pntr [P50.605'a] ;" e.g. PRIMARY VA DRUG CLASS: CV200 ;" 16 SECONDARY VA DRUG CLASS W:^ D:^ <-Mult [50.6816P] ;" .01 -SECONDARY VA DRUG CLASS <-Pntr [MP50.605'aX] ;" 17 NATIONAL FORMULARY INDICATOR [Sa] ;" e.g. NATIONAL FORMULARY INDICATOR: NO ;" 18 NATIONAL FORMULARY RESTRICTIONW:^ D:^ <-WP [50.6818] ;" .01 -NATIONAL FORMULARY RESTRICTION [W] ;" 19 CS FEDERAL SCHEDULE [Sa] ;" 20 SINGLE/MULTI SOURCE PRODUCT [Sa] ;" 21 INACTIVATION DATE [Da] ;" 23 EXCLUDE DRG-DRG INTERACTION CK [S] ;" 25 MAX SINGLE DOSE [NJ13,4a] ;" 26 MIN SINGLE DOSE [NJ13,4a] ;" 27 MAX DAILY DOSE [NJ13,4a] ;" 28 MIN DAILY DOSE [NJ13,4a] ;" 29 MAX CUMULATIVE DOSE [NJ13,4a] ;" 30 DSS NUMBER [NJ6,0a] ;"--------------------------------------------------------- ;"File: TMG FDA IMPORT COMPILED Branch: 1 ;"REF NODE;PIECE FLD NUM FIELD NAME ;"=============================================================================== ;" 1 0;1 .01 TMG FDA LISTING ENTRY <-Pntr [RP22706.5'] ;" e.g. TMG FDA LISTING ENTRY: 154001 ;" 2 0;4 .05 TRADENAME [F] ;" e.g. TRADENAME: DILTIAZEM HCL SR CAPSULES ;" 3 0;6 .07 GENERIC NAME [F] ;" 4 1;3 .08 VA GENERIC <-Pntr [P50.6'] ;" 5 1;5 .09 VA DRUG CLASS <-Pntr [P50.605'] ;" 6 0;2 1 STRENGTH [F] ;" e.g. STRENGTH: 240 ;" 7 0;3 2 UNIT [F] ;" e.g. UNIT: MG ;" 8 0;5 3 ROUTE [F] ;" e.g. ??? ;" 9 0;7 3.5 DOSAGE FORM <-Pntr [P50.606] ;" 9 1;1 4 NDC [F] ;" e.g. NDC: 053978-3062-*3 ;" 10 1;2 5 NDC 12-DIGIT [F] ;" e.g. NDC: 0539783062*3 ;" 11 1;4 6 SKIP THIS RECORD [S] ;" 12 1;7 7 DONE ADDING TO 50.68 [S] ;" 2;0 14 VA PRODUCT MATCHES <-Mult [22706.914P] ;" 13 -0;1 .01 -ONE MATCH <-Pntr [P50.68'] ;" e.g. ONE MATCH: DILTIAZEM (DILACOR XR) 240MG SA CAP ;" e.g. ONE MATCH: DILTIAZEM (CARDIZEM CD) 240MG SA CAP ;" e.g. ONE MATCH: DILTIAZEM (TIAZAC) 240MG SA CAP ;" e.g. ONE MATCH: DILTIAZEM (WATSON-XR) 240MG SA CAP ;" e.g. ONE MATCH: DILTIAZEM (TIAZAC) 240MG SA CAP,UD ;" e.g. ONE MATCH: DILTIAZEM (CARDIZEM CD) 240MG SA CAP,UD ;" 3;0 15 VA PRODUCT POSS MATCH <-Mult [22706.915P] ;" 14 -0;1 .01 -POSS MATCH <-Pntr [P50.68'] ;" 4;0 16 INGREDIENTS <-Mult [22706.916] ;" 15 -0;1 .01 -NUMBER [NJ3,0] ;" e.g. NUMBER: 1 ;" 17 -0;3 2 -INGREDIENT <-Pntr [P50.416'] ;" e.g. INGREDIENT: DILTIAZEM HYDROCHLORIDE ;" 18 -0;4 3 -STRENGTH [F] ;" e.g. STRENGTH: 240 ;" 19 -0;6 5 -UNIT <-Pntr [P50.607'] ;" e.g. ??? ;" ;"=============================================================================== ;"<> 'n',I=FldDD DA=Data F=Find G=Goto N=Node P=Pointer VGL=VGL ?=Help ;" ;"new FDAitemNum ;"set FDAitemNum=$$GET1^DIQ(22706.9,IEN,.01) ;"new DrugInfo ;"set result=$$GetDrugInfo^TMGNDF1A(FDAitemNum,.DrugInfo,"",1) ;"if result=0 do goto A2VPDone ;". if Quiet=1 quit ;". write !,"Unable to Get Drug Info for record: ",FDAitemNum,! ;".01 NAME [RFa] ;" e.g. NAME: DILTIAZEM (CARDIZEM CD) 240MG SA CAP set tempS=$piece($get(^TMG(22706.9,IEN,7)),"^",6) ;"7;6= field .04 LONG NAME set TMGFDA(50.68,IENS,.01)=tempS ;".01 NAME [RFa] ;e.g. NAME: DILTIAZEM (CARDIZEM CD) 240MG SA CAP ;"set DrugInfo("ADDED","GENERIC+BRAND")=tempS ;".05 VA GENERIC NAME <-Pntr [P50.6'a] ;" e.g. VA GENERIC NAME: DILTIAZEM set TMGFDA(50.68,IENS,.05)=$$GET1^DIQ(22706.9,IEN,.08) ;"1 DOSAGE FORM <-Pntr [P50.606'a] ;" e.g. DOSAGE FORM: CAP,SA set TMGFDA(50.68,IENS,1)=$$GET1^DIQ(22706.9,IEN,3.5) ;"2 STRENGTH [Fa] ;" e.g. STRENGTH: 240 set TMGFDA(50.68,IENS,2)=$$GET1^DIQ(22706.9,IEN,1) ;"3 UNITS <-Pntr [P50.607'a] ;" e.g. UNITS: MG new tempUnits set tempUnits=$$GET1^DIQ(22706.9,IEN,2) if tempUnits'="" do . do EnsureUnits(tempUnits) . set TMGFDA(50.68,IENS,3)=tempUnits ;"5 VA PRINT NAME [Fa] ;" e.g. VA PRINT NAME: DILTIAZEM (CARDIZEM CD) 240MG SA CAP ;"set tempS=$$MakeName(IEN,40,AllowCut) ;"if tempS="^" set result=0 goto A2VPDone set tempS=$piece($get(^TMG(22706.9,IEN,7)),"^",3) ;"7;3 = .055 TRADEBANE - 40 set TMGFDA(50.68,IENS,5)=tempS ;" 5=VA PRINT NAME ;"6 VA PRODUCT IDENTIFIER [Fa] <--- will use to store "0;TMG" ;" e.g. VA PRODUCT IDENTIFIER: D0230 set TMGFDA(50.68,IENS,6)="0;TMG" ;"14 ACTIVE INGREDIENTS W:^ D:^ <-Mult [50.6814P] ;"(multiple/subfile, add after this record added) ;"15 PRIMARY VA DRUG CLASS <-Pntr [P50.605'a] ;" e.g. PRIMARY VA DRUG CLASS: CV200 set TMGFDA(50.68,IENS,15)=$$GET1^DIQ(22706.9,IEN,.09) quit EnsureIngredients(fdaIEN,vapIEN) ;"Purpose: to ensure that all the ingredients from the FDA record (22706.9) are in the ;" VA PRODUCT record (50.68) ;"Input: fdaIEN -- the IEN from 22706.9 ;" vapIEN -- the target IEN in 50.68 ;"result: 1= OK to continue, 0=error new result set result=1 ;"default to success new recNum set recNum=1 ;"new IENS set IENS=fdaIEN_"," new IENS set IENS=vapIEN_"," new TMGFDA,TMGMSG,TMGIEN new subIEN set subIEN=0 ;"INGREDIENTS for set subIEN=+$order(^TMG(22706.9,fdaIEN,4,subIEN)) quit:(+subIEN'>0) do . new node set node=$get(^TMG(22706.9,fdaIEN,4,subIEN,0)) . new pIngredients,strength,units . set pIngredients=$piece(node,"^",3) ;"INGREDIENTS (a POINTER) . set strength=$piece(node,"^",4) ;"STRENGTH . set units=$piece(node,"^",6) ;"UNITS . ;"First search to ensure ingredient is not already present. . new subIEN2 set subIEN2=0 . new found set found=0 . for set subIEN2=$order(^PSNDF(50.68,vapIEN,2,subIEN2)) quit:(+subIEN2'>0)!found do . . new ptr set ptr=$piece($get(^PSNDF(50.68,vapIEN,2,subIEN2,0)),"^",1) . . if ptr=pIngredients set found=1 . if found=1 quit . if pIngredients="" do quit . . write !,"Ingredient entry is missing actual ingredient, so that subpart was DELETED.",! . . new TMGFDA,TMGMSG . . set TMGFDA(22706.916,subIEN_","_fdaIEN_",",.01)="@" ;"delete entry. . . do FILE^DIE("E","TMGFDA","TMGMSG") . . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) . set TMGFDA(50.6814,"+"_recNum_","_IENS,.01)=pIngredients . if strength'="" set TMGFDA(50.6814,"+"_recNum_","_IENS,1)=strength . if units'="" set TMGFDA(50.6814,"+"_recNum_","_IENS,2)=units . set recNum=recNum+1 if $data(TMGFDA)=0 goto EIDone do UPDATE^DIE("S","TMGFDA","TMGIEN","TMGMSG") if $data(TMGMSG("DIERR")) do goto A2VPDone . set result=0 if $get(Quiet)=1 quit . write !,"Error adding ingredients subrecord. IEN in 22706.9=",fdaIEN,! . new PriorErrorFound . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) EIDone quit result EnsureNDC(IEN) ;"Purpose: Ensure record exists in NDC/UPN file (50.67). ;"Input: IEN -- IEN from file 22706.9 (TMG FDA IMPORT COMPILED) to add from ;"Output: An entry to be added to file 50.67 ;"Result: 1=OK to continue, 0 if error ;"Make record in NDC/UPN file (50.67). ;"File: NDC/UPN Branch: 1 ;"REF NODE;PIECE FLD NUM FIELD NAME ;"=============================================================================== ;" 1 0;1 .01 SEQUENCE NUMBER [RNJ9,0aX] ;" 2 0;2 1 NDC [Fa] ;" 3 0;3 2 UPN [Fa] ;" 4 0;4 3 MANUFACTURER <-Pntr [P55.95'a] ;" 5 0;5 4 TRADE NAME [Fa] ;" 6 0;6 5 VA PRODUCT NAME <-Pntr [P50.68'a] ;" 1;0 6 ROUTE OF ADMINISTRATION W:^ D:^ <-Mult [50.676A] ;" 7 -0;1 .01 -ROUTE OF ADMINISTRATION [FaX] ;" 8 0;7 7 INACTIVATION DATE [Da] ;" 9 0;8 8 PACKAGE SIZE <-Pntr [P50.609'a] ;" 10 0;9 9 PACKAGE TYPE <-Pntr [P50.608'a] ;" 11 0;10 10 OTX/RX INDICATOR [Sa] ;" 2;0 11 PREVIOUS NDC W:^ D:^ <-Mult [50.6711A] ;" 12 -0;1 .01 -PREVIOUS NDC [Fa] ;" 3;0 12 PREVIOUS UPN W:^ D:^ <-Mult [50.6712A] ;" 13 -0;1 .01 -PREVIOUS UPN [Fa] ;" <> <> <> new result set result=0 ;" default to failure new TMGFDA,TMGMSG,TMGIEN new NDC set NDC=$piece($get(^TMG(22706.9,IEN,1)),"^",2) ;"1;2= field 5, NDC 12 digit new ndcIEN set ndcIEN=$order(^PSNDF(50.67,"NDC",NDC,"")) if +ndcIEN>0 set IENS=ndcIEN_"," goto EN1 ;"Below is for NEW records. DINUM at play here... new newIEN set newIEN="" for set newIEN=$order(^PSNDF(50.67,newIEN),-1) quit:(+newIEN=newIEN)!(newIEN="") if +newIEN=0 do write "Unable to create NDF entry for ",IEN,! goto ENDone set newIEN=newIEN+1 set TMGFDA(50.67,IENS,.01)=newIEN ;" .01 SEQUENCE NUMBER set IENS="+1," EN1 if NDC'="" set TMGFDA(50.67,IENS,1)=NDC ;"1=NDC ;"**Must add manufacturer if to be used! ;" 3 MANUFACTURER <-Pntr [P55.95'a] ;"new Firm set Firm=$get(DrugInfo("FIRM","NAME")) ;"if Firm'="" set TMGFDA(50.67,IENS,3)=Firm new tName set tName=$piece($get(^TMG(22706.9,IEN,7)),"^",3) ;"7;3 = TRADE NAME - 40 if tName'="" set TMGFDA(50.67,IENS,4)=tName ;" 4 TRADE NAME new vapIEN set vapIEN=+$piece($get(^TMG(22706.9,IEN,6)),"^",2) ;"6;2=field 5.5, VA PRODUCT LINK if vapIEN>0 set TMGFDA(50.67,IENS,5)=vapIEN;" 5 VA PRODUCT NAME --pointer to newly added 50.68 record ;" 10 OTX/RX INDICATOR new codeOTC set codeOTC=$piece($get(^TMG(22706.9,IEN,7)),"^",5) ;"7;5= field 7, RX or OTC if codeOTC'="" set TMGFDA(50.67,IENS,10)=codeOTC ;"If I decide to add this, must do it after adding parent record. ;" 1;0 6 ROUTE OF ADMINISTRATION W:^ D:^ <-Mult [50.676A] ;" 7 -0;1 .01 -ROUTE OF ADMINISTRATION [FaX] if IENS'["+" do goto EN2 ;"update existing record . new temp set temp=$$TrimFDA^TMGDBAPI(.TMGFDA) . if $data(TMGFDA)=0 quit . do FILE^DIE("K","TMGFDA","TMGMSG") ;"FDA is in INTERNAL format else do ;"add new record . do UPDATE^DIE("","TMGFDA","TMGIEN","TMGMSG") EN2 if $data(TMGMSG("DIERR")) do goto ENDone . set result=0 . new PriorErrorFound . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) set result=1 ;"ensure we are at success. ENDone quit result ;"========================================================== ;"========================================================== EnsureUnits(UnitS) ;"Purpose: to ensure that the UnitS is valid in file 50.607 ;"Input: UnitS -- the string such as "mg;mg" ;"Output: If UnitS is not found in 50.607, then it will be added ;"Results: none new TMGROOT,TMGMSG ;"Finish later... ;"do FIND^DIC(50.607,"","","",UnitS,"*",,,,"TMGROOT","TMGMSG") ;"if +$get(TMGROOT("DILIST",0))=1 goto EUDone ;"goto EUDone ;"Note: if there are duplicate entries (i.e. 2 entries for MG/0.5ML), then Y=-1 new X,Y,DIC set DIC=50.607 set DIC(0)="XML" set X=UnitS do ^DIC if +Y'>0 do . if $get(Quiet)=1 quit . write !,"Can't find or add: ",UnitS,! EUDone quit Unlock50dot607 ;"Purpose to allow deletion in file 50.607 kill ^DD(50.607,.01,8.5) kill ^DD(50.607,.01,9) quit Lock50dot607 ;"Purpose: to restore lock on file 50.607 set ^DD(50.607,.01,8.5)="^" set ^DD(50.607,.01,9)="^" quit Link2VAP ;"Purpose: to fill file 22706.9, field 5.5 in with link to a record ;" in VA PRODUCT file (50.68) that has the SAME national drug ;" code (NDC). It checks for and handles situations where there ;" are multiple entries in 50.68 with the same NDC. It picks ;" the entry with the closest name as the one to use. ;" --It also removes such a link from the VA PRODUCT SIMILAR MATCHES ;" field. I.e. it is not a 'similar' match if it is an exact match. ;" --It also removes such a link from the VA PRODUCT POSSIBLE MATCHES ;" field. I.e. it is not a 'possible' match if it is an exact match. ;"Results: none. ;"new pNDCIndex ;"set pNDCIndex=$name(^TMG("TMP","INDEX NDC-->VAP")) set pNDCIndex=$name(^PSNDF(50.67,"NDC")) new Itr,IEN,success new abort set abort=0 new modCount set modCount=0 set IEN=$$ItrInit^TMGITR(22706.9,.Itr) do PrepProgress^TMGITR(.Itr,20,0,"IEN") if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort . if $$UserAborted^TMGUSRIF set abort=1 quit . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;"1=SKIP THIS RECORD . new NDC set NDC=$piece($get(^TMG(22706.9,IEN,1)),"^",2) . if NDC="" quit ;"Can't link if no NDC. Fix later? . new count set count=$$ListCt^TMGMISC($name(@pNDCIndex@(NDC))) . new VAP set VAP=0 . if count=1 do . . new ndcP1 . . set ndcP1=+$order(@pNDCIndex@(NDC,"")) . . set VAP=+$piece($get(^PSNDF(50.67,ndcP1,0)),"^",6) . else do . . new vap1,s1,fdaS,ndcP1 . . new bestScore set bestScore=0 . . new bestVAP set bestVAP=0 . . new bestS set bestS="" . . set fdaS=$piece($get(^TMG(22706.9,IEN,0)),"^",4) ;"TradeName, field .05 . . set ndcP1=+$order(@pNDCIndex@(NDC,"")) . . for do set ndcP1=+$order(@pNDCIndex@(NDC,ndcP1)) quit:(+ndcP1'>0) . . . set vap1=+$piece($get(^PSNDF(50.67,ndcP1,0)),"^",6) . . . set s1=$piece($get(^PSNDF(50.68,vap1,0)),"^",1) . . . new tempScore set tempScore=$$Comp2Strs^TMGSTUTL(fdaS,s1) . . . if tempScore>bestScore set bestScore=tempScore,bestVAP=vap1,bestS=s1 . . if bestScore'>1 set bestVAP=0 . . set VAP=bestVAP . if VAP=0 quit . if $piece($get(^TMG(22706.9,IEN,6)),"^",2)'=VAP do . . new TMGFDA,TMGMSG . . set TMGFDA(22706.9,IEN_",",5.5)=VAP . . do FILE^DIE("K","TMGFDA","TMGMSG") . . do ShowIfDIERR^TMGDEBUG("TMGMSG") . . set modCount=modCount+1 . new subIEN set subIEN=0 . for set subIEN=$order(^TMG(22706.9,IEN,2,subIEN)) quit:(+subIEN'>0) do . . new nearVAP set nearVAP=$piece($get(^TMG(22706.9,IEN,2,subIEN,0)),"^",1) . . if nearVAP'=VAP quit . . ;"write "SIMILAR MATCH contains this link. Deleting...",! . . new TMGFDA,TMGMSG . . set TMGFDA(22706.914,subIEN_","_IEN_",",.01)="@" . . do FILE^DIE("K","TMGFDA","TMGMSG") . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) . . set modCount=modCount+1 . for set subIEN=$order(^TMG(22706.9,IEN,3,subIEN)) quit:(+subIEN'>0) do . . new nearVAP set nearVAP=$piece($get(^TMG(22706.9,IEN,3,subIEN,0)),"^",1) . . if nearVAP'=VAP quit . . ;"write "POSS SIMILAR MATCH contains this link. Deleting...",! . . new TMGFDA,TMGMSG . . set TMGFDA(22706.915,subIEN_","_IEN_",",.01)="@" . . do FILE^DIE("K","TMGFDA","TMGMSG") . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) . . set modCount=modCount+1 do ProgressDone^TMGITR(.Itr) write modCount," modifications made.",! do PressToCont^TMGUSRIF quit