source: FOIAVistA/trunk/r/REMOTE_ORDER_ENTRY_SYSTEM-RMPF-RMPJ/RMPFET82.m@ 794

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

initial load of FOIAVistA 6/30/08 version

File size: 4.0 KB
Line 
1RMPFET82 ;DDC/KAW-CANCEL A LINE ITEM [ 06/16/95 3:06 PM ]
2 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
3 ;; input: RMPFX,RMPFHAT,RMPFTYP,RMPFST,RMPFTP,DFN
4 ;;output: None
5 Q:'$D(RMPFX) Q:'RMPFX K RMPFY
6START W @IOF,?35,"ACTIVE LINE ITEMS",! D ^RMPFDT2
7 D ARRAY^RMPFDT2 S CL=0 K RMPFRE,RMPFCAN
8 S X=0 F S X=$O(RMPFO(X)) Q:'X D
9 .S Y=RMPFO(X) Q:Y="" S Y=$P($G(^RMPF(791810.2,Y,0)),U,2)
10 .I RMPFHAT="C"!(RMPFHAT="I")!(RMPFHAT="X"),Y'="N" S CL=CL+1,RX=X
11 .I "BQZWJD"[RMPFHAT,Y="B" S CL=CL+1,RX=X
12 I '$D(RMPFO) W !!,"*** NO LINE ITEMS TO CANCEL ***" G EXIT
13 I 'CL W !!,$S(RMPFHAT="C"!(RMPFHAT="I")!(RMPFHAT="X"):"*** ALL LINE ITEMS HAVE ALREADY BEEN CANCELED ***",1:"*** NO ITEMS HAVE BEEN BACKORDERED ***") G EXIT
14 I CL=1 S RMPFY=RX D SET G EXECUTE
15 D ASK1 G END:$D(RMPFOUT),EXECUTE:$D(RMPFCAN)
16 D ASK2 G END:$D(RMPFOUT),END:'$D(RMPFCAN)
17EXECUTE D APPROV G END:$D(RMPFOUT),END:'$D(RMPFCAN)
18 I "CI"[RMPFHAT D ^RMPFET83 G END
19 D CANCEL1 G END
20EXIT F I=1:1 Q:$Y>21 W !
21 W !,"Type <RETURN> to continue." D READ
22END K RMPFY,RMPFRE,RMPFCAN,SL,RMPFO,RMPFMD,CL,CX,C Q
23ASK1 ;;Ask to cancel multiple items
24 ;; input: CL,RMPFO,RMPFX,RMPFY
25 ;;output: RMPFCAN
26 W !!,"Do you wish to cancel the orders for ",CL," line items? NO// " D READ G END:$D(RMPFOUT)
27ASK11 I $D(RMPFQUT) W !!,"Enter a <Y> to cancel all line items",!?5,"an <N> or <RETURN> to select line items to cancel." G ASK1
28 S:Y="" Y="N" I "NnYy"'[Y S RMPFQUT="" G ASK11
29 G ASK1E:"Yy"'[Y S RMPFY=0
30 F S RMPFY=$O(RMPFO(RMPFY)) Q:'RMPFY S X=RMPFO(RMPFY) I X,$D(^RMPF(791810.2,X,0)),$P(^(0),U,2)'="N" D SET
31 K RMPFO
32ASK1E K Y Q
33ASK2 ;;Select items to cancel
34 ;; input: RMPFMD,RMPFX,RMPFY,RMPFO
35 ;;output: RMPFCAN
36 W !!,"Select the Number of the item you wish to cancel: "
37 D READ G END:$D(RMPFOUT)
38ASK21 I $D(RMPFQUT) W !!,"Enter the number to the left of the item you wish to cancel." G ASK2
39 G ASK2E:Y="" I '$D(RMPFMD(Y)) S RMPFQUT="" G ASK21
40 S RMPFY=RMPFMD(Y) I $D(RMPFCAN(RMPFY)) W !!,"*** ITEM ALREADY SELECTED ***" G ASK2
41 S X=RMPFO(RMPFY) I X,$D(^RMPF(791810.2,X,0)),$P(^(0),U,2)="N" K RMPFY W !!,"*** ITEM ALREADY CANCELED ***" G ASK2
42 D SET
43ASK22 W !!,"Select another? NO// " D READ Q:$D(RMPFOUT)
44ASK221 I $D(RMPFQUT) W !!,"Enter a <Y> to select another item to cancel",!?5,"an <N> or <RETURN> to continue" G ASK22
45 S:Y="" Y="N" S Y=$E(Y,1) I "YyNn"'[Y S RMPFQUT="" G ASK221
46 G ASK2:"Yy"[Y
47ASK2E K Y Q
48APPROV ;;Display and ask if selection correct
49 ;; input: RMPFCAN
50 ;;output: None
51 S (CN,RMPFY)=0 F S RMPFY=$O(RMPFCAN(RMPFY)) Q:'RMPFY D
52 .S RMPFIT=$P(RMPFCAN(RMPFY),U,1),RMPFQTY=$P(RMPFCAN(RMPFY),U,2)
53 .W:CN=0 !!,"Item(s) to be canceled: " W:CN ! W ?25,RMPFIT," (",RMPFQTY,")" S CN=CN+1
54APP1 W !!,"Are you sure you wish to cancel ",$S(CN>1:"these",1:"this")," item",$S(CN>1:"s",1:""),"? NO// "
55 D READ G APPROVE:$D(RMPFOUT)
56APP11 I $D(RMPFQUT) W !!,"Enter a <Y> to cancel ",$S(CN>1:"these",1:"this")," item(s)",$S(CN>1:"s",1:""),"",!?5,"an <N> or <RETURN> to leave the item",$S(CN>1:"s",1:"")," active in the order." G APP1
57 S:Y="" Y="N" S Y=$E(Y,1) I "Yy"'[Y K RMPFCAN
58APPROVE K RMPFIT,RMPFQTY,S0,CN,Y Q
59CANCEL1 ;;Cancel a line item
60 ;; input: RMPFCAN
61 ;;output: None
62 S (C,DA)=0 F S DA=$O(RMPFCAN(DA)) G CANCEL1E:'DA D
63 .S C=C+1,%DT="T",X="NOW" D ^%DT S TD=Y
64 .S RMPFIT=$P(RMPFCAN(DA),U,1),RMPFQTY=$P(RMPFCAN(DA),U,2)
65 .W !!,"Item # ",C,": ",RMPFIT,?$X+5,"Quantity: ",RMPFQTY,!
66 .S DIE="^RMPF(791810,"_RMPFX_",101,",DA(1)=RMPFX
67 .S DR=".15////C;.17////"_TD_";.18///CANCELED;.19////C;.2////1;90.13////"_DUZ_";90.05"
68 .D ^DIE
69CANCEL1E W !!,"Item",$S(C=1:"",1:"(s)")," CANCELED",!!
70 D APPROV1^RMPFEA2
71 K C,DA,C,%DT,TD,X,Y,DIE,RMPFIT,RMPFQTY,DR,%X,%Y Q
72SET ;;Set up array of items to cancel
73 ;; input: RMPFX,RMPFY
74 ;;output: RMPFCAN
75 S X=$G(^RMPF(791810,RMPFX,101,RMPFY,0))
76 S RMPFIT=$P(X,U,1),RMPFQTY=$P(X,U,6) S:'RMPFQTY RMPFQTY=1
77 I RMPFIT,$D(^RMPF(791811,RMPFIT,0)) S RMPFIT=$P(^(0),U,1)
78 S RMPFCAN(RMPFY)=RMPFIT_U_RMPFQTY
79 K X,RMPFIT,RMPFQTY Q
80READ K RMPFOUT,RMPFQUT
81 R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U
82 I Y?1"^".E S (RMPFOUT,Y)="" Q
83 S:Y?1"?".E (RMPFQUT,Y)=""
84 Q
Note: See TracBrowser for help on using the repository browser.