PSDEVO ;BIR/JPW,BJW-Edit/Cancel a Verified Order ; 20 Aug 98
;;3.0; CONTROLLED SUBSTANCES ;**10,66**;13 Feb 97;Build 3
;nois:mar-1297-21575
EN ;entry for edit/cancel verified order
I '$D(PSDSITE) D ^PSDSET Q:'$D(PSDSITE)
I '$D(^XUSEC("PSJ RPHARM",DUZ)) W !!,"Contact your Pharmacy Coordinator for access to edit or cancel",!,"a verified Controlled Substances order.",!!,"PSJ RPHARM security key required.",! G END
S PSDUZ=DUZ
W $C(7),!!,?18,"*** NOTE ***",!,?5,"Only Verified Orders with a status of FILLED - NOT DELIVERED",!,?5,"may be edited or cancelled.",!!
ASKD ;ask disp site
S PSDS=$P(PSDSITE,U,3),PSDSN=$P(PSDSITE,U,4)
G:$P(PSDSITE,U,5) GS
K DA,DIC S DIC=58.8,DIC("A")="Select Dispensing Site: ",DIC("S")="I $P(^(0),""^"",3)=+PSDSITE,$S($P(^(0),""^"",2)=""M"":1,$P(^(0),""^"",2)=""S"":1,1:0)"
S DIC(0)="QEA",DIC("B")=PSDSN
D ^DIC K DIC G:Y<0 END
S PSDS=+Y,PSDSN=$P(Y,"^",2),$P(PSDSITE,U,3)=+Y,$P(PSDSITE,U,4)=PSDSN
GS ;ask gs #
K DA,DIC,NQTY S DIC=58.81,DIC("A")="Select Green Sheet #: ",DIC(0)="QEASZ",D="D"
S DIC("S")="I $P(^(0),""^"",3)=+PSDS,$P(^(0),""^"",11)=3"
D IX^DIC K DIC G:Y<0 END S PSDA=+Y,QTY=$P(Y(0),"^",6),PSDPN=$P(Y(0),"^",17),PSDR=$P(Y(0),"^",5),PSDRN=$P($G(^PSDRUG(PSDR,0)),"^"),ORD=$P(Y(0),"^",20),NAOU=$P(Y(0),"^",18)
I '$D(^PSD(58.8,+PSDS,1,PSDR,0)) W !!,PSDRN," is not stocked in ",PSDSN,!! D MSG G END
S NBKU=$P(^PSD(58.8,+PSDS,1,+PSDR,0),"^",8),NPKG=$P(^(0),"^",9)
I 'NPKG!(NBKU']"") W !!,PSDRN," is missing breakdown unit or ",!,"package size data in ",PSDSN,".",!! D MSG G END
I $D(^PSD(58.81,PSDA,4)),+$P(^(4),"^",3) S NQTY=$P(^(4),"^",3)
W !!,"Drug: ",PSDRN,!," Quantity: ",$S($D(NQTY):NQTY,1:QTY)," Breakdown Unit: ",NBKU,!!
ASK ;edit or cancel
K DA,DIR,DIRUT S DIR("A")="ACTION (DC E): ",DIR(0)="SOBA^E:EDIT;DC:CANCEL"
S DIR("?",1)="Select 'E' to Edit this verified order, 'DC' to cancel",DIR("?")="or '^' to quit."
D ^DIR K DIR I $D(DIRUT) D MSG G END
S ANS=Y I ANS="DC" D CANC G END
I ANS="E" D ^PSDEVO1
END K %,%DT,%H,%I,ANS,AQTY,BAL,D,DA,DIC,DIE,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT,EXP,FIELD,LOT,MFG,NAOU,NAOUN,NBKU,NPKG,NQTY,OK,ORD,OREC
K PSDA,PSDOUT,PSDPN,PSDR,PSDRN,PSDS,PSDSN,PSDT,PSDUZ,QTY,RECD,RECDT,RQTY,STAT,STATN,SUB,WK,X,Y
Q
CANC ;canc ver ord
W !!,"Green Sheet # ",PSDPN," Quantity Dispensed: ",$S($D(NQTY):NQTY,1:QTY)," Breakdown Unit: ",NBKU,!
K DA,DIR,DIRUT S DIR(0)="YOA",DIR("?",1)="Answer 'YES' to cancel this order and add the quantity",DIR("?")="back to your vault balance or '^' to quit."
S DIR("A")="Are you sure? " D ^DIR K DIR I $D(DIRUT) D MSG S PSDOUT=1 Q
I 'Y D MSG S PSDOUT=1 Q
S AQTY=$S($D(NQTY):NQTY,1:QTY)
W !!,"Accessing your transaction history..."
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),$P(^(0),"^",4)=$P(^(0),"^",4)+AQTY
L -^PSD(58.8,+PSDS,1,+PSDR,0) W !!,"Old Balance: ",BAL,?35,"New Balance :",BAL+AQTY,!!
W !!,"Updating your transaction history now..."
K DA,DIE,DR S DA=PSDA,DIE=58.81,DR="10////9;55////"_PSDT_";56////"_PSDUZ_";57///"_AQTY_";59////"_BAL_";58" D ^DIE K DA,DIE,DR
W !!,"Order record..." K DA,DIE,DR S DA=ORD,DA(1)=PSDR,DA(2)=NAOU,DIE="^PSD(58.8,"_DA(2)_",1,"_DA(1)_",3,",DR="10////9;19////@" D ^DIE K DA,DIE,DR
I +$O(^PSD(58.85,"AD",NAOU,PSDR,ORD,0)) W "worksheet..." S DA=+$O(^PSD(58.85,"AD",NAOU,PSDR,ORD,0)),DIE=58.85,DR="6////9" D ^DIE K DIE,DA,DR
;Betty I'm commenting out the following line like we discussed
;I $D(^PSD(58.8,NAOU,1,PSDR,0)) S $P(^(0),"^",4)=$P(^(0),"^",4)-AQTY
MON ;monthly activity
I '$D(^PSD(58.8,+PSDS,1,PSDR,5,0)) S ^(0)="^58.801A^^"
I '$D(^PSD(58.8,+PSDS,1,PSDR,5,$E(DT,1,5)*100,0)) K DIC S DIC="^PSD(58.8,"_+PSDS_",1,"_PSDR_",5,",DIC(0)="LM",DLAYGO=58.8,(X,DINUM)=$E(DT,1,5)*100,DA(2)=+PSDS,DA(1)=PSDR D ^DIC K DIC,DA,DINUM,DLAYGO
K DA,DIE,DR S DIE="^PSD(58.8,"_+PSDS_",1,"_PSDR_",5,",DA(2)=+PSDS,DA(1)=PSDR,DA=$E(DT,1,5)*100,DR="11////^S X=$P($G(^(0)),""^"",7)+QTY" D ^DIE K DA,DIE,DR
W !!,"Finished. Your Green Sheet # ",PSDPN," has been cancelled.",!!
Q
MSG W !!,"** No action taken. **",!!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDEVO 4128 printed Dec 13, 2024@01:45:54 Page 2
PSDEVO ;BIR/JPW,BJW-Edit/Cancel a Verified Order ; 20 Aug 98
+1 ;;3.0; CONTROLLED SUBSTANCES ;**10,66**;13 Feb 97;Build 3
+2 ;nois:mar-1297-21575
EN ;entry for edit/cancel verified order
+1 IF '$DATA(PSDSITE)
DO ^PSDSET
if '$DATA(PSDSITE)
QUIT
+2 IF '$DATA(^XUSEC("PSJ RPHARM",DUZ))
WRITE !!,"Contact your Pharmacy Coordinator for access to edit or cancel",!,"a verified Controlled Substances order.",!!,"PSJ RPHARM security key required.",!
GOTO END
+3 SET PSDUZ=DUZ
+4 WRITE $CHAR(7),!!,?18,"*** NOTE ***",!,?5,"Only Verified Orders with a status of FILLED - NOT DELIVERED",!,?5,"may be edited or cancelled.",!!
ASKD ;ask disp site
+1 SET PSDS=$PIECE(PSDSITE,U,3)
SET PSDSN=$PIECE(PSDSITE,U,4)
+2 if $PIECE(PSDSITE,U,5)
GOTO GS
+3 KILL DA,DIC
SET DIC=58.8
SET DIC("A")="Select Dispensing Site: "
SET DIC("S")="I $P(^(0),""^"",3)=+PSDSITE,$S($P(^(0),""^"",2)=""M"":1,$P(^(0),""^"",2)=""S"":1,1:0)"
+4 SET DIC(0)="QEA"
SET DIC("B")=PSDSN
+5 DO ^DIC
KILL DIC
if Y<0
GOTO END
+6 SET PSDS=+Y
SET PSDSN=$PIECE(Y,"^",2)
SET $PIECE(PSDSITE,U,3)=+Y
SET $PIECE(PSDSITE,U,4)=PSDSN
GS ;ask gs #
+1 KILL DA,DIC,NQTY
SET DIC=58.81
SET DIC("A")="Select Green Sheet #: "
SET DIC(0)="QEASZ"
SET D="D"
+2 SET DIC("S")="I $P(^(0),""^"",3)=+PSDS,$P(^(0),""^"",11)=3"
+3 DO IX^DIC
KILL DIC
if Y<0
GOTO END
SET PSDA=+Y
SET QTY=$PIECE(Y(0),"^",6)
SET PSDPN=$PIECE(Y(0),"^",17)
SET PSDR=$PIECE(Y(0),"^",5)
SET PSDRN=$PIECE($GET(^PSDRUG(PSDR,0)),"^")
SET ORD=$PIECE(Y(0),"^",20)
SET NAOU=$PIECE(Y(0),"^",18)
+4 IF '$DATA(^PSD(58.8,+PSDS,1,PSDR,0))
WRITE !!,PSDRN," is not stocked in ",PSDSN,!!
DO MSG
GOTO END
+5 SET NBKU=$PIECE(^PSD(58.8,+PSDS,1,+PSDR,0),"^",8)
SET NPKG=$PIECE(^(0),"^",9)
+6 IF 'NPKG!(NBKU']"")
WRITE !!,PSDRN," is missing breakdown unit or ",!,"package size data in ",PSDSN,".",!!
DO MSG
GOTO END
+7 IF $DATA(^PSD(58.81,PSDA,4))
IF +$PIECE(^(4),"^",3)
SET NQTY=$PIECE(^(4),"^",3)
+8 WRITE !!,"Drug: ",PSDRN,!," Quantity: ",$SELECT($DATA(NQTY):NQTY,1:QTY)," Breakdown Unit: ",NBKU,!!
ASK ;edit or cancel
+1 KILL DA,DIR,DIRUT
SET DIR("A")="ACTION (DC E): "
SET DIR(0)="SOBA^E:EDIT;DC:CANCEL"
+2 SET DIR("?",1)="Select 'E' to Edit this verified order, 'DC' to cancel"
SET DIR("?")="or '^' to quit."
+3 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
DO MSG
GOTO END
+4 SET ANS=Y
IF ANS="DC"
DO CANC
GOTO END
+5 IF ANS="E"
DO ^PSDEVO1
END KILL %,%DT,%H,%I,ANS,AQTY,BAL,D,DA,DIC,DIE,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT,EXP,FIELD,LOT,MFG,NAOU,NAOUN,NBKU,NPKG,NQTY,OK,ORD,OREC
+1 KILL PSDA,PSDOUT,PSDPN,PSDR,PSDRN,PSDS,PSDSN,PSDT,PSDUZ,QTY,RECD,RECDT,RQTY,STAT,STATN,SUB,WK,X,Y
+2 QUIT
CANC ;canc ver ord
+1 WRITE !!,"Green Sheet # ",PSDPN," Quantity Dispensed: ",$SELECT($DATA(NQTY):NQTY,1:QTY)," Breakdown Unit: ",NBKU,!
+2 KILL DA,DIR,DIRUT
SET DIR(0)="YOA"
SET DIR("?",1)="Answer 'YES' to cancel this order and add the quantity"
SET DIR("?")="back to your vault balance or '^' to quit."
+3 SET DIR("A")="Are you sure? "
DO ^DIR
KILL DIR
IF $DATA(DIRUT)
DO MSG
SET PSDOUT=1
QUIT
+4 IF 'Y
DO MSG
SET PSDOUT=1
QUIT
+5 SET AQTY=$SELECT($DATA(NQTY):NQTY,1:QTY)
+6 WRITE !!,"Accessing your transaction history..."
+7 FOR
LOCK +^PSD(58.8,+PSDS,1,+PSDR,0):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
IF $TEST
QUIT
+8 DO NOW^%DTC
SET PSDT=+%
+9 SET BAL=$PIECE(^PSD(58.8,+PSDS,1,+PSDR,0),"^",4)
SET $PIECE(^(0),"^",4)=$PIECE(^(0),"^",4)+AQTY
+10 LOCK -^PSD(58.8,+PSDS,1,+PSDR,0)
WRITE !!,"Old Balance: ",BAL,?35,"New Balance :",BAL+AQTY,!!
+11 WRITE !!,"Updating your transaction history now..."
+12 KILL DA,DIE,DR
SET DA=PSDA
SET DIE=58.81
SET DR="10////9;55////"_PSDT_";56////"_PSDUZ_";57///"_AQTY_";59////"_BAL_";58"
DO ^DIE
KILL DA,DIE,DR
+13 WRITE !!,"Order record..."
KILL DA,DIE,DR
SET DA=ORD
SET DA(1)=PSDR
SET DA(2)=NAOU
SET DIE="^PSD(58.8,"_DA(2)_",1,"_DA(1)_",3,"
SET DR="10////9;19////@"
DO ^DIE
KILL DA,DIE,DR
+14 IF +$ORDER(^PSD(58.85,"AD",NAOU,PSDR,ORD,0))
WRITE "worksheet..."
SET DA=+$ORDER(^PSD(58.85,"AD",NAOU,PSDR,ORD,0))
SET DIE=58.85
SET DR="6////9"
DO ^DIE
KILL DIE,DA,DR
+15 ;Betty I'm commenting out the following line like we discussed
+16 ;I $D(^PSD(58.8,NAOU,1,PSDR,0)) S $P(^(0),"^",4)=$P(^(0),"^",4)-AQTY
MON ;monthly activity
+1 IF '$DATA(^PSD(58.8,+PSDS,1,PSDR,5,0))
SET ^(0)="^58.801A^^"
+2 IF '$DATA(^PSD(58.8,+PSDS,1,PSDR,5,$EXTRACT(DT,1,5)*100,0))
KILL DIC
SET DIC="^PSD(58.8,"_+PSDS_",1,"_PSDR_",5,"
SET DIC(0)="LM"
SET DLAYGO=58.8
SET (X,DINUM)=$EXTRACT(DT,1,5)*100
SET DA(2)=+PSDS
SET DA(1)=PSDR
DO ^DIC
KILL DIC,DA,DINUM,DLAYGO
+3 KILL DA,DIE,DR
SET DIE="^PSD(58.8,"_+PSDS_",1,"_PSDR_",5,"
SET DA(2)=+PSDS
SET DA(1)=PSDR
SET DA=$EXTRACT(DT,1,5)*100
SET DR="11////^S X=$P($G(^(0)),""^"",7)+QTY"
DO ^DIE
KILL DA,DIE,DR
+4 WRITE !!,"Finished. Your Green Sheet # ",PSDPN," has been cancelled.",!!
+5 QUIT
MSG WRITE !!,"** No action taken. **",!!
+1 QUIT
