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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDDWK1 2899 printed Apr 09, 2024@20:50:37 Page 2
PSDDWK1 ;BIR/JPW-Pharm Dispensing Worksheet (cont'd) ;12/14/99 15:01
+1 ;;3.0; CONTROLLED SUBSTANCES ;**20**;13 Feb 97
+2 ;
+3 ; Reference to XUSEC( supported by DBIA # 10076
+4 ; Reference to DPT( supported by DBIA # 10035
+5 ; Reference to PSD(58.8 supported by DBIA # 2711
+6 ;
START ;entry point for dispensing options
+1 SET (NEW,PSDNO)=0
SET NOFLAG=1
SET ACT=""
DO DISPLAY
if (PSDOUT)!(PSDNO)
QUIT
+2 SET ORDS=$SELECT(NEW:ORDS,1:+PSDS)
CHK ;
+1 IF '$DATA(^XUSEC("PSJ RPHARM",DUZ))
DO TECH
if PSDOUT
QUIT
GOTO ACT
+2 SET BAL=+$PIECE(^PSD(58.8,ORDS,1,PSDR,0),"^",4)
+3 IF QTY>BAL
WRITE $CHAR(7),!!,"=> The drug balance is "_BAL_". You cannot dispense "_QTY_" for this drug.",!
GOTO PHARM
+4 WRITE !!,"Old Balance: ",BAL,?35,"New Balance: ",BAL-QTY,!
PHARM ;by dispensing pharmacist
+1 WRITE !
KILL DA,DIR,DTOUT,DUOUT
SET DIR(0)="SOBA^V:VERIFY;DC:CANCEL;E:EDIT;B:BYPASS;S:SHOW"
SET DIR("?",1)="Enter 'V' to verify or dispense this order, 'DC' to cancel this order,"
+2 SET DIR("?",2)="'E' to edit, 'B' to bypass without verifying,"
SET DIR("?")="'S' to show this order again or '^' to quit."
SET DIR("A")="ACTION (V DC E B S): "
+3 DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET PSDOUT=1
DO MSG
QUIT
+4 SET ACT=$SELECT(Y="":"B",1:Y)
ACT ;decides disp action
+1 IF ACT="V"
DO ^PSDDWK2
QUIT
+2 IF ACT="P"
DO ^PSDDWK2
QUIT
+3 IF ACT="DC"
DO ^PSDDWK4
if STAT=9
QUIT
if PSDOUT
QUIT
GOTO CHK
+4 IF ACT="E"
DO EDIT^PSDDWKE
if (PSDOUT)!(PSDNO)
QUIT
GOTO CHK
+5 IF ACT="S"
DO DISPLAY
GOTO CHK
+6 IF ACT="B"
DO MSG
END QUIT
TECH ;by tech or non-disp pharmacist
+1 WRITE !
KILL DA,DIR,DTOUT,DUOUT
SET DIR("A")="ACTION"
SET DIR(0)="SOBA^P:PROCESS;DC:CANCEL;E:EDIT;B:BYPASS;S:SHOW"
SET DIR("?",1)="Enter 'P' to process this order, 'C' to cancel this order,"
+2 SET DIR("?",2)="'E' to edit, 'B' to bypass without processing,"
SET DIR("?")="'S' to show this order again or '^' to quit."
SET DIR("A")="ACTION (P DC E B S): "
+3 DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET PSDOUT=1
DO MSG
QUIT
+4 SET ACT=$SELECT(Y="":"B",1:Y)
+5 QUIT
MSG WRITE !!,"Press <RET> to continue"
READ X:DTIME
WRITE !!
+1 IF '$TEST!(X["^")
SET PSDOUT=1
+2 QUIT
DISPLAY ;displays order request
+1 if PSDOUT
QUIT
WRITE @IOF,!,?23,"Controlled Substance Order Request"
+2 IF $PIECE($GET(^PSD(58.85,PSDN,2)),U,2)
WRITE !,?27,"*** PRIORITY"
if $GET(PAT)
WRITE " INFUSION"
WRITE " ORDER ***"
+3 WRITE !!
KILL LN
SET $PIECE(LN,"-",80)=""
+4 WRITE "Pharmacy Dispensing #: ",$SELECT(PSDPN:PSDPN,1:""),!,"Requested by",?16,": ",ORDN,?52,"Request Date: ",REQD,!,LN,!
+5 WRITE !,"Drug",?16,": ",PSDRN,?56,"Quantity: ",?66,QTY
+6 if $GET(PAT)
WRITE !,"Patient",?16,": ",$PIECE($GET(^DPT(+$GET(PAT),0)),U)
+7 WRITE !,"Dispensed by",?16,": ",$SELECT(PSDBY:PSDBYN,1:""),?50,"Dispensed Date: ",$SELECT(PSDT:PSDDT,1:""),!,"Disp. Location",?16,": ",$SELECT($DATA(ORDSN):ORDSN,1:"")
+8 WRITE !,"Manufacturer",?16,": ",MFG,!,"Lot #",?16,": ",LOT,!,"Exp. Date",?16,": ",EXPD
+9 WRITE !,"Ord. Location",?16,": ",NAOUN,!,"Order Status",?16,": ",$PIECE($GET(^PSD(58.82,STAT,0)),"^"),!,"Comments:"
SET COMM=0
+10 IF $DATA(^PSD(58.85,PSDN,1,0))
SET COMM=1
KILL ^UTILITY($JOB,"W")
FOR TEXT=0:0
SET TEXT=$ORDER(^PSD(58.85,PSDN,1,TEXT))
if 'TEXT
QUIT
SET X=$GET(^PSD(58.85,PSDN,1,TEXT,0))
SET DIWL=5
SET DIWR=75
SET DIWF="W"
DO ^DIWP
+11 IF COMM
DO ^DIWW
SET COMM=0
+12 QUIT
