- PSDEVO1 ;BIR/JPW - Edit/Cancel a Verified Order (cont'd) ;22 Jun 93
- ;;3.0;CONTROLLED SUBSTANCES ;**66,79**;13 Feb 97;Build 20
- EN ;entry for edit verified order
- 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.",!!
- 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
- K DA,DIR,DIRUT S DIR(0)="SO^Q:QUANTITY ONLY;M:MFG/LOT#/EXP.DATE ONLY;B:BOTH SETS OF FIELDS"
- S DIR("?",1)="Enter 'Q' to edit quantity only,",DIR("?",2)="Enter 'M' to edit mfg/lot #/exp.date only"
- 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
- S FIELD=Y
- UPDATE ;
- I FIELD="M" D NOW^%DTC S PSDT=+%,NQTY=QTY,AQTY=0,BAL=+$P(^PSD(58.8,+PSDS,1,+PSDR,0),"^",4) G DIE
- NQ K DA,DIR,DTOUT,DUOUT S DIR(0)="58.81,50O",DIR("A")="NEW QUANTITY DISPENSED ("_NBKU_"/"_NPKG_")"
- S DIR("?",1)="Enter new quantity being dispensed or",DIR("?")="or '^' to quit" D ^DIR K DIR
- I $D(DTOUT)!($D(DUOUT)) S PSDOUT=1 D MSG Q
- 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
- W !!,"Old Dispensed Quantity: ",QTY," New Dispensed Quantity: ",NQTY,! S AQTY=QTY-NQTY
- 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
- 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."
- S DIR("A")="Are you sure? ",DIR("B")="NO"
- D ^DIR K DIR I 'Y!$D(DIRUT) S PSDOUT=1 D MSG Q
- W !!,"Accessing your transaction information..."
- S BAL=+$P(^PSD(58.8,+PSDS,1,+PSDR,0),"^",4)
- W !!,"Old Balance: ",BAL,?35,"New Balance: ",BAL+AQTY,!!
- DIE ;
- D NOW^%DTC S PSDT=+%
- 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
- D ^DIE K DA,DIE,DR I $D(Y)!$D(DTOUT)!$D(DUOUT) S PSDOUT=1 D MSG Q
- W !,"Updating transaction history..."
- F L +^PSD(58.8,+PSDS,1,+PSDR,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
- S $P(^PSD(58.8,+PSDS,1,+PSDR,0),"^",4)=$P(^PSD(58.8,+PSDS,1,+PSDR,0),"^",4)+AQTY
- L -^PSD(58.8,+PSDS,1,+PSDR,0)
- S MFG=$P($G(^PSD(58.81,PSDA,0)),"^",13),LOT=$P($G(^(0)),"^",14),EXP=$P($G(^(0)),"^",15)
- W !,"Updating Order..."
- ORDER K DA,DIE,DR S DA(1)=PSDR,DA(2)=NAOU,DA=ORD,DIE="^PSD(58.8,"_NAOU_",1,"_PSDR_",3,"
- S DR="7///"_MFG_";8///"_LOT_";9///"_EXP_";19////"_NQTY D ^DIE K DA,DIE,DR
- 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
- W "done."
- REPRT ;
- 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' .",!!
- Q
- MSG W !!,"** No action taken. **",!! H 2
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDEVO1 3149 printed Mar 13, 2025@20:50:36 Page 2
- PSDEVO1 ;BIR/JPW - Edit/Cancel a Verified Order (cont'd) ;22 Jun 93
- +1 ;;3.0;CONTROLLED SUBSTANCES ;**66,79**;13 Feb 97;Build 20
- EN ;entry for edit verified order
- +1 WRITE !!,?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.",!!
- +2 IF $DATA(NQTY)
- WRITE !!,"This verified order has been previously edited.",!,"You must cancel this order and re-enter a new one.",!!
- DO MSG
- SET PSDOUT=1
- QUIT
- +3 KILL DA,DIR,DIRUT
- SET DIR(0)="SO^Q:QUANTITY ONLY;M:MFG/LOT#/EXP.DATE ONLY;B:BOTH SETS OF FIELDS"
- +4 SET DIR("?",1)="Enter 'Q' to edit quantity only,"
- SET DIR("?",2)="Enter 'M' to edit mfg/lot #/exp.date only"
- +5 SET DIR("?")="Enter 'B' to edit both sets of fields or '^' to quit."
- SET DIR("A")="Select fields to edit"
- DO ^DIR
- KILL DIR
- IF $DATA(DIRUT)
- SET PSDOUT=1
- DO MSG
- QUIT
- +6 SET FIELD=Y
- UPDATE ;
- +1 IF FIELD="M"
- DO NOW^%DTC
- SET PSDT=+%
- SET NQTY=QTY
- SET AQTY=0
- SET BAL=+$PIECE(^PSD(58.8,+PSDS,1,+PSDR,0),"^",4)
- GOTO DIE
- NQ KILL DA,DIR,DTOUT,DUOUT
- SET DIR(0)="58.81,50O"
- SET DIR("A")="NEW QUANTITY DISPENSED ("_NBKU_"/"_NPKG_")"
- +1 SET DIR("?",1)="Enter new quantity being dispensed or"
- SET DIR("?")="or '^' to quit"
- DO ^DIR
- KILL DIR
- +2 IF $DATA(DTOUT)!($DATA(DUOUT))
- SET PSDOUT=1
- DO MSG
- QUIT
- +3 SET NQTY=+Y
- IF +Y=0
- WRITE !!,"Sorry. You've selected ZERO as the new dispensing balance.",!,"If the new balance is ZERO, please CANCEL this order."
- SET PSDOUT=1
- DO MSG
- QUIT
- +4 WRITE !!,"Old Dispensed Quantity: ",QTY," New Dispensed Quantity: ",NQTY,!
- SET AQTY=QTY-NQTY
- +5 IF ($PIECE(^PSD(58.8,+PSDS,1,+PSDR,0),"^",4)+AQTY)<0
- WRITE !!,"This transaction cannot be processed.",!,"Your vault balance is ",$PIECE(^PSD(58.8,+PSDS,1,+PSDR,0),"^",4),"."
- DO MSG
- QUIT
- +6 KILL DA,DIR,DIRUT
- SET DIR(0)="YOA"
- SET DIR("?",1)="Answer 'YES' to edit this order and adjust"
- SET DIR("?")="your vault balance, answer 'NO' or '^' to quit."
- +7 SET DIR("A")="Are you sure? "
- SET DIR("B")="NO"
- +8 DO ^DIR
- KILL DIR
- IF 'Y!$DATA(DIRUT)
- SET PSDOUT=1
- DO MSG
- QUIT
- +9 WRITE !!,"Accessing your transaction information..."
- +10 SET BAL=+$PIECE(^PSD(58.8,+PSDS,1,+PSDR,0),"^",4)
- +11 WRITE !!,"Old Balance: ",BAL,?35,"New Balance: ",BAL+AQTY,!!
- DIE ;
- +1 DO NOW^%DTC
- SET PSDT=+%
- +2 KILL DA,DIE,DR
- SET DA=+PSDA
- SET DIE=58.81
- SET DR="53;I FIELD=""Q"" S Y=48;52////1;12;13;14;48////"_PSDT_";49////"_PSDUZ_";50////"_NQTY_";51////"_AQTY_";54////"_BAL
- +3 DO ^DIE
- KILL DA,DIE,DR
- IF $DATA(Y)!$DATA(DTOUT)!$DATA(DUOUT)
- SET PSDOUT=1
- DO MSG
- QUIT
- +4 WRITE !,"Updating transaction history..."
- +5 FOR
- LOCK +^PSD(58.8,+PSDS,1,+PSDR,0):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
- IF $TEST
- QUIT
- +6 SET $PIECE(^PSD(58.8,+PSDS,1,+PSDR,0),"^",4)=$PIECE(^PSD(58.8,+PSDS,1,+PSDR,0),"^",4)+AQTY
- +7 LOCK -^PSD(58.8,+PSDS,1,+PSDR,0)
- +8 SET MFG=$PIECE($GET(^PSD(58.81,PSDA,0)),"^",13)
- SET LOT=$PIECE($GET(^(0)),"^",14)
- SET EXP=$PIECE($GET(^(0)),"^",15)
- +9 WRITE !,"Updating Order..."
- ORDER KILL DA,DIE,DR
- SET DA(1)=PSDR
- SET DA(2)=NAOU
- SET DA=ORD
- SET DIE="^PSD(58.8,"_NAOU_",1,"_PSDR_",3,"
- +1 SET DR="7///"_MFG_";8///"_LOT_";9///"_EXP_";19////"_NQTY
- DO ^DIE
- KILL DA,DIE,DR
- +2 IF +$ORDER(^PSD(58.85,"AC",3,NAOU,PSDR,ORD,0))
- SET WK=+$ORDER(^PSD(58.85,"AC",3,NAOU,PSDR,ORD,0))
- IF $DATA(^PSD(58.85,WK,0))
- SET $PIECE(^(0),"^",17)=NQTY
- +3 WRITE "done."
- REPRT ;
- +1 IF $DATA(^PSD(58.81,PSDA,"CS"))
- IF +$PIECE(^("CS"),"^",3)
- WRITE !!,"The VA FORM 10-2321 has been previously printed for this order.",!,"Please use the 'Reprint VA FORM 10-2321' .",!!
- +2 QUIT
- MSG WRITE !!,"** No action taken. **",!!
- HANG 2
- +1 QUIT
