- 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