| 1 | IBEFUNC1 ;ALB/ARH - CPT BILLING EXTRINSIC FUNCTIONS ; 11/27/91
|
|---|
| 2 | ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ;created front-ends for extrinsic functions for use until all versions of file man can use them
|
|---|
| 6 | FCC ;
|
|---|
| 7 | S IBCHGX=$$CPTCHG($S('$D(IBCDX):"",1:IBCDX),$S('$D(IBDIVX):"",1:IBDIVX),$S('$D(IBDTX):"",1:IBDTX))
|
|---|
| 8 | Q
|
|---|
| 9 | ;
|
|---|
| 10 | CPTCHG(CODE,DIV,DATE) ;ambulatory procedure billing charge on a date
|
|---|
| 11 | ;assumes current date if none passed in (to disallow guessing on division pass in +DIV)
|
|---|
| 12 | ;assumes first active division if (DIV=""!'$D(DIV)) passed in
|
|---|
| 13 | ;returns - the charge if code is valid and active in Billing on DATE
|
|---|
| 14 | ; - "" if unable to calc charge or there was none
|
|---|
| 15 | ; division or rate group inactive on date or not defined in file
|
|---|
| 16 | N X,%,%H,%I,Y
|
|---|
| 17 | S Y=-1 G:'$D(CODE) ENDCHG
|
|---|
| 18 | S:'$D(DATE) DATE=DT S DATE=$E(DATE,1,7) I DATE'?7N S DATE=DT
|
|---|
| 19 | S:'$D(DIV) DIV="" I DIV="" S DIV=$$MCDIV(DIV,DATE)
|
|---|
| 20 | I +$$CPTBSTAT(CODE,DATE) S X=DATE_"^"_DIV_"^"_+CODE D RATE^IBAUTL1
|
|---|
| 21 | ENDCHG Q $S(Y<0:"",1:Y)
|
|---|
| 22 | ;
|
|---|
| 23 | FCBS ;
|
|---|
| 24 | S IBSTX=$$CPTBSTAT($S('$D(IBCDX):"",1:IBCDX),$S('$D(IBDTX):"",1:IBDTX))
|
|---|
| 25 | Q
|
|---|
| 26 | ;
|
|---|
| 27 | CPTBSTAT(CODE,DATE) ;ambulatory procedure billing status on a date
|
|---|
| 28 | ;assumes current date if none passed in
|
|---|
| 29 | ;returns - "" if CODE had never been a billing code on/before DATE given or DATE before BASC start date
|
|---|
| 30 | ; - 0^INACTIVE if CODE billing inactive on DATE given or rate group inactive on DATE
|
|---|
| 31 | ; - 1^ACTIVE if CODE billing active on DATE given
|
|---|
| 32 | N LN,ST,%,%H,%I,X
|
|---|
| 33 | S ST="" I '$D(CODE) G ENDST
|
|---|
| 34 | S:'$D(DATE) DATE=DT S DATE=$E(DATE,1,7) I DATE'?7N S DATE=DT
|
|---|
| 35 | I $$STDATE^IBCU63>DATE G ENDST
|
|---|
| 36 | I $D(^IBE(350.4,+$O(^(+$O(^IBE(350.4,"AIVDT",+CODE,-(DATE+1))),0)),0)) S LN=^(0),ST=+$P(LN,"^",4)
|
|---|
| 37 | I ST,$P($G(^IBE(350.2,+$P(LN,"^",3),0)),"^",2)>DATE S ST=""
|
|---|
| 38 | S ST=ST_$S(ST'="":"^"_$P($P($P(^DD(350.4,.04,0),"^",3),ST_":",2),";",1),1:"")
|
|---|
| 39 | ENDST Q ST
|
|---|
| 40 | ;
|
|---|
| 41 | FCR ;
|
|---|
| 42 | S IBRGX=$$CPTRG($S('$D(IBCDX):"",1:IBCDX),$S('$D(IBDTX):"",1:IBDTX))
|
|---|
| 43 | Q
|
|---|
| 44 | ;
|
|---|
| 45 | CPTRG(CPT,DATE) ;find the rate group for the CPT on the given date
|
|---|
| 46 | ;assumes current date if none passed in
|
|---|
| 47 | ;returns - a rate group name
|
|---|
| 48 | ; - "" if no rate group listed for date, or CPT or DATE is ""
|
|---|
| 49 | N RATE,%,%H,%I,X
|
|---|
| 50 | G:'$D(CPT) ENDRG
|
|---|
| 51 | S:'$D(DATE) DATE=DT S DATE=$E(DATE,1,7) I DATE'?7N S DATE=DT
|
|---|
| 52 | I $D(^IBE(350.4,+$O(^(+$O(^IBE(350.4,"AIVDT",+CPT,-(DATE+1))),0)),0)) S RATE=$P($P($G(^IBE(350.1,+$P(^(0),"^",3),0)),"^",1)," ",2,999)
|
|---|
| 53 | ENDRG Q $S($D(RATE):RATE,1:"")
|
|---|
| 54 | ;
|
|---|
| 55 | FMCD ;
|
|---|
| 56 | S IBDIVX=$$MCDIV($S('$D(IBDIVX):"",1:IBDIVX),$S('$D(IBDTX):"",1:IBDTX))
|
|---|
| 57 | Q
|
|---|
| 58 | ;
|
|---|
| 59 | MCDIV(DIV,DATE) ;find the medical center division
|
|---|
| 60 | ; if DATE is not defined then assumes current date
|
|---|
| 61 | ;returns - DIV passed in, if its status is active for date given
|
|---|
| 62 | ; - first active division found, if DIV was inactive or ""
|
|---|
| 63 | ; - if all divisions are inactive for the given date, returns ""
|
|---|
| 64 | N I,NDIV,INACT,%,%H,%I,X S DIV=$G(DIV)
|
|---|
| 65 | ;I '$D(DIV) S DIV="" G ENDIV
|
|---|
| 66 | S:'$D(DATE) DATE=DT S DATE=$E(DATE,1,7) I DATE'?7N S DATE=DT
|
|---|
| 67 | S NDIV=+$O(^(+$O(^IBE(350.5,"AIVDT",+DIV,-(DATE+1))),0))
|
|---|
| 68 | I '$P($G(^IBE(350.5,NDIV,0)),"^",4) S DIV="" F I=1:1 S DIV=$O(^IBE(350.5,"AIVDT",DIV)) Q:DIV=""!('$D(INACT(+DIV))&($P($G(^IBE(350.5,+$O(^(+$O(^IBE(350.5,"AIVDT",+DIV,-(DATE+1))),0)),0)),"^",4))) S INACT(DIV)=""
|
|---|
| 69 | ENDIV Q DIV
|
|---|
| 70 | ;
|
|---|
| 71 | RC(D0,D1,DATE) ;find BASC charge for particular revenue code entry (399,42)
|
|---|
| 72 | ;input: D0 = bill ifn, D1 = revenue code sub-file IFN
|
|---|
| 73 | ; if DATE not passed then assums STATEMENT FROM date of bill
|
|---|
| 74 | ;returns: dollar amount if rev code has an active BASC CPT, otherwise ""
|
|---|
| 75 | N X,Y,DA S X="",DATE=$P($G(DATE),".") I DATE'?7N S DATE=+$G(^DGCR(399,D0,"U"))
|
|---|
| 76 | S Y=$G(^DGCR(399,D0,"RC",D1,0)) I +$P(Y,U,6),+$P(Y,U,7) S X=+$$CPTCHG^IBEFUNC1(+$P(Y,U,6),+$P(Y,U,7),DATE)
|
|---|
| 77 | Q X
|
|---|
| 78 | ;
|
|---|
| 79 | CP(D0,D1) ;find BASC charge for particular procedure entry (399,304)
|
|---|
| 80 | ;input: D0 = bill IFN, D1 = procedure code sub-file IFN
|
|---|
| 81 | ;returns: dollar amount if CPT is BASC active, otherwise ""
|
|---|
| 82 | N X,Y,DA S X="",Y=$G(^DGCR(399,D0,"CP",D1,0)) I $P(Y,U,1)[";ICPT(",+$P(Y,U,2),+$P(Y,U,6) S X=$$CPTCHG^IBEFUNC1(+Y,+$P(Y,U,6),+$P(Y,U,2))
|
|---|
| 83 | Q X
|
|---|
