70 lines
4.2 KiB
Mathematica
70 lines
4.2 KiB
Mathematica
PSAOP1 ;BIR/LTL-Outpatient Dispensing (Single Drug) & (All Drugs) ;7/23/97
|
|
;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**64**; 10/24/97;Build 4
|
|
;PSAOP,PSAOP1,PSAOP2, & PSAOP4 gathers Outpatient dispensing data.
|
|
;PSAOP3 calls this routine to stuff Outpatient dispensing data in
|
|
;#58.81 and update 58.8 balance. It is called by PSAOP, PSAOP2,
|
|
;PSAOP3, & PSAOP4.
|
|
;
|
|
N DIC,PSAD,PSAT,PSAB,X
|
|
;Get transaction number
|
|
F L +^PSD(58.81,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
|
|
FIND 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
|
|
S DIC="^PSD(58.81,",DIC(0)="L",DLAYGO=58.81,(DINUM,X)=PSAD D ^DIC
|
|
L -^PSD(58.81,0) K DLAYGO,DINUM
|
|
;Get date + current balance + update balance
|
|
F L +^PSD(58.8,+PSALOC,1,+PSADRUG,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
|
|
S PSAB=$P($G(^PSD(58.8,+PSALOC,1,+PSADRUG,0)),U,4)
|
|
S $P(^PSD(58.8,+PSALOC,1,+PSADRUG,0),U,4)=$P($G(^(0)),U,4)-PSA(3)
|
|
EDO S:'$D(^PSD(58.8,+PSALOC,1,+PSADRUG,5,0)) ^(0)="^58.801A^^"
|
|
;If no monthly activity data yet,
|
|
I '$D(^PSD(58.8,+PSALOC,1,+PSADRUG,5,+$E(PSA(2),1,5)*100,0)) D
|
|
.;Set up current month's node with beginning balance.
|
|
.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
|
|
.;Set up last month's node with ending balance.
|
|
.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
|
|
.S DIE="^PSD(58.8,+PSALOC,1,+PSADRUG,5,",DA(2)=PSALOC,DA(1)=PSADRUG
|
|
.S DR="3////"_$G(PSAB) D ^DIE K DIE
|
|
;Stuff the Total Dispensed with itself+new dispensing data.
|
|
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
|
|
L -^PSD(58.8,+PSALOC,1,+PSADRUG,0)
|
|
;Update transaction
|
|
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
|
|
D ^DIE K DIE,DA,DR
|
|
;Update Activity
|
|
S:'$D(^PSD(58.8,+PSALOC,1,+PSADRUG,4,0)) ^(0)="^58.800119PA^^"
|
|
S DIC="^PSD(58.8,+PSALOC,1,+PSADRUG,4,",DIC(0)="L",(X,DINUM)=PSAD
|
|
S DA(2)=PSALOC,DA(1)=PSADRUG,DLAYGO=58.8 D ^DIC K DIC,DA,DINUM,DLAYGO
|
|
END Q
|
|
TMP ;TMP("PSA",$J)
|
|
N DIC,PSAD,PSAT,PSAB,X
|
|
;Get transaction number
|
|
F L +^PSD(58.81,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
|
|
FIND1 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
|
|
S DIC="^PSD(58.81,",DIC(0)="L",DLAYGO=58.81,(DINUM,X)=PSAD D ^DIC
|
|
L -^PSD(58.81,0) K DLAYGO,DINUM
|
|
;Get date + current balance + update balance
|
|
F L +^PSD(58.8,+PSALOC,1,+PSADRUG,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
|
|
S PSAB=$P($G(^PSD(58.8,+PSALOC,1,+PSADRUG,0)),U,4)
|
|
S $P(^PSD(58.8,+PSALOC,1,+PSADRUG,0),U,4)=$P($G(^(0)),U,4)-PSA(3)
|
|
S:'$D(^PSD(58.8,+PSALOC,1,+PSADRUG,5,0)) ^(0)="^58.801A^^"
|
|
;;If no monthly activity data yet,
|
|
I '$D(^PSD(58.8,+PSALOC,1,+PSADRUG,5,+$E(PSA(2),1,5)*100,0)) D
|
|
.;Set up current month's node with beginning balance.
|
|
.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
|
|
.;Set up last month's node with ending balance.
|
|
.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
|
|
.S DIE="^PSD(58.8,"_+PSALOC_",1,"_+PSADRUG_",5,",DA(2)=PSALOC,DA(1)=PSADRUG
|
|
.S DR="3////"_$G(PSAB) D ^DIE K DIE
|
|
;Stuff the Total Dispensed with itself+new dispensing data.
|
|
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
|
|
L -^PSD(58.8,+PSALOC,1,+PSADRUG,0)
|
|
;Update transaction
|
|
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
|
|
D ^DIE K DIE,DA,DR
|
|
;Update Activity
|
|
S:'$D(^PSD(58.8,+PSALOC,1,+PSADRUG,4,0)) ^(0)="^58.800119PA^^"
|
|
S DIC="^PSD(58.8,"_+PSALOC_",1,"_+PSADRUG_",4,",DIC(0)="L",(X,DINUM)=PSAD
|
|
S DA(2)=PSALOC,DA(1)=PSADRUG,DLAYGO=58.8 D ^DIC K DA,DIC,DINUM,DLAYGO
|
|
K ^TMP("PSA",$J,PSADRUG)
|
|
Q
|