source: FOIAVistA/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSATRAN1.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 4.4 KB
Line 
1PSATRAN1 ;BIR/JMB-Transfer Drugs between Pharmacies - CONT'D ;7/23/97
2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**64**; 10/24/97;Build 4
3 ;This routine updates the dispensing and receiving locations. The drug
4 ;balance & monthly activity are updated. It creates an activity in 58.8,
5 ;a transaction in 58.81, sends a mail message if the drug is new to the
6 ;receiving location, and stores the data so the signature sheet can
7 ;print. It is called by PSATRAN.
8 ;
9UPDATE ;update location balances
10 D CHK Q:PSALES W !!,"Updating pharmacy on-hand balances now..."
11 S (PSATODA,PSAFRDA)=0
12 F PSALCNT=1:1:2 D CALC
13 I PSATODA,PSAFRDA D
14 .S DIE="^PSD(58.81,",DA=PSATODA,DR="16///^S X=PSAFRDA"
15 .F L +^PSD(58.81,DA,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
16 .D ^DIE L -^PSD(58.81,DA,0) K DA
17 .S DA=PSAFRDA,DR="16///^S X=PSATODA"
18 .F L +^PSD(58.81,DA,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
19 .D ^DIE L -^PSD(58.81,DA,0) K DA,DIE
20 W !,"Done!" H 1 S ^TMP("PSASIG",$J,+PSAFROM,+PSATO,PSAFRDA)=""
21 D:PSADD MSG I 'PSADD H 1
22 S (PSADD,PSAOUT)=0
23 Q
24CALC ;sub/add qty from dsp sites
25 W "." S PSATEMP=+$S(PSALCNT=1:PSAFROM,1:PSATO),PSATQTY=-PSATQTY
26 F L +^PSD(58.8,PSATEMP,1,PSADRG,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
27 D NOW^%DTC S PSADT=+%
28 S PSABAL(PSALCNT)=$P(^PSD(58.8,PSATEMP,1,PSADRG,0),"^",4),$P(^(0),"^",4)=$P(^(0),"^",4)+PSATQTY,$P(PSABAL(PSALCNT),"^",2)=(+PSABAL(PSALCNT)+PSATQTY)
29 L -^PSD(58.8,PSATEMP,1,PSADRG,0)
30ADD ;find entry number
31 F L +^PSD(58.81,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
32FIND S PSAREC=$P(^PSD(58.81,0),"^",3)+1 I $D(^PSD(58.81,PSAREC)) S $P(^PSD(58.81,0),"^",3)=PSAREC G FIND
33 K DIC,DLAYGO S DIC(0)="L",DIC="^PSD(58.81,",DLAYGO=58.81,(X,DINUM)=PSAREC D ^DIC K DIC,DINUM,DLAYGO
34 L -^PSD(58.81,0) W "."
35 S:PSALCNT=1 PSAFRDA=PSAREC S:PSALCNT=2 PSATODA=PSAREC
36TRANS ;update transaction data
37 K DA,DIE,DR S DA=PSAREC,DIE=58.81
38 S DR="1////24;2////"_PSATEMP_";4////"_PSADRG_";3////"_PSADT_";5////"_PSATQTY_";6////"_PSADUZ_";9////"_$P(PSABAL(PSALCNT),"^")
39 D ^DIE K DA,DIE,DR W "."
40ACT ;update location drug info
41 S:'$D(^PSD(58.8,PSATEMP,1,PSADRG,4,0)) ^PSD(58.8,PSATEMP,1,PSADRG,4,0)="^58.800119PA^^"
42 I '$D(^PSD(58.8,PSATEMP,1,PSADRG,4,PSAREC,0)) K DA,DD,DO S DIC(0)="L",DIC="^PSD(58.8,"_PSATEMP_",1,"_PSADRG_",4,",DA(2)=PSATEMP,DA(1)=PSADRG,(X,DINUM)=PSAREC D ^DIC K DA,DIC,DINUM W "."
43MON ;update monthly activity node
44 S:'$D(^PSD(58.8,PSATEMP,1,PSADRG,5,0)) ^(0)="^58.801A^^"
45 I '$D(^PSD(58.8,PSATEMP,1,PSADRG,5,$E(PSADT,1,5)*100,0)) D
46 .S DIC="^PSD(58.8,"_PSATEMP_",1,"_PSADRG_",5,",DIC(0)="LM"
47 .S DA(2)=PSATEMP,DA(1)=PSADRG,(X,DINUM)=($E(PSADT,1,5)*100),DLAYGO=58.8 D ^DIC K DIC,DINUM,DLAYGO W "." S DA=+Y
48 .S DIE="^PSD(58.8,"_PSATEMP_",1,"_PSADRG_",5,",DA(2)=PSATEMP,DA(1)=PSADRG,DR="1////^S X="_+PSABAL(PSALCNT) D ^DIE K DIE
49 .S X="T-1M" D ^%DT
50 .S DIC="^PSD(58.8,"_PSATEMP_",1,"_PSADRG_",5,",DIC(0)="LM",DA(2)=PSATEMP,DA(1)=PSADRG,(X,DINUM)=($E(Y,1,5)*100),DLAYGO=58.8 D ^DIC K DINUM,DLAYGO
51 ;.S DIE=DIC,DR="3////^S X="_($P($G(^PSD(58.8,PSATEMP,1,PSADRG,0)),"^",4)-PSATQTY) K DIC D ^DIE K DA,DIE W "."
52 S DA=($E(PSADT,1,5)*100),PSANODE=$G(^PSD(58.8,PSATEMP,1,PSADRG,5,DA,0)) Q:'$D(PSANODE)
53 S PSAREC=$P(PSANODE,"^",3),PSADJ=$P(PSANODE,"^",5),PSADISP=$P(PSANODE,"^",6),PSARET=$P(PSANODE,"^",7),PSATF=$P(PSANODE,"^",9)+PSATQTY
54 S PSABAL=$P(PSANODE,"^",2)+PSAREC+PSADJ-PSADISP+PSARET+PSATF
55 S DIE="^PSD(58.8,"_PSATEMP_",1,"_PSADRG_",5,",DA(2)=PSATEMP,DA(1)=PSADRG
56 S DR="13////^S X="_($P($G(^PSD(58.8,PSATEMP,1,PSADRG,5,DA,0)),"^",9)+PSATQTY)_";3////^S X="_PSABAL
57 D ^DIE K DA,DIE W "."
58 Q
59CHK ;check for valid bal
60 S PSALES=0 D:PSATQTY>$P(^PSD(58.8,PSAFROM,1,PSADRG,0),"^",4)
61 .W $C(7),!!,"=> The drug balance is "_+$P(^PSD(58.8,PSAFROM,1,PSADRG,0),"^",4)_". You cannot transfer "_PSATQTY_" for this drug.",! S PSALES=1
62 .W "No action taken.",!
63 Q
64MSG ;send mailman message with transfer info
65 K XMY,^TMP("PSATRAN",$J)
66 S ^TMP("PSATRAN",$J,1,0)="Drug: "_PSADRGN
67 S ^TMP("PSATRAN",$J,2,0)="Quantity : "_PSATQTY_" ("_PSADU_")",^TMP("PSATRAN",$J,3,0)="Pharmacist: "_PSADUZN,^TMP("PSATRAN",$J,4,0)=" "
68 S ^TMP("PSATRAN",$J,5,0)="Transferred from:",^TMP("PSATRAN",$J,6,0)=PSAFROMN,^TMP("PSATRAN",$J,7,0)=" "
69 S ^TMP("PSATRAN",$J,8,0)="Transferred and Added to:",^TMP("PSATRAN",$J,9,0)=PSATON
70 S XMSUB="Drug Transfer Between Pharmacies",XMTEXT="^TMP(""PSATRAN"",$J,",XMDUZ="Drug Accountability System"
71 F PSAJJ=0:0 S PSAJJ=$O(^XUSEC("PSAMGR",PSAJJ)) Q:'PSAJJ S XMY(PSAJJ)=""
72 G:'$D(XMY) QUIT D ^XMD
73QUIT K XMY,^TMP("PSATRAN",$J)
74 Q
Note: See TracBrowser for help on using the repository browser.