| [613] | 1 | IBAUTL2 ;ALB/CPM-MEANS TEST BILLING UTILITIES ;30-AUG-91
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**52,153,167,187,183**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | CHFIND ; Find open charge for a billable event
|
|---|
| 6 | ; Input: IBEVDA, IBX (C=copay/P=per diem)
|
|---|
| 7 | ; Output: IBCH*DA=0/ien of charge also IBCH* if IBCH*DA>0
|
|---|
| 8 | N J,X S J=0
|
|---|
| 9 | F S J=$O(^IB("ACT",IBEVDA,J)) Q:'J S X=$G(^IB(J,0)) I X]"",(($P(X,"^",8)["CO-PAY"&(IBX="C"))!($P(X,"^",8)["PER DIEM"&(IBX="P"))) Q:$P(X,"^",5)=1
|
|---|
| 10 | S:J IBCHTOTL=$P(X,"^",7),IBCHFR=$P(X,"^",14),IBCHTO=$P(X,"^",15)
|
|---|
| 11 | S @("IBCH"_IBX_"DA")=+J Q
|
|---|
| 12 | ;
|
|---|
| 13 | CHADD ; Add a new IB Action in #350
|
|---|
| 14 | D ADD^IBAUTL I Y<1 S IBY=Y G CHADDQ
|
|---|
| 15 | S $P(^IB(IBN,0),"^",2,16)=DFN_"^"_IBATYP_"^"_IBSL_"^1^1^"_IBCHG_"^"_IBDESC_"^"_IBN_"^^^^"_IBFAC_"^"_IBDT_"^"_IBDT_"^"_IBEVDA
|
|---|
| 16 | I $G(IBGMTR) S $P(^IB(IBN,0),"^",21)=1 ; GMT RELATED field #.21
|
|---|
| 17 | D NOW^%DTC S $P(^IB(IBN,1),"^")=DUZ,$P(^(1),"^",3,4)=DUZ_"^"_%
|
|---|
| 18 | S DIK="^IB(",DA=IBN D IX1^DIK K DIK,DA
|
|---|
| 19 | ;I $G(IBJOB)=1 S ^TMP($J,"IBAMTC","I",DFN,IBN)=""
|
|---|
| 20 | CHADDQ Q
|
|---|
| 21 | ;
|
|---|
| 22 | CHUPD ; Update an IB Action charge
|
|---|
| 23 | ; Input: IBCHTOTL, IBCHFR, IBDT, IBX(P/C), IBN, IBCHG, DUZ, IBGMTR(opt)
|
|---|
| 24 | N TOT,UNIT S UNIT=1
|
|---|
| 25 | I IBX="P" S X1=IBDT,X2=IBCHFR D ^%DTC S UNIT=X+1,TOT=UNIT*IBCHG
|
|---|
| 26 | I IBX="C" S TOT=IBCHTOTL+IBCHG
|
|---|
| 27 | D NOW^%DTC S $P(^IB(IBN,0),"^",6,7)=UNIT_"^"_TOT,$P(^(0),"^",15)=IBDT,$P(^(1),"^",3,4)=DUZ_"^"_%
|
|---|
| 28 | I $G(IBGMTR) S $P(^IB(IBN,0),"^",21)=1 ; GMT RELATED field #.21
|
|---|
| 29 | S DIK="^IB(",DA=IBN D IX1^DIK K DIK,DA
|
|---|
| 30 | ;I $G(IBJOB)=1 S ^TMP($J,"IBAMTC","I",+$G(DFN),IBN)=""
|
|---|
| 31 | Q
|
|---|
| 32 | ;
|
|---|
| 33 | SERV ; Find the service pointer for MAS.
|
|---|
| 34 | S IBSERV=$P($G(^IBE(350.9,1,1)),"^",14) I '$D(^DIC(49,+IBSERV,0)) S IBY="-1^IB003"
|
|---|
| 35 | Q
|
|---|
| 36 | ;
|
|---|
| 37 | TYPE ; Find the IB action type and rate for per diem and OPT co-payment charges.
|
|---|
| 38 | ; Input: IBDT, IBBS (if IBX=P), IBX (O=opt copay/P=per diem)
|
|---|
| 39 | ; IBTYPE (only if outpatient, specify Basic or Specialty)
|
|---|
| 40 | ; Output: IBATYP, IBCHG, IBDESC, IBRTED
|
|---|
| 41 | N J,IBOLDBS S IBCHG=0,IBDESC=""
|
|---|
| 42 | I IBX="O" D
|
|---|
| 43 | .S IBBS=$$ITPTR^IBCRU2(9,$S(IBTYPE=2:"SPECIALTY CARE",1:"BASIC CARE"))
|
|---|
| 44 | .S IBCS=$$CSN^IBCRU3("TL-MT OPT COPAY")
|
|---|
| 45 | .S IBOLDBS=$$MCCRUTL^IBCRU1("OUTPATIENT VISIT",5)
|
|---|
| 46 | .D COPAY
|
|---|
| 47 | ;
|
|---|
| 48 | I IBX="P" S IBATYP=+$P($G(^DGCR(399.1,IBBS,0)),"^",8) I IBATYP D COST X:$D(^IBE(350.1,IBATYP,20)) ^(20)
|
|---|
| 49 | I 'IBATYP S IBY="-1^IB008" G TYPEQ
|
|---|
| 50 | I 'IBCHG S IBY="-1^IB029"
|
|---|
| 51 | TYPEQ Q
|
|---|
| 52 | ;
|
|---|
| 53 | COST ; - find per diem charge. Input: IBATYP, IBDT Output: IBCHG
|
|---|
| 54 | N X S X=$O(^IBE(350.2,"AIVDT",IBATYP,-(IBDT+.1))),X=$O(^(+X,0)) I $D(^IBE(350.2,+X,0)) S X=$P(^(0),"^",4)
|
|---|
| 55 | S IBCHG=+X Q
|
|---|
| 56 | ;
|
|---|
| 57 | COPAY ; Find the Inpatient/NHCU daily copay rate and IB action type
|
|---|
| 58 | ; Input: IBBS, IBDT, IBCS (for the opt copay only)
|
|---|
| 59 | ; Output: IBATYP, IBCHG, IBDESC, IBRTED
|
|---|
| 60 | ;
|
|---|
| 61 | S (IBATYP,IBCHG)=0,IBDESC=""
|
|---|
| 62 | S IBATYP=$P($G(^DGCR(399.1,$S($D(IBOLDBS):IBOLDBS,1:IBBS),0)),"^",7) I 'IBATYP S IBY="-1^IB008" G COPAYQ
|
|---|
| 63 | I $D(^IBE(350.1,+IBATYP,20)) X ^(20)
|
|---|
| 64 | ;
|
|---|
| 65 | ; - charge set is not defined as input for inpatient rates
|
|---|
| 66 | I '$G(IBCS) S IBCS=$$CSN^IBCRU3("TL-INPT (INCLUSIVE)")
|
|---|
| 67 | S IBCHG=$$ITCHG^IBCRCI(IBCS,IBBS,IBDT)
|
|---|
| 68 | S IBRTED=$P(IBCHG,"^",2),IBCHG=+IBCHG
|
|---|
| 69 | ;
|
|---|
| 70 | I 'IBCHG S IBY="-1^IB030"
|
|---|
| 71 | COPAYQ K IBCS
|
|---|
| 72 | Q
|
|---|
