PSDEM3 ;BIR/LTL-Print NAOU Priority Order Report Summary Totals ; 28 Feg 95
;;3.0; CONTROLLED SUBSTANCES ;**20**;13 Feb 97
;
; Reference to DD("DD" supported by DBIA # 10017
;
PRINT ;prints data for stock drugs
K LN S $P(LN,"-",80)="",(PG,PSDOUT)=0,%DT="",X="T" D ^%DT X ^DD("DD") S RPDT=Y
I '$D(^TMP("PSDNU",$J)) D HDR W !!,?10,"***** NO DATA AVAILABLE FOR THIS REPORT *****" Q
S JJ="" F S JJ=$O(^TMP("PSDNUS",$J,JJ)) Q:JJ=""!(PSDOUT) D HDR S KK="" F S KK=$O(^TMP("PSDNUS",$J,JJ,KK)) D:KK="" NTOT Q:KK=""!(PSDOUT) D TOT
Q
HDR ;lists header information
I $E(IOST,1,2)="C-",PG 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 !,"SUMMARY NAOU/DRUG PRIORITY ORDER REPORT - DATE: "_RPDT,?70,"PAGE: ",PG,!
I ANS="N",$D(JJ) W "NAOU: ",JJ,!
I ANS="D",$D(JJ) W "DRUG: ",JJ,!
W "From ",$P(PSDATE,"^")," to ",$P(PSDATE,"^",2),!!
W !,?2,"=> ",$S(ANS="D":"NAOU",1:"DRUG"),!,"TOTAL # OF ORDERS",?30,"TOTAL QUANTITY",!,LN,!
Q
TOT Q:PSDOUT I $Y+8>IOSL D HDR
W !!,?2,"=> ",KK,!,$J(^TMP("PSDNUS",$J,JJ,KK),8),?34,$J(^TMP("PSDNUQ",$J,JJ,KK),6)
Q
NTOT Q:PSDOUT I $Y+6>IOSL D HDR
W !!,?2,"=> ",KK
W !!,$S(ANS="D":"DRUG",1:"NAOU")," Subtotal # of Orders: ",^TMP("PSDNUT",$J,JJ) W:ANS="D" " Total Quantity: ",^TMP("PSDNUQT",$J,JJ)
W !!,"Grand Total # of Orders: ",^TMP("PSDNUG",$J),!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDEM3 1350 printed Dec 13, 2024@01:45:44 Page 2
PSDEM3 ;BIR/LTL-Print NAOU Priority Order Report Summary Totals ; 28 Feg 95
+1 ;;3.0; CONTROLLED SUBSTANCES ;**20**;13 Feb 97
+2 ;
+3 ; Reference to DD("DD" supported by DBIA # 10017
+4 ;
PRINT ;prints data for stock drugs
+1 KILL LN
SET $PIECE(LN,"-",80)=""
SET (PG,PSDOUT)=0
SET %DT=""
SET X="T"
DO ^%DT
XECUTE ^DD("DD")
SET RPDT=Y
+2 IF '$DATA(^TMP("PSDNU",$JOB))
DO HDR
WRITE !!,?10,"***** NO DATA AVAILABLE FOR THIS REPORT *****"
QUIT
+3 SET JJ=""
FOR
SET JJ=$ORDER(^TMP("PSDNUS",$JOB,JJ))
if JJ=""!(PSDOUT)
QUIT
DO HDR
SET KK=""
FOR
SET KK=$ORDER(^TMP("PSDNUS",$JOB,JJ,KK))
if KK=""
DO NTOT
if KK=""!(PSDOUT)
QUIT
DO TOT
+4 QUIT
HDR ;lists header information
+1 IF $EXTRACT(IOST,1,2)="C-"
IF PG
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 !,"SUMMARY NAOU/DRUG PRIORITY ORDER REPORT - DATE: "_RPDT,?70,"PAGE: ",PG,!
+3 IF ANS="N"
IF $DATA(JJ)
WRITE "NAOU: ",JJ,!
+4 IF ANS="D"
IF $DATA(JJ)
WRITE "DRUG: ",JJ,!
+5 WRITE "From ",$PIECE(PSDATE,"^")," to ",$PIECE(PSDATE,"^",2),!!
+6 WRITE !,?2,"=> ",$SELECT(ANS="D":"NAOU",1:"DRUG"),!,"TOTAL # OF ORDERS",?30,"TOTAL QUANTITY",!,LN,!
+7 QUIT
TOT if PSDOUT
QUIT
IF $Y+8>IOSL
DO HDR
+1 WRITE !!,?2,"=> ",KK,!,$JUSTIFY(^TMP("PSDNUS",$JOB,JJ,KK),8),?34,$JUSTIFY(^TMP("PSDNUQ",$JOB,JJ,KK),6)
+2 QUIT
NTOT if PSDOUT
QUIT
IF $Y+6>IOSL
DO HDR
+1 WRITE !!,?2,"=> ",KK
+2 WRITE !!,$SELECT(ANS="D":"DRUG",1:"NAOU")," Subtotal # of Orders: ",^TMP("PSDNUT",$JOB,JJ)
if ANS="D"
WRITE " Total Quantity: ",^TMP("PSDNUQT",$JOB,JJ)
+3 WRITE !!,"Grand Total # of Orders: ",^TMP("PSDNUG",$JOB),!
+4 QUIT
