source: WorldVistAEHR/trunk/r/REMOTE_ORDER_ENTRY_SYSTEM-RMPF-RMPJ/RMPFER.m@ 701

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

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1RMPFER ;DDC/KAW-REMOVE ORDER FROM A BATCH; [ 04/04/97 8:35 AM ]
2 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;**4**;MAY 30, 1995
3RMPFSET I '$D(RMPFMENU) D MENU^RMPFUTL I '$D(RMPFMENU) W !!,$C(7),"*** A MENU SELECTION MUST BE MADE ***" Q ;;RMPFMENU must be defined
4 I '$D(RMPFSTAN)!'$D(RMPFDAT)!'$D(RMPFSYS) D ^RMPFUTL Q:'$D(RMPFSTAN)!'$D(RMPFDAT)!'$D(RMPFSYS)
5 W @IOF,!,"REMOVE ORDER FROM A BATCH"
6 I '$D(^RMPF(791812,"C",1)) W $C(7),!!,"*** NO BATCHES CURRENTLY OPEN ***" G END
7 W !!,"Currently Open Batch:",! F I=1:1:21 W "-"
8A0 S (RMPFBT,CT)=0,RM=$O(^RMPF(791810.5,"C",RMPFMENU,0))
9A1 S RMPFBT=$O(^RMPF(791812,"C",1,RMPFBT))
10 G A2:'RMPFBT,A1:'$D(^RMPF(791812,RMPFBT,0)) S S0=^(0)
11 G A1:$P(S0,U,2)'=1 S Y=$P(S0,U,1) D DD^%DT
12 G A1:$P(S0,U,8)'=RMPFSTAP,A1:$P(S0,U,9)'=RM
13 S D=Y,N=$P(S0,U,4) W !!,"Date/Time Opened: ",D
14 W !?1,"Number in Batch: ",N S CT=CT+1,RMPFBTH=RMPFBT G A1
15A2 I CT=0 W !!,"*** NO OPEN BATCH ***" G END
16 I CT=1 S RMPFBT=RMPFBTH G END:'RMPFBT,END:'$D(^RMPF(791812,RMPFBT,0)),A4
17 S %DT("A")="Select Date/Time of Batch to Edit: " W !
18 S %DT="AET" D ^%DT G END:Y=-1 S X=$O(^RMPF(791812,"B",Y,0))
19 I X,$D(^RMPF(791812,X,0)),$P(^(0),U,2)=1 G A3
20 W $C(7) G A0
21A3 S RMPFBT=X K RMPFBJ
22A4 W !!,"Display batch entries? YES// " D READ G END:$D(RMPFOUT)
23A41 I $D(RMPFQUT) W !!,"Type <Y> or <RETURN> to display entries in the batch or <N> to continue." G A4
24 S:Y="" Y="Y" I "YyNn"'[Y S RMPFQUT="" G A41
25 G END:"Nn"[Y
26A42 D ^RMPFDB1
27 D DELETE G END:$D(RMPFOUT)!'$D(RMPFBJ),RMPFSET
28END K RMPFB,RMPFBJ,N,D,RMPFBT,POP,I,CT,X,Y,%,%DT,RM Q
29READ K RMPFOUT,RMPFQUT
30 R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U
31 I Y?1"^".E S (RMPFOUT,Y)="" Q
32 S:Y?1"?".E (RMPFQUT,Y)=""
33 Q
34DELETE ;;input: RMPFB
35 ;;output: None
36 K RMPFBJ
37 W !!,"Enter Order Numbers Separated by Commas: "
38 D READ G DELETEE:$D(RMPFOUT)
39DELE I $D(RMPFQUT) W !!,"Select the number(s) to the left of the orders you wish to delete.",!,"Separate numbers with commas." G DELETE
40 G DELETEE:Y=""
41 F I=1:1 S X=$P(Y,",",I) Q:X="" I '$D(RMPFB(X)) S RMPFQUT="" Q
42 G DELE:$D(RMPFQUT) S SG=Y W !!
43 F I=1:1 S RX=$P(SG,",",I) Q:RX="" I $D(RMPFB(RX)) S RMPFBJ=RMPFB(RX) I $D(^RMPF(791812,RMPFBT,101,RMPFBJ,0)) S RMPFX=$P(^(0),U,1) D DEL
44 K X,Y,I,SG,RX Q
45DEL I $D(RMPFX),RMPFX,$D(^RMPF(791810,RMPFX,0)) G DEL0
46 W !!?25,$C(7),"*** ORDER DOES NOT EXIST *** " G DELETEE
47DEL0 W !!,"Order: " S Y=$P(^RMPF(791810,RMPFX,0),U,1) D DD^%DT W Y S X=$P(^RMPF(791810,RMPFX,0),U,2) I X,$D(^RMPF(791810.1,X,0)) W ?$X+5,$P(^(0),U,1)
48 W !!,"Are you sure you want to delete this order from the batch? NO// " D READ
49 G DELETEE:$D(RMPFOUT)
50DEL1 I $D(RMPFQUT) W !!,"Enter <N> or <RETURN> to continue or <Y> to delete the order." G DEL0
51 S:Y="" Y="N" S Y=$E(Y,1) I "yYnN"'[Y S RMPFQUT="" G DEL1
52 G DELETEE:"Nn"[Y
53DEL2 W !!,"Enter reason for deletion: " D READ
54 G DELETEE:$D(RMPFOUT)
55DEL3 I $D(RMPFQUT) W !!,"You must enter a reason for the deletion (3 to 30 characters)." G DEL2
56 I $L(Y)<3!$L(Y)>30 S RMPFQUT="" G DEL3
57 S RMPFDLR=Y
58 S X="NOW",%DT="TR" D ^%DT S RMPFDTD=Y
59 S DIE="^RMPF(791812,"_RMPFBT_",101,",DA(1)=RMPFBT,DA=RMPFBJ
60 S DR=".02////"_DUZ_";.03////"_RMPFDTD_";.04////"_RMPFDLR D ^DIE
61 L ^RMPF(791812,RMPFBT,0) S X=$P(^RMPF(791812,RMPFBT,0),U,4) S:X X=X-1 S $P(^(0),U,4)=X
62 I X=0 S Y=$P(^RMPF(791812,RMPFBT,0),U,2) K:Y ^RMPF(791812,"C",Y,RMPFBT) S Y=$P(^RMPF(791812,RMPFBT,0),U,1) K ^RMPF(791812,RMPFBT),^RMPF(791812,"B",Y,RMPFBT)
63 L
64 S DIE="^RMPF(791810,",DA=RMPFX,DR=".03///DISAPPROVED;.06////"_RMPFDTD_";.1////"_DUZ_";.11////"_RMPFDTD_";10.02////"_RMPFDLR D ^DIE
65 S DIE="^RMPF(791810,"_RMPFX_",101,",DA(1)=RMPFX
66 S DR=".17////"_RMPFDTD_";.18///DISAPPROVED;.2////1",DA=0
67 D ARRAY^RMPFDT2 F S DA=$O(RMPFO(DA)) Q:'DA D ^DIE
68 W !!?20,"*** ORDER DELETED FROM BATCH ***" H 2
69DELETEE K RMPFX,RMPFDLR,RMPFDTD,DI,D0,DQ,%DT,DA,DC,DIE,DIC,DA,DR,D,X,Y Q
Note: See TracBrowser for help on using the repository browser.