source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCRBC11.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.1 KB
Line 
1IBCRBC11 ;ALB/ARH - RATES: BILL CALCULATION BILLABLE EVENTS ;10-OCT-1998
2 ;;2.0;INTEGRATED BILLING;**106,245,155**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; continuation of IBCRBC1
6 ;
7INPTDRG(IBIFN,RS,CS) ; Determine charges for INPATIENT DRG billable events
8 ; - the billable events are DRG's, the Transfer DRG of the patient treating specialties movements,
9 ; pulled from the PTF record each time the charges are calculated (INPTPTF^IBCRCG)
10 ; - each day of billable care is calculated separately in case a rate becomes in/active
11 ; - if bedsection is ICU then allow ICU Charge Set only
12 ;
13 N IBX,IBBLITEM,IBCHGMTH,IBEVDT,IBIDRC,IBBS,IBITM,IBTYPE,IBCMPNT,IBSAVE I '$G(IBIFN)!'$G(CS) Q
14 ;
15 D INPTPTF^IBCRBG(IBIFN,CS)
16 ;
17 S IBTYPE=6,IBCMPNT=$P($G(^IBE(363.1,+CS,0)),U,4),IBX=$$CSBR^IBCRU3(CS),IBBLITEM=$P(IBX,U,4),IBCHGMTH=$P(IBX,U,5)
18 S IBIDRC=+$G(^DGCR(399,+IBIFN,"MP"))
19 I 'IBIDRC,$$MCRWNR^IBEFUNC($$CURR^IBCEF2(IBIFN)) S IBIDRC=$$CURR^IBCEF2(IBIFN)
20 S IBIDRC=$G(^DIC(36,+IBIDRC,0)),IBIDRC=$P(IBIDRC,U,7)
21 ;
22 S IBBDIV=$P($G(^DGCR(399,+IBIFN,0)),U,22) ; bill's default division
23 ;
24 I IBBLITEM=4,IBCHGMTH=1 D ; inpt/DRG/per diem
25 . S IBEVDT="" F S IBEVDT=$O(^TMP($J,"IBCRC-INDT",IBEVDT)) Q:IBEVDT="" D
26 .. ;
27 .. S IBX=$G(^TMP($J,"IBCRC-INDT",IBEVDT)),IBITM=$P(IBX,U,4),IBBS=$P(IBX,U,2),IBDIV=$P(IBX,U,5) Q:'IBITM
28 .. ;
29 .. I '$$CHGICU^IBCRBC2(CS,IBBS) Q ; check icu charges are applied to icu bedsection
30 .. ;
31 .. I $$CSDV^IBCRU3(CS,IBDIV,IBBDIV)<0 Q ; check division
32 .. ;
33 .. S IBSAVE="1^^"_IBDIV_"^"_IBTYPE_"^"_IBITM_"^"_IBCMPNT_"^"_IBBS
34 .. D BITMCHG^IBCRBC2(RS,CS,IBITM,IBEVDT,1,"","",IBIDRC,IBSAVE)
35 K ^TMP($J,"IBCRC-INDT")
36 Q
37 ;
38UNASSOC(IBIFN,RS,CS,IBMIARR) ; Determine charges for UNASSOCIATED billable events
39 ; - the billable event is not associated with any data element on the bill
40 ; - the item to charge is selected by the user from the list of billing items (363.21)
41 ; - the items the user selected to add charges to the bill for are passed in in array IBMIARR
42 ; - if the charge set is limited by region then either the items division or if no item division then the bill's
43 ; Default Division must be contained in the sets region
44 ;
45 N IBX,IBBLITEM,IBCHGMTH,IBIDRC,IBBDIV,IBI,IBITM,IBEVDT,IBTUNITS,IBDIV,IBRVCD,IBTYPE,IBCMPNT,IBSAVE
46 I '$G(IBIFN)!'$G(CS)!'$G(IBMIARR) Q
47 ;
48 S IBTYPE=9,IBCMPNT=$P($G(^IBE(363.1,+CS,0)),U,4),IBX=$$CSBR^IBCRU3(CS),IBBLITEM=$P(IBX,U,4),IBCHGMTH=$P(IBX,U,5)
49 S IBIDRC=+$G(^DGCR(399,+IBIFN,"MP"))
50 I 'IBIDRC,$$MCRWNR^IBEFUNC($$CURR^IBCEF2(IBIFN)) S IBIDRC=$$CURR^IBCEF2(IBIFN)
51 S IBIDRC=$G(^DIC(36,+IBIDRC,0)),IBIDRC=$P(IBIDRC,U,7)
52 ;
53 S IBBDIV=$P($G(^DGCR(399,+IBIFN,0)),U,22) ; bill's default division
54 ;
55 I IBBLITEM=9,IBCHGMTH=1 D ; charge per item
56 . S IBI=0 F S IBI=$O(IBMIARR(RS,CS,IBI)) Q:'IBI D
57 .. S IBX=IBMIARR(RS,CS,IBI),IBITM=+$P(IBX,U,1),IBEVDT=$P(IBX,U,2)
58 .. S IBTUNITS=$P(IBX,U,3),IBDIV=$P(IBX,U,4),IBRVCD=$P(IBX,U,5)
59 .. ;
60 .. I $$CSDV^IBCRU3(CS,IBDIV,IBBDIV)<0 Q ; check division
61 .. ;
62 .. S IBSAVE=IBTUNITS_"^^"_IBDIV_"^"_IBTYPE_"^"_IBITM_"^"_IBCMPNT
63 .. D BITMCHG^IBCRBC2(RS,CS,IBITM,IBEVDT,1,"",IBRVCD,IBIDRC,IBSAVE)
64 Q
Note: See TracBrowser for help on using the repository browser.