- Timestamp:
- Dec 4, 2009, 8:26:01 PM (14 years ago)
- Location:
- FOIAVistA/tag/r
- Files:
-
- 1 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
FOIAVistA/tag/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCBB.m
r628 r636 1 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 232 ;;2.0;INTEGRATED BILLING;**80,51,137,288,327,361**;21-MAR-94;Build 9 3 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 4 ; … … 23 23 ; 24 24 EN ;Entry to check for errors 25 N IBQ,IBXERR,IBXDATA,IBXSAVE,IBZPRC92,IBQUIT,IBISEQ,IDDATA,IB FOR,IBC25 N IBQ,IBXERR,IBXDATA,IBXSAVE,IBZPRC92,IBQUIT,IBISEQ,IDDATA,IBERRNO 26 26 I $D(IBFL) N IBFL 27 27 K ^TMP($J) 28 28 W ! 29 29 S IBER="" D GVAR I '$D(IBND0) S IBER=-1 Q 30 ; 31 ;I $$ISPROS^IBCEF1(IBIFN) D 32 ;. D WARN^IBCBB11("Bill has prosthetics item(s) and will only print locally") 33 ;. I $$NEEDMRA^IBEFUNC(IBIFN) S IBQUIT=$$IBER^IBCBB3(.IBER,"098") 30 34 ; 31 35 ;patient in patient file … … 41 45 I IBAT]"",'$D(^DGCR(399.3,IBAT,0)) S IBER=IBER_"IB059;" 42 46 I IBAT]"",$D(^DGCR(399.3,IBAT,0)),'$P(^(0),"^",6) S IBER=IBER_"IB059;",IBAT="" 47 ;I IBAT]"",$D(^DGCR(399.3,IBAT,0)) S IBARTP=$P(^PRCA(430.2,$P(^DGCR(399.3,IBAT,0),"^",6),0),"^",6) 43 48 I IBAT]"",$P($G(^DGCR(399.3,IBAT,0)),"^",6) S IBARTP=$P($$CATN^PRCAFN($P(^DGCR(399.3,IBAT,0),"^",6)),"^",3) 44 49 ;Check that AR category expects same debtor as defined in who's responsible. … … 77 82 . S IDDATA=$$INSDEM^IBCEF(IBIFN,IBISEQ) 78 83 . 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;" 84 . I '$P(IDDATA,U,1) D ; birth date missing 85 .. S IBERRNO=220+IBISEQ 86 .. S IBER=IBER_"IB"_IBERRNO_";" 87 . I "^M^F^"'[(U_$P(IDDATA,U,2)_U) D ; sex missing 88 .. S IBERRNO=260+IBISEQ 89 .. S IBER=IBER_"IB"_IBERRNO_";" 193 90 . Q 194 91 ; … … 207 104 Q ($P(IBND0,U,24)_$P($G(^DGCR(399.1,+$P(IBND0,U,25),0)),U,2)_$P(IBND0,U,26)) 208 105 ; 209 ERR(Z) ; update IBER variable from the above insurance checks210 ; Z is the IB error code# for the primary insurance error211 N IBERRNO212 S IBERRNO="IB"_(Z+IBISEQ-1)213 I IBER[IBERRNO Q214 S IBER=IBER_IBERRNO_";"215 Q216 ;
Note:
See TracChangeset
for help on using the changeset viewer.