Routine: PSDDWK1

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)

MSG W !!,"Press <RET> to continue" R X:DTIME W !!

 I '$T!(X["^") S PSDOUT=1

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDDWK1   2899     printed  Feb 18, 2025@23:12                                                                                                                                                                                                        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

PSDDWK1.m