- 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 Mar 13, 2025@20:52:50 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
