- Timestamp:
- Dec 4, 2009, 8:26:01 PM (14 years ago)
- Location:
- FOIAVistA/tag/r
- Files:
-
- 1 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
FOIAVistA/tag/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCRBC2.m
r628 r636 1 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 53 ;;Per VHA Directive 2004-038, this routine should not be modified.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 4 ; 5 5 ; Input: RS - rate schedule necessary to calculated modified charges … … 22 22 ; CLINIC - procedures associated clinic 23 23 ; IBOE - Outpatient Encounter, pointer to #408.69 24 ; MODS - list of all modifiers define for the procedure, separated by ','25 24 ; 26 25 ; Total charge is calculated: X = UNITS * UNIT CHARGE of the item (per unit charge (un-adjusted)) … … 35 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 36 35 ; 37 N IBCS0,IBDRVCD,IBBS,IBCHGARR,IBI,IBCNT,IBLN,IBCI,IBRVCD,IBPPRV,IBCHRG,IBTCHRG,IBRCHRG,IBPCHRG,IBACHRG 38 N IBMCHRG,IBMODS,IBBASE,IBCOMI '$G(ITEM)!'$G(CS)!'$G(UNITS) Q36 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 39 38 ; 40 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) 41 S IBCS0=$G(^IBE(363.1,+CS,0)),IBDRVCD=$P(IBCS0,U,5),IBPPRV=$P(SAVE,U,8) ,IBMODS=$P(SAVE,U,11)40 S IBCS0=$G(^IBE(363.1,+CS,0)),IBDRVCD=$P(IBCS0,U,5),IBPPRV=$P(SAVE,U,8) 42 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) 43 42 I 'IBBS Q … … 55 54 . S IBCHRG=IBCHRG+IBBASE 56 55 . 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 56 . S (IBCHRG,IBTCHRG)=+IBPCHRG 59 57 . S IBACHRG=IBTCHRG I +RS,+IBTCHRG S IBRCHRG=$$RATECHG^IBCRCC(RS,IBTCHRG,EVDT),IBACHRG=+IBRCHRG 60 58 . ; … … 64 62 . I (UNITS>1)!(+IBBASE) S IBCOM=$$COMMUB(CS,UNITS,IBBASE) I IBCOM'="" D COMMENT(IBCNT,IBCOM) 65 63 . 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 64 . I $P(IBRCHRG,U,2)'="" S IBCOM=$P(IBRCHRG,U,2) I IBCOM'="" D COMMENT(IBCNT,IBCOM) 68 65 Q
Note:
See TracChangeset
for help on using the changeset viewer.