PSOCLUTL ;BHAM ISC/DMA - utilities for clozapine reporting system ;4 Oct 2019 12:29:40
;;7.0;OUTPATIENT PHARMACY;**28,56,122,222,268,457,574,612,621,545**;DEC 1997;Build 270
;External reference ^YSCL(603.01 supported by DBIA 2697
;External reference ^PS(55 supported by DBIA 2228
;
REG ; Register Clozapine Patient
N DIC,DIR,PSOCZPTS,PSOERR
; Added "M" to the DIC(0) ; PSO*7.0*574
S DIC=55,DLAYGO=55,DIC(0)="AEQLM",DIC("A")="Select patient to register: " D ^DIC K DIC,DLAYGO G END:Y<0
S PSO1=+Y,PSONAME=$$GET1^DIQ(2,PSO1,.01)
D:$$GET1^DIQ(55,PSO1,52.1,"I")'=2 EN^PSOHLUP(PSO1) N ANQX
; BEGIN: JCH - PSO*7*612
D FIND^DIC(603.01,"","","QX",PSO1,"","C","","","PSOCZPTS","PSOERR") ; Look for all NCC authorizations in 603.01
; PSO*7.0*574
;I '$$FIND1^DIC(603.01,,"Q",PSO1,"C") D Q
I '$G(PSOCZPTS("DILIST",0)) D Q ; No NCC authorizations on file
. N DIR,X,Y
. W !!,PSONAME_" has not been authorized for Clozapine"
. W !,"by the NCCC (National Clozapine Coordinating Center)."
. W !,"This option is only available for known NCCC-registered patients."
. W !,"To dispense clozapine under a temporary registration for an authorized emergency"
. W !,"override situation, use the VistA Patient Prescription Processing option."
. W !,"Contact the NCCC during regular business hours for registration.",!
. S DIR(0)="E",DIR("A")="Press enter" D ^DIR
; END: JCH - PSO*7*612
;W !!,PSONAME_" has not been authorized for Clozapine",!,"by the NCCC in Dallas. Contact the NCCC in Dallas for authorization." D OVER G:'$G(%) REG S JADOVER=""
S PSO4=$$GET1^DIQ(55,PSO1,53) I PSO4]"" W !!,PSONAME_" is already registered with number "_PSO4,!!,"Use the edit option to change registration data, or",!,"contact your supervisor",! G REG
NUMBER ;
S DIR(0)="55,53",Y=$$GET1^DIQ(603.01,$$FIND1^DIC(603.01,,"Q",PSO1,"C"),.01)
S:Y]"" DIR("B")=Y
D ^DIR S PSO2=Y K DIR I $D(DIRUT) W !,"Not registered",! D END G REG
N PSOEX S PSOEX=$$FIND1^DIC(55,,"X",PSO2,"ASAND1")
I PSOEX,PSOEX'=PSO1 W !,PSO2," is already assigned to ",$$GET1^DIQ(2,PSOEX,.01) W !,"Please contact your supervisor" D END G REG
I '$D(JADOVER),'$$FIND1^DIC(603.01,"","X",PSO2,"B") D I '$G(%) W ! G NUMBER
. W !!,"The NCCC in Dallas has not authorized "_PSO2_" to be used",!
. W "at this facility. Contact the NCCC in Dallas for authorization." D OVER
NUMBER1 ;
S PSO3="A" ; (#54) CLOZAPINE STATUS
PHY ;
N DIC,DIR
S DIC="^VA(200,",DIC(0)="AEQMZ",DIC("A")="Provider responsible: ",DIC("S")="I $$GET1^DIQ(200,+Y,53.1)]"""""
D ^DIC K DIC I Y<0 D END D G:'$G(PSCLOZ) REG G END1
.I '$G(PSCLOZ) W !!,"Not registered",!! Q
.S ANQX=1 Q
I $G(PSCLOZ) D PROVCHK(+Y) G:$G(ANQX) PHY
S PSO4=+Y
;/RBN Begin NCC changes Ask if okay to register the unregistered patient - PSO*7.0*457
N DFN,VADM S DFN=PSO1 D DEM^VADPT
S SSN=$P(VADM(2),"^")
S LSTFOUR=$E(SSN,6,9)
I '$G(PSCLOZ) D
. S DIR("A",1)="OK to register "_PSONAME_" ("_$G(LSTFOUR)_")"_" with number "_PSO2
. S DIR("A")="as a"_$S('PSO3:" new",1:"n ongoing")_" patient in this program? "
I $G(PSCLOZ) D
. S DIR("A",2)="Would you like to override the registration requirement"
. S DIR("A",1)="and assign a temporary local authorization number"
. S DIR("A")="for "_PSONAME_" ("_$G(LSTFOUR)_")"_" with number "_PSO2_"? "
S DIR(0)="YA",DIR("B")="NO" D ^DIR K DIR I Y=0!($D(DUOUT)) S ANQX=1 D END G END1
;/RBN End NCC changes to remove Pretreatment choice - PSO*7.0*457
SAVE ;
S DA=PSO1,DIE=55,DR="53////"_PSO2_";54////"_PSO3_";57////"_PSO4_";56////0" S:($$GET1^DIQ(55,PSO1,53)'=PSO2) DR=DR_";58////"_DT
L +^PS(55,DA):DILOCKTM E W !!,$C(7),"Patient "_PSONAME_" is being edited by another user! Try Later." S ANQX=1 D END G END1
D ^DIE L -^PS(55,DA)
S:PSO2?1U6N $P(^XTMP("PSJ CLOZ",0),U,4)=PSO2 ; save last temp reg#
; BEGIN: JCH-PSO*7*612
I PSO2?2U5N K ^XTMP("PSJ4D-"_PSO1),^XTMP("PSO4D-"_PSO1) ; Registering new NCCC clozapine authorization makes previous local overrides obsolete
; END: JCH-PSO*7*612
END ;
K %,%Y,C,D,D0,DA,DI,DQ,DIC,DIE,DR,PSO,PSO1,PSO2,PSO3,PSO4,PSOC,PSOLN,PSONAME,PSONO,PSOT,R,SSNVAERR,XMDUZ,XMSUB,XMTEXT,Y
I '$G(PSCLOZ) K ^TMP($J),^TMP("PSO",$J)
Q
END1 ;
I $G(ANQX) W !!,"Patient Not Registered"
Q
;
FACILITY ;Enter facility DEA number to set up clozapine system
;this entry point is no longer used. this functionality was taken over
;by the mental health package with the release of YS*5.01*18
;W ! S DIC=59,DIC(0)="AEQM",DIC("A")="Select site to participate in clozapine program : " D ^DIC G END:Y<0
;S DIE=DIC,DA=+Y,DR="1R;2R;" L +^PS(59,DA) D ^DIE L -^PS(59,DA) G FACILITY
Q
;
;
AGAIN ; re-enter patient - new number, status and provider
S DIC=55,DIC(0)="AEQM",DIC("A")="Select clozapine patient : " D ^DIC K DIC G END:Y<0 S (DA,PSO1)=+Y,PSONAME=$$GET1^DIQ(2,DA,.01)
I $$GET1^DIQ(55,DA,53)="" W !,PSONAME_" is not registered. Use the register option." G AGAIN
; BEGIN: JCH - PSO*7*612
;I '$$FIND1^DIC(603.01,,"Q",PSO1,"C") W !!,PSONAME_" has not been authorized for Clozapine",!,"by the NCCC in Dallas. Contact the NCCC in Dallas for authorization." D OVER G:'$G(%) AGAIN S JADOVER=""
N PSOCZPTS,PSOERR
D FIND^DIC(603.01,"","","QX",PSO1,"","C","","","PSOCZPTS","PSOERR") ; Look for all NCC authorizations in 603.01
I '$G(PSOCZPTS("DILIST",0)) W !!,PSONAME_" has not been authorized for Clozapine",!,"by the NCCC in Dallas. Contact the NCCC in Dallas for authorization." D OVER G:'$G(%) AGAIN S JADOVER=""
; END: JCH - PSO*7*612
S DIR(0)="55,53" D ^DIR G END:$D(DIRUT) S PSO2=Y
N PSOEX S PSOEX=$$FIND1^DIC(55,,"X",PSO2,"ASAND1")
I PSOEX,PSOEX'=PSO1 W !,PSO2," already assigned to ",$$GET1^DIQ(2,PSOEX,.01) G END
I '$D(JADOVER),'$$FIND1^DIC(603.01,,"X",PSO2) W !!,"The NCCC in Dallas has not authorized "_PSO2_" for usage",!,"at this facility. Contact the NCCC in Dallas for authorization." D OVER G:'$G(%) END
W !,"CLOZAPINE STATUS: "_$$GET1^DIQ(55,PSO1,54)
S PSO3=$$GET1^DIQ(55,PSO1,54,"I")
PHY1 ;
S DIR(0)="55,57" D ^DIR G END:$D(DIRUT) I Y S PSO4=+Y
;I $$GET1^DIQ(200,PSO4,53.2)="" D G PHY1
;. W !!,"Only providers with DEA numbers entered in the New Person",!,"file can register patients in this program.",!!
;*545
I $$DEA^XUSER(0,PSO4)="" D G PHY1
.W !!,"Only providers with DEA numbers entered in the New Person",!,"file can register patients in this program.",!!
I $$GET1^DIQ(55,PSO1,53)=PSO2,$$GET1^DIQ(55,PSO1,57,"I")=PSO4 D G END
. W !!?5,"No changes made.",$C(7),!
G SAVE
;
OVER ;allow registration of patients and clozapine numbers not yet authorized by the NCCC.
K DIR,% W ! S DIR("A")="Do you want to override this warning",DIR(0)="Y",DIR("B")="No" D ^DIR
I Y S %=1
K DIR,DIRUT,DUOUT Q
;
CLOZPAT ;VERIFY PATIENT IS A CLOZAPINE PATIENT
K CLOZPAT,CLOZST S CLOZST=$$GET1^DIQ(55,DFN,54,"I")
I $L(CLOZST),CLOZST'="D" D
.N CLOZNUM,CLOZUID S CLOZNUM=$$GET1^DIQ(55,DFN,53)
.I CLOZNUM?1U6N S CLOZPAT=3 Q
.S CLOZUID=$$FIND1^DIC(603.01,,"X",CLOZNUM) Q:'CLOZUID ;Q:'$D(^YSCL(603.01,CLOZUID,0))
.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
;
PROVCHK(PROV) ;
N PSJQUIT S (ANQX,PSJQUIT)=0 I '$G(PROV) Q
;I '$L($$DEA^XUSER(,PROV)) S (ANQX,PSJQUIT)=1 D Q
;.W !," ",!,"*** Provider must have a DEA# or VA# to write prescriptions for this drug."
;*545
I $$DEA^XUSER(0,PROV)']"" S (ANQX,PSJQUIT)=1 D Q
.W !!,"Only providers with DEA numbers entered in the New Person",!,"file can register patients in this program.",!!
I '$$FIND1^DIC(200.051,","_PROV_",","X","YSCL AUTHORIZED") S (ANQX,PSJQUIT)=1 D
.W !," ",!,"*** Provider must hold YSCL AUTHORIZED key to write prescriptions for clozapine."
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 ; ; ** START NCC REMEDIATION ** 457 AND PSJ 327/RTW 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
;
CRXTMP(DFN,PSOYS) ; track OP 4 day supply
S ^XTMP("PSO4D-"_DFN,0)=$$FMADD^XLFDT(DT,5)_U_DT_"^Clozapine Local Override 4 day supply tracking"
S ^XTMP("PSO4D-"_DFN,"PSOYS")=PSOYS
Q
;
CRXTMPI(DFN,PSOYS) ; track IP 4 day supply
S ^XTMP("PSJ4D-"_DFN,0)=$$FMADD^XLFDT(DT,5)_U_DT_"^Clozapine Local Override 4 day supply tracking"
S ^XTMP("PSJ4D-"_DFN,"PSOYS")=PSOYS
Q
;
CLKEYWRN() ; uniform message to users - PSO*7*457
Q "Provider must hold YSCL AUTHORIZED key to write medication orders for clozapine."
;
GETREGYS(PSODFN) ; Get file 603.01 IEN currently registered to patient in file 55
;JCH - PSO*7*612
N PSOCLZN,PSOYSIEN,PSOCLODT
S PSOCLZN=$$GET1^DIQ(55,PSODFN,53)
S PSOYSIEN=$$FIND1^DIC(603.01,,"Q",PSOCLZN,"B")
Q PSOYSIEN
;
QTYCHK(PSORXARY,NUMDAYS) ; check/adjust quantity, PSORXARY passed by ref., NUMDAYS is # of days
Q:'($G(NUMDAYS)>0) ; required
N J,SCHED,NMIN,QTY,TMSDLY
S J=0,QTY=0 F S J=$O(PSORXARY("SCHEDULE",J)) Q:'J D
. S SCHED=PSORXARY("SCHEDULE",J)
. S NMIN=$$QTSCH^PSOSIG(SCHED) Q:'NMIN ;number of minutes between meds
. S TMSDLY=1440/NMIN ;times daily
. S QTY=QTY+(NUMDAYS*TMSDLY*$G(PSORXARY("DOSE ORDERED",J)))
;
S:QTY PSORXARY("QTY")=(QTY+.99)\1,$P(PSORXARY("RX0"),U,7)=(QTY+.99)\1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOCLUTL 13432 printed Sep 23, 2025@20:01:45 Page 2
PSOCLUTL ;BHAM ISC/DMA - utilities for clozapine reporting system ;4 Oct 2019 12:29:40
+1 ;;7.0;OUTPATIENT PHARMACY;**28,56,122,222,268,457,574,612,621,545**;DEC 1997;Build 270
+2 ;External reference ^YSCL(603.01 supported by DBIA 2697
+3 ;External reference ^PS(55 supported by DBIA 2228
+4 ;
REG ; Register Clozapine Patient
+1 NEW DIC,DIR,PSOCZPTS,PSOERR
+2 ; Added "M" to the DIC(0) ; PSO*7.0*574
+3 SET DIC=55
SET DLAYGO=55
SET DIC(0)="AEQLM"
SET DIC("A")="Select patient to register: "
DO ^DIC
KILL DIC,DLAYGO
if Y<0
GOTO END
+4 SET PSO1=+Y
SET PSONAME=$$GET1^DIQ(2,PSO1,.01)
+5 if $$GET1^DIQ(55,PSO1,52.1,"I")'=2
DO EN^PSOHLUP(PSO1)
NEW ANQX
+6 ; BEGIN: JCH - PSO*7*612
+7 ; Look for all NCC authorizations in 603.01
DO FIND^DIC(603.01,"","","QX",PSO1,"","C","","","PSOCZPTS","PSOERR")
+8 ; PSO*7.0*574
+9 ;I '$$FIND1^DIC(603.01,,"Q",PSO1,"C") D Q
+10 ; No NCC authorizations on file
IF '$GET(PSOCZPTS("DILIST",0))
Begin DoDot:1
+11 NEW DIR,X,Y
+12 WRITE !!,PSONAME_" has not been authorized for Clozapine"
+13 WRITE !,"by the NCCC (National Clozapine Coordinating Center)."
+14 WRITE !,"This option is only available for known NCCC-registered patients."
+15 WRITE !,"To dispense clozapine under a temporary registration for an authorized emergency"
+16 WRITE !,"override situation, use the VistA Patient Prescription Processing option."
+17 WRITE !,"Contact the NCCC during regular business hours for registration.",!
+18 SET DIR(0)="E"
SET DIR("A")="Press enter"
DO ^DIR
End DoDot:1
QUIT
+19 ; END: JCH - PSO*7*612
+20 ;W !!,PSONAME_" has not been authorized for Clozapine",!,"by the NCCC in Dallas. Contact the NCCC in Dallas for authorization." D OVER G:'$G(%) REG S JADOVER=""
+21 SET PSO4=$$GET1^DIQ(55,PSO1,53)
IF PSO4]""
WRITE !!,PSONAME_" is already registered with number "_PSO4,!!,"Use the edit option to change registration data, or",!,"contact your supervisor",!
GOTO REG
NUMBER ;
+1 SET DIR(0)="55,53"
SET Y=$$GET1^DIQ(603.01,$$FIND1^DIC(603.01,,"Q",PSO1,"C"),.01)
+2 if Y]""
SET DIR("B")=Y
+3 DO ^DIR
SET PSO2=Y
KILL DIR
IF $DATA(DIRUT)
WRITE !,"Not registered",!
DO END
GOTO REG
+4 NEW PSOEX
SET PSOEX=$$FIND1^DIC(55,,"X",PSO2,"ASAND1")
+5 IF PSOEX
IF PSOEX'=PSO1
WRITE !,PSO2," is already assigned to ",$$GET1^DIQ(2,PSOEX,.01)
WRITE !,"Please contact your supervisor"
DO END
GOTO REG
+6 IF '$DATA(JADOVER)
IF '$$FIND1^DIC(603.01,"","X",PSO2,"B")
Begin DoDot:1
+7 WRITE !!,"The NCCC in Dallas has not authorized "_PSO2_" to be used",!
+8 WRITE "at this facility. Contact the NCCC in Dallas for authorization."
DO OVER
End DoDot:1
IF '$GET(%)
WRITE !
GOTO NUMBER
NUMBER1 ;
+1 ; (#54) CLOZAPINE STATUS
SET PSO3="A"
PHY ;
+1 NEW DIC,DIR
+2 SET DIC="^VA(200,"
SET DIC(0)="AEQMZ"
SET DIC("A")="Provider responsible: "
SET DIC("S")="I $$GET1^DIQ(200,+Y,53.1)]"""""
+3 DO ^DIC
KILL DIC
IF Y<0
DO END
Begin DoDot:1
+4 IF '$GET(PSCLOZ)
WRITE !!,"Not registered",!!
QUIT
+5 SET ANQX=1
QUIT
End DoDot:1
if '$GET(PSCLOZ)
GOTO REG
GOTO END1
+6 IF $GET(PSCLOZ)
DO PROVCHK(+Y)
if $GET(ANQX)
GOTO PHY
+7 SET PSO4=+Y
+8 ;/RBN Begin NCC changes Ask if okay to register the unregistered patient - PSO*7.0*457
+9 NEW DFN,VADM
SET DFN=PSO1
DO DEM^VADPT
+10 SET SSN=$PIECE(VADM(2),"^")
+11 SET LSTFOUR=$EXTRACT(SSN,6,9)
+12 IF '$GET(PSCLOZ)
Begin DoDot:1
+13 SET DIR("A",1)="OK to register "_PSONAME_" ("_$GET(LSTFOUR)_")"_" with number "_PSO2
+14 SET DIR("A")="as a"_$SELECT('PSO3:" new",1:"n ongoing")_" patient in this program? "
End DoDot:1
+15 IF $GET(PSCLOZ)
Begin DoDot:1
+16 SET DIR("A",2)="Would you like to override the registration requirement"
+17 SET DIR("A",1)="and assign a temporary local authorization number"
+18 SET DIR("A")="for "_PSONAME_" ("_$GET(LSTFOUR)_")"_" with number "_PSO2_"? "
End DoDot:1
+19 SET DIR(0)="YA"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
IF Y=0!($DATA(DUOUT))
SET ANQX=1
DO END
GOTO END1
+20 ;/RBN End NCC changes to remove Pretreatment choice - PSO*7.0*457
SAVE ;
+1 SET DA=PSO1
SET DIE=55
SET DR="53////"_PSO2_";54////"_PSO3_";57////"_PSO4_";56////0"
if ($$GET1^DIQ(55,PSO1,53)'=PSO2)
SET DR=DR_";58////"_DT
+2 LOCK +^PS(55,DA):DILOCKTM
IF '$TEST
WRITE !!,$CHAR(7),"Patient "_PSONAME_" is being edited by another user! Try Later."
SET ANQX=1
DO END
GOTO END1
+3 DO ^DIE
LOCK -^PS(55,DA)
+4 ; save last temp reg#
if PSO2?1U6N
SET $PIECE(^XTMP("PSJ CLOZ",0),U,4)=PSO2
+5 ; BEGIN: JCH-PSO*7*612
+6 ; Registering new NCCC clozapine authorization makes previous local overrides obsolete
IF PSO2?2U5N
KILL ^XTMP("PSJ4D-"_PSO1),^XTMP("PSO4D-"_PSO1)
+7 ; END: JCH-PSO*7*612
END ;
+1 KILL %,%Y,C,D,D0,DA,DI,DQ,DIC,DIE,DR,PSO,PSO1,PSO2,PSO3,PSO4,PSOC,PSOLN,PSONAME,PSONO,PSOT,R,SSNVAERR,XMDUZ,XMSUB,XMTEXT,Y
+2 IF '$GET(PSCLOZ)
KILL ^TMP($JOB),^TMP("PSO",$JOB)
+3 QUIT
END1 ;
+1 IF $GET(ANQX)
WRITE !!,"Patient Not Registered"
+2 QUIT
+3 ;
FACILITY ;Enter facility DEA number to set up clozapine system
+1 ;this entry point is no longer used. this functionality was taken over
+2 ;by the mental health package with the release of YS*5.01*18
+3 ;W ! S DIC=59,DIC(0)="AEQM",DIC("A")="Select site to participate in clozapine program : " D ^DIC G END:Y<0
+4 ;S DIE=DIC,DA=+Y,DR="1R;2R;" L +^PS(59,DA) D ^DIE L -^PS(59,DA) G FACILITY
+5 QUIT
+6 ;
+7 ;
AGAIN ; re-enter patient - new number, status and provider
+1 SET DIC=55
SET DIC(0)="AEQM"
SET DIC("A")="Select clozapine patient : "
DO ^DIC
KILL DIC
if Y<0
GOTO END
SET (DA,PSO1)=+Y
SET PSONAME=$$GET1^DIQ(2,DA,.01)
+2 IF $$GET1^DIQ(55,DA,53)=""
WRITE !,PSONAME_" is not registered. Use the register option."
GOTO AGAIN
+3 ; BEGIN: JCH - PSO*7*612
+4 ;I '$$FIND1^DIC(603.01,,"Q",PSO1,"C") W !!,PSONAME_" has not been authorized for Clozapine",!,"by the NCCC in Dallas. Contact the NCCC in Dallas for authorization." D OVER G:'$G(%) AGAIN S JADOVER=""
+5 NEW PSOCZPTS,PSOERR
+6 ; Look for all NCC authorizations in 603.01
DO FIND^DIC(603.01,"","","QX",PSO1,"","C","","","PSOCZPTS","PSOERR")
+7 IF '$GET(PSOCZPTS("DILIST",0))
WRITE !!,PSONAME_" has not been authorized for Clozapine",!,"by the NCCC in Dallas. Contact the NCCC in Dallas for authorization."
DO OVER
if '$GET(%)
GOTO AGAIN
SET JADOVER=""
+8 ; END: JCH - PSO*7*612
+9 SET DIR(0)="55,53"
DO ^DIR
if $DATA(DIRUT)
GOTO END
SET PSO2=Y
+10 NEW PSOEX
SET PSOEX=$$FIND1^DIC(55,,"X",PSO2,"ASAND1")
+11 IF PSOEX
IF PSOEX'=PSO1
WRITE !,PSO2," already assigned to ",$$GET1^DIQ(2,PSOEX,.01)
GOTO END
+12 IF '$DATA(JADOVER)
IF '$$FIND1^DIC(603.01,,"X",PSO2)
WRITE !!,"The NCCC in Dallas has not authorized "_PSO2_" for usage",!,"at this facility. Contact the NCCC in Dallas for authorization."
DO OVER
if '$GET(%)
GOTO END
+13 WRITE !,"CLOZAPINE STATUS: "_$$GET1^DIQ(55,PSO1,54)
+14 SET PSO3=$$GET1^DIQ(55,PSO1,54,"I")
PHY1 ;
+1 SET DIR(0)="55,57"
DO ^DIR
if $DATA(DIRUT)
GOTO END
IF Y
SET PSO4=+Y
+2 ;I $$GET1^DIQ(200,PSO4,53.2)="" D G PHY1
+3 ;. W !!,"Only providers with DEA numbers entered in the New Person",!,"file can register patients in this program.",!!
+4 ;*545
+5 IF $$DEA^XUSER(0,PSO4)=""
Begin DoDot:1
+6 WRITE !!,"Only providers with DEA numbers entered in the New Person",!,"file can register patients in this program.",!!
End DoDot:1
GOTO PHY1
+7 IF $$GET1^DIQ(55,PSO1,53)=PSO2
IF $$GET1^DIQ(55,PSO1,57,"I")=PSO4
Begin DoDot:1
+8 WRITE !!?5,"No changes made.",$CHAR(7),!
End DoDot:1
GOTO END
+9 GOTO SAVE
+10 ;
OVER ;allow registration of patients and clozapine numbers not yet authorized by the NCCC.
+1 KILL DIR,%
WRITE !
SET DIR("A")="Do you want to override this warning"
SET DIR(0)="Y"
SET DIR("B")="No"
DO ^DIR
+2 IF Y
SET %=1
+3 KILL DIR,DIRUT,DUOUT
QUIT
+4 ;
CLOZPAT ;VERIFY PATIENT IS A CLOZAPINE PATIENT
+1 KILL CLOZPAT,CLOZST
SET CLOZST=$$GET1^DIQ(55,DFN,54,"I")
+2 IF $LENGTH(CLOZST)
IF CLOZST'="D"
Begin DoDot:1
+3 NEW CLOZNUM,CLOZUID
SET CLOZNUM=$$GET1^DIQ(55,DFN,53)
+4 IF CLOZNUM?1U6N
SET CLOZPAT=3
QUIT
+5 ;Q:'$D(^YSCL(603.01,CLOZUID,0))
SET CLOZUID=$$FIND1^DIC(603.01,,"X",CLOZNUM)
if 'CLOZUID
QUIT
+6 SET CLOZPAT=$$GET1^DIQ(603.01,CLOZUID,2,"I")
+7 SET CLOZPAT=$SELECT($GET(CLOZPAT)="M":2,$GET(CLOZPAT)="B":1,$GET(CLOZPAT)="W":0,1:90)
End DoDot:1
+8 QUIT
+9 ;
PROVCHK(PROV) ;
+1 NEW PSJQUIT
SET (ANQX,PSJQUIT)=0
IF '$GET(PROV)
QUIT
+2 ;I '$L($$DEA^XUSER(,PROV)) S (ANQX,PSJQUIT)=1 D Q
+3 ;.W !," ",!,"*** Provider must have a DEA# or VA# to write prescriptions for this drug."
+4 ;*545
+5 IF $$DEA^XUSER(0,PROV)']""
SET (ANQX,PSJQUIT)=1
Begin DoDot:1
+6 WRITE !!,"Only providers with DEA numbers entered in the New Person",!,"file can register patients in this program.",!!
End DoDot:1
QUIT
+7 IF '$$FIND1^DIC(200.051,","_PROV_",","X","YSCL AUTHORIZED")
SET (ANQX,PSJQUIT)=1
Begin DoDot:1
+8 WRITE !," ",!,"*** Provider must hold YSCL AUTHORIZED key to write prescriptions for clozapine."
End DoDot:1
+9 QUIT
+10 ;
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 ; ; ** START NCC REMEDIATION ** 457 AND PSJ 327/RTW 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 ;
CRXTMP(DFN,PSOYS) ; track OP 4 day supply
+1 SET ^XTMP("PSO4D-"_DFN,0)=$$FMADD^XLFDT(DT,5)_U_DT_"^Clozapine Local Override 4 day supply tracking"
+2 SET ^XTMP("PSO4D-"_DFN,"PSOYS")=PSOYS
+3 QUIT
+4 ;
CRXTMPI(DFN,PSOYS) ; track IP 4 day supply
+1 SET ^XTMP("PSJ4D-"_DFN,0)=$$FMADD^XLFDT(DT,5)_U_DT_"^Clozapine Local Override 4 day supply tracking"
+2 SET ^XTMP("PSJ4D-"_DFN,"PSOYS")=PSOYS
+3 QUIT
+4 ;
CLKEYWRN() ; uniform message to users - PSO*7*457
+1 QUIT "Provider must hold YSCL AUTHORIZED key to write medication orders for clozapine."
+2 ;
GETREGYS(PSODFN) ; Get file 603.01 IEN currently registered to patient in file 55
+1 ;JCH - PSO*7*612
+2 NEW PSOCLZN,PSOYSIEN,PSOCLODT
+3 SET PSOCLZN=$$GET1^DIQ(55,PSODFN,53)
+4 SET PSOYSIEN=$$FIND1^DIC(603.01,,"Q",PSOCLZN,"B")
+5 QUIT PSOYSIEN
+6 ;
QTYCHK(PSORXARY,NUMDAYS) ; check/adjust quantity, PSORXARY passed by ref., NUMDAYS is # of days
+1 ; required
if '($GET(NUMDAYS)>0)
QUIT
+2 NEW J,SCHED,NMIN,QTY,TMSDLY
+3 SET J=0
SET QTY=0
FOR
SET J=$ORDER(PSORXARY("SCHEDULE",J))
if 'J
QUIT
Begin DoDot:1
+4 SET SCHED=PSORXARY("SCHEDULE",J)
+5 ;number of minutes between meds
SET NMIN=$$QTSCH^PSOSIG(SCHED)
if 'NMIN
QUIT
+6 ;times daily
SET TMSDLY=1440/NMIN
+7 SET QTY=QTY+(NUMDAYS*TMSDLY*$GET(PSORXARY("DOSE ORDERED",J)))
End DoDot:1
+8 ;
+9 if QTY
SET PSORXARY("QTY")=(QTY+.99)\1
SET $PIECE(PSORXARY("RX0"),U,7)=(QTY+.99)\1
+10 QUIT
