- IBCBB ;ALB/AAS - EDIT CHECK ROUTINE TO BE INVOKED BEFORE ALL BILL APPROVAL ACTIONS ;2-NOV-89
- ;;2.0;INTEGRATED BILLING;**80,51,137,288,327,361,371,377,400,432,461,547,592,623**;21-MAR-94;Build 70
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- ;MAP TO DGCRBB
- ;
- ;IBNDn = IBND(n) = ^ib(399,n)
- ;RETURNS:
- ;IBER=fields with errors separated by semi-colons
- ;PRCASV("OKAY")=1 if iber="" and $D(prcasv("array")) compete
- ;
- GVAR ;set up variables for mccr
- Q:'$D(IBIFN) F I=0,"M","U","U1","S","MP","TX","UF3","UF31","U2" S @("IBND"_I)=$G(^DGCR(399,IBIFN,I))
- S IBBNO=$P(IBND0,"^"),DFN=$P(IBND0,"^",2),IBEVDT=$P(IBND0,"^",3)
- S IBLOC=$P(IBND0,"^",4),IBCL=$P(IBND0,"^",5),IBTF=$P(IBND0,"^",6)
- S IBAT=$P(IBND0,"^",7),IBWHO=$P(IBND0,"^",11),IBST=$P(IBND0,"^",13),IBFT=$P(IBND0,"^",19)
- S IBFDT=$P(IBNDU,"^",1),IBTDT=$P(IBNDU,"^",2)
- S IBTC=$P(IBNDU1,"^",1),IBFY=$P(IBNDU1,"^",9),IBFYC=$P(IBNDU1,"^",10)
- S IBEU=$P(IBNDS,"^",2),IBRU=$P(IBNDS,"^",5),IBAU=$P(IBNDS,"^",8)
- S IBTOB=$$TOB(IBND0),IBTOB12=$E(IBTOB,1,2)
- K ^TMP($J,"BILL-WARN")
- Q
- ;
- EN ;Entry to check for errors
- N IBQ,IBXERR,IBXDATA,IBXSAVE,IBZPRC92,IBQUIT,IBISEQ,IDDATA,IBFOR,IBC,IBDX,IBDX1
- I $D(IBFL) N IBFL
- K ^TMP($J)
- W !
- S IBER="" D GVAR I '$D(IBND0) S IBER=-1 Q
- ;
- ;patient in patient file
- I DFN="" S IBER=IBER_"IB057;"
- I DFN]"",'$D(^DPT(DFN)) S IBER=IBER_"IB057;"
- ;IB*2.0*623;check date fields for validity;begin
- I $$DTCK($$GET1^DIQ(2,DFN_",",.03,"I")) S IBER=IBER_"IB368;"
- I $$DTCK($$GET1^DIQ(2,DFN_",",.351,"I")) S IBER=IBER_"IB369;"
- S IBDX=0 F S IBDX=$O(^DPT(DFN,.312,IBDX)) Q:'IBDX D
- . S IBDX1=$$GET1^DIQ(2.312,IBDX_","_DFN_",",3.01,"I")
- . I $$DTCK(IBDX1) S IBER=IBER_"IB366;"
- . Q
- I $$DTCK($$GET1^DIQ(399,IBIFN_",",151,"I")) S IBER=IBER_"IB370;"
- I $$DTCK($$GET1^DIQ(399,IBIFN_",",152,"I")) S IBER=IBER_"IB371;"
- I $$DTCK($$GET1^DIQ(399,IBIFN_",",166,"I")) S IBER=IBER_"IB372;"
- I $$DTCK($$GET1^DIQ(399,IBIFN_",",167,"I")) S IBER=IBER_"IB373;"
- I $$DTCK($$GET1^DIQ(399,IBIFN_",",246,"I")) S IBER=IBER_"IB374;"
- I $$DTCK($$GET1^DIQ(399,IBIFN_",",245,"I")) S IBER=IBER_"IB375;"
- I $$DTCK($$GET1^DIQ(399,IBIFN_",",247,"I")) S IBER=IBER_"IB376;"
- I $$DTCK($$GET1^DIQ(399,IBIFN_",",263,"I")) S IBER=IBER_"IB377;"
- I $$DTCK($$GET1^DIQ(399,IBIFN_",",264,"I")) S IBER=IBER_"IB378;"
- I $$DTCK($$GET1^DIQ(399,IBIFN_",",282,"I")) S IBER=IBER_"IB379;"
- I $$DTCK($$GET1^DIQ(399,IBIFN_",",283,"I")) S IBER=IBER_"IB380;"
- I $$DTCK($$GET1^DIQ(399,IBIFN_",",262,"I")) S IBER=IBER_"IB381;"
- I $$DTCK($$GET1^DIQ(399,IBIFN_",",237,"I")) S IBER=IBER_"IB382;"
- ;
- ;end;IB*2.0*623
- ;
- ;Event date in correct format
- I IBEVDT="" S IBER=IBER_"IB049;"
- I IBEVDT]"",IBEVDT'?7N&(IBEVDT'?7N1".".N) S IBER=IBER_"IB049;"
- ;JWS;IB*2.0*623;add check for event date
- I IBER'["IB049",$$DTCK(IBEVDT) S IBER=IBER_"IB049;"
- ;
- ;Rate Type
- I IBAT="" S IBER=IBER_"IB059;"
- I IBAT]"",'$D(^DGCR(399.3,IBAT,0)) S IBER=IBER_"IB059;"
- I IBAT]"",$D(^DGCR(399.3,IBAT,0)),'$P(^(0),"^",6) S IBER=IBER_"IB059;",IBAT=""
- I IBAT]"",$P($G(^DGCR(399.3,IBAT,0)),"^",6) S IBARTP=$P($$CATN^PRCAFN($P(^DGCR(399.3,IBAT,0),"^",6)),"^",3)
- ;Check that AR category expects same debtor as defined in who's responsible.
- I $D(IBARTP),IBWHO="i"&(IBARTP'="T")!(IBWHO="p"&("PC"'[IBARTP))!(IBWHO="o"&(IBARTP'="N")) S IBER=IBER_"IB058;"
- ;
- ;Who's Responsible
- I IBWHO=""!($L(IBWHO)>1)!("iop"'[IBWHO) S IBER=IBER_"IB065;"
- S IBMRA=$S($$MCRWNR^IBEFUNC(+$$CURR^IBCEF2(IBIFN)):$$TXMT^IBCEF4(IBIFN)>0,1:0)
- ; MCR will not reimburse is only valid if there is subsequent insurance
- ; that will reimburse
- I IBWHO="i" D
- . ;JWS;IB*2.0*592;US1109; If Dental and Plan Coverage Limitation is NO skip; IA# 3820
- . I $$FT^IBCEF(IBIFN)=7 D
- .. N INSONBIL,LOOP
- .. ;JWS;IB*2.0*592;; only want to check insurance on the bill at this point
- .. F LOOP="I1","I2","I3" I $D(^DGCR(399,IBIFN,LOOP)) K INSONBIL S INSONBIL(+^(LOOP))="" I '$$PTCOV^IBCNSU3(DFN,$P($G(^DGCR(399,IBIFN,0)),"^",3),"DENTAL",,.INSONBIL),IBER'["IB362" S IBER=IBER_"IB362;"
- . I IBMRA D Q
- .. ;JWS;IB*2.0*592;Do not allow to bill Dental to Medicare WNR
- .. I $$FT^IBCEF(IBIFN)=7,'$F(IBER,"IB359;") S IBER=IBER_"IB359;"
- .. N Z,IBZ
- .. S IBZ=0
- .. F Z=$$COBN^IBCEF(IBIFN):1:3 I $D(^DGCR(399,IBIFN,"I"_(Z+1))),$P($G(^DIC(36,+$G(^DGCR(399,IBIFN,"I"_(Z+1))),0)),U,2)'="N" S IBZ=1 Q
- .. I 'IBZ S IBER=IBER_"IB054;" D WARN^IBCBB11("A valid claim for MEDICARE WNR needs subsequent ins. that will reimburse")
- . I $$COB^IBCEF(IBIFN)="S",$$MCRWNR^IBEFUNC(+$$CURR^IBCEF2(IBIFN))=1,$D(^DGCR(399,IBIFN,"I3")) Q
- . I $S('IBNDMP:1,1:$P(IBNDMP,U,2)'=$$BPP^IBCNS2(IBIFN,1)) S IBER=IBER_"IB054;"
- I IBWHO="o",'$P(IBNDM,"^",11) S IBER=IBER_"IB053;"
- ;
- ; Outpatient Statement dates can not span the ICD-10 activation date
- I IBCL>2,$$ICD10S^IBCU4(IBFDT,IBTDT) S IBER=IBER_"IB354;"
- ;
- ; All bill ICD codes must match Code Version on Statement To Date IB356
- D ICD10V^IBCBB0(IBIFN)
- ;
- ; Billing Provider check - IB*2*400
- D BP^IBCBB0(IBIFN)
- ;
- ; Pay-to Provider check - IB*2*400
- D PAYTO^IBCBB0(IBIFN)
- ;
- ; All insurance subscribers must have a birth date on file
- ; - 11/10/04 - IB*2.0*288
- ; - 12/14/06 - IB*2.0*361 - must have INSURED'S SEX too
- ; IB error codes
- ; IB221 - Primary insurance subscriber missing date of birth
- ; IB222 - Secondary insurance subscriber missing date of birth
- ; IB223 - Tertiary insurance subscriber missing date of birth
- ; IB261 - Primary insurance subscriber is missing INSURED'S SEX
- ; IB262 - Secondary insurance subscriber is missing INSURED'S SEX
- ; IB263 - Tertiary insurance subscriber is missing INSURED'S SEX
- ;
- F IBISEQ=1:1:3 D
- . I '$P($G(^DGCR(399,IBIFN,"I"_IBISEQ)),U,1) Q ; no insurance here
- . K ^UTILITY("VADM",$J),^UTILITY("VAPA",$J)
- . S IDDATA=$$INSDEM^IBCEF(IBIFN,IBISEQ)
- . K ^UTILITY("VADM",$J),^UTILITY("VAPA",$J)
- . ;
- . I '$P(IDDATA,U,1) D ERR(221) ; birth date missing
- . ;IB*2.0*623;JWS;date validation
- . I $$DTCK($P(IDDATA,U)) S IBER=IBER_"IB367;"
- . ;
- . I "^M^F^"'[(U_$P(IDDATA,U,2)_U) D ERR(261) ; sex missing
- . ;
- . ; IB*2*371 - esg - check for other missing insurance pieces
- . ; check insured's name, primary ID#, pt. relationship to insured,
- . ; and subscriber address data
- . N INNAME,SUBID,PTREL,SFA,CAS,LN,FN
- . ;
- . ; IB273 - Primary Insurance name of insured missing
- . ; IB274 - Secondary Insurance name of insured missing
- . ; IB275 - Tertiary Insurance name of insured missing
- . S INNAME=$$POLICY^IBCEF(IBIFN,17,IBISEQ)
- . S LN=$P(INNAME,",",1),FN=$P(INNAME,",",2) ; last name,first name
- . S LN=$$NOPUNCT^IBCEF(LN,1)
- . S FN=$$NOPUNCT^IBCEF(FN,1)
- . ; ib*2.0*547 - subscriber only needs last name
- . ;I LN=""!(FN="") D ERR(273) ; name of insured missing or invalid
- . I LN="" D ERR(273) ; name of insured missing or invalid
- . S LN=$$NAME^IBCEFG1(INNAME) ; additional name checks
- . S FN=$P(LN,U,2)
- . S LN=$P(LN,U,1)
- . ;I LN=""!(FN="") D ERR(273) ; name of insured missing or invalid
- . I LN="" D ERR(273) ; name of insured missing or invalid
- . ;
- . ; IB276 - Primary Insurance subscriber ID missing
- . ; IB277 - Secondary Insurance subscriber ID missing
- . ; IB278 - Tertiary Insurance subscriber ID missing
- . S SUBID=$$NOPUNCT^IBCEF($$POLICY^IBCEF(IBIFN,2,IBISEQ),1)
- . I SUBID="" D ERR(276) ; subscriber ID# missing
- . ;
- . ; IB279 - Primary Insurance missing pt relationship
- . ; IB280 - Secondary Insurance missing pt relationship
- . ; IB281 - Tertiary Insurance missing pt relationship
- . S PTREL=$$POLICY^IBCEF(IBIFN,16,IBISEQ)
- . I PTREL="" D ERR(279) ; missing patient relationship to insured
- . ;
- . ; subscriber address section
- . S SFA=$$INSADDR^IBCEF(IBIFN,IBISEQ) ; full address all pieces
- . S CAS=$$NOPUNCT^IBCEF($P(SFA,U,2,5),1) ; string city,st,zip,addr1
- . ;
- . ; IB282 - Primary Insurance address line 1 missing
- . ; IB283 - Secondary Insurance address line 1 missing
- . ; IB284 - Tertiary Insurance address line 1 missing
- . I $$NOPUNCT^IBCEF($P(SFA,U,5),1)="" D ; address line 1 is blank
- .. ; pat=subscriber and current insurance - address is required
- .. I +PTREL=1,IBISEQ=$$COBN^IBCEF(IBIFN) D ERR(282) Q
- .. ; if any part of the address is there, then all fields are required
- .. I CAS'="" D ERR(282) Q
- .. Q
- . ;
- . ; IB285 - Primary Insurance city missing
- . ; IB286 - Secondary Insurance city missing
- . ; IB287 - Tertiary Insurance city missing
- . I $$NOPUNCT^IBCEF($P(SFA,U,2),1)="" D ; city is blank
- .. ; pat=subscriber and current insurance - address is required
- .. I +PTREL=1,IBISEQ=$$COBN^IBCEF(IBIFN) D ERR(285) Q
- .. ; if any part of the address is there, then all fields are required
- .. I CAS'="" D ERR(285) Q
- .. Q
- . ;
- . ; IB288 - Primary Insurance state missing
- . ; IB289 - Secondary Insurance state missing
- . ; IB290 - Tertiary Insurance state missing
- . I $$NOPUNCT^IBCEF($P(SFA,U,3),1)="" D ; state is blank
- .. ; pat=subscriber and current insurance - address is required
- .. I +PTREL=1,IBISEQ=$$COBN^IBCEF(IBIFN) D ERR(288) Q
- .. ; if any part of the address is there, then all fields are required
- .. I CAS'="" D ERR(288) Q
- .. Q
- . ;
- . ; IB291 - Primary Insurance zipcode missing
- . ; IB292 - Secondary Insurance zipcode missing
- . ; IB293 - Tertiary Insurance zipcode missing
- . I $$NOPUNCT^IBCEF($P(SFA,U,4),1)="" D ; zipcode is blank
- .. ; pat=subscriber and current insurance - address is required
- .. I +PTREL=1,IBISEQ=$$COBN^IBCEF(IBIFN) D ERR(291) Q
- .. ; if any part of the address is there, then all fields are required
- .. I CAS'="" D ERR(291) Q
- .. Q
- . ;
- . Q
- ;
- ; esg - IB*2*371 - check patient address fields
- K ^UTILITY("VAPA",$J)
- ;
- S IBFOR=0 ; foreign address flag
- S IBC=+$$PTADDR^IBCEF(IBIFN,25) ; country code ien
- I IBC D
- . N CODE
- . S CODE=$$GET1^DIQ(779.004,IBC,.01) ; .01 code field file 779.004
- . I CODE'="",CODE'="USA" S IBFOR=1 ; foreign country exists
- . Q
- ;
- I $$NOPUNCT^IBCEF($$PTADDR^IBCEF(IBIFN,1),1)="" S IBER=IBER_"IB269;"
- I $$NOPUNCT^IBCEF($$PTADDR^IBCEF(IBIFN,4),1)="" S IBER=IBER_"IB270;"
- I $$NOPUNCT^IBCEF($$PTADDR^IBCEF(IBIFN,5),1)="",'IBFOR S IBER=IBER_"IB271;"
- I $$NOPUNCT^IBCEF($$PTADDR^IBCEF(IBIFN,11),1)="",'IBFOR S IBER=IBER_"IB272;"
- K ^UTILITY("VAPA",$J)
- ;
- D PAYERADD^IBCBB0(IBIFN) ; check the payer addresses
- D ^IBCBB1
- Q
- ; The remaining code below is being removed with Patch IB*2.0*432.
- ;
- ; esg - 9/20/07 - IB patch 371 - prevent EDI transmission for 3 payer
- ; claims for all but the first payer. To be removed when Emdeon
- ; and FSC are able to deal with these.
- ;
- I +$G(^DGCR(399,IBIFN,"I2")),+$G(^DGCR(399,IBIFN,"I3")),$$TXMT^IBCEF4(IBIFN) D
- . ; for MRA request claims, make sure the MRA secondary claim is forced to print
- . I $$REQMRA^IBEFUNC(IBIFN) D Q
- .. I '$P($G(^DGCR(399,IBIFN,"TX")),U,9) S IBER=IBER_"IB146;"
- .. Q
- . ;
- . I $$COBN^IBCEF(IBIFN)=1 Q ; primary payer sequence claims are OK
- . ;
- . ; But claims with a payer sequence of 2 or 3 need to print locally
- . S IBER=IBER_"IB147;"
- . Q
- ;
- Q
- ;
- EDIT(IBIFN) ; Run edits from within the billing edit screens
- N IBVIEW,IBDISP,IBNOFIX,DIR,X,Y
- S (IBNOFIX,IBVIEW,IBDISP)=1
- D EDITS^IBCB2
- W ! S DIR("A")="Press RETURN to continue",DIR(0)="E" D ^DIR K DIR
- Q
- ;
- TOB(IBND0) ;
- ; IBND0 = the 0-node of the bill (file 399)
- Q ($P(IBND0,U,24)_$P($G(^DGCR(399.1,+$P(IBND0,U,25),0)),U,2)_$P(IBND0,U,26))
- ;
- ERR(Z) ; update IBER variable from the above insurance checks
- ; Z is the IB error code# for the primary insurance error
- N IBERRNO
- S IBERRNO="IB"_(Z+IBISEQ-1)
- I IBER[IBERRNO Q
- S IBER=IBER_IBERRNO_";"
- Q
- ;
- DTCK(DATE) ; IB*2.0*623 - check for valid date
- I DATE="" Q 0
- S X=DATE D H^%DTC
- I %Y=-1 Q 1
- Q 0
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCBB 12039 printed Jan 18, 2025@03:09:57 Page 2
- IBCBB ;ALB/AAS - EDIT CHECK ROUTINE TO BE INVOKED BEFORE ALL BILL APPROVAL ACTIONS ;2-NOV-89
- +1 ;;2.0;INTEGRATED BILLING;**80,51,137,288,327,361,371,377,400,432,461,547,592,623**;21-MAR-94;Build 70
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 ;MAP TO DGCRBB
- +5 ;
- +6 ;IBNDn = IBND(n) = ^ib(399,n)
- +7 ;RETURNS:
- +8 ;IBER=fields with errors separated by semi-colons
- +9 ;PRCASV("OKAY")=1 if iber="" and $D(prcasv("array")) compete
- +10 ;
- GVAR ;set up variables for mccr
- +1 if '$DATA(IBIFN)
- QUIT
- FOR I=0,"M","U","U1","S","MP","TX","UF3","UF31","U2"
- SET @("IBND"_I)=$GET(^DGCR(399,IBIFN,I))
- +2 SET IBBNO=$PIECE(IBND0,"^")
- SET DFN=$PIECE(IBND0,"^",2)
- SET IBEVDT=$PIECE(IBND0,"^",3)
- +3 SET IBLOC=$PIECE(IBND0,"^",4)
- SET IBCL=$PIECE(IBND0,"^",5)
- SET IBTF=$PIECE(IBND0,"^",6)
- +4 SET IBAT=$PIECE(IBND0,"^",7)
- SET IBWHO=$PIECE(IBND0,"^",11)
- SET IBST=$PIECE(IBND0,"^",13)
- SET IBFT=$PIECE(IBND0,"^",19)
- +5 SET IBFDT=$PIECE(IBNDU,"^",1)
- SET IBTDT=$PIECE(IBNDU,"^",2)
- +6 SET IBTC=$PIECE(IBNDU1,"^",1)
- SET IBFY=$PIECE(IBNDU1,"^",9)
- SET IBFYC=$PIECE(IBNDU1,"^",10)
- +7 SET IBEU=$PIECE(IBNDS,"^",2)
- SET IBRU=$PIECE(IBNDS,"^",5)
- SET IBAU=$PIECE(IBNDS,"^",8)
- +8 SET IBTOB=$$TOB(IBND0)
- SET IBTOB12=$EXTRACT(IBTOB,1,2)
- +9 KILL ^TMP($JOB,"BILL-WARN")
- +10 QUIT
- +11 ;
- EN ;Entry to check for errors
- +1 NEW IBQ,IBXERR,IBXDATA,IBXSAVE,IBZPRC92,IBQUIT,IBISEQ,IDDATA,IBFOR,IBC,IBDX,IBDX1
- +2 IF $DATA(IBFL)
- NEW IBFL
- +3 KILL ^TMP($JOB)
- +4 WRITE !
- +5 SET IBER=""
- DO GVAR
- IF '$DATA(IBND0)
- SET IBER=-1
- QUIT
- +6 ;
- +7 ;patient in patient file
- +8 IF DFN=""
- SET IBER=IBER_"IB057;"
- +9 IF DFN]""
- IF '$DATA(^DPT(DFN))
- SET IBER=IBER_"IB057;"
- +10 ;IB*2.0*623;check date fields for validity;begin
- +11 IF $$DTCK($$GET1^DIQ(2,DFN_",",.03,"I"))
- SET IBER=IBER_"IB368;"
- +12 IF $$DTCK($$GET1^DIQ(2,DFN_",",.351,"I"))
- SET IBER=IBER_"IB369;"
- +13 SET IBDX=0
- FOR
- SET IBDX=$ORDER(^DPT(DFN,.312,IBDX))
- if 'IBDX
- QUIT
- Begin DoDot:1
- +14 SET IBDX1=$$GET1^DIQ(2.312,IBDX_","_DFN_",",3.01,"I")
- +15 IF $$DTCK(IBDX1)
- SET IBER=IBER_"IB366;"
- +16 QUIT
- End DoDot:1
- +17 IF $$DTCK($$GET1^DIQ(399,IBIFN_",",151,"I"))
- SET IBER=IBER_"IB370;"
- +18 IF $$DTCK($$GET1^DIQ(399,IBIFN_",",152,"I"))
- SET IBER=IBER_"IB371;"
- +19 IF $$DTCK($$GET1^DIQ(399,IBIFN_",",166,"I"))
- SET IBER=IBER_"IB372;"
- +20 IF $$DTCK($$GET1^DIQ(399,IBIFN_",",167,"I"))
- SET IBER=IBER_"IB373;"
- +21 IF $$DTCK($$GET1^DIQ(399,IBIFN_",",246,"I"))
- SET IBER=IBER_"IB374;"
- +22 IF $$DTCK($$GET1^DIQ(399,IBIFN_",",245,"I"))
- SET IBER=IBER_"IB375;"
- +23 IF $$DTCK($$GET1^DIQ(399,IBIFN_",",247,"I"))
- SET IBER=IBER_"IB376;"
- +24 IF $$DTCK($$GET1^DIQ(399,IBIFN_",",263,"I"))
- SET IBER=IBER_"IB377;"
- +25 IF $$DTCK($$GET1^DIQ(399,IBIFN_",",264,"I"))
- SET IBER=IBER_"IB378;"
- +26 IF $$DTCK($$GET1^DIQ(399,IBIFN_",",282,"I"))
- SET IBER=IBER_"IB379;"
- +27 IF $$DTCK($$GET1^DIQ(399,IBIFN_",",283,"I"))
- SET IBER=IBER_"IB380;"
- +28 IF $$DTCK($$GET1^DIQ(399,IBIFN_",",262,"I"))
- SET IBER=IBER_"IB381;"
- +29 IF $$DTCK($$GET1^DIQ(399,IBIFN_",",237,"I"))
- SET IBER=IBER_"IB382;"
- +30 ;
- +31 ;end;IB*2.0*623
- +32 ;
- +33 ;Event date in correct format
- +34 IF IBEVDT=""
- SET IBER=IBER_"IB049;"
- +35 IF IBEVDT]""
- IF IBEVDT'?7N&(IBEVDT'?7N1".".N)
- SET IBER=IBER_"IB049;"
- +36 ;JWS;IB*2.0*623;add check for event date
- +37 IF IBER'["IB049"
- IF $$DTCK(IBEVDT)
- SET IBER=IBER_"IB049;"
- +38 ;
- +39 ;Rate Type
- +40 IF IBAT=""
- SET IBER=IBER_"IB059;"
- +41 IF IBAT]""
- IF '$DATA(^DGCR(399.3,IBAT,0))
- SET IBER=IBER_"IB059;"
- +42 IF IBAT]""
- IF $DATA(^DGCR(399.3,IBAT,0))
- IF '$PIECE(^(0),"^",6)
- SET IBER=IBER_"IB059;"
- SET IBAT=""
- +43 IF IBAT]""
- IF $PIECE($GET(^DGCR(399.3,IBAT,0)),"^",6)
- SET IBARTP=$PIECE($$CATN^PRCAFN($PIECE(^DGCR(399.3,IBAT,0),"^",6)),"^",3)
- +44 ;Check that AR category expects same debtor as defined in who's responsible.
- +45 IF $DATA(IBARTP)
- IF IBWHO="i"&(IBARTP'="T")!(IBWHO="p"&("PC"'[IBARTP))!(IBWHO="o"&(IBARTP'="N"))
- SET IBER=IBER_"IB058;"
- +46 ;
- +47 ;Who's Responsible
- +48 IF IBWHO=""!($LENGTH(IBWHO)>1)!("iop"'[IBWHO)
- SET IBER=IBER_"IB065;"
- +49 SET IBMRA=$SELECT($$MCRWNR^IBEFUNC(+$$CURR^IBCEF2(IBIFN)):$$TXMT^IBCEF4(IBIFN)>0,1:0)
- +50 ; MCR will not reimburse is only valid if there is subsequent insurance
- +51 ; that will reimburse
- +52 IF IBWHO="i"
- Begin DoDot:1
- +53 ;JWS;IB*2.0*592;US1109; If Dental and Plan Coverage Limitation is NO skip; IA# 3820
- +54 IF $$FT^IBCEF(IBIFN)=7
- Begin DoDot:2
- +55 NEW INSONBIL,LOOP
- +56 ;JWS;IB*2.0*592;; only want to check insurance on the bill at this point
- +57 FOR LOOP="I1","I2","I3"
- IF $DATA(^DGCR(399,IBIFN,LOOP))
- KILL INSONBIL
- SET INSONBIL(+^(LOOP))=""
- IF '$$PTCOV^IBCNSU3(DFN,$PIECE($GET(^DGCR(399,IBIFN,0)),"^",3),"DENTAL",,.INSONBIL)
- IF IBER'["IB362"
- SET IBER=IBER_"IB362;"
- End DoDot:2
- +58 IF IBMRA
- Begin DoDot:2
- +59 ;JWS;IB*2.0*592;Do not allow to bill Dental to Medicare WNR
- +60 IF $$FT^IBCEF(IBIFN)=7
- IF '$FIND(IBER,"IB359;")
- SET IBER=IBER_"IB359;"
- +61 NEW Z,IBZ
- +62 SET IBZ=0
- +63 FOR Z=$$COBN^IBCEF(IBIFN):1:3
- IF $DATA(^DGCR(399,IBIFN,"I"_(Z+1)))
- IF $PIECE($GET(^DIC(36,+$GET(^DGCR(399,IBIFN,"I"_(Z+1))),0)),U,2)'="N"
- SET IBZ=1
- QUIT
- +64 IF 'IBZ
- SET IBER=IBER_"IB054;"
- DO WARN^IBCBB11("A valid claim for MEDICARE WNR needs subsequent ins. that will reimburse")
- End DoDot:2
- QUIT
- +65 IF $$COB^IBCEF(IBIFN)="S"
- IF $$MCRWNR^IBEFUNC(+$$CURR^IBCEF2(IBIFN))=1
- IF $DATA(^DGCR(399,IBIFN,"I3"))
- QUIT
- +66 IF $SELECT('IBNDMP:1,1:$PIECE(IBNDMP,U,2)'=$$BPP^IBCNS2(IBIFN,1))
- SET IBER=IBER_"IB054;"
- End DoDot:1
- +67 IF IBWHO="o"
- IF '$PIECE(IBNDM,"^",11)
- SET IBER=IBER_"IB053;"
- +68 ;
- +69 ; Outpatient Statement dates can not span the ICD-10 activation date
- +70 IF IBCL>2
- IF $$ICD10S^IBCU4(IBFDT,IBTDT)
- SET IBER=IBER_"IB354;"
- +71 ;
- +72 ; All bill ICD codes must match Code Version on Statement To Date IB356
- +73 DO ICD10V^IBCBB0(IBIFN)
- +74 ;
- +75 ; Billing Provider check - IB*2*400
- +76 DO BP^IBCBB0(IBIFN)
- +77 ;
- +78 ; Pay-to Provider check - IB*2*400
- +79 DO PAYTO^IBCBB0(IBIFN)
- +80 ;
- +81 ; All insurance subscribers must have a birth date on file
- +82 ; - 11/10/04 - IB*2.0*288
- +83 ; - 12/14/06 - IB*2.0*361 - must have INSURED'S SEX too
- +84 ; IB error codes
- +85 ; IB221 - Primary insurance subscriber missing date of birth
- +86 ; IB222 - Secondary insurance subscriber missing date of birth
- +87 ; IB223 - Tertiary insurance subscriber missing date of birth
- +88 ; IB261 - Primary insurance subscriber is missing INSURED'S SEX
- +89 ; IB262 - Secondary insurance subscriber is missing INSURED'S SEX
- +90 ; IB263 - Tertiary insurance subscriber is missing INSURED'S SEX
- +91 ;
- +92 FOR IBISEQ=1:1:3
- Begin DoDot:1
- +93 ; no insurance here
- IF '$PIECE($GET(^DGCR(399,IBIFN,"I"_IBISEQ)),U,1)
- QUIT
- +94 KILL ^UTILITY("VADM",$JOB),^UTILITY("VAPA",$JOB)
- +95 SET IDDATA=$$INSDEM^IBCEF(IBIFN,IBISEQ)
- +96 KILL ^UTILITY("VADM",$JOB),^UTILITY("VAPA",$JOB)
- +97 ;
- +98 ; birth date missing
- IF '$PIECE(IDDATA,U,1)
- DO ERR(221)
- +99 ;IB*2.0*623;JWS;date validation
- +100 IF $$DTCK($PIECE(IDDATA,U))
- SET IBER=IBER_"IB367;"
- +101 ;
- +102 ; sex missing
- IF "^M^F^"'[(U_$PIECE(IDDATA,U,2)_U)
- DO ERR(261)
- +103 ;
- +104 ; IB*2*371 - esg - check for other missing insurance pieces
- +105 ; check insured's name, primary ID#, pt. relationship to insured,
- +106 ; and subscriber address data
- +107 NEW INNAME,SUBID,PTREL,SFA,CAS,LN,FN
- +108 ;
- +109 ; IB273 - Primary Insurance name of insured missing
- +110 ; IB274 - Secondary Insurance name of insured missing
- +111 ; IB275 - Tertiary Insurance name of insured missing
- +112 SET INNAME=$$POLICY^IBCEF(IBIFN,17,IBISEQ)
- +113 ; last name,first name
- SET LN=$PIECE(INNAME,",",1)
- SET FN=$PIECE(INNAME,",",2)
- +114 SET LN=$$NOPUNCT^IBCEF(LN,1)
- +115 SET FN=$$NOPUNCT^IBCEF(FN,1)
- +116 ; ib*2.0*547 - subscriber only needs last name
- +117 ;I LN=""!(FN="") D ERR(273) ; name of insured missing or invalid
- +118 ; name of insured missing or invalid
- IF LN=""
- DO ERR(273)
- +119 ; additional name checks
- SET LN=$$NAME^IBCEFG1(INNAME)
- +120 SET FN=$PIECE(LN,U,2)
- +121 SET LN=$PIECE(LN,U,1)
- +122 ;I LN=""!(FN="") D ERR(273) ; name of insured missing or invalid
- +123 ; name of insured missing or invalid
- IF LN=""
- DO ERR(273)
- +124 ;
- +125 ; IB276 - Primary Insurance subscriber ID missing
- +126 ; IB277 - Secondary Insurance subscriber ID missing
- +127 ; IB278 - Tertiary Insurance subscriber ID missing
- +128 SET SUBID=$$NOPUNCT^IBCEF($$POLICY^IBCEF(IBIFN,2,IBISEQ),1)
- +129 ; subscriber ID# missing
- IF SUBID=""
- DO ERR(276)
- +130 ;
- +131 ; IB279 - Primary Insurance missing pt relationship
- +132 ; IB280 - Secondary Insurance missing pt relationship
- +133 ; IB281 - Tertiary Insurance missing pt relationship
- +134 SET PTREL=$$POLICY^IBCEF(IBIFN,16,IBISEQ)
- +135 ; missing patient relationship to insured
- IF PTREL=""
- DO ERR(279)
- +136 ;
- +137 ; subscriber address section
- +138 ; full address all pieces
- SET SFA=$$INSADDR^IBCEF(IBIFN,IBISEQ)
- +139 ; string city,st,zip,addr1
- SET CAS=$$NOPUNCT^IBCEF($PIECE(SFA,U,2,5),1)
- +140 ;
- +141 ; IB282 - Primary Insurance address line 1 missing
- +142 ; IB283 - Secondary Insurance address line 1 missing
- +143 ; IB284 - Tertiary Insurance address line 1 missing
- +144 ; address line 1 is blank
- IF $$NOPUNCT^IBCEF($PIECE(SFA,U,5),1)=""
- Begin DoDot:2
- +145 ; pat=subscriber and current insurance - address is required
- +146 IF +PTREL=1
- IF IBISEQ=$$COBN^IBCEF(IBIFN)
- DO ERR(282)
- QUIT
- +147 ; if any part of the address is there, then all fields are required
- +148 IF CAS'=""
- DO ERR(282)
- QUIT
- +149 QUIT
- End DoDot:2
- +150 ;
- +151 ; IB285 - Primary Insurance city missing
- +152 ; IB286 - Secondary Insurance city missing
- +153 ; IB287 - Tertiary Insurance city missing
- +154 ; city is blank
- IF $$NOPUNCT^IBCEF($PIECE(SFA,U,2),1)=""
- Begin DoDot:2
- +155 ; pat=subscriber and current insurance - address is required
- +156 IF +PTREL=1
- IF IBISEQ=$$COBN^IBCEF(IBIFN)
- DO ERR(285)
- QUIT
- +157 ; if any part of the address is there, then all fields are required
- +158 IF CAS'=""
- DO ERR(285)
- QUIT
- +159 QUIT
- End DoDot:2
- +160 ;
- +161 ; IB288 - Primary Insurance state missing
- +162 ; IB289 - Secondary Insurance state missing
- +163 ; IB290 - Tertiary Insurance state missing
- +164 ; state is blank
- IF $$NOPUNCT^IBCEF($PIECE(SFA,U,3),1)=""
- Begin DoDot:2
- +165 ; pat=subscriber and current insurance - address is required
- +166 IF +PTREL=1
- IF IBISEQ=$$COBN^IBCEF(IBIFN)
- DO ERR(288)
- QUIT
- +167 ; if any part of the address is there, then all fields are required
- +168 IF CAS'=""
- DO ERR(288)
- QUIT
- +169 QUIT
- End DoDot:2
- +170 ;
- +171 ; IB291 - Primary Insurance zipcode missing
- +172 ; IB292 - Secondary Insurance zipcode missing
- +173 ; IB293 - Tertiary Insurance zipcode missing
- +174 ; zipcode is blank
- IF $$NOPUNCT^IBCEF($PIECE(SFA,U,4),1)=""
- Begin DoDot:2
- +175 ; pat=subscriber and current insurance - address is required
- +176 IF +PTREL=1
- IF IBISEQ=$$COBN^IBCEF(IBIFN)
- DO ERR(291)
- QUIT
- +177 ; if any part of the address is there, then all fields are required
- +178 IF CAS'=""
- DO ERR(291)
- QUIT
- +179 QUIT
- End DoDot:2
- +180 ;
- +181 QUIT
- End DoDot:1
- +182 ;
- +183 ; esg - IB*2*371 - check patient address fields
- +184 KILL ^UTILITY("VAPA",$JOB)
- +185 ;
- +186 ; foreign address flag
- SET IBFOR=0
- +187 ; country code ien
- SET IBC=+$$PTADDR^IBCEF(IBIFN,25)
- +188 IF IBC
- Begin DoDot:1
- +189 NEW CODE
- +190 ; .01 code field file 779.004
- SET CODE=$$GET1^DIQ(779.004,IBC,.01)
- +191 ; foreign country exists
- IF CODE'=""
- IF CODE'="USA"
- SET IBFOR=1
- +192 QUIT
- End DoDot:1
- +193 ;
- +194 IF $$NOPUNCT^IBCEF($$PTADDR^IBCEF(IBIFN,1),1)=""
- SET IBER=IBER_"IB269;"
- +195 IF $$NOPUNCT^IBCEF($$PTADDR^IBCEF(IBIFN,4),1)=""
- SET IBER=IBER_"IB270;"
- +196 IF $$NOPUNCT^IBCEF($$PTADDR^IBCEF(IBIFN,5),1)=""
- IF 'IBFOR
- SET IBER=IBER_"IB271;"
- +197 IF $$NOPUNCT^IBCEF($$PTADDR^IBCEF(IBIFN,11),1)=""
- IF 'IBFOR
- SET IBER=IBER_"IB272;"
- +198 KILL ^UTILITY("VAPA",$JOB)
- +199 ;
- +200 ; check the payer addresses
- DO PAYERADD^IBCBB0(IBIFN)
- +201 DO ^IBCBB1
- +202 QUIT
- +203 ; The remaining code below is being removed with Patch IB*2.0*432.
- +204 ;
- +205 ; esg - 9/20/07 - IB patch 371 - prevent EDI transmission for 3 payer
- +206 ; claims for all but the first payer. To be removed when Emdeon
- +207 ; and FSC are able to deal with these.
- +208 ;
- +209 IF +$GET(^DGCR(399,IBIFN,"I2"))
- IF +$GET(^DGCR(399,IBIFN,"I3"))
- IF $$TXMT^IBCEF4(IBIFN)
- Begin DoDot:1
- +210 ; for MRA request claims, make sure the MRA secondary claim is forced to print
- +211 IF $$REQMRA^IBEFUNC(IBIFN)
- Begin DoDot:2
- +212 IF '$PIECE($GET(^DGCR(399,IBIFN,"TX")),U,9)
- SET IBER=IBER_"IB146;"
- +213 QUIT
- End DoDot:2
- QUIT
- +214 ;
- +215 ; primary payer sequence claims are OK
- IF $$COBN^IBCEF(IBIFN)=1
- QUIT
- +216 ;
- +217 ; But claims with a payer sequence of 2 or 3 need to print locally
- +218 SET IBER=IBER_"IB147;"
- +219 QUIT
- End DoDot:1
- +220 ;
- +221 QUIT
- +222 ;
- EDIT(IBIFN) ; Run edits from within the billing edit screens
- +1 NEW IBVIEW,IBDISP,IBNOFIX,DIR,X,Y
- +2 SET (IBNOFIX,IBVIEW,IBDISP)=1
- +3 DO EDITS^IBCB2
- +4 WRITE !
- SET DIR("A")="Press RETURN to continue"
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- +5 QUIT
- +6 ;
- TOB(IBND0) ;
- +1 ; IBND0 = the 0-node of the bill (file 399)
- +2 QUIT ($PIECE(IBND0,U,24)_$PIECE($GET(^DGCR(399.1,+$PIECE(IBND0,U,25),0)),U,2)_$PIECE(IBND0,U,26))
- +3 ;
- ERR(Z) ; update IBER variable from the above insurance checks
- +1 ; Z is the IB error code# for the primary insurance error
- +2 NEW IBERRNO
- +3 SET IBERRNO="IB"_(Z+IBISEQ-1)
- +4 IF IBER[IBERRNO
- QUIT
- +5 SET IBER=IBER_IBERRNO_";"
- +6 QUIT
- +7 ;
- DTCK(DATE) ; IB*2.0*623 - check for valid date
- +1 IF DATE=""
- QUIT 0
- +2 SET X=DATE
- DO H^%DTC
- +3 IF %Y=-1
- QUIT 1
- +4 QUIT 0
- +5 ;