source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBACVA1.m@ 1259

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

initial load of WorldVistAEHR

File size: 3.0 KB
Line 
1IBACVA1 ;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 ;
5BILL ; 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 ;
38BILLQ Q
39 ;
40LIM(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"
47LIMQ Q
48 ;
49PD(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"
56PDQ Q
57 ;
58PREV(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
67PREVQ Q +$G(Y)
Note: See TracBrowser for help on using the repository browser.