Routine: PSDPWK3

PSDPWK3 ;BIR/JPW-Print Pharm Disp. Worksheet (Summary) ; 23 Jun 94

 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97

 D NOW^%DTC S Y=+$E(%,1,12) X ^DD("DD") S RPDT=Y

 S (PG,PSDOUT)=0

 I '$D(^TMP("PSDWKT",$J)) D HDR W !!,?45,"****  NO PENDING REQUESTS FOR THIS DISPENSING LOCATION  ****" Q

PRINT ;prints data for worksheet

 D HDR Q:PSDOUT

 S LOOP="" F  S LOOP=$O(^TMP("PSDWKT",$J,LOOP)) Q:LOOP=""!(PSDOUT)  W !,?2,"=> ",LOOP D:$Y+4>IOSL HDR Q:PSDOUT  D

 .S LOOP2="" F  S LOOP2=$O(^TMP("PSDWKT",$J,LOOP,LOOP2)) Q:LOOP2=""!(PSDOUT)  D:$Y+4>IOSL HDR Q:PSDOUT  W !,LOOP2,?60,+^TMP("PSDWKT",$J,LOOP,LOOP2),!

DONE I SUM,$E(IOST)'="C" W @IOF

HDR ;lists 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

 K LN S $P(LN,"-",80)=""

 W:$Y @IOF S PG=PG+1 W !,?22,"PHARMACY DISPENSING WORKSHEET",?70,"PG "_PG,!,?29,"** SUMMARY **",!,?27,RPDT,!!,"Dispensing Location: ",PSDSN,!!

 W ?2,"=> DRUG",!,"NAOU",?55,"TOTAL TO DISPENSE",!,LN,!

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDPWK3   984     printed  Apr 09, 2024@20:53:31                                                                                                                                                                                                      Page 2

PSDPWK3   ;BIR/JPW-Print Pharm Disp. Worksheet (Summary) ; 23 Jun 94

 +1       ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97

 +2        DO NOW^%DTC

           SET Y=+$EXTRACT(%,1,12)

           XECUTE ^DD("DD")

           SET RPDT=Y

 +3        SET (PG,PSDOUT)=0

 +4        IF '$DATA(^TMP("PSDWKT",$JOB))

               DO HDR

               WRITE !!,?45,"****  NO PENDING REQUESTS FOR THIS DISPENSING LOCATION  ****"

               QUIT

PRINT     ;prints data for worksheet

 +1        DO HDR

           if PSDOUT

               QUIT

 +2        SET LOOP=""

FOR

               SET LOOP=$ORDER(^TMP("PSDWKT",$JOB,LOOP))

               if LOOP=""!(PSDOUT)

                   QUIT

               WRITE !,?2,"=> ",LOOP

               if $Y+4>IOSL

                   DO HDR

               if PSDOUT

                   QUIT

               Begin DoDot:1

 +3                SET LOOP2=""

FOR

                       SET LOOP2=$ORDER(^TMP("PSDWKT",$JOB,LOOP,LOOP2))

                       if LOOP2=""!(PSDOUT)

                           QUIT

                       if $Y+4>IOSL

                           DO HDR

                       if PSDOUT

                           QUIT

                       WRITE !,LOOP2,?60,+^TMP("PSDWKT",$JOB,LOOP,LOOP2),!

               End DoDot:1

DONE       IF SUM

               IF $EXTRACT(IOST)'="C"

                   WRITE @IOF

 +1        QUIT

HDR       ;lists 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        KILL LN

           SET $PIECE(LN,"-",80)=""

 +3        if $Y

               WRITE @IOF

           SET PG=PG+1

           WRITE !,?22,"PHARMACY DISPENSING WORKSHEET",?70,"PG "_PG,!,?29,"** SUMMARY **",!,?27,RPDT,!!,"Dispensing Location: ",PSDSN,!!

 +4        WRITE ?2,"=> DRUG",!,"NAOU",?55,"TOTAL TO DISPENSE",!,LN,!

 +5        QUIT

PSDPWK3.m