[613] | 1 | PSADJI ;BIR/LTL-Balance Initialization ;7/23/97
|
---|
| 2 | ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**64**; 10/24/97;Build 4
|
---|
| 3 | ;This routine allows the user to enter a beginning balance on hand for
|
---|
| 4 | ;a drug in a pharmacy location.
|
---|
| 5 | ;
|
---|
| 6 | D ^PSADA G:'$G(PSALOC) QUIT
|
---|
| 7 | N D1,D2,DIC,DIE,DINUM,D0,D1,DLAYGO,DR,DIR,DIRUT,DTOUT,DUOUT,PSAC,PSADT,DA,PSADRUG,PSADRUGN,PSAS,PSAQ,PSAR,PSAREC,PSAOUT,PSAT,X,Y
|
---|
| 8 | CHKD I '$O(^PSD(58.8,PSALOC,1,0)) W !!,"There are no drugs in ",$G(PSALOCN) G QUIT
|
---|
| 9 | W !!,"Give me a second to alphabetize.",!
|
---|
| 10 | S PSADRUG=0,PSADRUGN=""
|
---|
| 11 | F S PSADRUG=$O(^PSD(58.8,+PSALOC,1,PSADRUG)) Q:'PSADRUG!($P($G(^PSDRUG(+PSADRUG,0)),U)']"") D
|
---|
| 12 | .S ^TMP("PSAB",$J,$P($G(^PSDRUG(+PSADRUG,0)),U),PSADRUG)="" K Y
|
---|
| 13 | W @IOF
|
---|
| 14 | F PSAC=1:1 S PSADRUGN=$O(^TMP("PSAB",$J,PSADRUGN)) Q:PSADRUGN']"" S PSADRUG=$O(^TMP("PSAB",$J,PSADRUGN,0)) D G:$D(Y) QUIT
|
---|
| 15 | .I $P($G(^PSD(58.8,+PSALOC,1,PSADRUG,0)),U,4)]"" D:$Y+9>IOSL Q:$D(DUOUT)!($D(DTOUT)) W !!,PSADRUGN," may have to be adjusted.",!!,"There's already ",$P($G(^PSD(58.8,+PSALOC,1,+PSADRUG,0)),U,4)," on hand." Q
|
---|
| 16 | ..S DIR(0)="E" D ^DIR K DIR K:Y Y W @IOF
|
---|
| 17 | .W !!,PSADRUGN,!!,"Dispensing Unit: "
|
---|
| 18 | .W $P($G(^PSDRUG(+PSADRUG,660)),U,8),!
|
---|
| 19 | .F L +^PSD(58.8,+PSALOC,1,+PSADRUG,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
|
---|
| 20 | .S DIR(0)="N^0:999999:2",DIR("A")="Initial Balance" D ^DIR K DIR
|
---|
| 21 | .I $D(DIRUT) L -^PSD(58.8,+PSALOC,1,+PSADRUG,0) S Y=1 Q
|
---|
| 22 | .S PSAREC=Y D NOW^%DTC S PSADT=+$E(%,1,12),DIE="^PSD(58.8,+PSALOC,1,"
|
---|
| 23 | .S DA(1)=PSALOC,DA=PSADRUG,DR="3////"_PSAREC D ^DIE
|
---|
| 24 | .L -^PSD(58.8,+PSALOC,1,+PSADRUG,0)
|
---|
| 25 | .Q:$G(PSAREC)']""
|
---|
| 26 | MON .S:'$D(^PSD(58.8,+PSALOC,1,+PSADRUG,5,0)) ^(0)="^58.801A^^"
|
---|
| 27 | .I '$D(^PSD(58.8,+PSALOC,1,+PSADRUG,5,$E(DT,1,5)*100,0)) S DIC="^PSD(58.8,+PSALOC,1,+PSADRUG,5,",DIC(0)="L",(X,DINUM)=$E(DT,1,5)*100,DA(2)=PSALOC,DA(1)=PSADRUG,DLAYGO=58.8 D ^DIC K DIC,DLAYGO
|
---|
| 28 | .S DIE="^PSD(58.8,+PSALOC,1,+PSADRUG,5,",DA(2)=PSALOC,DA(1)=PSADRUG,DA=$E(DT,1,5)*100,DR="1////0;7////^S X=PSAREC" D ^DIE
|
---|
| 29 | .W !!,"Updating beginning balance and transaction history.",!
|
---|
| 30 | TR .F L +^PSD(58.81,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
|
---|
| 31 | FIND .S PSAT=$P(^PSD(58.81,0),U,3)+1 I $D(^PSD(58.81,PSAT)) S $P(^PSD(58.81,0),U,3)=$P(^PSD(58.81,0),U,3)+1 G FIND
|
---|
| 32 | .S DIC="^PSD(58.81,",DIC(0)="L",DLAYGO=58.81,(DINUM,X)=PSAT D ^DIC K DIC,DLAYGO L -^PSD(58.81,0)
|
---|
| 33 | .S DIE="^PSD(58.81,",DA=PSAT,DR="1////11;2////^S X=PSALOC;3////^S X=PSADT;4////^S X=PSADRUG;5////^S X=PSAREC;6////^S X=DUZ;9////0" D ^DIE K DIE
|
---|
| 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 DIC,DA,DLAYGO,Y
|
---|
| 37 | QUIT K ^TMP("PSAB",$J) Q
|
---|