source: WorldVistAEHR/trunk/r/CONTROLLED_SUBSTANCES-PSD/PSDORL.m@ 767

Last change on this file since 767 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1PSDORL ;BIR/JPW/LTL-CS Order Entry Listing and Cancel ; 19 Dec 94
2 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
3LIST ;list if pending orders
4 W !!,"Searching for pending orders..."
5 S PSDOUT=0 D SORT G:PSDOUT END
6CANC ;ask to cancel orders
7 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."
8 S DIR("B")="NO" D ^DIR I 'Y!($D(DIRUT)) D MSG G END
9 D PRT
10ASK K DA,DIR,DIRUT
11 W !,"You may cancel one order at a time.",!
12 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"
13 D ^DIR I 'Y D MSG G END
14 S KKO=+Y
15ORD ;update ord
16 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
17 S DA=+$P($G(LOC(KKO)),"^")
18 K DIE,DR S DIE=58.85,DR="6////9" D ^DIE K DA,DIE,DR
19 W $C(7),!!,"** The order you selected has been cancelled. **",!
20 G LIST
21END K AA,DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,JJ,KK,KKO,KK2,KK3,KK4,KK5,LL,LOC,NODEL,OCNT,PSDOUT,TOT,Y
22 Q
23MSG W !!,"No orders cancelled. Continue processing your order.",!
24 Q
25SORT ;searches for orders
26 K LL
27 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
28 .Q:'$D(^PSD(58.85,KK,0)) S NODEL=^PSD(58.85,KK,0),TOT=TOT+$P(NODEL,"^",6),OCNT=OCNT+1
29 .I AA=1,'+$G(^PSD(58.85,KK,2)) S LL(KK)=""
30 W !!,$S(OCNT:"Orders pending: "_OCNT_" Quantity Ordered ("_NBKU_"): "_TOT,1:"No orders pending"),!!
31 I 'OCNT S PSDOUT=1 Q
32 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
33 Q
34PRT ;displays list
35 K LOC
36 W !!,"Accessing pending orders for ",PSDRN,"...",!!,"The following orders may be cancelled:",!
37 W !,?6,"DATE ORDERED",?25,"QUANTITY",?38,"ORDERED BY",! S (KK,OCNT)=0
38 F S KK=$O(LL(KK)) Q:'KK I $D(^PSD(58.85,KK,0)),'$D(^PSD(58.85,KK,2)) D
39 .S NODEL=^PSD(58.85,KK,0) Q:$P(NODEL,"^",7)>1
40 .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
41 .S KK5=+$P($G(NODEL),"^",12),KK5=$S($P($G(^VA(200,KK5,0)),"^")]"":$P($G(^(0)),"^"),1:"UNKNOWN")
42 .S OCNT=OCNT+1,LOC(OCNT)=KK_"^"_KK2_"^"_KK3_"^"_KK4_"^"_KK5
43 .W !,"(",OCNT,")",?5,KK4,?25,$J(KK3,8),?38,KK5
44 W !
45 Q
Note: See TracBrowser for help on using the repository browser.