PSJCLOLS ;ALB/RTW - LIST INPATIENT CLOZAPINE ORDERS ENTERED BY OVERRIDE ; 8/30/18 3:20pm
;;5.0;INPATIENT MEDICATIONS;**327**;;Build 114
;RTW copied from routine PSOCLOLS and modified for the NCC Clozapine inpatient pharmacy project
W !,"Print list of clozapine orders 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
K ^TMP($J,"PSJORDT") D LIST^DIC(53.8,,.01,"I",,PSOBD,,"B",,,"^TMP($J,""PSJORDT"")")
W:$Y @IOF D HD I '^TMP($J,"PSJORDT","DILIST",0) W !,?5,"NO ORDERS FOUND",@IOF G EXIT
I ^TMP($J,"PSJORDT","DILIST",1,1)>PSOED W !,?5,"NO ORDERS FOUND",@IOF G EXIT
F I=1:1 Q:'$D(^TMP($J,"PSJORDT","DILIST",1,I)) S PSJOD=^TMP($J,"PSJORDT","DILIST",1,I) Q:PSJOD>PSOED D
.S PSOI=+^TMP($J,"PSJORDT","DILIST",2,I)
.D GETS^DIQ(53.8,PSOI,"*","I","PSJDATA") S PSOJ=PSOI_"," D:$D(PSJDATA) PRINT
W @IOF
EXIT D ^%ZISC K %DT,PSJDRG,POP,PSJOD,PSOI,PSOJ,PSJDATA,PSJRX,PSJUSR,PSJAPR,PSJREA,PSJCOM,PSJPAT,PSOBD,PSOED,X,J,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK
K ^TMP($J,"PSJORDT") Q
;
PRINT I $Y+9>IOSL W @IOF D HD
I '$D(PSJDATA(53.8,PSOJ,1))!'$D(PSJDATA(53.8,PSOJ,2))!'$D(PSJDATA(53.8,PSOJ,3))!'$D(PSJDATA(53.8,PSOJ,4)) Q
S PSJORD=+PSJDATA(53.8,PSOJ,1,"I"),PSJUSR=PSJDATA(53.8,PSOJ,2,"I")
S PSJAPR=PSJDATA(53.8,PSOJ,3,"I"),PSJREA=PSJDATA(53.8,PSOJ,4,"I")
S PSJUSR=$$GET1^DIQ(200,PSJUSR,.01),PSJAPR=$$GET1^DIQ(200,PSJAPR,.01)
S PSJCOM=PSJDATA(53.8,PSOJ,5,"I")
S PSJNUM=$$FIND1^DIC(100.045,","_PSJORD_",","X","DRUG","ID")
S PSJDRG=$$GET1^DIQ(100.045,PSJNUM_","_PSJORD,1) Q:'$D(PSJDRG)
S PSJPAT=$$GET1^DIQ(100,PSJORD,.02),PSJDRG=$$GET1^DIQ(50,PSJDRG,.01)
W !,?3,"Date : ",$E(PSJOD,4,5),"/",$E(PSJOD,6,7),"/",$E(PSJOD,2,3),?25,"ORDER # : ",PSJORD,?45,"Patient : ",PSJPAT
W !,?3,"DRUG : ",PSJDRG
W !,?3,"Entered by : ",PSJUSR,!,?3,"Approved by : ",PSJAPR
W !,?3,"Lockout Reason : ",$$GET1^DIQ(52.54,PSJREA,.01)
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJCLOLS 2642 printed Apr 09, 2024@21:07:49 Page 2
PSJCLOLS ;ALB/RTW - LIST INPATIENT CLOZAPINE ORDERS ENTERED BY OVERRIDE ; 8/30/18 3:20pm
+1 ;;5.0;INPATIENT MEDICATIONS;**327**;;Build 114
+2 ;RTW copied from routine PSOCLOLS and modified for the NCC Clozapine inpatient pharmacy project
+3 WRITE !,"Print list of clozapine orders overriding lockout",!
DATE SET %DT="EAX"
SET %DT("A")="Beginning date : "
DO ^%DT
if Y<0
GOTO EXIT
SET PSOBD=Y
+1 SET %DT("A")="Ending date : "
DO ^%DT
if Y<0
GOTO EXIT
SET PSOED=Y+.3
IF PSOED<PSOBD
WRITE !!,"Ending date must be after beginning date"
GOTO DATE
DEV ;I $E(IOST)'="P" W !,"Select a printer " G DEV
SET %ZIS("B")=""
SET %ZIS="MQ"
DO ^%ZIS
if POP
GOTO EXIT
+1 IF $DATA(IO("Q"))
GOTO QUE
DQ ;Entry to report
+1 KILL ^TMP($JOB,"PSJORDT")
DO LIST^DIC(53.8,,.01,"I",,PSOBD,,"B",,,"^TMP($J,""PSJORDT"")")
+2 if $Y
WRITE @IOF
DO HD
IF '^TMP($JOB,"PSJORDT","DILIST",0)
WRITE !,?5,"NO ORDERS FOUND",@IOF
GOTO EXIT
+3 IF ^TMP($JOB,"PSJORDT","DILIST",1,1)>PSOED
WRITE !,?5,"NO ORDERS FOUND",@IOF
GOTO EXIT
+4 FOR I=1:1
if '$DATA(^TMP($JOB,"PSJORDT","DILIST",1,I))
QUIT
SET PSJOD=^TMP($JOB,"PSJORDT","DILIST",1,I)
if PSJOD>PSOED
QUIT
Begin DoDot:1
+5 SET PSOI=+^TMP($JOB,"PSJORDT","DILIST",2,I)
+6 DO GETS^DIQ(53.8,PSOI,"*","I","PSJDATA")
SET PSOJ=PSOI_","
if $DATA(PSJDATA)
DO PRINT
End DoDot:1
+7 WRITE @IOF
EXIT DO ^%ZISC
KILL %DT,PSJDRG,POP,PSJOD,PSOI,PSOJ,PSJDATA,PSJRX,PSJUSR,PSJAPR,PSJREA,PSJCOM,PSJPAT,PSOBD,PSOED,X,J,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK
+1 KILL ^TMP($JOB,"PSJORDT")
QUIT
+2 ;
PRINT IF $Y+9>IOSL
WRITE @IOF
DO HD
+1 IF '$DATA(PSJDATA(53.8,PSOJ,1))!'$DATA(PSJDATA(53.8,PSOJ,2))!'$DATA(PSJDATA(53.8,PSOJ,3))!'$DATA(PSJDATA(53.8,PSOJ,4))
QUIT
+2 SET PSJORD=+PSJDATA(53.8,PSOJ,1,"I")
SET PSJUSR=PSJDATA(53.8,PSOJ,2,"I")
+3 SET PSJAPR=PSJDATA(53.8,PSOJ,3,"I")
SET PSJREA=PSJDATA(53.8,PSOJ,4,"I")
+4 SET PSJUSR=$$GET1^DIQ(200,PSJUSR,.01)
SET PSJAPR=$$GET1^DIQ(200,PSJAPR,.01)
+5 SET PSJCOM=PSJDATA(53.8,PSOJ,5,"I")
+6 SET PSJNUM=$$FIND1^DIC(100.045,","_PSJORD_",","X","DRUG","ID")
+7 SET PSJDRG=$$GET1^DIQ(100.045,PSJNUM_","_PSJORD,1)
if '$DATA(PSJDRG)
QUIT
+8 SET PSJPAT=$$GET1^DIQ(100,PSJORD,.02)
SET PSJDRG=$$GET1^DIQ(50,PSJDRG,.01)
+9 WRITE !,?3,"Date : ",$EXTRACT(PSJOD,4,5),"/",$EXTRACT(PSJOD,6,7),"/",$EXTRACT(PSJOD,2,3),?25,"ORDER # : ",PSJORD,?45,"Patient : ",PSJPAT
+10 WRITE !,?3,"DRUG : ",PSJDRG
+11 WRITE !,?3,"Entered by : ",PSJUSR,!,?3,"Approved by : ",PSJAPR
+12 WRITE !,?3,"Lockout Reason : ",$$GET1^DIQ(52.54,PSJREA,.01)
+13 WRITE !,?3,"Comments : "
IF $LENGTH(PSJCOM)<65
WRITE PSJCOM,!!
QUIT
+14 FOR J=1:1
if $PIECE(PSJCOM," ",J,9999)=""
QUIT
SET X=$PIECE(PSJCOM," ",J)
if $LENGTH(X)+$X>70
WRITE !,?14
WRITE X," "
+15 WRITE !!
QUIT
HD USE IO
WRITE !!,?5,"LIST OF ORDERS WRITTEN FOR CLOZAPINE OVERRIDING LOCKOUT",!,?10,"FOR THE DATE RANGE ",$EXTRACT(PSOBD,4,5),"/",$EXTRACT(PSOBD,6,7),"/",$EXTRACT(PSOBD,2,3)," THROUGH ",$EXTRACT(PSOED,4,5),"/",$EXTRACT(PSOED,6,7),"/",$EXTRACT(PSOED,2,3
),!
QUIT
+1 ;
QUE ;queue job
+1 SET ZTRTN="DQ^PSJCLOLS"
SET ZTDESC="CLOZAPINE LIST"
SET ZTSAVE("PSOBD")=""
SET ZTSAVE("PSOED")=""
DO ^%ZTLOAD
GOTO EXIT
