PSDPAT2.m

PSDPAT2 ;B'ham ISC/JPW - Print Patient/Drug Report (summary) ; 1 Feb 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,$P(LN,"-",80)=""

 I '$D(^TMP("PSDPATL",$J)) D HDR W !!,?45,"****  NO DISPENSING SUMMARY  ****" Q

PRINT ;prints data for dispensing

 D HDR Q:PSDOUT

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

 .W !,LOOP,?55,$J(+$P(^TMP("PSDPATL",$J,LOOP),"^",3),6),?70,$J(+$P(^(LOOP),"^",2),6),!

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

 Q

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

 W:$Y @IOF S PG=PG+1 W !,?22,"ACTIVITY",?70,"PG "_PG,!,?29,"** SUMMARY **",!,?27,"Date: ",$P(PSDATE,"^")," to ",$P(PSDATE,"^",2),!!,"NAOU: ",NAOUN,!!

 W "DRUG",?55,"QUANTITY USED",?70,"BALANCE",!,LN,!

 Q

PSDPAT2   ;B'ham ISC/JPW - Print Patient/Drug Report (summary) ; 1 Feb 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

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

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

               DO HDR

               WRITE !!,?45,"****  NO DISPENSING SUMMARY  ****"

               QUIT 

PRINT     ;prints data for dispensing

 +1        DO HDR

           IF PSDOUT

               QUIT 

 +2        SET LOOP=""

           FOR 

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

               IF LOOP=""!(PSDOUT)

                   QUIT 

               IF $Y+4>IOSL

                   DO HDR

               IF PSDOUT

                   QUIT 

               Begin DoDot:1

 +3                WRITE !,LOOP,?55,$JUSTIFY(+$PIECE(^TMP("PSDPATL",$JOB,LOOP),"^",3),6),?70,$JUSTIFY(+$PIECE(^(LOOP),"^",2),6),!

               End DoDot:1

               IF PSDOUT

                   QUIT 

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        IF $Y

               WRITE @IOF

           SET PG=PG+1

           WRITE !,?22,"ACTIVITY",?70,"PG "_PG,!,?29,"** SUMMARY **",!,?27,"Date: ",$PIECE(PSDATE,"^")," to ",$PIECE(PSDATE,"^",2),!!,"NAOU: ",NAOUN,!!

 +3        WRITE "DRUG",?55,"QUANTITY USED",?70,"BALANCE",!,LN,!

 +4        QUIT