PSDEM3.m

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