PSJCLOLS ;ALB/RTW - LIST INPATIENT CLOZAPINE ORDERS ENTERED BY OVERRIDE ; 03/25/2016 10:31
 ;;5.0;INPATIENT PHARMACY;**327**;;DEC 1997
 ;RTW copied from routine PSOCLOLS and modified for the NCC Clozapine inpatient pharmacy project
 W !,"Print list of clozapine prescriptions overriding lockout",!
DATE S %DT="EAX",%DT("A")="Beginning date : " D ^%DT G EXIT:Y<0 S PSOBD=Y
 S %DT("A")="Ending date : " D ^%DT G EXIT:Y<0 S PSOED=Y+.3 I PSOED<PSOBD W !!,"Ending date must be after beginning date" G DATE
DEV S %ZIS("B")="",%ZIS="MQ" D ^%ZIS G EXIT:POP I $E(IOST)'="P" W !,"Select a printer " G DEV
 I $D(IO("Q")) G QUE
DQ ;Entry to report
 W:$Y @IOF D HD I '$O(^PS(53.8,"B",PSOBD)) W !,?5,"NO PRESCRIPTIONS FOUND",@IOF G EXIT
 I $O(^PS(53.8,"B",PSOBD))>PSOED W !,?5,"NO PRESCRIPTIONS FOUND",@IOF G EXIT
 F PSJOD=PSOBD-.1:0 S PSJOD=$O(^PS(53.8,"B",PSJOD)) Q:'PSJOD  Q:PSJOD>PSOED  S PSOI=+$O(^(PSJOD,0)) I $D(^PS(53.8,PSOI,0)) S PSJDATA=^(0) D PRINT
 W @IOF
EXIT D ^%ZISC K %DT,PSJDRG,POP,PSJOD,PSOI,PSJDATA,PSJRX,PSJUSR,PSJAPR,PSJREA,PSJCOM,PSJPAT,PSOBD,PSOED,X,J,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK Q
 ;
PRINT I $Y+9>IOSL W @IOF D HD
 Q:$P(PSJDATA,"^",2)=""!($P(PSJDATA,"^",3)="")!($P(PSJDATA,"^",4)="")!($P(PSJDATA,"^",5)="")
 S PSJORD=+$P(PSJDATA,"^",2),PSJUSR=$P(PSJDATA,"^",3),PSJAPR=$P(PSJDATA,"^",4),PSJREA=$P(PSJDATA,"^",5),PSJUSR=$P(^VA(200,PSJUSR,0),"^"),PSJAPR=$P(^VA(200,PSJAPR,0),"^"),PSJCOM=$P(PSJDATA,"^",6)
 S PSJNUM=0 F  S PSJNUM=$O(^OR(100,PSJORD,4.5,PSJNUM)) Q:'PSJNUM  D
 . I $P(^OR(100,PSJORD,4.5,PSJNUM,0),"^",4)["DRUG" D
 . . S PSJDRG=$P($G(^OR(100,PSJORD,4.5,PSJNUM,1)),"^",1)
 Q:'$D(PSJDRG)
 S PSJORD=$S($D(^OR(100,PSJORD,0)):^(0),1:""),PSJPAT=+$P(PSJORD,"^",2)
 I PSJORD]"" S PSJPAT=$P(^DPT(PSJPAT,0),"^"),PSJDRG=$P(^PSDRUG(PSJDRG,0),"^")
 W !,?3,"Date : ",$E(PSJOD,4,5),"/",$E(PSJOD,6,7),"/",$E(PSJOD,2,3),?25,"ORDER # : ",$S(PSJORD]"":$P(PSJORD,"^"),1:"UNKNOWN"),?45,"Patient : ",$S(PSJORD]"":PSJPAT,1:"UNKNOWN")
 W !,?3,"DRUG : ",$S(PSJORD]"":PSJDRG,1:"UNKNOWN (PRESCRIPTION DELETED)")
 W !,?3,"Entered by : ",PSJUSR,!,?3,"Approved by : ",PSJAPR
 W !,?3,"Lockout Reason : ",$P(^PS(52.54,PSJREA,0),"^")
 W !,?3,"Comments : " I $L(PSJCOM)<65 W PSJCOM,!! Q
 F J=1:1 Q:$P(PSJCOM," ",J,9999)=""  S X=$P(PSJCOM," ",J) W:$L(X)+$X>70 !,?14 W X," "
 W !! Q
HD U IO W !!,?5,"LIST OF ORDERS WRITTEN FOR CLOZAPINE OVERRIDING LOCKOUT",!,?10,"FOR THE DATE RANGE ",$E(PSOBD,4,5),"/",$E(PSOBD,6,7),"/",$E(PSOBD,2,3)," THROUGH ",$E(PSOED,4,5),"/",$E(PSOED,6,7),"/",$E(PSOED,2,3),! Q
 ;
QUE ;queue job
 S ZTRTN="DQ^PSJCLOLS",ZTDESC="CLOZAPINE LIST",ZTSAVE("PSOBD")="",ZTSAVE("PSOED")="" D ^%ZTLOAD G EXIT