source: FOIAVistA/trunk/r/CONTROLLED_SUBSTANCES-PSD/PSDRFX.m@ 1742

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

initial load of FOIAVistA 6/30/08 version
File size: 2.4 KB
Line 
1PSDRFX ;B'ham ISC/JPW,LTL,BJW - File Dispensing Info ; 14 May 98
2 ;;3.0; CONTROLLED SUBSTANCES ;**7,66**;13 Feb 97;Build 3
3 ;inserted line 15 to save date return for activity rpt
4UPDAT I $G(PSDPN) F JJ=0:0 S JJ=$O(^PSD(58.8,"F",PSDPN,NAOU,PSDR,JJ)) Q:'JJ S ORD=+JJ
5 ;$S(WQTY:18,CQTY:9,1:17) S:PSDTYP=9 QTY=CQTY-OQTY
6 W ?40,"Recording transaction... "
7 D UPDATE W "done."
8END ;kill variables
9 K %,%DT,%H,%I,BAL,CQTY,DA,DIC,DIE,DIK,DINUM,DLAYGO,DR,JJ,LQTY,NAOUN,NODE,NUR2,OK,ORD
10 K PSD,PSDER,PSDREC,PSDRN,PSDT,PSDTN,QTY,WQTY,X,Y
11 Q
12UPDATE ;update 58.8 and 58.81
13 ;updating drug balance in 58.8
14 F L +^PSD(58.8,NAOU,1,PSDR,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
15 D NOW^%DTC S (PSDTN,PSDT)=+%
16 S BAL=$P(^PSD(58.8,NAOU,1,PSDR,0),"^",4),$P(^(0),"^",4)=$P(^(0),"^",4)+WQTY
17 L -^PSD(58.8,NAOU,1,PSDR,0)
18 S $P(^PSD(58.81,+PSDA(1),3),"^")=$G(PSDRET)
19 S $P(^PSD(58.81,+PSDA(1),3),U,2)=$P($G(^(3)),U,2)+WQTY K WQTY
20 S $P(^PSD(58.81,+PSDA(1),3),U,3)=$G(PSDRE(1)) G EDIT
21 ;update order balance
22 I $G(ORD),$D(^PSD(58.8,NAOU,1,PSDR,3,ORD,0)),PSDTYP'=9 S $P(^(0),"^",22)=$P(^(0),"^",22)-PSDQ,DA=+$P(^(0),"^",17) D:$P(^(0),"^",22)=0 K DA,DIE,DR
23 .K DIE,DR S DIE="^PSD(58.81,",DR="10////12;11////1" D ^DIE K DA,DIE,DR
24 .K DA,DIE,DR S DIE="^PSD(58.8,"_NAOU_",1,"_PSDR_",3,",DA=+ORD,DA(1)=+PSDR,DA(2)=+NAOU,DR="10////12;11////1" D ^DIE K DA,DIE,DR
25ADD ;find entry number in 58.81
26 F L +^PSD(58.81,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
27FIND S PSDREC=$P(^PSD(58.81,0),"^",3)+1 I $D(^PSD(58.81,PSDREC)) S $P(^PSD(58.81,0),"^",3)=PSDREC G FIND
28 K DIC,DLAYGO S DIC(0)="L",(DIC,DLAYGO)=58.81,(X,DINUM)=PSDREC D ^DIC K DIC,DLAYGO
29 L -^PSD(58.81,0)
30EDIT ;edit transaction in 58.81
31 S $P(^PSD(58.81,PSDA(1),0),U,16)=$G(PSDRE)
32 S $P(^PSD(58.81,PSDA(1),0),U,6)=$S($G(WQTY)&('$G(PSDQ(1))):PSDQ+WQTY,'$G(PSDQ(2)):PSDQ,1:OQTY-$G(PSDQ(2)))
33 S:$G(WQTY) $P(^PSD(58.81,PSDA(1),9),U,4)=WQTY
34 S $P(^PSD(58.81,PSDA(1),9),U,6)=$G(NUR2)
35 K DA,DIK S DA=PSDA(1),DIK="^PSD(58.81," D IX^DIK K DA,DIK
36 ;I PSDTYP'=17 D ERR
37 Q
38ERR ;err log update
39 F L +^PSD(58.89,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
40FIND9 S PSDER=$P(^PSD(58.89,0),"^",3)+1 I $D(^PSD(58.89,PSDER)) S $P(^PSD(58.89,0),"^",3)=PSDER G FIND9
41 K DIC,DLAYGO S DIC(0)="L",(DIC,DLAYGO)=58.89,(X,DINUM)=PSDER D ^DIC K DIC,DLAYGO
42 L -^PSD(58.89,0)
43EDIT9 ;edit error log
44 K DA,DIE,DR S DA=PSDER,DIE=58.89,DR="1////"_PSDREC_";2////"_PSDT_";6////"_NAOU D ^DIE K DA,DIE,DR
45 S PHARM1=NUR1,QTY=PSDQ
46 S:$G(NAOUN)']"" NAOUN=$P($G(^PSD(58.8,NAOU,0)),U) D ^PSDRFM
47 Q
Note: See TracBrowser for help on using the repository browser.