- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCRBC1.m
r613 r623 1 IBCRBC1 2 ;;2.0;INTEGRATED BILLING;**52,80,106,138,51,148,245,270,370**;21-MAR-94;Build 5 3 ;;Per VHA Directive 2004-038, this routine should not be modified.4 5 6 7 8 9 10 11 12 13 14 INPTBS(IBIFN,RS,CS) 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 OPTVST(IBIFN,RS,CS) 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 RX(IBIFN,RS,CS) 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 CPT(IBIFN,RS,CS) 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 N IBPPRV,IBBS,IBCLIN,IBOE,IBSAVE,IBUNIT,IBCPTRX,IBMODSI '$G(IBIFN)!'$G(CS) Q118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 ... S IBX=IBCPTARR(IBCPT,IBCPTFN),IBEVDT=$P(IBX,U,1),(IBMOD,IBMODS)=$P(IBX,U,2)134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 ... S IBSAVE="1^"_IBCPT_U_IBDIV_U_IBTYPE_U_IBCPTFN_U_IBCMPNT_U_IBBS_U_IBPPRV_U_IBCLIN_U_IBOE_U_IBMODS 149 150 151 152 153 PI(IBIFN,RS,CS) 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 1 IBCRBC1 ;ALB/ARH - RATES: BILL CALCULATION BILLABLE EVENTS ; 22 MAY 96 2 ;;2.0;INTEGRATED BILLING;**52,80,106,138,51,148,245,270**;21-MAR-94 3 ;;Per VHA Directive 10-93-142, this routine should not be modified. 4 ; 5 ; For each type of Billable Event, search for items on the bill and calculate the charges 6 ; 1) search the bill for items of the billable event type 7 ; 2) determine how the charges should be calculated, based on Billable Item and Charge Method of the Set's Rate 8 ; 3) calculate charges 9 ; For per diem Billing Rates, no item pointers are passed since all items have a standard charge 10 ; The Insurance Company Different Revenue Codes to Use (36,.07) is passed so standard rev codes can be replaced 11 ; The Charge Type (363.1,.04) is passed so it can be added to the charge on the bill if it is defined for a Set 12 ; Output: ^TMP($J,"IBCRCC")= ..., (created in IBCRBC2 based on charge items found here) 13 ; 14 INPTBS(IBIFN,RS,CS) ; Determine charges for INPATIENT BEDSECTION STAY billable events 15 ; - the billable events are billable bedsections based on the patient movement treating specialties, 16 ; these are pulled from the PTF record each time the charges are calculated (INPTPTF^IBCRCG) 17 ; - each day of billable care is calculated separately in case a rate becomes inactive 18 ; 19 N IBX,IBBLITEM,IBCHGMTH,IBEVDT,IBIDRC,IBBDIV,IBITM,IBDIV,IBTYPE,IBCMPNT,IBSAVE I '$G(IBIFN)!'$G(CS) Q 20 ; 21 D INPTPTF^IBCRBG(IBIFN,CS) 22 ; 23 S IBTYPE=1,IBCMPNT=$P($G(^IBE(363.1,+CS,0)),U,4),IBX=$$CSBR^IBCRU3(CS),IBBLITEM=$P(IBX,U,4),IBCHGMTH=$P(IBX,U,5) 24 S IBIDRC=+$G(^DGCR(399,+IBIFN,"MP")) 25 I 'IBIDRC,$$MCRWNR^IBEFUNC($$CURR^IBCEF2(IBIFN)) S IBIDRC=$$CURR^IBCEF2(IBIFN) 26 S IBIDRC=$G(^DIC(36,+IBIDRC,0)),IBIDRC=$P(IBIDRC,U,7) 27 ; 28 S IBBDIV=$P($G(^DGCR(399,+IBIFN,0)),U,22) ; bill's default division 29 ; 30 I IBBLITEM=1,IBCHGMTH=1 D ; inpt/bedsection/per diem 31 . S IBEVDT="" F S IBEVDT=$O(^TMP($J,"IBCRC-INDT",IBEVDT)) Q:'IBEVDT D 32 .. S IBX=$G(^TMP($J,"IBCRC-INDT",IBEVDT)),IBITM=+$P(IBX,U,2),IBDIV=$P(IBX,U,5) 33 .. ; 34 .. I $$CSDV^IBCRU3(CS,IBDIV,IBBDIV)<0 Q ; check division 35 .. ; 36 .. S IBSAVE="1^^"_IBDIV_"^"_IBTYPE_"^^"_IBCMPNT 37 .. D BITMCHG^IBCRBC2(RS,CS,IBITM,IBEVDT,1,"","",IBIDRC,IBSAVE) 38 K ^TMP($J,"IBCRC-INDT") 39 Q 40 ; 41 OPTVST(IBIFN,RS,CS) ; Determine charges for OUTPATIENT VISIT DATE billable events 42 ; - the billable event is the outpatient visit date(s) on the bill (399,43) 43 ; 44 N IBX,IBBLITEM,IBCHGMTH,IBIDRC,IBOPVARR,IBI,IBEVDT,IBTYPE,IBCMPNT,IBSAVE I '$G(IBIFN)!'$G(CS) Q 45 ; 46 D OPTVD^IBCRBG1(IBIFN,.IBOPVARR) Q:'IBOPVARR 47 ; 48 S IBTYPE=2,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 I IBBLITEM=1,IBCHGMTH=1 D ; opt vst/bedsection/per diem 54 . S IBI="" F S IBI=$O(IBOPVARR(IBI)) Q:IBI="" D 55 .. S IBEVDT=IBOPVARR(IBI) 56 .. S IBSAVE="1^^^"_IBTYPE_"^^"_IBCMPNT 57 .. D ALLBEDS^IBCRBC2(RS,CS,IBEVDT,"",IBIDRC,IBSAVE) 58 Q 59 ; 60 RX(IBIFN,RS,CS) ; Determine charges for PRESCRIPTION billable events 61 ; - the billable event is an rx that has been added to the bill (362.4) 62 ; - the insurance company Prescription Refill Rev Code (36,.15) is passed to the calculator to be used as 63 ; the rev code for all Rx charges, all types, this overrides the rev codes for the set or item 64 ; - on HCFA 1500, the site parameter Default Rx Refill CPT (350.9,1.3) is added as the CPT to all Rx RC entries 65 ; 66 N IBX,IBBLITEM,IBCHGMTH,IBRXCPT,IBIDRC,IBIRC,IBRXARR,IBRX,IBEVDT,IBUNIT,IBITM,IBNDC,IBTYPE,IBCMPNT,IBSAVE 67 I '$G(IBIFN)!'$G(CS) Q 68 ; 69 D SET^IBCSC5A(IBIFN,.IBRXARR) Q:'$P(IBRXARR,U,2) 70 ; 71 S IBTYPE=3,IBCMPNT=$P($G(^IBE(363.1,+CS,0)),U,4),IBX=$$CSBR^IBCRU3(CS),IBBLITEM=$P(IBX,U,4),IBCHGMTH=$P(IBX,U,5) 72 S IBIDRC=+$G(^DGCR(399,+IBIFN,"MP")) 73 I 'IBIDRC,$$MCRWNR^IBEFUNC($$CURR^IBCEF2(IBIFN)) S IBIDRC=$$CURR^IBCEF2(IBIFN) 74 S IBIDRC=$G(^DIC(36,+IBIDRC,0)),IBIRC=$P(IBIDRC,U,15),IBIDRC=$P(IBIDRC,U,7) 75 ; 76 S IBRXCPT="" I $$FT^IBCU3(IBIFN)=2 S IBRXCPT=$P($G(^IBE(350.9,1,1)),U,30) 77 ; 78 I IBBLITEM=1,IBCHGMTH=1 D ; rx refill/bedsection/per diem 79 . S IBRX="" F S IBRX=$O(IBRXARR(IBRX)) Q:IBRX="" D 80 .. S IBEVDT=0 F S IBEVDT=$O(IBRXARR(IBRX,IBEVDT)) Q:'IBEVDT D 81 ... ; 82 ... S IBSAVE="1^"_IBRXCPT_"^^"_IBTYPE_"^"_+IBRXARR(IBRX,IBEVDT)_"^"_IBCMPNT 83 ... D ALLBEDS^IBCRBC2(RS,CS,IBEVDT,IBIRC,IBIDRC,IBSAVE) 84 ; 85 I IBBLITEM=3,IBCHGMTH=3 D ; ndc/quantity 86 . S IBRX="" F S IBRX=$O(IBRXARR(IBRX)) Q:IBRX="" D 87 .. S IBEVDT=0 F S IBEVDT=$O(IBRXARR(IBRX,IBEVDT)) Q:'IBEVDT D 88 ... S IBX=IBRXARR(IBRX,IBEVDT),IBITM=+IBX,IBUNIT=$P(IBX,U,4),IBNDC=$P(IBX,U,5) Q:IBNDC="" 89 ... S IBNDC=$O(^IBA(363.21,"B",IBNDC,0)) Q:'IBNDC 90 ... S IBSAVE="1^"_IBRXCPT_"^^"_IBTYPE_"^"_IBITM_"^"_IBCMPNT 91 ... D BITMCHG^IBCRBC2(RS,CS,IBNDC,IBEVDT,IBUNIT,"",IBIRC,IBIDRC,IBSAVE) 92 ; 93 I IBCHGMTH=2 D ; va cost 94 . S IBRX="" F S IBRX=$O(IBRXARR(IBRX)) Q:IBRX="" D 95 .. S IBEVDT=0 F S IBEVDT=$O(IBRXARR(IBRX,IBEVDT)) Q:'IBEVDT D 96 ... S IBX=IBRXARR(IBRX,IBEVDT),IBITM=+IBX,IBUNIT=$P(IBX,U,4) Q:'IBITM 97 ... S IBSAVE="1^"_IBRXCPT_"^^"_IBTYPE_"^"_IBITM_"^"_IBCMPNT 98 ... D BITMCHG^IBCRBC2(RS,CS,IBITM,IBEVDT,IBUNIT,"",IBIRC,IBIDRC,IBSAVE) 99 ; 100 Q 101 ; 102 CPT(IBIFN,RS,CS) ; Determine charges for PROCEDURE billable events 103 ; - the billable event is a CPT procedure from the bill (399,304) 104 ; - the item to be billed is a CPT, this may include Modifier 105 ; - for each CPT found on the bill that has a modifier, will first check to see if that CPT-modifier 106 ; combination is billable (ie. is defined as a charge item for the Billing Rate, does not have to be active) 107 ; if it does not then assumes the charge should be the CPT charge 108 ; - if the charge set is limited by region then either the CPT's division or if no CPT division then the bill's 109 ; Default Division must be contained in the sets region 110 ; - the billable CPT is added as the CPT of the charge entry, Division is also added if defined for the CPT 111 ; - the procedures provider may affect the charges due to a provider discount 112 ; - if an inpatient bill then the bedsection on date of procedure will be used as the default bedsection 113 ; - different sets of charges apply to SNF and Inpatient care although the bill is defined as inpatient 114 ; - the Default Rx CPT should not be billed the CPT charge, instead the Rx is charged 115 ; 116 N IBX,IBBLITEM,IBCHGMTH,IBBR,IBBDIV,IBIDRC,IBCPTARR,IBCPT,IBCPTFN,IBEVDT,IBMOD,IBDIV,IBTYPE,IBCMPNT 117 N IBPPRV,IBBS,IBCLIN,IBOE,IBSAVE,IBUNIT,IBCPTRX I '$G(IBIFN)!'$G(CS) Q 118 ; 119 D CPT^IBCRBG1(IBIFN,.IBCPTARR) Q:'IBCPTARR 120 ; 121 S IBTYPE=4,IBCMPNT=$P($G(^IBE(363.1,+CS,0)),U,4),IBX=$$CSBR^IBCRU3(CS),IBBLITEM=$P(IBX,U,4),IBCHGMTH=$P(IBX,U,5) 122 S IBIDRC=+$G(^DGCR(399,+IBIFN,"MP")) 123 I 'IBIDRC,$$MCRWNR^IBEFUNC($$CURR^IBCEF2(IBIFN)) S IBIDRC=$$CURR^IBCEF2(IBIFN) 124 S IBIDRC=$G(^DIC(36,+IBIDRC,0)),IBIDRC=$P(IBIDRC,U,7) 125 S IBBR=$P(IBX,U,3) S IBCPTRX="" I $O(^IBA(362.4,"C",IBIFN,0)) S IBCPTRX=+$P($G(^IBE(350.9,1,1)),U,30) 126 ; 127 S IBBDIV=$P($G(^DGCR(399,+IBIFN,0)),U,22) ; bill's default division 128 D INPTPTF^IBCRBG(IBIFN,CS) ; get inpatient bedsections 129 ; 130 I IBBLITEM=2 D ; cpt/count/minutes/miles/hours 131 . S IBCPT=0 F S IBCPT=$O(IBCPTARR(IBCPT)) Q:'IBCPT D 132 .. S IBCPTFN=0 F S IBCPTFN=$O(IBCPTARR(IBCPT,IBCPTFN)) Q:'IBCPTFN D 133 ... S IBX=IBCPTARR(IBCPT,IBCPTFN),IBEVDT=$P(IBX,U,1),IBMOD=$P(IBX,U,2) 134 ... S IBDIV=$P(IBX,U,3),IBPPRV=$P(IBX,U,4),IBCLIN=$P(IBX,U,5),IBOE=$P(IBX,U,6) 135 ... ; 136 ... I '$$CHGOTH^IBCRBC2(IBIFN,RS,IBEVDT) Q 137 ... I +IBCPTRX,'IBOE,IBCPT=IBCPTRX Q ; site parameter rx procedure 138 ... ; 139 ... S IBUNIT=$$CPTUNITS^IBCRBC2(CS,IBCHGMTH,IBX) Q:'IBUNIT 140 ... ; 141 ... S IBBS=$P($G(^TMP($J,"IBCRC-INDT",IBEVDT)),U,2) ; get inpatient bedsection 142 ... I 'IBBS S IBX=$O(^TMP($J,"IBCRC-INDT",IBEVDT),-1) I +IBX S IBBS=$P($G(^TMP($J,"IBCRC-INDT",IBX)),U,2) 143 ... ; 144 ... I '$P($$CPT^ICPTCOD(+IBCPT,+IBEVDT),U,7) Q ; check is a valid active CPT 145 ... I $$CSDV^IBCRU3(CS,IBDIV,IBBDIV)<0 Q ; check division 146 ... I +IBMOD S IBMOD=$P($$CPTMOD^IBCRCU1(CS,IBCPT,IBMOD,IBEVDT),",",1) ; check CPT-MODs for billable combination 147 ... ; 148 ... S IBSAVE="1^"_IBCPT_U_IBDIV_U_IBTYPE_U_IBCPTFN_U_IBCMPNT_U_IBBS_U_IBPPRV_U_IBCLIN_U_IBOE 149 ... D BITMCHG^IBCRBC2(RS,CS,IBCPT,IBEVDT,IBUNIT,IBMOD,"",IBIDRC,IBSAVE) 150 K ^TMP($J,"IBCRC-INDT") 151 Q 152 ; 153 PI(IBIFN,RS,CS) ; Determine charges for PROSTHETICS billable events 154 ; - the billable event is a prosthetic item that has been added to the bill (362.5) 155 ; 156 N IBX,IBBLITEM,IBCHGMTH,IBPIARR,IBIDRC,IBEVDT,IBPI,IBITM,IBTYPE,IBCMPNT,IBSAVE I '$G(IBIFN)!'$G(CS) Q 157 ; 158 D SET^IBCSC5B(IBIFN,.IBPIARR) Q:'$P(IBPIARR,U,2) 159 ; 160 S IBTYPE=5,IBCMPNT=$P($G(^IBE(363.1,+CS,0)),U,4),IBX=$$CSBR^IBCRU3(CS),IBBLITEM=$P(IBX,U,4),IBCHGMTH=$P(IBX,U,5) 161 S IBIDRC=+$G(^DGCR(399,+IBIFN,"MP")) 162 I 'IBIDRC,$$MCRWNR^IBEFUNC($$CURR^IBCEF2(IBIFN)) S IBIDRC=$$CURR^IBCEF2(IBIFN) 163 S IBIDRC=$G(^DIC(36,+IBIDRC,0)),IBIDRC=$P(IBIDRC,U,7) 164 ; 165 I IBBLITEM=1,IBCHGMTH=1 D ; pros/bedsection/per diem 166 . S IBEVDT="" F S IBEVDT=$O(IBPIARR(IBEVDT)) Q:'IBEVDT D 167 .. S IBPI=0 F S IBPI=$O(IBPIARR(IBEVDT,IBPI)) Q:'IBPI D 168 ... S IBSAVE="1^^^"_IBTYPE_"^^"_IBCMPNT 169 ... D ALLBEDS^IBCRBC2(RS,CS,IBEVDT,"",IBIDRC,IBSAVE) 170 ; 171 I IBCHGMTH=2 D ; va cost 172 . S IBEVDT="" F S IBEVDT=$O(IBPIARR(IBEVDT)) Q:'IBEVDT D 173 .. S IBPI=0 F S IBPI=$O(IBPIARR(IBEVDT,IBPI)) Q:'IBPI D 174 ... S IBITM=IBPIARR(IBEVDT,IBPI) Q:'IBITM 175 ... S IBSAVE="1^^^"_IBTYPE_"^"_+IBITM_"^"_IBCMPNT 176 ... D BITMCHG^IBCRBC2(RS,CS,+IBITM,IBEVDT,1,"","",IBIDRC,IBSAVE) 177 ; 178 Q
Note:
See TracChangeset
for help on using the changeset viewer.
