| [613] | 1 | PSDTRV1 ;BIR/JPW-Transfer CS Drugs between Vaults (cont'd) ; 17 Nov 93
|
|---|
| 2 | ;;3.0; CONTROLLED SUBSTANCES ;**66**;13 Feb 97;Build 3
|
|---|
| 3 | UPDATE ;update vault balances
|
|---|
| 4 | D CHK G:PSDLES END
|
|---|
| 5 | W !!,"Updating vault on-hand balances now..." F CNT=1:1:2 D CALC
|
|---|
| 6 | W "done!",!! D:ADD MSG
|
|---|
| 7 | S (ADD,PSDOUT)=0
|
|---|
| 8 | END K %,%H,%I,BAL,CNT,DA,DD,DIC,DIE,DINUM,DIR,DIROUT,DIRUT,DLAYGO,DO,DR,DTOUT,DUOUT,EXP,JJ,LOT,MFG,NBKU,NPKG,PSDT,PSDLES,PSDR,PSDREC,PSDRN
|
|---|
| 9 | K QTY,RDT,TEMP,TQTY,VAULT,VAULTN,X,XMDUZ,XMSUB,XMTEXT,XMY,Y
|
|---|
| 10 | Q
|
|---|
| 11 | CALC ;sub/add qty from dsp sites
|
|---|
| 12 | W $S(CNT=2:VAULTN,1:PSDSN)_"..."
|
|---|
| 13 | S TEMP=$S(CNT=2:VAULT,1:PSDS),TQTY=-TQTY
|
|---|
| 14 | F L +^PSD(58.8,TEMP,1,PSDR,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
|
|---|
| 15 | D NOW^%DTC S PSDT=+%
|
|---|
| 16 | S BAL(CNT)=$P(^PSD(58.8,TEMP,1,PSDR,0),"^",4),$P(^(0),"^",4)=$P(^(0),"^",4)+TQTY,$P(BAL(CNT),"^",2)=+BAL(CNT)+TQTY
|
|---|
| 17 | L -^PSD(58.8,TEMP,1,PSDR,0)
|
|---|
| 18 | ADD ;find entry number
|
|---|
| 19 | F L +^PSD(58.81,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
|
|---|
| 20 | FIND S PSDREC=$P(^PSD(58.81,0),"^",3)+1 I $D(^PSD(58.81,PSDREC)) S $P(^PSD(58.81,0),"^",3)=PSDREC G FIND
|
|---|
| 21 | K DIC,DLAYGO S DIC(0)="L",(DIC,DLAYGO)=58.81,(X,DINUM)=PSDREC D ^DIC K DIC,DLAYGO
|
|---|
| 22 | L -^PSD(58.81,0)
|
|---|
| 23 | DIE ;update transaction data
|
|---|
| 24 | K DA,DIE,DR S DA=PSDREC,DIE=58.81
|
|---|
| 25 | S DR="1////16;2////"_+TEMP_";4////"_PSDR_";3////"_PSDT_";Q;5////"_TQTY_";6////"_PSDUZ_";9////"_$P(BAL(CNT),"^")_";100////1"
|
|---|
| 26 | D ^DIE K DA,DIE,DR W !,"Still updating..."
|
|---|
| 27 | ;update vault drug info
|
|---|
| 28 | I CNT=2 K DA,DIE,DR S DIE="^PSD(58.8,"_+TEMP_",1,",DA(1)=+TEMP,DA=+PSDR,DR="I 'ADD S Y=9;7////"_NBKU_";8////"_NPKG_";9////"_MFG_";10////"_LOT_";11////"_EXP D ^DIE K DA,DIE,DR
|
|---|
| 29 | S:'$D(^PSD(58.8,+TEMP,1,+PSDR,4,0)) ^PSD(58.8,+TEMP,1,+PSDR,4,0)="^58.800119PA^^"
|
|---|
| 30 | I '$D(^PSD(58.8,+TEMP,1,+PSDR,4,PSDREC,0)) K DA,DIC,DD,DO S DIC(0)="L",DIC="^PSD(58.8,"_+TEMP_",1,"_+PSDR_",4,",DA(2)=+TEMP,DA(1)=+PSDR,(X,DINUM)=PSDREC D FILE^DICN K DA,DIC
|
|---|
| 31 | Q
|
|---|
| 32 | CHK ;check for valid bal
|
|---|
| 33 | S PSDLES=0 D:TQTY>$P(^PSD(58.8,PSDS,1,PSDR,0),"^",4)
|
|---|
| 34 | .W $C(7),!!,"=> The drug balance is "_+$P(^PSD(58.8,PSDS,1,PSDR,0),"^",4)_". You cannot transfer "_TQTY_" for this drug.",! S PSDLES=1
|
|---|
| 35 | .W "No action taken.",!
|
|---|
| 36 | Q
|
|---|
| 37 | MSG ;send mailman message with transfer info
|
|---|
| 38 | K XMY,^TMP("PSDTRV",$J) D NOW^%DTC S Y=X X ^DD("DD") S RDT=Y S ^TMP("PSDTRV",$J,1,0)="Controlled Substances have been transferred between Dispensing Sites."
|
|---|
| 39 | S ^TMP("PSDTRV",$J,2,0)="Run Date: "_RDT,^TMP("PSDTRV",$J,3,0)=""
|
|---|
| 40 | S ^TMP("PSDTRV",$J,4,0)="Drug: "_PSDRN
|
|---|
| 41 | S ^TMP("PSDTRV",$J,5,0)="Transferred from: "_PSDSN,^TMP("PSDTRV",$J,6,0)="Transferred and Added to: "_VAULTN
|
|---|
| 42 | S ^TMP("PSDTRV",$J,7,0)="Quantity ("_NBKU_"): "_TQTY,^TMP("PSDTRV",$J,8,0)="Pharmacist: "_PSDUZN
|
|---|
| 43 | S XMSUB="CS DRUG TRANSFER BETWEEN VAULTS",XMTEXT="^TMP(""PSDTRV"",$J,",XMDUZ="CONTROLLED SUBSTANCES PHARMACY" F JJ=0:0 S JJ=$O(^XUSEC("PSDMGR",JJ)) Q:'JJ S XMY(JJ)=""
|
|---|
| 44 | S:'$D(XMY) XMY(.5)="" D ^XMD K XMY,^TMP("PSDTRV",$J)
|
|---|
| 45 | Q
|
|---|
