- 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
- 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
