PSDDWK4.m

PSDDWK4 ;BIR/JPW-Pharm Dispensing Worksheet (cont'd) ; 24 Aug 93

 ;;3.0; CONTROLLED SUBSTANCES ;**66**;13 Feb 97;Build 3

CANC ;canc req ord

 I STAT>2 W !!,"This order is ",$P($G(^PSD(58.82,+STAT,0)),"^"),!,"and should be cancelled using the 'Edit Verified Order' option.",!!

 W ! S PSDOUT=0 K DIR,DIRUT,DUOUT S DIR(0)="YO",DIR("A")="Do you want to cancel this request order",DIR("B")="NO"

 S DIR("?",1)="Answer 'YES' to cancel this request order,",DIR("?")="answer 'NO' to leave this request active or '^' to quit." D ^DIR K DIR I $D(DUOUT) S PSDOUT=1 Q

 Q:PSDOUT  I 'Y W $C(7),!!,"No action taken.  This request order remains active.",!!,"Press <RET> to continue.",! R X:DTIME Q

 W !!,"Accessing your order information..."

 F  L +^PSD(58.8,+PSDS,1,PSDR,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I  Q

 D NOW^%DTC S PSDT=+%

 S BAL=$P(^PSD(58.8,+PSDS,1,PSDR,0),"^",4)

 L -^PSD(58.8,+PSDS,1,PSDR,0)

 K DA,DIE,DR S DIE=58.85,DA=PSDN,DR="6////9" D ^DIE K DA,DIE,DR

 K DA,DIE,DR S DA=+$P($G(^PSD(58.85,PSDN,0)),"^",5),DA(1)=+$P($G(^(0)),"^",4),DA(2)=+$P($G(^(0)),"^",3),DIE="^PSD(58.8,"_DA(2)_",1,"_DA(1)_",3,",DR="10////9;19////@" D ^DIE K DA,DIE,DR

 I +$P($G(^PSD(58.85,PSDN,0)),"^",8) K DA,DIE,DR S DA=$P(^(0),"^",8),DIE=58.81,DR="1////7;3////"_PSDT_";10////9;9////"_BAL D ^DIE K DA,DIE,DR W !!,?10,"Balance: ",BAL,!!

 S STAT=9 W !!,?10,"CANCELLED...",! I ANS="W" W !!,"Press <RET> to continue" R X:DTIME I '$T!(X["^") S PSDOUT=1

 Q

PSDDWK4   ;BIR/JPW-Pharm Dispensing Worksheet (cont'd) ; 24 Aug 93

 +1       ;;3.0; CONTROLLED SUBSTANCES ;**66**;13 Feb 97;Build 3

CANC      ;canc req ord

 +1        IF STAT>2

               WRITE !!,"This order is ",$PIECE($GET(^PSD(58.82,+STAT,0)),"^"),!,"and should be cancelled using the 'Edit Verified Order' option.",!!

 +2        WRITE !

           SET PSDOUT=0

           KILL DIR,DIRUT,DUOUT

           SET DIR(0)="YO"

           SET DIR("A")="Do you want to cancel this request order"

           SET DIR("B")="NO"

 +3        SET DIR("?",1)="Answer 'YES' to cancel this request order,"

           SET DIR("?")="answer 'NO' to leave this request active or '^' to quit."

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET PSDOUT=1

               QUIT 

 +4        IF PSDOUT

               QUIT 

           IF 'Y

               WRITE $CHAR(7),!!,"No action taken.  This request order remains active.",!!,"Press <RET> to continue.",!

               READ X:DTIME

               QUIT 

 +5        WRITE !!,"Accessing your order information..."

 +6        FOR 

               LOCK +^PSD(58.8,+PSDS,1,PSDR,0):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)

              IF $TEST

                   QUIT 

 +7        DO NOW^%DTC

           SET PSDT=+%

 +8        SET BAL=$PIECE(^PSD(58.8,+PSDS,1,PSDR,0),"^",4)

 +9        LOCK -^PSD(58.8,+PSDS,1,PSDR,0)

 +10       KILL DA,DIE,DR

           SET DIE=58.85

           SET DA=PSDN

           SET DR="6////9"

           DO ^DIE

           KILL DA,DIE,DR

 +11       KILL DA,DIE,DR

           SET DA=+$PIECE($GET(^PSD(58.85,PSDN,0)),"^",5)

           SET DA(1)=+$PIECE($GET(^(0)),"^",4)

           SET DA(2)=+$PIECE($GET(^(0)),"^",3)

           SET DIE="^PSD(58.8,"_DA(2)_",1,"_DA(1)_",3,"

           SET DR="10////9;19////@"

           DO ^DIE

           KILL DA,DIE,DR

 +12       IF +$PIECE($GET(^PSD(58.85,PSDN,0)),"^",8)

               KILL DA,DIE,DR

               SET DA=$PIECE(^(0),"^",8)

               SET DIE=58.81

               SET DR="1////7;3////"_PSDT_";10////9;9////"_BAL

               DO ^DIE

               KILL DA,DIE,DR

               WRITE !!,?10,"Balance: ",BAL,!!

 +13       SET STAT=9

           WRITE !!,?10,"CANCELLED...",!

           IF ANS="W"

               WRITE !!,"Press <RET> to continue"

               READ X:DTIME

               IF '$TEST!(X["^")

                   SET PSDOUT=1

 +14       QUIT