| 1 | IBOHCK ;ALB/EMG - CHECK FOR IB CHARGES ON HOLD ; MAR 21 1997
|
|---|
| 2 | ;;2.0; INTEGRATED BILLING ;**70**; 21-MAR-94
|
|---|
| 3 | ;
|
|---|
| 4 | FIND(DFN,IBIFN) ; find all related IB charges on hold for episodes of care
|
|---|
| 5 | ; being billed on this third party claim.
|
|---|
| 6 | ; once IB Charge is found, set ON HOLD DATE in file 350 to date
|
|---|
| 7 | ; third party claim is authorized.
|
|---|
| 8 | ;
|
|---|
| 9 | ; Input: DFN -- pointer to the patient in file #2
|
|---|
| 10 | ; IBIFN -- ien of third party Claim
|
|---|
| 11 | ;
|
|---|
| 12 | I '$G(DFN)!('$G(IBIFN)) G ALLQ
|
|---|
| 13 | ;
|
|---|
| 14 | N Y,Y1,IBAUTH,IBDT,IBBEG,IBEND,IBERR,IBX,IBOHD
|
|---|
| 15 | S IBBEG=$P(^DGCR(399,IBIFN,"U"),"^",1),IBEND=$P(^DGCR(399,IBIFN,"U"),"^",2)
|
|---|
| 16 | S IBAUTH=$P($G(^DGCR(399,IBIFN,"S")),"^",10)
|
|---|
| 17 | I $D(^IBA(362.4,"AIFN"_+IBIFN)) D RXCHG
|
|---|
| 18 | ;
|
|---|
| 19 | ;
|
|---|
| 20 | ; - find related inpatient/outpatient patient charges on hold
|
|---|
| 21 | S IBDT="" F S IBDT=$O(^IB("AFDT",DFN,IBDT)) Q:'IBDT I -IBDT'>IBEND S Y=0 F S Y=$O(^IB("AFDT",DFN,IBDT,Y)) Q:'Y D
|
|---|
| 22 | .S Y1=0 F S Y1=$O(^IB("AF",Y,Y1)) Q:'Y1 D
|
|---|
| 23 | ..Q:'$D(^IB(Y1,0)) S IBX=^(0)
|
|---|
| 24 | ..I $P(IBX,"^",14)<IBBEG!($P(IBX,"^",15)>IBEND) Q
|
|---|
| 25 | ..I ($P(IBX,"^",5)'=8) Q
|
|---|
| 26 | ..S IBOHD=$P($G(^IB(Y1,1)),"^",6) D UPDT
|
|---|
| 27 | ..Q
|
|---|
| 28 | Q
|
|---|
| 29 | ;
|
|---|
| 30 | UPDT ; Update Integrated Billing Action (#350) On Hold Date field (#16)
|
|---|
| 31 | N IBNOHD,FDA
|
|---|
| 32 | S IBERR=""
|
|---|
| 33 | S IBNOHD=$S(IBAUTH>IBOHD:IBAUTH,1:IBOHD)
|
|---|
| 34 | S FDA(350,Y1_",",16)=IBNOHD
|
|---|
| 35 | D FILE^DIE("K","FDA")
|
|---|
| 36 | ;S DIE="^IB(",DA=Y1,DR="16///^S X=IBNOHD" D ^DIE
|
|---|
| 37 | Q
|
|---|
| 38 | ;
|
|---|
| 39 | ALLQ K Y,Y1,IBAUTH,IBBEG,IBC,IBCRG,IBDT,IBEND,IBERR,IBIFN,IBNOHD,IBOHD,IBRXBN,IBRXDT,IBRXEND,IBRXN,IBX
|
|---|
| 40 | Q
|
|---|
| 41 | ;
|
|---|
| 42 | ;
|
|---|
| 43 | RXCHG ; - find related rx copay's on hold in file 350
|
|---|
| 44 | N IBRXN,IBRXBN,IBRXEND,IBRXDT,IBCRG,IBC
|
|---|
| 45 | S IBRXN=0 F S IBRXN=$O(^IBA(362.4,"AIFN"_+IBIFN,IBRXN)) Q:'IBRXN S IBRXBN=0 F S IBRXBN=$O(^IBA(362.4,"AIFN"_+IBIFN,IBRXN,IBRXBN)) Q:'IBRXBN D
|
|---|
| 46 | .S IBRXDT=+$P($G(^IBA(362.4,IBRXBN,0)),"^",3)
|
|---|
| 47 | .I IBRXDT<IBBEG!(IBRXDT>IBEND) Q
|
|---|
| 48 | .S IBRXEND=+IBRXDT+.999999 F S IBRXDT=$O(^IB("APTDT",DFN,IBRXDT)) Q:'IBRXDT!(IBRXDT>IBRXEND) S Y1=0 F S Y1=$O(^IB("APTDT",DFN,IBRXDT,Y1)) Q:'Y1 S IBC=$G(^IB(Y1,0)),IBOHD=$P($G(^IB(Y1,1)),"^",6) D
|
|---|
| 49 | ..I $P(IBC,"^",5)'=8 Q
|
|---|
| 50 | ..D UPDT Q
|
|---|
| 51 | .Q
|
|---|
| 52 | ;
|
|---|
