TMGNDF4G ;TMG/kst/FDA Import -- Fix OQV Problems;10/15/07 ;;1.0;TMG-LIB;**1**;10/15/07 ;" FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS ;" Fixing problems with ORDER QUICK VIEW ;"Kevin Toppenberg MD ;"GNU General Public License (GPL) applies ;"10-15-2007 ;"======================================================================= ;" API -- Public Functions. ;"======================================================================= ;"(No menu -- called from ^TMGNDF4F) ;"AskFix1TMG -- ask user for entry in 22706.9 and allow editing. ;"======================================================================= ;"======================================================================= ;" Private Functions. ;"======================================================================= ;"FixOQVMissing -- fix a missing ORDER QUICK VIEW. ;"FindOQV(Prefix,RxName,RxSet,SrchRec) -- Search ORDER QUICk VIEW for RxName, and return if found ;"FindTMG(Prefix,RxName,RxSet,SrchRec,IgnoreSkipped) -- Scan 22706.9 for RxName, and return if found ;"DoFind(Prefix,RxName,FileNum,Field,SrchRec,index) -- Scam file for RxName, and return if found ;"HandleChain(array) -- Show chain and alow user editing etc. from input entry towards final part of chain (Order Quick View) ;"HandleOne(IEN10144,IEN10143,IEN50d7,IEN50,IEN22706d9,GorT) -- show the user a drug chain and allow manipulation of it ;"Hndl22706d9(IEN,RxSet,OutArray,array1,GorT) -- A brief subroutine to format 22706.9 input ;"Fmt101d43(IEN,RxSet) -- add an entry from file 101.43 to output string ;"Fmt50d7(IEN,RxSet) -- add an entry from file 50.7 to output string ;"Fmt50(IEN,RxSet) -- add an entry from file 50 to output string ;"Fmt22706d9(IEN,RxSet,s) -- add an entry from file 22706.9 to output string ;"EditTMG(IEN) -- to edit the TMG entry in 22706.9 ;"FullEDTMG(IEN) -- allow editing of any field in TMG 22706.9 ;"======================================================================= FixOQVMissing ;"Purpose: to fix a missing ORDER QUICK VIEW. I.e. add entry and ;" and interviening entries needed. ;"Input: none. new RxSet set RxSet=$$GetOQVSet^TMGNDFUT() if RxSet'>0 goto FOQVDone new RxName,SrchRec read "Enter DRUG NAME to FIND/ADD (may be partial name): ",RxName:$get(DTIME,3600),! if (RxName="")!(RxName="^") goto FOQVDone ;"do FindOQV("A. (101.44): ",RxName,RxSet,.SrchRec) ;"ORDER QUICK VIEW ;"do DoFind("B. (101.43): ",RxName,101.43,.01,.SrchRec,"B") ;"ORDERABLE ITEM ;"do DoFind("C. (50.7): ",RxName,50.7,.01,.SrchRec,"B") ;"PHARMACY ORDERABLE ITEM ;"do DoFind("D. (50): ",RxName,50,.01,.SrchRec,"B") ;"DRUG file ;"do DoFind("E. (22706.9): ",RxName,22706.9,.04,.SrchRec,"LN^C") ;"TMG FDA IMPORT COMPILED (22706.9) ;"do DoFind("",RxName,22706.9,.04,.SrchRec,"B^C^D^E^LN") ;"TMG FDA IMPORT COMPILED (22706.9) new % set %=1 write "Ignore drugs marked to be SKIPPED" do YN^DICN write ! if %=-1 goto FOQVDone do FindTMG("",RxName,RxSet,.SrchRec,(%=1)) write !,"Next, select one or more drugs that are ",! write "examples of a drug that is missing.",! do PressToCont^TMGUSRIF new Results do Slctor2^TMGUSRIF("SrchRec","Results","Pick Example(s) of Missing Drugs. [ESC][ESC] when done.") set %=1 write "Automatically Refreshing Selected Before Editing" do YN^DICN write ! if %=-1 goto FOQVDone if %=1 do RefreshChain(.Results) do HandleChain(.Results) ;"Show forward array write "Done.",! do PressToCont^TMGUSRIF FOQVDone quit AskFix1TMG ;"Purpose: ask user for entry in 22706.9 and allow editing. new DIC,X,Y,IEN22706d9 set DIC=22706.9,DIC(0)="MAEQ" do ^DIC if +Y>0 do . new array . set array($piece(Y,"^",2),+Y_"^22706.9")="" . do HandleChain(.array) quit FindOQV(Prefix,RxName,RxSet,SrchRec) ;"Purpose: look through ORDER QUICk VIEW for RxName, and return if found ;"Input: Prefix -- a string to prefix name with in index. ;" RxName -- the string of the Rx name to look for (may be a partial name) ;" RxSet -- IEN of 'ORWDSET O RX' in 101.44 ;" SrchRec -- PASS BY REFERENCE. An OUT PARAMETER. Format: ;" SrchRec(NameFound)=IEN^File# ;" SrchRec(NameFound)=IEN^File# ;"Output: SrchRec is filled. ;"Result: none new TMGDATA,TMGERR do FIND^DIC(101.442,","_RxSet_",","","M",RxName,"*","B","","","TMGDATA","TMGERR") if +$get(TMGDATA("DILIST",0))>0 do . new j,IEN,Name . set j=0 for set j=+$order(TMGDATA("DILIST",2,j)) quit:(j=0) do . . set IEN=$get(TMGDATA("DILIST",2,j)) . . set name=Prefix_$$GET1^DIQ(101.442,IEN_","_RxSet_",",".01") . . set SrchRec(name,IEN_","_RxSet_",^101.442")="" quit FindTMG(Prefix,RxName,RxSet,SrchRec,IgnoreSkipped) ;"Purpose: look through 22706.9 for RxName, and return if found ;"Input: Prefix -- a string to prefix name with in index. ;" RxName -- the string of the Rx name to look for (may be a partial name) ;" RxSet -- IEN of 'ORWDSET O RX' in 101.44 ;" SrchRec -- PASS BY REFERENCE. An OUT PARAMETER. Format: ;" SrchRec(NameFound,IEN^File#)="" ;" SrchRec(NameFound,IEN^File#)="" ;" IgnoreSkipped -- if 1 then only show drugs not marked to be SKIPPED ;"Output: SrchRec is filled. ;"Result: none new TMGDATA,TMGERR ;"do FIND^DIC(22706.9,"","","M",RxName,"*","B^C^D^E^LN","","","TMGDATA","TMGERR") do FIND^DIC(22706.9,"","","M",RxName,"*","B^C^D^LN","","","TMGDATA","TMGERR") if +$get(TMGDATA("DILIST",0))>0 do . new j,IEN,IENS,name,name1,name2,name3,TMGARRAY . set j=0 for set j=+$order(TMGDATA("DILIST",2,j)) quit:(j=0) do . . set IEN=$get(TMGDATA("DILIST",2,j)),IENS=IEN_"," . . do GETS^DIQ(22706.9,IENS,".05;.07;6;.04",,"TMGARRAY","TMGMSG") . . if IgnoreSkipped,($get(TMGARRAY(22706.9,IENS,"6"))="SKIP") quit . . set name1=$get(TMGARRAY(22706.9,IENS,".05")) . . set name2=$get(TMGARRAY(22706.9,IENS,".07")) . . set name3=$get(TMGARRAY(22706.9,IENS,".04")) . . set name=name1_" | "_name2_" | "_name3 . . set name=$extract(name,1,75) . . set SrchRec(name,IENS_"^"_"22706.9")="" quit DoFind(Prefix,RxName,FileNum,Field,SrchRec,index) ;"Purpose: look through file for RxName, and return if found ;"Input: Prefix -- a string to prefix name with in index. ;" RxName -- the string of the Rx name to look for (may be a partial name) ;" FileNum -- The file number to look in. ;" Field -- OPTIONAL. Field to return value in. Default=.01 ;" SrchRec -- PASS BY REFERENCE. An OUT PARAMETER. Format: ;" SrchRec(NameFound)=IEN^File# ;" SrchRec(NameFound)=IEN^File# ;" --NOTE: if Name has already been found, it will NOT be overwritten here. ;" index -- OPTIONAL. Index to search. Default="B" ;"Output: SrchRec is filled. ;"Result: none set Field=$get(Field,".01") set index=$get(index,"B") new TMGDATA,TMGERR do FIND^DIC(FileNum,"","","M",RxName,"*",index,"","","TMGDATA","TMGERR") if +$get(TMGDATA("DILIST",0))>0 do . new j,IEN,Name . set j=0 for set j=+$order(TMGDATA("DILIST",2,j)) quit:(j=0) do . . set IEN=$get(TMGDATA("DILIST",2,j)) . . set name=Prefix_$$GET1^DIQ(FileNum,IEN,Field) . . set SrchRec(name,IEN_"^"_FileNum)="" quit RefreshChain(array) ;"Purpose: Refresh entries in 22706.9 ;"Input: -- array: PASS BY REFERENCE. Format: ;" array(DrugName,IEN^File#)="" ;" array(DrugName,IEN^File#)="" ;" Note: it is expected that File# will be: ;" 101.44, 101.43, 50.7, 50, or 22706.9 new name,IENArray set name="" for set name=$order(array(name)) quit:(name="") do . new fInfo set fInfo="" . for set fInfo=$order(array(name,fInfo)) quit:(fInfo="") do . . new IEN,FileNum . . set FileNum=$piece(fInfo,"^",2) . . if FileNum'=22706.9 quit . . set IEN=$piece(fInfo,"^",1) . . set IENArray(+IEN)="" new Option set Option("FIX CHAIN")=1 set Option("QUIET")=1 do RefreshBatch^TMGNDF3C(.IENArray,.Option) quit HandleChain(array) ;"Show forward array ;"Purpose: Show chain from input entry towards final part of chain (Order Quick View) ;"Input: -- array: PASS BY REFERENCE. Format: ;" array(DrugName,IEN^File#)="" ;" array(DrugName,IEN^File#)="" ;" Note: it is expected that File# will be: ;" 101.44, 101.43, 50.7, 50, or 22706.9 new output,RxSet,OutArray set RxSet=$$GetOQVSet^TMGNDFUT() if RxSet'>0 goto HCnDone new IEN10144,IEN10143,IEN50d7,IEN50,IEN22706d9 new array1,array2,num new abort,rescan new name HC1 kill output,array2,array1 set name="" for set name=$order(array(name)) quit:(name="") do . new fInfo set fInfo="" . for set fInfo=$order(array(name,fInfo)) quit:(fInfo="") do . . new IEN,FileNum . . set IEN=$piece(fInfo,"^",1) . . set FileNum=$piece(fInfo,"^",2) . . if FileNum=101.44 set output=IEN . . else if FileNum=101.43 set output=$$Fmt101d43(IEN,RxSet) . . else if FileNum=50.7 set output=$$Fmt50d7(IEN,RxSet) . . else if FileNum=50 set output=$$Fmt50(IEN,RxSet) . . else if FileNum=22706.9 do . . . do Hndl22706d9(IEN,RxSet,.OutArray,.array1,"T") . . . set output=$$Fmt22706d9(IEN,RxSet,"G") . . set IEN10144=+$piece(output,"^",1) . . set IEN10143=+$piece(output,"^",2) . . set IEN50d7=+$piece(output,"^",3) . . set IEN50=+$piece(output,"^",4) . . set IEN22706d9=+$piece(output,"^",5) . . if IEN22706d9=0 quit . . set OutArray(IEN10144,IEN10143,IEN50d7,IEN50,IEN22706d9)="G" . . set array1(IEN22706d9,IEN10144_"^"_IEN10143_"^"_IEN50d7_"^"_IEN50_"^"_IEN22706d9_"^"_"G")="" ;"Now rearrange into a numbered array set num=0,IEN22706d9="" for set IEN22706d9=$order(array1(IEN22706d9)) quit:(IEN22706d9="") do . new s set s="" . for set s=$order(array1(IEN22706d9,s)) quit:(s="") do . . set num=num+1 . . set array2(num)=s ;"Now display array -- this setup will allow user to back up in list set abort=0,rescan=0,num=0 for set num=$order(array2(num)) quit:(num="")!(abort=1)!(rescan=1) do . new s set s=$get(array2(num)) . new result . set result=$$HandleOne($piece(s,"^",1),$piece(s,"^",2),$piece(s,"^",3),$piece(s,"^",4),$piece(s,"^",5),$piece(s,"^",6)) . if result="^" set abort=1 quit . else if result=-3 kill array2(num) quit . else if result=-4 set rescan=1 quit . else if result=-1 do quit . . set num=$order(array2(num),-1) . . if num>0 set num=$order(array2(num),-1) if rescan=1 goto HC1 HCnDone quit HandleOne(IEN10144,IEN10143,IEN50d7,IEN50,IEN22706d9,GorT) ;"Purpose: to show the user a drug chain and allow manipulation of it ;"Input: IEN's ;" GorT -- G or T ;"NOTE: makes use of RxSet (a variable globally scoped here) ;"Results: 1: go to next, ;" -1: go back one, ;" ^: abort, ;" -3: delete this record ;" -4: Rescan and re-setup array new input new result set result=1 H1L1 write # write "-- TMG FDA IMPORT COMPILED (22706.9) file, Record# ",IEN22706d9," [",GorT,"] -----------",! new tabCol set tabCol=50 ;"write $extract($$GET1^DIQ(22706.9,IEN22706d9_",",.04),1,48),?50," [.04;22706.9:#",IEN22706d9,"]",! write "1. ",$$GET1^DIQ(22706.9,IEN22706d9_",",.04),?tabCol," [.04; Long]",! write "2. ",$$GET1^DIQ(22706.9,IEN22706d9_",",.05),?tabCol," [.05; Trade (inclds Frm)]",! write "3. ",$$GET1^DIQ(22706.9,IEN22706d9_",",.055),?tabCol," [.055; Trade&Frm]",! write "4. ",$$GET1^DIQ(22706.9,IEN22706d9_",",.056),?tabCol," [.056; Trade,Frm,Dose,Unit]",! write "5. ",$$GET1^DIQ(22706.9,IEN22706d9_",",.07),?tabCol," [.07; Generic]",! write "6. ",$$GET1^DIQ(22706.9,IEN22706d9_",",.075),?tabCol," [.075; Genrc&Frm]",! write "7. ",$$GET1^DIQ(22706.9,IEN22706d9_",",.076),?tabCol," [.076; Generc,Frm,Dose,Unit]",! write "8. +-> [",GorT,"] ",$$GET1^DIQ(50,IEN50_",",.01),?tabCol," [50:#",IEN50,"]",! new vapIEN set vapIEN=+$piece($get(^PSDRUG(IEN50,"ND")),"^",3) if vapIEN>0 write "9. +~~~> 50.68: ",$$GET1^DIQ(50.68,vapIEN_",",.01),! write "10. +->",$$GET1^DIQ(50.7,IEN50d7_",",.01),?tabCol," [50.7:#",IEN50d7,"]",! write "11. +->",$$GET1^DIQ(101.43,IEN10143_",",.01),?tabCol," [101.43:#",IEN10143,"]",! write "12. +->",$$GET1^DIQ(101.442,IEN10144_","_RxSet_",",.01),?tabCol," [101.44:#",IEN10144,"]",! write ! write "'-'=Backward; '+'=Forward; '^'=quit;",! write "F=show FDA source; T=show Compiled record dump",! write "S=mark import to be SKIPPED'",! write "FE=Full edit of Compiled",! write "1..7=Edit Compiled, 8=Edit DRUG (50) record",! write "RC=Recompile; N=Alt Names setup; RDL=Refresh DRUG link",! read "Enter option: +// ",input,! if input="" set input="+" set input=$$UP^XLFSTR(input) if input="^" set result="^" goto HODone if input="-" set result=-1 goto HODone if input="+" set result=1 goto HODone if input="FE" do . do FullEDTMG(IEN22706d9) . set input="RDL" if (+input>0)&(+input<8) do . do EditTMG(IEN22706d9) . set input="RDL" if input="8" do . do Edit50^TMGNDFUT(IEN50) . set input="RDL" if input="9" do . do EditVAP(IEN22706d9) . set input="RDL" if input="F" do goto H1L1 . do Show1Source^TMGNDF1A(IEN22706d9) . do PressToCont^TMGUSRIF if input="T" do goto H1L1 . do DumpRec2^TMGDEBUG(22706.9,IEN22706d9,0) . do PressToCont^TMGUSRIF if input="S" do goto HODone . new Option . set Option("FIX CHAIN")=1 . set Option("FIX CHAIN","IEN22706d9")=IEN22706d9 . set Option("DELETING")=1 . set Option("QUIET")=1 . do Refresh1^TMGNDF3C(IEN22706d9,.Option) . new TMGFDA,TMGMSG . set TMGFDA(22706.9,IEN22706d9,6)=1 . do FILE^DIE("","TMGFDA","TMGMSG") . do ShowIfDIERR^TMGDEBUG(.TMGMSG) . ;"set $piece(^TMG(22706.9,IEN22706d9,1),"^",4)=1 ;"set SKIP=true . set result=-3 if input="RC" do goto H1L1 . new Option set Option("FIX CHAIN")=1 . do ReCompOne^TMGNDF1A(IEN22706d9,.Option) . do PressToCont^TMGUSRIF if input="N" do goto H1L1 . new Option set Option("FIX CHAIN")=1 . do Make1Alt^TMGNDF2G(IEN22706d9,.Option) . do PressToCont^TMGUSRIF if input="RDL" do goto HODone . new Option set Option("FIX CHAIN")=1 . set Option("FIX CHAIN","IEN22706d9")=IEN22706d9 . do Refresh1^TMGNDF3C(IEN22706d9,.Option) . set result=-4 . write "Will now rescan and setup array to detect possible changes.",! . do PressToCont^TMGUSRIF HODone quit result Hndl22706d9(IEN,RxSet,OutArray,array1,GorT) ;"Purpose: A brief subroutine to format 22706.9 input new output new IEN10144,IEN10143,IEN50d7,IEN50,IEN22706d9 set output=$$Fmt22706d9(IEN,RxSet,GorT) set IEN10144=+$piece(output,"^",1) set IEN10143=+$piece(output,"^",2) set IEN50d7=+$piece(output,"^",3) set IEN50=+$piece(output,"^",4) set IEN22706d9=+$piece(output,"^",5) if IEN22706d9=0 quit set OutArray(IEN10144,IEN10143,IEN50d7,IEN50,IEN22706d9)=GorT set array1(IEN22706d9,IEN10144_"^"_IEN10143_"^"_IEN50d7_"^"_IEN50_"^"_IEN22706d9_"^"_GorT)="" quit Fmt101d43(IEN,RxSet) ;"Purpose: to add an entry from file 101.43 to output string ;"Input: IEN -- an IEN from file 101.43 ;" RxSet -- the IEN in 101.44 of the ORWDSET O RX record ;"Result: IEN101.44^IEN101.43 new parentIEN set IEN=+$get(IEN) if IEN>0 do . set parentIEN=+$order(^ORD(101.44,RxSet,20,"B",IEN,"")) else set parentIEN=0 quit parentIEN_"^"_IEN Fmt50d7(IEN,RxSet) ;"Purpose: to add an entry from file 50.7 to output string ;"Input: IEN -- an IEN from file 50.7 ;" RxSet -- the IEN in 101.44 of the ORWDSET O RX record ;"Result: IEN101.44^IEN101.43^IEN50.7 new parentIEN set IEN=+$get(IEN) if IEN>0 do . set parentIEN=$order(^ORD(101.43,"ID",IEN_";99PSP","")) else set parentIEN=0 quit $$Fmt101d43(parentIEN,RxSet)_"^"_IEN Fmt50(IEN,RxSet) ;"Purpose: to add an entry from file 50 to output string ;"Input: IEN -- an IEN from file 50 ;" RxSet -- the IEN in 101.44 of the ORWDSET O RX record ;"Result: IEN101.44^IEN101.43^IEN50.7^IEN50 new parentIEN set IEN=+$get(IEN) if IEN>0 do . set parentIEN=+$piece($get(^PSDRUG(IEN,2)),"^",1) else set parentIEN=0 quit $$Fmt50d7(parentIEN,RxSet)_"^"_IEN Fmt22706d9(IEN,RxSet,s) ;"Purpose: to add an entry from file 22706.9 to output string ;"Input: IEN -- an IEN from file 22706.9 ;" RxSet -- the IEN in 101.44 of the ORWDSET O RX record ;" s -- "G" or "T" for Generic or Trade ;"Result: IEN101.44^IEN101.43^IEN50.7^IEN50^IEN22706.9 new parentIEN set parentIEN=0 new parentS set IEN=+$get(IEN) if IEN>0 do . if $get(s)="T" do . . set parentIEN=+$piece($get(^TMG(22706.9,IEN,7)),"^",1) ;" 7;1 DRUG TRADENAME LINK . else do . . set parentIEN=+$piece($get(^TMG(22706.9,IEN,7)),"^",2) ;" 7;2 DRUG GENERIC LINK if parentIEN>0 do . set parentS=$$Fmt50(parentIEN,RxSet) else do . set parentS="???" quit parentS_"^"_IEN ;"============================================================ EditTMG(IEN) ;"Purpose: to edit the TMG ;"do Edit1^TMGNDF1D(IEN) new Options,IENlist set IENlist(IEN)="" set Options("FILE")=22706.9 set Options("FIELDS",1)=.04 set Options("FIELDS",2)=.05 set Options("FIELDS",3)=.055 set Options("FIELDS",4)=.056 set Options("FIELDS",5)=.07 set Options("FIELDS",6)=.075 set Options("FIELDS",7)=.076 set Options("FIELDS",8)=6 set Options("FIELDS","MAX NUM")=8 new temp set temp=$$EditRecs^TMGSELED("IENlist",.Options) quit FullEDTMG(IEN) ;"Purpose: allow editing of any field in TMG new Options set Options("FILE")=22706.9 if $$GetFields^TMGSELED(.Options)=0 goto FETDone new list set list(IEN)="" new temp set temp=$$EditRecs^TMGSELED("list",.Options) FETDone quit EditVAP(IEN) ;"Purpose: to edit the TMG ;"Input: IEN -- IEN in 22706.9 new Options,IENlist set IENlist(IEN)="" set Options("FILE")=22706.9 set Options("FIELDS",1)=.04 set Options("FIELDS",1,"NO EDIT")=1 set Options("FIELDS",2)=.055 set Options("FIELDS",2,"NO EDIT")=1 set Options("FIELDS",3)=.075 set Options("FIELDS",3,"NO EDIT")=1 set Options("FIELDS",4)=.076 set Options("FIELDS",4,"NO EDIT")=1 set Options("FIELDS",5)=5.5 set Options("FIELDS","MAX NUM")=5 new temp set temp=$$EditRecs^TMGSELED("IENlist",.Options) quit