source: FOIAVistA/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSAPSI1.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 2.4 KB
Line 
1PSAPSI1 ;BIR/LTL-IV Dispensing (Single Drug) & (All Drugs) ;7/23/97
2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**64**; 10/24/97;Build 4
3 ;This routine places the IV data into files 58.8 and 58.81. It is called
4 ;by PSAPSI, PSAPSI2, AND PSAPSI3.
5 ;
6 N DIC,PSAD,PSAT
7 S (PSA(4),PSA(6))=0 F S PSA(4)=$O(^TMP("PSA",$J,PSADRUG,PSA(4))) Q:'PSA(4) S PSA(6)=PSA(6)+1
8 ;get transaction numbers
9 F L +^PSD(58.81,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
10FIND 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
11 S PSAT=PSAD,DIC="^PSD(58.81,",DIC(0)="L",DLAYGO=58.81
12 F PSAD=PSAT:1:(PSAT+(PSA(6)-1)) S (DINUM,X)=PSAD D ^DIC
13 L -^PSD(58.81,0) K DIC,DINUM,DLAYGO
14 ;loop thru array
15LUP S PSA(4)=0 F S PSA(4)=$O(^TMP("PSA",$J,PSADRUG,PSA(4))) Q:'PSA(4) S PSA=$G(^TMP("PSA",$J,PSADRUG,PSA(4))) S:$P($G(^PSD(58.8,PSALOC,1,PSADRUG,6)),U,4) PSA=PSA/$P($G(^(6)),U,4) D LUP1
16 K ^TMP("PSA",$J,PSADRUG)
17 Q
18LUP1 ;get date + current balance + update balance
19 F L +^PSD(58.8,PSALOC,1,PSADRUG,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
20 S PSAB=$P($G(^PSD(58.8,PSALOC,1,PSADRUG,0)),U,4)
21 G:'$G(PSA(7)) EDO
22 S $P(^PSD(58.8,PSALOC,1,PSADRUG,0),U,4)=$P($G(^(0)),U,4)-PSA
23EDO L -^PSD(58.8,PSALOC,1,PSADRUG,0)
24 S:'$D(^PSD(58.8,PSALOC,1,PSADRUG,5,0)) ^(0)="^58.801A^^"
25 I '$D(^PSD(58.8,PSALOC,1,PSADRUG,5,+$E(PSA(4),1,5)*100,0)) D
26 .S DIC="^PSD(58.8,"_PSALOC_",1,"_PSADRUG_",5,",DIC(0)="L",DIC("DR")="1////^S X=$G(PSAB)",(X,DINUM)=$E(PSA(4),1,5)*100,DA(2)=PSALOC,DA(1)=PSADRUG,DLAYGO=58.8 D ^DIC K DIC,DINUM,DLAYGO
27 .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
28 .S DIE="^PSD(58.8,"_PSALOC_",1,"_PSADRUG_",5,",DA(2)=PSALOC,DA(1)=PSADRUG
29 .S DR="3////^S X=$G(PSAB)" D ^DIE K DIE
30 S DIE="^PSD(58.8,"_PSALOC_",1,"_PSADRUG_",5,",DR="9////^S X=$P($G(^(0)),U,6)+PSA",DA=$E(PSA(4),1,5)*100,DA(2)=PSALOC,DA(1)=PSADRUG D ^DIE K DA
31 ;update transaction
32 S DIE="^PSD(58.81,",DR="1////15;2////^S X=PSALOC;3///^S X=PSA(4);4////^S X=PSADRUG;5////^S X=PSA;9////^S X=$G(PSAB)",DA=PSAT
33 D ^DIE K DIE,DA,PSAB
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)=PSAT
36 S DA(2)=PSALOC,DA(1)=PSADRUG,DLAYGO=58.8 D ^DIC K DA,DIC,DINUM,DLAYGO
37 S DIE="^PSD(58.8,"_PSALOC_",1,",DA(1)=PSALOC,DA=PSADRUG,DR="24////^S X=PSA(4)_"",""_$G(PSAW(1))" D ^DIE S PSAT=PSAT+1
38 Q
Note: See TracBrowser for help on using the repository browser.