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