Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBOHCK

IBOHCK.m

Go to the documentation of this file.
  1. IBOHCK ;ALB/EMG - CHECK FOR IB CHARGES ON HOLD ; MAR 21 1997
  1. ;;2.0; INTEGRATED BILLING ;**70**; 21-MAR-94
  1. ;
  1. FIND(DFN,IBIFN) ; find all related IB charges on hold for episodes of care
  1. ; being billed on this third party claim.
  1. ; once IB Charge is found, set ON HOLD DATE in file 350 to date
  1. ; third party claim is authorized.
  1. ;
  1. ; Input: DFN -- pointer to the patient in file #2
  1. ; IBIFN -- ien of third party Claim
  1. ;
  1. I '$G(DFN)!('$G(IBIFN)) G ALLQ
  1. ;
  1. N Y,Y1,IBAUTH,IBDT,IBBEG,IBEND,IBERR,IBX,IBOHD
  1. S IBBEG=$P(^DGCR(399,IBIFN,"U"),"^",1),IBEND=$P(^DGCR(399,IBIFN,"U"),"^",2)
  1. S IBAUTH=$P($G(^DGCR(399,IBIFN,"S")),"^",10)
  1. I $D(^IBA(362.4,"AIFN"_+IBIFN)) D RXCHG
  1. ;
  1. ;
  1. ; - find related inpatient/outpatient patient charges on hold
  1. 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
  1. .S Y1=0 F S Y1=$O(^IB("AF",Y,Y1)) Q:'Y1 D
  1. ..Q:'$D(^IB(Y1,0)) S IBX=^(0)
  1. ..I $P(IBX,"^",14)<IBBEG!($P(IBX,"^",15)>IBEND) Q
  1. ..I ($P(IBX,"^",5)'=8) Q
  1. ..S IBOHD=$P($G(^IB(Y1,1)),"^",6) D UPDT
  1. ..Q
  1. Q
  1. ;
  1. UPDT ; Update Integrated Billing Action (#350) On Hold Date field (#16)
  1. N IBNOHD,FDA
  1. S IBERR=""
  1. S IBNOHD=$S(IBAUTH>IBOHD:IBAUTH,1:IBOHD)
  1. S FDA(350,Y1_",",16)=IBNOHD
  1. D FILE^DIE("K","FDA")
  1. ;S DIE="^IB(",DA=Y1,DR="16///^S X=IBNOHD" D ^DIE
  1. Q
  1. ;
  1. ALLQ K Y,Y1,IBAUTH,IBBEG,IBC,IBCRG,IBDT,IBEND,IBERR,IBIFN,IBNOHD,IBOHD,IBRXBN,IBRXDT,IBRXEND,IBRXN,IBX
  1. Q
  1. ;
  1. ;
  1. RXCHG ; - find related rx copay's on hold in file 350
  1. N IBRXN,IBRXBN,IBRXEND,IBRXDT,IBCRG,IBC
  1. 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
  1. .S IBRXDT=+$P($G(^IBA(362.4,IBRXBN,0)),"^",3)
  1. .I IBRXDT<IBBEG!(IBRXDT>IBEND) Q
  1. .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
  1. ..I $P(IBC,"^",5)'=8 Q
  1. ..D UPDT Q
  1. .Q
  1. ;