- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEU1.m
r613 r623 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 ; 1 IBCEU1 ;ALB/TMP - EDI UTILITIES FOR EOB PROCESSING ;10-FEB-99 2 ;;2.0;INTEGRATED BILLING;**137,155,296,349**;21-MAR-94;Build 46 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 .. S IBTOT=IBTOT+$P($G(^IBM(361.1,Z,1)),U,2) 78 Q IBTOT 79 ; 80 ; 81 LCOBOUT(IBXSAVE,IBXDATA,COL) ; Output the line adjustment reasons COB 82 ; line # data for an electronic claim 83 ; IBXSAVE,IBXDATA = arrays holding formatter information for claim - 84 ; pass by reference 85 ; COL = the column in the 837 flat file being output for LCAS record 86 N LINE,COBSEQ,RECCT,GRPCD,SEQ,RCCT,RCPC,DATA,RCREC,SEQLINE K IBXDATA 87 S (LINE,RECCT)=0 88 S RCPC=(COL#3) S:'RCPC RCPC=3 89 S RCREC=$S(COL'<4:COL-1\3,1:0) 90 ;S RCREC=$S(COL'<4:COL+5\6-1,1:0) 91 F S LINE=$O(IBXSAVE("LCOB",LINE)) Q:'LINE D 92 . S COBSEQ=0 93 . 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 94 .. S RECCT=RECCT+1 95 .. I COL=2 S IBXDATA(RECCT)=LINE,DATA=LINE D:RECCT>1 ID^IBCEF2(RECCT,"LCAS") 96 .. I COL=3 S IBXDATA(RECCT)=$TR(GRPCD," ") 97 .. S (SEQ,RCCT)=0 98 .. 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 99 ... S RCCT=RCCT+1 100 ... Q:COL'<4&(RCCT'=RCREC)&(RCCT'>6) 101 ... S DATA=$S(COL=2:LINE,COL=3:$TR(GRPCD," "),1:$P($G(IBXSAVE("LCOB",LINE,"COB",COBSEQ,SEQLINE,GRPCD,SEQ)),U,RCPC)) 102 ... I COL'<4,RCCT=RCREC S:DATA'="" IBXDATA(RECCT)=DATA Q 103 ... 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 104 Q 105 ; 106 CCOBOUT(IBXSAVE,IBXDATA,COL) ; Output the claim adjustment reasons COB 107 ; data for an electronic claim 108 ; IBXSAVE,IBXDATA = arrays holding formatter information for claim - 109 ; pass by reference 110 ; COL = the column in the 837 flat file being output for CCAS record 111 N COBSEQ,RECCT,GRPSEQ,SEQ,RCPC,RCCT,RCREC,DATA K IBXDATA 112 S RECCT=0 113 S RCPC=(COL#3) S:'RCPC RCPC=3 114 S RCREC=$S(COL'<4:COL+5\6-1,1:0) 115 S COBSEQ=0 116 F S COBSEQ=$O(IBXSAVE("CCAS",COBSEQ)) Q:'COBSEQ S GRPSEQ="" F S GRPSEQ=$O(IBXSAVE("CCAS",COBSEQ,GRPSEQ)) Q:GRPSEQ="" D 117 . S RECCT=RECCT+1 118 . I COL=2 S IBXDATA(RECCT)=COBSEQ D:RECCT>1 ID^IBCEF2(RECCT,"CCAS") 119 . I COL=3 S IBXDATA(RECCT)=$P($G(IBXSAVE("CCAS",COBSEQ,GRPSEQ)),U) 120 . S (SEQ,RCCT)=0 121 . F S SEQ=$O(IBXSAVE("CCAS",COBSEQ,GRPSEQ,SEQ)) Q:'SEQ I $TR($G(IBXSAVE("CCAS",COBSEQ,GRPSEQ,SEQ)),U)'="" D 122 .. S RCCT=RCCT+1 123 .. Q:COL'<4&(RCCT'=RCREC)&(RCCT'>6) 124 .. 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)) 125 .. I COL'<4,RCCT=RCREC S:DATA'="" IBXDATA(RECCT)=DATA Q 126 .. 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 127 Q 128 ; 129 COBOUT(IBXSAVE,IBXDATA,CL) ; 130 N Z,M,N,P,PCCL 131 S (N,Z,P)=0 F S Z=$O(IBXSAVE("LCOB",Z)) Q:'Z D 132 . S N=N+1 133 . S M=$O(IBXSAVE("LCOB",Z,"COB",""),-1) Q:'M 134 . S P=$O(IBXSAVE("LCOB",Z,"COB",M,""),-1) Q:'P 135 . S PCCL=$P($G(IBXSAVE("LCOB",Z,"COB",M,P)),U,CL) 136 . S:PCCL'="" IBXDATA(N)=PCCL 137 . Q 138 Q 139 ; 140 COBPYRID(IBXIEN,IBXSAVE,IBXDATA) ; cob insurance company payer id 141 N CT,Z,N,NUM 142 K IBXDATA 143 I '$D(IBXSAVE("LCOB")) G COBPYRX 144 D ALLPAYID^IBCEF2(IBXIEN,.NUM,1) 145 S Z=$$COID^IBCEF2(IBXIEN),NUM=$G(NUM(1)) 146 S:Z="" Z="0000" 147 S NUM=$E(NUM_$J("",5),1,5)_$E(Z_$J("",4),1,4) 148 S (CT,N)=0 149 F S N=$O(IBXSAVE("LCOB",N)) Q:'N S CT=CT+1,IBXDATA(CT)=NUM 150 COBPYRX ; 151 Q 152 ; 153 EOBELIG(IBEOB) ; EOB eligibility for secondary claim 154 ; Function to decide if EOB entry in file 361.1 (ien=IBEOB) is 155 ; eligible to be included for secondary claim creation process 156 ; The EOB is not eligible if the review status is not 3, or if there 157 ; is no insurance sequence indicator, or if the EOB has been DENIED 158 ; and the patient responsibility for that EOB is $0. 159 ; 160 NEW ELIG,IBDATA,PTRESP 161 S ELIG=0 162 I '$G(IBEOB) G EOBELIGX 163 S IBDATA=$G(^IBM(361.1,IBEOB,0)) 164 I $P(IBDATA,U,4)'=1 G EOBELIGX ; Only MRA EOB's for now 165 I $P(IBDATA,U,16)'=3 G EOBELIGX ; review status - accepted-complete 166 I '$P(IBDATA,U,15) G EOBELIGX ; insurance sequence must exist 167 S PTRESP=$P($G(^IBM(361.1,IBEOB,1)),U,2) ; Pt Resp Amount for 1500s 168 I $$FT^IBCEF(+IBDATA)=3 S PTRESP=$$PTRESPI^IBCECOB1(IBEOB) ; for UBs 169 I PTRESP'>0,$P(IBDATA,U,13)=2 G EOBELIGX ; Denied & No Pt. Resp. 170 I $D(^IBM(361.1,IBEOB,"ERR")) G EOBELIGX ; filing error 171 ; 172 S ELIG=1 173 EOBELIGX ; 174 Q ELIG 175 ; 176 EOBCNT(IBIFN) ; This function counts up the number of EOBs that are eligible 177 ; for the secondary claim creation process for a given bill#. 178 NEW CNT,IEN 179 S (CNT,IEN)=0 180 F S IEN=$O(^IBM(361.1,"B",+$G(IBIFN),IEN)) Q:'IEN D 181 . I $$EOBELIG(IEN) S CNT=CNT+1 182 . Q 183 EOBCNTX ; 184 Q CNT 185 ;
Note:
See TracChangeset
for help on using the changeset viewer.
