source: FOIAVistA/tag/r/DRUG_ACCOUNTABILITY-PSA/PSAOP1.m@ 636

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

initial load of FOIAVistA 6/30/08 version
File size: 4.2 KB
Line 
1PSAOP1 ;BIR/LTL-Outpatient Dispensing (Single Drug) & (All Drugs) ;7/23/97
2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**64**; 10/24/97;Build 4
3 ;PSAOP,PSAOP1,PSAOP2, & PSAOP4 gathers Outpatient dispensing data.
4 ;PSAOP3 calls this routine to stuff Outpatient dispensing data in
5 ;#58.81 and update 58.8 balance. It is called by PSAOP, PSAOP2,
6 ;PSAOP3, & PSAOP4.
7 ;
8 N DIC,PSAD,PSAT,PSAB,X
9 ;Get transaction number
10 F L +^PSD(58.81,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
11FIND S PSAD=$P(^PSD(58.81,0),U,3)+1 I $D(^PSD(58.81,PSAD)) S $P(^PSD(58.81,0),U,3)=$P(^PSD(58.81,0),U,3)+1 G FIND
12 S DIC="^PSD(58.81,",DIC(0)="L",DLAYGO=58.81,(DINUM,X)=PSAD D ^DIC
13 L -^PSD(58.81,0) K DLAYGO,DINUM
14 ;Get date + current balance + update balance
15 F L +^PSD(58.8,+PSALOC,1,+PSADRUG,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
16 S PSAB=$P($G(^PSD(58.8,+PSALOC,1,+PSADRUG,0)),U,4)
17 S $P(^PSD(58.8,+PSALOC,1,+PSADRUG,0),U,4)=$P($G(^(0)),U,4)-PSA(3)
18EDO S:'$D(^PSD(58.8,+PSALOC,1,+PSADRUG,5,0)) ^(0)="^58.801A^^"
19 ;If no monthly activity data yet,
20 I '$D(^PSD(58.8,+PSALOC,1,+PSADRUG,5,+$E(PSA(2),1,5)*100,0)) D
21 .;Set up current month's node with beginning balance.
22 .S DIC="^PSD(58.8,+PSALOC,1,+PSADRUG,5,",DIC(0)="L",DIC("DR")="1////"_$G(PSAB),(X,DINUM)=$E(PSA(2),1,5)*100,DA(2)=PSALOC,DA(1)=PSADRUG,DLAYGO=58.8 D ^DIC K DIC,DINUM,DLAYGO
23 .;Set up last month's node with ending balance.
24 .S X="T-1M" D ^%DT S DIC="^PSD(58.8,+PSALOC,1,+PSADRUG,5,",DIC(0)="L",(X,DINUM)=$E(Y,1,5)*100,DA(2)=PSALOC,DA(1)=PSADRUG,DLAYGO=58.8 D ^DIC K DIC,DINUM,DLAYGO S DA=+Y
25 .S DIE="^PSD(58.8,+PSALOC,1,+PSADRUG,5,",DA(2)=PSALOC,DA(1)=PSADRUG
26 .S DR="3////"_$G(PSAB) D ^DIE K DIE
27 ;Stuff the Total Dispensed with itself+new dispensing data.
28 S DIE="^PSD(58.8,"_+PSALOC_",1,"_+PSADRUG_",5,",DR="9////^S X=$P($G(^(0)),U,6)+PSA(3)",DA=$E(PSA(2),1,5)*100,DA(2)=PSALOC,DA(1)=PSADRUG D ^DIE K DA
29 L -^PSD(58.8,+PSALOC,1,+PSADRUG,0)
30 ;Update transaction
31 S DIE="^PSD(58.81,",DR="1////6;2////^S X=PSALOC;3///^S X=PSA(2);4////^S X=PSADRUG;5////^S X=PSA(3);9////^S X=$G(PSAB)",DA=PSAD
32 D ^DIE K DIE,DA,DR
33 ;Update Activity
34 S:'$D(^PSD(58.8,+PSALOC,1,+PSADRUG,4,0)) ^(0)="^58.800119PA^^"
35 S DIC="^PSD(58.8,+PSALOC,1,+PSADRUG,4,",DIC(0)="L",(X,DINUM)=PSAD
36 S DA(2)=PSALOC,DA(1)=PSADRUG,DLAYGO=58.8 D ^DIC K DIC,DA,DINUM,DLAYGO
37END Q
38TMP ;TMP("PSA",$J)
39 N DIC,PSAD,PSAT,PSAB,X
40 ;Get transaction number
41 F L +^PSD(58.81,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
42FIND1 S PSAD=$P(^PSD(58.81,0),U,3)+1 I $D(^PSD(58.81,PSAD)) S $P(^PSD(58.81,0),U,3)=$P(^PSD(58.81,0),U,3)+1 G FIND1
43 S DIC="^PSD(58.81,",DIC(0)="L",DLAYGO=58.81,(DINUM,X)=PSAD D ^DIC
44 L -^PSD(58.81,0) K DLAYGO,DINUM
45 ;Get date + current balance + update balance
46 F L +^PSD(58.8,+PSALOC,1,+PSADRUG,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
47 S PSAB=$P($G(^PSD(58.8,+PSALOC,1,+PSADRUG,0)),U,4)
48 S $P(^PSD(58.8,+PSALOC,1,+PSADRUG,0),U,4)=$P($G(^(0)),U,4)-PSA(3)
49 S:'$D(^PSD(58.8,+PSALOC,1,+PSADRUG,5,0)) ^(0)="^58.801A^^"
50 ;;If no monthly activity data yet,
51 I '$D(^PSD(58.8,+PSALOC,1,+PSADRUG,5,+$E(PSA(2),1,5)*100,0)) D
52 .;Set up current month's node with beginning balance.
53 .S DIC="^PSD(58.8,+PSALOC,1,+PSADRUG,5,",DIC(0)="L",DIC("DR")="1////"_$G(PSAB),(X,DINUM)=$E(PSA(2),1,5)*100,DA(2)=PSALOC,DA(1)=PSADRUG,DLAYGO=58.8 D ^DIC K DIC,DINUM,DLAYGO
54 .;Set up last month's node with ending balance.
55 .S X="T-1M" D ^%DT S DIC="^PSD(58.8,+PSALOC,1,+PSADRUG,5,",DIC(0)="L",(X,DINUM)=$E(Y,1,5)*100,DA(2)=PSALOC,DA(1)=PSADRUG,DLAYGO=58.8 D ^DIC K DIC,DINUM,DLAYGO S DA=+Y
56 .S DIE="^PSD(58.8,"_+PSALOC_",1,"_+PSADRUG_",5,",DA(2)=PSALOC,DA(1)=PSADRUG
57 .S DR="3////"_$G(PSAB) D ^DIE K DIE
58 ;Stuff the Total Dispensed with itself+new dispensing data.
59 S DIE="^PSD(58.8,+PSALOC,1,+PSADRUG,5,",DR="9////^S X=$P($G(^(0)),U,6)+PSA(3)",DA=$E(PSA(2),1,5)*100,DA(2)=PSALOC,DA(1)=PSADRUG D ^DIE K DA
60 L -^PSD(58.8,+PSALOC,1,+PSADRUG,0)
61 ;Update transaction
62 S DIE="^PSD(58.81,",DR="1////6;2////^S X=PSALOC;3///^S X=PSA(2);4////^S X=PSADRUG;5////^S X=PSA(3);9////^S X=$G(PSAB)",DA=PSAD
63 D ^DIE K DIE,DA,DR
64 ;Update Activity
65 S:'$D(^PSD(58.8,+PSALOC,1,+PSADRUG,4,0)) ^(0)="^58.800119PA^^"
66 S DIC="^PSD(58.8,"_+PSALOC_",1,"_+PSADRUG_",4,",DIC(0)="L",(X,DINUM)=PSAD
67 S DA(2)=PSALOC,DA(1)=PSADRUG,DLAYGO=58.8 D ^DIC K DA,DIC,DINUM,DLAYGO
68 K ^TMP("PSA",$J,PSADRUG)
69 Q
Note: See TracBrowser for help on using the repository browser.