1 | IBAMTV32 ;ALB/CPM - RELEASE PENDING CHARGES ACTIONS ; 03-JUN-94
|
---|
2 | ;;Version 2.0 ; INTEGRATED BILLING ;**15**; 21-MAR-94
|
---|
3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | ;
|
---|
5 | PC ; 'Pass Charges' entry action.
|
---|
6 | N IBCOMMIT,IBNBR,IBY,IBMSG,IBNOS,IBNOSX,IBND,IBY,IBMSG,IBDUZ,IBSTAT
|
---|
7 | N IBAFY,IBATYP,IBARTYP,IBN,IBSEQNO,IBSERV,IBTOTL,IBTRAN,IBIL,IBBG
|
---|
8 | S IBCOMMIT=0 D EN^VALM2($G(XQORNOD(0))) I '$O(VALMY(0)) G PCQ
|
---|
9 | S IBNBR="" F S IBNBR=$O(VALMY(IBNBR)) Q:'IBNBR D D MSG
|
---|
10 | .S (IBNOS,IBNOSX)=^TMP("IBAMTV31",$J,"IDX",IBNBR,IBNBR)
|
---|
11 | .S IBND=$G(^IB(IBNOS,0)),IBY=1,IBMSG="",IBDUZ=DUZ
|
---|
12 | .I 'IBND S IBMSG="was not passed - record missing the zeroth node" Q
|
---|
13 | .I $P(IBND,"^",12) S IBMSG="was not passed - the charge already has an AR Transaction Number" Q
|
---|
14 | .S IBSTAT=+$P(IBND,"^",5) I $P($G(^IBE(350.21,IBSTAT,0)),"^",4) S IBMSG="was not passed - the status indicates that the charge is billed" Q
|
---|
15 | .I $P(IBND,"^",7)'>0 S IBMSG="was not passed - there is no charge amount" Q
|
---|
16 | .S IBSEQNO=$P($G(^IBE(350.1,+$P(IBND,"^",3),0)),"^",5) I 'IBSEQNO S IBMSG="was not passed (Bulletin will be generated)",IBY="-1^IB023" Q
|
---|
17 | .;
|
---|
18 | .; - okay to pass charge?
|
---|
19 | .D PROC^IBECEAU4("pass") I IBY<0 S IBY=1 Q
|
---|
20 | .;
|
---|
21 | .; - pass charge to AR and update list
|
---|
22 | .D ^IBR S IBY=$G(Y)
|
---|
23 | .S IBND=$G(^IB(IBNOSX,0)),IBCOMMIT=1
|
---|
24 | .S IBMSG=$S(IBY<0:"was not passed - see error message (bulletin).",$P(IBND,"^",5)=8:"has now been placed ON HOLD (patient has active insurance).",1:"has been passed to Accounts Receivable.")
|
---|
25 | .;
|
---|
26 | .; - update IVM
|
---|
27 | .D IVM(IBND)
|
---|
28 | ;
|
---|
29 | PCQ D PAUSE^VALM1
|
---|
30 | S VALMBCK=$S(IBCOMMIT:"R",1:"")
|
---|
31 | I IBCOMMIT S IBBG=VALMBG D INIT^IBAMTV31 S VALMBG=IBBG
|
---|
32 | Q
|
---|
33 | ;
|
---|
34 | ;
|
---|
35 | CC ; 'Cancel Charges' entry action.
|
---|
36 | N IBCHG,IBCRES,IBIL,IBND,IBSEQNO,IBUNIT,IBATYP,IBDUZ,IBBG
|
---|
37 | N IBN,IBY,IBPARNT,IBH,IBCANTR,IBXA,IBFR,IBCANC,IBCOMMIT,IBNBR
|
---|
38 | D FULL^VALM1
|
---|
39 | S IBCOMMIT=0 D EN^VALM2($G(XQORNOD(0))) I '$O(VALMY(0)) G CCQ
|
---|
40 | S IBNBR="" F S IBNBR=$O(VALMY(IBNBR)) Q:'IBNBR D
|
---|
41 | .S IBN=^TMP("IBAMTV31",$J,"IDX",IBNBR,IBNBR),IBDUZ=DUZ,IBY=0 Q:'IBN
|
---|
42 | .;
|
---|
43 | .; - perform up-front edits
|
---|
44 | .D CED^IBECEAU4(IBN) Q:IBY<0
|
---|
45 | .I 'IBH,IBIL="" S IBY="-1^IB024" Q
|
---|
46 | .;
|
---|
47 | .; - ask for the cancellation reason
|
---|
48 | .D REAS^IBECEAU2("C") Q:IBCRES<0
|
---|
49 | .;
|
---|
50 | .; - okay to proceed?
|
---|
51 | .D PROC^IBECEAU4("cancel") I IBY<0 S IBY=1 Q
|
---|
52 | .;
|
---|
53 | .; - handle incomplete and regular transactions
|
---|
54 | .D CANC^IBECEAU4(IBN,IBCRES,1) Q:IBY<0
|
---|
55 | .;
|
---|
56 | .S IBCOMMIT=1,IBMSG="has been cancelled." D MSG
|
---|
57 | .;
|
---|
58 | .; - handle the clock
|
---|
59 | .D CLSTR^IBECEAU1(DFN,$P(IBND,"^",14))
|
---|
60 | .I 'IBCLDA W !!,"Please note that there is no billing clock which would cover this charge.",!,"Be sure that this patient's billing clock is correct." Q
|
---|
61 | .D CLDSP^IBECEAU1(IBCLST,$$PT^IBEFUNC(DFN))
|
---|
62 | .W !!,"Since the billing clock was updated when the charge was originally built,"
|
---|
63 | .W !,"you may now need to update this clock since the charge has been cancelled."
|
---|
64 | ;
|
---|
65 | CCQ D PAUSE^VALM1
|
---|
66 | S VALMBCK="R"
|
---|
67 | I IBCOMMIT S IBBG=VALMBG D INIT^IBAMTV31 S VALMBG=IBBG
|
---|
68 | Q
|
---|
69 | ;
|
---|
70 | ;
|
---|
71 | MSG ; Display results message.
|
---|
72 | I IBMSG]"" W !,"Charge #"_IBNBR_" "_IBMSG I +IBY=-1 D ^IBAERR1
|
---|
73 | Q
|
---|
74 | ;
|
---|
75 | ;
|
---|
76 | IVM(IBND) ; Pass billing information to the IVM package.
|
---|
77 | ; This tag is also called by IBECEA1 (Pass a Charge)
|
---|
78 | ;
|
---|
79 | ; Input: IBND -- Zeroth node of IB action in file #350
|
---|
80 | ;
|
---|
81 | Q:'$G(IBND)
|
---|
82 | D REV^IVMUFNC3(+IBND,+$P(IBND,"^",2),$S($P(IBND,"^",8)["OPT COPAY":2,1:1),$S($P($G(^IBE(350.1,+$P(IBND,"^",3),0)),"^")["PER DIEM":3,1:2),$P(IBND,"^",14),$P(IBND,"^",15),$P(IBND,"^",7),$P(IBND,"^",5)=8)
|
---|
83 | Q
|
---|