source: WorldVistAEHR/trunk/r/CONTROLLED_SUBSTANCES-PSD/PSDGSRV2.m@ 1593

Last change on this file since 1593 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1PSDGSRV2 ;BIR/BJW-Print(VA FORM 10-2321) for Ret Stk/Destroy ; 20 SEP 96
2 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
3DEV ;asks device and queueing information
4 W !!,"This report is designed for a 132 column format.",!,"You may queue this report to print at a later time.",!!
5 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
6 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
7 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
8 U IO
9 ;5/16/96 added test for temp. file created in psdesto
10START K LN S $P(LN,"-",132)="" I '$D(^TMP("PSDESTO",$J)) F JJ=1:1:NUM D PRINT
11 I $D(^TMP("PSDESTO",$J)) D PRTMP
12DONE I $E(IOST)'="C" W @IOF
13 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
14END ;
15 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
16 D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
17 Q
18PRINT ;print 2321 for ret/stk and destroys(psdcoms added for e3r# 3771)
19 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)),"^")
20 W ?120,"Page: ",PG,!,?52,RECDT,!
21 W !,?14,"DATE",?78,"DATE"
22 W !,"DISP #",?12,"DISPENSED",?24,"QTY",?33,"DRUG",?78,"ORD",?90,"ORDERED BY"
23 W !,LN,!!
24 W:$D(PSDHLD) ?5,"Destruction # ",PSDHLD,!!
25 W:$D(PSDPN) PSDPN W ?12,RECDT,?24,RQTY,?33,PSDRN
26 I (MFG]"")!(LOT]"")!(EXP]"") W !,?33,"Mfg/Lot #/Exp Date: ",MFG_" "_LOT_" "_EXP,!
27 W !!,?7,$S($D(PSDOK):"Witnessed",1:"Disp")," by:___________________________________",?61,$S($D(PSDOK):"Witnessed",1:"Rec'd")," by:___________________________________"
28 W !,?15,"(Full Name)",?69,"(Full Name)",!
29 W:$D(PSDCOMS) !,?16,"COMMENTS: ",PSDCOMS
30 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
31 W !
32 Q
33HDR ;5/16/96 added Hdr,Prtmp for ret/stk or destroys
34 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)),"^")
35 W ?120,"Page: ",PG,!,?52,RECDT,!
36 W !,?14,"DATE",?78,"DATE"
37 W !,"DISP #",?12,"DISPENSED",?24,"QTY",?33,"DRUG",?78,"ORD",?90,"ORDERED BY"
38 W !,LN,!!
39 Q
40PRTMP ; print 2321 fr temp file
41 S PSDHLD=""
42 F JJ=1:1:NUM F S PSDHLD=$O(^TMP("PSDESTO",$J,PSDHLD)) Q:PSDHLD="" S NODE=^TMP("PSDESTO",$J,PSDHLD) D HDR D
43 .I PSDHLD="" Q
44 .W ?5,"Destruction # ",PSDHLD W !!,?12,$P(NODE,"^",2),?24,$P(NODE,"^",4),?33,$P(NODE,"^",3)
45 .I (MFG]"")!(LOT]"")!(EXP]"") W !,?33,"Mfg/Lot #/Exp Date: ",MFG_" "_LOT
46 .W !!,?7,$S($D(PSDOK):"Witnessed",1:"Disp")," by:_____________________________________",?61,$S($D(PSDOK):"Witnessed",1:"Rec'd")," by:____________________________________"
47 .W !,?15,"(Full Name)",?69,"(Full Name)",!
48 .W !,?16,"COMMENTS: ",$P(NODE,"^",5)
49 .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
50 Q
51SAVE ;
52 S (ZTSAVE("REAS"),ZTSAVE("PG"),ZTSAVE("MFG"),ZTSAVE("LOT"),ZTSAVE("EXP"),ZTSAVE("RECDT"),ZTSAVE("PSDCOMS"),ZTSAVE("PSDRN"),ZTSAVE("NUM"),ZTSAVE("RECDT"),ZTSAVE("RQTY"))=""
53 S:$D(PSDPN) ZTSAVE("PSDPN")="" S:$D(PSDHLD) ZTSAVE("PSDHLD")=""
54 S:$D(PSDS) ZTSAVE("PSDS")="" S:$D(COMP) ZTSAVE("COMP")=""
55 S:$D(AOUN) ZTSAVE("AOUN")="" S:$D(NAOUTN) ZTSAVE("NAOUTN")=""
56 S:$D(REPRINT) ZTSAVE("REPRINT")=""
57 S:$D(PSDOK) ZTSAVE("PSDOK")=""
58 S:$D(PSDCOMS) ZTSAVE("PSDCOMS")=""
59 S ZTSAVE("^TMP(""PSDESTO"",$J,")=""
60 Q
Note: See TracBrowser for help on using the repository browser.