source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBECEA2.m@ 635

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

initial load of FOIAVistA 6/30/08 version
File size: 3.5 KB
Line 
1IBECEA2 ;ALB/CPM-Cancel/Edit/Add... Edit a Charge ; 15-MAR-93
2 ;;2.0;INTEGRATED BILLING;**57,52,150,176,183,240**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5ONE ; Edit a single charge.
6 N IBGMTR
7 S IBGMTR=0 ; GMT Related flag
8 ;
9 D HDR^IBECEAU("E D I T")
10 ;
11 ; - don't allow edit of CHAMPVA charges
12 I $P($G(^IB(IBN,1)),"^",5) W !,"Sorry! You cannot edit the CHAMPVA inpatient subsistence charge.",!,"Please cancel this charge and add a new charge." G ONEQ
13 ;
14 ; - don't allow edit of TRICARE charges
15 I $P($G(^IBE(350.1,+$P($G(^IB(IBN,0)),"^",3),0)),"^",11)=7 W !,"Sorry! You cannot edit TRICARE copayment charges.",!,"Please cancel this charge and add a new charge." G ONEQ
16 ;
17 ; - don't allow edit of LTC charges
18 S IBXA=$P($G(^IBE(350.1,+$P($G(^IB(IBN,0)),"^",3),0)),"^",11)
19 I IBXA>7,IBXA<10 W !,"Sorry! You cannot edit LTC copayment charges.",!,"Please cancel this charge and add a new charge." G ONEQ
20 ;
21 ; - perform up-front edits
22 I 'IBND S IBY="-1^IB021" G ONEQ
23 S IBPARNT=+$P(IBND,"^",9) I '$D(^IB(IBPARNT,0)) S IBY="-1^IB027" G ONEQ
24 I $$LAST^IBECEAU(IBPARNT)'=IBN W !,"You can only edit the last transaction for an original charge." G ONEQ
25 S IBATYP=$G(^IBE(350.1,+$P(IBND,"^",3),0)) I IBATYP="" S IBY="-1^IB022" G ONEQ
26 S IBSEQNO=$P(IBATYP,"^",5) I 'IBSEQNO S IBY="-1^IB023" G ONEQ
27 I $P(IBATYP,"^",5)=2 W !,"You cannot edit cancellation transactions... please add a new charge." G ONEQ
28 I $P(IBND,"^",5)=10 W !,"You cannot edit charges which have been directly cancelled.",!,"Please add a new charge." G ONEQ
29 ;
30 ; - see if charge has been billed or not
31 S IBH="^1^2^8^9^99^"[("^"_+$P(IBND,"^",5)_"^"),IBXA=$P(IBATYP,"^",11)
32 S IBIL=$P(IBND,"^",11),IBUNITP=+$P(IBND,"^",6),IBCHGP=+$P(IBND,"^",7)
33 S IBATYP=+$P($G(^IBE(350.1,+$P(IBND,"^",3),0)),"^",9)
34 I 'IBH D G:IBY<0 ONEQ
35 .I 'IBUNITP W !,"This charge has been billed, but there are no units!" S IBY=-1 Q
36 .I 'IBCHGP W !,"There is no charge amount associated with this action!" S IBY=-1 Q
37 .I IBIL="" W !,"This charge has been billed, but there is no bill number!" S IBY=-1 Q
38 I IBH,$P(IBND,"^",5)'=8 W !,"*** Please Note: This charge has not yet been passed to Accounts Receivable ***"
39 I $P(IBND,"^",5)=8 W !?17,"*** Please Note: This charge is on hold. ***",!?9,"Editing it will cause it to be passed to Accounts Receivable."
40 ;
41 ; - ask user for the cancellation reason
42 I 'IBH,IBXA'=4 D REAS^IBECEAU2("E") G:IBCRES<0 ONEQ
43 ;
44 ; - ask user for data to be edited
45 D ^IBECEA21 G:IBY<0 ONEQ
46 ;
47 ; - okay to proceed?
48 D PROC^IBECEAU4("edit") G:IBY<0 ONEQ S IBUPD=IBND
49 ;
50 ; - cancel 354.71 transaction (copay cap)
51 S:$P(IBND,"^",19) IBAMC=$$CANCEL^IBARXMN(DFN,$P(IBND,"^",19),.IBY) G:IBY<0 ONEQ
52 ;
53 ; - build the cancellation transaction
54 D CANC^IBECEAU4(IBN,IBCRES,0) G:IBY<0 ONEQ
55 ;
56 ; - build new 354.71 transaction (copay cap)
57 I IBXA=5 W !!,"Building the new cap transaction... " S IBAM=$$ADD^IBARXMN(DFN,"^^"_DT_"^^P^^"_IBUNIT_"^"_IBCHG_"^"_IBDESC_"^^"_IBCHG_"^0^"_IBSITE) I IBAM<0 S IBY="-1^IB316" G ONEQ
58 ;
59 ; - build the updated transaction
60 D UPD^IBECEA22 G:IBY<0 ONEQ
61 ;
62 ; - handle updating of clock
63 I "^1^2^3^"[("^"_IBXA_"^") D CLOCK^IBECEAU(IBDOLA-IBCLDOL,IBCLDAY,IBDAYA-IBCLDAY)
64 ;
65ONEQ D ERR^IBECEAU4:IBY<0,PAUSE^IBECEAU
66 K IBBS,IBCRES,IBDESC,IBIL,IBND,IBARTYP,IBSEQNO,IBTOTL,IBUNIT,IBATYP,IBIDX,IBN,IBY,IBPARNT,IBH,IBXA,IBNOS,IBRTED,IBADJMED,IBAM,IBAMC
67 K IBAFY,IBCAN,IBCHG,IBCHGP,IBCLDA,IBCLDAY,IBCLDOL,IBCLDOLO,IBCLDT,IBCLST,IBDAYA,IBDAYP,IBDOLA,IBDOLP,IBDT,IBFR,IBFRP,IBI,IBJ,IBLIM,IBMED,IBTO,IBTOP,IBTRAN,IBUNIT,IBUNITP,IBUPD
68 Q
Note: See TracBrowser for help on using the repository browser.