IBCBB0 ;ALB/ESG - IB edit check routine continuation ;12-Mar-2008
;;2.0;INTEGRATED BILLING;**377,400,461**;21-MAR-94;Build 58
;;Per VHA Directive 2004-038, this routine should not be modified.
;
Q
;
BP(IBIFN) ; make sure the claim has a valid Billing Provider w/address
N BPZ,BPAD1,BPCITY,BPST,BPZIP,IBZ
S BPZ=$$B^IBCEF79(IBIFN)
I 'BPZ D G BPX
. S IBER=IBER_"IB140;" ; fatal error# IB140 - This claim has no Billing Provider.
. D WARN^IBCBB11($P(BPZ,U,2)) ; display reason as a warning
. Q
;
; billing provider exists....check the address pieces.
; for printed, UB claims we always use the billing provider data in FL-1 from the Inst file.
; for EDI claims or for printed CMS-1500 claims, we use the GETBP^IBCEF79 utility to get the billing provider data.
I '$$TXMT^IBCEF4(IBIFN),$$FT^IBCEF(IBIFN)=3 D
. S BPAD1=$$GETFAC^IBCEP8(+BPZ,0,1)
. S BPCITY=$$GETFAC^IBCEP8(+BPZ,0,"3C")
. S BPST=$$GETFAC^IBCEP8(+BPZ,0,"3S")
. S BPZIP=$$GETFAC^IBCEP8(+BPZ,0,"3Z")
. Q
;
E D
. D GETBP^IBCEF79(IBIFN,"",+BPZ,"IBCBB0",.IBZ)
. S BPAD1=$G(IBZ("IBCBB0","ADDR1"))
. S BPCITY=$G(IBZ("IBCBB0","CITY"))
. S BPST=$G(IBZ("IBCBB0","ST"))
. S BPZIP=$G(IBZ("IBCBB0","ZIP"))
. Q
;
I '$L(BPAD1)!'$L(BPCITY)!'$L(BPST)!'$L(BPZIP) S IBER=IBER_"IB148;"
BPX ;
Q
;
PAYTO(IBIFN) ; check for missing Pay-to Provider information
;
; Possible IB error codes for Pay-to Provider:
; IB177 - No Pay-to Provider defined for this claim.
; IB178 - Pay-to Provider on the claim is missing a name.
; IB179 - Pay-to Provider on the claim is missing an NPI.
; IB180 - Pay-to Provider on the claim is missing a Tax ID number.
; IB181 - Address Line 1, City, State, and ZIP are required for Pay-to Provider.
;
N Z,PTPERR,PTPINST,PTPFT,PTPFTN,Z1,PTPFLAG
S Z=$$PRVDATA^IBJPS3(IBIFN)
S PTPERR=$P(Z,U,10) ; list of any pay-to provider errors as listed above
I PTPERR'="" S IBER=IBER_PTPERR
;
I IBER["IB177" G PAYTOX ; no need to continue if there is no pay-to provider
;
; display a warning if the pay-to provider facility type is wrong
S PTPINST=$P(Z,U,11) ; pay-to provider Institution file pointer (file 4 ien)
S PTPFT=+$$GET1^DIQ(4,+PTPINST_",",13,"I") ; pay-to provider facility type ien
S PTPFTN=$$WHAT^XUAF4(PTPINST,13) ; pay-to provider facility type name
I PTPFTN="" S PTPFTN="UNKNOWN"
;
S (Z1,PTPFLAG)=""
I PTPFT S Z1=+$O(^IBE(350.9,1,20,"B",PTPFT,0))
I Z1 S PTPFLAG=$P($G(^IBE(350.9,1,20,Z1,0)),U,2)
;
; display warning message if the flag is not true
I 'PTPFLAG D WARN^IBCBB11("Pay-to Prov "_$P(Z,U,1)_" on this claim has facility type "_PTPFTN_".")
;
PAYTOX ;
Q
;
PAYERADD(IBIFN) ; check to make sure payer address is present for all payers on the claim
; Address line 1, city, state, and zip must be present for all non-Medicare payers on the claim
;
NEW IBZ,OK,Z,IBL,N,SEQ,ADDR,IBXDATA,IBXSAVE,IBXARRAY,IBXARRY,IBXERR
;
; check current payer address if not Medicare
I '$$WNRBILL^IBEFUNC(IBIFN) D
. D F^IBCEF("N-CURR INS CO FULL ADDRESS","IBZ",,IBIFN)
. S OK=1
. F Z=1,4,5,6 I $G(IBZ(Z))="" S OK=0 Q
. I 'OK S IBER=IBER_"IB172;"
. Q
;
; check other payer addresses if they exist
D F^IBCEF("N-OTH INSURANCE SEQUENCE","IBL",,IBIFN) ; other payer sequence array
I '$O(IBXSAVE(1,0)) G PAYERAX ; no other payers on claim
S N=0 F S N=$O(IBXSAVE(1,N)) Q:'N D
. S SEQ=IBXSAVE(1,N) ; other payer sequence letter
. I $$WNRBILL^IBEFUNC(IBIFN,SEQ) Q ; ignore Medicare addresses
. S ADDR=$$ADD^IBCNADD(IBIFN,SEQ) ; other payer address string
. S OK=1
. F Z=1,4,5,6 I $P(ADDR,U,Z)="" S OK=0 Q
. I 'OK S IBER=IBER_"IB173;"
. Q
;
PAYERAX ;
Q
;
ICD10V(IBIFN) ; ICD-10 Edit Check:
; Check that all bill Diagnosis and Procedures match the ICD Coding Version determined by the Statement To Date
N IBI,IB0,IBU2,IBU3,IBCL,IBFT,IBTDT,IBDXA,IBDX,IBPR,IBP0,IBICD10,IBERROR S IBERROR=0 I '$G(IBIFN) Q
;
S IB0=$G(^DGCR(399,IBIFN,0)),IBCL=$P(IB0,U,5),IBFT=$P(IB0,U,19)
S IBU2=$G(^DGCR(399,IBIFN,"U2")),IBU3=$G(^DGCR(399,IBIFN,"U3"))
S IBTDT=$P($G(^DGCR(399,IBIFN,"U")),U,2)
;
S IBICD10=$$ICD9SYS^IBACSV(IBTDT) ; ICD Diagnosis Version active for Bill
;
D SET^IBCSC4D(IBIFN,.IBDXA)
S IBDX=0 F S IBDX=$O(IBDXA(IBDX)) Q:'IBDX I $$ICD9VER^IBACSV(IBDX)'=IBICD10 S IBERROR=1 ; Bill Dx
I IBCL<3 S IBDX=+$P(IBU2,U,1) I IBDX,$$ICD9VER^IBACSV(IBDX)'=IBICD10 S IBERROR=1 ; Inpt Admitting Dx
I IBCL>2,IBFT=3 F IBI=8,9,10 S IBDX=+$P(IBU3,U,IBI) I IBDX,$$ICD9VER^IBACSV(IBDX)'=IBICD10 S IBERROR=1 ; OptUB PRV
;
S IBICD10=$$ICD0SYS^IBACSV(IBTDT) ; ICD Procedure Version active for Bill
;
S IBPR=0 F S IBPR=$O(^DGCR(399,IBIFN,"CP",IBPR)) Q:'IBPR D ; Bill Procedures
. S IBP0=$G(^DGCR(399,IBIFN,"CP",IBPR,0)) I IBP0["ICD0(",$$ICD0VER^IBACSV(+IBP0)'=IBICD10 S IBERROR=1
;
ICD10VX I IBERROR S IBER=$G(IBER)_"IB356;"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCBB0 5060 printed Apr 09, 2024@21:09:49 Page 2
IBCBB0 ;ALB/ESG - IB edit check routine continuation ;12-Mar-2008
+1 ;;2.0;INTEGRATED BILLING;**377,400,461**;21-MAR-94;Build 58
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
BP(IBIFN) ; make sure the claim has a valid Billing Provider w/address
+1 NEW BPZ,BPAD1,BPCITY,BPST,BPZIP,IBZ
+2 SET BPZ=$$B^IBCEF79(IBIFN)
+3 IF 'BPZ
Begin DoDot:1
+4 ; fatal error# IB140 - This claim has no Billing Provider.
SET IBER=IBER_"IB140;"
+5 ; display reason as a warning
DO WARN^IBCBB11($PIECE(BPZ,U,2))
+6 QUIT
End DoDot:1
GOTO BPX
+7 ;
+8 ; billing provider exists....check the address pieces.
+9 ; for printed, UB claims we always use the billing provider data in FL-1 from the Inst file.
+10 ; for EDI claims or for printed CMS-1500 claims, we use the GETBP^IBCEF79 utility to get the billing provider data.
+11 IF '$$TXMT^IBCEF4(IBIFN)
IF $$FT^IBCEF(IBIFN)=3
Begin DoDot:1
+12 SET BPAD1=$$GETFAC^IBCEP8(+BPZ,0,1)
+13 SET BPCITY=$$GETFAC^IBCEP8(+BPZ,0,"3C")
+14 SET BPST=$$GETFAC^IBCEP8(+BPZ,0,"3S")
+15 SET BPZIP=$$GETFAC^IBCEP8(+BPZ,0,"3Z")
+16 QUIT
End DoDot:1
+17 ;
+18 IF '$TEST
Begin DoDot:1
+19 DO GETBP^IBCEF79(IBIFN,"",+BPZ,"IBCBB0",.IBZ)
+20 SET BPAD1=$GET(IBZ("IBCBB0","ADDR1"))
+21 SET BPCITY=$GET(IBZ("IBCBB0","CITY"))
+22 SET BPST=$GET(IBZ("IBCBB0","ST"))
+23 SET BPZIP=$GET(IBZ("IBCBB0","ZIP"))
+24 QUIT
End DoDot:1
+25 ;
+26 IF '$LENGTH(BPAD1)!'$LENGTH(BPCITY)!'$LENGTH(BPST)!'$LENGTH(BPZIP)
SET IBER=IBER_"IB148;"
BPX ;
+1 QUIT
+2 ;
PAYTO(IBIFN) ; check for missing Pay-to Provider information
+1 ;
+2 ; Possible IB error codes for Pay-to Provider:
+3 ; IB177 - No Pay-to Provider defined for this claim.
+4 ; IB178 - Pay-to Provider on the claim is missing a name.
+5 ; IB179 - Pay-to Provider on the claim is missing an NPI.
+6 ; IB180 - Pay-to Provider on the claim is missing a Tax ID number.
+7 ; IB181 - Address Line 1, City, State, and ZIP are required for Pay-to Provider.
+8 ;
+9 NEW Z,PTPERR,PTPINST,PTPFT,PTPFTN,Z1,PTPFLAG
+10 SET Z=$$PRVDATA^IBJPS3(IBIFN)
+11 ; list of any pay-to provider errors as listed above
SET PTPERR=$PIECE(Z,U,10)
+12 IF PTPERR'=""
SET IBER=IBER_PTPERR
+13 ;
+14 ; no need to continue if there is no pay-to provider
IF IBER["IB177"
GOTO PAYTOX
+15 ;
+16 ; display a warning if the pay-to provider facility type is wrong
+17 ; pay-to provider Institution file pointer (file 4 ien)
SET PTPINST=$PIECE(Z,U,11)
+18 ; pay-to provider facility type ien
SET PTPFT=+$$GET1^DIQ(4,+PTPINST_",",13,"I")
+19 ; pay-to provider facility type name
SET PTPFTN=$$WHAT^XUAF4(PTPINST,13)
+20 IF PTPFTN=""
SET PTPFTN="UNKNOWN"
+21 ;
+22 SET (Z1,PTPFLAG)=""
+23 IF PTPFT
SET Z1=+$ORDER(^IBE(350.9,1,20,"B",PTPFT,0))
+24 IF Z1
SET PTPFLAG=$PIECE($GET(^IBE(350.9,1,20,Z1,0)),U,2)
+25 ;
+26 ; display warning message if the flag is not true
+27 IF 'PTPFLAG
DO WARN^IBCBB11("Pay-to Prov "_$PIECE(Z,U,1)_" on this claim has facility type "_PTPFTN_".")
+28 ;
PAYTOX ;
+1 QUIT
+2 ;
PAYERADD(IBIFN) ; check to make sure payer address is present for all payers on the claim
+1 ; Address line 1, city, state, and zip must be present for all non-Medicare payers on the claim
+2 ;
+3 NEW IBZ,OK,Z,IBL,N,SEQ,ADDR,IBXDATA,IBXSAVE,IBXARRAY,IBXARRY,IBXERR
+4 ;
+5 ; check current payer address if not Medicare
+6 IF '$$WNRBILL^IBEFUNC(IBIFN)
Begin DoDot:1
+7 DO F^IBCEF("N-CURR INS CO FULL ADDRESS","IBZ",,IBIFN)
+8 SET OK=1
+9 FOR Z=1,4,5,6
IF $GET(IBZ(Z))=""
SET OK=0
QUIT
+10 IF 'OK
SET IBER=IBER_"IB172;"
+11 QUIT
End DoDot:1
+12 ;
+13 ; check other payer addresses if they exist
+14 ; other payer sequence array
DO F^IBCEF("N-OTH INSURANCE SEQUENCE","IBL",,IBIFN)
+15 ; no other payers on claim
IF '$ORDER(IBXSAVE(1,0))
GOTO PAYERAX
+16 SET N=0
FOR
SET N=$ORDER(IBXSAVE(1,N))
if 'N
QUIT
Begin DoDot:1
+17 ; other payer sequence letter
SET SEQ=IBXSAVE(1,N)
+18 ; ignore Medicare addresses
IF $$WNRBILL^IBEFUNC(IBIFN,SEQ)
QUIT
+19 ; other payer address string
SET ADDR=$$ADD^IBCNADD(IBIFN,SEQ)
+20 SET OK=1
+21 FOR Z=1,4,5,6
IF $PIECE(ADDR,U,Z)=""
SET OK=0
QUIT
+22 IF 'OK
SET IBER=IBER_"IB173;"
+23 QUIT
End DoDot:1
+24 ;
PAYERAX ;
+1 QUIT
+2 ;
ICD10V(IBIFN) ; ICD-10 Edit Check:
+1 ; Check that all bill Diagnosis and Procedures match the ICD Coding Version determined by the Statement To Date
+2 NEW IBI,IB0,IBU2,IBU3,IBCL,IBFT,IBTDT,IBDXA,IBDX,IBPR,IBP0,IBICD10,IBERROR
SET IBERROR=0
IF '$GET(IBIFN)
QUIT
+3 ;
+4 SET IB0=$GET(^DGCR(399,IBIFN,0))
SET IBCL=$PIECE(IB0,U,5)
SET IBFT=$PIECE(IB0,U,19)
+5 SET IBU2=$GET(^DGCR(399,IBIFN,"U2"))
SET IBU3=$GET(^DGCR(399,IBIFN,"U3"))
+6 SET IBTDT=$PIECE($GET(^DGCR(399,IBIFN,"U")),U,2)
+7 ;
+8 ; ICD Diagnosis Version active for Bill
SET IBICD10=$$ICD9SYS^IBACSV(IBTDT)
+9 ;
+10 DO SET^IBCSC4D(IBIFN,.IBDXA)
+11 ; Bill Dx
SET IBDX=0
FOR
SET IBDX=$ORDER(IBDXA(IBDX))
if 'IBDX
QUIT
IF $$ICD9VER^IBACSV(IBDX)'=IBICD10
SET IBERROR=1
+12 ; Inpt Admitting Dx
IF IBCL<3
SET IBDX=+$PIECE(IBU2,U,1)
IF IBDX
IF $$ICD9VER^IBACSV(IBDX)'=IBICD10
SET IBERROR=1
+13 ; OptUB PRV
IF IBCL>2
IF IBFT=3
FOR IBI=8,9,10
SET IBDX=+$PIECE(IBU3,U,IBI)
IF IBDX
IF $$ICD9VER^IBACSV(IBDX)'=IBICD10
SET IBERROR=1
+14 ;
+15 ; ICD Procedure Version active for Bill
SET IBICD10=$$ICD0SYS^IBACSV(IBTDT)
+16 ;
+17 ; Bill Procedures
SET IBPR=0
FOR
SET IBPR=$ORDER(^DGCR(399,IBIFN,"CP",IBPR))
if 'IBPR
QUIT
Begin DoDot:1
+18 SET IBP0=$GET(^DGCR(399,IBIFN,"CP",IBPR,0))
IF IBP0["ICD0("
IF $$ICD0VER^IBACSV(+IBP0)'=IBICD10
SET IBERROR=1
End DoDot:1
+19 ;
ICD10VX IF IBERROR
SET IBER=$GET(IBER)_"IB356;"
+1 QUIT
