PSDORL ;BIR/JPW/LTL-CS Order Entry Listing and Cancel ; 19 Dec 94
;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
LIST ;list if pending orders
W !!,"Searching for pending orders..."
S PSDOUT=0 D SORT G:PSDOUT END
CANC ;ask to cancel orders
K DA,DIR,DIRUT S DIR(0)="Y",DIR("A")="Do you wish to cancel any pending orders",DIR("?")="Answer YES to select order(s) to cancel, NO or ^ to continue this order."
S DIR("B")="NO" D ^DIR I 'Y!($D(DIRUT)) D MSG G END
D PRT
ASK K DA,DIR,DIRUT
W !,"You may cancel one order at a time.",!
S DIR("A")="Please enter the order number you wish to cancel",DIR(0)="NO^1:"_OCNT,DIR("?")="Answer with the order number you wish to cancel or <RET> to continue with your order"
D ^DIR I 'Y D MSG G END
S KKO=+Y
ORD ;update ord
K DA,DIE,DR S DIE="^PSD(58.8,"_NAOU_",1,"_PSDR_",3,",DA=+$P($G(LOC(KKO)),"^",2),DA(1)=PSDR,DA(2)=NAOU,DR="10////9;19////@" D ^DIE K DA,DIE,DR
S DA=+$P($G(LOC(KKO)),"^")
K DIE,DR S DIE=58.85,DR="6////9" D ^DIE K DA,DIE,DR
W $C(7),!!,"** The order you selected has been cancelled. **",!
G LIST
END K AA,DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,JJ,KK,KKO,KK2,KK3,KK4,KK5,LL,LOC,NODEL,OCNT,PSDOUT,TOT,Y
Q
MSG W !!,"No orders cancelled. Continue processing your order.",!
Q
SORT ;searches for orders
K LL
S (AA,TOT,OCNT)=0 F S AA=$O(^PSD(58.85,"AC",AA)) Q:'AA!(AA>3) S JJ=0 F S JJ=$O(^PSD(58.85,"AC",AA,+NAOU,+PSDR,JJ)) Q:'JJ S KK=0 F S KK=$O(^PSD(58.85,"AC",AA,+NAOU,+PSDR,JJ,KK)) Q:'KK D
.Q:'$D(^PSD(58.85,KK,0)) S NODEL=^PSD(58.85,KK,0),TOT=TOT+$P(NODEL,"^",6),OCNT=OCNT+1
.I AA=1,'+$G(^PSD(58.85,KK,2)) S LL(KK)=""
W !!,$S(OCNT:"Orders pending: "_OCNT_" Quantity Ordered ("_NBKU_"): "_TOT,1:"No orders pending"),!!
I 'OCNT S PSDOUT=1 Q
I '$O(LL(0)) W $C(7),"All pending orders are currently being processed. Please review the PENDING ",!,"CS ORDERS REPORT for more information.",! S PSDOUT=1 Q
Q
PRT ;displays list
K LOC
W !!,"Accessing pending orders for ",PSDRN,"...",!!,"The following orders may be cancelled:",!
W !,?6,"DATE ORDERED",?25,"QUANTITY",?38,"ORDERED BY",! S (KK,OCNT)=0
F S KK=$O(LL(KK)) Q:'KK I $D(^PSD(58.85,KK,0)),'$D(^PSD(58.85,KK,2)) D
.S NODEL=^PSD(58.85,KK,0) Q:$P(NODEL,"^",7)>1
.Q:+$P($G(NODEL),"^",8) S KK2=+$P($G(NODEL),"^",5),KK3=+$P($G(NODEL),"^",6),(KK4,Y)=+$P($G(NODEL),"^",18) X ^DD("DD") S KK4=Y
.S KK5=+$P($G(NODEL),"^",12),KK5=$S($P($G(^VA(200,KK5,0)),"^")]"":$P($G(^(0)),"^"),1:"UNKNOWN")
.S OCNT=OCNT+1,LOC(OCNT)=KK_"^"_KK2_"^"_KK3_"^"_KK4_"^"_KK5
.W !,"(",OCNT,")",?5,KK4,?25,$J(KK3,8),?38,KK5
W !
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDORL 2567 printed Apr 09, 2024@20:52:24 Page 2
PSDORL ;BIR/JPW/LTL-CS Order Entry Listing and Cancel ; 19 Dec 94
+1 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
LIST ;list if pending orders
+1 WRITE !!,"Searching for pending orders..."
+2 SET PSDOUT=0
DO SORT
if PSDOUT
GOTO END
CANC ;ask to cancel orders
+1 KILL DA,DIR,DIRUT
SET DIR(0)="Y"
SET DIR("A")="Do you wish to cancel any pending orders"
SET DIR("?")="Answer YES to select order(s) to cancel, NO or ^ to continue this order."
+2 SET DIR("B")="NO"
DO ^DIR
IF 'Y!($DATA(DIRUT))
DO MSG
GOTO END
+3 DO PRT
ASK KILL DA,DIR,DIRUT
+1 WRITE !,"You may cancel one order at a time.",!
+2 SET DIR("A")="Please enter the order number you wish to cancel"
SET DIR(0)="NO^1:"_OCNT
SET DIR("?")="Answer with the order number you wish to cancel or <RET> to continue with your order"
+3 DO ^DIR
IF 'Y
DO MSG
GOTO END
+4 SET KKO=+Y
ORD ;update ord
+1 KILL DA,DIE,DR
SET DIE="^PSD(58.8,"_NAOU_",1,"_PSDR_",3,"
SET DA=+$PIECE($GET(LOC(KKO)),"^",2)
SET DA(1)=PSDR
SET DA(2)=NAOU
SET DR="10////9;19////@"
DO ^DIE
KILL DA,DIE,DR
+2 SET DA=+$PIECE($GET(LOC(KKO)),"^")
+3 KILL DIE,DR
SET DIE=58.85
SET DR="6////9"
DO ^DIE
KILL DA,DIE,DR
+4 WRITE $CHAR(7),!!,"** The order you selected has been cancelled. **",!
+5 GOTO LIST
END KILL AA,DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,JJ,KK,KKO,KK2,KK3,KK4,KK5,LL,LOC,NODEL,OCNT,PSDOUT,TOT,Y
+1 QUIT
MSG WRITE !!,"No orders cancelled. Continue processing your order.",!
+1 QUIT
SORT ;searches for orders
+1 KILL LL
+2 SET (AA,TOT,OCNT)=0
FOR
SET AA=$ORDER(^PSD(58.85,"AC",AA))
if 'AA!(AA>3)
QUIT
SET JJ=0
FOR
SET JJ=$ORDER(^PSD(58.85,"AC",AA,+NAOU,+PSDR,JJ))
if 'JJ
QUIT
SET KK=0
FOR
SET KK=$ORDER(^PSD(58.85,"AC",AA,+NAOU,+PSDR,JJ,KK))
if 'KK
QUIT
Begin DoDot:1
+3 if '$DATA(^PSD(58.85,KK,0))
QUIT
SET NODEL=^PSD(58.85,KK,0)
SET TOT=TOT+$PIECE(NODEL,"^",6)
SET OCNT=OCNT+1
+4 IF AA=1
IF '+$GET(^PSD(58.85,KK,2))
SET LL(KK)=""
End DoDot:1
+5 WRITE !!,$SELECT(OCNT:"Orders pending: "_OCNT_" Quantity Ordered ("_NBKU_"): "_TOT,1:"No orders pending"),!!
+6 IF 'OCNT
SET PSDOUT=1
QUIT
+7 IF '$ORDER(LL(0))
WRITE $CHAR(7),"All pending orders are currently being processed. Please review the PENDING ",!,"CS ORDERS REPORT for more information.",!
SET PSDOUT=1
QUIT
+8 QUIT
PRT ;displays list
+1 KILL LOC
+2 WRITE !!,"Accessing pending orders for ",PSDRN,"...",!!,"The following orders may be cancelled:",!
+3 WRITE !,?6,"DATE ORDERED",?25,"QUANTITY",?38,"ORDERED BY",!
SET (KK,OCNT)=0
+4 FOR
SET KK=$ORDER(LL(KK))
if 'KK
QUIT
IF $DATA(^PSD(58.85,KK,0))
IF '$DATA(^PSD(58.85,KK,2))
Begin DoDot:1
+5 SET NODEL=^PSD(58.85,KK,0)
if $PIECE(NODEL,"^",7)>1
QUIT
+6 if +$PIECE($GET(NODEL),"^",8)
QUIT
SET KK2=+$PIECE($GET(NODEL),"^",5)
SET KK3=+$PIECE($GET(NODEL),"^",6)
SET (KK4,Y)=+$PIECE($GET(NODEL),"^",18)
XECUTE ^DD("DD")
SET KK4=Y
+7 SET KK5=+$PIECE($GET(NODEL),"^",12)
SET KK5=$SELECT($PIECE($GET(^VA(200,KK5,0)),"^")]"":$PIECE($GET(^(0)),"^"),1:"UNKNOWN")
+8 SET OCNT=OCNT+1
SET LOC(OCNT)=KK_"^"_KK2_"^"_KK3_"^"_KK4_"^"_KK5
+9 WRITE !,"(",OCNT,")",?5,KK4,?25,$JUSTIFY(KK3,8),?38,KK5
End DoDot:1
+10 WRITE !
+11 QUIT
