- PSOCLOLS ; BHAM ISC/DMA - LIST CLOZAPINE RXS ENTERED BY OVERRIDE ; 04/06/93 15:01
- ;;7.0;OUTPATIENT PHARMACY;;DEC 1997
- 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(52.52,"B",PSOBD)) W !,?5,"NO PRESCRIPTIONS FOUND",@IOF G EXIT
- I $O(^PS(52.52,"B",PSOBD))>PSOED W !,?5,"NO PRESCRIPTIONS FOUND",@IOF G EXIT
- F PSOD=PSOBD-.1:0 S PSOD=$O(^PS(52.52,"B",PSOD)) Q:'PSOD Q:PSOD>PSOED S PSOI=+$O(^(PSOD,0)) I $D(^PS(52.52,PSOI,0)) S DATA=^(0) D PRINT
- W @IOF
- EXIT D ^%ZISC K %DT,DRG,POP,PSOD,PSOI,DATA,RX,USR,APR,REA,COM,PAT,PSOBD,PSOED,X,J,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK Q
- ;
- PRINT I $Y+9>IOSL W @IOF D HD
- S RX=+$P(DATA,"^",2),USR=$P(DATA,"^",3),APR=$P(DATA,"^",4),REA=$P(DATA,"^",5),USR=$P(^VA(200,USR,0),"^"),APR=$P(^VA(200,APR,0),"^"),COM=$P(DATA,"^",6),RX=$S($D(^PSRX(RX,0)):^(0),1:""),PAT=$P(RX,"^",2),DRG=$P(RX,"^",6),RX=$P(RX,"^")
- I RX]"" S PAT=$P(^DPT(PAT,0),"^"),DRG=$P(^PSDRUG(DRG,0),"^")
- W !,?3,"Date : ",$E(PSOD,4,5),"/",$E(PSOD,6,7),"/",$E(PSOD,2,3),?25,"RX # : ",$S(RX]"":RX,1:"UNKNOWN"),?45,"Patient : ",$S(RX]"":PAT,1:"UNKNOWN")
- W !,?3,"DRUG : ",$S(RX]"":DRG,1:"UNKNOWN (PRESCRIPTION DELETED)")
- W !,?3,"Entered by : ",USR,!,?3,"Approved by : ",APR
- W !,?3,"Lockout reason : ",$P($P($P(^DD(52.52,4,0),"^",3),";",REA),":",2)
- W !,?3,"Comments : " I $L(COM)<65 W COM,!! Q
- F J=1:1 Q:$P(COM," ",J,9999)="" S X=$P(COM," ",J) W:$L(X)+$X>70 !,?14 W X," "
- W !! Q
- HD U IO W !!,?5,"LIST OF PRESCRIPTIONS 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^PSOCLOLS",ZTDESC="CLOZAPINE LIST",ZTSAVE("PSOBD")="",ZTSAVE("PSOED")="" D ^%ZTLOAD G EXIT
- PSOCLOLS ; BHAM ISC/DMA - LIST CLOZAPINE RXS ENTERED BY OVERRIDE ; 04/06/93 15:01
- +1 ;;7.0;OUTPATIENT PHARMACY;;DEC 1997
- +2 WRITE !,"Print list of clozapine prescriptions 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 SET %ZIS("B")=""
- SET %ZIS="MQ"
- DO ^%ZIS
- IF POP
- GOTO EXIT
- IF $EXTRACT(IOST)'="P"
- WRITE !,"Select a printer "
- GOTO DEV
- +1 IF $DATA(IO("Q"))
- GOTO QUE
- DQ ;Entry to report
- +1 IF $Y
- WRITE @IOF
- DO HD
- IF '$ORDER(^PS(52.52,"B",PSOBD))
- WRITE !,?5,"NO PRESCRIPTIONS FOUND",@IOF
- GOTO EXIT
- +2 IF $ORDER(^PS(52.52,"B",PSOBD))>PSOED
- WRITE !,?5,"NO PRESCRIPTIONS FOUND",@IOF
- GOTO EXIT
- +3 FOR PSOD=PSOBD-.1:0
- SET PSOD=$ORDER(^PS(52.52,"B",PSOD))
- IF 'PSOD
- QUIT
- IF PSOD>PSOED
- QUIT
- SET PSOI=+$ORDER(^(PSOD,0))
- IF $DATA(^PS(52.52,PSOI,0))
- SET DATA=^(0)
- DO PRINT
- +4 WRITE @IOF
- EXIT DO ^%ZISC
- KILL %DT,DRG,POP,PSOD,PSOI,DATA,RX,USR,APR,REA,COM,PAT,PSOBD,PSOED,X,J,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK
- QUIT
- +1 ;
- PRINT IF $Y+9>IOSL
- WRITE @IOF
- DO HD
- +1 SET RX=+$PIECE(DATA,"^",2)
- SET USR=$PIECE(DATA,"^",3)
- SET APR=$PIECE(DATA,"^",4)
- SET REA=$PIECE(DATA,"^",5)
- SET USR=$PIECE(^VA(200,USR,0),"^")
- SET APR=$PIECE(^VA(200,APR,0),"^")
- SET COM=$PIECE(DATA,"^",6)
- SET RX=$SELECT($DATA(^PSRX(RX,0)):^(0),1:"")
- SET PAT=$PIECE(RX,"^",2)
- SET DRG=$PIECE(RX,"^",6)
- SET RX=$PIECE(RX,"^")
- +2 IF RX]""
- SET PAT=$PIECE(^DPT(PAT,0),"^")
- SET DRG=$PIECE(^PSDRUG(DRG,0),"^")
- +3 WRITE !,?3,"Date : ",$EXTRACT(PSOD,4,5),"/",$EXTRACT(PSOD,6,7),"/",$EXTRACT(PSOD,2,3),?25,"RX # : ",$SELECT(RX]"":RX,1:"UNKNOWN"),?45,"Patient : ",$SELECT(RX]"":PAT,1:"UNKNOWN")
- +4 WRITE !,?3,"DRUG : ",$SELECT(RX]"":DRG,1:"UNKNOWN (PRESCRIPTION DELETED)")
- +5 WRITE !,?3,"Entered by : ",USR,!,?3,"Approved by : ",APR
- +6 WRITE !,?3,"Lockout reason : ",$PIECE($PIECE($PIECE(^DD(52.52,4,0),"^",3),";",REA),":",2)
- +7 WRITE !,?3,"Comments : "
- IF $LENGTH(COM)<65
- WRITE COM,!!
- QUIT
- +8 FOR J=1:1
- IF $PIECE(COM," ",J,9999)=""
- QUIT
- SET X=$PIECE(COM," ",J)
- IF $LENGTH(X)+$X>70
- WRITE !,?14
- WRITE X," "
- +9 WRITE !!
- QUIT
- HD USE IO
- WRITE !!,?5,"LIST OF PRESCRIPTIONS 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(PS
- OED,2,3),!
- QUIT
- +1 ;
- QUE ;queue job
- +1 SET ZTRTN="DQ^PSOCLOLS"
- SET ZTDESC="CLOZAPINE LIST"
- SET ZTSAVE("PSOBD")=""
- SET ZTSAVE("PSOED")=""
- DO ^%ZTLOAD
- GOTO EXIT
