PSOCLOLS ; HEC/hrub ;4 May 2019 18:48:29
;;7.0;OUTPATIENT PHARMACY;**457,593**;DEC 1997;Build 2
;
W !,"Print clozapine prescriptions with lockout override.",!
D DT^DICRW N %ZIS,DIR,PSOCLDT
S DIR(0)="DA^:"_DT_":XE",DIR("A")="Override Beginning date: " D ^DIR G EXIT:'(Y>0) S PSOCLDT("beg")=Y
K DIR S DIR(0)="DA^"_Y_":"_DT_":XE",DIR("A")=" Override Ending date: " D ^DIR G EXIT:Y<0 S PSOCLDT("end")=Y
K %ZIS S %ZIS="Q" D ^%ZIS G EXIT:POP
I $D(IO("Q")) D QUE G EXIT
DQ ; List of Override Prescriptions [PSOLIST OVERRIDES] report
N PSIEN,PSOHDR,PSOLPDT,X
S PSOHDR(1)=" Clozapine Lockout Override Prescriptions - "_$$FMTE^XLFDT($$NOW^XLFDT)_" Page: "
S PSOHDR(2)=" From "_$$FMTE^XLFDT(PSOCLDT("beg"))_" through "_$$FMTE^XLFDT(PSOCLDT("end"))
S PSOHDR(0,"pg#")=0
W:$Y @IOF D PGHDR(.PSOHDR) I '$O(^PS(52.52,"B",PSOCLDT("beg"))) D NOTFND(.PSOHDR) G EXIT
I $O(^PS(52.52,"B",PSOCLDT("beg")))>PSOCLDT("end") D NOTFND(.PSOHDR) G EXIT
S PSOLPDT=PSOCLDT("beg")-.1,PSOLPDT("stop")=0 ; PSOLPDT("stop") - flag to exit loop
F S PSOLPDT=$O(^PS(52.52,"B",PSOLPDT)) Q:'PSOLPDT!PSOLPDT("stop")!(PSOLPDT>PSOCLDT("end")) D
. S PSIEN=0 F S PSIEN=$O(^PS(52.52,"B",PSOLPDT,PSIEN)) Q:'PSIEN S X=$G(^PS(52.52,PSIEN,0)) D:$L(X) PRINT(X)
;
D:'PSOLPDT("stop") RPTEND ; only if user didn't enter '^'
;
EXIT ;
D ^%ZISC Q
;
PRINT(OVRDND) ;OVRDND - zero node of entry in file 52.52
I $Y+7>IOSL D
. I '$G(ZTSK),$E(IOST,1,2)="C-" D ; only if interactive user
.. N DIR S DIR(0)="E" D ^DIR S:'Y PSOLPDT("stop")=1
. I 'PSOLPDT("stop") W @IOF D PGHDR(.PSOHDR)
N CLUSR,RPTLN,RXCLO,Y
S RXCLO("rxIen")=+$P(OVRDND,U,2),RXCLO("ntryDuz")=+$P(OVRDND,U,3),RXCLO("apprvDuz")=+$P(OVRDND,U,4),RXCLO("ovrdRsn")=$P(OVRDND,U,6)
S RXCLO("ntryNm")=$P($G(^VA(200,RXCLO("ntryDuz"),0)),U),RXCLO("apprvNm")=$P($G(^VA(200,RXCLO("apprvDuz"),0)),U)
S RXCLO("cmmnt")=$P(OVRDND,U,6),RXCLO("rxZroNd")=$S($D(^PSRX(RXCLO("rxIen"),0)):^(0),1:""),RXCLO("rxDfn")=$P(RXCLO("rxZroNd"),U,2),RXCLO("rxDrgIen")=$P(RXCLO("rxZroNd"),U,6),RXCLO("rx#")=$P(RXCLO("rxZroNd"),U)
I RXCLO("rxIen") S RXCLO("rxPtNm")=$P(^DPT(RXCLO("rxDfn"),0),U),RXCLO("drugNm")=$P($G(^PSDRUG(RXCLO("rxDrgIen"),0)),U)
S Y=$$FMTE^XLFDT(PSOLPDT,2),RPTLN="Date: "_Y_$J(" ",18-$L(Y))_" Rx #"_$S(RXCLO("rxIen"):RXCLO("rx#"),1:" UNKNOWN (Rx Deleted)")
S RPTLN=RPTLN_" Patient: "_$S(RXCLO("rxIen"):RXCLO("rxPtNm"),1:"UNKNOWN")
W !,RPTLN
W !," Drug: "_$S(RXCLO("rxIen"):RXCLO("drugNm"),1:"UNKNOWN (PRESCRIPTION DELETED)")
W !," Entered by: "_RXCLO("ntryNm")_" Approved by: "_RXCLO("apprvNm")
W !," Override reason: "_$P(RXCLO("ovrdRsn"),":",2)
W !," Comments: "_RXCLO("cmmnt"),!
Q
PGHDR(PSOHDR) ; header, PSOHDR passed by ref.
S PSOHDR(0,"pg#")=PSOHDR(0,"pg#")+1
U IO W !,PSOHDR(1)_PSOHDR(0,"pg#"),!,PSOHDR(2),! Q
;
RPTEND ;
W !," ** End of Clozapine Override Report **",! Q
QUE ;queue job
N ZTDESC,ZTRTN,ZTSAVE,ZTSK
S ZTRTN="DQ^"_$T(+0),ZTDESC="Clozapine Override Report",ZTSAVE("PSOCLDT(")="" D ^%ZTLOAD ;593 Added ( to ZTSAVE
W !,$S($G(ZTSK):"Override Report queued as task #"_ZTSK,1:"* Report NOT queued.")
Q
;
NOTFND(PSOHDR) ;
W !," * No CLOZAPINE PRESCRIPTION OVERRIDES"_PSOHDR(2)_" *",!
D RPTEND
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOCLOLS 3231 printed Oct 16, 2024@18:26:05 Page 2
PSOCLOLS ; HEC/hrub ;4 May 2019 18:48:29
+1 ;;7.0;OUTPATIENT PHARMACY;**457,593**;DEC 1997;Build 2
+2 ;
+3 WRITE !,"Print clozapine prescriptions with lockout override.",!
+4 DO DT^DICRW
NEW %ZIS,DIR,PSOCLDT
+5 SET DIR(0)="DA^:"_DT_":XE"
SET DIR("A")="Override Beginning date: "
DO ^DIR
if '(Y>0)
GOTO EXIT
SET PSOCLDT("beg")=Y
+6 KILL DIR
SET DIR(0)="DA^"_Y_":"_DT_":XE"
SET DIR("A")=" Override Ending date: "
DO ^DIR
if Y<0
GOTO EXIT
SET PSOCLDT("end")=Y
+7 KILL %ZIS
SET %ZIS="Q"
DO ^%ZIS
if POP
GOTO EXIT
+8 IF $DATA(IO("Q"))
DO QUE
GOTO EXIT
DQ ; List of Override Prescriptions [PSOLIST OVERRIDES] report
+1 NEW PSIEN,PSOHDR,PSOLPDT,X
+2 SET PSOHDR(1)=" Clozapine Lockout Override Prescriptions - "_$$FMTE^XLFDT($$NOW^XLFDT)_" Page: "
+3 SET PSOHDR(2)=" From "_$$FMTE^XLFDT(PSOCLDT("beg"))_" through "_$$FMTE^XLFDT(PSOCLDT("end"))
+4 SET PSOHDR(0,"pg#")=0
+5 if $Y
WRITE @IOF
DO PGHDR(.PSOHDR)
IF '$ORDER(^PS(52.52,"B",PSOCLDT("beg")))
DO NOTFND(.PSOHDR)
GOTO EXIT
+6 IF $ORDER(^PS(52.52,"B",PSOCLDT("beg")))>PSOCLDT("end")
DO NOTFND(.PSOHDR)
GOTO EXIT
+7 ; PSOLPDT("stop") - flag to exit loop
SET PSOLPDT=PSOCLDT("beg")-.1
SET PSOLPDT("stop")=0
+8 FOR
SET PSOLPDT=$ORDER(^PS(52.52,"B",PSOLPDT))
if 'PSOLPDT!PSOLPDT("stop")!(PSOLPDT>PSOCLDT("end"))
QUIT
Begin DoDot:1
+9 SET PSIEN=0
FOR
SET PSIEN=$ORDER(^PS(52.52,"B",PSOLPDT,PSIEN))
if 'PSIEN
QUIT
SET X=$GET(^PS(52.52,PSIEN,0))
if $LENGTH(X)
DO PRINT(X)
End DoDot:1
+10 ;
+11 ; only if user didn't enter '^'
if 'PSOLPDT("stop")
DO RPTEND
+12 ;
EXIT ;
+1 DO ^%ZISC
QUIT
+2 ;
PRINT(OVRDND) ;OVRDND - zero node of entry in file 52.52
+1 IF $Y+7>IOSL
Begin DoDot:1
+2 ; only if interactive user
IF '$GET(ZTSK)
IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:2
+3 NEW DIR
SET DIR(0)="E"
DO ^DIR
if 'Y
SET PSOLPDT("stop")=1
End DoDot:2
+4 IF 'PSOLPDT("stop")
WRITE @IOF
DO PGHDR(.PSOHDR)
End DoDot:1
+5 NEW CLUSR,RPTLN,RXCLO,Y
+6 SET RXCLO("rxIen")=+$PIECE(OVRDND,U,2)
SET RXCLO("ntryDuz")=+$PIECE(OVRDND,U,3)
SET RXCLO("apprvDuz")=+$PIECE(OVRDND,U,4)
SET RXCLO("ovrdRsn")=$PIECE(OVRDND,U,6)
+7 SET RXCLO("ntryNm")=$PIECE($GET(^VA(200,RXCLO("ntryDuz"),0)),U)
SET RXCLO("apprvNm")=$PIECE($GET(^VA(200,RXCLO("apprvDuz"),0)),U)
+8 SET RXCLO("cmmnt")=$PIECE(OVRDND,U,6)
SET RXCLO("rxZroNd")=$SELECT($DATA(^PSRX(RXCLO("rxIen"),0)):^(0),1:"")
SET RXCLO("rxDfn")=$PIECE(RXCLO("rxZroNd"),U,2)
SET RXCLO("rxDrgIen")=$PIECE(RXCLO("rxZroNd"),U,6)
SET RXCLO("rx#")=$PIECE(RXCLO("rxZroNd"),U)
+9 IF RXCLO("rxIen")
SET RXCLO("rxPtNm")=$PIECE(^DPT(RXCLO("rxDfn"),0),U)
SET RXCLO("drugNm")=$PIECE($GET(^PSDRUG(RXCLO("rxDrgIen"),0)),U)
+10 SET Y=$$FMTE^XLFDT(PSOLPDT,2)
SET RPTLN="Date: "_Y_$JUSTIFY(" ",18-$LENGTH(Y))_" Rx #"_$SELECT(RXCLO("rxIen"):RXCLO("rx#"),1:" UNKNOWN (Rx Deleted)")
+11 SET RPTLN=RPTLN_" Patient: "_$SELECT(RXCLO("rxIen"):RXCLO("rxPtNm"),1:"UNKNOWN")
+12 WRITE !,RPTLN
+13 WRITE !," Drug: "_$SELECT(RXCLO("rxIen"):RXCLO("drugNm"),1:"UNKNOWN (PRESCRIPTION DELETED)")
+14 WRITE !," Entered by: "_RXCLO("ntryNm")_" Approved by: "_RXCLO("apprvNm")
+15 WRITE !," Override reason: "_$PIECE(RXCLO("ovrdRsn"),":",2)
+16 WRITE !," Comments: "_RXCLO("cmmnt"),!
+17 QUIT
PGHDR(PSOHDR) ; header, PSOHDR passed by ref.
+1 SET PSOHDR(0,"pg#")=PSOHDR(0,"pg#")+1
+2 USE IO
WRITE !,PSOHDR(1)_PSOHDR(0,"pg#"),!,PSOHDR(2),!
QUIT
+3 ;
RPTEND ;
+1 WRITE !," ** End of Clozapine Override Report **",!
QUIT
QUE ;queue job
+1 NEW ZTDESC,ZTRTN,ZTSAVE,ZTSK
+2 ;593 Added ( to ZTSAVE
SET ZTRTN="DQ^"_$TEXT(+0)
SET ZTDESC="Clozapine Override Report"
SET ZTSAVE("PSOCLDT(")=""
DO ^%ZTLOAD
+3 WRITE !,$SELECT($GET(ZTSK):"Override Report queued as task #"_ZTSK,1:"* Report NOT queued.")
+4 QUIT
+5 ;
NOTFND(PSOHDR) ;
+1 WRITE !," * No CLOZAPINE PRESCRIPTION OVERRIDES"_PSOHDR(2)_" *",!
+2 DO RPTEND
+3 QUIT
+4 ;
