PSDACT2.m

PSDACT2 ;BIR/JPW-Print Daily Activity Log (cont'd) ; 2 Aug 94

 ;;3.0; CONTROLLED SUBSTANCES ;**30**;13 Feb 97

PRINT ;prints data

 K LN S (CNT,FLAG,PG,PSDOUT)=0,$P(LN,"-",132)=""

 I '$D(^TMP("PSDACT",$J)) D HDR W !!,?15,"**** NO DAILY ACTIVITY ****",!! G DONE

 S PSDRG="" F  S PSDRG=$O(^TMP("PSDACT",$J,PSDRG)) Q:PSDRG=""!(PSDOUT)  S PG=0 D PAGE Q:PSDOUT  D HDR Q:PSDOUT  S CNT=1 W !,?5,"=> ",PSDRG F PSD=0:0 S PSD=$O(^TMP("PSDACT",$J,PSDRG,PSD)) Q:'PSD!(PSDOUT)  D

 .F TYP=0:0 S TYP=$O(^TMP("PSDACT",$J,PSDRG,PSD,TYP)) Q:'TYP!(PSDOUT)  F PSDA=0:0 S PSDA=$O(^TMP("PSDACT",$J,PSDRG,PSD,TYP,PSDA)) Q:'PSDA!(PSDOUT)  S NODE=^TMP("PSDACT",$J,PSDRG,PSD,TYP,PSDA) D

 ..W:CNT ?115,$P(NODE,"^"),!! S CNT=0,FLAG=1

 ..I $Y+4>IOSL D HDR Q:PSDOUT  W !,?5,"=> ",PSDRG,?115,$P(NODE,"^")

 ..S Y=PSD X ^DD("DD") S DATE=Y

 ..;Dave B (PSD*3*30) Include Returned to stock indicator.

 ..W !,DATE,?22,$P(NODE,"^",2),?45,$P(NODE,"^",3),?95,$J($P(NODE,"^",4),6) W:$P(NODE,"^",6)=1 " (RTS)" W ?115,$P(NODE,"^")+$P(NODE,"^",4),?128,$P(NODE,"^",5)

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

 I $E(IOST,1,2)="C-",'PSDOUT W ! K DIR,DIRUT S DIR(0)="EA",DIR("A")="END OF REPORT!  Press <RET> to return to the menu" D ^DIR K DIR

END ;

 D KVAR^VADPT

 K %,%DT,%H,%I,%ZIS,ACT,ALL,BFWD,C,CNT,DA,DATE,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,FLAG,LN,MFG,NAOU,NODE,NQTY,NUM

 K PAT,PG,PHARM,POP,PSD,PSDA,PSDATE,PSDED,PSDEV,PSDIO,PSDOUT,PSDPN,PSDR,PSDRG,PSDRGN,PSDS,PSDSD,PSDSN,PSDUZ,PSDUZN,RX,TEXT,TYP,QTY,TYP,TYPE,X,Y,VA("BID"),VA("PID")

 K ^TMP("PSDACT",$J),ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK

 D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"

 Q

HDR ;header

 I $E(IOST,1,2)="C-",PG K DA,DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSDOUT=1 Q

 S PG=PG+1 W:$Y @IOF W !,?20,"Daily Activity Log for ",PSDSN,?115,"Page: ",PG,!,?20,"Date: ",$P(PSDATE,"^")," to ",$P(PSDATE,"^",2),!!

 W "DATE/TIME",?22,"NUMBER",?45,"TYPE OF ACTIVITY",?95,"QUANTITY",?115,"BALANCE",?128,"BY",!,LN,!!

 Q

PAGE ;page stop after each drug

 I $E(IOST,1,2)="C-",FLAG W !! K DA,DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSDOUT=1 Q

 Q

PSDACT2   ;BIR/JPW-Print Daily Activity Log (cont'd) ; 2 Aug 94

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

PRINT     ;prints data

 +1        KILL LN

           SET (CNT,FLAG,PG,PSDOUT)=0

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

 +2        IF '$DATA(^TMP("PSDACT",$JOB))

               DO HDR

               WRITE !!,?15,"**** NO DAILY ACTIVITY ****",!!

               GOTO DONE

 +3        SET PSDRG=""

           FOR 

               SET PSDRG=$ORDER(^TMP("PSDACT",$JOB,PSDRG))

               IF PSDRG=""!(PSDOUT)

                   QUIT 

               SET PG=0

               DO PAGE

               IF PSDOUT

                   QUIT 

               DO HDR

               IF PSDOUT

                   QUIT 

               SET CNT=1

               WRITE !,?5,"=> ",PSDRG

               FOR PSD=0:0

                   SET PSD=$ORDER(^TMP("PSDACT",$JOB,PSDRG,PSD))

                   IF 'PSD!(PSDOUT)

                       QUIT 

                   Begin DoDot:1

 +4                    FOR TYP=0:0

                           SET TYP=$ORDER(^TMP("PSDACT",$JOB,PSDRG,PSD,TYP))

                           IF 'TYP!(PSDOUT)

                               QUIT 

                           FOR PSDA=0:0

                               SET PSDA=$ORDER(^TMP("PSDACT",$JOB,PSDRG,PSD,TYP,PSDA))

                               IF 'PSDA!(PSDOUT)

                                   QUIT 

                               SET NODE=^TMP("PSDACT",$JOB,PSDRG,PSD,TYP,PSDA)

                               Begin DoDot:2

 +5                                IF CNT

                                       WRITE ?115,$PIECE(NODE,"^"),!!

                                   SET CNT=0

                                   SET FLAG=1

 +6                                IF $Y+4>IOSL

                                       DO HDR

                                       IF PSDOUT

                                           QUIT 

                                       WRITE !,?5,"=> ",PSDRG,?115,$PIECE(NODE,"^")

 +7                                SET Y=PSD

                                   XECUTE ^DD("DD")

                                   SET DATE=Y

 +8       ;Dave B (PSD*3*30) Include Returned to stock indicator.

 +9                                WRITE !,DATE,?22,$PIECE(NODE,"^",2),?45,$PIECE(NODE,"^",3),?95,$JUSTIFY($PIECE(NODE,"^",4),6)

                                   IF $PIECE(NODE,"^",6)=1

                                       WRITE " (RTS)"

                                   WRITE ?115,$PIECE(NODE,"^")+$PIECE(NODE,"^",4),?128,$PIECE(NODE,"^",5)

                               End DoDot:2

                   End DoDot:1

DONE       IF $EXTRACT(IOST)'="C"

               WRITE @IOF

 +1        IF $EXTRACT(IOST,1,2)="C-"

               IF 'PSDOUT

                   WRITE !

                   KILL DIR,DIRUT

                   SET DIR(0)="EA"

                   SET DIR("A")="END OF REPORT!  Press <RET> to return to the menu"

                   DO ^DIR

                   KILL DIR

END       ;

 +1        DO KVAR^VADPT

 +2        KILL %,%DT,%H,%I,%ZIS,ACT,ALL,BFWD,C,CNT,DA,DATE,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,FLAG,LN,MFG,NAOU,NODE,NQTY,NUM

 +3        KILL PAT,PG,PHARM,POP,PSD,PSDA,PSDATE,PSDED,PSDEV,PSDIO,PSDOUT,PSDPN,PSDR,PSDRG,PSDRGN,PSDS,PSDSD,PSDSN,PSDUZ,PSDUZN,RX,TEXT,TYP,QTY,TYP,TYPE,X,Y,VA("BID"),VA("PID")

 +4        KILL ^TMP("PSDACT",$JOB),ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK

 +5        DO ^%ZISC

           IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +6        QUIT 

HDR       ;header

 +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        SET PG=PG+1

           IF $Y

               WRITE @IOF

           WRITE !,?20,"Daily Activity Log for ",PSDSN,?115,"Page: ",PG,!,?20,"Date: ",$PIECE(PSDATE,"^")," to ",$PIECE(PSDATE,"^",2),!!

 +3        WRITE "DATE/TIME",?22,"NUMBER",?45,"TYPE OF ACTIVITY",?95,"QUANTITY",?115,"BALANCE",?128,"BY",!,LN,!!

 +4        QUIT 

PAGE      ;page stop after each drug

 +1        IF $EXTRACT(IOST,1,2)="C-"

               IF FLAG

                   WRITE !!

                   KILL DA,DIR

                   SET DIR(0)="E"

                   DO ^DIR

                   KILL DIR

                   IF 'Y

                       SET PSDOUT=1

                       QUIT 

 +2        QUIT