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

IBCBB.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;MAP TO DGCRBB
  1. ;
  1. ;IBNDn = IBND(n) = ^ib(399,n)
  1. ;RETURNS:
  1. ;IBER=fields with errors separated by semi-colons
  1. ;PRCASV("OKAY")=1 if iber="" and $D(prcasv("array")) compete
  1. ;
  1. GVAR ;set up variables for mccr
  1. Q:'$D(IBIFN) F I=0,"M","U","U1","S","MP","TX","UF3","UF31","U2" S @("IBND"_I)=$G(^DGCR(399,IBIFN,I))
  1. S IBBNO=$P(IBND0,"^"),DFN=$P(IBND0,"^",2),IBEVDT=$P(IBND0,"^",3)
  1. S IBLOC=$P(IBND0,"^",4),IBCL=$P(IBND0,"^",5),IBTF=$P(IBND0,"^",6)
  1. S IBAT=$P(IBND0,"^",7),IBWHO=$P(IBND0,"^",11),IBST=$P(IBND0,"^",13),IBFT=$P(IBND0,"^",19)
  1. S IBFDT=$P(IBNDU,"^",1),IBTDT=$P(IBNDU,"^",2)
  1. S IBTC=$P(IBNDU1,"^",1),IBFY=$P(IBNDU1,"^",9),IBFYC=$P(IBNDU1,"^",10)
  1. S IBEU=$P(IBNDS,"^",2),IBRU=$P(IBNDS,"^",5),IBAU=$P(IBNDS,"^",8)
  1. S IBTOB=$$TOB(IBND0),IBTOB12=$E(IBTOB,1,2)
  1. K ^TMP($J,"BILL-WARN")
  1. Q
  1. ;
  1. EN ;Entry to check for errors
  1. N IBQ,IBXERR,IBXDATA,IBXSAVE,IBZPRC92,IBQUIT,IBISEQ,IDDATA,IBFOR,IBC,IBDX,IBDX1
  1. I $D(IBFL) N IBFL
  1. K ^TMP($J)
  1. W !
  1. S IBER="" D GVAR I '$D(IBND0) S IBER=-1 Q
  1. ;
  1. ;patient in patient file
  1. I DFN="" S IBER=IBER_"IB057;"
  1. I DFN]"",'$D(^DPT(DFN)) S IBER=IBER_"IB057;"
  1. ;IB*2.0*623;check date fields for validity;begin
  1. I $$DTCK($$GET1^DIQ(2,DFN_",",.03,"I")) S IBER=IBER_"IB368;"
  1. I $$DTCK($$GET1^DIQ(2,DFN_",",.351,"I")) S IBER=IBER_"IB369;"
  1. S IBDX=0 F S IBDX=$O(^DPT(DFN,.312,IBDX)) Q:'IBDX D
  1. . S IBDX1=$$GET1^DIQ(2.312,IBDX_","_DFN_",",3.01,"I")
  1. . I $$DTCK(IBDX1) S IBER=IBER_"IB366;"
  1. . Q
  1. I $$DTCK($$GET1^DIQ(399,IBIFN_",",151,"I")) S IBER=IBER_"IB370;"
  1. I $$DTCK($$GET1^DIQ(399,IBIFN_",",152,"I")) S IBER=IBER_"IB371;"
  1. I $$DTCK($$GET1^DIQ(399,IBIFN_",",166,"I")) S IBER=IBER_"IB372;"
  1. I $$DTCK($$GET1^DIQ(399,IBIFN_",",167,"I")) S IBER=IBER_"IB373;"
  1. I $$DTCK($$GET1^DIQ(399,IBIFN_",",246,"I")) S IBER=IBER_"IB374;"
  1. I $$DTCK($$GET1^DIQ(399,IBIFN_",",245,"I")) S IBER=IBER_"IB375;"
  1. I $$DTCK($$GET1^DIQ(399,IBIFN_",",247,"I")) S IBER=IBER_"IB376;"
  1. I $$DTCK($$GET1^DIQ(399,IBIFN_",",263,"I")) S IBER=IBER_"IB377;"
  1. I $$DTCK($$GET1^DIQ(399,IBIFN_",",264,"I")) S IBER=IBER_"IB378;"
  1. I $$DTCK($$GET1^DIQ(399,IBIFN_",",282,"I")) S IBER=IBER_"IB379;"
  1. I $$DTCK($$GET1^DIQ(399,IBIFN_",",283,"I")) S IBER=IBER_"IB380;"
  1. I $$DTCK($$GET1^DIQ(399,IBIFN_",",262,"I")) S IBER=IBER_"IB381;"
  1. I $$DTCK($$GET1^DIQ(399,IBIFN_",",237,"I")) S IBER=IBER_"IB382;"
  1. ;
  1. ;end;IB*2.0*623
  1. ;
  1. ;Event date in correct format
  1. I IBEVDT="" S IBER=IBER_"IB049;"
  1. I IBEVDT]"",IBEVDT'?7N&(IBEVDT'?7N1".".N) S IBER=IBER_"IB049;"
  1. ;JWS;IB*2.0*623;add check for event date
  1. I IBER'["IB049",$$DTCK(IBEVDT) S IBER=IBER_"IB049;"
  1. ;
  1. ;Rate Type
  1. I IBAT="" S IBER=IBER_"IB059;"
  1. I IBAT]"",'$D(^DGCR(399.3,IBAT,0)) S IBER=IBER_"IB059;"
  1. I IBAT]"",$D(^DGCR(399.3,IBAT,0)),'$P(^(0),"^",6) S IBER=IBER_"IB059;",IBAT=""
  1. I IBAT]"",$P($G(^DGCR(399.3,IBAT,0)),"^",6) S IBARTP=$P($$CATN^PRCAFN($P(^DGCR(399.3,IBAT,0),"^",6)),"^",3)
  1. ;Check that AR category expects same debtor as defined in who's responsible.
  1. I $D(IBARTP),IBWHO="i"&(IBARTP'="T")!(IBWHO="p"&("PC"'[IBARTP))!(IBWHO="o"&(IBARTP'="N")) S IBER=IBER_"IB058;"
  1. ;
  1. ;Who's Responsible
  1. I IBWHO=""!($L(IBWHO)>1)!("iop"'[IBWHO) S IBER=IBER_"IB065;"
  1. S IBMRA=$S($$MCRWNR^IBEFUNC(+$$CURR^IBCEF2(IBIFN)):$$TXMT^IBCEF4(IBIFN)>0,1:0)
  1. ; MCR will not reimburse is only valid if there is subsequent insurance
  1. ; that will reimburse
  1. I IBWHO="i" D
  1. . ;JWS;IB*2.0*592;US1109; If Dental and Plan Coverage Limitation is NO skip; IA# 3820
  1. . I $$FT^IBCEF(IBIFN)=7 D
  1. .. N INSONBIL,LOOP
  1. .. ;JWS;IB*2.0*592;; only want to check insurance on the bill at this point
  1. .. 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;"
  1. . I IBMRA D Q
  1. .. ;JWS;IB*2.0*592;Do not allow to bill Dental to Medicare WNR
  1. .. I $$FT^IBCEF(IBIFN)=7,'$F(IBER,"IB359;") S IBER=IBER_"IB359;"
  1. .. N Z,IBZ
  1. .. S IBZ=0
  1. .. 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
  1. .. I 'IBZ S IBER=IBER_"IB054;" D WARN^IBCBB11("A valid claim for MEDICARE WNR needs subsequent ins. that will reimburse")
  1. . I $$COB^IBCEF(IBIFN)="S",$$MCRWNR^IBEFUNC(+$$CURR^IBCEF2(IBIFN))=1,$D(^DGCR(399,IBIFN,"I3")) Q
  1. . I $S('IBNDMP:1,1:$P(IBNDMP,U,2)'=$$BPP^IBCNS2(IBIFN,1)) S IBER=IBER_"IB054;"
  1. I IBWHO="o",'$P(IBNDM,"^",11) S IBER=IBER_"IB053;"
  1. ;
  1. ; Outpatient Statement dates can not span the ICD-10 activation date
  1. I IBCL>2,$$ICD10S^IBCU4(IBFDT,IBTDT) S IBER=IBER_"IB354;"
  1. ;
  1. ; All bill ICD codes must match Code Version on Statement To Date IB356
  1. D ICD10V^IBCBB0(IBIFN)
  1. ;
  1. ; Billing Provider check - IB*2*400
  1. D BP^IBCBB0(IBIFN)
  1. ;
  1. ; Pay-to Provider check - IB*2*400
  1. D PAYTO^IBCBB0(IBIFN)
  1. ;
  1. ; All insurance subscribers must have a birth date on file
  1. ; - 11/10/04 - IB*2.0*288
  1. ; - 12/14/06 - IB*2.0*361 - must have INSURED'S SEX too
  1. ; IB error codes
  1. ; IB221 - Primary insurance subscriber missing date of birth
  1. ; IB222 - Secondary insurance subscriber missing date of birth
  1. ; IB223 - Tertiary insurance subscriber missing date of birth
  1. ; IB261 - Primary insurance subscriber is missing INSURED'S SEX
  1. ; IB262 - Secondary insurance subscriber is missing INSURED'S SEX
  1. ; IB263 - Tertiary insurance subscriber is missing INSURED'S SEX
  1. ;
  1. F IBISEQ=1:1:3 D
  1. . I '$P($G(^DGCR(399,IBIFN,"I"_IBISEQ)),U,1) Q ; no insurance here
  1. . K ^UTILITY("VADM",$J),^UTILITY("VAPA",$J)
  1. . S IDDATA=$$INSDEM^IBCEF(IBIFN,IBISEQ)
  1. . K ^UTILITY("VADM",$J),^UTILITY("VAPA",$J)
  1. . ;
  1. . I '$P(IDDATA,U,1) D ERR(221) ; birth date missing
  1. . ;IB*2.0*623;JWS;date validation
  1. . I $$DTCK($P(IDDATA,U)) S IBER=IBER_"IB367;"
  1. . ;
  1. . I "^M^F^"'[(U_$P(IDDATA,U,2)_U) D ERR(261) ; sex missing
  1. . ;
  1. . ; IB*2*371 - esg - check for other missing insurance pieces
  1. . ; check insured's name, primary ID#, pt. relationship to insured,
  1. . ; and subscriber address data
  1. . N INNAME,SUBID,PTREL,SFA,CAS,LN,FN
  1. . ;
  1. . ; IB273 - Primary Insurance name of insured missing
  1. . ; IB274 - Secondary Insurance name of insured missing
  1. . ; IB275 - Tertiary Insurance name of insured missing
  1. . S INNAME=$$POLICY^IBCEF(IBIFN,17,IBISEQ)
  1. . S LN=$P(INNAME,",",1),FN=$P(INNAME,",",2) ; last name,first name
  1. . S LN=$$NOPUNCT^IBCEF(LN,1)
  1. . S FN=$$NOPUNCT^IBCEF(FN,1)
  1. . ; ib*2.0*547 - subscriber only needs last name
  1. . ;I LN=""!(FN="") D ERR(273) ; name of insured missing or invalid
  1. . I LN="" D ERR(273) ; name of insured missing or invalid
  1. . S LN=$$NAME^IBCEFG1(INNAME) ; additional name checks
  1. . S FN=$P(LN,U,2)
  1. . S LN=$P(LN,U,1)
  1. . ;I LN=""!(FN="") D ERR(273) ; name of insured missing or invalid
  1. . I LN="" D ERR(273) ; name of insured missing or invalid
  1. . ;
  1. . ; IB276 - Primary Insurance subscriber ID missing
  1. . ; IB277 - Secondary Insurance subscriber ID missing
  1. . ; IB278 - Tertiary Insurance subscriber ID missing
  1. . S SUBID=$$NOPUNCT^IBCEF($$POLICY^IBCEF(IBIFN,2,IBISEQ),1)
  1. . I SUBID="" D ERR(276) ; subscriber ID# missing
  1. . ;
  1. . ; IB279 - Primary Insurance missing pt relationship
  1. . ; IB280 - Secondary Insurance missing pt relationship
  1. . ; IB281 - Tertiary Insurance missing pt relationship
  1. . S PTREL=$$POLICY^IBCEF(IBIFN,16,IBISEQ)
  1. . I PTREL="" D ERR(279) ; missing patient relationship to insured
  1. . ;
  1. . ; subscriber address section
  1. . S SFA=$$INSADDR^IBCEF(IBIFN,IBISEQ) ; full address all pieces
  1. . S CAS=$$NOPUNCT^IBCEF($P(SFA,U,2,5),1) ; string city,st,zip,addr1
  1. . ;
  1. . ; IB282 - Primary Insurance address line 1 missing
  1. . ; IB283 - Secondary Insurance address line 1 missing
  1. . ; IB284 - Tertiary Insurance address line 1 missing
  1. . I $$NOPUNCT^IBCEF($P(SFA,U,5),1)="" D ; address line 1 is blank
  1. .. ; pat=subscriber and current insurance - address is required
  1. .. I +PTREL=1,IBISEQ=$$COBN^IBCEF(IBIFN) D ERR(282) Q
  1. .. ; if any part of the address is there, then all fields are required
  1. .. I CAS'="" D ERR(282) Q
  1. .. Q
  1. . ;
  1. . ; IB285 - Primary Insurance city missing
  1. . ; IB286 - Secondary Insurance city missing
  1. . ; IB287 - Tertiary Insurance city missing
  1. . I $$NOPUNCT^IBCEF($P(SFA,U,2),1)="" D ; city is blank
  1. .. ; pat=subscriber and current insurance - address is required
  1. .. I +PTREL=1,IBISEQ=$$COBN^IBCEF(IBIFN) D ERR(285) Q
  1. .. ; if any part of the address is there, then all fields are required
  1. .. I CAS'="" D ERR(285) Q
  1. .. Q
  1. . ;
  1. . ; IB288 - Primary Insurance state missing
  1. . ; IB289 - Secondary Insurance state missing
  1. . ; IB290 - Tertiary Insurance state missing
  1. . I $$NOPUNCT^IBCEF($P(SFA,U,3),1)="" D ; state is blank
  1. .. ; pat=subscriber and current insurance - address is required
  1. .. I +PTREL=1,IBISEQ=$$COBN^IBCEF(IBIFN) D ERR(288) Q
  1. .. ; if any part of the address is there, then all fields are required
  1. .. I CAS'="" D ERR(288) Q
  1. .. Q
  1. . ;
  1. . ; IB291 - Primary Insurance zipcode missing
  1. . ; IB292 - Secondary Insurance zipcode missing
  1. . ; IB293 - Tertiary Insurance zipcode missing
  1. . I $$NOPUNCT^IBCEF($P(SFA,U,4),1)="" D ; zipcode is blank
  1. .. ; pat=subscriber and current insurance - address is required
  1. .. I +PTREL=1,IBISEQ=$$COBN^IBCEF(IBIFN) D ERR(291) Q
  1. .. ; if any part of the address is there, then all fields are required
  1. .. I CAS'="" D ERR(291) Q
  1. .. Q
  1. . ;
  1. . Q
  1. ;
  1. ; esg - IB*2*371 - check patient address fields
  1. K ^UTILITY("VAPA",$J)
  1. ;
  1. S IBFOR=0 ; foreign address flag
  1. S IBC=+$$PTADDR^IBCEF(IBIFN,25) ; country code ien
  1. I IBC D
  1. . N CODE
  1. . S CODE=$$GET1^DIQ(779.004,IBC,.01) ; .01 code field file 779.004
  1. . I CODE'="",CODE'="USA" S IBFOR=1 ; foreign country exists
  1. . Q
  1. ;
  1. I $$NOPUNCT^IBCEF($$PTADDR^IBCEF(IBIFN,1),1)="" S IBER=IBER_"IB269;"
  1. I $$NOPUNCT^IBCEF($$PTADDR^IBCEF(IBIFN,4),1)="" S IBER=IBER_"IB270;"
  1. I $$NOPUNCT^IBCEF($$PTADDR^IBCEF(IBIFN,5),1)="",'IBFOR S IBER=IBER_"IB271;"
  1. I $$NOPUNCT^IBCEF($$PTADDR^IBCEF(IBIFN,11),1)="",'IBFOR S IBER=IBER_"IB272;"
  1. K ^UTILITY("VAPA",$J)
  1. ;
  1. D PAYERADD^IBCBB0(IBIFN) ; check the payer addresses
  1. D ^IBCBB1
  1. Q
  1. ; The remaining code below is being removed with Patch IB*2.0*432.
  1. ;
  1. ; esg - 9/20/07 - IB patch 371 - prevent EDI transmission for 3 payer
  1. ; claims for all but the first payer. To be removed when Emdeon
  1. ; and FSC are able to deal with these.
  1. ;
  1. I +$G(^DGCR(399,IBIFN,"I2")),+$G(^DGCR(399,IBIFN,"I3")),$$TXMT^IBCEF4(IBIFN) D
  1. . ; for MRA request claims, make sure the MRA secondary claim is forced to print
  1. . I $$REQMRA^IBEFUNC(IBIFN) D Q
  1. .. I '$P($G(^DGCR(399,IBIFN,"TX")),U,9) S IBER=IBER_"IB146;"
  1. .. Q
  1. . ;
  1. . I $$COBN^IBCEF(IBIFN)=1 Q ; primary payer sequence claims are OK
  1. . ;
  1. . ; But claims with a payer sequence of 2 or 3 need to print locally
  1. . S IBER=IBER_"IB147;"
  1. . Q
  1. ;
  1. Q
  1. ;
  1. EDIT(IBIFN) ; Run edits from within the billing edit screens
  1. N IBVIEW,IBDISP,IBNOFIX,DIR,X,Y
  1. S (IBNOFIX,IBVIEW,IBDISP)=1
  1. D EDITS^IBCB2
  1. W ! S DIR("A")="Press RETURN to continue",DIR(0)="E" D ^DIR K DIR
  1. Q
  1. ;
  1. TOB(IBND0) ;
  1. ; IBND0 = the 0-node of the bill (file 399)
  1. Q ($P(IBND0,U,24)_$P($G(^DGCR(399.1,+$P(IBND0,U,25),0)),U,2)_$P(IBND0,U,26))
  1. ;
  1. ERR(Z) ; update IBER variable from the above insurance checks
  1. ; Z is the IB error code# for the primary insurance error
  1. N IBERRNO
  1. S IBERRNO="IB"_(Z+IBISEQ-1)
  1. I IBER[IBERRNO Q
  1. S IBER=IBER_IBERRNO_";"
  1. Q
  1. ;
  1. DTCK(DATE) ; IB*2.0*623 - check for valid date
  1. I DATE="" Q 0
  1. S X=DATE D H^%DTC
  1. I %Y=-1 Q 1
  1. Q 0
  1. ;