Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOCLUTL

PSOCLUTL.m

Go to the documentation of this file. 
  1. 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
  1.  ;External reference ^YSCL(603.01 supported by DBIA 2697
  1.  ;External reference ^PS(55 supported by DBIA 2228
  1.  ;
  1. REG ; Register Clozapine Patient
  1.  N DIC,DIR,PSOCZPTS,PSOERR
  1.  ; Added "M" to the DIC(0)  ; PSO*7.0*574
  1.  S DIC=55,DLAYGO=55,DIC(0)="AEQLM",DIC("A")="Select patient to register: " D ^DIC K DIC,DLAYGO G END:Y<0
  1.  S PSO1=+Y,PSONAME=$$GET1^DIQ(2,PSO1,.01)
  1.  D:$$GET1^DIQ(55,PSO1,52.1,"I")'=2 EN^PSOHLUP(PSO1) N ANQX
  1.  ; BEGIN: JCH - PSO*7*612
  1.  D FIND^DIC(603.01,"","","QX",PSO1,"","C","","","PSOCZPTS","PSOERR")  ; Look for all NCC authorizations in 603.01
  1.  ; PSO*7.0*574
  1.  ;I '$$FIND1^DIC(603.01,,"Q",PSO1,"C") D  Q
  1.  I '$G(PSOCZPTS("DILIST",0)) D  Q  ; No NCC authorizations on file
  1.  . N DIR,X,Y
  1.  . W !!,PSONAME_" has not been authorized for Clozapine"
  1.  . W !,"by the NCCC (National Clozapine Coordinating Center)."
  1.  . W !,"This option is only available for known NCCC-registered patients."
  1.  . W !,"To dispense clozapine under a temporary registration for an authorized emergency"
  1.  . W !,"override situation, use the VistA Patient Prescription Processing option."
  1.  . W !,"Contact the NCCC during regular business hours for registration.",!
  1.  . S DIR(0)="E",DIR("A")="Press enter" D ^DIR
  1.  ; END: JCH - PSO*7*612
  1.  ;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=""
  1.  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
  1. NUMBER ;
  1.  S DIR(0)="55,53",Y=$$GET1^DIQ(603.01,$$FIND1^DIC(603.01,,"Q",PSO1,"C"),.01)
  1.  S:Y]"" DIR("B")=Y
  1.  D ^DIR S PSO2=Y K DIR I $D(DIRUT) W !,"Not registered",! D END G REG
  1.  N PSOEX S PSOEX=$$FIND1^DIC(55,,"X",PSO2,"ASAND1")
  1.  I PSOEX,PSOEX'=PSO1 W !,PSO2," is already assigned to ",$$GET1^DIQ(2,PSOEX,.01) W !,"Please contact your supervisor" D END G REG
  1.  I '$D(JADOVER),'$$FIND1^DIC(603.01,"","X",PSO2,"B") D  I '$G(%) W ! G NUMBER
  1.  . W !!,"The NCCC in Dallas has not authorized "_PSO2_" to be used",!
  1.  . W "at this facility.  Contact the NCCC in Dallas for authorization." D OVER
  1. NUMBER1 ;
  1.  S PSO3="A"  ; (#54) CLOZAPINE STATUS
  1. PHY ;
  1.  N DIC,DIR
  1.  S DIC="^VA(200,",DIC(0)="AEQMZ",DIC("A")="Provider responsible: ",DIC("S")="I $$GET1^DIQ(200,+Y,53.1)]"""""
  1.  D ^DIC K DIC I Y<0 D END D  G:'$G(PSCLOZ) REG G END1
  1.  .I '$G(PSCLOZ) W !!,"Not registered",!! Q
  1.  .S ANQX=1 Q
  1.  I $G(PSCLOZ) D PROVCHK(+Y) G:$G(ANQX) PHY
  1.  S PSO4=+Y
  1.  ;/RBN Begin NCC changes Ask if okay to register the unregistered patient - PSO*7.0*457
  1.  N DFN,VADM S DFN=PSO1 D DEM^VADPT
  1.  S SSN=$P(VADM(2),"^")
  1.  S LSTFOUR=$E(SSN,6,9)
  1.  I '$G(PSCLOZ) D
  1.  . S DIR("A",1)="OK to register "_PSONAME_" ("_$G(LSTFOUR)_")"_" with number "_PSO2
  1.  . S DIR("A")="as a"_$S('PSO3:" new",1:"n ongoing")_" patient in this program? "
  1.  I $G(PSCLOZ) D
  1.  . S DIR("A",2)="Would you like to override the registration requirement"
  1.  . S DIR("A",1)="and assign a temporary local authorization number"
  1.  . S DIR("A")="for  "_PSONAME_" ("_$G(LSTFOUR)_")"_" with number "_PSO2_"? "
  1.  S DIR(0)="YA",DIR("B")="NO" D ^DIR K DIR I Y=0!($D(DUOUT)) S ANQX=1 D END G END1
  1.  ;/RBN End NCC changes to remove Pretreatment choice - PSO*7.0*457
  1. SAVE ;
  1.  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
  1.  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
  1.  D ^DIE L -^PS(55,DA)
  1.  S:PSO2?1U6N $P(^XTMP("PSJ CLOZ",0),U,4)=PSO2  ; save last temp reg#
  1.  ; BEGIN: JCH-PSO*7*612
  1.  I PSO2?2U5N K ^XTMP("PSJ4D-"_PSO1),^XTMP("PSO4D-"_PSO1)  ; Registering new NCCC clozapine authorization makes previous local overrides obsolete
  1.  ; END: JCH-PSO*7*612
  1. END ;
  1.  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
  1.  I '$G(PSCLOZ) K ^TMP($J),^TMP("PSO",$J)
  1.  Q
  1. END1 ;
  1.  I $G(ANQX) W !!,"Patient Not Registered"
  1.  Q
  1.  ;
  1. FACILITY ;Enter facility DEA number to set up clozapine system
  1.  ;this entry point is no longer used.  this functionality was taken over
  1.  ;by the mental health package with the release of YS*5.01*18
  1.  ;W ! S DIC=59,DIC(0)="AEQM",DIC("A")="Select site to participate in clozapine program : " D ^DIC G END:Y<0
  1.  ;S DIE=DIC,DA=+Y,DR="1R;2R;" L +^PS(59,DA) D ^DIE L -^PS(59,DA) G FACILITY
  1.  Q
  1.  ;
  1.  ;
  1. AGAIN ; re-enter patient - new number, status and provider
  1.  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)
  1.  I $$GET1^DIQ(55,DA,53)="" W !,PSONAME_" is not registered.  Use the register option." G AGAIN
  1.  ; BEGIN: JCH - PSO*7*612
  1.  ;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=""
  1.  N PSOCZPTS,PSOERR
  1.  D FIND^DIC(603.01,"","","QX",PSO1,"","C","","","PSOCZPTS","PSOERR")  ; Look for all NCC authorizations in 603.01
  1.  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=""
  1.  ; END: JCH - PSO*7*612
  1.  S DIR(0)="55,53" D ^DIR G END:$D(DIRUT) S PSO2=Y
  1.  N PSOEX S PSOEX=$$FIND1^DIC(55,,"X",PSO2,"ASAND1")
  1.  I PSOEX,PSOEX'=PSO1 W !,PSO2," already assigned to ",$$GET1^DIQ(2,PSOEX,.01) G END
  1.  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
  1.  W !,"CLOZAPINE STATUS: "_$$GET1^DIQ(55,PSO1,54)
  1.  S PSO3=$$GET1^DIQ(55,PSO1,54,"I")
  1. PHY1 ;
  1.  S DIR(0)="55,57" D ^DIR G END:$D(DIRUT) I Y S PSO4=+Y
  1.  ;I $$GET1^DIQ(200,PSO4,53.2)="" D  G PHY1
  1.  ;. W !!,"Only providers with DEA numbers entered in the New Person",!,"file can register patients in this program.",!!
  1.  ;*545
  1.  I $$DEA^XUSER(0,PSO4)="" D  G PHY1
  1.  .W !!,"Only providers with DEA numbers entered in the New Person",!,"file can register patients in this program.",!!
  1.  I $$GET1^DIQ(55,PSO1,53)=PSO2,$$GET1^DIQ(55,PSO1,57,"I")=PSO4 D  G END
  1.  . W !!?5,"No changes made.",$C(7),!
  1.  G SAVE
  1.  ;
  1. OVER ;allow registration of patients and clozapine numbers not yet authorized by the NCCC.
  1.  K DIR,% W ! S DIR("A")="Do you want to override this warning",DIR(0)="Y",DIR("B")="No" D ^DIR
  1.  I Y S %=1
  1.  K DIR,DIRUT,DUOUT Q
  1.  ;
  1. CLOZPAT ;VERIFY PATIENT IS A CLOZAPINE PATIENT
  1.  K CLOZPAT,CLOZST S CLOZST=$$GET1^DIQ(55,DFN,54,"I")
  1.  I $L(CLOZST),CLOZST'="D" D
  1.  .N CLOZNUM,CLOZUID S CLOZNUM=$$GET1^DIQ(55,DFN,53)
  1.  .I CLOZNUM?1U6N S CLOZPAT=3 Q
  1.  .S CLOZUID=$$FIND1^DIC(603.01,,"X",CLOZNUM) Q:'CLOZUID  ;Q:'$D(^YSCL(603.01,CLOZUID,0))
  1.  .S CLOZPAT=$$GET1^DIQ(603.01,CLOZUID,2,"I")
  1.  .S CLOZPAT=$S($G(CLOZPAT)="M":2,$G(CLOZPAT)="B":1,$G(CLOZPAT)="W":0,1:90)
  1.  Q
  1.  ;
  1. PROVCHK(PROV) ;
  1.  N PSJQUIT S (ANQX,PSJQUIT)=0 I '$G(PROV) Q
  1.  ;I '$L($$DEA^XUSER(,PROV)) S (ANQX,PSJQUIT)=1 D  Q
  1.  ;.W !," ",!,"*** Provider must have a DEA# or VA# to write prescriptions for this drug."
  1.  ;*545
  1.  I $$DEA^XUSER(0,PROV)']"" S (ANQX,PSJQUIT)=1 D  Q
  1.  .W !!,"Only providers with DEA numbers entered in the New Person",!,"file can register patients in this program.",!!
  1.  I '$$FIND1^DIC(200.051,","_PROV_",","X","YSCL AUTHORIZED") S (ANQX,PSJQUIT)=1 D
  1.  .W !," ",!,"*** Provider must hold YSCL AUTHORIZED key to write prescriptions for clozapine."
  1.  Q
  1.  ;
  1. MSG1 ;
  1.  W !!,"Permission to dispense clozapine has been denied. The results of the latest",!
  1.  W "Lab Test drawn in the past 7 days show ANC results but No Matching WBC.",!
  1.  W "If you wish to dispense outside the FDA and VA protocol ANC limits,",!
  1.  W "document your request to Request for Override of Pharmacy Lockout ",!
  1.  W "(from VHA Handbook 1160.02) Director of the",!
  1.  W "VA National Clozapine Coordinating Center",!
  1.  W "(Phone: 214-857-0068 Fax: 214-857-0339) for a one-time override permission.",!
  1.  W !,"No order entered!"
  1.  S ANQX=1
  1.  Q
  1. MSG2 ;
  1.  W !!,"Permission to dispense clozapine has been denied. The results of the latest",!
  1.  W "Lab Test drawn in the past 7 days show No ANC results. If you wish to dispense",!
  1.  W "outside the FDA and VA protocol ANC limits, document your request to Request",!
  1.  W "for Override of Pharmacy Lockout (from VHA Handbook 1160.02) Director of the",!
  1.  W "VA National Clozapine Coordinating Center",!
  1.  W "(Phone: 214-857-0068 Fax: 214-857-0339) for a one-time override permission.",!
  1.  W !,"No order entered!"
  1.  S ANQX=1
  1.  Q
  1. MSG3 ;
  1.  W !,"A CBC/Differential including ANC Must Be Ordered and Monitored on a",!
  1.  W "Daily basis until the ANC above 1000/mm3 with no signs of infection.",!
  1.  W "If ANC is between 1000-1499, therapy can be continued but physician must order",!
  1.  W "lab test three times weekly."
  1.  Q
  1. MSG4 ;
  1.  W !,"Permission to dispense clozapine has been denied. If the results of the latest"
  1.  W !,"Lab Test drawn in the past 7 days show ANC below 1000/mm3 and you wish to"
  1.  W !,"dispense outside the FDA and VA protocol ANC limits, document your request to"
  1.  W !,"Request for Override of Pharmacy Lockout (from VHA Handbook 1160.02)"
  1.  W !,"Director of the VA National Clozapine Coordinating Center"
  1.  W !,"(Phone: 214-857-0068 Fax: 214-857-0339) for a one-time override permission.",!
  1.  S ANQX=1
  1.  Q
  1. MSG5 ;
  1.  W !!,"Permission to dispense clozapine has been denied. Please contact the"
  1.  W !,"Director of the VA National Clozapine Coordinating Center"
  1.  W !!,"Request for Override of Pharmacy Lockout (from VHA Handbook 1160.02)"
  1.  W !,"(Phone: 214-857-0068 Fax: 214-857-0339).",!
  1.  Q
  1. MSG6 ; ; ** START NCC REMEDIATION ** 457 AND PSJ 327/RTW MSG 6 added for new critically low ANC levels clozapine override requirements
  1.  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."
  1.  W !!,"Please contact the NCCC to request an override in order to proceed with dispensing this drug. "
  1.  W !!,"Request for Override of Pharmacy Lockout (from VHA Handbook 1160.02)"
  1.  W !!,"The matching ANC counts which caused the lockout are of lab test results performed on "
  1.  S ANQX=1,Y=$P(PSOYS,"^",6) X ^DD("DD") W $P(Y,"@")
  1.  W !!,?5,"ANC: "_$P(PSOYS,"^",4),!
  1.  Q
  1. MSG9 ;
  1.  W !,"*** Permission to dispense clozapine has been denied based on the available"
  1.  W !,"    lab tests related to the clozapine treatment program. ***"
  1.  W !!,"For a National Override to dispense at the patient's normal frequency,"
  1.  W !,"please contact the VA National Clozapine Coordinating Center to request"
  1.  W !,"an Override of Pharmacy Lockout (from VHA Handbook 1160.02)"
  1.  W !,"(Phone: 214-857-0068 Fax: 214-857-0339)."
  1.  W !,"A Special Conditions Local Override can be approved for"
  1.  W !,"(1) weather-related conditions, (2) mail order delays of clozapine, or"
  1.  W !,"(3) inpatient going on leave. With Provider's documentation of approval,"
  1.  W !,"you may dispense a one-time supply not to exceed 4 days.",!
  1.  Q
  1.  ;
  1.  ;/RBN Begin of modifications for new message for IP 4 day overrride.
  1. MSG10 ;
  1.  W !,"*** Permission to dispense clozapine has been denied based on the available"
  1.  W !,"    lab tests related to the clozapine treatment program. ***"
  1.  W !!,"For a National Override to dispense at the patient's normal frequency,"
  1.  W !,"please contact the VA National Clozapine Coordinating Center to request an"
  1.  W !,"Override of Pharmacy Lockout (from VHA Handbook 1160.02) (Phone: 214-857-0068"
  1.  W !,"Fax: 214-857-0339)."
  1.  W !,"A Special Conditions Local Override for Inpatients can be approved for an"
  1.  W !,"IP Override Order with Outside Lab Results. With Provider's documentation of"
  1.  W !,"approval, you may dispense a one-time IP supply not to exceed 4 days."
  1.  W !,"The ANC from another facility must be recorded in the Progress note/comments"
  1.  W !,"in pharmacy"
  1.  Q
  1.  ;
  1. CRXTMP(DFN,PSOYS) ; track OP 4 day supply
  1.  S ^XTMP("PSO4D-"_DFN,0)=$$FMADD^XLFDT(DT,5)_U_DT_"^Clozapine Local Override 4 day supply tracking"
  1.  S ^XTMP("PSO4D-"_DFN,"PSOYS")=PSOYS
  1.  Q
  1.  ;
  1. CRXTMPI(DFN,PSOYS) ; track IP 4 day supply
  1.  S ^XTMP("PSJ4D-"_DFN,0)=$$FMADD^XLFDT(DT,5)_U_DT_"^Clozapine Local Override 4 day supply tracking"
  1.  S ^XTMP("PSJ4D-"_DFN,"PSOYS")=PSOYS
  1.  Q
  1.  ;
  1. CLKEYWRN() ; uniform message to users - PSO*7*457
  1.  Q "Provider must hold YSCL AUTHORIZED key to write medication orders for clozapine."
  1.  ;
  1. GETREGYS(PSODFN)   ; Get file 603.01 IEN currently registered to patient in file 55
  1.  ;JCH - PSO*7*612
  1.  N PSOCLZN,PSOYSIEN,PSOCLODT
  1.  S PSOCLZN=$$GET1^DIQ(55,PSODFN,53)
  1.  S PSOYSIEN=$$FIND1^DIC(603.01,,"Q",PSOCLZN,"B")
  1.  Q PSOYSIEN
  1.  ;
  1. QTYCHK(PSORXARY,NUMDAYS) ; check/adjust quantity, PSORXARY passed by ref., NUMDAYS is # of days
  1.  Q:'($G(NUMDAYS)>0)  ; required
  1.  N J,SCHED,NMIN,QTY,TMSDLY
  1.  S J=0,QTY=0 F  S J=$O(PSORXARY("SCHEDULE",J))  Q:'J  D
  1.  . S SCHED=PSORXARY("SCHEDULE",J)
  1.  . S NMIN=$$QTSCH^PSOSIG(SCHED) Q:'NMIN   ;number of minutes between meds
  1.  . S TMSDLY=1440/NMIN  ;times daily
  1.  . S QTY=QTY+(NUMDAYS*TMSDLY*$G(PSORXARY("DOSE ORDERED",J)))
  1.  ;
  1.  S:QTY PSORXARY("QTY")=(QTY+.99)\1,$P(PSORXARY("RX0"),U,7)=(QTY+.99)\1
  1.  Q