PSJCLOZ ; DAL/RJS - INPATIENT CLOZAPINE ORDER CHECK ;12 June 2019 11:36:51
;;5.0;INPATIENT MEDICATIONS ;**327**;01 DEC 15;Build 114
;
CLOZ(DFN,DRUG) ;
; DFN is patient IEN, DRUG is drug file (#50) IEN
I '($G(DFN)>0)!'($G(DRUG)>0) S ANQX=0 Q
D PROVCHK($G(PSGPR)) Q:ANQX
N RTN
S RTN=$$GET1^DIQ(50,DRUG,17.5)
D:$L(RTN) ^@RTN
Q
;
PROVCHK(PROV) ;
N PSJQUIT
;
S (ANQX,PSJQUIT)=0
I $G(PROV) D
.I '$L($$DEA^XUSER(,PROV)) D
..S (ANQX,PSJQUIT)=1
..W !," ",!,"*** Provider must have a DEA# or VA# to write prescriptions for this drug."
. Q:PSJQUIT
.I '$$FIND1^DIC(200.051,","_PROV_",","X","YSCL AUTHORIZED") D
..S (ANQX,PSJQUIT)=1
..W !," ",!,$$CLKEYWRN^PSOCLUTL
Q
BEFQUIT ;
Q:'$G(QOAA)
N QODS,QORF,ORMAX,ORCLPAT
S QODS=$$FIND1^DIC(101.41,,"X","OR GTX DAYS SUPPLY","AB") Q:'QODS
S QODS=$$FIND1^DIC(101.416,","_ORX_",","Q",QODS,"D") Q:'QODS
S QODS=$$GET1^DIQ(101.416,QODS_","_ORX,.01)
S QORF=$$FIND1^DIC(101.41,,"X","OR GTX REFILLS","AB") Q:'QORF
S QORF=$$FIND1^DIC(101.416,","_ORX_",","Q",QORF,"D") Q:'QORF
S QORF=$$GET1^DIQ(101.416,QORF_","_ORX,.01)
S QORF=QORF+1
S ORCLPAT=$P(ORYS,U,7)
S ORMAX=$S(ORCLPAT="M":28,ORCLPAT="B":14,ORCLPAT="W":7,1:90)
I QORF*QODS>ORMAX D
.K ORY
.S ORY=1_U_ORCLOZ
.W !,?5,"Problem Ordering Clozapine Related Medication"_U_ORCLOZ
.W !,?5,"*** This patient is only allowed an order with a maximum Days Supply of "_ORMAX_"."
.W !,?5,"This includes the amounts added by any refills entered in with the order also."
Q
OVERRIDE ;
I '$$FIND1^DIC(200.051,","_PROV_",","X","PSOLOCKCLOZ") D Q 1
.N Y
.W !," ",!," *** You are not authorized to override Clozapine orders.",!," "
.K DIR S DIR(0)="E",DIR("A")="Press Return to Continue..." D ^DIR K DIR W @IOF
Q
PSJFILE(DFN) ;
S PSJCLPAT=DFN
N PSJORN,PSJORDER I $G(PSJCOM) D Q
.I $G(PSGODA),$O(^TMP("PSJCOM",$J,PSGODA))'="" Q ; Put into the file 53.8 just at the end
.N PSJORD1 S PSJORD1=""
.F S PSJORD1=$O(^TMP("PSJCOM",$J,PSJORD1)) Q:'PSJORD1 D
..S ANQDATA=$G(^TMP("PSJCOM",$J,PSJORD1,"ANQDATA")) Q:'$L(ANQDATA)
..S PSJORN=+$P(^TMP("PSJCOM",$J,PSJORD1,0),"^",21)
..D PSJFILE1
PSJFILE1 ;
I $D(ANQDATA) D
.F D NOW^%DTC I '$D(^PS(53.8,"B",%)) S NOW=% Q
.S PSJPROV=$P(ANQDATA,"^",2),PSJ1PH=$P(ANQDATA,"^"),PSJ2PH=$P(ANQDATA,"^",5)
.S PSJREASN=$P(ANQDATA,"^",3),PSJREMRK=$P(ANQDATA,"^",4)
.I $G(ORO) S PSJPROV=$P(ORO,"^",4)
.S:'$G(PSJORN)&$G(ORO) PSJORN=+ORO
.S PSJORDER("PSJORN")=PSJORN
.K DD,DO S DIC="^PS(53.8,",DIC(0)="L",DLAYGO=53.8,X=NOW
.D FILE^DICN K DIC,DLAYGO,DD,DO,DA,DR
.N PS538 S (PS538,DA)=+Y,DIE="^PS(53.8,",DR="1////^S X=PSJORDER(""PSJORN"")"_";3////^S X=PSJPROV;2////^S X=PSJ1PH;4////^S X=PSJREASN;5////^S X=PSJREMRK;6////^S X=PSJ2PH"
.D ^DIE K DIE,DA,DR
.S XMY(PSJPROV)="",XMY(PSJ2PH)=""
.K ANQDATA,X,Y,%,ANQREM
.W !,"THE OVERRIDDEN ORDER IS COMPLETE",!
.D ALERT
Q
ALERT ; send an alert to the TWO approving team members
N RSLT
S XQADATA=PSCLPAT ;
S PSOLAST4=$E($$GET1^DIQ(2,PSCLPAT,.09),6,9)
S XQAARCH=1,XQAFLG="D"
S XQA(PSJ2PH)="",XQA(PSJPROV)="",PSCDATE=$$FMTE^XLFDT($$NOW^XLFDT)
S XQAMSG=$$GET1^DIQ(2,PSCLPAT,.01)_" ("_PSOLAST4_")"_" : Clozapine Override Rx Processed: "_PSCDATE
S XQAID="PSI"_","_PSCLPAT
S RSLT=$$SETUP1^XQALERT
W !!,"OVERRIDE ALERTS HAVE BEEN SENT TO THE APPROVING TEAM MEMBERS",!!
Q
;
READ ;
S CLOZPAT=$P($P(XQX,"patient ",2)," BY",1)
S DIR("A")="Do you concur with the requested override for "_CLOZPAT,DIR(0)="Y",DIR("B")="N" D ^DIR G END:$D(DIRUT) K DIR D:'Y!($D(DIRUT)) END
Q
TDD ; TOTAL DAILY DOSE INPUT
D
.S DIR(0)="N^12.5:3000:1",DIR("A")="CLOZAPINE dosage (mg/day) ? " D ^DIR K DIR I $D(DIRUT) S (ANQX,PSGORQF)=1 Q
.S:+$G(PSJEDITO) PSGETDD=X
.S:+$G(PSGCOPY) PSGCTDD=X
.S PSOSAND=X
Q
ORD ;
S PSGDRG=PSJDD
I $$GET1^DIQ(50,+$G(PSGDRG),17.5)="PSOCLO1" D CLOZ(PSGP,PSGDRG) I $G(ANQX) S PSGORQF=1
END ;
K DIRUT,DIROUT,DIR
Q
;
CMPLX ;COMPLEX THEN ORDER LOGIC
Q:'$$GET1^DIQ(53.1,+$G(PSGORD),125,"I")
Q:+$G(PSGCOPY)
D CLOZPAT,ANDTHEN
Q:$G(PSGTYP)="A"
I $D(PSGTYP),'$D(^TMP("PSGCPLX",$J,DFN,+$G(PSGORD))) S ^TMP("PSGCPLX",$J,DFN,+$G(PSGORD))=PSGSD,PSGCOMP=1
Q
CMPLX2 ;SECOND COMPLEX THEN ORDER LOGIC
Q:'$$GET1^DIQ(53.1,+$G(PSGORD),125,"I")
Q:+$G(PSGCOPY)
D CLOZPAT,ANDTHEN
I $G(PSGTYP)="A"!($G(PSGTYP)="AT") Q
I $D(^TMP("PSGCPLX",$J,DFN)) D
.I $O(^TMP("PSGCPLX",$J,DFN,0)) S PSGTMP=$O(^TMP("PSGCPLX",$J,DFN,0))
.I +$G(PSGTMP)'=+$G(PSGORD) D
..S $P(PSGRDTX,U,1)=$G(^TMP("PSGCPLX",$J,DFN,PSGTMP))
..I $G(PSGRDTX(+$G(PSJORD),"PSGSD"))=+$G(PSGRDTX)
..N X,X1,X2 S X1=+$G(PSGRDTX),X2=$S($G(CLOZPAT)=2:28,$G(CLOZPAT)=1:14,$G(CLOZPAT)=0:7,$G(CLOZPAT)=3:4,1:90)
..D C^%DTC S PSGFD=X,PSGFDN=$$ENDD^PSGMI(PSGFD)_"^"_$$ENDTC^PSGMI(PSGFD)
Q
CMPLX3 ;SECOND COMPLEX THEN ORDER LOGIC
Q:'$$GET1^DIQ(53.1,+$G(PSGORD),125,"I")
I PSGSTAT="NON-VERIFIED" D DISPCMP(PSGORD,PSGFD) D Q
.I $G(PSSD) S PSGFD=PSSD,PSGFDN=$$ENDD^PSGMI(PSGFD)_"^"_$$ENDTC^PSGMI(PSGFD) K PSSD
D CLOZPAT,ANDTHEN
I $G(PSGTYP)="T"!($G(PSGTYP)="TA") Q
N X,X1,X2 S X1=+$G(PSGRDTX),X2=$S($G(CLOZPAT)=2:28,$G(CLOZPAT)=1:14,$G(CLOZPAT)=0:7,$G(CLOZPAT)=3:4,1:90)
D C^%DTC S PSGFD=X,PSGFDN=$$ENDD^PSGMI(PSGFD)_"^"_$$ENDTC^PSGMI(PSGFD)
Q
CLOZPAT ;VERIFY PATIENT IS A CLOZAPINE PATIENT
K CLOZPAT
I $L($$GET1^DIQ(55,DFN,53)),$$GET1^DIQ(55,DFN,54,"I")'="D" D
.I $$GET1^DIQ(55,DFN,53)?1U6N S CLOZPAT=3 Q
.N CLOZNUM,CLOZUID
.S CLOZNUM=$$GET1^DIQ(55,DFN,53) Q:CLOZNUM=""
.S CLOZUID=$$FIND1^DIC(603.01,,"X",CLOZNUM) Q:'CLOZUID
.S CLOZPAT=$$GET1^DIQ(603.01,CLOZUID,2,"I")
.S CLOZPAT=$S($G(CLOZPAT)="M":2,$G(CLOZPAT)="B":1,$G(CLOZPAT)="W":0,1:90)
Q
ANDTHEN ;COMPLEX AND/THEN ORDER
Q:'$$GET1^DIQ(53.1,+$G(PSGORD),125,"I")
Q:+$G(PSGCOPY)
N PSGTMP,PSGID S PSGTMP=+$$GET1^DIQ(53.1,+$G(PSGORD),125,"I"),PSGTYP=""
S PSGID=$$FIND1^DIC(100.045,","_PSGTMP_",","X","CONJ","ID") I PSGID D
.S PSGTYP=PSGTYP_$$GET1^DIQ(100.045,PSGID_","_PSGTMP,1)
Q
DISPCMP(PSGORD,PSSD) ;COMPLEX ORDER CHECK
Q:'$$GET1^DIQ(53.1,+$G(PSGORD),125,"I")
S PSSD=+$$GET1^DIQ(53.1,+$G(PSGORD),117,"I")
Q
EXTDT ;VERIFY EXTERNAL DATE
Q
;
MSG1 ;
W !!,"Permission to dispense clozapine has been denied. The results of the latest",!
W "Lab Test drawn in the past 7 days show ANC results but No Matching WBC.",!
W "If you wish to dispense outside the FDA and VA protocol ANC limits,",!
W "document your request to Request for Override of Pharmacy Lockout ",!
W "(from VHA Handbook 1160.02) Director of the",!
W "VA National Clozapine Coordinating Center",!
W "(Phone: 214-857-0068 Fax: 214-857-0339) for a one-time override permission.",!
W !,"No order entered!"
S ANQX=1
Q
MSG2 ;
W !!,"Permission to dispense clozapine has been denied. The results of the latest",!
W "Lab Test drawn in the past 7 days show No ANC results. If you wish to dispense",!
W "outside the FDA and VA protocol ANC limits, document your request to Request",!
W "for Override of Pharmacy Lockout (from VHA Handbook 1160.02) Director of the",!
W "VA National Clozapine Coordinating Center",!
W "(Phone: 214-857-0068 Fax: 214-857-0339) for a one-time override permission.",!
W !,"No order entered!"
S ANQX=1
Q
MSG3 ;
W !,"A CBC/Differential including ANC Must Be Ordered and Monitored on a",!
W "Daily basis until the ANC above 1000/mm3 with no signs of infection.",!
W "If ANC is between 1000-1499, therapy can be continued but physician must order",!
W "lab test three times weekly."
Q
MSG4 ;
W !,"Permission to dispense clozapine has been denied. If the results of the latest"
W !,"Lab Test drawn in the past 7 days show ANC below 1000/mm3 and you wish to"
W !,"dispense outside the FDA and VA protocol ANC limits, document your request to"
W !,"Request for Override of Pharmacy Lockout (from VHA Handbook 1160.02)"
W !,"Director of the VA National Clozapine Coordinating Center"
W !,"(Phone: 214-857-0068 Fax: 214-857-0339) for a one-time override permission.",!
S ANQX=1
Q
MSG5 ;
W !!,"Permission to dispense clozapine has been denied. Please contact the"
W !,"Director of the VA National Clozapine Coordinating Center"
W !!,"Request for Override of Pharmacy Lockout (from VHA Handbook 1160.02)"
W !,"(Phone: 214-857-0068 Fax: 214-857-0339).",!
Q
MSG6 ; MSG 6 added for new critically low ANC levels clozapine override requirements
W !!,"This clozapine drug may not be dispensed to the patient at this time based on the available lab tests related to the clozapine treatment program."
W !!,"Please contact the NCCC to request an override in order to proceed with dispensing this drug. "
W !!,"Request for Override of Pharmacy Lockout (from VHA Handbook 1160.02)"
W !!,"The matching ANC counts which caused the lockout are of lab test results performed on "
S ANQX=1,Y=$P(PSOYS,"^",6) X ^DD("DD") W $P(Y,"@")
W !!,?5,"ANC: "_$P(PSOYS,"^",4),!
Q
MSG9 ;
W !,"*** Permission to dispense clozapine has been denied based on the available"
W !," lab tests related to the clozapine treatment program. ***"
W !!,"For a National Override to dispense at the patient's normal frequency,"
W !,"please contact the VA National Clozapine Coordinating Center to request"
W !,"an Override of Pharmacy Lockout (from VHA Handbook 1160.02)"
W !,"(Phone: 214-857-0068 Fax: 214-857-0339)."
W !,"A Special Conditions Local Override can be approved for"
W !,"(1) weather-related conditions, (2) mail order delays of clozapine, or"
W !,"(3) inpatient going on leave. With Provider's documentation of approval,"
W !,"you may dispense a one-time supply not to exceed 4 days.",!
Q
;
;/RBN Begin of modifications for new message for IP 4 day overrride.
MSG10 ;
W !,"*** Permission to dispense clozapine has been denied based on the available"
W !," lab tests related to the clozapine treatment program. ***"
W !!,"For a National Override to dispense at the patient's normal frequency,"
W !,"please contact the VA National Clozapine Coordinating Center to request an"
W !,"Override of Pharmacy Lockout (from VHA Handbook 1160.02) (Phone: 214-857-0068"
W !,"Fax: 214-857-0339)."
W !,"A Special Conditions Local Override for Inpatients can be approved for an"
W !,"IP Override Order with Outside Lab Results. With Provider's documentation of"
W !,"approval, you may dispense a one-time IP supply not to exceed 4 days."
W !,"The ANC from another facility must be recorded in the Progress note/comments"
W !,"in pharmacy"
Q
;/RBN End of modifications for new message for IP 4 day overrride.
; ** END NCC REMEDIATION ** 457 AND PSJ 327/RTW
;
COMPLEX ; Display Complex Order stop date warning message <<RJS
Q:$G(PSGFLG)
Q:'$$GET1^DIQ(53.1,+$G(PSGORD),125,"I")
N PSGFDT ;,PSGSD,PSGYS,X,X1,X2
D CLOZPAT
S X1=+$G(PSGSD),X2=$S($G(CLOZPAT)=2:28,$G(CLOZPAT)=1:14,$G(CLOZPAT)=0:7,$G(CLOZPAT)=3:4,1:90)
D C^%DTC S PSGFDT=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
W !!,?25,"* WARNING *",!!,?10,"This order contains a requested duration."
W !,?8,"Please review the system calculated stop date",!,?5,"to confirm that it is within the allowable duration"
W !,?13,"of the order based on the patient's",!,?11,"authorized clozapine dispense frequency.",!
W !,?10,"Order stop date should not exceed ",PSGFDT,!,!,?1,"Review the entire profile to determine appropriate action(s).",!
K PSGCOMP D PAUSE^VALM1 S PSGFLG=1
Q
COMPLEX1 ; Display Complex Order stop date warning message <<RJS
Q:$G(PSGFLG)
Q:'$$GET1^DIQ(53.1,+$G(PSGORD),125,"I")
N PSGFDT,MSG
D:'$D(CLOZPAT) CLOZPAT
S X1=+$G(PSGSD),X2=$S($G(CLOZPAT)=2:28,$G(CLOZPAT)=1:14,$G(CLOZPAT)=0:7,$G(CLOZPAT)=3:4,1:90)
D C^%DTC S PSGFDT=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
S MSG=$J("",25)_"* WARNING *" D INSTR^VALM1("",1,9,80,1),INSTR^VALM1(MSG,1,10,80,1)
S MSG=$J("",10)_"This order contains a requested duration." D INSTR^VALM1(MSG,1,11,80,1)
S MSG=$J("",8)_"Please review the system calculated stop date" D INSTR^VALM1(MSG,1,12,80,1)
S MSG=$J("",5)_"to confirm that it is within the allowable duration" D INSTR^VALM1(MSG,1,13,80,1)
S MSG=$J("",13)_"of the order based on the patient's" D INSTR^VALM1(MSG,1,14,80,1)
S MSG=$J("",11)_"authorized clozapine dispense frequency." D INSTR^VALM1(MSG,1,15,80,1)
S MSG=$J("",10)_"Order stop date should not exceed "_PSGFDT D INSTR^VALM1(MSG,1,17,80,1)
S MSG=" Review the entire profile to determine appropriate action(s)." D INSTR^VALM1(MSG,1,18,80,1)
N LN F LN=16,19 D INSTR^VALM1("",1,LN,80,1)
K PSGCOMP D PAUSE^VALM1 S PSGFLG=1
Q
LASTCHLD(DFN,ON) ; Last child of Complex order or not
N FL,PSORDA,PSORD1 I ON'["U",ON'["V" Q 1
I ON["U" D Q:'PSORDA 1 Q:'PSORD1 1 Q 0
.S PSORDA=$$GET1^DIQ(55.06,+ON_","_DFN,125,"I"),PSORD1=+$$GET1^DIQ(55.06,+ON_","_DFN,66,"I")
.I 'PSORDA!'PSORD1 Q
.N ORARR,MAX D LIST^DIC(100.002,","_PSORDA_",",,"I",,,,,,,"ORARR") S MAX=+ORARR("DILIST",0)
.F I=1:1 Q:'$D(ORARR("DILIST",2,I)) I ORARR("DILIST",2,I)=PSORD1 Q
.S:I=MAX PSORD1=0 Q
I ON["V" D Q:'PSORDA 1 Q:'PSORD1 1 Q 0
.S PSORDA=$$GET1^DIQ(55.01,+ON_","_DFN,150,"I"),PSORD1=+$$GET1^DIQ(55.01,+ON_","_DFN,110,"I")
.I 'PSORDA!'PSORD1 Q
.N ORARR,MAX D LIST^DIC(100.002,","_PSORDA_",",,"I",,,,,,,"ORARR") S MAX=+ORARR("DILIST",0)
.F I=1:1 Q:'$D(ORARR("DILIST",2,I)) I ORARR("DILIST",2,I)=PSORD1 Q
.S:I=MAX PSORD1=0 Q
Q 1
;
ISCLOZ(PSGORD,ORPSOI,DFN,PSGORDNM,PSGDRG) ; Define a clozapine order and associated drug
; PSGORD - Pending Order number (file 53.1)
; ORPSOI - ID containing Pharmacy Orderable Item number (file 50.7)
; DFN - Patient ID (file 2)
; PSGORDNM - Pharmacy order number (file 55)
; PSGDRG - Drug Code
; OROI - Orderable Item number (file 101.43)
N ISCLOZ S ISCLOZ=0
I $G(PSGORD) D Q ISCLOZ
.I '$$GET1^DIQ(53.1,PSGORD,.01,"I") Q
.S PSGDRG=$$GET1^DIQ(53.11,"1,"_+PSGORD,.01,"I") I PSGDRG D Q
..I $$GET1^DIQ(50,+$G(PSGDRG),17.5)="PSOCLO1" S ISCLOZ=1_U_PSGDRG
.N ORPSOI S ORPSOI=$$GET1^DIQ(53.1,PSGORD,108,"I") I 'ORPSOI Q
.D CLOZPSOI(+ORPSOI)
I $G(ORPSOI) D CLOZPSOI(+ORPSOI) Q ISCLOZ
I $G(DFN),$G(PSGORDNM) D Q ISCLOZ
.S PSGDRG=$$GET1^DIQ(55.07,"1,"_PSGORDNM_","_DFN,.01,"I") I PSGDRG D Q
..I $$GET1^DIQ(50,+$G(PSGDRG),17.5)="PSOCLO1" S ISCLOZ=1_U_PSGDRG
.N ORPSOI S ORPSOI=$$GET1^DIQ(55.06,PSGORDNM_","_DFN,108,"I") I 'ORPSOI Q
.D CLOZPSOI(+ORPSOI)
;
I $G(PSGDRG)>0,$$GET1^DIQ(50,$G(PSGDRG),17.5)="PSOCLO1" S ISCLOZ=1_U_PSGDRG
Q ISCLOZ
;
CLOZPSOI(ORPSOI) ; Define a clozapine order based on Pharmacy Orderable item
N ARR,PSGDRG,CLOZFLG D FIND^DIC(50,,.01,"Q",ORPSOI,,"ASP",,,"ARR")
N I F I=2:1 Q:'$D(ARR("DILIST",2,I)) S PSGDRG=+$G(ARR("DILIST",2,I)) D Q:ISCLOZ
.I $$GET1^DIQ(50,PSGDRG,17.5)="PSOCLO1" S ISCLOZ=1_U_PSGDRG
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJCLOZ 14761 printed Apr 09, 2024@21:09:33 Page 2
PSJCLOZ ; DAL/RJS - INPATIENT CLOZAPINE ORDER CHECK ;12 June 2019 11:36:51
+1 ;;5.0;INPATIENT MEDICATIONS ;**327**;01 DEC 15;Build 114
+2 ;
CLOZ(DFN,DRUG) ;
+1 ; DFN is patient IEN, DRUG is drug file (#50) IEN
+2 IF '($GET(DFN)>0)!'($GET(DRUG)>0)
SET ANQX=0
QUIT
+3 DO PROVCHK($GET(PSGPR))
if ANQX
QUIT
+4 NEW RTN
+5 SET RTN=$$GET1^DIQ(50,DRUG,17.5)
+6 if $LENGTH(RTN)
DO ^@RTN
+7 QUIT
+8 ;
PROVCHK(PROV) ;
+1 NEW PSJQUIT
+2 ;
+3 SET (ANQX,PSJQUIT)=0
+4 IF $GET(PROV)
Begin DoDot:1
+5 IF '$LENGTH($$DEA^XUSER(,PROV))
Begin DoDot:2
+6 SET (ANQX,PSJQUIT)=1
+7 WRITE !," ",!,"*** Provider must have a DEA# or VA# to write prescriptions for this drug."
End DoDot:2
+8 if PSJQUIT
QUIT
+9 IF '$$FIND1^DIC(200.051,","_PROV_",","X","YSCL AUTHORIZED")
Begin DoDot:2
+10 SET (ANQX,PSJQUIT)=1
+11 WRITE !," ",!,$$CLKEYWRN^PSOCLUTL
End DoDot:2
End DoDot:1
+12 QUIT
BEFQUIT ;
+1 if '$GET(QOAA)
QUIT
+2 NEW QODS,QORF,ORMAX,ORCLPAT
+3 SET QODS=$$FIND1^DIC(101.41,,"X","OR GTX DAYS SUPPLY","AB")
if 'QODS
QUIT
+4 SET QODS=$$FIND1^DIC(101.416,","_ORX_",","Q",QODS,"D")
if 'QODS
QUIT
+5 SET QODS=$$GET1^DIQ(101.416,QODS_","_ORX,.01)
+6 SET QORF=$$FIND1^DIC(101.41,,"X","OR GTX REFILLS","AB")
if 'QORF
QUIT
+7 SET QORF=$$FIND1^DIC(101.416,","_ORX_",","Q",QORF,"D")
if 'QORF
QUIT
+8 SET QORF=$$GET1^DIQ(101.416,QORF_","_ORX,.01)
+9 SET QORF=QORF+1
+10 SET ORCLPAT=$PIECE(ORYS,U,7)
+11 SET ORMAX=$SELECT(ORCLPAT="M":28,ORCLPAT="B":14,ORCLPAT="W":7,1:90)
+12 IF QORF*QODS>ORMAX
Begin DoDot:1
+13 KILL ORY
+14 SET ORY=1_U_ORCLOZ
+15 WRITE !,?5,"Problem Ordering Clozapine Related Medication"_U_ORCLOZ
+16 WRITE !,?5,"*** This patient is only allowed an order with a maximum Days Supply of "_ORMAX_"."
+17 WRITE !,?5,"This includes the amounts added by any refills entered in with the order also."
End DoDot:1
+18 QUIT
OVERRIDE ;
+1 IF '$$FIND1^DIC(200.051,","_PROV_",","X","PSOLOCKCLOZ")
Begin DoDot:1
+2 NEW Y
+3 WRITE !," ",!," *** You are not authorized to override Clozapine orders.",!," "
+4 KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to Continue..."
DO ^DIR
KILL DIR
WRITE @IOF
End DoDot:1
QUIT 1
+5 QUIT
PSJFILE(DFN) ;
+1 SET PSJCLPAT=DFN
+2 NEW PSJORN,PSJORDER
IF $GET(PSJCOM)
Begin DoDot:1
+3 ; Put into the file 53.8 just at the end
IF $GET(PSGODA)
IF $ORDER(^TMP("PSJCOM",$JOB,PSGODA))'=""
QUIT
+4 NEW PSJORD1
SET PSJORD1=""
+5 FOR
SET PSJORD1=$ORDER(^TMP("PSJCOM",$JOB,PSJORD1))
if 'PSJORD1
QUIT
Begin DoDot:2
+6 SET ANQDATA=$GET(^TMP("PSJCOM",$JOB,PSJORD1,"ANQDATA"))
if '$LENGTH(ANQDATA)
QUIT
+7 SET PSJORN=+$PIECE(^TMP("PSJCOM",$JOB,PSJORD1,0),"^",21)
+8 DO PSJFILE1
End DoDot:2
End DoDot:1
QUIT
PSJFILE1 ;
+1 IF $DATA(ANQDATA)
Begin DoDot:1
+2 FOR
DO NOW^%DTC
IF '$DATA(^PS(53.8,"B",%))
SET NOW=%
QUIT
+3 SET PSJPROV=$PIECE(ANQDATA,"^",2)
SET PSJ1PH=$PIECE(ANQDATA,"^")
SET PSJ2PH=$PIECE(ANQDATA,"^",5)
+4 SET PSJREASN=$PIECE(ANQDATA,"^",3)
SET PSJREMRK=$PIECE(ANQDATA,"^",4)
+5 IF $GET(ORO)
SET PSJPROV=$PIECE(ORO,"^",4)
+6 if '$GET(PSJORN)&$GET(ORO)
SET PSJORN=+ORO
+7 SET PSJORDER("PSJORN")=PSJORN
+8 KILL DD,DO
SET DIC="^PS(53.8,"
SET DIC(0)="L"
SET DLAYGO=53.8
SET X=NOW
+9 DO FILE^DICN
KILL DIC,DLAYGO,DD,DO,DA,DR
+10 NEW PS538
SET (PS538,DA)=+Y
SET DIE="^PS(53.8,"
SET DR="1////^S X=PSJORDER(""PSJORN"")"_";3////^S X=PSJPROV;2////^S X=PSJ1PH;4////^S X=PSJREASN;5////^S X=PSJREMRK;6////^S X=PSJ2PH"
+11 DO ^DIE
KILL DIE,DA,DR
+12 SET XMY(PSJPROV)=""
SET XMY(PSJ2PH)=""
+13 KILL ANQDATA,X,Y,%,ANQREM
+14 WRITE !,"THE OVERRIDDEN ORDER IS COMPLETE",!
+15 DO ALERT
End DoDot:1
+16 QUIT
ALERT ; send an alert to the TWO approving team members
+1 NEW RSLT
+2 ;
SET XQADATA=PSCLPAT
+3 SET PSOLAST4=$EXTRACT($$GET1^DIQ(2,PSCLPAT,.09),6,9)
+4 SET XQAARCH=1
SET XQAFLG="D"
+5 SET XQA(PSJ2PH)=""
SET XQA(PSJPROV)=""
SET PSCDATE=$$FMTE^XLFDT($$NOW^XLFDT)
+6 SET XQAMSG=$$GET1^DIQ(2,PSCLPAT,.01)_" ("_PSOLAST4_")"_" : Clozapine Override Rx Processed: "_PSCDATE
+7 SET XQAID="PSI"_","_PSCLPAT
+8 SET RSLT=$$SETUP1^XQALERT
+9 WRITE !!,"OVERRIDE ALERTS HAVE BEEN SENT TO THE APPROVING TEAM MEMBERS",!!
+10 QUIT
+11 ;
READ ;
+1 SET CLOZPAT=$PIECE($PIECE(XQX,"patient ",2)," BY",1)
+2 SET DIR("A")="Do you concur with the requested override for "_CLOZPAT
SET DIR(0)="Y"
SET DIR("B")="N"
DO ^DIR
if $DATA(DIRUT)
GOTO END
KILL DIR
if 'Y!($DATA(DIRUT))
DO END
+3 QUIT
TDD ; TOTAL DAILY DOSE INPUT
+1 Begin DoDot:1
+2 SET DIR(0)="N^12.5:3000:1"
SET DIR("A")="CLOZAPINE dosage (mg/day) ? "
DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET (ANQX,PSGORQF)=1
QUIT
+3 if +$GET(PSJEDITO)
SET PSGETDD=X
+4 if +$GET(PSGCOPY)
SET PSGCTDD=X
+5 SET PSOSAND=X
End DoDot:1
+6 QUIT
ORD ;
+1 SET PSGDRG=PSJDD
+2 IF $$GET1^DIQ(50,+$GET(PSGDRG),17.5)="PSOCLO1"
DO CLOZ(PSGP,PSGDRG)
IF $GET(ANQX)
SET PSGORQF=1
END ;
+1 KILL DIRUT,DIROUT,DIR
+2 QUIT
+3 ;
CMPLX ;COMPLEX THEN ORDER LOGIC
+1 if '$$GET1^DIQ(53.1,+$GET(PSGORD),125,"I")
QUIT
+2 if +$GET(PSGCOPY)
QUIT
+3 DO CLOZPAT
DO ANDTHEN
+4 if $GET(PSGTYP)="A"
QUIT
+5 IF $DATA(PSGTYP)
IF '$DATA(^TMP("PSGCPLX",$JOB,DFN,+$GET(PSGORD)))
SET ^TMP("PSGCPLX",$JOB,DFN,+$GET(PSGORD))=PSGSD
SET PSGCOMP=1
+6 QUIT
CMPLX2 ;SECOND COMPLEX THEN ORDER LOGIC
+1 if '$$GET1^DIQ(53.1,+$GET(PSGORD),125,"I")
QUIT
+2 if +$GET(PSGCOPY)
QUIT
+3 DO CLOZPAT
DO ANDTHEN
+4 IF $GET(PSGTYP)="A"!($GET(PSGTYP)="AT")
QUIT
+5 IF $DATA(^TMP("PSGCPLX",$JOB,DFN))
Begin DoDot:1
+6 IF $ORDER(^TMP("PSGCPLX",$JOB,DFN,0))
SET PSGTMP=$ORDER(^TMP("PSGCPLX",$JOB,DFN,0))
+7 IF +$GET(PSGTMP)'=+$GET(PSGORD)
Begin DoDot:2
+8 SET $PIECE(PSGRDTX,U,1)=$GET(^TMP("PSGCPLX",$JOB,DFN,PSGTMP))
+9 IF $GET(PSGRDTX(+$GET(PSJORD),"PSGSD"))=+$GET(PSGRDTX)
+10 NEW X,X1,X2
SET X1=+$GET(PSGRDTX)
SET X2=$SELECT($GET(CLOZPAT)=2:28,$GET(CLOZPAT)=1:14,$GET(CLOZPAT)=0:7,$GET(CLOZPAT)=3:4,1:90)
+11 DO C^%DTC
SET PSGFD=X
SET PSGFDN=$$ENDD^PSGMI(PSGFD)_"^"_$$ENDTC^PSGMI(PSGFD)
End DoDot:2
End DoDot:1
+12 QUIT
CMPLX3 ;SECOND COMPLEX THEN ORDER LOGIC
+1 if '$$GET1^DIQ(53.1,+$GET(PSGORD),125,"I")
QUIT
+2 IF PSGSTAT="NON-VERIFIED"
DO DISPCMP(PSGORD,PSGFD)
Begin DoDot:1
+3 IF $GET(PSSD)
SET PSGFD=PSSD
SET PSGFDN=$$ENDD^PSGMI(PSGFD)_"^"_$$ENDTC^PSGMI(PSGFD)
KILL PSSD
End DoDot:1
QUIT
+4 DO CLOZPAT
DO ANDTHEN
+5 IF $GET(PSGTYP)="T"!($GET(PSGTYP)="TA")
QUIT
+6 NEW X,X1,X2
SET X1=+$GET(PSGRDTX)
SET X2=$SELECT($GET(CLOZPAT)=2:28,$GET(CLOZPAT)=1:14,$GET(CLOZPAT)=0:7,$GET(CLOZPAT)=3:4,1:90)
+7 DO C^%DTC
SET PSGFD=X
SET PSGFDN=$$ENDD^PSGMI(PSGFD)_"^"_$$ENDTC^PSGMI(PSGFD)
+8 QUIT
CLOZPAT ;VERIFY PATIENT IS A CLOZAPINE PATIENT
+1 KILL CLOZPAT
+2 IF $LENGTH($$GET1^DIQ(55,DFN,53))
IF $$GET1^DIQ(55,DFN,54,"I")'="D"
Begin DoDot:1
+3 IF $$GET1^DIQ(55,DFN,53)?1U6N
SET CLOZPAT=3
QUIT
+4 NEW CLOZNUM,CLOZUID
+5 SET CLOZNUM=$$GET1^DIQ(55,DFN,53)
if CLOZNUM=""
QUIT
+6 SET CLOZUID=$$FIND1^DIC(603.01,,"X",CLOZNUM)
if 'CLOZUID
QUIT
+7 SET CLOZPAT=$$GET1^DIQ(603.01,CLOZUID,2,"I")
+8 SET CLOZPAT=$SELECT($GET(CLOZPAT)="M":2,$GET(CLOZPAT)="B":1,$GET(CLOZPAT)="W":0,1:90)
End DoDot:1
+9 QUIT
ANDTHEN ;COMPLEX AND/THEN ORDER
+1 if '$$GET1^DIQ(53.1,+$GET(PSGORD),125,"I")
QUIT
+2 if +$GET(PSGCOPY)
QUIT
+3 NEW PSGTMP,PSGID
SET PSGTMP=+$$GET1^DIQ(53.1,+$GET(PSGORD),125,"I")
SET PSGTYP=""
+4 SET PSGID=$$FIND1^DIC(100.045,","_PSGTMP_",","X","CONJ","ID")
IF PSGID
Begin DoDot:1
+5 SET PSGTYP=PSGTYP_$$GET1^DIQ(100.045,PSGID_","_PSGTMP,1)
End DoDot:1
+6 QUIT
DISPCMP(PSGORD,PSSD) ;COMPLEX ORDER CHECK
+1 if '$$GET1^DIQ(53.1,+$GET(PSGORD),125,"I")
QUIT
+2 SET PSSD=+$$GET1^DIQ(53.1,+$GET(PSGORD),117,"I")
+3 QUIT
EXTDT ;VERIFY EXTERNAL DATE
+1 QUIT
+2 ;
MSG1 ;
+1 WRITE !!,"Permission to dispense clozapine has been denied. The results of the latest",!
+2 WRITE "Lab Test drawn in the past 7 days show ANC results but No Matching WBC.",!
+3 WRITE "If you wish to dispense outside the FDA and VA protocol ANC limits,",!
+4 WRITE "document your request to Request for Override of Pharmacy Lockout ",!
+5 WRITE "(from VHA Handbook 1160.02) Director of the",!
+6 WRITE "VA National Clozapine Coordinating Center",!
+7 WRITE "(Phone: 214-857-0068 Fax: 214-857-0339) for a one-time override permission.",!
+8 WRITE !,"No order entered!"
+9 SET ANQX=1
+10 QUIT
MSG2 ;
+1 WRITE !!,"Permission to dispense clozapine has been denied. The results of the latest",!
+2 WRITE "Lab Test drawn in the past 7 days show No ANC results. If you wish to dispense",!
+3 WRITE "outside the FDA and VA protocol ANC limits, document your request to Request",!
+4 WRITE "for Override of Pharmacy Lockout (from VHA Handbook 1160.02) Director of the",!
+5 WRITE "VA National Clozapine Coordinating Center",!
+6 WRITE "(Phone: 214-857-0068 Fax: 214-857-0339) for a one-time override permission.",!
+7 WRITE !,"No order entered!"
+8 SET ANQX=1
+9 QUIT
MSG3 ;
+1 WRITE !,"A CBC/Differential including ANC Must Be Ordered and Monitored on a",!
+2 WRITE "Daily basis until the ANC above 1000/mm3 with no signs of infection.",!
+3 WRITE "If ANC is between 1000-1499, therapy can be continued but physician must order",!
+4 WRITE "lab test three times weekly."
+5 QUIT
MSG4 ;
+1 WRITE !,"Permission to dispense clozapine has been denied. If the results of the latest"
+2 WRITE !,"Lab Test drawn in the past 7 days show ANC below 1000/mm3 and you wish to"
+3 WRITE !,"dispense outside the FDA and VA protocol ANC limits, document your request to"
+4 WRITE !,"Request for Override of Pharmacy Lockout (from VHA Handbook 1160.02)"
+5 WRITE !,"Director of the VA National Clozapine Coordinating Center"
+6 WRITE !,"(Phone: 214-857-0068 Fax: 214-857-0339) for a one-time override permission.",!
+7 SET ANQX=1
+8 QUIT
MSG5 ;
+1 WRITE !!,"Permission to dispense clozapine has been denied. Please contact the"
+2 WRITE !,"Director of the VA National Clozapine Coordinating Center"
+3 WRITE !!,"Request for Override of Pharmacy Lockout (from VHA Handbook 1160.02)"
+4 WRITE !,"(Phone: 214-857-0068 Fax: 214-857-0339).",!
+5 QUIT
MSG6 ; MSG 6 added for new critically low ANC levels clozapine override requirements
+1 WRITE !!,"This clozapine drug may not be dispensed to the patient at this time based on the available lab tests related to the clozapine treatment program."
+2 WRITE !!,"Please contact the NCCC to request an override in order to proceed with dispensing this drug. "
+3 WRITE !!,"Request for Override of Pharmacy Lockout (from VHA Handbook 1160.02)"
+4 WRITE !!,"The matching ANC counts which caused the lockout are of lab test results performed on "
+5 SET ANQX=1
SET Y=$PIECE(PSOYS,"^",6)
XECUTE ^DD("DD")
WRITE $PIECE(Y,"@")
+6 WRITE !!,?5,"ANC: "_$PIECE(PSOYS,"^",4),!
+7 QUIT
MSG9 ;
+1 WRITE !,"*** Permission to dispense clozapine has been denied based on the available"
+2 WRITE !," lab tests related to the clozapine treatment program. ***"
+3 WRITE !!,"For a National Override to dispense at the patient's normal frequency,"
+4 WRITE !,"please contact the VA National Clozapine Coordinating Center to request"
+5 WRITE !,"an Override of Pharmacy Lockout (from VHA Handbook 1160.02)"
+6 WRITE !,"(Phone: 214-857-0068 Fax: 214-857-0339)."
+7 WRITE !,"A Special Conditions Local Override can be approved for"
+8 WRITE !,"(1) weather-related conditions, (2) mail order delays of clozapine, or"
+9 WRITE !,"(3) inpatient going on leave. With Provider's documentation of approval,"
+10 WRITE !,"you may dispense a one-time supply not to exceed 4 days.",!
+11 QUIT
+12 ;
+13 ;/RBN Begin of modifications for new message for IP 4 day overrride.
MSG10 ;
+1 WRITE !,"*** Permission to dispense clozapine has been denied based on the available"
+2 WRITE !," lab tests related to the clozapine treatment program. ***"
+3 WRITE !!,"For a National Override to dispense at the patient's normal frequency,"
+4 WRITE !,"please contact the VA National Clozapine Coordinating Center to request an"
+5 WRITE !,"Override of Pharmacy Lockout (from VHA Handbook 1160.02) (Phone: 214-857-0068"
+6 WRITE !,"Fax: 214-857-0339)."
+7 WRITE !,"A Special Conditions Local Override for Inpatients can be approved for an"
+8 WRITE !,"IP Override Order with Outside Lab Results. With Provider's documentation of"
+9 WRITE !,"approval, you may dispense a one-time IP supply not to exceed 4 days."
+10 WRITE !,"The ANC from another facility must be recorded in the Progress note/comments"
+11 WRITE !,"in pharmacy"
+12 QUIT
+13 ;/RBN End of modifications for new message for IP 4 day overrride.
+14 ; ** END NCC REMEDIATION ** 457 AND PSJ 327/RTW
+15 ;
COMPLEX ; Display Complex Order stop date warning message <<RJS
+1 if $GET(PSGFLG)
QUIT
+2 if '$$GET1^DIQ(53.1,+$GET(PSGORD),125,"I")
QUIT
+3 ;,PSGSD,PSGYS,X,X1,X2
NEW PSGFDT
+4 DO CLOZPAT
+5 SET X1=+$GET(PSGSD)
SET X2=$SELECT($GET(CLOZPAT)=2:28,$GET(CLOZPAT)=1:14,$GET(CLOZPAT)=0:7,$GET(CLOZPAT)=3:4,1:90)
+6 DO C^%DTC
SET PSGFDT=$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)
+7 WRITE !!,?25,"* WARNING *",!!,?10,"This order contains a requested duration."
+8 WRITE !,?8,"Please review the system calculated stop date",!,?5,"to confirm that it is within the allowable duration"
+9 WRITE !,?13,"of the order based on the patient's",!,?11,"authorized clozapine dispense frequency.",!
+10 WRITE !,?10,"Order stop date should not exceed ",PSGFDT,!,!,?1,"Review the entire profile to determine appropriate action(s).",!
+11 KILL PSGCOMP
DO PAUSE^VALM1
SET PSGFLG=1
+12 QUIT
COMPLEX1 ; Display Complex Order stop date warning message <<RJS
+1 if $GET(PSGFLG)
QUIT
+2 if '$$GET1^DIQ(53.1,+$GET(PSGORD),125,"I")
QUIT
+3 NEW PSGFDT,MSG
+4 if '$DATA(CLOZPAT)
DO CLOZPAT
+5 SET X1=+$GET(PSGSD)
SET X2=$SELECT($GET(CLOZPAT)=2:28,$GET(CLOZPAT)=1:14,$GET(CLOZPAT)=0:7,$GET(CLOZPAT)=3:4,1:90)
+6 DO C^%DTC
SET PSGFDT=$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)
+7 SET MSG=$JUSTIFY("",25)_"* WARNING *"
DO INSTR^VALM1("",1,9,80,1)
DO INSTR^VALM1(MSG,1,10,80,1)
+8 SET MSG=$JUSTIFY("",10)_"This order contains a requested duration."
DO INSTR^VALM1(MSG,1,11,80,1)
+9 SET MSG=$JUSTIFY("",8)_"Please review the system calculated stop date"
DO INSTR^VALM1(MSG,1,12,80,1)
+10 SET MSG=$JUSTIFY("",5)_"to confirm that it is within the allowable duration"
DO INSTR^VALM1(MSG,1,13,80,1)
+11 SET MSG=$JUSTIFY("",13)_"of the order based on the patient's"
DO INSTR^VALM1(MSG,1,14,80,1)
+12 SET MSG=$JUSTIFY("",11)_"authorized clozapine dispense frequency."
DO INSTR^VALM1(MSG,1,15,80,1)
+13 SET MSG=$JUSTIFY("",10)_"Order stop date should not exceed "_PSGFDT
DO INSTR^VALM1(MSG,1,17,80,1)
+14 SET MSG=" Review the entire profile to determine appropriate action(s)."
DO INSTR^VALM1(MSG,1,18,80,1)
+15 NEW LN
FOR LN=16,19
DO INSTR^VALM1("",1,LN,80,1)
+16 KILL PSGCOMP
DO PAUSE^VALM1
SET PSGFLG=1
+17 QUIT
LASTCHLD(DFN,ON) ; Last child of Complex order or not
+1 NEW FL,PSORDA,PSORD1
IF ON'["U"
IF ON'["V"
QUIT 1
+2 IF ON["U"
Begin DoDot:1
+3 SET PSORDA=$$GET1^DIQ(55.06,+ON_","_DFN,125,"I")
SET PSORD1=+$$GET1^DIQ(55.06,+ON_","_DFN,66,"I")
+4 IF 'PSORDA!'PSORD1
QUIT
+5 NEW ORARR,MAX
DO LIST^DIC(100.002,","_PSORDA_",",,"I",,,,,,,"ORARR")
SET MAX=+ORARR("DILIST",0)
+6 FOR I=1:1
if '$DATA(ORARR("DILIST",2,I))
QUIT
IF ORARR("DILIST",2,I)=PSORD1
QUIT
+7 if I=MAX
SET PSORD1=0
QUIT
End DoDot:1
if 'PSORDA
QUIT 1
if 'PSORD1
QUIT 1
QUIT 0
+8 IF ON["V"
Begin DoDot:1
+9 SET PSORDA=$$GET1^DIQ(55.01,+ON_","_DFN,150,"I")
SET PSORD1=+$$GET1^DIQ(55.01,+ON_","_DFN,110,"I")
+10 IF 'PSORDA!'PSORD1
QUIT
+11 NEW ORARR,MAX
DO LIST^DIC(100.002,","_PSORDA_",",,"I",,,,,,,"ORARR")
SET MAX=+ORARR("DILIST",0)
+12 FOR I=1:1
if '$DATA(ORARR("DILIST",2,I))
QUIT
IF ORARR("DILIST",2,I)=PSORD1
QUIT
+13 if I=MAX
SET PSORD1=0
QUIT
End DoDot:1
if 'PSORDA
QUIT 1
if 'PSORD1
QUIT 1
QUIT 0
+14 QUIT 1
+15 ;
ISCLOZ(PSGORD,ORPSOI,DFN,PSGORDNM,PSGDRG) ; Define a clozapine order and associated drug
+1 ; PSGORD - Pending Order number (file 53.1)
+2 ; ORPSOI - ID containing Pharmacy Orderable Item number (file 50.7)
+3 ; DFN - Patient ID (file 2)
+4 ; PSGORDNM - Pharmacy order number (file 55)
+5 ; PSGDRG - Drug Code
+6 ; OROI - Orderable Item number (file 101.43)
+7 NEW ISCLOZ
SET ISCLOZ=0
+8 IF $GET(PSGORD)
Begin DoDot:1
+9 IF '$$GET1^DIQ(53.1,PSGORD,.01,"I")
QUIT
+10 SET PSGDRG=$$GET1^DIQ(53.11,"1,"_+PSGORD,.01,"I")
IF PSGDRG
Begin DoDot:2
+11 IF $$GET1^DIQ(50,+$GET(PSGDRG),17.5)="PSOCLO1"
SET ISCLOZ=1_U_PSGDRG
End DoDot:2
QUIT
+12 NEW ORPSOI
SET ORPSOI=$$GET1^DIQ(53.1,PSGORD,108,"I")
IF 'ORPSOI
QUIT
+13 DO CLOZPSOI(+ORPSOI)
End DoDot:1
QUIT ISCLOZ
+14 IF $GET(ORPSOI)
DO CLOZPSOI(+ORPSOI)
QUIT ISCLOZ
+15 IF $GET(DFN)
IF $GET(PSGORDNM)
Begin DoDot:1
+16 SET PSGDRG=$$GET1^DIQ(55.07,"1,"_PSGORDNM_","_DFN,.01,"I")
IF PSGDRG
Begin DoDot:2
+17 IF $$GET1^DIQ(50,+$GET(PSGDRG),17.5)="PSOCLO1"
SET ISCLOZ=1_U_PSGDRG
End DoDot:2
QUIT
+18 NEW ORPSOI
SET ORPSOI=$$GET1^DIQ(55.06,PSGORDNM_","_DFN,108,"I")
IF 'ORPSOI
QUIT
+19 DO CLOZPSOI(+ORPSOI)
End DoDot:1
QUIT ISCLOZ
+20 ;
+21 IF $GET(PSGDRG)>0
IF $$GET1^DIQ(50,$GET(PSGDRG),17.5)="PSOCLO1"
SET ISCLOZ=1_U_PSGDRG
+22 QUIT ISCLOZ
+23 ;
CLOZPSOI(ORPSOI) ; Define a clozapine order based on Pharmacy Orderable item
+1 NEW ARR,PSGDRG,CLOZFLG
DO FIND^DIC(50,,.01,"Q",ORPSOI,,"ASP",,,"ARR")
+2 NEW I
FOR I=2:1
if '$DATA(ARR("DILIST",2,I))
QUIT
SET PSGDRG=+$GET(ARR("DILIST",2,I))
Begin DoDot:1
+3 IF $$GET1^DIQ(50,PSGDRG,17.5)="PSOCLO1"
SET ISCLOZ=1_U_PSGDRG
End DoDot:1
if ISCLOZ
QUIT
+4 QUIT
+5 ;
