- 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 Feb 18, 2025@23:52 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 ;