- 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/IBCECOB1.m
r613 r623 1 IBCECOB1 ;ALB/CXW - IB COB MANAGEMENT SCREEN/REPORT ;14-JUN-99 2 ;;2.0;INTEGRATED BILLING;**137,155,288,348,377**;21-MAR-94;Build 23 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 BLD ; Build list entrypoint 6 N I,IBFND,IBB,IBIFN,IB364,IBDA1,IBDTN,IBDA,IBDAY,IBHIS,IBNDS,IBEUT,IBAPY,IBOAM,IBDT,IBMUT,IBBPY,IBINS,IBNDM,IBQ,IBNDI1,IBNDI2,IBNDI3,Z,Z0,IBSEQ,IB3611,IBINS1,IBINS2,IBEXPY,IBNBAL,IBPTRSP,IBAMT,IBMRACNT,IBPTNM,IBSRVC,IBPY,IBB364 7 N IBEOBREV,IBDENDUP 8 K ^TMP("IBCECOB",$J),^TMP("IBCECOB1",$J),^TMP("IBCOBST",$J),^TMP("IBCOBSTX",$J) 9 D CLEAN^VALM10 ; kill data and video control arrays 10 S VALMCNT=0,IBHIS="" 11 ; since 0 is a valid Review Status, init w/null 12 S IBEOBREV="" 13 ; get EOB's w/Review Status of 0, 1, 1.5 or 2; If 3 or higher, not needed 14 F S IBEOBREV=$O(^IBM(361.1,"AMRA",1,IBEOBREV)) Q:IBEOBREV="" Q:IBEOBREV>2 D ; 15 . S IBDA="A" F S IBDA=$O(^IBM(361.1,"AMRA",1,IBEOBREV,IBDA),-1) Q:'IBDA D BLD1 16 ; no data accumulated 17 I $O(^TMP("IBCOBST",$J,""))="" D NMAT Q 18 ; display accumulated data 19 D SCRN 20 Q 21 BLD1 ; 22 I '$$ELIG(IBDA) Q 23 S IBDENDUP=$$DENDUP^IBCEMU4(IBDA) 24 I '$G(IBMRADUP),IBDENDUP Q ; don't include denied MRAs for Duplicate Claim/Service 25 S IB3611=$G(^IBM(361.1,IBDA,0)) 26 S IBIFN=+IB3611,IB364=$P(IB3611,U,19),IBDT=+$P(IB3611,U,6) 27 I $D(^TMP("IBCOBSTX",$J,IBIFN)) Q ;show each bill once on the worklist 28 S IBB=$G(^DGCR(399,IBIFN,0)) 29 S IBNDS=$G(^DGCR(399,IBIFN,"S")),IBNDI1=$G(^("I1")),IBNDI2=$G(^("I2")),IBNDI3=$G(^("I3")),IBNDM=$G(^("M")) 30 S IBMUT=+$P(IBNDS,U,8),IBEUT=+$P(IBNDS,U,2) 31 S IBINS="",IBSEQ=$P(IB3611,U,15) 32 F I=1:1:3 S Z="IBNDI"_I I @Z D 33 . N Q 34 . S Q=(IBSEQ=I) 35 . I Q S IBINS1=+@Z_U_$P($G(^DIC(36,+@Z,0)),U) 36 . S IBINS=IBINS_$S(IBINS="":"",1:", ")_$P($G(^DIC(36,+@Z,0)),U) 37 ; Get the payer/insurance company that comes after Medicare WNR 38 ; If WNR is Primary, get the secondary ins. co. 39 ; If WNR is secondary, get the tertiary ins. co. 40 D I $P(IBINS2,U,2)="" S $P(IBINS2,U,2)="UNKNOWN" 41 . I $$WNRBILL^IBEFUNC(IBIFN,1) S IBINS2=+IBNDI2_U_$P($G(^DIC(36,+IBNDI2,0)),U) Q 42 . S IBINS2=+IBNDI3_U_$P($G(^DIC(36,+IBNDI3,0)),U) 43 S IBFND=0 44 ; biller entry not ALL and no biller, then get entered/edited by user 45 I $D(^TMP("IBBIL",$J)) D Q:'IBFND 46 . S IBFND=$S($D(^TMP("IBBIL",$J,IBMUT)):IBMUT,$D(^TMP("IBBIL",$J,IBEUT)):IBEUT,1:0) 47 S Z=$S(IBFND:IBFND,IBMUT:IBMUT,1:IBEUT) 48 S IBMUT=$P($G(^VA(200,+Z,0)),U)_"~"_Z 49 S:'$P(IBMUT,"~",2) IBMUT="UNKNOWN~0" 50 S IBBPY=+$$COBN^IBCEF(IBIFN),IBQ=1 51 ;IBQ;1=EOB without subsequent insurer,0=COB,2=0 balance 52 D ;I IBQ Q 53 . ;Check for no reimbursable subsequent insurance 54 . F I=IBBPY+1:1:3 D Q:'IBQ 55 .. S Z="IBNDI"_I,Z=$G(@Z) 56 .. I $P($G(^DIC(36,+Z,0)),U,2)="N" S IBQ=0 Q 57 . ;Check if next ins doesn't exist or next bill# already created 58 . S Z="IBNDI"_(IBBPY+1),Z=$G(@Z) 59 . I Z,'$P($G(^DGCR(399,IBIFN,"M1")),U,5+IBBPY) S IBQ=0 60 ; 61 ; Days since transmission of latest bill in COB - IBDAY 62 S IBDAY=+$P($G(^DGCR(399,IBIFN,"TX")),U,2) I IBDAY S IBDAY=$$FMDIFF^XLFDT(DT,IBDAY,1) 63 ; if no Last Electronic Extract Date on file 399, get it from file 364 64 I 'IBDAY D I IBDAY S IBDAY=$$FMDIFF^XLFDT(DT,IBDAY,1) ;calc. the difference 65 . S IBB364=$$LAST364^IBCEF4(IBIFN) I IBB364'="" S IBDAY=+$P($P($G(^IBA(364,IBB364,0)),U,4),".",1) 66 ; 67 S IBAPY=$$TPR^PRCAFN(IBIFN) ; payment on this bill from A/R 68 S IBEXPY=+$G(^IBM(361.1,IBDA,1)) ; payer paid amount 69 S IBPTRSP=$$PREOBTOT^IBCEU0(IBIFN) ; patient resp. function 70 S IBPY=$S(IBAPY:IBAPY,1:IBEXPY) 71 S IBOAM=+$G(^DGCR(399,IBIFN,"U1")) ; total charges for bill 72 S IBNBAL=IBOAM-IBPY 73 I IBNBAL'>0 S IBQ=2 74 S IBPTNM=$P($G(^DPT(+$P($G(^DGCR(399,IBIFN,0)),U,2),0)),U) I IBPTNM="" S IBPTNM="UNKNOWN" 75 S IBSRVC=$P($G(^DGCR(399,IBIFN,"U")),U) 76 S Z0=$S(IBSRT="B":IBMUT,IBSRT="D":-IBDAY,IBSRT="I":$P(IBINS2,U,2)_"~"_$P(IBINS2,U),IBSRT="M":$$EXTERNAL^DILFD(361.1,.13,"",$P(IB3611,"^",13)),IBSRT="R":-IBPTRSP,IBSRT="P":IBPTNM,IBSRT="S":IBSRVC,1:IBDT) 77 S ^TMP("IBCOBST",$J,Z0,IBIFN)=IBSRVC_U_IBOAM_U_IBAPY_U_$S(IBNBAL>0:IBNBAL,1:0)_U_$P(IBB,U,5)_U_$P(IBB,U,19)_U_IBBPY_U_$P(IBMUT,"~")_U_IBINS_U_IBDA_U_$$HIS(IBIFN)_U_IBDAY_U_IBDT_U_IBQ_U_IB364_U_IBSEQ_U_IBEXPY_U_IBPTRSP 78 S ^TMP("IBCOBST",$J,Z0,IBIFN,1)=$$EXTERNAL^DILFD(361.1,.13,"",$P(IB3611,"^",13))_", "_$$FMTE^XLFDT($P($P(IB3611,"^",6),"."))_"^"_$P(IB3611,"^",16) 79 S ^TMP("IBCOBSTX",$J,IBIFN)=IBDA ;keep track of compiled IBIFN's 80 ; 81 ; Save some data when there are multiple MRA's on file for this bill 82 S IBMRACNT=$$MRACNT^IBCEMU1(IBIFN) 83 I IBMRACNT>1 S $P(^TMP("IBCOBST",$J,Z0,IBIFN,1),U,1)="Multiple MRA's on file" 84 S $P(^TMP("IBCOBST",$J,Z0,IBIFN,1),U,3)=IBMRACNT 85 S $P(^TMP("IBCOBST",$J,Z0,IBIFN,1),U,4)=IBDENDUP 86 Q 87 ; 88 HIS(IBIFN) ; COB history 89 N A,B,IBST,IBBIL,IBHIS 90 S IBHIS="",A=0 F S A=$O(^IBM(361.1,"ABS",IBIFN,A)) Q:'A S B=0 F S B=$O(^IBM(361.1,"ABS",IBIFN,A,B)) Q:'B D 91 . S IBST=$P($G(^IBM(361.1,B,0)),U,4),IBBIL=$P(^DGCR(399,IBIFN,"M1"),U,4+A) 92 . Q:IBBIL="" 93 . S IBHIS=IBHIS_$S(IBHIS="":"",1:";")_$S(A=1:"PRIMARY",A=2:"SECONDARY",1:"TERTIARY")_" "_$S(IBST:"MRA",1:"EOB")_" RECEIVED - "_IBBIL 94 Q IBHIS 95 ; 96 NMAT ;No COB list 97 S VALMCNT=2,IBCNT=2 98 S ^TMP("IBCECOB",$J,1,0)=" " 99 S ^TMP("IBCECOB",$J,2,0)=" No MRA's Matching Selection Criteria Were Found" 100 Q 101 ; 102 SCRN ; 103 N IBX,IBCNT,IBIFN,IBDA,IB,X,IBS1,IBPAT,Z,IBK,IBFORM 104 S IBCNT=0 105 S IBS1=$S(IBSRT="B":"BILLER",IBSRT="D":"Days Since Last Transmission",IBSRT="L":"Date Last MRA Received",IBSRT="I":"SECONDARY INSURANCE COMPANY",IBSRT="M":"MRA Status",1:"") 106 S IBX="" F S IBX=$O(^TMP("IBCOBST",$J,IBX)) Q:IBX="" D 107 . I IBSRT="B"!(IBSRT="I")!(IBSRT="M") D 108 .. D:IBCNT SET("",IBCNT+1) 109 .. D SET(IBS1_": "_$P(IBX,"~"),IBCNT+1) 110 . S IBIFN=0 F S IBIFN=$O(^TMP("IBCOBST",$J,IBX,IBIFN)) Q:'IBIFN D 111 .. S IB=$G(^TMP("IBCOBST",$J,IBX,IBIFN)) 112 .. S Z=$G(^DPT(+$P($G(^DGCR(399,IBIFN,0)),U,2),0)) 113 .. S IBPAT=$$LJ^XLFSTR($E($P(Z,U),1,18),18," ")_" "_$E($P(Z,U,9),6,9) 114 .. S IBDA=$P(IB,U,10) ;361.1-ien 115 .. S IBQ=$P(IB,U,14),IB364=$P(IB,U,15) 116 .. S IBFORM=$$EXTERNAL^DILFD(399,.19,,+$P(IB,U,6)) 117 .. I +$P(IB,U,6)=2 S IBFORM=1500 ; for space reasons 118 .. S IBPTRSP=$P(IB,U,18) 119 .. S IBAMT=$P(IB,U,2) 120 .. S IBCNT=IBCNT+1 121 .. S X="" 122 .. S X=$$SETFLD^VALM1(IBCNT,X,"NUMBER") 123 .. S X=$$SETFLD^VALM1($$BN1^PRCAFN(IBIFN)_$S($P($G(^DGCR(399,IBIFN,"TX")),U,10)=1:"*",1:""),X,"BILL") 124 .. S X=$$SETFLD^VALM1($$DAT1^IBOUTL($P(IB,U)),X,"SERVICE") 125 .. S X=$$SETFLD^VALM1(IBPAT,X,"PATNM") 126 .. S X=$$SETFLD^VALM1($$RJ^XLFSTR($FN(IBPTRSP,"",2),9," "),X,"PTRESP") 127 .. S X=$$SETFLD^VALM1($$RJ^XLFSTR($FN(IBAMT,"",2),9," "),X,"IBAMT") 128 .. S X=$$SETFLD^VALM1($$TYPE^IBJTLA1($P(IB,U,5))_"/"_IBFORM,X,"BTYPE") 129 .. D SET(X,IBCNT,IBIFN,IBDA,IBQ,IB364,IBX,IB) 130 .. ;For R (Pt Resp), P (Pt Name) and S (Service Date) don't display sub-headers 131 .. I "BIMRPS"'[IBSRT D 132 ... S Z=$S(IBSRT="L":$$DAT1^IBOUTL(IBX),IBSRT="D":-IBX,1:IBX) 133 ... D SET(" "_IBS1_": "_Z,IBCNT) 134 .. S X=$$SETSTR^VALM1("Insurers: "_$P(IB,U,9),"",7,74) 135 .. D SET(X,IBCNT,IBIFN,IBDA,IBQ,IB364,IBX,IB) 136 .. ; 137 .. ; line 3 of display: MRA status/date/split claim indicator 138 .. S X=$$SETSTR^VALM1("MRA Status: ","",5,13) 139 .. S IBK=$G(^TMP("IBCOBST",$J,IBX,IBIFN,1)) 140 .. S X=$$SETSTR^VALM1($P(IBK,U,1),X,18,63) 141 .. I $P(IBK,U,2)=2 S X=$$SETSTR^VALM1("** SPLIT CLAIM **",X,63,18) 142 .. I $P(IBK,U,4),$P(IBK,U,2)'=2,$P(IBK,U,3)=1 S X=$$SETSTR^VALM1("** Denied for Duplicate **",X,54,27) 143 .. D SET(X,IBCNT,IBIFN,IBDA,IBQ,IB364,IBX,IB) 144 .. ; 145 .. ; conditionally update video attributes of line 3 146 .. I '$D(IOINHI) D ENS^%ZISS 147 .. ; split claim 148 .. I $P(IBK,U,2)=2 D CNTRL^VALM10(VALMCNT,63,17,IOINHI,IOINORM) 149 .. ; multiple mra's on file 150 .. I $P(IBK,U,3)>1 D CNTRL^VALM10(VALMCNT,18,22,IOINHI,IOINORM) 151 .. ; Denied for Duplicate - no split claim and single MRA only 152 .. I $P(IBK,U,4),$P(IBK,U,2)'=2,$P(IBK,U,3)=1 D CNTRL^VALM10(VALMCNT,54,26,IOINHI,IOINORM) 153 .. Q 154 Q 155 ; 156 SET(X,CNT,IBIFN,IBDA,IBQ,IB364,IBX,IB) ;set up list manager screen array 157 S VALMCNT=VALMCNT+1 158 S ^TMP("IBCECOB",$J,VALMCNT,0)=X 159 S ^TMP("IBCECOB",$J,"IDX",VALMCNT,CNT)="" 160 I $G(IBIFN),$G(^TMP("IBCECOB",$J,CNT))="" S ^TMP("IBCECOB",$J,CNT)=VALMCNT_U_IBIFN_U_IB364_U_IBDA_U_IBQ_U_IBX,^TMP("IBCECOB1",$J,CNT)=IB 161 Q 162 ; 163 FTYPE(Y) ;type classification 164 Q $E($P($G(^IBE(353,Y,0)),U),1,8) 165 ; 166 PTRESPI(IBEOB) ; Function - Computes the Patient's Responsibility based on IBEOB 167 ; of 361.1 for Claims/Bills with form type 3=UB 168 ; Input IBEOB - a single EOB ien; Required 169 ; Output - Function Returns IBPTRES - Patient Responsibility Amount for the EOB 170 ; 171 N IBPTRES,IBC,EOBADJ 172 S IBPTRES=0,IBEOB=+$G(IBEOB) 173 I 'IBEOB Q IBPTRES ;PTRESPI 174 ; 175 ; get claim level adjustments 176 K EOBADJ M EOBADJ=^IBM(361.1,IBEOB,10) 177 S IBPTRES=$$CALCPR^IBCEU0(.EOBADJ) 178 ; 179 ; get line level adjustments 180 S IBC=0 F S IBC=$O(^IBM(361.1,IBEOB,15,IBC)) Q:'IBC D 181 . K EOBADJ M EOBADJ=^IBM(361.1,IBEOB,15,IBC,1) 182 . S IBPTRES=IBPTRES+$$CALCPR^IBCEU0(.EOBADJ) 183 Q IBPTRES 184 ; 185 ELIG(IBEOB) ; Function to determine if an EOB entry is eligible for 186 ; inclusion on the MRA management worklist or not. 187 ; IBEOB - ien into file 361.1 (required) 188 ; Returns 1 if EOB should appear on the worklist 189 ; Returns 0 if EOB should not appear on the worklist 190 ; 191 NEW ELIG,IB3611,IBIFN 192 S ELIG=0,IBEOB=+$G(IBEOB) 193 S IB3611=$G(^IBM(361.1,IBEOB,0)) 194 I $P(IB3611,U,4)'=1 G ELIGX ; eob type must be Medicare MRA 195 I $P(IB3611,U,16)>2 G ELIGX ; review status must be <= 2 196 S IBIFN=+IB3611 197 I $P($G(^DGCR(399,IBIFN,0)),U,13)'=2 G ELIGX ; Request MRA bill status 198 I $D(^IBM(361.1,IBEOB,"ERR")) G ELIGX ; filing errors 199 ; 200 S ELIG=1 ; this EOB is eligible for the worklist 201 ; 202 ELIGX ; 203 Q ELIG 204 ; 1 IBCECOB1 ;ALB/CXW - IB COB MANAGEMENT SCREEN/REPORT ;14-JUN-99 2 ;;2.0;INTEGRATED BILLING;**137,155,288,348**;21-MAR-94;Build 5 3 ; 4 BLD ; Build list entrypoint 5 N I,IBFND,IBB,IBIFN,IB364,IBDA1,IBDTN,IBDA,IBDAY,IBHIS,IBNDS,IBEUT,IBAPY,IBOAM,IBDT,IBMUT,IBBPY,IBINS,IBNDM,IBQ,IBNDI1,IBNDI2,IBNDI3,Z,Z0,IBSEQ,IB3611,IBINS1,IBINS2,IBEXPY,IBNBAL,IBPTRSP,IBAMT,IBMRACNT,IBPTNM,IBSRVC,IBPY,IBB364 6 N IBEOBREV,IBDENDUP 7 K ^TMP("IBCECOB",$J),^TMP("IBCECOB1",$J),^TMP("IBCOBST",$J),^TMP("IBCOBSTX",$J) 8 D CLEAN^VALM10 ; kill data and video control arrays 9 S VALMCNT=0,IBHIS="" 10 ; since 0 is a valid Review Status, init w/null 11 S IBEOBREV="" 12 ; get EOB's w/Review Status of 0, 1, 1.5 or 2; If 3 or higher, not needed 13 F S IBEOBREV=$O(^IBM(361.1,"AMRA",1,IBEOBREV)) Q:IBEOBREV="" Q:IBEOBREV>2 D ; 14 . S IBDA="A" F S IBDA=$O(^IBM(361.1,"AMRA",1,IBEOBREV,IBDA),-1) Q:'IBDA D BLD1 15 ; no data accumulated 16 I $O(^TMP("IBCOBST",$J,""))="" D NMAT Q 17 ; display accumulated data 18 D SCRN 19 Q 20 BLD1 ; 21 I '$$ELIG(IBDA) Q 22 S IBDENDUP=$$DENDUP^IBCEMU4(IBDA) 23 I '$G(IBMRADUP),IBDENDUP Q ; don't include denied MRAs for Duplicate Claim/Service 24 S IB3611=$G(^IBM(361.1,IBDA,0)) 25 S IBIFN=+IB3611,IB364=$P(IB3611,U,19),IBDT=+$P(IB3611,U,6) 26 I $D(^TMP("IBCOBSTX",$J,IBIFN)) Q ;show each bill once on the worklist 27 S IBB=$G(^DGCR(399,IBIFN,0)) 28 S IBNDS=$G(^DGCR(399,IBIFN,"S")),IBNDI1=$G(^("I1")),IBNDI2=$G(^("I2")),IBNDI3=$G(^("I3")),IBNDM=$G(^("M")) 29 S IBMUT=+$P(IBNDS,U,8),IBEUT=+$P(IBNDS,U,2) 30 S IBINS="",IBSEQ=$P(IB3611,U,15) 31 F I=1:1:3 S Z="IBNDI"_I I @Z D 32 . N Q 33 . S Q=(IBSEQ=I) 34 . I Q S IBINS1=+@Z_U_$P($G(^DIC(36,+@Z,0)),U) 35 . S IBINS=IBINS_$S(IBINS="":"",1:", ")_$P($G(^DIC(36,+@Z,0)),U) 36 ; Get the payer/insurance company that comes after Medicare WNR 37 ; If WNR is Primary, get the secondary ins. co. 38 ; If WNR is secondary, get the tertiary ins. co. 39 D I $P(IBINS2,U,2)="" S $P(IBINS2,U,2)="UNKNOWN" 40 . I $$WNRBILL^IBEFUNC(IBIFN,1) S IBINS2=+IBNDI2_U_$P($G(^DIC(36,+IBNDI2,0)),U) Q 41 . S IBINS2=+IBNDI3_U_$P($G(^DIC(36,+IBNDI3,0)),U) 42 S IBFND=0 43 ; biller entry not ALL and no biller, then get entered/edited by user 44 I $D(^TMP("IBBIL",$J)) D Q:'IBFND 45 . S IBFND=$S($D(^TMP("IBBIL",$J,IBMUT)):IBMUT,$D(^TMP("IBBIL",$J,IBEUT)):IBEUT,1:0) 46 S Z=$S(IBFND:IBFND,IBMUT:IBMUT,1:IBEUT) 47 S IBMUT=$P($G(^VA(200,+Z,0)),U)_"~"_Z 48 S:'$P(IBMUT,"~",2) IBMUT="UNKNOWN~0" 49 S IBBPY=+$$COBN^IBCEF(IBIFN),IBQ=1 50 ;IBQ;1=EOB without subsequent insurer,0=COB,2=0 balance 51 D ;I IBQ Q 52 . ;Check for no reimbursable subsequent insurance 53 . F I=IBBPY+1:1:3 D Q:'IBQ 54 .. S Z="IBNDI"_I,Z=$G(@Z) 55 .. I $P($G(^DIC(36,+Z,0)),U,2)="N" S IBQ=0 Q 56 . ;Check if next ins doesn't exist or next bill# already created 57 . S Z="IBNDI"_(IBBPY+1),Z=$G(@Z) 58 . I Z,'$P($G(^DGCR(399,IBIFN,"M1")),U,5+IBBPY) S IBQ=0 59 ; 60 ; Days since transmission of latest bill in COB - IBDAY 61 S IBDAY=+$P($G(^DGCR(399,IBIFN,"TX")),U,2) I IBDAY S IBDAY=$$FMDIFF^XLFDT(DT,IBDAY,1) 62 ; if no Last Electronic Extract Date on file 399, get it from file 364 63 I 'IBDAY D I IBDAY S IBDAY=$$FMDIFF^XLFDT(DT,IBDAY,1) ;calc. the difference 64 . S IBB364=$$LAST364^IBCEF4(IBIFN) I IBB364'="" S IBDAY=+$P($P($G(^IBA(364,IBB364,0)),U,4),".",1) 65 ; 66 S IBAPY=$$TPR^PRCAFN(IBIFN) ; payment on this bill from A/R 67 S IBEXPY=+$G(^IBM(361.1,IBDA,1)) ; payer paid amount 68 S IBPTRSP=$$PREOBTOT^IBCEU0(IBIFN) ; patient resp. function 69 S IBPY=$S(IBAPY:IBAPY,1:IBEXPY) 70 S IBOAM=+$G(^DGCR(399,IBIFN,"U1")) ; total charges for bill 71 S IBNBAL=IBOAM-IBPY 72 I IBNBAL'>0 S IBQ=2 73 S IBPTNM=$P($G(^DPT(+$P($G(^DGCR(399,IBIFN,0)),U,2),0)),U) I IBPTNM="" S IBPTNM="UNKNOWN" 74 S IBSRVC=$P($G(^DGCR(399,IBIFN,"U")),U) 75 S Z0=$S(IBSRT="B":IBMUT,IBSRT="D":-IBDAY,IBSRT="I":$P(IBINS2,U,2)_"~"_$P(IBINS2,U),IBSRT="M":$$EXTERNAL^DILFD(361.1,.13,"",$P(IB3611,"^",13)),IBSRT="R":-IBPTRSP,IBSRT="P":IBPTNM,IBSRT="S":IBSRVC,1:IBDT) 76 S ^TMP("IBCOBST",$J,Z0,IBIFN)=IBSRVC_U_IBOAM_U_IBAPY_U_$S(IBNBAL>0:IBNBAL,1:0)_U_$P(IBB,U,5)_U_$P(IBB,U,19)_U_IBBPY_U_$P(IBMUT,"~")_U_IBINS_U_IBDA_U_$$HIS(IBIFN)_U_IBDAY_U_IBDT_U_IBQ_U_IB364_U_IBSEQ_U_IBEXPY_U_IBPTRSP 77 S ^TMP("IBCOBST",$J,Z0,IBIFN,1)=$$EXTERNAL^DILFD(361.1,.13,"",$P(IB3611,"^",13))_", "_$$FMTE^XLFDT($P($P(IB3611,"^",6),"."))_"^"_$P(IB3611,"^",16) 78 S ^TMP("IBCOBSTX",$J,IBIFN)=IBDA ;keep track of compiled IBIFN's 79 ; 80 ; Save some data when there are multiple MRA's on file for this bill 81 S IBMRACNT=$$MRACNT^IBCEMU1(IBIFN) 82 I IBMRACNT>1 S $P(^TMP("IBCOBST",$J,Z0,IBIFN,1),U,1)="Multiple MRA's on file" 83 S $P(^TMP("IBCOBST",$J,Z0,IBIFN,1),U,3)=IBMRACNT 84 S $P(^TMP("IBCOBST",$J,Z0,IBIFN,1),U,4)=IBDENDUP 85 Q 86 ; 87 HIS(IBIFN) ; COB history 88 N A,B,IBST,IBBIL,IBHIS 89 S IBHIS="",A=0 F S A=$O(^IBM(361.1,"ABS",IBIFN,A)) Q:'A S B=0 F S B=$O(^IBM(361.1,"ABS",IBIFN,A,B)) Q:'B D 90 . S IBST=$P($G(^IBM(361.1,B,0)),U,4),IBBIL=$P(^DGCR(399,IBIFN,"M1"),U,4+A) 91 . Q:IBBIL="" 92 . S IBHIS=IBHIS_$S(IBHIS="":"",1:";")_$S(A=1:"PRIMARY",A=2:"SECONDARY",1:"TERTIARY")_" "_$S(IBST:"MRA",1:"EOB")_" RECEIVED - "_IBBIL 93 Q IBHIS 94 ; 95 NMAT ;No COB list 96 S VALMCNT=2,IBCNT=2 97 S ^TMP("IBCECOB",$J,1,0)=" " 98 S ^TMP("IBCECOB",$J,2,0)=" No MRA's Matching Selection Criteria Were Found" 99 Q 100 ; 101 SCRN ; 102 N IBX,IBCNT,IBIFN,IBDA,IB,X,IBS1,IBPAT,Z,IBK,IBFORM 103 S IBCNT=0 104 S IBS1=$S(IBSRT="B":"BILLER",IBSRT="D":"Days Since Last Transmission",IBSRT="L":"Date Last MRA Received",IBSRT="I":"SECONDARY INSURANCE COMPANY",IBSRT="M":"MRA Status",1:"") 105 S IBX="" F S IBX=$O(^TMP("IBCOBST",$J,IBX)) Q:IBX="" D 106 . I IBSRT="B"!(IBSRT="I")!(IBSRT="M") D 107 .. D:IBCNT SET("",IBCNT+1) 108 .. D SET(IBS1_": "_$P(IBX,"~"),IBCNT+1) 109 . S IBIFN=0 F S IBIFN=$O(^TMP("IBCOBST",$J,IBX,IBIFN)) Q:'IBIFN D 110 .. S IB=$G(^TMP("IBCOBST",$J,IBX,IBIFN)) 111 .. S Z=$G(^DPT(+$P($G(^DGCR(399,IBIFN,0)),U,2),0)) 112 .. S IBPAT=$$LJ^XLFSTR($E($P(Z,U),1,18),18," ")_" "_$E($P(Z,U,9),6,9) 113 .. S IBDA=$P(IB,U,10) ;361.1-ien 114 .. S IBQ=$P(IB,U,14),IB364=$P(IB,U,15) 115 .. S IBFORM=$$EXTERNAL^DILFD(399,.19,,+$P(IB,U,6)) 116 .. I +$P(IB,U,6)=2 S IBFORM=1500 ; for space reasons 117 .. S IBPTRSP=$P(IB,U,18) 118 .. S IBAMT=$P(IB,U,2) 119 .. S IBCNT=IBCNT+1 120 .. S X="" 121 .. S X=$$SETFLD^VALM1(IBCNT,X,"NUMBER") 122 .. S X=$$SETFLD^VALM1($$BN1^PRCAFN(IBIFN),X,"BILL") 123 .. S X=$$SETFLD^VALM1($$DAT1^IBOUTL($P(IB,U)),X,"SERVICE") 124 .. S X=$$SETFLD^VALM1(IBPAT,X,"PATNM") 125 .. S X=$$SETFLD^VALM1($$RJ^XLFSTR($FN(IBPTRSP,"",2),9," "),X,"PTRESP") 126 .. S X=$$SETFLD^VALM1($$RJ^XLFSTR($FN(IBAMT,"",2),9," "),X,"IBAMT") 127 .. S X=$$SETFLD^VALM1($$TYPE^IBJTLA1($P(IB,U,5))_"/"_IBFORM,X,"BTYPE") 128 .. D SET(X,IBCNT,IBIFN,IBDA,IBQ,IB364,IBX,IB) 129 .. ;For R (Pt Resp), P (Pt Name) and S (Service Date) don't display sub-headers 130 .. I "BIMRPS"'[IBSRT D 131 ... S Z=$S(IBSRT="L":$$DAT1^IBOUTL(IBX),IBSRT="D":-IBX,1:IBX) 132 ... D SET(" "_IBS1_": "_Z,IBCNT) 133 .. S X=$$SETSTR^VALM1("Insurers: "_$P(IB,U,9),"",7,74) 134 .. D SET(X,IBCNT,IBIFN,IBDA,IBQ,IB364,IBX,IB) 135 .. ; 136 .. ; line 3 of display: MRA status/date/split claim indicator 137 .. S X=$$SETSTR^VALM1("MRA Status: ","",5,13) 138 .. S IBK=$G(^TMP("IBCOBST",$J,IBX,IBIFN,1)) 139 .. S X=$$SETSTR^VALM1($P(IBK,U,1),X,18,63) 140 .. I $P(IBK,U,2)=2 S X=$$SETSTR^VALM1("** SPLIT CLAIM **",X,63,18) 141 .. I $P(IBK,U,4),$P(IBK,U,2)'=2,$P(IBK,U,3)=1 S X=$$SETSTR^VALM1("** Denied for Duplicate **",X,54,27) 142 .. D SET(X,IBCNT,IBIFN,IBDA,IBQ,IB364,IBX,IB) 143 .. ; 144 .. ; conditionally update video attributes of line 3 145 .. I '$D(IOINHI) D ENS^%ZISS 146 .. ; split claim 147 .. I $P(IBK,U,2)=2 D CNTRL^VALM10(VALMCNT,63,17,IOINHI,IOINORM) 148 .. ; multiple mra's on file 149 .. I $P(IBK,U,3)>1 D CNTRL^VALM10(VALMCNT,18,22,IOINHI,IOINORM) 150 .. ; Denied for Duplicate - no split claim and single MRA only 151 .. I $P(IBK,U,4),$P(IBK,U,2)'=2,$P(IBK,U,3)=1 D CNTRL^VALM10(VALMCNT,54,26,IOINHI,IOINORM) 152 .. Q 153 Q 154 ; 155 SET(X,CNT,IBIFN,IBDA,IBQ,IB364,IBX,IB) ;set up list manager screen array 156 S VALMCNT=VALMCNT+1 157 S ^TMP("IBCECOB",$J,VALMCNT,0)=X 158 S ^TMP("IBCECOB",$J,"IDX",VALMCNT,CNT)="" 159 I $G(IBIFN),$G(^TMP("IBCECOB",$J,CNT))="" S ^TMP("IBCECOB",$J,CNT)=VALMCNT_U_IBIFN_U_IB364_U_IBDA_U_IBQ_U_IBX,^TMP("IBCECOB1",$J,CNT)=IB 160 Q 161 ; 162 FTYPE(Y) ;type classification 163 Q $E($P($G(^IBE(353,Y,0)),U),1,8) 164 ; 165 PTRESPI(IBEOB) ; Function - Computes the Patient's Responsibility based on IBEOB 166 ; of 361.1 for Claims/Bills with form type 3=UB 167 ; Input IBEOB - a single EOB ien; Required 168 ; Output - Function Returns IBPTRES - Patient Responsibility Amount for the EOB 169 ; 170 N IBPTRES,IBC,EOBADJ 171 S IBPTRES=0,IBEOB=+$G(IBEOB) 172 I 'IBEOB Q IBPTRES ;PTRESPI 173 ; 174 ; get claim level adjustments 175 K EOBADJ M EOBADJ=^IBM(361.1,IBEOB,10) 176 S IBPTRES=$$CALCPR^IBCEU0(.EOBADJ) 177 ; 178 ; get line level adjustments 179 S IBC=0 F S IBC=$O(^IBM(361.1,IBEOB,15,IBC)) Q:'IBC D 180 . K EOBADJ M EOBADJ=^IBM(361.1,IBEOB,15,IBC,1) 181 . S IBPTRES=IBPTRES+$$CALCPR^IBCEU0(.EOBADJ) 182 Q IBPTRES 183 ; 184 ELIG(IBEOB) ; Function to determine if an EOB entry is eligible for 185 ; inclusion on the MRA management worklist or not. 186 ; IBEOB - ien into file 361.1 (required) 187 ; Returns 1 if EOB should appear on the worklist 188 ; Returns 0 if EOB should not appear on the worklist 189 ; 190 NEW ELIG,IB3611,IBIFN 191 S ELIG=0,IBEOB=+$G(IBEOB) 192 S IB3611=$G(^IBM(361.1,IBEOB,0)) 193 I $P(IB3611,U,4)'=1 G ELIGX ; eob type must be Medicare MRA 194 I $P(IB3611,U,16)>2 G ELIGX ; review status must be <= 2 195 S IBIFN=+IB3611 196 I $P($G(^DGCR(399,IBIFN,0)),U,13)'=2 G ELIGX ; Request MRA bill status 197 I $D(^IBM(361.1,IBEOB,"ERR")) G ELIGX ; filing errors 198 ; 199 S ELIG=1 ; this EOB is eligible for the worklist 200 ; 201 ELIGX ; 202 Q ELIG 203 ;
Note:
See TracChangeset
for help on using the changeset viewer.
