| 1 | IBCEU1 ;ALB/TMP - EDI UTILITIES FOR EOB PROCESSING ;10-FEB-99
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**137,155,296,349,371**;21-MAR-94;Build 57
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | CCOB1(IBIFN,NODE,SEQ) ; Extract Claim level COB data
|
|---|
| 6 | ; for a bill IBIFN
|
|---|
| 7 | ; NODE = the file 361.1 node(s) to be returned, separated by commas
|
|---|
| 8 | ; SEQ = the specific insurance sequence you want returned. If not =
|
|---|
| 9 | ; 1, 2, or 3, all are returned
|
|---|
| 10 | ; Returns IBXDATA(COB,n,node) where COB = COB insurance sequence,
|
|---|
| 11 | ; n is the entry number in file 361.1 and node is the node requested
|
|---|
| 12 | ; = the requested node's data
|
|---|
| 13 | ;
|
|---|
| 14 | N IB,IBN,IBBILL,IBS,A,B,C
|
|---|
| 15 | ;
|
|---|
| 16 | K IBXDATA
|
|---|
| 17 | ;
|
|---|
| 18 | S:$G(NODE)="" NODE=1
|
|---|
| 19 | S IB=$P($G(^DGCR(399,IBIFN,"M1")),U,5,7)
|
|---|
| 20 | S:"123"'[$G(SEQ) SEQ=""
|
|---|
| 21 | ;
|
|---|
| 22 | F B=1:1:3 S IBBILL=$P(IB,U,B) I IBBILL S C=0 F S C=$O(^IBM(361.1,"B",IBBILL,C)) Q:'C D
|
|---|
| 23 | . I '$$EOBELIG(C) Q ; eob not eligible for secondary claim
|
|---|
| 24 | . S IBS=$P($G(^IBM(361.1,C,0)),U,15) ; insurance sequence
|
|---|
| 25 | . I $S('$G(SEQ):1,1:SEQ=IBS) D
|
|---|
| 26 | .. F Z=1:1:$L(NODE,",") D
|
|---|
| 27 | ... S A=$P(NODE,",",Z)
|
|---|
| 28 | ... Q:A=""
|
|---|
| 29 | ... S IBN=$G(^IBM(361.1,C,A))
|
|---|
| 30 | ... I $TR(IBN,U)'="" S IBXDATA(IBS,C,A)=IBN
|
|---|
| 31 | ;
|
|---|
| 32 | Q
|
|---|
| 33 | ;
|
|---|
| 34 | CCAS1(IBIFN,SEQ) ; Extract all MEDICARE COB claim level adjustment data
|
|---|
| 35 | ; for a bill IBIFN (subfile 361.11 in file 361.1)
|
|---|
| 36 | ; SEQ = the specific insurance sequence you want returned. If not =
|
|---|
| 37 | ; 1, 2, or 3, all are returned
|
|---|
| 38 | ; Returns IBXDATA(COB,n) where COB = COB insurance sequence,
|
|---|
| 39 | ; n is the entry number in file 361.1 and
|
|---|
| 40 | ; = the 0-node of the subfile entry (361.11)
|
|---|
| 41 | ; and IBXDATA(COB,n,m) where m is a sequential # and
|
|---|
| 42 | ; = this level's 0-node
|
|---|
| 43 | N IB,IBA,IBS,IB0,IB00,IBBILL,B,C,D,E
|
|---|
| 44 | ;
|
|---|
| 45 | S IB=$P($G(^DGCR(399,IBIFN,"M1")),U,5,7)
|
|---|
| 46 | S:"123"'[$G(SEQ) SEQ=""
|
|---|
| 47 | ;
|
|---|
| 48 | F B=1:1:3 S IBBILL=$P(IB,U,B) I IBBILL S C=0 F S C=$O(^IBM(361.1,"B",IBBILL,C)) Q:'C D
|
|---|
| 49 | . I '$$EOBELIG(C) Q ; eob not eligible for secondary claim
|
|---|
| 50 | . S IBS=$P($G(^IBM(361.1,C,0)),U,15) ; insurance sequence
|
|---|
| 51 | . I $S('$G(SEQ):1,1:SEQ=IBS) D
|
|---|
| 52 | .. S (IBA,D)=0 F S D=$O(^IBM(361.1,C,10,D)) Q:'D S IB0=$G(^(D,0)) D
|
|---|
| 53 | ... S IBXDATA(IBS,D)=IB0
|
|---|
| 54 | ... S (IBA,E)=0
|
|---|
| 55 | ... F S E=$O(^IBM(361.1,C,10,D,1,E)) Q:'E S IB00=$G(^(E,0)) D
|
|---|
| 56 | .... S IBA=IBA+1
|
|---|
| 57 | .... I $TR(IB00,U)'="" S IBXDATA(IBS,D,IBA)=IB00
|
|---|
| 58 | ;
|
|---|
| 59 | Q
|
|---|
| 60 | ;
|
|---|
| 61 | SEQ(A) ; Translate sequence # A into corresponding letter representation
|
|---|
| 62 | S A=$E("PST",A)
|
|---|
| 63 | I $S(A'="":"PST"'[A,1:1) S A="P"
|
|---|
| 64 | Q A
|
|---|
| 65 | ;
|
|---|
| 66 | EOBTOT(IBIFN,IBCOBN) ; Total all EOB's for a bill's COB sequence
|
|---|
| 67 | ; Function returns the total of all EOB's for a specific COB seq
|
|---|
| 68 | ; IBIFN = ien of bill in file 399
|
|---|
| 69 | ; IBCOBN = the # of the COB sequence you want EOB/MRA total for (1-3)
|
|---|
| 70 | ;
|
|---|
| 71 | N Z,Z0,IBTOT
|
|---|
| 72 | S IBTOT=0
|
|---|
| 73 | I $O(^IBM(361.1,"ABS",IBIFN,IBCOBN,0)) D
|
|---|
| 74 | . ; Set up prior payment field here from MRA/EOB(s)
|
|---|
| 75 | . S (IBTOT,Z)=0
|
|---|
| 76 | . F S Z=$O(^IBM(361.1,"ABS",IBIFN,IBCOBN,Z)) Q:'Z D
|
|---|
| 77 | .. ; HD64841 IB*2*371 - total up the payer paid amounts
|
|---|
| 78 | .. S IBTOT=IBTOT+$P($G(^IBM(361.1,Z,1)),U,1)
|
|---|
| 79 | Q IBTOT
|
|---|
| 80 | ;
|
|---|
| 81 | ;
|
|---|
| 82 | LCOBOUT(IBXSAVE,IBXDATA,COL) ; Output the line adjustment reasons COB
|
|---|
| 83 | ; line # data for an electronic claim
|
|---|
| 84 | ; IBXSAVE,IBXDATA = arrays holding formatter information for claim -
|
|---|
| 85 | ; pass by reference
|
|---|
| 86 | ; COL = the column in the 837 flat file being output for LCAS record
|
|---|
| 87 | N LINE,COBSEQ,RECCT,GRPCD,SEQ,RCCT,RCPC,DATA,RCREC,SEQLINE K IBXDATA
|
|---|
| 88 | S (LINE,RECCT)=0
|
|---|
| 89 | S RCPC=(COL#3) S:'RCPC RCPC=3
|
|---|
| 90 | S RCREC=$S(COL'<4:COL-1\3,1:0)
|
|---|
| 91 | ;S RCREC=$S(COL'<4:COL+5\6-1,1:0)
|
|---|
| 92 | F S LINE=$O(IBXSAVE("LCOB",LINE)) Q:'LINE D
|
|---|
| 93 | . S COBSEQ=0
|
|---|
| 94 | . F S COBSEQ=$O(IBXSAVE("LCOB",LINE,"COB",COBSEQ)) Q:'COBSEQ S SEQLINE=0 F S SEQLINE=$O(IBXSAVE("LCOB",LINE,"COB",COBSEQ,SEQLINE)) Q:'SEQLINE S GRPCD="" F S GRPCD=$O(IBXSAVE("LCOB",LINE,"COB",COBSEQ,SEQLINE,GRPCD)) Q:GRPCD="" D
|
|---|
| 95 | .. S RECCT=RECCT+1
|
|---|
| 96 | .. I COL=2 S IBXDATA(RECCT)=LINE,DATA=LINE D:RECCT>1 ID^IBCEF2(RECCT,"LCAS")
|
|---|
| 97 | .. I COL=3 S IBXDATA(RECCT)=$TR(GRPCD," ")
|
|---|
| 98 | .. S (SEQ,RCCT)=0
|
|---|
| 99 | .. F S SEQ=$O(IBXSAVE("LCOB",LINE,"COB",COBSEQ,SEQLINE,GRPCD,SEQ)) Q:'SEQ I $TR($G(IBXSAVE("LCOB",LINE,"COB",COBSEQ,SEQLINE,GRPCD,SEQ)),U)'="" D
|
|---|
| 100 | ... S RCCT=RCCT+1
|
|---|
| 101 | ... Q:COL'<4&(RCCT'=RCREC)&(RCCT'>6)
|
|---|
| 102 | ... S DATA=$S(COL=2:LINE,COL=3:$TR(GRPCD," "),1:$P($G(IBXSAVE("LCOB",LINE,"COB",COBSEQ,SEQLINE,GRPCD,SEQ)),U,RCPC))
|
|---|
| 103 | ... I COL'<4,RCCT=RCREC S:DATA'="" IBXDATA(RECCT)=DATA Q
|
|---|
| 104 | ... I RCCT>6 S RCCT=1,RECCT=RECCT+1 D:COL=2 ID^IBCEF2(RECCT,"LCAS") I DATA'="",$S(COL'>3:1,1:RCCT=RCREC) S IBXDATA(RECCT)=DATA
|
|---|
| 105 | Q
|
|---|
| 106 | ;
|
|---|
| 107 | CCOBOUT(IBXSAVE,IBXDATA,COL) ; Output the claim adjustment reasons COB
|
|---|
| 108 | ; data for an electronic claim
|
|---|
| 109 | ; IBXSAVE,IBXDATA = arrays holding formatter information for claim -
|
|---|
| 110 | ; pass by reference
|
|---|
| 111 | ; COL = the column in the 837 flat file being output for CCAS record
|
|---|
| 112 | N COBSEQ,RECCT,GRPSEQ,SEQ,RCPC,RCCT,RCREC,DATA K IBXDATA
|
|---|
| 113 | S RECCT=0
|
|---|
| 114 | S RCPC=(COL#3) S:'RCPC RCPC=3
|
|---|
| 115 | S RCREC=$S(COL'<4:COL+5\6-1,1:0)
|
|---|
| 116 | S COBSEQ=0
|
|---|
| 117 | F S COBSEQ=$O(IBXSAVE("CCAS",COBSEQ)) Q:'COBSEQ S GRPSEQ="" F S GRPSEQ=$O(IBXSAVE("CCAS",COBSEQ,GRPSEQ)) Q:GRPSEQ="" D
|
|---|
| 118 | . S RECCT=RECCT+1
|
|---|
| 119 | . I COL=2 S IBXDATA(RECCT)=COBSEQ D:RECCT>1 ID^IBCEF2(RECCT,"CCAS")
|
|---|
| 120 | . I COL=3 S IBXDATA(RECCT)=$P($G(IBXSAVE("CCAS",COBSEQ,GRPSEQ)),U)
|
|---|
| 121 | . S (SEQ,RCCT)=0
|
|---|
| 122 | . F S SEQ=$O(IBXSAVE("CCAS",COBSEQ,GRPSEQ,SEQ)) Q:'SEQ I $TR($G(IBXSAVE("CCAS",COBSEQ,GRPSEQ,SEQ)),U)'="" D
|
|---|
| 123 | .. S RCCT=RCCT+1
|
|---|
| 124 | .. Q:COL'<4&(RCCT'=RCREC)&(RCCT'>6)
|
|---|
| 125 | .. S DATA=$S(COL=2:COBSEQ,COL=3:$P($G(IBXSAVE("CCAS",COBSEQ,GRPSEQ)),U),1:$P($G(IBXSAVE("CCAS",COBSEQ,GRPSEQ,SEQ)),U,RCPC))
|
|---|
| 126 | .. I COL'<4,RCCT=RCREC S:DATA'="" IBXDATA(RECCT)=DATA Q
|
|---|
| 127 | .. I RCCT>6 S RCCT=1,RECCT=RECCT+1 D:COL=2 ID^IBCEF2(RECCT,"CCAS") I DATA'="",$S(COL'>3:1,1:RCCT=RCREC) S IBXDATA(RECCT)=DATA
|
|---|
| 128 | Q
|
|---|
| 129 | ;
|
|---|
| 130 | COBOUT(IBXSAVE,IBXDATA,CL) ; build LCOB segment data
|
|---|
| 131 | ; The IBXSAVE array used here is built by INS-2, then LCOB-1.9
|
|---|
| 132 | ; This is basically the 361.115, but all the piece numbers here in this
|
|---|
| 133 | ; local array are one higher than the pieces in subfile 361.115.
|
|---|
| 134 | N Z,M,N,P,PCCL
|
|---|
| 135 | S (N,Z,P)=0 F S Z=$O(IBXSAVE("LCOB",Z)) Q:'Z D
|
|---|
| 136 | . S N=N+1
|
|---|
| 137 | . S M=$O(IBXSAVE("LCOB",Z,"COB",""),-1) Q:'M
|
|---|
| 138 | . S P=$O(IBXSAVE("LCOB",Z,"COB",M,""),-1) Q:'P
|
|---|
| 139 | . S PCCL=$P($G(IBXSAVE("LCOB",Z,"COB",M,P)),U,CL)
|
|---|
| 140 | . S:PCCL'="" IBXDATA(N)=PCCL
|
|---|
| 141 | . Q
|
|---|
| 142 | Q
|
|---|
| 143 | ;
|
|---|
| 144 | COBPYRID(IBXIEN,IBXSAVE,IBXDATA) ; cob insurance company payer id
|
|---|
| 145 | N CT,N,NUM
|
|---|
| 146 | K IBXDATA
|
|---|
| 147 | I '$D(IBXSAVE("LCOB")) G COBPYRX
|
|---|
| 148 | D ALLPAYID^IBCEF2(IBXIEN,.NUM,1)
|
|---|
| 149 | S NUM=$G(NUM(1))
|
|---|
| 150 | S NUM=$E(NUM_$J("",5),1,5)
|
|---|
| 151 | S (CT,N)=0
|
|---|
| 152 | F S N=$O(IBXSAVE("LCOB",N)) Q:'N S CT=CT+1,IBXDATA(CT)=NUM
|
|---|
| 153 | COBPYRX ;
|
|---|
| 154 | Q
|
|---|
| 155 | ;
|
|---|
| 156 | EOBELIG(IBEOB) ; EOB eligibility for secondary claim
|
|---|
| 157 | ; Function to decide if EOB entry in file 361.1 (ien=IBEOB) is
|
|---|
| 158 | ; eligible to be included for secondary claim creation process
|
|---|
| 159 | ; The EOB is not eligible if the review status is not 3, or if there
|
|---|
| 160 | ; is no insurance sequence indicator, or if the EOB has been DENIED
|
|---|
| 161 | ; and the patient responsibility for that EOB is $0 and that EOB is
|
|---|
| 162 | ; not a split EOB. Split EOB's need to be included (IB*2*371).
|
|---|
| 163 | ;
|
|---|
| 164 | NEW ELIG,IBDATA,PTRESP
|
|---|
| 165 | S ELIG=0
|
|---|
| 166 | I '$G(IBEOB) G EOBELIGX
|
|---|
| 167 | S IBDATA=$G(^IBM(361.1,IBEOB,0))
|
|---|
| 168 | I $P(IBDATA,U,4)'=1 G EOBELIGX ; Only MRA EOB's for now
|
|---|
| 169 | I $D(^IBM(361.1,IBEOB,"ERR")) G EOBELIGX ; filing error
|
|---|
| 170 | I $P(IBDATA,U,16)'=3 G EOBELIGX ; review status - accepted-complete
|
|---|
| 171 | I '$P(IBDATA,U,15) G EOBELIGX ; insurance sequence must exist
|
|---|
| 172 | S PTRESP=$P($G(^IBM(361.1,IBEOB,1)),U,2) ; Pt Resp Amount for 1500s
|
|---|
| 173 | I $$FT^IBCEF(+IBDATA)=3 S PTRESP=$$PTRESPI^IBCECOB1(IBEOB) ; for UBs
|
|---|
| 174 | I PTRESP'>0,$P(IBDATA,U,13)=2,'$$SPLIT^IBCEMU1(IBEOB) G EOBELIGX ; Denied & No Pt. Resp. & not a split MRA
|
|---|
| 175 | ;
|
|---|
| 176 | S ELIG=1
|
|---|
| 177 | EOBELIGX ;
|
|---|
| 178 | Q ELIG
|
|---|
| 179 | ;
|
|---|
| 180 | EOBCNT(IBIFN) ; This function counts up the number of EOBs that are eligible
|
|---|
| 181 | ; for the secondary claim creation process for a given bill#.
|
|---|
| 182 | NEW CNT,IEN
|
|---|
| 183 | S (CNT,IEN)=0
|
|---|
| 184 | F S IEN=$O(^IBM(361.1,"B",+$G(IBIFN),IEN)) Q:'IEN D
|
|---|
| 185 | . I $$EOBELIG(IEN) S CNT=CNT+1
|
|---|
| 186 | . Q
|
|---|
| 187 | EOBCNTX ;
|
|---|
| 188 | Q CNT
|
|---|
| 189 | ;
|
|---|
