| [613] | 1 | IBACVA1 ;ALB/CPM - BILL CHAMPVA SUBSISTENCE CHARGE ; 29-JUL-93
|
|---|
| 2 | ;;Version 2.0 ; INTEGRATED BILLING ;**27,45,52**; 21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | BILL ; Create the CHAMPVA inpatient subsistence charge.
|
|---|
| 6 | S IBY=1 I '$$CHECK^IBECEAU(0) D ERRMSG^IBACVA2(1,1) G BILLQ
|
|---|
| 7 | S IBCHGT=0
|
|---|
| 8 | D LIM($$HTFM^XLFDT(IBBDT,1))
|
|---|
| 9 | I IBY<0 W:$G(IBJOB)=4 !!,"Cannot determine the Subsistence limit!" D ERRMSG^IBACVA2(1,1) G BILLQ
|
|---|
| 10 | ;
|
|---|
| 11 | ; - calculate the subsistence charge for the episode
|
|---|
| 12 | F IBD=IBBDT:1:IBEDT S IBDT=$$HTFM^XLFDT(IBD,1) D Q:IBY<0
|
|---|
| 13 | .I IBBDT'=IBEDT S VAIP("D")=IBDT_.2359 D IN5^VADPT Q:'VAIP(10) ; on leave
|
|---|
| 14 | .D PD(IBDT) Q:IBY<0 ; can't find daily per diem
|
|---|
| 15 | .S:'IBCHGT IBFR=IBDT ; set 'from date' on 1st pass
|
|---|
| 16 | .S IBCHGT=IBCHGT+IBCHG,IBTO=IBDT ; build cumulative charge/set 'to date'
|
|---|
| 17 | I IBY<0 W:$G(IBJOB)=4 !!,"Cannot determine Subsistence per diem rate!" D ERRMSG^IBACVA2(1,1) G BILLQ
|
|---|
| 18 | I IBCHGT<IBLIM S IBCHGT=IBLIM,IBTO=IBDT
|
|---|
| 19 | ;
|
|---|
| 20 | ; - display message and get confirmation for Cancel/Edit/Add.
|
|---|
| 21 | I $G(IBJOB)=4 D G:IBY<0 BILLQ
|
|---|
| 22 | .W !!,"The following billing parameters have been calculated:"
|
|---|
| 23 | .W !!," Bill From: ",$$DAT1^IBOUTL(IBFR)
|
|---|
| 24 | .W !," Bill To: ",$$DAT1^IBOUTL(IBTO)
|
|---|
| 25 | .W !," Charge: $",IBCHGT,!
|
|---|
| 26 | .D PROC^IBECEAU4("add")
|
|---|
| 27 | ;
|
|---|
| 28 | ; - bill the charge
|
|---|
| 29 | W:'$G(DGQUIET) !,"Billing the CHAMPVA inpatient subsistence charge..."
|
|---|
| 30 | S IBUNIT=1,IBDESC="CHAMPVA SUBSISTENCE",IBCHG=IBCHGT,IBSL="405:"_IBSL
|
|---|
| 31 | D ADD^IBECEAU3 I IBY<0 D ERRMSG^IBACVA2(1,1) G BILLQ
|
|---|
| 32 | ;
|
|---|
| 33 | ; - release the charge to AR
|
|---|
| 34 | D AR^IBR I IBY<0 D ERRMSG^IBACVA2(1,1) G BILLQ
|
|---|
| 35 | ;
|
|---|
| 36 | S:$G(IBJOB)=4 IBCOMMIT=1 W:'$G(DGQUIET) "completed."
|
|---|
| 37 | ;
|
|---|
| 38 | BILLQ Q
|
|---|
| 39 | ;
|
|---|
| 40 | LIM(DATE) ; Find the CHAMPVA subsistence limit on DATE.
|
|---|
| 41 | ; Input: DATE -- The date on which to determine the limit
|
|---|
| 42 | ; Output: IBLIM -- The maximum subsistence charge for an episode
|
|---|
| 43 | N X S IBLIM=0
|
|---|
| 44 | S X=$O(^IBE(350.1,"E","CHAMPVA LIMIT",0)) I 'X S IBY="-1^IB083" G LIMQ
|
|---|
| 45 | S X=$O(^IBE(350.2,"AIVDT",+X,-(DATE+.1))),X=$O(^(+X,0))
|
|---|
| 46 | S IBLIM=$P($G(^IBE(350.2,+X,0)),"^",4) I 'IBLIM S IBY="-1^IB084"
|
|---|
| 47 | LIMQ Q
|
|---|
| 48 | ;
|
|---|
| 49 | PD(IBDT) ; Find the CHAMPVA per diem charge on IBDT.
|
|---|
| 50 | ; Input: IBDT -- The date on which to determine the per diem
|
|---|
| 51 | ; Output: IBCHG -- The CHAMPVA per diem charge on IBDT
|
|---|
| 52 | ; IBATYP -- CHAMPVA Action Type
|
|---|
| 53 | S IBATYP=$O(^IBE(350.1,"E","CHAMPVA SUBSISTENCE",0)),IBCHG=0
|
|---|
| 54 | I 'IBATYP S IBY="-1^IB008" G PDQ
|
|---|
| 55 | D COST^IBAUTL2 I 'IBCHG S IBY="-1^IB029"
|
|---|
| 56 | PDQ Q
|
|---|
| 57 | ;
|
|---|
| 58 | PREV(DFN,DATE,LINK) ; Billed an admission the CHAMPVA subsistence charge?
|
|---|
| 59 | ; Input: DFN -- Pointer to patient in file #2
|
|---|
| 60 | ; DATE -- Event (admission) date
|
|---|
| 61 | ; LINK -- Pointer to mvmt in file #405
|
|---|
| 62 | ; Output: 0 -- Admission has not been billed, or
|
|---|
| 63 | ; >0 -- ien of billed charge in file #350
|
|---|
| 64 | I '$G(DFN)!'$G(DATE)!'$G(LINK) G PREVQ
|
|---|
| 65 | N IBN,IBND,IBP,Y
|
|---|
| 66 | S IBP=0 F S IBP=$O(^IB("ACVA",DFN,DATE,IBP)) Q:'IBP S IBN=$$LAST^IBECEAU(IBP),IBND=$G(^IB(IBN,0)) I $P($G(^IBE(350.1,+$P(IBND,"^",3),0)),"^",5)'=2,$P(IBND,"^",4)=("405:"_LINK),"^3^4^"[("^"_+$P(IBND,"^",5)_"^") S Y=IBN Q
|
|---|
| 67 | PREVQ Q +$G(Y)
|
|---|
