IBOHCK ;ALB/EMG - CHECK FOR IB CHARGES ON HOLD ; MAR 21 1997
;;2.0; INTEGRATED BILLING ;**70**; 21-MAR-94
;
FIND(DFN,IBIFN) ; find all related IB charges on hold for episodes of care
; being billed on this third party claim.
; once IB Charge is found, set ON HOLD DATE in file 350 to date
; third party claim is authorized.
;
; Input: DFN -- pointer to the patient in file #2
; IBIFN -- ien of third party Claim
;
I '$G(DFN)!('$G(IBIFN)) G ALLQ
;
N Y,Y1,IBAUTH,IBDT,IBBEG,IBEND,IBERR,IBX,IBOHD
S IBBEG=$P(^DGCR(399,IBIFN,"U"),"^",1),IBEND=$P(^DGCR(399,IBIFN,"U"),"^",2)
S IBAUTH=$P($G(^DGCR(399,IBIFN,"S")),"^",10)
I $D(^IBA(362.4,"AIFN"_+IBIFN)) D RXCHG
;
;
; - find related inpatient/outpatient patient charges on hold
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
.S Y1=0 F S Y1=$O(^IB("AF",Y,Y1)) Q:'Y1 D
..Q:'$D(^IB(Y1,0)) S IBX=^(0)
..I $P(IBX,"^",14)<IBBEG!($P(IBX,"^",15)>IBEND) Q
..I ($P(IBX,"^",5)'=8) Q
..S IBOHD=$P($G(^IB(Y1,1)),"^",6) D UPDT
..Q
Q
;
UPDT ; Update Integrated Billing Action (#350) On Hold Date field (#16)
N IBNOHD,FDA
S IBERR=""
S IBNOHD=$S(IBAUTH>IBOHD:IBAUTH,1:IBOHD)
S FDA(350,Y1_",",16)=IBNOHD
D FILE^DIE("K","FDA")
;S DIE="^IB(",DA=Y1,DR="16///^S X=IBNOHD" D ^DIE
Q
;
ALLQ K Y,Y1,IBAUTH,IBBEG,IBC,IBCRG,IBDT,IBEND,IBERR,IBIFN,IBNOHD,IBOHD,IBRXBN,IBRXDT,IBRXEND,IBRXN,IBX
Q
;
;
RXCHG ; - find related rx copay's on hold in file 350
N IBRXN,IBRXBN,IBRXEND,IBRXDT,IBCRG,IBC
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
.S IBRXDT=+$P($G(^IBA(362.4,IBRXBN,0)),"^",3)
.I IBRXDT<IBBEG!(IBRXDT>IBEND) Q
.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
..I $P(IBC,"^",5)'=8 Q
..D UPDT Q
.Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBOHCK 2058 printed Dec 13, 2024@02:25:30 Page 2
IBOHCK ;ALB/EMG - CHECK FOR IB CHARGES ON HOLD ; MAR 21 1997
+1 ;;2.0; INTEGRATED BILLING ;**70**; 21-MAR-94
+2 ;
FIND(DFN,IBIFN) ; find all related IB charges on hold for episodes of care
+1 ; being billed on this third party claim.
+2 ; once IB Charge is found, set ON HOLD DATE in file 350 to date
+3 ; third party claim is authorized.
+4 ;
+5 ; Input: DFN -- pointer to the patient in file #2
+6 ; IBIFN -- ien of third party Claim
+7 ;
+8 IF '$GET(DFN)!('$GET(IBIFN))
GOTO ALLQ
+9 ;
+10 NEW Y,Y1,IBAUTH,IBDT,IBBEG,IBEND,IBERR,IBX,IBOHD
+11 SET IBBEG=$PIECE(^DGCR(399,IBIFN,"U"),"^",1)
SET IBEND=$PIECE(^DGCR(399,IBIFN,"U"),"^",2)
+12 SET IBAUTH=$PIECE($GET(^DGCR(399,IBIFN,"S")),"^",10)
+13 IF $DATA(^IBA(362.4,"AIFN"_+IBIFN))
DO RXCHG
+14 ;
+15 ;
+16 ; - find related inpatient/outpatient patient charges on hold
+17 SET IBDT=""
FOR
SET IBDT=$ORDER(^IB("AFDT",DFN,IBDT))
if 'IBDT
QUIT
IF -IBDT'>IBEND
SET Y=0
FOR
SET Y=$ORDER(^IB("AFDT",DFN,IBDT,Y))
if 'Y
QUIT
Begin DoDot:1
+18 SET Y1=0
FOR
SET Y1=$ORDER(^IB("AF",Y,Y1))
if 'Y1
QUIT
Begin DoDot:2
+19 if '$DATA(^IB(Y1,0))
QUIT
SET IBX=^(0)
+20 IF $PIECE(IBX,"^",14)<IBBEG!($PIECE(IBX,"^",15)>IBEND)
QUIT
+21 IF ($PIECE(IBX,"^",5)'=8)
QUIT
+22 SET IBOHD=$PIECE($GET(^IB(Y1,1)),"^",6)
DO UPDT
+23 QUIT
End DoDot:2
End DoDot:1
+24 QUIT
+25 ;
UPDT ; Update Integrated Billing Action (#350) On Hold Date field (#16)
+1 NEW IBNOHD,FDA
+2 SET IBERR=""
+3 SET IBNOHD=$SELECT(IBAUTH>IBOHD:IBAUTH,1:IBOHD)
+4 SET FDA(350,Y1_",",16)=IBNOHD
+5 DO FILE^DIE("K","FDA")
+6 ;S DIE="^IB(",DA=Y1,DR="16///^S X=IBNOHD" D ^DIE
+7 QUIT
+8 ;
ALLQ KILL Y,Y1,IBAUTH,IBBEG,IBC,IBCRG,IBDT,IBEND,IBERR,IBIFN,IBNOHD,IBOHD,IBRXBN,IBRXDT,IBRXEND,IBRXN,IBX
+1 QUIT
+2 ;
+3 ;
RXCHG ; - find related rx copay's on hold in file 350
+1 NEW IBRXN,IBRXBN,IBRXEND,IBRXDT,IBCRG,IBC
+2 SET IBRXN=0
FOR
SET IBRXN=$ORDER(^IBA(362.4,"AIFN"_+IBIFN,IBRXN))
if 'IBRXN
QUIT
SET IBRXBN=0
FOR
SET IBRXBN=$ORDER(^IBA(362.4,"AIFN"_+IBIFN,IBRXN,IBRXBN))
if 'IBRXBN
QUIT
Begin DoDot:1
+3 SET IBRXDT=+$PIECE($GET(^IBA(362.4,IBRXBN,0)),"^",3)
+4 IF IBRXDT<IBBEG!(IBRXDT>IBEND)
QUIT
+5 SET IBRXEND=+IBRXDT+.999999
FOR
SET IBRXDT=$ORDER(^IB("APTDT",DFN,IBRXDT))
if 'IBRXDT!(IBRXDT>IBRXEND)
QUIT
SET Y1=0
FOR
SET Y1=$ORDER(^IB("APTDT",DFN,IBRXDT,Y1))
if 'Y1
QUIT
SET IBC=$GET(^IB(Y1,0))
SET IBOHD=$PIECE($GET(^IB(Y1,1)),"^",6)
Begin DoDot:2
+6 IF $PIECE(IBC,"^",5)'=8
QUIT
+7 DO UPDT
QUIT
End DoDot:2
+8 QUIT
End DoDot:1
+9 ;
