Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBJTEP

IBJTEP.m

Go to the documentation of this file.
  1. IBJTEP ;ALB/TJB - TP ERA/835 INFORMATION SCREEN ;20 Dec 2018 14:47:23
  1. ;;2.0;INTEGRATED BILLING;**530,609,633,639,642**;21-MAR-94;Build 22
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. EN ; -- main entry point for IBJT ERA 835 INFORMATION
  1. D EN^VALM("IBJT ERA 835 INFORMATION")
  1. Q
  1. ;
  1. HDR ; -- header code
  1. N IBRP,IBREJ S IBRP(U)=", "
  1. ; Add the EEOB, Reject and ECME indicators to the Bill
  1. S IBREJ=$S($$BILLREJ^IBJTU6(EPBILL):"c",1:"")
  1. S VALMHDR(1)=$$EEOB^IBJTLA1(IBIFN)_IBREJ_EPBILL_$$ECME^IBTRE(IBIFN)_" "_$E(EPNM,1,20)_" "_EPSS_" DOB: "_EPDOB_" Subsc ID: "_EPSID
  1. S VALMHDR(2)="Svc Date: "_EPDOS_" Orig Amt: "_EPAMT_" ERA#: "_$$REPLACE^XLFSTR(ERALST,.IBRP)
  1. Q
  1. ;
  1. INIT ; -- init variables and list array
  1. N AQ,EPIEN,EPTN,ERADA,ERAIEN,EPARR,EPPCT,EOBCT,EOBLST,EOBMX,FL,IBAR,IBI,IBCOL,IBEBERA,IBRX,IBSHEOB,IBSPEOB ; IB*2.0*633
  1. N II,LINE,QQ,RCBAMT,RCCOPY,RCRC,RCOIN,RCDED,RCERR,RCFLD,RMIEN,RCRDC,RCRLN,RCXY,RCMD,REMOVED,X,XX,Z
  1. S EOBMX=0
  1. S ERALST="",$P(SP80," ",80)=" "
  1. ; IBIFN comes in from the TPJI screen and will be cleaned up there
  1. I '$G(IBIFN) S VALMQUIT="" G INITQ
  1. K EPARR D BILL^IBRFN3(IBIFN,.EPARR) ; Get Bill information
  1. S EPBILL=EPARR("BN") ; K-Bill
  1. S EPPAT=$$GET1^DIQ(399,IBIFN_",",.02,"I") ; Get Patient IEN
  1. S EPNM=$$GET1^DIQ(399,IBIFN_",",.02) ; Get Patient Name
  1. ; Get Total Charges and justify the amount
  1. S EPAMT=$J(+EPARR("TCG"),$L(+EPARR("TCG")),2)
  1. S EPSS=$E(EPNM)_$$GET1^DIQ(2,EPPAT_",",.364) ; Get Short SSN
  1. S EPDOB=$$GET1^DIQ(2,EPPAT_",",.03) ; Get DOB
  1. S EPSID=$P(EPARR("PIN"),U,6) ; Get Subscriber ID
  1. S EPDOS=$$FMTE^XLFDT(EPARR("STF"),"5DZ") ; Get Date of Service
  1. S:EPARR("STF")'=EPARR("STT") EPDOS=EPDOS_" - "_$$FMTE^XLFDT(EPARR("STT"),"5DZ") ; If Bill for date range
  1. ; Check to see if we may have an EEOB if not report no ERA Information for this K-Bill
  1. S EPIEN=$O(^IBM(361.1,"B",$G(IBIFN),"")) I EPIEN="" S VALMCNT=2 D SET^VALM10(1," "),SET^VALM10(2,"No ERA Information for Bill: "_EPBILL) G INITQ
  1. ; Get % Collected from AR claim - IA 1452 - IB*2.0*609
  1. S IBAR=$$BILL^RCJIBFN2(IBIFN),IBCOL=$P(IBAR,U,5)
  1. ; Collect all possible EOBs associated with this Claim
  1. S ERAIEN=""
  1. ; IB*2.0*633 - Start modified block
  1. S IBSHEOB=0,IBI=0,RCCOPY=0
  1. F S IBI=$O(^IBM(361.1,"B",IBIFN,IBI)) Q:'IBI D ;
  1. . S IBSHEOB=IBSHEOB+1,IBSHEOB(IBI)=0
  1. . ; For each EOB get the associated ERAs from ADET index
  1. . S ERAIEN="" F S ERAIEN=$O(^RCY(344.4,"ADET",IBI,ERAIEN)) Q:'ERAIEN D ;
  1. . . S IBSHEOB(IBI,ERAIEN)=""
  1. . ; PRCA*4.5*332 - Start modified code block
  1. . I $O(IBSHEOB(IBI,""))="" D ; EOB not assocated with an ERA. Check if it was copied.
  1. . . I $$GET1^DIQ(361.1,IBI_",",.17,"I") Q ; Ignore manually entered EOB
  1. . . S X=$O(^IBM(361.1,IBI,101,"A"),-1)
  1. . . I X,$$GET1^DIQ(361.1101,X_","_IBI_",",.05,"I")="C" D ; EOB is a copy
  1. . . . S RCCOPY=RCCOPY+1
  1. . . . S RCCOPY(RCCOPY)=IBI
  1. ; IB*2.0*633 - End modified block
  1. ; Loop on the IEN for the EEOBs - exclude MRAs, but include all insurances
  1. S EPIEN="",LINE=0,EOBCT=0
  1. F S EPIEN=$O(IBSHEOB(EPIEN)) Q:EPIEN="" S ERADA="" F S ERADA=$O(IBSHEOB(EPIEN,ERADA)) Q:'ERADA D ; IB*2.0*633
  1. . Q:$P($G(^IBM(361.1,EPIEN,0)),U,4)=1 ; Get next because this is an MRA
  1. . S EPTN=$$GET1^DIQ(361.1,EPIEN_",",.07),ERAIEN=ERADA_"," ; IB*2.0*633
  1. . Q:U_ERALST_U[(U_ERAIEN_U) ; Quit if we have already reported this ERA #
  1. . K IBEPAR,IBPLB
  1. . D GETS^DIQ(344.4,ERAIEN,".01;.02;.03;.04;.05;.06;.07;.08;.09;.1;.11;.12;.13;.14;.15;4.02;","E","IBEPAR")
  1. . D GETS^DIQ(344.4,ERAIEN,"2*;","E","IBPLB") ; ERA Level Adjustments
  1. . Q:$D(IBEPAR)'>0 ; No IBEPAR - no data done with this record.
  1. . S ERALST=$$PUSH(ERALST,ERAIEN) S XLN="ERA#: "_$G(IBEPAR("344.4",ERAIEN,".01","E")),XSP=$E(SP80,1,(22-$L(XLN)))
  1. . S EPPCT=$S($G(EPARR("TCG"))>0:($G(IBEPAR("344.4",ERAIEN,".05","E"))/EPARR("TCG"))*100,1:0)
  1. . D SET(.LINE,"** ERA SUMMARY DATA ** ")
  1. . D SET(.LINE,XLN_XSP_"TRACE#: "_$G(IBEPAR("344.4",ERAIEN,".02","E")))
  1. . ; Holding onto the line below because the change of calculation
  1. . ; S XLN="ERA DATE (PAYER): "_$G(IBEPAR("344.4",ERAIEN,".04","E"))_" TOTAL AMT PD: "_$J($G(IBEPAR("344.4",ERAIEN,".05","E")),9)_" % COLLECTED: "_$J(EPPCT,6,2)
  1. . S XLN="ERA DATE (PAYER): "_$G(IBEPAR("344.4",ERAIEN,".04","E"))_" TOTAL AMT PD: "_$J($G(IBEPAR("344.4",ERAIEN,".05","E")),9)
  1. . D SET(.LINE,XLN)
  1. . D SET(.LINE,"PAYER NAME/TIN: "_$G(IBEPAR("344.4",ERAIEN,".06","E"))_"/"_$G(IBEPAR("344.4",ERAIEN,".03","E")))
  1. . D SET(.LINE,"FILE DATE/TIME: "_$G(IBEPAR("344.4",ERAIEN,".07","E")))
  1. . D SET(.LINE,"EFT MATCH STATUS: "_$G(IBEPAR("344.4",ERAIEN,".09","E")))
  1. . S XLN="ERA TYPE: "_$G(IBEPAR("344.4",ERAIEN,".1","E")),XSP=$E(SP80,1,(40-$L(XLN)))
  1. . D SET(.LINE,XLN_XSP_"INDIVIDUAL EOB COUNT: "_$G(IBEPAR("344.4",ERAIEN,".11","E")))
  1. . S XLN="MAIL MESSAGE: "_$G(IBEPAR("344.4",ERAIEN,".12","E")),XSP=$E(SP80,1,(40-$L(XLN)))
  1. . D SET(.LINE,XLN_XSP_"CHECK#: "_$G(IBEPAR("344.4",ERAIEN,".13","E")))
  1. . S XLN="DETAIL POST STATUS: "_$G(IBEPAR("344.4",ERAIEN,".14","E")),XSP=$E(SP80,1,(40-$L(XLN)))
  1. . D SET(.LINE,XLN_XSP_"EXPECTED PAYMENT METHOD CODE: "_$G(IBEPAR("344.4",ERAIEN,".15","E")))
  1. . D SET(.LINE," ")
  1. . D SET(.LINE,"********** ERA LEVEL ADJUSTMENTS **********")
  1. . I $D(IBPLB)=0 D SET(.LINE," -- NONE --")
  1. . D:$D(IBPLB)'=0 ; If we have PLB Data report it
  1. .. S FL="",RCF=0 F S FL=$O(IBPLB(344.42,FL)) Q:FL="" D
  1. ... I RCF'=0 D SET(.LINE," ")
  1. ... S RCF=RCF+1
  1. ... S XLN=" ADJUSTMENT REASON CODE: "_IBPLB(344.42,FL,.02,"E"),XSP=$E(SP80,1,(45-$L(XLN)))
  1. ... I $G(IBPLB(344.42,FL,.02,"E"))'="" S ACT=$$FIND1^DIC(345.1,,"B",IBPLB(344.42,FL,.02,"E")),ACT=$$GET1^DIQ(345.1,ACT,.05)
  1. ... D SET(.LINE,XLN_XSP_"ADJUSTMENT AMOUNT: "_$J(IBPLB(344.42,FL,.03,"E"),9))
  1. ... D SET(.LINE," ADJUSTMENT CODE TEXT: "_ACT)
  1. ... D SET(.LINE," REFERENCE: "_IBPLB(344.42,FL,.01,"E"))
  1. . D SET(.LINE," ")
  1. . K IBEBERA S ZZEPIEN=EPIEN D EEOB^IBJTEP1("IBEBERA",ERAIEN,EPBILL,1)
  1. . F EOBCT=1:1:IBEBERA D
  1. .. S EPIEN=$O(IBEBERA(EOBCT,""))
  1. .. I EPIEN,'$D(EOBLST(EPIEN)) D ;
  1. ... D EOBDET(EPIEN,0,EOBCT,IBEBERA,ERAIEN) ; PRCA*4.5*332
  1. ... S EOBLST(EPIEN)=""
  1. . D SET(.LINE,$TR(SP80," ","="))
  1. . S EPIEN=ZZEPIEN
  1. I RCCOPY D ;
  1. . S (X,XX)=0 F S X=$O(RCCOPY(X)) Q:'X D ; Display copied EOBs - PRCA*4.5*332
  1. . . I '$D(EOBLST(RCCOPY(X))) D ;
  1. . . . D EOBDET(RCCOPY(X),1,X,RCCOPY,"")
  1. . . . S EOBLST(RCCOPY(X))="",XX=XX+1
  1. . I XX D SET(.LINE,$TR(SP80," ","="))
  1. ; No EEOB IEN, then report that No ERA recieved for this bill
  1. I LINE=0 S VALMCNT=2 D SET^VALM10(1," "),SET^VALM10(2,"No ERA Information for Bill: "_EPBILL) G INITQ
  1. S VALMCNT=LINE
  1. ;
  1. INITQ K IBEPAR,IBPLB,IBEOB,IBDGCR,IBGX,IBSPL,IBEERR,TT,AA,EE,RCPL,ACT,ACNT,CC,XLN,XSP,XSP1,TSDT,TEDT,TRX,TECME,RCF,SP80,X,ZZEPIEN
  1. Q
  1. ;
  1. HELP ; -- help code
  1. S X="?" D DISP^XQORM1 W !!
  1. Q
  1. ;
  1. EXIT ; -- exit code
  1. K EPBILL,EPEOB,ERALST,EPPAT,EPNM,EPSS,EPDOB,EPDOS,EPSID,EPAMT,EPARR
  1. D CLEAR^VALM1,CLEAN^VALM10
  1. Q
  1. ;
  1. EXPND ; -- expand code
  1. Q
  1. ;
  1. PUSH(VAR,VALUE) ;
  1. S VALUE=$TR(VALUE,",") ; Remove Commas from string
  1. Q:$G(VAR)="" VALUE ; Empty variable
  1. ; If this VALUE is on the list don't add it a second time
  1. I U_VAR_U[(U_VALUE_U) Q VAR
  1. Q VAR_U_VALUE
  1. ;
  1. ; IB*2.0*642 - 2020/02/05:DM removed to meet SAC line limit
  1. ; Get the code modifier description
  1. ;MODC(MCD) ;
  1. ; Q:$G(MCD)="" "No Modifier Code Description"
  1. ; N ZZIEN,ZZDEC
  1. ; S ZZIEN=$$FIND1^DIC(81.3,,"BX","26","","","")
  1. ; S ZZDEC=$$GET1^DIQ(81.3,ZZIEN_",",.02)
  1. ; Q:ZZDEC="" "No Modifier Code Description"
  1. ; Q ZZDEC
  1. ;
  1. SET(LINE,DATA) ; -- set arrays
  1. ; LINE = line number passed by reference
  1. ; DATA = string to add to displayed data
  1. S LINE=LINE+1
  1. D SET^VALM10(LINE,$G(DATA))
  1. Q
  1. ; PRCA*4.5*332 - Move EOB display into its own subroutine
  1. EOBDET(EPIEN,TYPE,EOBCT,IBEBERA,ERAIEN) ; Add EOB detail to List Manager Array
  1. ; Input: EPIEN - Internal entry number to file 361.1
  1. ; TYPE - 0 - EEOB associated with an ERA, 1 - Copied EOB created by split/edit or link payment
  1. ; EOBCT - Count# of this EOB within the ERA
  1. ; IBEBERA - Number of EOBs for this bill in this ERA
  1. ; ERAIEN - Internal entry number from file 344.4
  1. ;
  1. N IBEOB,IBGX,IBCL,IBDGCR,IBRX,IBSPL,IBEERR,RCTRACE
  1. D GETS^DIQ(361.1,EPIEN_",",".01;.02;.03;.04;.06;.07;.14;1.01;1.02;1.03;1.1;1.11;2.03;2.04;3.03;3.04;3.05;3.06;3.07;102;104","EI","IBEOB")
  1. D GETS^DIQ(361.1,EPIEN_",","10*;","EI","IBGX"),RESORT^IBJTEP1("IBGX",361.111),RESORT^IBJTEP1("IBGX",361.11) ; Claim Level Adjustments
  1. D GETS^DIQ(361.1,EPIEN_",","15*;","EI","IBCL") ; Line Level Adjustments
  1. D GETS^DIQ(361.1,EPIEN_",","8*;","EI","IBSPL") ; ERA Splits for this EEOB
  1. D GETS^DIQ(361.1,EPIEN_",","20;","","IBEERR") ; EOB Errors if they exist
  1. ; Make it easier to walk the data
  1. D RESORT^IBJTEP1("IBCL",361.11511),RESORT^IBJTEP1("IBCL",361.115),RESORT^IBJTEP1("IBCL",361.1151)
  1. D RESORT^IBJTEP1("IBCL",361.1152),RESORT^IBJTEP1("IBCL",361.1154)
  1. D GETS^DIQ(399,IBEOB(361.1,EPIEN_",",.01,"I")_",","460;","EI","IBDGCR")
  1. S RCTRACE=$G(IBEOB("361.1",EPIEN_",",".07","E"))
  1. I ERAIEN="",RCTRACE'="" S ERAIEN=$O(^RCY(344.4,"D",RCTRACE,""))
  1. D SET(.LINE,"********** "_$S(TYPE=0:"",1:"COPIED ")_"EOB/835 INFORMATION ("_EOBCT_" of "_IBEBERA_") **********")
  1. I $G(IBEOB("361.1",EPIEN_",","102","I")) D Q ; EOB Removed
  1. . D EOBREM^IBJTEP1(EPIEN,.LINE)
  1. . D SET(.LINE,$TR(SP80," ","-"))
  1. ;
  1. I $G(ERADA) D ; ORIGINAL PATIENT NAME added in IB*2.0*639
  1. . S ERAIEN("p344.41")=$O(^RCY(344.4,ERADA,1,"AC",EPIEN,0))
  1. . I ERAIEN("p344.41") D ; POINTER TO ERA DETAIL 344.41
  1. . . S XLN=" Free Text Patient Name: "_$$GET1^DIQ(344.41,ERAIEN("p344.41")_","_ERADA_",",.15,"E")
  1. . . D SET(.LINE,XLN)
  1. E D ;
  1. . S ERAIEN("p344.41")=$G(IBEOB("361.1",EPIEN_",","104","E"))
  1. . I ERAIEN("p344.41")'="" D ;
  1. . . S XLN=" Free Text Patient Name: "_$$GET1^DIQ(344.41,ERAIEN("p344.41"),.15,"E")
  1. . . D SET(.LINE,XLN)
  1. ;
  1. S XLN=" EOB Type: "_$G(IBEOB("361.1",EPIEN_",",".04","E")),XSP=$E(SP80,1,(40-$L(XLN)))
  1. D SET(.LINE,XLN_XSP_"EOB Paid Date: "_$G(IBEOB("361.1",EPIEN_",",".06","E")))
  1. S TSDT=$$FMTE^XLFDT($G(IBEOB("361.1",EPIEN_",","1.1","I")),"2Z"),TEDT=$$FMTE^XLFDT($G(IBEOB("361.1",EPIEN_",","1.11","I")),"2Z"),XLN=" Svc From Date: "_TSDT,XSP=$E(SP80,1,(40-$L(XLN)))
  1. D SET(.LINE,XLN_XSP_"Svc to Date: "_TEDT)
  1. D SET(.LINE," ICN: "_$G(IBEOB("361.1",EPIEN_",",".14","E")))
  1. D SET(.LINE," Payer Name/TIN: "_$G(IBEOB("361.1",EPIEN_",",".02","E"))_"/"_$G(IBEOB("361.1",EPIEN_",",".03","E")))
  1. I ERAIEN D ;
  1. . S XLN=" ERA #: "_$$GET1^DIQ(344.4,ERAIEN_",",".01","E"),XSP=$E(SP80,1,(40-$L(XLN)))
  1. . D SET(.LINE,XLN_XSP_"Auto-Post Status: "_$$GET1^DIQ(344.4,ERAIEN_",","4.02","E"))
  1. . D SET(.LINE," Trace #: "_$$GET1^DIQ(344.4,ERAIEN_",",".02","E"))
  1. E D ;
  1. . D SET(.LINE," Trace #: "_RCTRACE)
  1. S TECME=$P($G(IBDGCR(399,IBEOB(361.1,EPIEN_",",.01,"I")_",",460,"E")),";",1)
  1. D GETRX^IBJTEP1(EPIEN,.IBRX)
  1. S TRX=$$GET1^DIQ(52,+TECME_",",".01")_"/"_$G(IBRX("FILL"))_"/"_$G(IBRX("RELEASED STATUS"))
  1. I TECME="" S TRX=""
  1. S XLN=" ECME #: "_TECME,XSP=$E(SP80,1,(25-$L(XLN))),XSP1=$E(SP80,1,(39-$L(XLN_XSP_"DOS: "_$G(IBRX("DOS")))))
  1. D SET(.LINE,XLN_XSP_"DOS: "_$G(IBRX("DOS"))_XSP1_"Rx/Fill/Release Status: "_TRX)
  1. D SET(.LINE,"--------------------------------------------------------------------------------")
  1. D:$D(IBSPL)>1 ; This EEOB was split display split payment information
  1. . N SPL
  1. . D SET(.LINE,"** A/R CORRECTED PAYMENT DATA:")
  1. . D SET(.LINE," TOTAL AMT PD: "_$J(IBEOB(361.1,EPIEN_",",1.01,"E"),9,2))
  1. . S SPL="" F S SPL=$O(IBSPL(361.18,SPL)) Q:SPL="" D
  1. .. D SET(.LINE," "_$S(IBSPL(361.18,SPL,.03,"I")'="":$$BN1^PRCAFN(IBSPL(361.18,SPL,.03,"I"))_$J("",8),1:"[suspense] "_IBSPL(361.18,SPL,.01,"E"))_" "_$J(IBSPL(361.18,SPL,.02,"E"),9,2))
  1. . D SET(.LINE," ")
  1. D SET(.LINE,"CLAIM LEVEL PAY STATUS:")
  1. D SET(.LINE," Total Submitted Charges :"_$J($G(IBEOB("361.1",EPIEN_",","2.04","E")),11,2)_" Payer Covered Amount :"_$J($G(IBEOB("361.1",EPIEN_",","1.03","E")),11,2))
  1. D SET(.LINE," Payer Paid Amount :"_$J($G(IBEOB("361.1",EPIEN_",","1.01","E")),11,2)_" MEDICARE Allowed Amount :"_$J($G(IBEOB("361.1",EPIEN_",","2.03","E")),11,2))
  1. D SET(.LINE," Patient Responsibility :"_$J($G(IBEOB("361.1",EPIEN_",","1.02","E")),11,2)_" % Collected :"_$J(+IBCOL,11,0)_" %") ; IB*2.0*609
  1. D SET(.LINE,$TR(SP80," ","-"))
  1. D SET(.LINE,"CLAIM LEVEL ADJUSTMENTS:")
  1. S AA="",ACNT=0 F S AA=$O(IBGX(361.11,AA)) Q:AA="" S ACNT=ACNT+1,AQ="" D
  1. . S CC=AA F S CC=$O(IBGX(361.111,CC)) Q:$E(CC,1,$L(AA))'=AA D
  1. .. I AQ="" S AQ=$J(ACNT,3)_") "
  1. .. E S ACNT=ACNT+1,AQ=$J(ACNT,3)_") "
  1. .. D SET(.LINE,AQ_"ADJ. AMT: "_$J(IBGX(361.111,CC,.02,"E"),9,2)_" ADJ GROUP: "_IBGX(361.11,AA,.01,"I")_" => "_IBGX(361.11,AA,.01,"E"))
  1. .. S RMIEN=$$FIND1^DIC(345,"","BX",IBGX(361.111,CC,.01,"E"),"","","RCERR")
  1. .. I RMIEN'="" K RCERR,RCRDC,RCFLD S RCXY=$$GET1^DIQ(345,RMIEN_",",4,"","RCRDC","RCERR") D DLN^IBJTEP1("RCRDC","RCFLD",55,69)
  1. .. D SET(.LINE," ADJ. CODE: "_IBGX(361.111,CC,.01,"E")_" => "_RCFLD(1))
  1. .. I RCFLD>1 F II=2:1:RCFLD D SET(.LINE," "_RCFLD(II))
  1. I ACNT=0 D SET(.LINE," -- None --")
  1. D SET(.LINE,"CLAIM LEVEL REMARKS: ")
  1. S RCRC=0 F II="3.03","3.04","3.05","3.06","3.07" D:IBEOB("361.1",EPIEN_",",II,"E")'=""
  1. . ; Get IEN for this remark code - if no IEN then need to look at the data "RM1" to "RM5"
  1. . S RMIEN=$$FIND1^DIC(346,"","BX",IBEOB("361.1",EPIEN_",",II,"E"),"","","RCERR")
  1. . I RMIEN'="" K RCERR,RCRDC,RCFLD S RCXY=$$GET1^DIQ(346,RMIEN_",",4,"","RCRDC","RCERR") D DLN^IBJTEP1("RCRDC","RCFLD",57,69)
  1. . I RMIEN="" S RCFLD=$S(II="3.03":5.011,II="3.04":5.021,II="3.05":5.031,II="3.06":5.041,II="3.07":5.051,1:5.011) S RCRLN=$$GET1^DIQ(361.1,EPIEN_",",RCFLD)
  1. . S RCRC=RCRC+1 D SET(.LINE," --- REMARK CODE("_RCRC_"): "_IBEOB("361.1",EPIEN_",",II,"E")_" => "_RCFLD(1))
  1. . I RCFLD>1 F II=2:1:RCFLD D SET(.LINE," "_RCFLD(II))
  1. I RCRC=0 D SET(.LINE," -- None --")
  1. D SET(.LINE,$TR(SP80," ","-"))
  1. ; Walk through the line level information...
  1. D SET(.LINE,"EEOB LINE LEVEL ADJUSTMENTS:")
  1. K ^XTMP("IBJTEP",$J) M ^XTMP("IBJTEP",$J)=IBCL
  1. S RCPL=0,EE="" F S EE=$O(IBCL(361.115,EE)) Q:EE="" S RCPL=RCPL+1 D
  1. . S QQ=EE,RCMD="" F S QQ=$O(IBCL(361.1152,QQ)) Q:$E(QQ,1,$L(EE))'=EE S RCMD=IBCL(361.1152,QQ,.01,"I")
  1. . D SET(.LINE," # SV DT REVCD PROC MOD UNITS BILLED DEDUCT COINS ALLOW PYMT")
  1. . S RCBAMT=$$BILLN^IBJTEP1(IBEOB(361.1,EPIEN_",",.01,"I"),IBCL(361.115,EE,.1,"E"),IBCL(361.115,EE,.04,"E"))
  1. . S RCDED=$$ADJU^IBJTEP1("DEDUCT",.IBCL,EE),RCOIN=$$ADJU^IBJTEP1("COINS",.IBCL,EE) ; Get Deductable and Co-Insurance amts.
  1. . S XLN=$J(RCPL,2,0)_" "_$$FMTE^XLFDT(IBCL(361.115,EE,.16,"I"),"2Z")_" "_$$CJ^XLFSTR(IBCL(361.115,EE,.1,"E"),5)_" "_$$CJ^XLFSTR(IBCL(361.115,EE,.04,"E"),8)_$$CJ^XLFSTR(RCMD,5)_" "_$$CJ^XLFSTR(IBCL(361.115,EE,.11,"E"),3)
  1. . D SET(.LINE,XLN_" "_$J(RCBAMT,9,2)_$J(RCDED,8,2)_$J(RCOIN,8,2)_$J(IBCL(361.115,EE,.13,"E"),9,2)_$J(IBCL(361.115,EE,.03,"E"),9,2))
  1. . ; IB*2.0*642 - Add logic to display DRG/GRP Adjustment Weight
  1. . ; N SPL S SPL=$$SUPL^IBCECSA7($P(EE,",",2),$P(EE,",")) I SPL]"" D SET(.LINE,SPL)
  1. . D SET(.LINE," ")
  1. . D SET(.LINE," Product/Service Description:"_IBCL(361.115,EE,.09,"E"))
  1. . D SET(.LINE," Payer Policy Reference:"_$G(IBCL(361.11512,EE,.01,"E")))
  1. . D SET(.LINE," ")
  1. . S ACNT=0,AA=EE F S AA=$O(IBCL(361.1151,AA)) Q:$E(AA,1,$L(EE))'=EE D
  1. .. S ACNT=ACNT+1
  1. .. S CC=AA,RCRC=0 F S CC=$O(IBCL(361.11511,CC)) Q:$E(CC,1,$L(AA))'=AA D
  1. ... S RCRC=RCRC+1 D SET(.LINE," -> ADJ AMT: "_$J(IBCL(361.11511,CC,.02,"E"),9,2)_" ADJ GROUP: "_IBCL(361.1151,AA,.01,"I")_" - "_IBCL(361.1151,AA,.01,"E")_" "_$$CJ^XLFSTR("QTY: "_+$G(IBCL(361.11511,CC,.03,"E")),8))
  1. ... S RCXY=$$FIND1^DIC(345,"","BX",IBCL(361.11511,CC,.01,"E"),"","","RCERR")
  1. ... K RCRDC,RCERR S RCXY=$$GET1^DIQ(345,RCXY_",",4,"","RCRDC","RCERR")
  1. ... I $D(RCRDC)>0 K RCFLD D DLN^IBJTEP1("RCRDC","RCFLD",57,57)
  1. ... I $D(RCRDC)=0 K RCFLD S RCRDC(1)=IBCL(361.11511,CC,.04,"E") D DLN^IBJTEP1("RCRDC","RCFLD",57,57) ; If no data from file 345 use data from FMS
  1. ... D SET(.LINE," ADJ CODE: "_$$CJ^XLFSTR(IBCL(361.11511,CC,.01,"E"),5)_" "_RCFLD(1))
  1. ... I RCFLD>1 F II=2:1:RCFLD D SET(.LINE," "_RCFLD(II))
  1. . ; Display RARC Codes for this Line Item
  1. . I $D(IBCL(361.1154))'=0 S QQ=EE,RCMD="" F S QQ=$O(IBCL(361.1154,QQ)) Q:$E(QQ,1,$L(EE))'=EE D
  1. .. K RCERR,RCRDC,RCFLD
  1. .. S RMIEN=$$FIND1^DIC(346,"","BX",IBCL(361.1154,QQ,.02,"E"),"","","RCERR")
  1. .. ; avoid "undefined" if RMIEN could not be found *642
  1. .. I 'RMIEN S RCFLD=1,RCFLD(1)="*["_IBCL(361.1154,QQ,.02,"E")_"] code is not on file."
  1. .. I RMIEN S RCXY=$$GET1^DIQ(346,RMIEN_",",4,"","RCRDC","RCERR") D DLN^IBJTEP1("RCRDC","RCFLD",57,68)
  1. .. D SET(.LINE," --- RARC: "_IBCL(361.1154,QQ,.02,"E")_" - "_RCFLD(1))
  1. .. I RCFLD>1 F II=2:1:RCFLD D SET(.LINE," "_RCFLD(II))
  1. . D SET(.LINE," ")
  1. I ACNT=0 D SET(.LINE," -- No Line Level Adjustments --")
  1. ; If there are EOB Errors add them to the screen
  1. D:$D(IBEERR(361.1,EPIEN_",",20))>9
  1. . D SET(.LINE," "),SET(.LINE,"EEOB MESSAGE ERRORS:")
  1. . N II S II=0 F S II=$O(IBEERR(361.1,EPIEN_",",20,II)) Q:(II="")!(II'=+II) D SET(.LINE,$G(IBEERR(361.1,EPIEN_",",20,II)))
  1. Q