PSDFND1 ;BIR/JPW-Pharm Filled Not Delivered Report ; 2 Aug 94
;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
SUMPRT ;prints summary
K LN S (PG,PSDOUT)=0,$P(LN,"-",80)=""
I '$D(^TMP("PSDFNDT",$J)) D SUMHDR W !!,?45,"**** NO PENDING DELIVERIES FOR THIS DISPENSING LOCATION ****",! Q
PRTSUM ;prints summary data for filled not delivered log
D SUMHDR Q:PSDOUT
S DRUG="" F S DRUG=$O(^TMP("PSDFNDT",$J,DRUG)) Q:DRUG="" D:$Y+4>IOSL SUMHDR Q:PSDOUT W !,?2,DRUG,?60,$J(+^TMP("PSDFNDT",$J,DRUG),6),!
Q
SUMHDR ;lists summary header information
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,"Narcotics Filled Not Delivered Report",?70,"Page "_PG,!,?36,RPDT,!,?35,"** SUMMARY **",!!,"Dispensing Vault: ",PSDSN,!!
W !,?58,"TOTAL FILLED",!,?5,"DRUG",?58,"NOT DISPENSED",!,LN,!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDFND1 849 printed Oct 16, 2024@17:46:55 Page 2
PSDFND1 ;BIR/JPW-Pharm Filled Not Delivered Report ; 2 Aug 94
+1 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
SUMPRT ;prints summary
+1 KILL LN
SET (PG,PSDOUT)=0
SET $PIECE(LN,"-",80)=""
+2 IF '$DATA(^TMP("PSDFNDT",$JOB))
DO SUMHDR
WRITE !!,?45,"**** NO PENDING DELIVERIES FOR THIS DISPENSING LOCATION ****",!
QUIT
PRTSUM ;prints summary data for filled not delivered log
+1 DO SUMHDR
if PSDOUT
QUIT
+2 SET DRUG=""
FOR
SET DRUG=$ORDER(^TMP("PSDFNDT",$JOB,DRUG))
if DRUG=""
QUIT
if $Y+4>IOSL
DO SUMHDR
if PSDOUT
QUIT
WRITE !,?2,DRUG,?60,$JUSTIFY(+^TMP("PSDFNDT",$JOB,DRUG),6),!
+3 QUIT
SUMHDR ;lists summary header information
+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,"Narcotics Filled Not Delivered Report",?70,"Page "_PG,!,?36,RPDT,!,?35,"** SUMMARY **",!!,"Dispensing Vault: ",PSDSN,!!
+3 WRITE !,?58,"TOTAL FILLED",!,?5,"DRUG",?58,"NOT DISPENSED",!,LN,!
+4 QUIT
