| 1 | PSDEVO1 ;BIR/JPW-Edit/Cancel a Verified Order (cont'd) ; 22 Jun 93
|
|---|
| 2 | ;;3.0; CONTROLLED SUBSTANCES ;**66**;13 Feb 97;Build 3
|
|---|
| 3 | EN ;entry for edit verified order
|
|---|
| 4 | W !!,?5,"You may edit quantity, manufacturer, lot # and expiration date.",!,?5,"If you wish to edit drug or NAOU, you must cancel this order",!,?5,"and enter a new order.",!!
|
|---|
| 5 | I $D(NQTY) W !!,"This verified order has been previously edited.",!,"You must cancel this order and re-enter a new one.",!! D MSG S PSDOUT=1 Q
|
|---|
| 6 | K DA,DIR,DIRUT S DIR(0)="SO^Q:QUANTITY ONLY;M:MFG/LOT#/EXP.DATE ONLY;B:BOTH SETS OF FIELDS"
|
|---|
| 7 | S DIR("?",1)="Enter 'Q' to edit quantity only,",DIR("?",2)="Enter 'M' to edit mfg/lot #/exp.date only"
|
|---|
| 8 | S DIR("?")="Enter 'B' to edit both sets of fields or '^' to quit.",DIR("A")="Select fields to edit" D ^DIR K DIR I $D(DIRUT) S PSDOUT=1 D MSG Q
|
|---|
| 9 | S FIELD=Y
|
|---|
| 10 | UPDATE ;
|
|---|
| 11 | I FIELD="M" D NOW^%DTC S PSDT=+%,NQTY=QTY,AQTY=0,BAL=+$P(^PSD(58.8,+PSDS,1,+PSDR,0),"^",4) G DIE
|
|---|
| 12 | NQ K DA,DIR,DTOUT,DUOUT S DIR(0)="58.81,50O",DIR("A")="NEW QUANTITY DISPENSED ("_NBKU_"/"_NPKG_")"
|
|---|
| 13 | S DIR("?",1)="Enter new quantity being dispensed or",DIR("?")="or '^' to quit" D ^DIR K DIR
|
|---|
| 14 | I $D(DTOUT)!($D(DUOUT)) S PSDOUT=1 D MSG Q
|
|---|
| 15 | S NQTY=+Y I +Y=0 W !!,"Sorry. You've selected ZERO as the new dispensing balance.",!,"If the new balance is ZERO, please CANCEL this order." S PSDOUT=1 D MSG Q
|
|---|
| 16 | W !!,"Old Dispensed Quantity: ",QTY," New Dispensed Quantity: ",NQTY,! S AQTY=QTY-NQTY
|
|---|
| 17 | I ($P(^PSD(58.8,+PSDS,1,+PSDR,0),"^",4)+AQTY)<0 W !!,"This transaction cannot be processed.",!,"Your vault balance is ",$P(^PSD(58.8,+PSDS,1,+PSDR,0),"^",4),"." D MSG Q
|
|---|
| 18 | K DA,DIR,DIRUT S DIR(0)="YOA",DIR("?",1)="Answer 'YES' to edit this order and adjust",DIR("?")="your vault balance, answer 'NO' or '^' to quit."
|
|---|
| 19 | S DIR("A")="Are you sure? ",DIR("B")="NO"
|
|---|
| 20 | D ^DIR K DIR I 'Y!$D(DIRUT) D MSG Q
|
|---|
| 21 | W !!,"Accessing your transaction information..."
|
|---|
| 22 | F L +^PSD(58.8,+PSDS,1,+PSDR,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
|
|---|
| 23 | D NOW^%DTC S PSDT=+%
|
|---|
| 24 | S BAL=+$P(^PSD(58.8,+PSDS,1,+PSDR,0),"^",4),$P(^(0),"^",4)=$P(^(0),"^",4)+AQTY
|
|---|
| 25 | L -^PSD(58.8,+PSDS,1,+PSDR,0)
|
|---|
| 26 | W !!,"Old Balance: ",BAL,?35,"New Balance: ",BAL+AQTY,!!
|
|---|
| 27 | DIE W !,"Updating transaction history..."
|
|---|
| 28 | ;K DA,DIE,DR S DA=+PSDA,DIE=58.81,DR="48////"_PSDT_";49////"_PSDUZ_";50///"_NQTY_";51///"_AQTY_";54///"_BAL_";53;I FIELD=""Q"" S Y=""@1"";52////1;12;13;14;@1"
|
|---|
| 29 | K DA,DIE,DR S DA=+PSDA,DIE=58.81,DR="53;I FIELD=""Q"" S Y=48;52////1;12;13;14;48////"_PSDT_";49////"_PSDUZ_";50////"_NQTY_";51////"_AQTY_";54////"_BAL
|
|---|
| 30 | D ^DIE K DA,DIE,DR I $D(Y) S PSDOUT=1 D MSG Q
|
|---|
| 31 | S MFG=$P($G(^PSD(58.81,PSDA,0)),"^",13),LOT=$P($G(^(0)),"^",14),EXP=$P($G(^(0)),"^",15)
|
|---|
| 32 | W !,"Updating Order..."
|
|---|
| 33 | ORDER K DA,DIE,DR S DA(1)=PSDR,DA(2)=NAOU,DA=ORD,DIE="^PSD(58.8,"_NAOU_",1,"_PSDR_",3,"
|
|---|
| 34 | S DR="7///"_MFG_";8///"_LOT_";9///"_EXP_";19////"_NQTY D ^DIE K DA,DIE,DR
|
|---|
| 35 | I +$O(^PSD(58.85,"AC",3,NAOU,PSDR,ORD,0)) S WK=+$O(^PSD(58.85,"AC",3,NAOU,PSDR,ORD,0)) I $D(^PSD(58.85,WK,0)) S $P(^(0),"^",17)=NQTY
|
|---|
| 36 | W "done."
|
|---|
| 37 | REPRT ;
|
|---|
| 38 | I $D(^PSD(58.81,PSDA,"CS")),+$P(^("CS"),"^",3) W !!,"The VA FORM 10-2321 has been previously printed for this order.",!,"Please use the 'Reprint VA FORM 10-2321' .",!!
|
|---|
| 39 | Q
|
|---|
| 40 | MSG W !!,"** No action taken. **",!!
|
|---|
| 41 | Q
|
|---|
