source: FOIAVistA/trunk/r/CONTROLLED_SUBSTANCES-PSD/PSDGSH2.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 3.7 KB
Line 
1PSDGSH2 ;BIR/JPW-Review Green Sheet History (cont'd) ; 2 Aug 94
2 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
3DISPLAY ;print data
4 S (PG,PSDOUT)=0 D HDR
5 W !,"Manufacturer",?16,": ",MFG,?61,"Lot:",?66,LOT,!,"Expiration Date : ",EXP
6 W !,"Dispensed by",?16,": ",$S($D(PSDBY):PSDBY,1:""),?49,"Disp Date: ",PSDDT
7 I $D(FILL),FILL]"" W !,"Filled by",?16,": ",FILL,?53,"Fill Date: ",$S($D(PROC):PROC,1:"")
8 W !,"Ord. Location",?16,": ",NAOU,!,"Ordered by",?16,": ",$G(REQ),?52
9 W "Order Date: ",$G(REQD)
10 I $D(PSDUZAN) W !,"Ord. by Pharm",?16,": ",PSDUZAN
11 S COMM=0
12 I $D(^PSD(58.81,PSDA,2,0)) S COMM=1 W !,"Comments:" K ^UTILITY($J,"W") F TEXT=0:0 S TEXT=$O(^PSD(58.81,PSDA,2,TEXT)) Q:'TEXT S X=$G(^PSD(58.81,PSDA,2,TEXT,0)),DIWL=5,DIWR=75,DIWF="W" D ^DIWP
13 I COMM D ^DIWW S COMM=0
14 I $D(ORC),ORC]"" D CHK Q:PSDOUT W !,"Received by",?16,": ",ORC,?53,"Rec Date: ",$S($D(ORCD):ORCD,1:"")
15 I $D(RTECH),RTECH]"" D CHK Q:PSDOUT W !,"Rec'd by Tech",?16,": ",RTECH,?55,"Rec Date :",$S($D(ORCD):ORCD,1:"")
16 I $D(REAS),REAS]"" D CHK Q:PSDOUT W !,"REASON",?16,": ",REAS
17 I $D(PSDIN),PSDIN]"" D CHK Q:PSDOUT W !,"Insp Hold by:",?16,": ",PSDIN,?51,"Placed Date: ",PSDIP W:PSDIR]"" !,?50,"Removed Date: ",PSDIR
18 I NODE16]"" W !,"Hold Reason:",?16,": ",NODE16
19 I $D(RETN),RETN]"" D CHK Q:PSDOUT W !,"Comp by Nurse",?16,": ",RETN,?53,"Comp Date: ",PSDTP
20 I $D(PUBY),PUBY]"" D CHK Q:PSDOUT W !,"Pickup by",?16,": ",$S($D(PUBY):PUBY,1:""),?51,"Pickup Date: ",PUDT
21 I $D(CBY),CBY]"" D CHK Q:PSDOUT W !,"Completed by",?16,": ",CBY,?53,"Comp Date: ",$S($D(CDT):CDT,1:"")
22 I $D(OTR),OTR]"" D CHK Q:PSDOUT W !,"Referred Reason",?16,": ",OTR
23 I $D(NODE3)!($D(NODE4))!($D(NODE5))!($D(TRANS)) D MORE
24 W !
25 Q
26HDR ;header
27 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
28 S PG=PG+1 W:$Y @IOF W !,?23,"Controlled Substance Order",!! K LN S $P(LN,"-",80)=""
29 W "Pharmacy Dispensing #: ",PSDPN,!,"Order Status",?21,": ",STAT,!,?23,$S(COMP]"":COMP,1:"")
30 W !,"Dispensing Location : ",PSDSN,!,LN,!
31 W:$P($G(^PSD(58.81,PSDA,9)),U) !,"Patient",?16,": ",$P($G(^DPT(+$P($G(^PSD(58.81,PSDA,9)),U),0)),U)
32 W !,"Drug",?16,": ",DRUG,?56,"Quantity: ",?66,QTY
33 Q
34MORE ;additional display
35 I $D(NODE4),$D(EDT),EDT]"" D:$Y+8>IOSL HDR Q:PSDOUT W !!,?10,"*** EDITED AFTER VERIFICATION ***",!!,"Edit Date",?16,": ",EDT,?48,"New Adjusted Qty: ",?64,EDQTY,!,"Pharmacist",?16,": ",EDPH,!,"Reason",?16,": ",EREAS
36 I $D(NODE5),$D(CANCD),CANCD]"" D:$Y+8>IOSL HDR Q:PSDOUT W !!,?10,"*** CANCELLED AFTER VERIFICATION ***",!!,"Cancel Date",?16,": ",CANCD,!,"Pharmacist",?16,": ",CANCPH,!,"Reason",?16,": ",CREAS
37 I $D(NODE3),$D(STKD),STKD]"" D:$Y+8>IOSL HDR Q:PSDOUT W !!,?10,"*** RETURNED TO STOCK ***",!!,"Ret by Nurse",?16,": ",$S($D(RETN):RETN,1:""),?57,"Qty Ret: ",?66,STKQ,!,"Returned Date",?16,": ",STKD,!,"Reason",?16,": ",SREAS
38 I $D(NODE3),$D(DESTD),DESTD]"" D:$Y+10>IOSL HDR Q:PSDOUT W !!,?10,"*** TURNED IN FOR DESTRUCTION ***",!!,"Turned in by",?16,": ",$S($D(RETN):RETN,1:"") D
39 .W ?56,"Qty Dest:",?66,DESTQ,!,"Turn in Date",?16,": ",DESTD,!,"Holding #",?16,": ",DESTH,!,"Reason",?16,": ",DREAS
40 .W:DESDP]"" !,"Destroyed by",?16,": ",DESDP W:DESD]"" ?55,"Date Dest:",?66,DESD
41 I $D(NODE7) D:$Y+10>IOSL HDR Q:PSDOUT W !!,?10,"*** TRANSFER BETWEEN NAOUs ***",! D LOOP
42 W !
43 Q
44LOOP ;loop thru transfer between naous
45 F JJ=0:0 S JJ=$O(TRN(JJ)) Q:'JJ D:$Y+8>IOSL HDR Q:PSDOUT W !,"From NAOU",?16,": ",$P(TRN(JJ),"^"),?56,"Quantity:",?66,$P(TRN(JJ),"^",7),!,"Nurse From",?16,": ",$P(TRN(JJ),"^",3),?56,"Date:",?62,$P(TRN(JJ),"^",2),! D
46 .W "To NAOU",?16,": ",$P(TRN(JJ),"^",4),!
47 .W "Nurse to",?16,": "
48 .W $S($P(TRN(JJ),"^",6)'=0:$P(TRN(JJ),U,6),1:"Not Received Yet"),?56
49 .W "Date:",?62,$S($P(TRN(JJ),"^",5)'=0:$P(TRN(JJ),"^",5),1:"*****")
50 Q
51CHK ;check end of page
52 D:$Y+6>IOSL HDR
53 Q
Note: See TracBrowser for help on using the repository browser.