source: FOIAVistA/tag/r/CONTROLLED_SUBSTANCES-PSD/PSDRPGS2.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 4.4 KB
Line 
1PSDRPGS2 ;BIR/JPW,LTL,BJW-Reprint Green Sheet (VA FORM 10-2638) cont'd ; 3 Mar 98
2 ;;3.0; CONTROLLED SUBSTANCES ;**8,46**;13 Feb 97
3 ;**Y2K compliance** display 4 digit year on va forms
4START ;loop through transactions
5 ;second call to %ZIS to restore varibles for open execute
6 I $D(ZTQUEUED) S IOP=ION D ^%ZIS U IO
7 ;get ready for bar codes and formatting
8 N PSD10,PSD12,PSDL,A7BAR0,A7BAR1
9 D A7BAR^PSDPGS1
10 S PSD10=$P($G(^%ZIS(2,+$G(IOST(0)),5)),U),PSD12=$P($G(^(5)),U,2)
11 S PSDL=$P($G(^%ZIS(2,+$G(IOST(0)),12.16)),U)
12 S PSDL(1)=$P($G(^%ZIS(2,+$G(IOST(0)),12.15)),U)
13 I PSD12']""!(PSD10']"")!(PSDL']"")!(PSDL(1)']"") W !!,"The device you selected is not set up for green sheets, please contact IRM.",!! Q
14 S PSD=$P(PSDS,"^",2),PSDCNT=1
15 S PSD1="" F S PSD1=$O(PSD1(PSD1)) Q:PSD1="" D LOOP
16END K %ZIS,ANS,ASK,C,CNT,D,DA,DIC,DIE,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT,EXP,EXPD,LINE,LOT,NAOU,NAOUN,NODE,NODE1
17 K OK,ORD,ORDN,POP,PRT,PSD,PSD1,PSDA,PSDBY,PSDBYN,PSDCNT,PSDDT,PSDEV,PSDOUT,PSDCPI,PSDPN,PSDR,PSDRN,PSDS,PSDSN,PSDT,PSDTR,PSDTRN,PSDYR,REPRINT,QTY,SITE,STAT,TRANS,Y,ZTDESC,ZTDTH,ZTRTN,ZTSAVE,ZTSK
18 D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
19 Q
20LOOP S PSDPN=$P(PSD1(PSD1),",",PSDCNT),PSDCNT=PSDCNT+1 I PSDPN="" S PSDCNT=1 Q
21 S PSDA=$O(^PSD(58.81,"D",PSDPN,0)) D SET
22 G LOOP
23 Q
24SET ;set data for printing
25 K TRANS,PSDTR S PSDOUT=0
26 Q:'$D(^PSD(58.81,+PSDA,0)) S NODE=^PSD(58.81,+PSDA,0)
27 Q:+$P(NODE,"^",3)'=+PSDS I (+$P(NODE,"^",11)>4)&(+$P(NODE,"^",11)'=10)&(+$P(NODE,U,11)'=13) Q
28 I +$P($G(^PSD(58.81,PSDA,"CS")),"^",4) S REPRINT=1
29 S PSD=+$P(NODE,"^",18)
30 S NAOUN=$S($P($G(^PSD(58.8,+PSD,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN")
31 S PSDR=$P(NODE,"^",5),PSDRN=$S($P($G(^PSDRUG(PSDR,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN")
32 S PSDT=$P(NODE,"^",4)
33 S QTY=$P(NODE,"^",6) I $D(^PSD(58.81,PSDA,4)),+$P(^(4),"^",3) S QTY=$P(^(4),"^",3)
34 S LOT=$P(NODE,"^",14),EXP=$P(NODE,"^",15),EXPD="" I EXP S Y=$E(EXP,1,7) X ^DD("DD") S EXPD=Y
35 S (PSDBY,PSDBYN,ORD,ORDN)=""
36 I $D(^PSD(58.81,PSDA,1)) S NODE1=^(1),PSDBY=$P(NODE1,"^"),ORD=$P(NODE1,"^",7)
37 S:ORD ORDN=$S($P($G(^VA(200,ORD,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN")
38 S:PSDBY PSDBYN=$S($P($G(^VA(200,PSDBY,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN")
39 S CNT=1,PSDTR(CNT)=+$O(^PSD(58.81,"AE",PSDA,0)) D:PSDTR(CNT) G:PSDOUT PRINT
40 .S TRANS=1
41 .D SETT Q:PSDOUT
42 .S NAOU=+$P($G(^PSD(58.81,PSDTR(CNT),0)),"^",18)
43 .S:NAOU $P(PSDTR(CNT),"^",2)=$S($P($G(^PSD(58.8,+NAOU,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN")
44PRINT ;print green sheet
45 I ORDN]"",ORDN'="UNKNOWN" S ORDN=$P(ORDN,",")_","_$E($P(ORDN,",",2))
46 I PSDBYN]"",PSDBYN'="UNKNOWN" S PSDBYN=$P(PSDBYN,",")_","_$E($P(PSDBYN,",",2))
47 S PSDDT="" I PSDT S Y=PSDT X ^DD("DD") S PSDYR=$P(Y,",",2),PSDYR=$E(PSDYR,1,4) S PSDDT=$E(PSDT,4,5)_"/"_$E(PSDT,6,7)_"/"_PSDYR
48 W:$Y @IOF,@PSD12
49 W:$D(REPRINT) $C(13),?10,"* REPRINT *",$P($G(^DPT(+$P($G(^PSD(58.81,PSDA,9)),U),0)),U) I '$D(TRANS) W ?33,NAOUN
50 W:$D(TRANS) "* Transferred to: ",$S($P(PSDTR(CNT),"^",2)]"":$P(PSDTR(CNT),"^",2),1:$P(PSDTR(CNT-1),"^",2))," *"
51 I $D(A7PRT) W $C(13),?70,@A7BAR1,@PSD10,PSDPN,@A7BAR0,@PSD12
52 W @PSDL,!?6,"CONTROLLED SUBSTANCE ADMINISTRATION RECORD",?54
53 W "Pharmacy Dispensing # ",@PSD10,PSDPN,@PSD12,!?6
54 W "Drug: ",@PSD10,PSDRN,@PSD12,?60,"Exp: ",EXPD,?78
55 W "Qty: ",@PSD10,QTY,@PSD12,!?6
56 W "Lot#",LOT,?21,"Ord by: ",$E(ORDN,1,20)
57 W ?45,"Disp by: ",$E(PSDBYN,1,20),?70,"Date: ",PSDDT,@PSDL(1),!?7
58 S $P(LN,"_",79)="" W LN,@PSDL,!?6
59 W "| DATE TIME NAME OF PATIENT DOSE BALANCE ADMINISTERED BY |"
60 F LINE=1:1:30 W !?6,"|_______|_____|_______________________|_____|______|___________________________|"
61 ;W:ASK !
62 W !?6,"Above Drug Received: Date__________ R.N. Sign_____________________________"
63 W !?6,"Above Drug Administered: Date__________ R.N. Sign_____________________________"
64 W !?6,"Entries Reviewed: Date__________ R.PH. Sign____________________________",!?6
65 W @PSDL(1),"Drug: ",@PSD10,PSDRN,@PSD12,?60
66 W "Pharmacy Dispensing # ",@PSD10,PSDPN,@PSD12,!?6
67 W "Automated VA FORM 10-2638"
68 ;W @PSDL(1),"Drug: ",@PSD10,PSDRN,@PSD12,!?6
69 ;W "Automated VA FORM 10-2638",?54,"Pharmacy Dispensing # ",@PSD10,PSDPN
70 K DA,DIE,DR S DA=PSDA,DIE=58.81,DR="103////1" D ^DIE K DA,DIE,DR
71 Q
72SETT ;set trans naous
73 S PSDTRN=+$O(^PSD(58.81,"AE",+PSDTR(CNT),0)) Q:'PSDTRN
74 S NAOU=$P($G(^PSD(58.81,+PSDTRN,0)),"^",18) I 'NAOU S PSDOUT=1 Q
75 S:NAOU $P(PSDTR(CNT),"^",2)=$S($P($G(^PSD(58.8,+NAOU,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN")
76 I $O(^PSD(58.81,"AE",+PSDTRN,0)) S CNT=CNT+1,PSDTR(CNT)=$O(^PSD(58.81,"AE",+PSDTRN,0)) G SETT
77 Q
Note: See TracBrowser for help on using the repository browser.