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

PSOCLO1.m

Go to the documentation of this file. 
  1. PSOCLO1 ;BHAM ISC/SAB - clozaril rx lockout routine ; 20 Apr 1999  10:50 AM
  1.  ;;7.0;OUTPATIENT PHARMACY;**1,23,37,222**;DEC 1997;Build 12
  1.  ;External reference YSCLTST2 supported by DBIA 4556
  1.  ;External reference ^PS(55 supported by DBIA 2228
  1.  ;MH package will authorize dispensing of the Clozapine drugs
  1.  K ANQDATA,ANQX,ANQNO,PSONEW("SAND"),^TMP($J,"PSO")
  1.  N X,Y,%,%DT,J,ANQ,ANQD,ANQJ,ANQRE,DTOUT,DUOUT,DIR,DIRUT,PSOYS
  1.  I '$D(^PS(55,DFN,"SAND")) W !!,"*** This patient has not been registered in the clozapine program ***" G END
  1.  I $P(^PS(55,DFN,"SAND"),"^")="" W !!,"*** This patient has no clozapine registration number ***" G END
  1.  I $P(^PS(55,DFN,"SAND"),"^",2)="D" D  G END
  1.  .W !!,"*** This patient has been discontinued from the clozapine treatment program ***"
  1.  .W !,"*** and must have a new registration number assigned ***"
  1.  S PSOYS=$$CL^YSCLTST2(DFN)
  1.  G:+PSOYS<0 END
  1.  S CLOZPAT=$P(PSOYS,"^",7),CLOZPAT=$S(CLOZPAT="M":2,CLOZPAT="B":1,1:0)
  1.  G:$P(PSOYS,"^")=0 OV1
  1.  D DSP  G:+PSOYS=1 GDOSE
  1.  S X=$S(CLOZPAT=2:84,CLOZPAT=1:42,1:21)
  1.  D CL1^YSCLTST2(DFN,X)
  1.  I $D(^TMP($J,"PSO")) G CHECK
  1. OV1 I $$OVERRIDE^YSCLTST2(DFN) S ANQRE=7 W !!,"Permission to dispense clozapine has been authorized by NCCC",! G OVRD
  1.  D MSG4,MSG3,MH G QU
  1.  Q
  1. CHECK ;
  1.  S ANQRE=$S($P(PSOYS,"^",2)<3500:3,1:5)
  1.  S ANQD(1)=9999999-$P(PSOYS,"^",6),X1=$P(PSOYS,"^",6),X2="-6" D C^%DTC S ANQD=(9999999-$P(X,"."))
  1.  S ANQ(1)=$P(PSOYS,"^",2)_"^"_$P(PSOYS,"^",4) D
  1.  .F ANQJ=2:1:4 S ANQD=$O(^TMP($J,"PSO",ANQD)) Q:'ANQD  S ANQ(ANQJ)=^(ANQD),ANQD(ANQJ)=ANQD
  1.  S ANQD=$O(ANQ(""),-1)
  1.  I ANQD<2 W !,"*** No previous results to display ***",! G OVRD
  1.  W !,"*** Last "_$S(ANQD=4:"Four ",ANQD=3:"Three ",1:"TWO ")_$P(PSOYS,"^",3)_" and ANC results were:"
  1.  W !,?39,"WBC    ANC",!
  1.  F ANQJ=ANQD:-1:1 S ANQD=9999999-ANQD(ANQJ)_"0000" W ?5,$E(ANQD,4,5)_"/"_$E(ANQD,6,7)_"/"_($E(ANQD,1,3)+1700) W:ANQD["." "@",$E(ANQD,9,10),":",$E(ANQD,11,12) W ?29,"Results: "_$P(ANQ(ANQJ),"^")_" - "_$P(ANQ(ANQJ),"^",2),!
  1. OVRD ;
  1.  I '$D(^XUSEC("PSOLOCKCLOZ",DUZ)) D  G EXIT
  1.  .S ANQX=1 W !,"You Are Not Authorized to Override! See Clozapine Manager with PSOLOCKCLOZ key."
  1.  I ANQRE W !,"Override reason being: "_$P($T(@(ANQRE_"^PSOCLO1")),";;",2),!
  1.  S DIR("A")="Do you want to override and issue this prescription",DIR(0)="Y",DIR("B")="N" D ^DIR K DIR I 'Y!($D(DIRUT)) S ANQX=1 G EXIT
  1.  S DIC=200,DIC(0)="AEQM",DIC("A")="Approving member of the Clozapine team: ",DIC("S")="I $D(^XUSEC(""PSOLOCKCLOZ"",+Y)),+Y'=DUZ" D ^DIC K DIC S ANQD=+Y I Y<0 S ANQX=1 G EXIT
  1.  S DIR(0)="52.52,5",DIR("A")="Remarks"
  1.  D ^DIR K DIR G EXIT:$D(DIRUT)
  1.  S ANQX=0,ANQDATA=DUZ_"^"_ANQD_"^"_ANQRE_"^"_X
  1.  ;
  1. GDOSE ; set variable to ask daily dose
  1.  N PSOCD
  1. DOSE ;
  1.  S DIR(0)="N^12.5:3000:1",DIR("A")="CLOZAPINE dosage (mg/day) ? " D ^DIR K DIR G EXIT:$D(DIRUT)
  1.  S PSOCD=X
  1.  I PSOCD#25=0,PSOCD'<12.5,PSOCD<900 G EXIT
  1.  I PSOCD#12.5 S DIR(0)="Y",DIR("B")="NO",DIR("A")=PSOCD_" is an unusual dose.  Are you sure " D ^DIR K DIR G EXIT:$D(DIRUT) I 'Y G DOSE
  1.  I PSOCD>900 S DIR(0)="Y",DIR("A")="Recommended maximum daily dose is 900. Are you sure " D ^DIR K DIR G EXIT:$D(DIRUT) I 'Y G DOSE
  1. EXIT ;
  1.  K ^TMP($J,"PSO")
  1.  S:$D(DIRUT) ANQX=1
  1.  I $G(ANQX) W !!,"No Prescription entered!" K ANQDATA
  1.  E  S PSONEW("SAND")=PSOCD_"^"_$P(PSOYS,"^",2)_"^"_($P($P(PSOYS,"^",6),"."))_"^"_$P(PSOYS,"^",4)
  1.  D DIR
  1.  Q
  1. MSG3 ;
  1.  W !!,"A CBC/Differential including WBC and ANC Must Be Ordered and Monitored on a",!
  1.  W "Twice weekly basis until the WBC STABILIZES above 3500/mm3 and ANC above",!
  1.  W "2000/mm3 with no signs of infection.",!
  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 WBC>3000/mm3 and ANC>1500/mm3 and"
  1.  W !,"you wish to dispense outside the FDA and VA protocol WBC/ANC limits, document"
  1.  W !,"your request to 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.  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 !,"(Phone: 214-857-0068 Fax: 214-857-0339)."
  1.  Q
  1. MH       ;
  1.  W !,"Also make sure that the LAB tests, WBC and ANC are set up correctly in the"
  1.  W !,"Mental Health package using the CLOZAPINE MULTI TEST LINK option."
  1.  Q
  1. DSP ;
  1.  W !,"*** Most recent "_$P(PSOYS,"^",3)_" and "_$P(PSOYS,"^",5)_" (ANC) results ***"
  1.  W !,"     performed on "
  1.  S Y=$P(PSOYS,"^",6) X ^DD("DD") W $P(Y,"@")_" are: "
  1.  W !!,?5,$P(PSOYS,"^",3)_": "_$P(PSOYS,"^",2)
  1.  W !,?5,"ANC: "_$P(PSOYS,"^",4),!
  1.  Q
  1. DIR ;
  1.  W !! K DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR,DTOUT,DUOUT,DIRUT
  1.  Q
  1. END ;
  1.  D MSG5
  1. QU S ANQX=1 D DIR
  1.  Q
  1. 1 ;;NO WBC IN LAST 7 DAYS
  1. 2 ;;NO VERIFIED WBC
  1. 3 ;;LAST WBC RESULT < 3500
  1. 4 ;;3 SEQ. WBC DECREASE
  1. 5 ;;LAST ANC RESULT < 2000
  1. 6 ;;3 SEQ. ANC DECREASE
  1. 7 ;;NCCC AUTHORIZED