PSDPND1 ;BIR/JPW-Pharm Dispensing Report (cont'd) ; 2 Aug 94
;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
PRINT ;print pharmacy disp log by date
I SUM S PG=0 D SUMPRT G DONE
S (PG,PSDOUT)=0
K LN S $P(LN,"-",132)="" I '$D(^TMP("PSDND",$J)) D HDR W !!,?45,"**** NO DISPENSING DATA FOR THIS DISPENSING LOCATION ****" G DONE
D HDR S NUM="" F S NUM=$O(^TMP("PSDND",$J,NUM)) Q:NUM=""!(PSDOUT) D:$Y+4>IOSL HDR Q:PSDOUT D
.F PSD=0:0 S PSD=$O(^TMP("PSDND",$J,NUM,PSD)) Q:'PSD!(PSDOUT) D:$Y+4>IOSL HDR Q:PSDOUT S NODE=^TMP("PSDND",$J,NUM,PSD) W !,NUM,?15,$P(NODE,"^"),?58,$J($P(NODE,"^",3),6),?68,$P(NODE,"^",4),?86,$P(NODE,"^",2),?112,$P(NODE,"^",5)
I $E(IOST,1,2)="C-",'PSDOUT W !!,"Press <RET> to return to display the summary totals" R X:DTIME
D:'PSDOUT SUMPRT
DONE I $E(IOST)'="C" W @IOF
I $E(IOST,1,2)="C-",'PSDOUT W ! K DIR,DIRUT S DIR(0)="EA",DIR("A")="END OF REPORT! Press <RET> to return to the menu" D ^DIR K DIR
Q
HDR ;header for log
I $E(IOST,1,2)="C-",PG W ! K DA,DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSDOUT=1 Q
S PG=PG+1 W:$Y @IOF W !,?45,"Pharmacy Dispensing Report",?115,"Page: ",PG,!,?45,"Dispensing Vault: "_PSDSN,!,?45,$P(PSDATE,"^")_" to "_$P(PSDATE,"^",2)
W !!,?58,"QUANTITY",?71,"DATE"
W !,"DISP #",?15,"DRUG",?58,"DISPENSED",?71,"DISP",?86,"DISPENSED TO",?112,"DISPENSED BY"
W !,LN,!
Q
SUMPRT ;prt sum
K LN S (PG,PSDOUT)=0,$P(LN,"-",80)=""
I '$D(^TMP("PSDNDT",$J)) D SUMHDR W !!,?45,"**** NO DISPENSING DATA FOR THIS DISPENSING LOCATION ****" Q
PRTSUM ;prints summary data
D SUMHDR Q:PSDOUT
S DRUG="" F S DRUG=$O(^TMP("PSDNDT",$J,DRUG)) Q:DRUG="" D:$Y+4>IOSL SUMHDR Q:PSDOUT W !,?2,DRUG,?60,$J(+^TMP("PSDNDT",$J,DRUG),6),!
Q
SUMHDR ;sum header
I $E(IOST,1,2)="C-",PG W ! K DA,DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSDOUT=1 Q
W:$Y @IOF S PG=PG+1 W !,?25,"Pharmacy Dispensing Report",?70,"Page "_PG,!,?25,$P(PSDATE,"^")_" to "_$P(PSDATE,"^",2),!,?31,"** SUMMARY **",!!,"Dispensing Vault: ",PSDSN,!!
W ?5,"DRUG",?57,"TOTAL DISPENSED",!,LN,!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDPND1 2019 printed Apr 09, 2024@20:53:45 Page 2
PSDPND1 ;BIR/JPW-Pharm Dispensing Report (cont'd) ; 2 Aug 94
+1 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
PRINT ;print pharmacy disp log by date
+1 IF SUM
SET PG=0
DO SUMPRT
GOTO DONE
+2 SET (PG,PSDOUT)=0
+3 KILL LN
SET $PIECE(LN,"-",132)=""
IF '$DATA(^TMP("PSDND",$JOB))
DO HDR
WRITE !!,?45,"**** NO DISPENSING DATA FOR THIS DISPENSING LOCATION ****"
GOTO DONE
+4 DO HDR
SET NUM=""
FOR
SET NUM=$ORDER(^TMP("PSDND",$JOB,NUM))
if NUM=""!(PSDOUT)
QUIT
if $Y+4>IOSL
DO HDR
if PSDOUT
QUIT
Begin DoDot:1
+5 FOR PSD=0:0
SET PSD=$ORDER(^TMP("PSDND",$JOB,NUM,PSD))
if 'PSD!(PSDOUT)
QUIT
if $Y+4>IOSL
DO HDR
if PSDOUT
QUIT
SET NODE=^TMP("PSDND",$JOB,NUM,PSD)
WRITE !,NUM,?15,$PIECE(NODE,"^"),?58,$JUSTIFY($PIECE(NODE,"^",3),6),?68,$PIECE(NODE,"^",4),?86,$PIECE(NODE,"^",2),?112,$PIECE(NODE,"^",5)
End DoDot:1
+6 IF $EXTRACT(IOST,1,2)="C-"
IF 'PSDOUT
WRITE !!,"Press <RET> to return to display the summary totals"
READ X:DTIME
+7 if 'PSDOUT
DO SUMPRT
DONE IF $EXTRACT(IOST)'="C"
WRITE @IOF
+1 IF $EXTRACT(IOST,1,2)="C-"
IF 'PSDOUT
WRITE !
KILL DIR,DIRUT
SET DIR(0)="EA"
SET DIR("A")="END OF REPORT! Press <RET> to return to the menu"
DO ^DIR
KILL DIR
+2 QUIT
HDR ;header for log
+1 IF $EXTRACT(IOST,1,2)="C-"
IF PG
WRITE !
KILL DA,DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET PSDOUT=1
QUIT
+2 SET PG=PG+1
if $Y
WRITE @IOF
WRITE !,?45,"Pharmacy Dispensing Report",?115,"Page: ",PG,!,?45,"Dispensing Vault: "_PSDSN,!,?45,$PIECE(PSDATE,"^")_" to "_$PIECE(PSDATE,"^",2)
+3 WRITE !!,?58,"QUANTITY",?71,"DATE"
+4 WRITE !,"DISP #",?15,"DRUG",?58,"DISPENSED",?71,"DISP",?86,"DISPENSED TO",?112,"DISPENSED BY"
+5 WRITE !,LN,!
+6 QUIT
SUMPRT ;prt sum
+1 KILL LN
SET (PG,PSDOUT)=0
SET $PIECE(LN,"-",80)=""
+2 IF '$DATA(^TMP("PSDNDT",$JOB))
DO SUMHDR
WRITE !!,?45,"**** NO DISPENSING DATA FOR THIS DISPENSING LOCATION ****"
QUIT
PRTSUM ;prints summary data
+1 DO SUMHDR
if PSDOUT
QUIT
+2 SET DRUG=""
FOR
SET DRUG=$ORDER(^TMP("PSDNDT",$JOB,DRUG))
if DRUG=""
QUIT
if $Y+4>IOSL
DO SUMHDR
if PSDOUT
QUIT
WRITE !,?2,DRUG,?60,$JUSTIFY(+^TMP("PSDNDT",$JOB,DRUG),6),!
+3 QUIT
SUMHDR ;sum header
+1 IF $EXTRACT(IOST,1,2)="C-"
IF PG
WRITE !
KILL DA,DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET PSDOUT=1
QUIT
+2 if $Y
WRITE @IOF
SET PG=PG+1
WRITE !,?25,"Pharmacy Dispensing Report",?70,"Page "_PG,!,?25,$PIECE(PSDATE,"^")_" to "_$PIECE(PSDATE,"^",2),!,?31,"** SUMMARY **",!!,"Dispensing Vault: ",PSDSN,!!
+3 WRITE ?5,"DRUG",?57,"TOTAL DISPENSED",!,LN,!
+4 QUIT
