- 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 Feb 18, 2025@23:32:45 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
