| [623] | 1 | IBCEOB00 ;ALB/ESG - 835 EDI EOB MSG PROCESSING CONT ;30-JUN-2003
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**155,349**;21-MAR-94;Build 46
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | RCRU(IBZDATA,IB0,IBLN) ; Revenue Code Roll-up procedure check -
|
|---|
| 7 | ; Total up outbound line items by revenue code and compare with
|
|---|
| 8 | ; incoming EOB 40 record to see if it has been rolled up
|
|---|
| 9 | ;
|
|---|
| 10 | ; IBZDATA - UB output formatter array, passed by reference
|
|---|
| 11 | ; IB0 - 40 record data
|
|---|
| 12 | ; IBLN - output parameter, passed by reference
|
|---|
| 13 | ;
|
|---|
| 14 | NEW Z,LN,REV,UN,CH,RUD,RUD2,UCH,MRAUCH
|
|---|
| 15 | I $P(IB0,U,4)="" G RCRUX
|
|---|
| 16 | S IBLN="",Z=0
|
|---|
| 17 | F S Z=$O(IBZDATA(Z)) Q:'Z S LN=IBZDATA(Z) D
|
|---|
| 18 | . S REV=$P(LN,U,1),UN=$P(LN,U,4),CH=$P(LN,U,5),UCH=+$P(LN,U,3)
|
|---|
| 19 | . I REV="" Q
|
|---|
| 20 | . ;
|
|---|
| 21 | . S RUD=$G(RUD(REV)) ; roll up data array for rev code
|
|---|
| 22 | . S $P(RUD,U,1)=$P(RUD,U,1)+CH ; total charges
|
|---|
| 23 | . S $P(RUD,U,2)=$P(RUD,U,2)+UN ; total units
|
|---|
| 24 | . S $P(RUD,U,3)=$P(RUD,U,3)+1 ; total line items
|
|---|
| 25 | . S RUD(REV)=RUD
|
|---|
| 26 | . S RUD(REV,Z)=""
|
|---|
| 27 | . ;
|
|---|
| 28 | . S RUD2=$G(RUD2(REV,UCH)) ; roll up data array for rev code
|
|---|
| 29 | . S $P(RUD2,U,1)=$P(RUD2,U,1)+CH ; total charges
|
|---|
| 30 | . S $P(RUD2,U,2)=$P(RUD2,U,2)+UN ; total units
|
|---|
| 31 | . S $P(RUD2,U,3)=$P(RUD2,U,3)+1 ; total line items
|
|---|
| 32 | . S RUD2(REV,UCH)=RUD2
|
|---|
| 33 | . S RUD2(REV,UCH,Z)=""
|
|---|
| 34 | . ;
|
|---|
| 35 | . Q
|
|---|
| 36 | ;
|
|---|
| 37 | I '$D(RUD),'$D(RUD2) G RCRUX
|
|---|
| 38 | ;
|
|---|
| 39 | ; delete the revenue code roll-up, if only 1 line item.
|
|---|
| 40 | S REV="" ; this is not a roll up situation
|
|---|
| 41 | F S REV=$O(RUD(REV)) Q:REV="" I $P(RUD(REV),U,3)=1 KILL RUD(REV)
|
|---|
| 42 | ;
|
|---|
| 43 | S (REV,UCH)=""
|
|---|
| 44 | F S REV=$O(RUD2(REV)) Q:REV="" F S UCH=$O(RUD2(REV,UCH)) Q:UCH="" I $P(RUD2(REV,UCH),U,3)=1 KILL RUD2(REV,UCH)
|
|---|
| 45 | ;
|
|---|
| 46 | I '$D(RUD),'$D(RUD2) G RCRUX
|
|---|
| 47 | ;
|
|---|
| 48 | S RUD=$G(RUD($P(IB0,U,4))) ; compare with 40 record data
|
|---|
| 49 | I RUD="" G RCRU2 ; make sure it exists
|
|---|
| 50 | I $P(RUD,U,1)'=+$$DOLLAR^IBCEOB($P(IB0,U,15)) G RCRU2 ; charges
|
|---|
| 51 | I $P(RUD,U,2)'=$P(IB0,U,16) G RCRU2 ; units
|
|---|
| 52 | S IBLN=$O(RUD($P(IB0,U,4),"")) ; use the first line# found
|
|---|
| 53 | G RCRUX
|
|---|
| 54 | ;
|
|---|
| 55 | RCRU2 ; check roll-up data by rev code and unit charge
|
|---|
| 56 | S MRAUCH=0
|
|---|
| 57 | I $P(IB0,U,16) S MRAUCH=+$$DOLLAR^IBCEOB($P(IB0,U,15))/$P(IB0,U,16)
|
|---|
| 58 | S RUD2=$G(RUD2($P(IB0,U,4),MRAUCH)) ; compare with 40 record data
|
|---|
| 59 | I RUD2="" G RCRUX ; make sure it exists
|
|---|
| 60 | I $P(RUD2,U,1)'=+$$DOLLAR^IBCEOB($P(IB0,U,15)) G RCRUX ; charges
|
|---|
| 61 | I $P(RUD2,U,2)'=$P(IB0,U,16) G RCRUX ; units
|
|---|
| 62 | S IBLN=$O(RUD2($P(IB0,U,4),MRAUCH,"")) ; use the first line# found
|
|---|
| 63 | ;
|
|---|
| 64 | RCRUX ;
|
|---|
| 65 | Q
|
|---|
| 66 | ;
|
|---|
| 67 | ICN(IBEOB,ICN,COBN,IBOK) ; File the 835 ICN into the Bill
|
|---|
| 68 | ;
|
|---|
| 69 | ; Input parameters
|
|---|
| 70 | ; IBEOB - ien to file 361.1
|
|---|
| 71 | ; ICN - the ICN# from the 835 transmission
|
|---|
| 72 | ; COBN - the insurance sequence#
|
|---|
| 73 | ;
|
|---|
| 74 | ; Output parameter
|
|---|
| 75 | ; IBOK - returns as 0 if we get a filing error here
|
|---|
| 76 | ;
|
|---|
| 77 | ; The field in file 399 depends on the current payer sequence
|
|---|
| 78 | ; 399,453 - primary ICN
|
|---|
| 79 | ; 399,454 - secondary ICN
|
|---|
| 80 | ; 399,455 - tertiary ICN
|
|---|
| 81 | ;
|
|---|
| 82 | NEW IBIFN,FIELD,D,D0,DA,DI,DIC,DIE,DQ,DR,X,Y
|
|---|
| 83 | S IBEOB=+$G(IBEOB),COBN=+$G(COBN)
|
|---|
| 84 | I 'IBEOB!'COBN G ICNX
|
|---|
| 85 | S IBIFN=+$P($G(^IBM(361.1,IBEOB,0)),U,1)
|
|---|
| 86 | I '$D(^DGCR(399,IBIFN)) G ICNX
|
|---|
| 87 | I $G(ICN)="" G ICNX
|
|---|
| 88 | I '$F(".1.2.3.","."_COBN_".") G ICNX
|
|---|
| 89 | ;
|
|---|
| 90 | S FIELD=452+COBN
|
|---|
| 91 | S DIE=399,DA=IBIFN,DR=FIELD_"////"_ICN D ^DIE
|
|---|
| 92 | S IBOK=($D(Y)=0)
|
|---|
| 93 | I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Error in filing the ICN into the Bill/Claims file"
|
|---|
| 94 | ICNX ;
|
|---|
| 95 | Q
|
|---|
| 96 | ;
|
|---|
| 97 | 35(IB0,IBEGBL,IBEOB) ; Record '35'
|
|---|
| 98 | ;
|
|---|
| 99 | N A,IBOK
|
|---|
| 100 | ;
|
|---|
| 101 | S A="3;4.12;1;0;0^4;4.13;1;0;0^5;4.14;0;1;1^6;4.15;1;0;0^7;4.16;1;0;0^8;4.17;1;0;0^9;4.18;1;0;0^10;4.04;1;0;0^11;3.01;0;1;1^12;3.02;1;0;0^13;3.08;1;0;0^14;3.09;1;0;0"
|
|---|
| 102 | ;
|
|---|
| 103 | S IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB)
|
|---|
| 104 | I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad MEDICARE Inpt Adjudication data"
|
|---|
| 105 | Q35 Q $G(IBOK)
|
|---|
| 106 | ;
|
|---|
| 107 | 37(IB0,IBEGBL,IBEOB) ; Record '37'
|
|---|
| 108 | ;
|
|---|
| 109 | N IBOK,IBCT
|
|---|
| 110 | S IBCT=$G(^TMP($J,37))+1
|
|---|
| 111 | I IBCT>5 S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Too many Medicare Claim Level Adjudication Remarks" G Q37 ; Max 5 allowed
|
|---|
| 112 | S A="4;"_$S($P(IB0,U,3)="O":"3.0"_(IBCT+2),1:"5.0"_IBCT)_";0;0;0^5;5.0"_IBCT_"1;0;0;0"
|
|---|
| 113 | S IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB)
|
|---|
| 114 | I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad Medicare Claim Level Adjudication Remarks data"
|
|---|
| 115 | ;
|
|---|
| 116 | ; 4/22/03 - esg - If claim level remark code MA15 is reported, then
|
|---|
| 117 | ; this is a split EOB and we need to change the REVIEW STATUS
|
|---|
| 118 | ; of this EOB to be ACCEPTED-INTERIM EOB.
|
|---|
| 119 | ;
|
|---|
| 120 | I $P(IB0,U,4)["MA15" D
|
|---|
| 121 | . N DA,DIE,DR,DIC
|
|---|
| 122 | . S DA=IBEOB,DIE=361.1,DR=".16////2" D ^DIE S IBOK=($D(Y)=0)
|
|---|
| 123 | . I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Split EOB, but review status was not updated correctly"
|
|---|
| 124 | . Q
|
|---|
| 125 | ;
|
|---|
| 126 | Q37 S ^TMP($J,37)=$G(^TMP($J,37))+1 ; Saves the # of entries for 37 records
|
|---|
| 127 | Q $G(IBOK)
|
|---|
| 128 | ;
|
|---|
| 129 | ;
|
|---|
| 130 | DET40(IB0,ARRAY) ; Format important details of record 40 for error
|
|---|
| 131 | ; IB0 = data on 40 record (some pieces pre-formatted)
|
|---|
| 132 | ; ARRAY(n)=formatted line is returned if passed by ref
|
|---|
| 133 | N Q
|
|---|
| 134 | S ARRAY(1)="Payer reported the following was billed to them:"
|
|---|
| 135 | S ARRAY(2)=" "_$S($P(IB0,U,21)="NU":"Rev Cd",1:"Proc")_": "_$S($P(IB0,U,10)'="":$P(IB0,U,10),1:"Same as adjudicated")_" Chg: "_$J($P(IB0,U,15)/100,"",2)_" Units: "_$S($P(IB0,U,16):$P(IB0,U,16),1:1)
|
|---|
| 136 | S ARRAY(3)=" Svc Date(s): "_$S($P(IB0,U,19)'="":$$FDT($P(IB0,U,19)),1:"??")_$S($P(IB0,U,20)'="":"-"_$$FDT($P(IB0,U,20)),1:"")
|
|---|
| 137 | I $P(IB0,U,11)'="" S ARRAY(3)=ARRAY(3)_" Mods: " F Q=11:1:14 I $P(IB0,U,Q)'="" S ARRAY(3)=ARRAY(3)_$P(IB0,U,Q)_$S(Q=14:"",$P(IB0,U,Q+1)'="":",",1:"")
|
|---|
| 138 | S ARRAY(4)="Payer reported adjudication on:"
|
|---|
| 139 | S ARRAY(5)=" "_$S($P(IB0,U,21)="NU":"Rev Cd",1:"Proc")_": "_$S($P(IB0,U,3)'="":$P(IB0,U,3),1:$P(IB0,U,4))
|
|---|
| 140 | S ARRAY(5)=ARRAY(5)_" Type: "_$P(IB0,U,21)_$S($P(IB0,U,21)'="NU":" Rev Cd: "_$P(IB0,U,4),1:"")_" Units: "_$S($P(IB0,U,18):$P(IB0,U,18)/100,1:1)_" Amt: "_$J($P(IB0,U,17)/100,"",2)
|
|---|
| 141 | I $P(IB0,U,5)'="" S ARRAY(5)=ARRAY(5)_" Mods: " F Q=5:1:8 I $P(IB0,U,Q)'="" S ARRAY(5)=ARRAY(5)_$P(IB0,U,Q)_$S(Q=8:"",$P(IB0,U,Q+1)'="":",",1:"")
|
|---|
| 142 | Q
|
|---|
| 143 | ;
|
|---|
| 144 | DET4X(RECID,IB0,ARRAY) ; Format important details of record 41-45 for error
|
|---|
| 145 | ; RECID = 41,42,45
|
|---|
| 146 | ; IB0 = data on RECID record
|
|---|
| 147 | ; ARRAY(n)=formatted line is returned if passed by ref
|
|---|
| 148 | N CT,Q
|
|---|
| 149 | I RECID=41 D Q
|
|---|
| 150 | . S ARRAY(1)="Allowed Amt: "_$J($P(IB0,U,3)/100,"",2)_" Per Diem Amt: "_$J($P(IB0,U,4)/100,"",2)
|
|---|
| 151 | ;
|
|---|
| 152 | I RECID=42 D Q
|
|---|
| 153 | . S ARRAY(1)="Line Item Remark Code: "_$P(IB0,U,3)
|
|---|
| 154 | . I $P(IB0,U,4)'="" S CT=1 F Q=0:80:190 I $E($P(IB0,U,4),Q+1,Q+80)'="" S CT=CT+1,ARRAY(CT)=$E($P(IB0,U,4),Q+1,Q+80)
|
|---|
| 155 | ;
|
|---|
| 156 | I RECID=45 D
|
|---|
| 157 | . S ARRAY(1)="Adj Group Cd: "_$P(IB0,U,3)_" Reason Cd: "_$P(IB0,U,4)_" Amt: "_$J($P(IB0,U,5)/100,"",2)_" Quantity: "_+$P(IB0,U,6)
|
|---|
| 158 | . I $P(IB0,U,7)'="" S CT=1 F Q=0:80:190 I $E($P(IB0,U,7),Q+1,Q+80)'="" S CT=CT+1,ARRAY(CT)=$E($P(IB0,U,7),Q+1,Q+80)
|
|---|
| 159 | Q
|
|---|
| 160 | ;
|
|---|
| 161 | FDT(X) ; Format date in X (YYYYMMDD) to MM/DD/YYYY
|
|---|
| 162 | S:X'="" X=$E(X,5,6)_"/"_$E(X,7,8)_"/"_$E(X,1,4)
|
|---|
| 163 | Q X
|
|---|
| 164 | ;
|
|---|
| 165 | UPDNM(IBEOB,IB0,IBBULL,IBDR) ; Update name on claim if it comes back changed
|
|---|
| 166 | ; IBEOB = the internal entry # of the entry in file 361.1
|
|---|
| 167 | ; IB0 = the raw data returned from the 835 flat file
|
|---|
| 168 | ; IBBULL = holds result of name change check in piece 1 - if name
|
|---|
| 169 | ; changed, first '^' piece is 1, 3rd '^' piece is the old
|
|---|
| 170 | ; insured's name
|
|---|
| 171 | ; IBDR = returned as the updated 'DR' string with the name changed
|
|---|
| 172 | ; fields to use to update the EOB file (361.1) - pass by reference
|
|---|
| 173 | ;
|
|---|
| 174 | N IBCHGED,IBIFN,IBNEW,IBCOB,DIE,DR,X,Y
|
|---|
| 175 | I $P(IB0,U,7) D
|
|---|
| 176 | . S IBNEW=$P(IB0,U,3)_","_$P(IB0,U,4)_$S($P(IB0,U,5)'="":" "_$P(IB0,U,5),1:""),$P(IBBULL,U)=1
|
|---|
| 177 | . S IBCOB=+$P($G(^IBM(361.1,IBEOB,0)),U,15)
|
|---|
| 178 | . S IBIFN=+$G(^IBM(361.1,+IBEOB,0))
|
|---|
| 179 | . S IB=$G(^DGCR(399,IBIFN,"I"_IBCOB))
|
|---|
| 180 | . ;
|
|---|
| 181 | . I IB'="",$P(IB,U,17)'=IBNEW D
|
|---|
| 182 | .. ; Update the claim data only
|
|---|
| 183 | .. S $P(IBBULL,U,3)=$P(IB,U,17) ; save old value
|
|---|
| 184 | .. S $P(IB,U,17)=IBNEW
|
|---|
| 185 | .. S DIE="^DGCR(399,",DA=IBIFN,DR="30"_IBCOB_"////"_IB
|
|---|
| 186 | .. D:DA ^DIE
|
|---|
| 187 | .. S IBCHGED=1
|
|---|
| 188 | . S IBDR=$G(IBDR)_"6.01////"_$P(IB0,U,3)_","_$P(IB0,U,4)_" "_$P(IB0,U,5)_";"
|
|---|
| 189 | ;
|
|---|
| 190 | Q $G(IBCHGED)
|
|---|
| 191 | ;
|
|---|
| 192 | UPDID(IBEOB,IB0,IBBULL,IBDR) ; Update id # on claim and policy if it comes back
|
|---|
| 193 | ; changed
|
|---|
| 194 | ; IBEOB = the internal entry # of the entry in file 361.1
|
|---|
| 195 | ; IB0 = the raw data returned from the 835 flat file
|
|---|
| 196 | ; IBBULL = holds result of id change check in piece 2 - if id changed,
|
|---|
| 197 | ; second '^' piece = 1,4th '^' piece is the old insured's id
|
|---|
| 198 | ; IBDR = returned as the updated 'DR' string with the id changed fields
|
|---|
| 199 | ; to use to update the EOB file (361.1) - pass by reference
|
|---|
| 200 | ;
|
|---|
| 201 | N IBCHGED,IBNEW,IBCOB,IB,DIE,DR,DA,X,Y
|
|---|
| 202 | I $P(IB0,U,8) D
|
|---|
| 203 | . S IBNEW=$P(IB0,U,6),$P(IBBULL,U,2)=1
|
|---|
| 204 | . S IBIFN=+$G(^IBM(361.1,+IBEOB,0))
|
|---|
| 205 | . S IBCOB=+$P($G(^IBM(361.1,IBEOB,0)),U,15)
|
|---|
| 206 | . S IB=$G(^DGCR(399,IBIFN,"I"_IBCOB))
|
|---|
| 207 | . ;
|
|---|
| 208 | . I IB'="",$P(IB,U,2)'=IBNEW D
|
|---|
| 209 | .. ; Update the claim
|
|---|
| 210 | .. S $P(IBBULL,U,4)=$P(IB,U,2) ; save old value
|
|---|
| 211 | .. S $P(IB,U,2)=IBNEW
|
|---|
| 212 | .. S DIE="^DGCR(399,",DA=IBIFN,DR="30"_IBCOB_"////"_IB D ^DIE
|
|---|
| 213 | .. ;
|
|---|
| 214 | .. ; Update the policy
|
|---|
| 215 | .. S DA(1)=$P($G(^DGCR(399,IBIFN,0)),U,2),DA=$P($G(^("M")),U,(11+IBCOB)),DR="1////"_IBNEW,DIE="^DPT("_DA(1)_",.312,"
|
|---|
| 216 | .. I DA(1),DA D ^DIE
|
|---|
| 217 | .. S IBCHGED=1
|
|---|
| 218 | . S IBDR=$G(IBDR)_"6.02////"_$P(IB0,U,6)_";"
|
|---|
| 219 | ;
|
|---|
| 220 | Q $G(IBCHGED)
|
|---|
| 221 | ;
|
|---|
