51 lines
2.8 KiB
Mathematica
51 lines
2.8 KiB
Mathematica
PSDDWK1 ;BIR/JPW-Pharm Dispensing Worksheet (cont'd) ;12/14/99 15:01
|
|
;;3.0; CONTROLLED SUBSTANCES ;**20**;13 Feb 97
|
|
;
|
|
; Reference to XUSEC( supported by DBIA # 10076
|
|
; Reference to DPT( supported by DBIA # 10035
|
|
; Reference to PSD(58.8 supported by DBIA # 2711
|
|
;
|
|
START ;entry point for dispensing options
|
|
S (NEW,PSDNO)=0,NOFLAG=1,ACT="" D DISPLAY Q:(PSDOUT)!(PSDNO)
|
|
S ORDS=$S(NEW:ORDS,1:+PSDS)
|
|
CHK ;
|
|
I '$D(^XUSEC("PSJ RPHARM",DUZ)) D TECH Q:PSDOUT G ACT
|
|
S BAL=+$P(^PSD(58.8,ORDS,1,PSDR,0),"^",4)
|
|
I QTY>BAL W $C(7),!!,"=> The drug balance is "_BAL_". You cannot dispense "_QTY_" for this drug.",! G PHARM
|
|
W !!,"Old Balance: ",BAL,?35,"New Balance: ",BAL-QTY,!
|
|
PHARM ;by dispensing pharmacist
|
|
W ! K DA,DIR,DTOUT,DUOUT S DIR(0)="SOBA^V:VERIFY;DC:CANCEL;E:EDIT;B:BYPASS;S:SHOW",DIR("?",1)="Enter 'V' to verify or dispense this order, 'DC' to cancel this order,"
|
|
S DIR("?",2)="'E' to edit, 'B' to bypass without verifying,",DIR("?")="'S' to show this order again or '^' to quit.",DIR("A")="ACTION (V DC E B S): "
|
|
D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S PSDOUT=1 D MSG Q
|
|
S ACT=$S(Y="":"B",1:Y)
|
|
ACT ;decides disp action
|
|
I ACT="V" D ^PSDDWK2 Q
|
|
I ACT="P" D ^PSDDWK2 Q
|
|
I ACT="DC" D ^PSDDWK4 Q:STAT=9 Q:PSDOUT G CHK
|
|
I ACT="E" D EDIT^PSDDWKE Q:(PSDOUT)!(PSDNO) G CHK
|
|
I ACT="S" D DISPLAY G CHK
|
|
I ACT="B" D MSG
|
|
END Q
|
|
TECH ;by tech or non-disp pharmacist
|
|
W ! K DA,DIR,DTOUT,DUOUT S DIR("A")="ACTION",DIR(0)="SOBA^P:PROCESS;DC:CANCEL;E:EDIT;B:BYPASS;S:SHOW",DIR("?",1)="Enter 'P' to process this order, 'C' to cancel this order,"
|
|
S DIR("?",2)="'E' to edit, 'B' to bypass without processing,",DIR("?")="'S' to show this order again or '^' to quit.",DIR("A")="ACTION (P DC E B S): "
|
|
D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S PSDOUT=1 D MSG Q
|
|
S ACT=$S(Y="":"B",1:Y)
|
|
Q
|
|
MSG W !!,"Press <RET> to continue" R X:DTIME W !!
|
|
I '$T!(X["^") S PSDOUT=1
|
|
Q
|
|
DISPLAY ;displays order request
|
|
Q:PSDOUT W @IOF,!,?23,"Controlled Substance Order Request"
|
|
I $P($G(^PSD(58.85,PSDN,2)),U,2) W !,?27,"*** PRIORITY" W:$G(PAT) " INFUSION" W " ORDER ***"
|
|
W !! K LN S $P(LN,"-",80)=""
|
|
W "Pharmacy Dispensing #: ",$S(PSDPN:PSDPN,1:""),!,"Requested by",?16,": ",ORDN,?52,"Request Date: ",REQD,!,LN,!
|
|
W !,"Drug",?16,": ",PSDRN,?56,"Quantity: ",?66,QTY
|
|
W:$G(PAT) !,"Patient",?16,": ",$P($G(^DPT(+$G(PAT),0)),U)
|
|
W !,"Dispensed by",?16,": ",$S(PSDBY:PSDBYN,1:""),?50,"Dispensed Date: ",$S(PSDT:PSDDT,1:""),!,"Disp. Location",?16,": ",$S($D(ORDSN):ORDSN,1:"")
|
|
W !,"Manufacturer",?16,": ",MFG,!,"Lot #",?16,": ",LOT,!,"Exp. Date",?16,": ",EXPD
|
|
W !,"Ord. Location",?16,": ",NAOUN,!,"Order Status",?16,": ",$P($G(^PSD(58.82,STAT,0)),"^"),!,"Comments:" S COMM=0
|
|
I $D(^PSD(58.85,PSDN,1,0)) S COMM=1 K ^UTILITY($J,"W") F TEXT=0:0 S TEXT=$O(^PSD(58.85,PSDN,1,TEXT)) Q:'TEXT S X=$G(^PSD(58.85,PSDN,1,TEXT,0)),DIWL=5,DIWR=75,DIWF="W" D ^DIWP
|
|
I COMM D ^DIWW S COMM=0
|
|
Q
|