PSDGSRV2.m

PSDGSRV2 ;BIR/BJW-Print(VA FORM 10-2321) for Ret Stk/Destroy ; 20 SEP 96

 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97

DEV ;asks device and queueing information

 W !!,"This report is designed for a 132 column format.",!,"You may queue this report to print at a later time.",!!

 I $G(OK)'=1 S Y=$P($G(^PSD(58.8,+PSDS,2)),"^",9),C=$P(^DD(58.8,24,0),"^",2) D Y^DIQ S PSDEV=Y

 K %ZIS,IOP,IO("Q"),POP S %ZIS="QM",%ZIS("B")=$G(PSDEV) D ^%ZIS I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED!" Q

 I $D(IO("Q")) K IO("Q"),ZTIO,ZTSAVE,ZTDTH,ZTSK S ZTRTN="START^PSDGSRV2",ZTDESC="CS PHARM Print (VA FORM 10-2321) RET/DEST/TRANS" D SAVE,^%ZTLOAD,HOME^%ZIS K ZTSK G END

 U IO

 ;5/16/96 added test for temp. file created in psdesto

START K LN S $P(LN,"-",132)="" I '$D(^TMP("PSDESTO",$J)) F JJ=1:1:NUM D PRINT

 I $D(^TMP("PSDESTO",$J)) D PRTMP

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 ;

 K %ZIS,C,COMP,CPBY,EXP,JJ,LN,LOT,MFG,NBKU,NODE,NUM,OCOMP,PG,POP,PSDA,PSDCOMS,PSDCT,PSDEV,PSDHLD,PSDOK,PSDOUT,PSDPN,PSDR,PSDRN,PSDS,PSDTYP,PSDUZ,REAS,RECDT,RQTY,X,Y,ZTDESC,ZTRTN,ZTSAVE,ZTDTH,ZTSK

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

 Q

PRINT ;print 2321 for ret/stk and destroys(psdcoms added for e3r# 3771)

 S PG=PG+1 W:$Y @IOF W:$D(REPRINT) !,?55,"*** REPRINT ***" W !,?5,"VA FORM 10-2321",?42,"Narcotic Dispensing/Receiving Report for ",$P($G(^PSD(58.8,+PSDS,0)),"^")

 W ?120,"Page: ",PG,!,?52,RECDT,!

 W !,?14,"DATE",?78,"DATE"

 W !,"DISP #",?12,"DISPENSED",?24,"QTY",?33,"DRUG",?78,"ORD",?90,"ORDERED BY"

 W !,LN,!!

 W:$D(PSDHLD) ?5,"Destruction # ",PSDHLD,!!

 W:$D(PSDPN) PSDPN W ?12,RECDT,?24,RQTY,?33,PSDRN

 I (MFG]"")!(LOT]"")!(EXP]"") W !,?33,"Mfg/Lot #/Exp Date:  ",MFG_"  "_LOT_"  "_EXP,!

 W !!,?7,$S($D(PSDOK):"Witnessed",1:"Disp")," by:___________________________________",?61,$S($D(PSDOK):"Witnessed",1:"Rec'd")," by:___________________________________"

 W !,?15,"(Full Name)",?69,"(Full Name)",!

 W:$D(PSDCOMS) !,?16,"COMMENTS: ",PSDCOMS

 I $D(COMP) W !!!,?15,"*** ",$S(COMP=999:"TRANSFERRED BETWEEN NAOUs",COMP=3:"RETURNED TO STOCK",1:"TURNED IN FOR DESTRUCTION")," ***  ",REAS I $D(AOUN),$D(NAOUTN) W " from "_AOUN_" to "_NAOUTN

 W !

 Q

HDR ;5/16/96 added Hdr,Prtmp for ret/stk or destroys

 S PG=PG+1 W:$Y @IOF W:$D(REPRINT) !,?55,"*** REPRINT ***" W !,?5,"VA FORM 10-2321",?42,"Narcotic Dispensing/Receiving Report for ",$P($G(^PSD(58.8,+PSDS,0)),"^")

 W ?120,"Page: ",PG,!,?52,RECDT,!

 W !,?14,"DATE",?78,"DATE"

 W !,"DISP #",?12,"DISPENSED",?24,"QTY",?33,"DRUG",?78,"ORD",?90,"ORDERED BY"

 W !,LN,!!

 Q

PRTMP ; print 2321 fr temp file

 S PSDHLD=""

 F JJ=1:1:NUM F  S PSDHLD=$O(^TMP("PSDESTO",$J,PSDHLD)) Q:PSDHLD=""  S NODE=^TMP("PSDESTO",$J,PSDHLD) D HDR D

 .I PSDHLD="" Q

 .W ?5,"Destruction # ",PSDHLD W !!,?12,$P(NODE,"^",2),?24,$P(NODE,"^",4),?33,$P(NODE,"^",3)

 .I (MFG]"")!(LOT]"")!(EXP]"") W !,?33,"Mfg/Lot #/Exp Date:  ",MFG_"  "_LOT

 .W !!,?7,$S($D(PSDOK):"Witnessed",1:"Disp")," by:_____________________________________",?61,$S($D(PSDOK):"Witnessed",1:"Rec'd")," by:____________________________________"

 .W !,?15,"(Full Name)",?69,"(Full Name)",!

 .W !,?16,"COMMENTS: ",$P(NODE,"^",5)

 .I $D(COMP) W !!!,?15,"*** ",$S(COMP=999:"TRANSFERRED BETWEEN NAOUs",COMP=3:"RETURNED TO STOCK",1:"TURNED IN FOR DESTRUCTION")," ***  ",REAS I $D(AOUN),$D(NAOUTN) W " from "_AOUN_" to "_NAOUTN

 Q

SAVE ;

 S (ZTSAVE("REAS"),ZTSAVE("PG"),ZTSAVE("MFG"),ZTSAVE("LOT"),ZTSAVE("EXP"),ZTSAVE("RECDT"),ZTSAVE("PSDCOMS"),ZTSAVE("PSDRN"),ZTSAVE("NUM"),ZTSAVE("RECDT"),ZTSAVE("RQTY"))=""

 S:$D(PSDPN) ZTSAVE("PSDPN")="" S:$D(PSDHLD) ZTSAVE("PSDHLD")=""

 S:$D(PSDS) ZTSAVE("PSDS")="" S:$D(COMP) ZTSAVE("COMP")=""

 S:$D(AOUN) ZTSAVE("AOUN")="" S:$D(NAOUTN) ZTSAVE("NAOUTN")=""

 S:$D(REPRINT) ZTSAVE("REPRINT")=""

 S:$D(PSDOK) ZTSAVE("PSDOK")=""

 S:$D(PSDCOMS) ZTSAVE("PSDCOMS")=""

 S ZTSAVE("^TMP(""PSDESTO"",$J,")=""

 Q

PSDGSRV2  ;BIR/BJW-Print(VA FORM 10-2321) for Ret Stk/Destroy ; 20 SEP 96

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

DEV       ;asks device and queueing information

 +1        WRITE !!,"This report is designed for a 132 column format.",!,"You may queue this report to print at a later time.",!!

 +2        IF $GET(OK)'=1

               SET Y=$PIECE($GET(^PSD(58.8,+PSDS,2)),"^",9)

               SET C=$PIECE(^DD(58.8,24,0),"^",2)

               DO Y^DIQ

               SET PSDEV=Y

 +3        KILL %ZIS,IOP,IO("Q"),POP

           SET %ZIS="QM"

           SET %ZIS("B")=$GET(PSDEV)

           DO ^%ZIS

           IF POP

               WRITE !,"NO DEVICE SELECTED OR REPORT PRINTED!"

               QUIT 

 +4        IF $DATA(IO("Q"))

               KILL IO("Q"),ZTIO,ZTSAVE,ZTDTH,ZTSK

               SET ZTRTN="START^PSDGSRV2"

               SET ZTDESC="CS PHARM Print (VA FORM 10-2321) RET/DEST/TRANS"

               DO SAVE

               DO ^%ZTLOAD

               DO HOME^%ZIS

               KILL ZTSK

               GOTO END

 +5        USE IO

 +6       ;5/16/96 added test for temp. file created in psdesto

START      KILL LN

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

           IF '$DATA(^TMP("PSDESTO",$JOB))

               FOR JJ=1:1:NUM

                   DO PRINT

 +1        IF $DATA(^TMP("PSDESTO",$JOB))

               DO PRTMP

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        KILL %ZIS,C,COMP,CPBY,EXP,JJ,LN,LOT,MFG,NBKU,NODE,NUM,OCOMP,PG,POP,PSDA,PSDCOMS,PSDCT,PSDEV,PSDHLD,PSDOK,PSDOUT,PSDPN,PSDR,PSDRN,PSDS,PSDTYP,PSDUZ,REAS,RECDT,RQTY,X,Y,ZTDESC,ZTRTN,ZTSAVE,ZTDTH,ZTSK

 +2        DO ^%ZISC

           IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +3        QUIT 

PRINT     ;print 2321 for ret/stk and destroys(psdcoms added for e3r# 3771)

 +1        SET PG=PG+1

           IF $Y

               WRITE @IOF

           IF $DATA(REPRINT)

               WRITE !,?55,"*** REPRINT ***"

           WRITE !,?5,"VA FORM 10-2321",?42,"Narcotic Dispensing/Receiving Report for ",$PIECE($GET(^PSD(58.8,+PSDS,0)),"^")

 +2        WRITE ?120,"Page: ",PG,!,?52,RECDT,!

 +3        WRITE !,?14,"DATE",?78,"DATE"

 +4        WRITE !,"DISP #",?12,"DISPENSED",?24,"QTY",?33,"DRUG",?78,"ORD",?90,"ORDERED BY"

 +5        WRITE !,LN,!!

 +6        IF $DATA(PSDHLD)

               WRITE ?5,"Destruction # ",PSDHLD,!!

 +7        IF $DATA(PSDPN)

               WRITE PSDPN

           WRITE ?12,RECDT,?24,RQTY,?33,PSDRN

 +8        IF (MFG]"")!(LOT]"")!(EXP]"")

               WRITE !,?33,"Mfg/Lot #/Exp Date:  ",MFG_"  "_LOT_"  "_EXP,!

 +9        WRITE !!,?7,$SELECT($DATA(PSDOK):"Witnessed",1:"Disp")," by:___________________________________",?61,$SELECT($DATA(PSDOK):"Witnessed",1:"Rec'd")," by:___________________________________"

 +10       WRITE !,?15,"(Full Name)",?69,"(Full Name)",!

 +11       IF $DATA(PSDCOMS)

               WRITE !,?16,"COMMENTS: ",PSDCOMS

 +12       IF $DATA(COMP)

               WRITE !!!,?15,"*** ",$SELECT(COMP=999:"TRANSFERRED BETWEEN NAOUs",COMP=3:"RETURNED TO STOCK",1:"TURNED IN FOR DESTRUCTION")," ***  ",REAS

               IF $DATA(AOUN)

                   IF $DATA(NAOUTN)

                       WRITE " from "_AOUN_" to "_NAOUTN

 +13       WRITE !

 +14       QUIT 

HDR       ;5/16/96 added Hdr,Prtmp for ret/stk or destroys

 +1        SET PG=PG+1

           IF $Y

               WRITE @IOF

           IF $DATA(REPRINT)

               WRITE !,?55,"*** REPRINT ***"

           WRITE !,?5,"VA FORM 10-2321",?42,"Narcotic Dispensing/Receiving Report for ",$PIECE($GET(^PSD(58.8,+PSDS,0)),"^")

 +2        WRITE ?120,"Page: ",PG,!,?52,RECDT,!

 +3        WRITE !,?14,"DATE",?78,"DATE"

 +4        WRITE !,"DISP #",?12,"DISPENSED",?24,"QTY",?33,"DRUG",?78,"ORD",?90,"ORDERED BY"

 +5        WRITE !,LN,!!

 +6        QUIT 

PRTMP     ; print 2321 fr temp file

 +1        SET PSDHLD=""

 +2        FOR JJ=1:1:NUM

               FOR 

                   SET PSDHLD=$ORDER(^TMP("PSDESTO",$JOB,PSDHLD))

                   IF PSDHLD=""

                       QUIT 

                   SET NODE=^TMP("PSDESTO",$JOB,PSDHLD)

                   DO HDR

                   Begin DoDot:1

 +3                    IF PSDHLD=""

                           QUIT 

 +4                    WRITE ?5,"Destruction # ",PSDHLD

                       WRITE !!,?12,$PIECE(NODE,"^",2),?24,$PIECE(NODE,"^",4),?33,$PIECE(NODE,"^",3)

 +5                    IF (MFG]"")!(LOT]"")!(EXP]"")

                           WRITE !,?33,"Mfg/Lot #/Exp Date:  ",MFG_"  "_LOT

 +6                    WRITE !!,?7,$SELECT($DATA(PSDOK):"Witnessed",1:"Disp")," by:_____________________________________",?61,$SELECT($DATA(PSDOK):"Witnessed",1:"Rec'd")," by:____________________________________"

 +7                    WRITE !,?15,"(Full Name)",?69,"(Full Name)",!

 +8                    WRITE !,?16,"COMMENTS: ",$PIECE(NODE,"^",5)

 +9                    IF $DATA(COMP)

                           WRITE !!!,?15,"*** ",$SELECT(COMP=999:"TRANSFERRED BETWEEN NAOUs",COMP=3:"RETURNED TO STOCK",1:"TURNED IN FOR DESTRUCTION")," ***  ",REAS

                           IF $DATA(AOUN)

                               IF $DATA(NAOUTN)

                                   WRITE " from "_AOUN_" to "_NAOUTN

                   End DoDot:1

 +10       QUIT 

SAVE      ;

 +1        SET (ZTSAVE("REAS"),ZTSAVE("PG"),ZTSAVE("MFG"),ZTSAVE("LOT"),ZTSAVE("EXP"),ZTSAVE("RECDT"),ZTSAVE("PSDCOMS"),ZTSAVE("PSDRN"),ZTSAVE("NUM"),ZTSAVE("RECDT"),ZTSAVE("RQTY"))=""

 +2        IF $DATA(PSDPN)

               SET ZTSAVE("PSDPN")=""

           IF $DATA(PSDHLD)

               SET ZTSAVE("PSDHLD")=""

 +3        IF $DATA(PSDS)

               SET ZTSAVE("PSDS")=""

           IF $DATA(COMP)

               SET ZTSAVE("COMP")=""

 +4        IF $DATA(AOUN)

               SET ZTSAVE("AOUN")=""

           IF $DATA(NAOUTN)

               SET ZTSAVE("NAOUTN")=""

 +5        IF $DATA(REPRINT)

               SET ZTSAVE("REPRINT")=""

 +6        IF $DATA(PSDOK)

               SET ZTSAVE("PSDOK")=""

 +7        IF $DATA(PSDCOMS)

               SET ZTSAVE("PSDCOMS")=""

 +8        SET ZTSAVE("^TMP(""PSDESTO"",$J,")=""

 +9        QUIT