46 lines
2.7 KiB
Mathematica
46 lines
2.7 KiB
Mathematica
PSDTRV1 ;BIR/JPW-Transfer CS Drugs between Vaults (cont'd) ; 17 Nov 93
|
|
;;3.0; CONTROLLED SUBSTANCES ;**66**;13 Feb 97;Build 3
|
|
UPDATE ;update vault balances
|
|
D CHK G:PSDLES END
|
|
W !!,"Updating vault on-hand balances now..." F CNT=1:1:2 D CALC
|
|
W "done!",!! D:ADD MSG
|
|
S (ADD,PSDOUT)=0
|
|
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
|
|
K QTY,RDT,TEMP,TQTY,VAULT,VAULTN,X,XMDUZ,XMSUB,XMTEXT,XMY,Y
|
|
Q
|
|
CALC ;sub/add qty from dsp sites
|
|
W $S(CNT=2:VAULTN,1:PSDSN)_"..."
|
|
S TEMP=$S(CNT=2:VAULT,1:PSDS),TQTY=-TQTY
|
|
F L +^PSD(58.8,TEMP,1,PSDR,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
|
|
D NOW^%DTC S PSDT=+%
|
|
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
|
|
L -^PSD(58.8,TEMP,1,PSDR,0)
|
|
ADD ;find entry number
|
|
F L +^PSD(58.81,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
|
|
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
|
|
K DIC,DLAYGO S DIC(0)="L",(DIC,DLAYGO)=58.81,(X,DINUM)=PSDREC D ^DIC K DIC,DLAYGO
|
|
L -^PSD(58.81,0)
|
|
DIE ;update transaction data
|
|
K DA,DIE,DR S DA=PSDREC,DIE=58.81
|
|
S DR="1////16;2////"_+TEMP_";4////"_PSDR_";3////"_PSDT_";Q;5////"_TQTY_";6////"_PSDUZ_";9////"_$P(BAL(CNT),"^")_";100////1"
|
|
D ^DIE K DA,DIE,DR W !,"Still updating..."
|
|
;update vault drug info
|
|
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
|
|
S:'$D(^PSD(58.8,+TEMP,1,+PSDR,4,0)) ^PSD(58.8,+TEMP,1,+PSDR,4,0)="^58.800119PA^^"
|
|
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
|
|
Q
|
|
CHK ;check for valid bal
|
|
S PSDLES=0 D:TQTY>$P(^PSD(58.8,PSDS,1,PSDR,0),"^",4)
|
|
.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
|
|
.W "No action taken.",!
|
|
Q
|
|
MSG ;send mailman message with transfer info
|
|
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."
|
|
S ^TMP("PSDTRV",$J,2,0)="Run Date: "_RDT,^TMP("PSDTRV",$J,3,0)=""
|
|
S ^TMP("PSDTRV",$J,4,0)="Drug: "_PSDRN
|
|
S ^TMP("PSDTRV",$J,5,0)="Transferred from: "_PSDSN,^TMP("PSDTRV",$J,6,0)="Transferred and Added to: "_VAULTN
|
|
S ^TMP("PSDTRV",$J,7,0)="Quantity ("_NBKU_"): "_TQTY,^TMP("PSDTRV",$J,8,0)="Pharmacist: "_PSDUZN
|
|
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)=""
|
|
S:'$D(XMY) XMY(.5)="" D ^XMD K XMY,^TMP("PSDTRV",$J)
|
|
Q
|