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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDGSRV2 3977 printed Apr 09, 2024@20:53:12 Page 2
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
