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

PSJCLOZ.m

Go to the documentation of this file.
  1. PSJCLOZ ; DAL/RJS - INPATIENT CLOZAPINE ORDER CHECK ;12 June 2019 11:36:51
  1. ;;5.0;INPATIENT MEDICATIONS ;**327**;01 DEC 15;Build 114
  1. ;
  1. CLOZ(DFN,DRUG) ;
  1. ; DFN is patient IEN, DRUG is drug file (#50) IEN
  1. I '($G(DFN)>0)!'($G(DRUG)>0) S ANQX=0 Q
  1. D PROVCHK($G(PSGPR)) Q:ANQX
  1. N RTN
  1. S RTN=$$GET1^DIQ(50,DRUG,17.5)
  1. D:$L(RTN) ^@RTN
  1. Q
  1. ;
  1. PROVCHK(PROV) ;
  1. N PSJQUIT
  1. ;
  1. S (ANQX,PSJQUIT)=0
  1. I $G(PROV) D
  1. .I '$L($$DEA^XUSER(,PROV)) D
  1. ..S (ANQX,PSJQUIT)=1
  1. ..W !," ",!,"*** Provider must have a DEA# or VA# to write prescriptions for this drug."
  1. . Q:PSJQUIT
  1. .I '$$FIND1^DIC(200.051,","_PROV_",","X","YSCL AUTHORIZED") D
  1. ..S (ANQX,PSJQUIT)=1
  1. ..W !," ",!,$$CLKEYWRN^PSOCLUTL
  1. Q
  1. BEFQUIT ;
  1. Q:'$G(QOAA)
  1. N QODS,QORF,ORMAX,ORCLPAT
  1. S QODS=$$FIND1^DIC(101.41,,"X","OR GTX DAYS SUPPLY","AB") Q:'QODS
  1. S QODS=$$FIND1^DIC(101.416,","_ORX_",","Q",QODS,"D") Q:'QODS
  1. S QODS=$$GET1^DIQ(101.416,QODS_","_ORX,.01)
  1. S QORF=$$FIND1^DIC(101.41,,"X","OR GTX REFILLS","AB") Q:'QORF
  1. S QORF=$$FIND1^DIC(101.416,","_ORX_",","Q",QORF,"D") Q:'QORF
  1. S QORF=$$GET1^DIQ(101.416,QORF_","_ORX,.01)
  1. S QORF=QORF+1
  1. S ORCLPAT=$P(ORYS,U,7)
  1. S ORMAX=$S(ORCLPAT="M":28,ORCLPAT="B":14,ORCLPAT="W":7,1:90)
  1. I QORF*QODS>ORMAX D
  1. .K ORY
  1. .S ORY=1_U_ORCLOZ
  1. .W !,?5,"Problem Ordering Clozapine Related Medication"_U_ORCLOZ
  1. .W !,?5,"*** This patient is only allowed an order with a maximum Days Supply of "_ORMAX_"."
  1. .W !,?5,"This includes the amounts added by any refills entered in with the order also."
  1. Q
  1. OVERRIDE ;
  1. I '$$FIND1^DIC(200.051,","_PROV_",","X","PSOLOCKCLOZ") D Q 1
  1. .N Y
  1. .W !," ",!," *** You are not authorized to override Clozapine orders.",!," "
  1. .K DIR S DIR(0)="E",DIR("A")="Press Return to Continue..." D ^DIR K DIR W @IOF
  1. Q
  1. PSJFILE(DFN) ;
  1. S PSJCLPAT=DFN
  1. N PSJORN,PSJORDER I $G(PSJCOM) D Q
  1. .I $G(PSGODA),$O(^TMP("PSJCOM",$J,PSGODA))'="" Q ; Put into the file 53.8 just at the end
  1. .N PSJORD1 S PSJORD1=""
  1. .F S PSJORD1=$O(^TMP("PSJCOM",$J,PSJORD1)) Q:'PSJORD1 D
  1. ..S ANQDATA=$G(^TMP("PSJCOM",$J,PSJORD1,"ANQDATA")) Q:'$L(ANQDATA)
  1. ..S PSJORN=+$P(^TMP("PSJCOM",$J,PSJORD1,0),"^",21)
  1. ..D PSJFILE1
  1. PSJFILE1 ;
  1. I $D(ANQDATA) D
  1. .F D NOW^%DTC I '$D(^PS(53.8,"B",%)) S NOW=% Q
  1. .S PSJPROV=$P(ANQDATA,"^",2),PSJ1PH=$P(ANQDATA,"^"),PSJ2PH=$P(ANQDATA,"^",5)
  1. .S PSJREASN=$P(ANQDATA,"^",3),PSJREMRK=$P(ANQDATA,"^",4)
  1. .I $G(ORO) S PSJPROV=$P(ORO,"^",4)
  1. .S:'$G(PSJORN)&$G(ORO) PSJORN=+ORO
  1. .S PSJORDER("PSJORN")=PSJORN
  1. .K DD,DO S DIC="^PS(53.8,",DIC(0)="L",DLAYGO=53.8,X=NOW
  1. .D FILE^DICN K DIC,DLAYGO,DD,DO,DA,DR
  1. .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"
  1. .D ^DIE K DIE,DA,DR
  1. .S XMY(PSJPROV)="",XMY(PSJ2PH)=""
  1. .K ANQDATA,X,Y,%,ANQREM
  1. .W !,"THE OVERRIDDEN ORDER IS COMPLETE",!
  1. .D ALERT
  1. Q
  1. ALERT ; send an alert to the TWO approving team members
  1. N RSLT
  1. S XQADATA=PSCLPAT ;
  1. S PSOLAST4=$E($$GET1^DIQ(2,PSCLPAT,.09),6,9)
  1. S XQAARCH=1,XQAFLG="D"
  1. S XQA(PSJ2PH)="",XQA(PSJPROV)="",PSCDATE=$$FMTE^XLFDT($$NOW^XLFDT)
  1. S XQAMSG=$$GET1^DIQ(2,PSCLPAT,.01)_" ("_PSOLAST4_")"_" : Clozapine Override Rx Processed: "_PSCDATE
  1. S XQAID="PSI"_","_PSCLPAT
  1. S RSLT=$$SETUP1^XQALERT
  1. W !!,"OVERRIDE ALERTS HAVE BEEN SENT TO THE APPROVING TEAM MEMBERS",!!
  1. Q
  1. ;
  1. READ ;
  1. S CLOZPAT=$P($P(XQX,"patient ",2)," BY",1)
  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
  1. Q
  1. TDD ; TOTAL DAILY DOSE INPUT
  1. D
  1. .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
  1. .S:+$G(PSJEDITO) PSGETDD=X
  1. .S:+$G(PSGCOPY) PSGCTDD=X
  1. .S PSOSAND=X
  1. Q
  1. ORD ;
  1. S PSGDRG=PSJDD
  1. I $$GET1^DIQ(50,+$G(PSGDRG),17.5)="PSOCLO1" D CLOZ(PSGP,PSGDRG) I $G(ANQX) S PSGORQF=1
  1. END ;
  1. K DIRUT,DIROUT,DIR
  1. Q
  1. ;
  1. CMPLX ;COMPLEX THEN ORDER LOGIC
  1. Q:'$$GET1^DIQ(53.1,+$G(PSGORD),125,"I")
  1. Q:+$G(PSGCOPY)
  1. D CLOZPAT,ANDTHEN
  1. Q:$G(PSGTYP)="A"
  1. I $D(PSGTYP),'$D(^TMP("PSGCPLX",$J,DFN,+$G(PSGORD))) S ^TMP("PSGCPLX",$J,DFN,+$G(PSGORD))=PSGSD,PSGCOMP=1
  1. Q
  1. CMPLX2 ;SECOND COMPLEX THEN ORDER LOGIC
  1. Q:'$$GET1^DIQ(53.1,+$G(PSGORD),125,"I")
  1. Q:+$G(PSGCOPY)
  1. D CLOZPAT,ANDTHEN
  1. I $G(PSGTYP)="A"!($G(PSGTYP)="AT") Q
  1. I $D(^TMP("PSGCPLX",$J,DFN)) D
  1. .I $O(^TMP("PSGCPLX",$J,DFN,0)) S PSGTMP=$O(^TMP("PSGCPLX",$J,DFN,0))
  1. .I +$G(PSGTMP)'=+$G(PSGORD) D
  1. ..S $P(PSGRDTX,U,1)=$G(^TMP("PSGCPLX",$J,DFN,PSGTMP))
  1. ..I $G(PSGRDTX(+$G(PSJORD),"PSGSD"))=+$G(PSGRDTX)
  1. ..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)
  1. ..D C^%DTC S PSGFD=X,PSGFDN=$$ENDD^PSGMI(PSGFD)_"^"_$$ENDTC^PSGMI(PSGFD)
  1. Q
  1. CMPLX3 ;SECOND COMPLEX THEN ORDER LOGIC
  1. Q:'$$GET1^DIQ(53.1,+$G(PSGORD),125,"I")
  1. I PSGSTAT="NON-VERIFIED" D DISPCMP(PSGORD,PSGFD) D Q
  1. .I $G(PSSD) S PSGFD=PSSD,PSGFDN=$$ENDD^PSGMI(PSGFD)_"^"_$$ENDTC^PSGMI(PSGFD) K PSSD
  1. D CLOZPAT,ANDTHEN
  1. I $G(PSGTYP)="T"!($G(PSGTYP)="TA") Q
  1. 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)
  1. D C^%DTC S PSGFD=X,PSGFDN=$$ENDD^PSGMI(PSGFD)_"^"_$$ENDTC^PSGMI(PSGFD)
  1. Q
  1. CLOZPAT ;VERIFY PATIENT IS A CLOZAPINE PATIENT
  1. K CLOZPAT
  1. I $L($$GET1^DIQ(55,DFN,53)),$$GET1^DIQ(55,DFN,54,"I")'="D" D
  1. .I $$GET1^DIQ(55,DFN,53)?1U6N S CLOZPAT=3 Q
  1. .N CLOZNUM,CLOZUID
  1. .S CLOZNUM=$$GET1^DIQ(55,DFN,53) Q:CLOZNUM=""
  1. .S CLOZUID=$$FIND1^DIC(603.01,,"X",CLOZNUM) Q:'CLOZUID
  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. ANDTHEN ;COMPLEX AND/THEN ORDER
  1. Q:'$$GET1^DIQ(53.1,+$G(PSGORD),125,"I")
  1. Q:+$G(PSGCOPY)
  1. N PSGTMP,PSGID S PSGTMP=+$$GET1^DIQ(53.1,+$G(PSGORD),125,"I"),PSGTYP=""
  1. S PSGID=$$FIND1^DIC(100.045,","_PSGTMP_",","X","CONJ","ID") I PSGID D
  1. .S PSGTYP=PSGTYP_$$GET1^DIQ(100.045,PSGID_","_PSGTMP,1)
  1. Q
  1. DISPCMP(PSGORD,PSSD) ;COMPLEX ORDER CHECK
  1. Q:'$$GET1^DIQ(53.1,+$G(PSGORD),125,"I")
  1. S PSSD=+$$GET1^DIQ(53.1,+$G(PSGORD),117,"I")
  1. Q
  1. EXTDT ;VERIFY EXTERNAL DATE
  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 ; 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. ;/RBN End of modifications for new message for IP 4 day overrride.
  1. ; ** END NCC REMEDIATION ** 457 AND PSJ 327/RTW
  1. ;
  1. COMPLEX ; Display Complex Order stop date warning message <<RJS
  1. Q:$G(PSGFLG)
  1. Q:'$$GET1^DIQ(53.1,+$G(PSGORD),125,"I")
  1. N PSGFDT ;,PSGSD,PSGYS,X,X1,X2
  1. D CLOZPAT
  1. S X1=+$G(PSGSD),X2=$S($G(CLOZPAT)=2:28,$G(CLOZPAT)=1:14,$G(CLOZPAT)=0:7,$G(CLOZPAT)=3:4,1:90)
  1. D C^%DTC S PSGFDT=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
  1. W !!,?25,"* WARNING *",!!,?10,"This order contains a requested duration."
  1. W !,?8,"Please review the system calculated stop date",!,?5,"to confirm that it is within the allowable duration"
  1. W !,?13,"of the order based on the patient's",!,?11,"authorized clozapine dispense frequency.",!
  1. W !,?10,"Order stop date should not exceed ",PSGFDT,!,!,?1,"Review the entire profile to determine appropriate action(s).",!
  1. K PSGCOMP D PAUSE^VALM1 S PSGFLG=1
  1. Q
  1. COMPLEX1 ; Display Complex Order stop date warning message <<RJS
  1. Q:$G(PSGFLG)
  1. Q:'$$GET1^DIQ(53.1,+$G(PSGORD),125,"I")
  1. N PSGFDT,MSG
  1. D:'$D(CLOZPAT) CLOZPAT
  1. S X1=+$G(PSGSD),X2=$S($G(CLOZPAT)=2:28,$G(CLOZPAT)=1:14,$G(CLOZPAT)=0:7,$G(CLOZPAT)=3:4,1:90)
  1. D C^%DTC S PSGFDT=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
  1. S MSG=$J("",25)_"* WARNING *" D INSTR^VALM1("",1,9,80,1),INSTR^VALM1(MSG,1,10,80,1)
  1. S MSG=$J("",10)_"This order contains a requested duration." D INSTR^VALM1(MSG,1,11,80,1)
  1. S MSG=$J("",8)_"Please review the system calculated stop date" D INSTR^VALM1(MSG,1,12,80,1)
  1. S MSG=$J("",5)_"to confirm that it is within the allowable duration" D INSTR^VALM1(MSG,1,13,80,1)
  1. S MSG=$J("",13)_"of the order based on the patient's" D INSTR^VALM1(MSG,1,14,80,1)
  1. S MSG=$J("",11)_"authorized clozapine dispense frequency." D INSTR^VALM1(MSG,1,15,80,1)
  1. S MSG=$J("",10)_"Order stop date should not exceed "_PSGFDT D INSTR^VALM1(MSG,1,17,80,1)
  1. S MSG=" Review the entire profile to determine appropriate action(s)." D INSTR^VALM1(MSG,1,18,80,1)
  1. N LN F LN=16,19 D INSTR^VALM1("",1,LN,80,1)
  1. K PSGCOMP D PAUSE^VALM1 S PSGFLG=1
  1. Q
  1. LASTCHLD(DFN,ON) ; Last child of Complex order or not
  1. N FL,PSORDA,PSORD1 I ON'["U",ON'["V" Q 1
  1. I ON["U" D Q:'PSORDA 1 Q:'PSORD1 1 Q 0
  1. .S PSORDA=$$GET1^DIQ(55.06,+ON_","_DFN,125,"I"),PSORD1=+$$GET1^DIQ(55.06,+ON_","_DFN,66,"I")
  1. .I 'PSORDA!'PSORD1 Q
  1. .N ORARR,MAX D LIST^DIC(100.002,","_PSORDA_",",,"I",,,,,,,"ORARR") S MAX=+ORARR("DILIST",0)
  1. .F I=1:1 Q:'$D(ORARR("DILIST",2,I)) I ORARR("DILIST",2,I)=PSORD1 Q
  1. .S:I=MAX PSORD1=0 Q
  1. I ON["V" D Q:'PSORDA 1 Q:'PSORD1 1 Q 0
  1. .S PSORDA=$$GET1^DIQ(55.01,+ON_","_DFN,150,"I"),PSORD1=+$$GET1^DIQ(55.01,+ON_","_DFN,110,"I")
  1. .I 'PSORDA!'PSORD1 Q
  1. .N ORARR,MAX D LIST^DIC(100.002,","_PSORDA_",",,"I",,,,,,,"ORARR") S MAX=+ORARR("DILIST",0)
  1. .F I=1:1 Q:'$D(ORARR("DILIST",2,I)) I ORARR("DILIST",2,I)=PSORD1 Q
  1. .S:I=MAX PSORD1=0 Q
  1. Q 1
  1. ;
  1. ISCLOZ(PSGORD,ORPSOI,DFN,PSGORDNM,PSGDRG) ; Define a clozapine order and associated drug
  1. ; PSGORD - Pending Order number (file 53.1)
  1. ; ORPSOI - ID containing Pharmacy Orderable Item number (file 50.7)
  1. ; DFN - Patient ID (file 2)
  1. ; PSGORDNM - Pharmacy order number (file 55)
  1. ; PSGDRG - Drug Code
  1. ; OROI - Orderable Item number (file 101.43)
  1. N ISCLOZ S ISCLOZ=0
  1. I $G(PSGORD) D Q ISCLOZ
  1. .I '$$GET1^DIQ(53.1,PSGORD,.01,"I") Q
  1. .S PSGDRG=$$GET1^DIQ(53.11,"1,"_+PSGORD,.01,"I") I PSGDRG D Q
  1. ..I $$GET1^DIQ(50,+$G(PSGDRG),17.5)="PSOCLO1" S ISCLOZ=1_U_PSGDRG
  1. .N ORPSOI S ORPSOI=$$GET1^DIQ(53.1,PSGORD,108,"I") I 'ORPSOI Q
  1. .D CLOZPSOI(+ORPSOI)
  1. I $G(ORPSOI) D CLOZPSOI(+ORPSOI) Q ISCLOZ
  1. I $G(DFN),$G(PSGORDNM) D Q ISCLOZ
  1. .S PSGDRG=$$GET1^DIQ(55.07,"1,"_PSGORDNM_","_DFN,.01,"I") I PSGDRG D Q
  1. ..I $$GET1^DIQ(50,+$G(PSGDRG),17.5)="PSOCLO1" S ISCLOZ=1_U_PSGDRG
  1. .N ORPSOI S ORPSOI=$$GET1^DIQ(55.06,PSGORDNM_","_DFN,108,"I") I 'ORPSOI Q
  1. .D CLOZPSOI(+ORPSOI)
  1. ;
  1. I $G(PSGDRG)>0,$$GET1^DIQ(50,$G(PSGDRG),17.5)="PSOCLO1" S ISCLOZ=1_U_PSGDRG
  1. Q ISCLOZ
  1. ;
  1. CLOZPSOI(ORPSOI) ; Define a clozapine order based on Pharmacy Orderable item
  1. N ARR,PSGDRG,CLOZFLG D FIND^DIC(50,,.01,"Q",ORPSOI,,"ASP",,,"ARR")
  1. N I F I=2:1 Q:'$D(ARR("DILIST",2,I)) S PSGDRG=+$G(ARR("DILIST",2,I)) D Q:ISCLOZ
  1. .I $$GET1^DIQ(50,PSGDRG,17.5)="PSOCLO1" S ISCLOZ=1_U_PSGDRG
  1. Q
  1. ;