| 1 | IBCEOB1 ;ALB/TMP - 835 EDI EOB MSG PROCESSING ;18-FEB-99
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**137,135,155,296,356,349**;21-MAR-94;Build 46
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | STORE(A,IB0,IBEOB,LEVEL) ;
|
|---|
| 7 | ; A = the string of data to extract and try to store
|
|---|
| 8 | ; each ^ piece is a field to store
|
|---|
| 9 | ; within each ^ piece, there are 5 ';' pieces:
|
|---|
| 10 | ; 1 = piece to extract from the data string;
|
|---|
| 11 | ; 2 = field to update;
|
|---|
| 12 | ; 3 = flag for dollar amt (1=YES);
|
|---|
| 13 | ; 4 = flag for 4-slash stuff without transform (1=YES);
|
|---|
| 14 | ; 5 = flag for numeric/non-dollar amt (1=Yes, 0=No,
|
|---|
| 15 | ; Dn = the field is numeric with 'n' decimal places
|
|---|
| 16 | ; IB0 = the record being processed
|
|---|
| 17 | ; IBEOB = the ien of the EOB entry in file 361.1
|
|---|
| 18 | ; LEVEL = the array that contains the DIE and DA values if stuffing at a
|
|---|
| 19 | ; level other than the top level
|
|---|
| 20 | ;
|
|---|
| 21 | N B,IBPC,IBFLD,DA,DR,DIE,X,Y
|
|---|
| 22 | S DR=";"
|
|---|
| 23 | ;
|
|---|
| 24 | I '$G(LEVEL) S DIE="^IBM(361.1,",DA=IBEOB
|
|---|
| 25 | ;
|
|---|
| 26 | I $G(LEVEL) D
|
|---|
| 27 | . N Q
|
|---|
| 28 | . S DIE=$G(LEVEL("DIE"))
|
|---|
| 29 | . S Q=0 F S Q=$O(LEVEL(Q)) Q:'Q S DA(Q)=LEVEL(Q)
|
|---|
| 30 | . S DA=LEVEL(0)
|
|---|
| 31 | ;
|
|---|
| 32 | I $G(DA) F B=1:1:$L(A,U) D
|
|---|
| 33 | . S IBPC=$P(A,U,B),IBFLD=$P(IBPC,";",2)
|
|---|
| 34 | . I $P(IB0,U,+IBPC)'="",IBFLD D
|
|---|
| 35 | .. N VAL
|
|---|
| 36 | .. ; For dollar amts, add full cents; For numerics, strip leading
|
|---|
| 37 | .. ; 0's; For non-numeric/non-dollar amts, make any ; in data into |
|
|---|
| 38 | .. S VAL=$S($P(IBPC,";",3):$$DOLLAR^IBCEOB($P(IB0,U,+IBPC)),$P(IBPC,";",5):+$P(IB0,U,+IBPC),$P($P(IBPC,";",5),"D",2):$P(IB0,U,+IBPC)/(10**$P($P(IBPC,";",5),"D",2)),1:$TR($P(IB0,U,+IBPC),";","|"))
|
|---|
| 39 | .. I $P(IBPC,";",3),VAL S VAL=$P(VAL,".")_"."_$E($P(VAL,".",2)_"00",1,2)
|
|---|
| 40 | .. S DR=DR_IBFLD_"///"_$S($P(IBPC,";",4):"/",1:"")_VAL_";"
|
|---|
| 41 | ;
|
|---|
| 42 | S DR=$P(DR,";",2,$L(DR,";")-1)
|
|---|
| 43 | I DR'="" D ^DIE
|
|---|
| 44 | Q ($D(Y)=0) ;Successfully stored all the data it was sent if $D(Y)=0
|
|---|
| 45 | ;
|
|---|
| 46 | HDR(IB0,IBEGBL,IBEOB) ; Store header data for EOB
|
|---|
| 47 | ; IB0 = the record being processed from the msg
|
|---|
| 48 | ; IBEOB = the ien of the EOB entry in file 361.1
|
|---|
| 49 | ;
|
|---|
| 50 | N IBDT,IBDTP,DA,DR,DIE,X,Y
|
|---|
| 51 | K IBXSAVE("XTRA"),IBZSAVE
|
|---|
| 52 | ;
|
|---|
| 53 | S IBDT=$P(IB0,U,3),IBDT=$E(IBDT,1,4)-1700_$E(IBDT,5,8)_"."_$P(IB0,U,4)
|
|---|
| 54 | S IBDTP=$P(IB0,U,9)
|
|---|
| 55 | I IBDTP S IBDTP=$E(IBDTP,1,4)-1700_$E(IBDTP,5,8)
|
|---|
| 56 | S DR=$S($P(IB0,U,7)'="":".03////"_$P(IB0,U,7)_";",1:"")_".05////"_IBDT_";.04////"_($P(IB0,U,5)="Y")_";.15///"_$$COBN^IBCEF(+$G(^IBM(361.1,IBEOB,0)))_";.07///"_$P(IB0,U,8)_$S(IBDTP:";.06////"_IBDTP,1:"")
|
|---|
| 57 | S DIE="^IBM(361.1,",DA=IBEOB
|
|---|
| 58 | D ^DIE
|
|---|
| 59 | I $D(Y)'=0 D
|
|---|
| 60 | . S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad header data"
|
|---|
| 61 | Q ($D(Y)=0)
|
|---|
| 62 | ;
|
|---|
| 63 | FINDLN(IB0,IBEOB,IBZDATA) ; Find the corresponding billed line for the adj
|
|---|
| 64 | ; IB0 = the record being processed
|
|---|
| 65 | ; NOTE: pieces 3,4,16 are already reformatted
|
|---|
| 66 | ; IBEOB = the ien of the EOB entry in file 361.1
|
|---|
| 67 | ; IBZDATA = the array from the output formatter containing line
|
|---|
| 68 | ; items for the bill. This is passed in so this data only has
|
|---|
| 69 | ; to be extracted once for each bill (the first time in, it
|
|---|
| 70 | ; will be undefined)
|
|---|
| 71 | ; OUTPUT = Line # in the original bill that this adjustment relates to
|
|---|
| 72 | ; ^ paid procedure code if different from original procedure OR
|
|---|
| 73 | ; paid rev code if different from original and no proc code
|
|---|
| 74 | ;
|
|---|
| 75 | N IBLN,IBLN1,IBBNDL,OCHG,OCHG2,OPROC,OREVCD,IBIFN,IBXARRAY,IBXARRY
|
|---|
| 76 | N IBXERR,UNITS,UNITS2,UNITS3,IBMOD,Z,Z0,CPT,EOBCHG,IBZVLA,IBAMIN
|
|---|
| 77 | ;
|
|---|
| 78 | S (IBLN,IBLN1)="",IBIFN=+$G(^IBM(361.1,IBEOB,0))
|
|---|
| 79 | S EOBCHG=+$$DOLLAR^IBCEOB($P(IB0,U,15)) ; charges on EOB 40 record
|
|---|
| 80 | ;
|
|---|
| 81 | ; if original procedure exists and is different than the 835 procedure,
|
|---|
| 82 | ; the procedure or revenue code originally billed will be in piece 10
|
|---|
| 83 | ; of the '40' record of the 835 flat file. Otherwise, pc 10 is null.
|
|---|
| 84 | S IBBNDL=$S($P(IB0,U,10)'="":1,1:0)
|
|---|
| 85 | ;
|
|---|
| 86 | ; If this is a split MRA, build array of Vista line#'s from other split MRA's
|
|---|
| 87 | I $P($G(^IBM(361.1,IBEOB,0)),U,4)=1,$$SPLIT^IBCEMU1(IBEOB) D
|
|---|
| 88 | . N IEN S IEN=0
|
|---|
| 89 | . F S IEN=$O(^IBM(361.1,"B",IBIFN,IEN)) Q:'IEN I IEN'=IBEOB D
|
|---|
| 90 | .. I $P($G(^IBM(361.1,IEN,0)),U,4)'=1 Q ; not an MRA
|
|---|
| 91 | .. I '$$SPLIT^IBCEMU1(IEN) Q ; not a split EOB
|
|---|
| 92 | .. M IBZVLA=^IBM(361.1,IEN,15,"AC")
|
|---|
| 93 | .. Q
|
|---|
| 94 | . Q
|
|---|
| 95 | ;
|
|---|
| 96 | I $P($G(^DGCR(399,IBIFN,0)),U,19)=3 D G FINDLNX ; UB-04 format
|
|---|
| 97 | . I '$D(IBZDATA) D F^IBCEF("N-UB-04 SERVICE LINE (EDI)","IBZDATA",,IBIFN)
|
|---|
| 98 | . I $P(IB0,U,22),$D(IBZDATA(+$P(IB0,U,22))) S IBLN=+$P(IB0,U,22)_U_$P(IB0,U,10) Q
|
|---|
| 99 | . ;
|
|---|
| 100 | . S Z=0 F S Z=$O(IBZDATA(Z)) Q:'Z D Q:IBLN
|
|---|
| 101 | .. ; Quit if processing an MRA and this VistA line# has already been filed
|
|---|
| 102 | .. I $P($G(^IBM(361.1,IBEOB,0)),U,4)=1,$D(^IBM(361.1,IBEOB,15,"AC",Z)) Q
|
|---|
| 103 | .. ; Quit if split MRA and this VistA line# has already been filed
|
|---|
| 104 | .. I $D(IBZVLA(Z)) Q
|
|---|
| 105 | .. I $G(IBZDATA(Z))="" Q
|
|---|
| 106 | .. S OCHG=$P(IBZDATA(Z),U,3)*$P(IBZDATA(Z),U,4) ; Total charge from bill
|
|---|
| 107 | .. S OCHG2=+$P(IBZDATA(Z),U,5)
|
|---|
| 108 | .. I OCHG'=EOBCHG,OCHG2=EOBCHG S OCHG=OCHG2 ; update OCHG
|
|---|
| 109 | .. ;
|
|---|
| 110 | .. S CPT=$P(IBZDATA(Z),U,2) ; proc from bill
|
|---|
| 111 | .. I CPT'?.N,CPT'="" S CPT=$O(^ICPT("B",CPT,"")) ; non-numeric proc
|
|---|
| 112 | .. S OPROC=$$PRCD^IBCEF1(+CPT_";ICPT(") ; ext proc code
|
|---|
| 113 | .. S OREVCD=+$P($G(^DGCR(399.2,+IBZDATA(Z),0)),U) ; Rev cd from bill
|
|---|
| 114 | .. ;
|
|---|
| 115 | .. ; if not bundled/unbundled
|
|---|
| 116 | .. I 'IBBNDL D Q
|
|---|
| 117 | ... I OPROC="",OREVCD,OREVCD'=$P(IB0,U,4) Q ; revenue code
|
|---|
| 118 | ... I OPROC'="",OPROC'=$P(IB0,U,3) Q ; procedure code
|
|---|
| 119 | ... I +$P(IBZDATA(Z),U,4)'=$P(IB0,U,16) Q ; original units
|
|---|
| 120 | ... I +OCHG'=EOBCHG Q ; original charges
|
|---|
| 121 | ... I '$$MODMATCH($P(IBZDATA(Z),U,9),$P(IB0,U,5,8)),'$$MODMATCH($P($P(IBZDATA(Z),U,9),",",1),$P(IB0,U,5)) Q ; modifiers
|
|---|
| 122 | ... S IBLN=Z
|
|---|
| 123 | ... Q
|
|---|
| 124 | .. ;
|
|---|
| 125 | .. ; if bundled/unbundled
|
|---|
| 126 | .. I IBBNDL D Q
|
|---|
| 127 | ... I OPROC="",OREVCD,OREVCD'=+$P(IB0,U,10) Q ; revenue code
|
|---|
| 128 | ... I OPROC'="",OPROC'=$P(IB0,U,10) Q ; procedure code
|
|---|
| 129 | ... I +$P(IBZDATA(Z),U,4)'=$P(IB0,U,16) Q ; original units
|
|---|
| 130 | ... I +OCHG'=EOBCHG Q ; original charges
|
|---|
| 131 | ... I '$$MODMATCH($P(IBZDATA(Z),U,9),$P(IB0,U,11,14)),'$$MODMATCH($P($P(IBZDATA(Z),U,9),",",1),$P(IB0,U,11)) Q ; modifiers
|
|---|
| 132 | ... S IBLN=Z_U_$S(OPROC'="":OPROC,1:OREVCD)
|
|---|
| 133 | ... Q
|
|---|
| 134 | .. Q
|
|---|
| 135 | . ; When dealing with Inpatient UB-04's, check for revenue code roll-ups
|
|---|
| 136 | . I 'IBLN,$$INPAT^IBCEF(IBIFN,1) D RCRU^IBCEOB00(.IBZDATA,IB0,.IBLN)
|
|---|
| 137 | . ; If only 1 rev code and charges are the same, assume a match
|
|---|
| 138 | . I 'IBLN,'$P($G(^IBM(361.1,IBEOB,0)),U,4),$O(IBZDATA(""),-1)=$O(IBZDATA("")),+OCHG=EOBCHG S IBLN=+$O(IBZDATA(""))_U_OREVCD
|
|---|
| 139 | ;
|
|---|
| 140 | ; At this point, we can assume the claim is CMS-1500 format
|
|---|
| 141 | I '$D(IBZDATA) D F^IBCEF("N-HCFA 1500 SERVICE LINE (EDI)","IBZDATA",,IBIFN)
|
|---|
| 142 | I $P(IB0,U,22),$D(IBZDATA(+$P(IB0,U,22))) S IBLN=+$P(IB0,U,22)_U_$P(IB0,U,10) G FINDLNX
|
|---|
| 143 | S Z=0 F S Z=$O(IBZDATA(Z)) Q:'Z D Q:IBLN
|
|---|
| 144 | . ; Quit if processing an MRA and this VistA line# has already been filed
|
|---|
| 145 | . I $P($G(^IBM(361.1,IBEOB,0)),U,4)=1,$D(^IBM(361.1,IBEOB,15,"AC",Z)) Q
|
|---|
| 146 | . ; Quit if split MRA and this VistA line# has already been filed
|
|---|
| 147 | . I $D(IBZVLA(Z)) Q
|
|---|
| 148 | . S OCHG=$P(IBZDATA(Z),U,8)*$P(IBZDATA(Z),U,9) ; charge from bill
|
|---|
| 149 | . S IBAMIN=""
|
|---|
| 150 | . I $P(IBZDATA(Z),U,12)'="" S IBAMIN=$P(IBZDATA(Z),U,12) ;anesthesia minutes
|
|---|
| 151 | . S UNITS=$S('IBAMIN:$P(IBZDATA(Z),U,9),1:IBAMIN/15)
|
|---|
| 152 | . ; original units from bill or anesthesia minutes calculation
|
|---|
| 153 | . I $P(UNITS,".",2) S UNITS=$FN(UNITS,"",1) ; round to a single decimal place for fractional units
|
|---|
| 154 | . I $P($P(IB0,U,16),".",2) S $P(IB0,U,16)=$FN($P(IB0,U,16),"",1)
|
|---|
| 155 | . S UNITS2=$P(IBZDATA(Z),U,9) ; just the units
|
|---|
| 156 | . ; UNITS3 is the number of anesthesia minutes divided by 10, or nil.
|
|---|
| 157 | . ; Solution to get around the Trailblazers bug for MRAs
|
|---|
| 158 | . S UNITS3=""
|
|---|
| 159 | . I IBAMIN'=0 S UNITS3=IBAMIN/10
|
|---|
| 160 | . ;
|
|---|
| 161 | . S CPT=$P(IBZDATA(Z),U,5) ; proc from bill
|
|---|
| 162 | . I CPT'?.N,CPT'="" S CPT=$O(^ICPT("B",CPT,"")) ; non-numeric proc
|
|---|
| 163 | . S OPROC=$$PRCD^IBCEF1(+CPT_";ICPT(") ; ext proc code
|
|---|
| 164 | . Q:OPROC'=$S('IBBNDL:$P(IB0,U,3),1:$P(IB0,U,10))
|
|---|
| 165 | . ;
|
|---|
| 166 | . S MODOK=0
|
|---|
| 167 | . I $$DOLLAR^IBCEFG1(OCHG)=+$P(IB0,U,15),UNITS=$P(IB0,U,16)!(UNITS2=$P(IB0,U,16))!(UNITS3=$P(IB0,U,16))!(IBAMIN=$P(IB0,U,16)),$S($P(IB0,U,19):$P(IB0,U,19)=$P(IBZDATA(Z),U),1:1) D
|
|---|
| 168 | .. ;Original procedure/chg/units/date match to get here
|
|---|
| 169 | .. ;Check matching original modifiers
|
|---|
| 170 | .. S MODOK=$$MODMATCH($$MODLST^IBEFUNC2($P(IBZDATA(Z),U,10)),$S('IBBNDL:$P(IB0,U,5,8),1:$P(IB0,U,11,14)))
|
|---|
| 171 | .. I 'MODOK,'IBLN1 S IBLN1=Z_$S(IBBNDL:U_OPROC,1:"")
|
|---|
| 172 | .. Q:'MODOK
|
|---|
| 173 | .. S IBLN=Z_$S(IBBNDL:U_OPROC,1:"")
|
|---|
| 174 | I 'IBLN,IBLN1 S IBLN=IBLN1
|
|---|
| 175 | ;
|
|---|
| 176 | FINDLNX ;
|
|---|
| 177 | Q IBLN
|
|---|
| 178 | ;
|
|---|
| 179 | MODMATCH(IB,MODLST) ; Match modifiers
|
|---|
| 180 | ; IB = the list of modifiers iens from the bill, comma delimited
|
|---|
| 181 | ; MODLST = the 4 '^' pieces of the reported modifiers
|
|---|
| 182 | ;
|
|---|
| 183 | N MODOK,Q,Z0,IBMOD,MMOD
|
|---|
| 184 | S MODOK=1
|
|---|
| 185 | I $TR(IB,",")'="" F Q=1:1:$L(IB,",") S Z0=$P(IB,",",Q) I Z0'="" S IBMOD(Z0)=$G(IBMOD(Z0))+1
|
|---|
| 186 | I $TR(MODLST,U)="",$O(IBMOD(""))="" G MODQ ; No modifiers used
|
|---|
| 187 | ;
|
|---|
| 188 | ; No match if no VistA modifiers, but there are MRA modifiers
|
|---|
| 189 | I $TR(MODLST,U)'="",$O(IBMOD(""))="" S MODOK=0 G MODQ
|
|---|
| 190 | ;
|
|---|
| 191 | ; Evaluate each MRA modifier
|
|---|
| 192 | F Z0=1:1:4 D
|
|---|
| 193 | . S MMOD=$P(MODLST,U,Z0) Q:MMOD="" ; individual MRA modifier
|
|---|
| 194 | . I '$D(IBMOD(MMOD)) Q ; not in array so just quit
|
|---|
| 195 | . S IBMOD(MMOD)=IBMOD(MMOD)-1 ; decrement array counter
|
|---|
| 196 | . I 'IBMOD(MMOD) KILL IBMOD(MMOD) ; if 0, then kill array entry
|
|---|
| 197 | . Q
|
|---|
| 198 | ;
|
|---|
| 199 | I $O(IBMOD(""))'="" S MODOK=0 ; All submitted mods not matched
|
|---|
| 200 | MODQ Q MODOK
|
|---|
| 201 | ;
|
|---|
