TMGDRUG ;TMG/kst/Code for setting up Drugs/Pharmacy ;03/25/06 ;;1.0;TMG-LIB;**1**;01/01/06 ;"TMG FUNCTIONS FOR SETTING UP DRUGS/PHARMACY ;"======================================================================= ;" API -- Public Functions. ;"======================================================================= ;"SetupDF -- Set up the Drug File ;"MakeExList ;"======================================================================= ;"PRIVATE API FUNCTIONS ;"======================================================================= ;"MakeSubExClass(ParentClass) ;"CodeInCode(TextCode,RefCode) ;"ClassInClass(ClassIEN,TextCode,RefClassIEN) Purpose: To return if a class is either equal to, or a child of a Ref Class ;"DrugInClass(DrugIEN,TextCode,ClassIEN Purpose: To see if a drug is in a given class ;"ShowClHeirarchy(ClassIEN) ;"GetClHeirarchy(ClassIEN,Array) ;"ShowClass(DrugIEN) ;"ShowRxInClass(ClassIEN) Purpose: to show all drugs in given class ;"IsClassNull(DrugIEN) ;"IsClassExcluded(ClassIEN) Purpose: To see is class is in an excluded class ;"TestExclusions ;"IsRxExcluded(DrugIEN) Purpose: To see if drug is in excluded catagory ;"ShowDrugs ;"ShowNCDrugs ;"ShowExDrugs ;"SURxArray Purpose: To set up the drug file such that the drugs are orderable in CPRS ;"MakePO(ShortName) ;Make a Pharmacy Orderable Item ;"======================================================================= ;"======================================================================= MakeExList ;"Purpose: To create an array of drug classes that are not desired ;"Output: Stores result in ^TMP("TMGPSExclude",*) new ClassIEN,LastClass new Backup set Backup=0 new result set result=1 set LastClass="" kill ^TMP("TMGPSExclude") new TempI set TempI=0 set ClassIEN=$order(^PS(50.605,0)) ;"file# 50.605 = VA DRUG CLASS CODE for do quit:(ClassIEN="") . if ClassIEN="" quit . new Node set Node=$get(^PS(50.605,ClassIEN,0)) . new Code set Code=$piece(Node,"^",1) . new Parent set Parent=+$piece(Node,"^",3) . if Parent=0 do quit:(ClassIEN="") . . set result=$$MakeSubExClass(ClassIEN) . . if result=0 set ClassIEN="" . if Backup=0 set ClassIEN=$order(^PS(50.605,ClassIEN)) . else set Backup=0 write "Here are the excluded IEN's from file 50.605",! zwr ^TMP("TMGPSExclude",*) write "Goodbye!",! quit MakeSubExClass(ParentClass,ChildDetail) ;"Purpose: To review the elements on one class, to see if they need to be excluded ;"Input: ParentClass -- The parent class of the class to be reviewed. ;" ChildDetail -- OPTIONAL, default=0 ;" If 1, then show children of Parent Class ;" if 0, just show ParentClass (<--Default Value) ;"Output: Stores result in ^TMP("TMGPSExclude",*) ;"Result: 1 if OK to continue, 0 if aborted. new ClassIEN,LastClass new Backup set Backup=0 set LastClass="" new result set result=1 set ChildDetail=$get(ChildDetail,0) if '$data(ParentClass) set result=0 goto MSECDone if $$IsClassExcluded(ParentClass) goto MSECDone set ClassIEN=ParentClass ;"In file order, children come after parent. for do quit:(+ClassIEN=0) ;"Cycle, looking for children. . if +ClassIEN=0 quit . new AskThisOne set AskThisOne=0 ;"default=no show . new Node set Node=$get(^PS(50.605,ClassIEN,0)) . new Code set Code=$piece(Node,"^",1) . new Class set Class=$piece(Node,"^",2) . new Parent set Parent=+$piece(Node,"^",3) . new Type set Type=$piece(Node,"^",4) . if ChildDetail=0 do ;" just show parent . . if ClassIEN=ParentClass set AskThisOne=1 . else do . . set AskThisOne=1 . . if ClassIEN=ParentClass set AskThisOne=0 ;"(don't show parent) . . if ($$ClassInClass(ClassIEN,,ParentClass)=0) do . . . set AskThisOne=0 ;"(don't show if not in parent's class) . . . set ClassIEN="" ;"as so as we get to an entry in the list that is not in parent, then we can escape . if AskThisOne do . . write "---------------------------------------------------",! . . write Class," (",Code,")",! . . write "---------------------------------------------------",! . . new ref set ref="^PS(50.605,"_i_",1)" . . do WriteWP^TMGSTUTL(ref) . . new Exclude set Exclude="" . . for do quit:(Exclude="") . . . write Class," (",Code,")",! . . . read "Exclude this drug class (and any derivative subclasses)? (? for help) NO//",Exclude:$get(DTIME,3600),! . . . if Exclude="" set Exclude="NO" . . . if Exclude["?" do quit . . . . Write "^ to abort",! . . . . write "^SUB to explore subclasses",! . . . . Write "^BACKUP to backup to previous category.",! . . . . write !,"Here is a list:",!! . . . . do ShowRxInClass(ClassIEN) . . . . write "End of list for: " . . . if Exclude="^SUB" do quit . . . . set result=$$MakeSubExClass(ClassIEN,1) . . . if Exclude="^BACKUP" do quit . . . . if LastClass'="" set ClassIEN=LastClass,Backup=1,Exclude="" . . . if Exclude="^" set ClassIEN="",Exclude="",result=0 quit . . . if '("YyYESYes"[Exclude) write ! set Exclude="" quit . . . set Exclude="" . . . write "OK... excluding.",!! . . . new TempI set TempI=$get(^TMP("TMGPSExclude",0,"Max"),0) . . . set TempI=TempI+1 . . . set ^TMP("TMGPSExclude",TempI)=ClassIEN . . . set ^TMP("TMGPSExclude",TempI,"CLASS")=Class . . . set ^TMP("TMGPSExclude",TempI,"CLASS","CODE")=Code . . . set ^TMP("TMGPSExclude",0,ClassIEN)="" . . . set ^TMP("TMGPSExclude",0,"Max")=TempI . . set LastClass=ClassIEN . if ClassIEN="" quit . if Backup=0 set ClassIEN=$order(^PS(50.605,ClassIEN)) . else set Backup=0 . if ChildDetail=0 set ClassIEN="" MSECDone quit result CodeInCode(TextCode,RefCode) ;"Purpose: To see if Text Code is in reference code ;" e.g. is AX050 "in" AX00 --> yes ;"Result: 1 = match present, 0 = no match set RefCode=$$Trim^TMGSTUTL(RefCode,"0") ;"convert AX000 -> AX new CompCode set CompCode=$extract(TextCode,1,$length(RefCode)) quit (CompCode=RefCode) ClassInClass(ClassIEN,TextCode,RefClassIEN) ;"Purpose: To return if a class is either equal to, or a child of a Ref Class ;"Input: ClassIEN: an IEN from file 50.605 to test ;" TextCode: OPTIONAL Text code for drug class, from field #2 in DRUG file #50 ;" Note: this is the text code for RefClassIEN, not for ClassIEN ;" RefClassIEN: an IEN from file 50.605 to test against ;"Results: 1 if ClassIEN=RefClassIEN, or is child of RefClassIEN ;" 0 otherwise if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"ClassInClass") new result set result=0 set TextCode=$get(TextCode) if +$get(RefClassIEN)=0 goto CICDone if +$get(ClassIEN)=0 goto CICDone new node set node=$get(^PS(50.605,ClassIEN,0)) new RefCode set RefCode=$piece(node,"^",1) if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Is Class #",ClassIEN," in Class #",RefClassIEN,"?") if ClassIEN=RefClassIEN set result=1 goto CICDone if (TextCode'="")&($$CodeInCode(TextCode,RefCode)) set result=1 goto CICDone if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"looking at node: ",node) if node'="" do . new code set code=$piece(node,"^",1) . new ParentClass set ParentClass=$piece(node,"^",3) . if ParentClass=ClassIEN set ParentClass=0 ;"I found one cyclic reference->endless loop. Avoid that. . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"parent class=",ParentClass) . if +ParentClass'=0 do . . if ParentClass=RefClassIEN set result=1 . . else do . . . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"calling recursively ClassInClass(",ParentClass,",",RefClassIEN,")") . . . set result=$$ClassInClass(ParentClass,TextCode,RefClassIEN) CICDone if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"result=",result) if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"ClassInClass") quit result DrugInClass(DrugIEN,TextCode,ClassIEN) ;"Purpose: To see if a drug is in a given class ;"Input: DrugIEN: The IEN of a drug in file#50 ;" TextCode: Text code for drug class, from field #2 in DRUG file #50 ;" ClassIEN: the IEN of a drug class in file #50.605 ;"Note: If drug is in a class that is a child of ClassIEN, then ;" the drug will be considered to be that class. ;"Result: 0 if not in class, 1 if is in class, or child of class. if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"DrugInClass") new result set result=0 if $get(DrugIEN)="" goto DICDone if $get(^PSDRUG(DrugIEN,0))="" goto DICDone if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Is Drug #",DrugIEN," in Class #",ClassIEN,"?") new node set node=$get(^PS(50.605,ClassIEN,0)) new RefCode set RefCode=$piece(node,"^",1) if $$CodeInCode(TextCode,RefCode) set result=1 goto DICDone new DrugClass set DrugClass=$piece($get(^PSDRUG(DrugIEN,"ND")),"^",6) ;"field #25,NATIONAL DRUG CLASS set result=$$ClassInClass(DrugClass,TextCode,ClassIEN) DICDone ;"write "DrugInClass result=",result,! if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"result=",result) if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"DrugInClass") quit result ShowClHeirarchy(ClassIEN) new ParentClass,indent set indent="" if (+ClassIEN'=0) for do quit:(+ClassIEN=0) . new Curnode . set Curnode=$get(^PS(50.605,ClassIEN,0)) . write indent,"Class ",ClassIEN," (",$piece(Curnode,"^",1),") ",$piece(Curnode,"^",2),! . new node set node=$get(^PS(50.605,ClassIEN,0)) . set ParentClass=$piece(node,"^",3) . if ParentClass=ClassIEN set ParentClass=0 ;"I found at least one circular ref. . set ClassIEN=ParentClass . set indent=indent_". " quit ShowClass(DrugIEN) ;"Purpose: To show a given drug's class, and parent classes new DrugClass set DrugClass=$piece($get(^PSDRUG(DrugIEN,"ND")),"^",6) new ParentClass set ParentClass=0 new TextCode,node,Name set node=$get(^PSDRUG(DrugIEN,0)) set TextCode=$piece(node,"^",2) set Name=$piece(node,"^",1) write "Drug: ",Name," [",TextCode,"]",! if (+DrugClass'=0) for do quit:(+DrugClass=0) . new Curnode . set Curnode=$get(^PS(50.605,DrugClass,0)) . write "Class (",$piece(Curnode,"^",1),") ",$piece(Curnode,"^",2),! . new node set node=$get(^PS(50.605,DrugClass,0)) . set ParentClass=$piece(node,"^",3) . if ParentClass=ClassIEN set ParentClass=0 ;"I found at least one circular ref. . set DrugClass=ParentClass else do . write "Drug class pointer is null",! . write "Free text drug class is",$piece($get(^PSDRUG(DrugIEN,0)),"^",2),! quit ShowRxInClass(ClassIEN) ;"Purpose: to show all drugs in given class new i,name set i=$order(^PSDRUG(0)) for do quit:(i="") . if i="" quit . set Name=$piece($get(^PSDRUG(i,0)),"^",1) . if Name'="" do . . new TextCode . . set TextCode=$piece($get(^PSDRUG(i,0)),"^",2) ;"field #2,VA CLASSIFICATION . . if $$DrugInClass(i,TextCode,ClassIEN)=1 write " -- ",Name,! . set i=$order(^PSDRUG(i)) SRICDone write ! quit IsClassNull(DrugIEN) ;"Purpose: to return if Drug has no assigned class new result,node,class set node=$get(^PSDRUG(DrugIEN,"ND")) set class=+$piece(node,"^",6) set result=(class=0) quit result IsClassExcluded(ClassIEN) ;"Purpose: To see is class is in an excluded class, based on exclusions stored ;" in ^TMP("TMGPSExclude") ;"Input: ClassIEN -- Class to check if excluded. ;"Result: 1 if class is in an already excluded class. new i,result set result=0 set i=$order(^TMP("TMGPSExclude",0)) if i'="" for do quit:(i="")!(result=1) . new ExClass . set ExClass=$get(^TMP("TMGPSExclude",i)) . set result=$$ClassInClass(ClassIEN,,ExClass) . set i=$order(^TMP("TMGPSExclude",i)) quit result TestExclusions new ClassIEN set ClassIEN=$order(^PS(50.605,0)) ;"file# 50.605 = VA DRUG CLASS CODE for do quit:(+ClassIEN=0) . new Node set Node=$get(^PS(50.605,ClassIEN,0)) . new Code set Code=$piece(Node,"^",1) . new Class set Class=$piece(Node,"^",2) . new Parent set Parent=+$piece(Node,"^",3) . new Type set Type=$piece(Node,"^",4) . write ClassIEN," (",Code,"): " . if $$IsClassExcluded(ClassIEN)=1 do . . write "Excluded:",! . . ;"do ShowClHeirarchy(ClassIEN) . else write "OK",! . set ClassIEN=$order(^PS(50.605,ClassIEN)) quit IsRxExcluded(DrugIEN) ;"Purpose: To see if drug is in excluded catagory ;"Input: DrugIEN -- an IEN from file #50 ;"Note: This assumes that an exclusion array has been created in ;" ^TMP("TMGPSExclude"), as setup by MakeExList() ;"Result: 1 if drug is not wanted (i.e. is excluded) ;" 0 otherwise if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"IsRxExcluded") new result set result=0 new i new TextCode set TextCode=$piece($get(^PSDRUG(DrugIEN,0)),"^",2) ;"field #2,VA CLASSIFICATION (text field) if $$IsClassNull(DrugIEN)&(TextCode="") do goto IREDone . set result=1 . write "Excluding drug #`",DrugIEN," due to null class, and empty class code.",! . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Is drug is excluded because of no assigned class") if +$get(DrugIEN)=0 goto IREDone set i=$order(^TMP("TMGPSExclude",0)) for do quit:(i="")!(result=1) . if i="" quit . new ExClass . set ExClass=$get(^TMP("TMGPSExclude",i)) . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Is drug #",DrugIEN," is class named '",^TMP("TMGPSExclude",i,"CLASS"),"'?") . set result=$$DrugInClass(DrugIEN,TextCode,ExClass) . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"The value of result returned from DrugInClass=",result) . set i=$order(^TMP("TMGPSExclude",i)) . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"next exclusion class i=",i," result=",result) IREDone ;"write "IsRxExcluded result=",result,! if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"result=",result) if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"IsRxExcluded") quit result ShowDrugs new i set i=$order(^PSDRUG(0)) for do quit:(i="") . if i="" quit . new Name . set Name=$piece($get(^PSDRUG(i,0)),"^",1) . new Class set Class=$piece($get(^PSDRUG(i,0)),"^",2) . if Name'="" do . . write $piece(Name," ",1)," -- ",Class,! . set i=$order(^PSDRUG(i)) quit ShowNCDrugs ;"Show all drugs that do not have an assigned class. new i,count set count=0 set i=$order(^PSDRUG(0)) for do quit:(i="") . if i="" quit . new Name,node . set node=$get(^PSDRUG(i,0)) . set Name=$piece(node,"^",1) . new TextCode set TextCode=$piece(node,"^",2) . new Class set Class=$piece($get(^PSDRUG(i,"ND")),"^",6) . if (Name'="")&(TextCode="")&(+Class=0) do . . write "`#",i," ",Name," -- TextCode='",TextCode,"' ClassIEN=",Class,! . . set count=count+1 . set i=$order(^PSDRUG(i)) write count," drugs with no class assigned.",! write "Goodbye.",! quit ShowExDrugs ;"Purpose: Show those members of file 50 that should be excluded new DBIndent if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"ShowExDrugs") new i write "This will show all entries in File#50 that should be excluded based",! write "on exclusion list in ^TMP(""TMGPSExclude"")",!! new Y,DIC,DIR set DIR(0)="Y",DIR("B")="NO" set DIR("A")="Store values into a Search Template (for later Fileman use)? " do ^DIR if Y=1 do . set DIC=.401 ;"SORT TEMPLATE, ^DIBT . set DIC(0)="MAQE" . do ^DIC . if +Y kill ^DIBT(+Y,1) set i=$order(^PSDRUG(0)) for do quit:(i="") . if i="" quit . new Name . set Name=$piece($get(^PSDRUG(i,0)),"^",1) . new Class set Class=$piece($get(^PSDRUG(i,0)),"^",2) . if (Name'="") do . . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Considering: ",Name) . . if ($$IsRxExcluded(i)=1) do . . . write "`",i,": ",Name," -- ",Class,! . . . if +Y do . . . . set ^DIBT(+Y,1,i)="" ;"stuff valus into SORT TEMPLATE, IEN=805 (this is a hack) . . else do . . . ;write "Not #",i," ",Name,! . set i=$order(^PSDRUG(i)) . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Next i=",i) . ;new cont read "Press Key to Continue",*cont:3600,! . ;if $char(cont)="^" set i="" if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"ShowExDrugs") write !,"goodbye...",! quit SURxArray ;"Set Up Rx array ;"Purpose: To set up the drug file such that the drugs are orderable in CPRS ;"Note: In the first part of this function, is will group similar drugs into an ;" array like this: ;" Array("SILDENAFIL",DrugIEN1)="(full drug name)" ;" Array("SILDENAFIL",DrugIEN2)="(full drug name)" ;" Array("SILDENAFIL",DrugIEN3)="(full drug name)" ;" Array("AMOXICILLIN",DrugIEN1)="(full drug name)" ;" Array("AMOXICILLIN",DrugIEN2)="(full drug name)" ;" Array("AMOXICILLIN",DrugIEN3)="(full drug name)" new DBIndent if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"SURxArray") new i new count set count=0 new Class set Class="" if $data(^TMP("TMGPSExclude"))=0 do MakeExList kill ^TMP("TMGPSUSE") set i=$order(^PSDRUG(0)) for do quit:(i="") . if i="" quit . set count=count+1 . new Name . set Name=$piece($get(^PSDRUG(i,0)),"^",1) . new temp set temp=$$UP^XLFSTR($extract(Name,1,2)) . if temp="ZZ" set Name="" . ;"new Class set Class=$piece($get(^PSDRUG(i,0)),"^",2) ;"Some bad drugs have no class--> skip . set Class="zzz" . if (Name'="")&(Class'="") do . . set Class=$piece($get(^PSDRUG(i,0)),"^",2) ;"Some bad drugs have no class--> skip . . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Considering: ",Name) . . if ($$IsRxExcluded(i)=0) do . . . ;"quit ;"temp . . . write Name," -- ",Class,! . . . new NamePiece,pi . . . for pi=1:1 do quit:(NamePiece="")!(+NamePiece>0) . . . . set NamePiece=$piece(Name," ",pi) . . . new ShortName set ShortName=$piece(Name," ",1,pi-1) . . . if ShortName'="" do . . . . write "Converted '",Name,"' --> ",ShortName,! . . . . set ^TMP("TMGPSUSE",ShortName,i)=Name . . . else write "Couldn't convert: ",Name,! . . else write "Excluded: ",Name,! . else if (Name'="") write "Skipped `",i," due to no class: ",Name," class=[",Class,"]",! . set i=$order(^PSDRUG(i)) . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Next i=",i) if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"SURxArray") write "Processed ",count," records.",! write "Done. Goodbye.",! quit MakePO(ShortName) ;Make a Pharmacy Orderable Item ;"Purpose: To take one entry from the Rx Array (as set up by SURxArray) ;" and create a fully linked PHARMACY ORDERABLE ITEM entry (File 50.7). ;"Note: When the PHARMACY ORDERABLE ITEM record is created, records that match ;" are also created in the ORDERABLE ITEM file (101.43), and the QUICK VIEW ;" file (101.44)--although the display text in the QUICK VIEW file must be set. ;"Steps: 1.