- 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/IBCRBC2.m
r613 r623 1 IBCRBC2 ;ALB/ARH - RATES: BILL CALCULATION OF ITEM CHARGE ; 22-MAY-1996 2 ;;2.0;INTEGRATED BILLING;**52,106,138,148,245,370**;21-MAR-94;Build 5 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 ; Input: RS - rate schedule necessary to calculated modified charges 6 ; CS - required, charge set which defines the charges to calculate 7 ; ITEM - required, ptr to source item to be billed, type defined by billable item of the rate 8 ; EVDT - date of event, to be used when searching for a charge effective date, default=DT 9 ; UNITS - required, used only for Quantity: # of units of Charge Item Charge for each Item 10 ; MOD - CPT Modifier if any 11 ; INSRC - special revenue code to use (from ins comp), if any (overrides set and item rv cd) 12 ; IDFRC - different revenue codes to use, these replace the standard set in CM (DRC:SRC,DRC:SRC) 13 ; SAVE - serveral data items not needed here but passed on to next step (store) in TMP array: 14 ; TUNITS - required to add charge to bill, total # of the Item on the bill 15 ; CPT - default CPT to be added to the bill for the charge 16 ; DIV - division charges apply to 17 ; TYPE - type of item being billed - defines the source of the item on the bill 18 ; ITMPTR - soft pointer to the item on the bill: may be a multiple or file IFN 19 ; CMPNT - what component of the total charge: institutional or professional 20 ; BEDS - billable bedsection to use if not a bedsection item, if null uses set default 21 ; PROV - procedure provider 22 ; CLINIC - procedures associated clinic 23 ; IBOE - Outpatient Encounter, pointer to #408.69 24 ; MODS - list of all modifiers define for the procedure, separated by ',' 25 ; 26 ; Total charge is calculated: X = UNITS * UNIT CHARGE of the item (per unit charge (un-adjusted)) 27 ; Y = X modified by Rate Schedule Adjustment (per unit charge (adjusted)) 28 ; the Units are used to calculate the per item charge: 30 pills for an rx, 1 bs per bs 29 ; and the Tunits are the number of that Item on the bill: 1 rx of 30 pills, 11 days of bs stay 30 ; 31 ; Output: TMP($J,"IBCRCC", containing all chargable items and all related info needed to file them on the bill 32 ; each charge will have it's own entry, nothing combined (12 = per unit charge (adjusted), p13 = Tunits) 33 ; TMP is not killed on entry so each items charges are compiled and added to existing charges 34 ; 35 BITMCHG(RS,CS,ITEM,EVDT,UNITS,MOD,INSRC,IDFRC,SAVE) ; get bill charges for a specific item, rate schedule and charge set and date set into temp array 36 ; 37 N IBCS0,IBDRVCD,IBBS,IBCHGARR,IBI,IBCNT,IBLN,IBCI,IBRVCD,IBPPRV,IBCHRG,IBTCHRG,IBRCHRG,IBPCHRG,IBACHRG 38 N IBMCHRG,IBMODS,IBBASE,IBCOM I '$G(ITEM)!'$G(CS)!'$G(UNITS) Q 39 ; 40 S RS=$G(RS),EVDT=$S(+$G(EVDT):+EVDT\1,1:DT),MOD=$G(MOD),INSRC=$G(INSRC),IDFRC=$G(IDFRC),SAVE=$G(SAVE) 41 S IBCS0=$G(^IBE(363.1,+CS,0)),IBDRVCD=$P(IBCS0,U,5),IBPPRV=$P(SAVE,U,8),IBMODS=$P(SAVE,U,11) 42 S IBBS=+ITEM I $P($G(^IBE(363.3,+$P(IBCS0,U,2),0)),U,4)'=1 S IBBS=$P(SAVE,U,7) I 'IBBS S IBBS=$P(IBCS0,U,6) 43 I 'IBBS Q 44 ; 45 D ITMCHG^IBCRCC(CS,ITEM,EVDT,MOD,.IBCHGARR) 46 ; 47 S IBCNT=+$G(^TMP($J,"IBCRCC")) 48 S IBI=0 F S IBI=$O(IBCHGARR(IBI)) Q:'IBI D 49 . S IBLN=IBCHGARR(IBI),IBCI=+IBLN,IBCHRG=$P(IBLN,U,3),(IBPCHRG,IBRCHRG)="" Q:'IBCHRG S IBBASE=$P(IBLN,U,4) 50 . S IBRVCD=INSRC I 'IBRVCD S IBRVCD=$P(IBLN,U,2) 51 . I 'IBRVCD S IBRVCD=$P($$RVLNK^IBCRU6(+ITEM,"",+CS),U,2) I 'IBRVCD S IBRVCD=IBDRVCD Q:'IBRVCD 52 . I +IDFRC,+$P(IDFRC,IBRVCD_":",2) S IBRVCD=+$P(IDFRC,IBRVCD_":",2) Q:IBRVCD'?3N 53 . ; 54 . S IBCHRG=IBCHRG*UNITS 55 . S IBCHRG=IBCHRG+IBBASE 56 . S IBPCHRG=IBCHRG I +IBPPRV S IBPCHRG=$$PRVCHG^IBCRCC(CS,IBCHRG,IBPPRV,EVDT,ITEM) 57 . S IBMCHRG=+IBPCHRG I +IBMODS S IBMCHRG=$$MODCHG^IBCRCC(CS,IBPCHRG,IBMODS) 58 . S (IBCHRG,IBTCHRG)=+IBMCHRG 59 . S IBACHRG=IBTCHRG I +RS,+IBTCHRG S IBRCHRG=$$RATECHG^IBCRCC(RS,IBTCHRG,EVDT),IBACHRG=+IBRCHRG 60 . ; 61 . S IBCNT=IBCNT+1,^TMP($J,"IBCRCC")=IBCNT 62 . S ^TMP($J,"IBCRCC",IBCNT)=IBCI_U_CS_U_RS_U_ITEM_U_MOD_U_IBRVCD_U_IBBS_U_EVDT_U_IBCHRG_U_UNITS_U_IBTCHRG_U_IBACHRG_U_$G(SAVE) 63 . ; 64 . I (UNITS>1)!(+IBBASE) S IBCOM=$$COMMUB(CS,UNITS,IBBASE) I IBCOM'="" D COMMENT(IBCNT,IBCOM) 65 . I $P(IBPCHRG,U,2)'="" S IBCOM=$P(IBPCHRG,U,2) I IBCOM'="" D COMMENT(IBCNT,IBCOM) 66 . I $P(IBMCHRG,U,2)'="" S IBCOM=$P(IBMCHRG,U,2) I IBCOM'="" D COMMENT(IBCNT,IBCOM) 67 . I $P(IBRCHRG,U,2)'="" S IBCOM=$P(IBRCHRG,U,2) I IBCOM'="" D COMMENT(IBCNT,IBCOM) 68 Q 69 ; 70 COMMENT(LINE,COMM) ; set comment into charge array for a particular line item 71 I +$D(^TMP($J,"IBCRCC",+$G(LINE))) N IBX D 72 . S IBX=$O(^TMP($J,"IBCRCC",+LINE,"CC",9999),-1) S IBX=IBX+1 73 . S ^TMP($J,"IBCRCC",+LINE,"CC",IBX)=$G(COMM) 74 Q 75 ; 76 COMMUB(CS,UNITS,BASE) ; return comment for special units and base 77 N IBX,IBY,IBCM S IBX="",IBY="Charge calculated" 78 S IBCM=$P($G(^IBE(363.1,+CS,0)),U,2),IBCM=$P($G(^IBE(363.3,+IBCM,0)),U,5) 79 S IBCM=$S(IBCM=4:"Miles",IBCM=5:"SubUnits",IBCM=6:"Hours",1:"") 80 I +$G(UNITS) S IBX=IBY_" for "_UNITS_" "_IBCM,IBY="" 81 I +$G(BASE) S IBX=IBY_IBX_" with a Base Charge="_$J(BASE,0,2) 82 Q IBX 83 ; 84 ALLBEDS(RS,CS,EVDT,RC,DFRC,SAVE) ; get charges for all bedsections active on date of visit 85 ; each effective date supercedes all previous effective date, regardless of the item 86 ; used for per diem rates where the charges are associated with a bedsection, but the item being billed is not 87 ; a bedsection, so the count of the item on the bill is found and applied as the units to all bedsections active 88 ; on the event date (the 3 opt visit dates on a bill are the units for the Outpatient Visit bedsection charge) 89 ; 90 N IBITM,IBITEMS I '$G(CS)!'$G(EVDT) Q 91 ; 92 D CSALL^IBCRCU1(CS,EVDT,.IBITEMS) 93 ; 94 I +IBITEMS S IBITM="" F S IBITM=$O(IBITEMS(IBITM)) Q:'IBITM D 95 . D BITMCHG($G(RS),CS,IBITM,EVDT,1,"",$G(RC),$G(DFRC),$G(SAVE)) 96 Q 97 ; 98 ; 99 CPTUNITS(CS,CHGMTH,ITLINE) ; return CPT units based on Charge Method and CPT data 100 ; Input: CS is the related Charge Set 101 ; CHGMTH is the Rate Schedule Charge Method (363.3, .05) 102 ; ITLINE is item data from CPT^IBCRBG1 103 ; Output: calculated units for CPT, 1 or calculated for miles/minutes/hours 104 N IBUNIT S IBUNIT=1,CHGMTH=$G(CHGMTH),ITLINE=$G(ITLINE),CS=$G(CS) 105 I CHGMTH=4 S IBUNIT=+$P(ITLINE,U,8) ; miles 106 I CHGMTH=5 S IBUNIT=+$P(ITLINE,U,7) ; minutes 107 I CHGMTH=6 S IBUNIT=+$P(ITLINE,U,9) ; hours 108 S IBUNIT=$$CPTUNITS^IBCRCU1(CS,IBUNIT) 109 Q IBUNIT 110 ; 111 CHGOTH(IBIFN,RS,EVDT) ; check if the Rate Schedule charges are applicable to the event date for the bill 112 ; this is relevent to RC v2.0 and type of care of Other 113 ; both Rate Schedule is SNF and event date is SNF care or neither can be otherwise no charge 114 ; SNF charges can't be used for non-SNF care and non-SNF charges can't be used for SNF care 115 ; Output: returns true if charges and bill date are of same type, SNF or non-SNF 116 N IBOK,IBRSTY,IBDTTY S (IBRSTY,IBDTTY)=0,IBOK=1 117 I $G(EVDT)<$$VERSDT^IBCRU8(2) G CHGOTHQ 118 I '$G(IBIFN)!'$G(RS) G CHGOTHQ 119 ; 120 S IBRSTY=$$RSOTHER^IBCRU8(RS) ; are charges for other type of care 121 S IBDTTY=$$BOTHER^IBCU3(IBIFN,EVDT) ; is date other type of care 122 ; 123 I +IBRSTY,'IBDTTY S IBOK=0 124 I 'IBRSTY,+IBDTTY S IBOK=0 125 ; 126 CHGOTHQ Q IBOK 127 ; 128 CHGICU(CS,BS) ; check if charge and bedsection match relative to ICU RC 2.0+, compares Charge Set Name and Bedsection 129 ; both the charge set and the bedsection have to be ICU or neither of them can be ICU otherwise no charge 130 ; ICU charges can't be used with non-ICU bedsections and non-ICU charges can't be used with ICU bedsection 131 ; Output: returns true if charges and bedsection are of same type, ICU or non-ICU 132 N IBCSICU,IBCSN,IBICU,IBOK S (IBOK,IBCSICU)=0,BS=+$G(BS) 133 S IBICU=$$MCCRUTL^IBCRU1("ICU",5) 134 S IBCSN=$G(^IBE(363.1,+$G(CS),0)) I $E(IBCSN,1,2)'="RC" S IBOK=1 135 I $P(IBCSN,U,1)["ICU" S IBCSICU=1 ; charge set is icu 136 ; 137 I BS=IBICU,+IBCSICU S IBOK=1 ; both bedsection and charge set are icu 138 I BS'=IBICU,'IBCSICU S IBOK=1 ; niether bedsection nor charge set are icu 139 Q IBOK 1 IBCRBC2 ;ALB/ARH - RATES: BILL CALCULATION OF ITEM CHARGE ; 22-MAY-1996 2 ;;2.0;INTEGRATED BILLING;**52,106,138,148,245**;21-MAR-94 3 ;;Per VHA Directive 10-93-142, this routine should not be modified. 4 ; 5 ; Input: RS - rate schedule necessary to calculated modified charges 6 ; CS - required, charge set which defines the charges to calculate 7 ; ITEM - required, ptr to source item to be billed, type defined by billable item of the rate 8 ; EVDT - date of event, to be used when searching for a charge effective date, default=DT 9 ; UNITS - required, used only for Quantity: # of units of Charge Item Charge for each Item 10 ; MOD - CPT Modifier if any 11 ; INSRC - special revenue code to use (from ins comp), if any (overrides set and item rv cd) 12 ; IDFRC - different revenue codes to use, these replace the standard set in CM (DRC:SRC,DRC:SRC) 13 ; SAVE - serveral data items not needed here but passed on to next step (store) in TMP array: 14 ; TUNITS - required to add charge to bill, total # of the Item on the bill 15 ; CPT - default CPT to be added to the bill for the charge 16 ; DIV - division charges apply to 17 ; TYPE - type of item being billed - defines the source of the item on the bill 18 ; ITMPTR - soft pointer to the item on the bill: may be a multiple or file IFN 19 ; CMPNT - what component of the total charge: institutional or professional 20 ; BEDS - billable bedsection to use if not a bedsection item, if null uses set default 21 ; PROV - procedure provider 22 ; CLINIC - procedures associated clinic 23 ; IBOE - Outpatient Encounter, pointer to #408.69 24 ; 25 ; Total charge is calculated: X = UNITS * UNIT CHARGE of the item (per unit charge (un-adjusted)) 26 ; Y = X modified by Rate Schedule Adjustment (per unit charge (adjusted)) 27 ; the Units are used to calculate the per item charge: 30 pills for an rx, 1 bs per bs 28 ; and the Tunits are the number of that Item on the bill: 1 rx of 30 pills, 11 days of bs stay 29 ; 30 ; Output: TMP($J,"IBCRCC", containing all chargable items and all related info needed to file them on the bill 31 ; each charge will have it's own entry, nothing combined (12 = per unit charge (adjusted), p13 = Tunits) 32 ; TMP is not killed on entry so each items charges are compiled and added to existing charges 33 ; 34 BITMCHG(RS,CS,ITEM,EVDT,UNITS,MOD,INSRC,IDFRC,SAVE) ; get bill charges for a specific item, rate schedule and charge set and date set into temp array 35 ; 36 N IBCS0,IBDRVCD,IBBS,IBCHGARR,IBI,IBCNT,IBLN,IBCI,IBRVCD,IBPPRV,IBCHRG,IBTCHRG,IBRCHRG,IBPCHRG,IBACHRG,IBBASE,IBCOM 37 I '$G(ITEM)!'$G(CS)!'$G(UNITS) Q 38 ; 39 S RS=$G(RS),EVDT=$S(+$G(EVDT):+EVDT\1,1:DT),MOD=$G(MOD),INSRC=$G(INSRC),IDFRC=$G(IDFRC),SAVE=$G(SAVE) 40 S IBCS0=$G(^IBE(363.1,+CS,0)),IBDRVCD=$P(IBCS0,U,5),IBPPRV=$P(SAVE,U,8) 41 S IBBS=+ITEM I $P($G(^IBE(363.3,+$P(IBCS0,U,2),0)),U,4)'=1 S IBBS=$P(SAVE,U,7) I 'IBBS S IBBS=$P(IBCS0,U,6) 42 I 'IBBS Q 43 ; 44 D ITMCHG^IBCRCC(CS,ITEM,EVDT,MOD,.IBCHGARR) 45 ; 46 S IBCNT=+$G(^TMP($J,"IBCRCC")) 47 S IBI=0 F S IBI=$O(IBCHGARR(IBI)) Q:'IBI D 48 . S IBLN=IBCHGARR(IBI),IBCI=+IBLN,IBCHRG=$P(IBLN,U,3),(IBPCHRG,IBRCHRG)="" Q:'IBCHRG S IBBASE=$P(IBLN,U,4) 49 . S IBRVCD=INSRC I 'IBRVCD S IBRVCD=$P(IBLN,U,2) 50 . I 'IBRVCD S IBRVCD=$P($$RVLNK^IBCRU6(+ITEM,"",+CS),U,2) I 'IBRVCD S IBRVCD=IBDRVCD Q:'IBRVCD 51 . I +IDFRC,+$P(IDFRC,IBRVCD_":",2) S IBRVCD=+$P(IDFRC,IBRVCD_":",2) Q:IBRVCD'?3N 52 . ; 53 . S IBCHRG=IBCHRG*UNITS 54 . S IBCHRG=IBCHRG+IBBASE 55 . S IBPCHRG=IBCHRG I +IBPPRV S IBPCHRG=$$PRVCHG^IBCRCC(CS,IBCHRG,IBPPRV,EVDT,ITEM) 56 . S (IBCHRG,IBTCHRG)=+IBPCHRG 57 . S IBACHRG=IBTCHRG I +RS,+IBTCHRG S IBRCHRG=$$RATECHG^IBCRCC(RS,IBTCHRG,EVDT),IBACHRG=+IBRCHRG 58 . ; 59 . S IBCNT=IBCNT+1,^TMP($J,"IBCRCC")=IBCNT 60 . S ^TMP($J,"IBCRCC",IBCNT)=IBCI_U_CS_U_RS_U_ITEM_U_MOD_U_IBRVCD_U_IBBS_U_EVDT_U_IBCHRG_U_UNITS_U_IBTCHRG_U_IBACHRG_U_$G(SAVE) 61 . ; 62 . I (UNITS>1)!(+IBBASE) S IBCOM=$$COMMUB(CS,UNITS,IBBASE) I IBCOM'="" D COMMENT(IBCNT,IBCOM) 63 . I $P(IBPCHRG,U,2)'="" S IBCOM=$P(IBPCHRG,U,2) I IBCOM'="" D COMMENT(IBCNT,IBCOM) 64 . I $P(IBRCHRG,U,2)'="" S IBCOM=$P(IBRCHRG,U,2) I IBCOM'="" D COMMENT(IBCNT,IBCOM) 65 Q 66 ; 67 COMMENT(LINE,COMM) ; set comment into charge array for a particular line item 68 I +$D(^TMP($J,"IBCRCC",+$G(LINE))) N IBX D 69 . S IBX=$O(^TMP($J,"IBCRCC",+LINE,"CC",9999),-1) S IBX=IBX+1 70 . S ^TMP($J,"IBCRCC",+LINE,"CC",IBX)=$G(COMM) 71 Q 72 ; 73 COMMUB(CS,UNITS,BASE) ; return comment for special units and base 74 N IBX,IBY,IBCM S IBX="",IBY="Charge calculated" 75 S IBCM=$P($G(^IBE(363.1,+CS,0)),U,2),IBCM=$P($G(^IBE(363.3,+IBCM,0)),U,5) 76 S IBCM=$S(IBCM=4:"Miles",IBCM=5:"SubUnits",IBCM=6:"Hours",1:"") 77 I +$G(UNITS) S IBX=IBY_" for "_UNITS_" "_IBCM,IBY="" 78 I +$G(BASE) S IBX=IBY_IBX_" with a Base Charge="_$J(BASE,0,2) 79 Q IBX 80 ; 81 ALLBEDS(RS,CS,EVDT,RC,DFRC,SAVE) ; get charges for all bedsections active on date of visit 82 ; each effective date supercedes all previous effective date, regardless of the item 83 ; used for per diem rates where the charges are associated with a bedsection, but the item being billed is not 84 ; a bedsection, so the count of the item on the bill is found and applied as the units to all bedsections active 85 ; on the event date (the 3 opt visit dates on a bill are the units for the Outpatient Visit bedsection charge) 86 ; 87 N IBITM,IBITEMS I '$G(CS)!'$G(EVDT) Q 88 ; 89 D CSALL^IBCRCU1(CS,EVDT,.IBITEMS) 90 ; 91 I +IBITEMS S IBITM="" F S IBITM=$O(IBITEMS(IBITM)) Q:'IBITM D 92 . D BITMCHG($G(RS),CS,IBITM,EVDT,1,"",$G(RC),$G(DFRC),$G(SAVE)) 93 Q 94 ; 95 ; 96 CPTUNITS(CS,CHGMTH,ITLINE) ; return CPT units based on Charge Method and CPT data 97 ; Input: CS is the related Charge Set 98 ; CHGMTH is the Rate Schedule Charge Method (363.3, .05) 99 ; ITLINE is item data from CPT^IBCRBG1 100 ; Output: calculated units for CPT, 1 or calculated for miles/minutes/hours 101 N IBUNIT S IBUNIT=1,CHGMTH=$G(CHGMTH),ITLINE=$G(ITLINE),CS=$G(CS) 102 I CHGMTH=4 S IBUNIT=+$P(ITLINE,U,8) ; miles 103 I CHGMTH=5 S IBUNIT=+$P(ITLINE,U,7) ; minutes 104 I CHGMTH=6 S IBUNIT=+$P(ITLINE,U,9) ; hours 105 S IBUNIT=$$CPTUNITS^IBCRCU1(CS,IBUNIT) 106 Q IBUNIT 107 ; 108 CHGOTH(IBIFN,RS,EVDT) ; check if the Rate Schedule charges are applicable to the event date for the bill 109 ; this is relevent to RC v2.0 and type of care of Other 110 ; both Rate Schedule is SNF and event date is SNF care or neither can be otherwise no charge 111 ; SNF charges can't be used for non-SNF care and non-SNF charges can't be used for SNF care 112 ; Output: returns true if charges and bill date are of same type, SNF or non-SNF 113 N IBOK,IBRSTY,IBDTTY S (IBRSTY,IBDTTY)=0,IBOK=1 114 I $G(EVDT)<$$VERSDT^IBCRU8(2) G CHGOTHQ 115 I '$G(IBIFN)!'$G(RS) G CHGOTHQ 116 ; 117 S IBRSTY=$$RSOTHER^IBCRU8(RS) ; are charges for other type of care 118 S IBDTTY=$$BOTHER^IBCU3(IBIFN,EVDT) ; is date other type of care 119 ; 120 I +IBRSTY,'IBDTTY S IBOK=0 121 I 'IBRSTY,+IBDTTY S IBOK=0 122 ; 123 CHGOTHQ Q IBOK 124 ; 125 CHGICU(CS,BS) ; check if charge and bedsection match relative to ICU RC 2.0+, compares Charge Set Name and Bedsection 126 ; both the charge set and the bedsection have to be ICU or neither of them can be ICU otherwise no charge 127 ; ICU charges can't be used with non-ICU bedsections and non-ICU charges can't be used with ICU bedsection 128 ; Output: returns true if charges and bedsection are of same type, ICU or non-ICU 129 N IBCSICU,IBCSN,IBICU,IBOK S (IBOK,IBCSICU)=0,BS=+$G(BS) 130 S IBICU=$$MCCRUTL^IBCRU1("ICU",5) 131 S IBCSN=$G(^IBE(363.1,+$G(CS),0)) I $E(IBCSN,1,2)'="RC" S IBOK=1 132 I $P(IBCSN,U,1)["ICU" S IBCSICU=1 ; charge set is icu 133 ; 134 I BS=IBICU,+IBCSICU S IBOK=1 ; both bedsection and charge set are icu 135 I BS'=IBICU,'IBCSICU S IBOK=1 ; niether bedsection nor charge set are icu 136 Q IBOK
Note:
See TracChangeset
for help on using the changeset viewer.
