- 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
- 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
