| 1 | PSDDWK2 ;BIR/JPW-Pharm Dispensing Worksheet (cont'd) ; 21 Jun 93
|
|---|
| 2 | ;;3.0; CONTROLLED SUBSTANCES ;**66**;13 Feb 97;Build 3
|
|---|
| 3 | PROC ;ver/proc req ord
|
|---|
| 4 | D CHK Q:PSDLES
|
|---|
| 5 | S TECH=$S($P($G(^PSD(58.85,PSDN,0)),"^",16):$P(^(0),"^",16),ACT="P":DUZ,1:"") I PSDT="" D NOW^%DTC S PSDT=+%
|
|---|
| 6 | DISPN ;assign dsp #s
|
|---|
| 7 | G:$P($G(^PSD(58.85,PSDN,0)),"^",15) EDIT S FLAG=0,ORDS=$S(NEW:ORDS,1:PSDS),PSDAGN=$S(NEW:PSDAGN,1:PSDAG)
|
|---|
| 8 | I PSDAGN W !!,"Assigning Pharmacy Dispensing #...",! D AUTO Q:PSDOUT G EDIT
|
|---|
| 9 | ASKN K DIR,DIRUT S DIR(0)="N^1:999999999:0",DIR("A")="PHARMACY DISPENSING #",DIR("?")="Enter your narcotic control number for this order." D ^DIR K DIR
|
|---|
| 10 | I $D(DIRUT) W !!,"This order cannot be processed without a dispensing number.",!!,"Press <RET> to continue" R X:DTIME Q
|
|---|
| 11 | I +$O(^PSD(58.81,"D",Y,0)) W !!,"The number "_Y_" has previously been used as a dispensing number.",!,"Please select another number.",!! G ASKN
|
|---|
| 12 | S PSDPN=Y
|
|---|
| 13 | EDIT ;edit/add ord
|
|---|
| 14 | S BAL=0 W !!,"PHARMACY DISPENSING # ",PSDPN,!
|
|---|
| 15 | K PSDREC I +$P($G(^PSD(58.85,PSDN,0)),"^",8) S PSDREC=$P(^(0),"^",8)
|
|---|
| 16 | W !!,"Accessing the order...",! D:'$D(PSDREC) ADD D:ACT="V" SUB
|
|---|
| 17 | W !,"Updating the transaction..."
|
|---|
| 18 | D UPDATE^PSDDWK3,MSG1
|
|---|
| 19 | Q
|
|---|
| 20 | ADD ;find entry number
|
|---|
| 21 | F L +^PSD(58.81,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
|
|---|
| 22 | 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
|
|---|
| 23 | K DIC,DLAYGO S DIC(0)="L",(DIC,DLAYGO)=58.81,(X,DINUM)=PSDREC D ^DIC K DIC,DINUM,DLAYGO
|
|---|
| 24 | L -^PSD(58.81,0)
|
|---|
| 25 | Q
|
|---|
| 26 | AUTO ;select next available disp #
|
|---|
| 27 | K MSG I '$P($G(^PSD(58.8,+ORDS,2)),"^",4) S MSG=1 D MSG Q
|
|---|
| 28 | I $P($G(^PSD(58.8,+ORDS,2)),"^",3)'>$P($G(^PSD(58.8,+ORDS,2)),"^",4) S MSG=0 D MSG Q
|
|---|
| 29 | F L +^PSD(58.8,+ORDS,2):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
|
|---|
| 30 | ADDN S PSDPN=$P($G(^PSD(58.8,+ORDS,2)),"^",4)
|
|---|
| 31 | I +$O(^PSD(58.81,"D",PSDPN,0)) S $P(^PSD(58.8,+ORDS,2),"^",4)=PSDPN+1 G ADDN
|
|---|
| 32 | S $P(^PSD(58.8,+ORDS,2),"^",4)=PSDPN+1
|
|---|
| 33 | L -^PSD(58.8,+ORDS,2)
|
|---|
| 34 | Q
|
|---|
| 35 | MSG ;prints message
|
|---|
| 36 | W $C(7),!!," Contact your Pharmacy Co-ordinator.",!," Your ""Dispensing #'s"" range has "_$S(MSG:"not been defined.",1:"been exceeded.") S PSDOUT=1
|
|---|
| 37 | MSG1 W !!,"Press <RET> to continue" R X:DTIME
|
|---|
| 38 | I '$T!(X["^") S PSDOUT=1
|
|---|
| 39 | Q
|
|---|
| 40 | SUB ;sub qty from dsp site
|
|---|
| 41 | F L +^PSD(58.8,ORDS,1,PSDR,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
|
|---|
| 42 | D NOW^%DTC S PSDT=+%
|
|---|
| 43 | S BAL=$P(^PSD(58.8,ORDS,1,PSDR,0),"^",4),$P(^(0),"^",4)=$P(^(0),"^",4)-QTY
|
|---|
| 44 | L -^PSD(58.8,ORDS,1,PSDR,0)
|
|---|
| 45 | W !!,"Old Balance : ",BAL,?35,"New Balance :",BAL-QTY,!!
|
|---|
| 46 | Q
|
|---|
| 47 | CHK ;check for valid bal
|
|---|
| 48 | S PSDLES=0 D:QTY>$P(^PSD(58.8,ORDS,1,PSDR,0),"^",4) Q:PSDLES
|
|---|
| 49 | .W $C(7),!!,"=> The drug balance is "_+$P(^PSD(58.8,ORDS,1,PSDR,0),"^",4)_". You cannot dispense "_QTY_" for this drug.",!,?5,"This order remains "_$P($G(^PSD(58.82,STAT,0)),"^")_".",! S PSDLES=1
|
|---|
| 50 | .D MSG1
|
|---|
