- IBJTBA1 ;ALB/TMK/PJH - TPJI BILL CHARGE INFO SCREEN ;Sep 30, 2014@12:07:36
- ;;2.0;INTEGRATED BILLING;**135,265,155,349,417,451,488,511,613**;21-MAR-94;Build 28
- ;Per VA Directive 6402, this routine should not be modified.
- ;
- SHEOB(IBI,IBSPL,IBEOBCT,IBCTOF) ; Format EOB called from IBJTBA
- ; IBSPL = 0 if EOB represents one bill's payment
- ; = 1 if AR had to split the EOB between multiple bills
- ; Assumes IBLN is defined and returns it with line count
- ; Assumes IBEOBDET may be defined as a flag to control detail level of print
- N X,IBPT,IBCN,IBM,IBM1,IBM2,IBTY,IBPY,IBPR,IBST,IBSTR,IBCA,IBTS,IBTA,Z,Z0
- S X="0.00"
- S IBM=$G(^IBM(361.1,IBI,0))
- S IBTY=$P(IBM,U,4),IBTY=$S(IBTY:"MEDICARE MRA",1:"NORMAL EOB")
- I IBTY'["MRA",IBSPL S IBTY="A/R SPLIT/COVERS MORE THAN 1 BILL"
- I $P(IBM,U,13)>1,$P(IBM,U,13)<5 S IBTY=IBTY_" ("_$$EXTERNAL^DILFD(361.1,.13,,$P(IBM,U,13))_")"
- S IBCN=$P(IBM,U,14),IBPY=$P(IBM,U,2)
- S:IBPY IBPY=$P($G(^DIC(36,IBPY,0)),U)
- S IBPR=$$FMTE^XLFDT($P(IBM,U,6)),IBST=$P(IBM,U,16)
- S IBST=$$EXPAND^IBTRE(361.1,.16,+IBST)
- S IBM1=$G(^IBM(361.1,IBI,1))
- ;
- S IBPT=$P(IBM1,U,2) ; patient responsibility 1.02 file
- I $P(IBM,U,4),$D(^IBM(361.1,IBI,"ERR")) S IBPT=0 ; filing error
- ; If MRA & UB, then calculate patient responsiblity value
- I $P(IBM,U,4),$$FT^IBCEF(+$P(IBM,U,1))=3 S IBPT=$$PTRESPI^IBCECOB1(IBI)
- ;
- S IBCA=$P(IBM1,U)
- S IBM2=$G(^IBM(361.1,IBI,2)),IBTA=$P(IBM2,U,3)
- ; if no Total Allowed Amount, sum up amounts on Line Level Adjustment
- I IBTA="" S IBTA=$$ALLOWED^IBCEMU2(IBI)
- S IBTS=$P(IBM2,U,4)
- D MRA2
- S IBLN=$$SET^IBJTBA("",IBLN)
- I '$G(IBEOBDET),IBSPL D
- . S IBSTR=$$SETLN^IBJTBA(" **A/R CORRECTED PAYMENT DATA:","",1,50),IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- . S IBSTR=$$SETLN^IBJTBA(" TOTAL AMT PD: "_$J(+$P($G(^IBM(361.1,IBI,1)),U,1),"",2),"",1,75),IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- . S Z=0 F S Z=$O(^IBM(361.1,IBI,8,Z)) Q:'Z S Z0=$G(^(Z,0)) D
- .. S IBSTR=$$SETLN^IBJTBA($E($J("",8)_$S($P(Z0,U,3):$$BN1^PRCAFN(+$P(Z0,U,3)),1:"[suspense]"_$P(Z0,U))_$J("",25),1,25)_" "_$J(+$P(Z0,U,2),"",2),"",1,75),IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- ;
- I $G(IBEOBDET) D
- . I $P($G(^IBM(361.1,IBI,0)),U,4) D Q ; Medicare MRA processing
- .. N VALMCNT
- .. K ^TMP("IBCECSD",$J)
- .. D GETEOB^IBCECSA6(IBI,0,,+$G(IBLN)-1)
- .. S Z=0 F S Z=$O(^TMP("IBCECSD",$J,Z)) Q:'Z S IBSTR=$$SETLN^IBJTBA($G(^TMP("IBCECSD",$J,Z,0)),"",1,79),IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- .. K ^TMP("IBCECSD",$J)
- .. D EOBERR
- .. Q
- . ;
- . ; Normal EOB processing
- . N VALMCNT
- . K ^TMP("PRCA_EOB",$J)
- . ; IB*2*511 - do not display EEOB detail if EEOB has been "removed"
- . Q:$P($G(^IBM(361.1,IBI,102)),U)
- . D GETEOB^IBCECSA6(IBI,1)
- . S Z=0 F S Z=$O(^TMP("PRCA_EOB",$J,IBI,Z)) Q:'Z S IBSTR=$$SETLN^IBJTBA($G(^TMP("PRCA_EOB",$J,IBI,Z)),"",1,79),IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- . K ^TMP("PRCA_EOB",$J)
- . D EOBERR
- . Q
- ;
- Q
- ;
- MRA2 ;
- N IBD
- S IBLN=$$SET^IBJTBA("",IBLN)
- S IBD="EOB/MRA Information"_$S($D(IBCTOF):" ("_$G(IBEOBCT)_" OF "_IBCTOF_")",1:"")
- S IBSTR=$$SETLN^IBJTBA(IBD,"",30,45),$E(IBSTR,1,2)=">>",IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- ; IB*2*511 - do not display EEOB detail if EEOB has been removed
- I IBTY'["MRA",$P($G(^IBM(361.1,IBI,102)),U) D REMOVE Q
- S IBD="EOB Type: "_IBTY,IBSTR=$$SETLN^IBJTBA(IBD,"",5,59)
- S IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- S IBD="ICN: "_IBCN,IBSTR=$$SETLN^IBJTBA(IBD,"",10,30)
- S IBD="Patient Resp Amount: "_$S('IBPT:X,1:IBPT)
- S IBSTR=$$SETLN^IBJTBA(IBD,IBSTR,44,35)
- S IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- S IBD="Payer Name: "_IBPY,IBSTR=$$SETLN^IBJTBA(IBD,"",3,40)
- S IBD="Total Allowed Amount: "_$S('IBTA:X,1:IBTA)
- S IBSTR=$$SETLN^IBJTBA(IBD,IBSTR,43,36)
- S IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- S IBD="EOB Date: "_IBPR,IBSTR=$$SETLN^IBJTBA(IBD,"",5,35)
- S IBD="Total Submitted Charges: "_$S('IBTS:X,1:IBTS)
- S IBSTR=$$SETLN^IBJTBA(IBD,IBSTR,40,39)
- S IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- S IBD="Svc From Dt: "_$$DAT1^IBOUTL($P(IBM1,U,10))
- S IBSTR=$$SETLN^IBJTBA(IBD,"",2,38)
- S IBD="Svc To Dt: "_$$DAT1^IBOUTL($P(IBM1,U,11))
- S IBSTR=$$SETLN^IBJTBA(IBD,IBSTR,54,25)
- S IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- S IBSTR=""
- I IBTY["MRA" S IBD="MRA Review Status: "_IBST,IBSTR=$$SETLN^IBJTBA(IBD,"",2,38)
- S IBD=$S('$G(IBSPL):" ",1:"**")_"Reported Payment Amt: "_$S('IBCA:$J(X,"",2),1:$J(+IBCA,"",2))
- S IBSTR=$$SETLN^IBJTBA(IBD,IBSTR,41,37)
- S IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- ;
- ; begin IB*2.0*451
- ; display Trace # and ERA # for every EOB record found. MRAs will not have an ERA #, only a Trace #
- I IBTY]"" D
- . N IBAPS,IBERAE,IBTRACE
- . S IBTRACE=$P($G(^IBM(361.1,IBI,0)),U,7)
- . I IBTRACE]"" S IBERAE=$O(^RCY(344.4,"D",IBTRACE,""))
- . S IBD=" ERA #: "_$G(IBERAE),IBSTR=$$SETLN^IBJTBA(IBD,"",1,25)
- . ; include AUTO-POST STATUS for auto-posted ERAs
- . ; *613 to fix undefined variable
- . I $G(IBERAE)]"" S IBAPS=$P($G(^RCY(344.4,IBERAE,4)),"^",2) I IBAPS]"" D
- . . S IBD=IBD_" Auto-Post Status: "_$S(IBAPS=2:"Complete",1:"Not Complete") S IBSTR=$$SETLN^IBJTBA(IBD,"",1,80)
- . S IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- . S IBD=" Trace #: "_$G(IBTRACE),IBSTR=$$SETLN^IBJTBA(IBD,"",1,80) ; Trace # can be up to 50 characters long
- . S IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- . S IBLN=$$SET^IBJTBA("",IBLN)
- ; end IB*2.0*451
- ;
- I IBTY["MRA",$D(^IBM(361.1,IBI,21)) D
- . S IBD=$TR($J("",35)," ","-")_"Review"_$TR($J("",38)," ","-")
- . S IBSTR=$$SETLN^IBJTBA(IBD,"",1,79),IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- . S (IBST,IBCN)=0 F S IBCN=$O(^IBM(361.1,IBI,21,IBCN)) Q:'IBCN S X=$G(^(IBCN,0)) D
- .. S IBST=0
- .. S IBD="Review Date: "_$$DAT1^IBOUTL($P(X,U))
- .. S IBSTR=$$SETLN^IBJTBA(IBD,"",1,30)
- .. S IBD="Reviewed By: "_$P($G(^VA(200,+$P(X,U,2),0)),U)
- .. S IBSTR=$$SETLN^IBJTBA(IBD,IBSTR,40,39)
- .. S IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- .. S IBD=0 F S IBD=$O(^IBM(361.1,IBI,21,IBCN,1,IBD)) Q:'IBD S IBSTR=$$SETLN^IBJTBA($S('IBST:"Comments: ",1:"")_$G(^(IBD,0)),"",1,$S('IBST:69,1:79)),IBST=1,IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- . I 'IBST D
- .. S IBSTR=$$SETLN^IBJTBA("None","",1,10)
- .. S IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- ;
- MOVE ;
- ;Display details of any EEOB MOVE/COPY
- I IBTY'["MRA",$D(^IBM(361.1,IBI,101)) D
- .N IEN101,FIRST101 S IEN101=0,FIRST101=1
- .F S IEN101=$O(^IBM(361.1,IBI,101,IEN101)) Q:'IEN101 D
- ..N IB101,IB102,IBDATE,IBUSER,IBJS,IBJS1,IBJS2,IBORIG,IBDIR
- ..S IB101=$G(^IBM(361.1,IBI,101,IEN101,0)) Q:IB101=""
- ..D GETAUDIT(IB101)
- ..I FIRST101 D
- ...S IBSTR=$$SETLN^IBJTBA("MOVE/COPY/REMOVE HISTORY","",1,78),FIRST101=0
- ...S IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- ..S IBLN=$$SET^IBJTBA("",IBLN)
- ..S:IBDIR']"" IBDIR="Move"
- ..S IBSTR=$$SETLN^IBJTBA("Date/Time of EEOB "_IBDIR_": "_IBDATE,"",1,78)
- ..S IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- ..S IBSTR=$$SETLN^IBJTBA(IBDIR_" of EEOB performed by: "_IBUSER,"",1,78)
- ..S IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- ..S IBSTR=$$SETLN^IBJTBA(IBDIR_" Justification Comments: ","",1,78)
- ..S IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- ..S IBSTR=$$SETLN^IBJTBA(IBJS,"",1,78)
- ..S IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- ..I IBJS1]"" D
- ...S IBSTR=$$SETLN^IBJTBA(IBJS1,"",1,78)
- ...S IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- ..I IBORIG]"" D
- ...S IBSTR=$$SETLN^IBJTBA("Original Claim Number: "_IBORIG,"",1,78)
- ...S IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- ..;Other claim numbers
- ..D OTHERS(IBI,IEN101)
- Q
- ;
- REMOVE ; Display Removal Reason and User
- N SUB,IB101,IBDATE,IBUSER,IBJS,IBJS1,IBJS2,IBORIG,IBDIR
- S SUB=$O(^IBM(361.1,IBI,101,"A"),-1) Q:'SUB
- S IB101=$G(^IBM(361.1,IBI,101,SUB,0)) Q:IB101=""
- D GETAUDIT(IB101)
- S IBSTR=$$SETLN^IBJTBA(" *** EEOB REMOVED ***","",1,78)
- S IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- S IBSTR=$$SETLN^IBJTBA("MOVE/COPY/REMOVE HISTORY","",1,78)
- S IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- S IBSTR=$$SETLN^IBJTBA("Date/Time EEOB Removed: "_IBDATE,"",1,78)
- S IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- S IBSTR=$$SETLN^IBJTBA("Remove of EEOB performed by: "_IBUSER,"",1,78)
- S IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- S IBSTR=$$SETLN^IBJTBA("Remove Justification Comments: ","",1,78)
- S IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- S IBSTR=$$SETLN^IBJTBA(IBJS,"",1,78)
- S IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- I IBJS1]"" S IBSTR=$$SETLN^IBJTBA(IBJS1,"",1,78),IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- ; display original claim
- I IBORIG]"" S IBSTR=$$SETLN^IBJTBA("Original Claim Number: "_IBORIG,"",1,78),IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- ;display OTHER claim numbers
- D OTHERS(IBI,SUB)
- Q
- ;
- EOBERR ; Display information about any 361.1 message storage or filing errors
- N ERRTXT,DASHES,Z
- S DASHES="---------------------------------------------------------------------"
- I '$O(^IBM(361.1,IBI,"ERR",0)) Q
- S IBSTR=$$SETLN^IBJTBA("VistA could not match all of the Line Level data received in the EEOB","",1,79),IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- S IBSTR=$$SETLN^IBJTBA("(835 Record 40) to the claim in VistA.","",1,79),IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- S IBLN=$$SET^IBJTBA("",IBLN)
- S Z=0 F S Z=$O(^IBM(361.1,IBI,"ERR",Z)) Q:'Z D
- .S ERRTXT=$G(^IBM(361.1,IBI,"ERR",Z,0))
- .I ERRTXT["##RAW DATA" S ERRTXT=DASHES
- .S IBSTR=$$SETLN^IBJTBA(ERRTXT,"",1,79),IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- Q
- ;
- GETAUDIT(IB101) ; retrieve audit data
- ; IB101 - string of data at the MOVE/COPY/REMOVE HISTORY multiple (361.1,101)
- S IBDATE=$$EXTERNAL^DILFD(361.1101,.01,,$P(IB101,U,1))
- S IBUSER=$$EXTERNAL^DILFD(361.1101,.02,,$P(IB101,U,2))
- S IBJS=$E($P(IB101,U,3),1,78),IBJS1=$E($P(IB101,U,3),79,100)
- S IBDIR=$$EXTERNAL^DILFD(361.1101,.05,,$P(IB101,U,5))
- S IBORIG=$$EXTERNAL^DILFD(361.1101,.04,,$P(IB101,U,4))
- Q
- ;
- OTHERS(IBI,IEN101) ; get other claim(s)
- ; IBI - ien for entry in 361.1
- ; IEN101 - sub-ien for entry in 361.1,101 multiple
- N SUB,IBOTH,OTEXT
- S SUB=0,OTEXT=""
- F S SUB=$O(^IBM(361.1,IBI,101,IEN101,1,SUB)) Q:'SUB D
- . S IBOTH=$P($G(^IBM(361.1,IBI,101,IEN101,1,SUB,0)),U) Q:'IBOTH
- . S IBOTH=$$EXTERNAL^DILFD(361.11016,.01,,IBOTH) Q:IBOTH=""
- . S OTEXT=OTEXT_","_IBOTH
- S OTEXT=$P(OTEXT,",",2,99)
- I OTEXT]"" S IBSTR=$$SETLN^IBJTBA("Other Claims: "_OTEXT,"",1,78),IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBJTBA1 9973 printed Apr 23, 2025@18:38:20 Page 2
- IBJTBA1 ;ALB/TMK/PJH - TPJI BILL CHARGE INFO SCREEN ;Sep 30, 2014@12:07:36
- +1 ;;2.0;INTEGRATED BILLING;**135,265,155,349,417,451,488,511,613**;21-MAR-94;Build 28
- +2 ;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- SHEOB(IBI,IBSPL,IBEOBCT,IBCTOF) ; Format EOB called from IBJTBA
- +1 ; IBSPL = 0 if EOB represents one bill's payment
- +2 ; = 1 if AR had to split the EOB between multiple bills
- +3 ; Assumes IBLN is defined and returns it with line count
- +4 ; Assumes IBEOBDET may be defined as a flag to control detail level of print
- +5 NEW X,IBPT,IBCN,IBM,IBM1,IBM2,IBTY,IBPY,IBPR,IBST,IBSTR,IBCA,IBTS,IBTA,Z,Z0
- +6 SET X="0.00"
- +7 SET IBM=$GET(^IBM(361.1,IBI,0))
- +8 SET IBTY=$PIECE(IBM,U,4)
- SET IBTY=$SELECT(IBTY:"MEDICARE MRA",1:"NORMAL EOB")
- +9 IF IBTY'["MRA"
- IF IBSPL
- SET IBTY="A/R SPLIT/COVERS MORE THAN 1 BILL"
- +10 IF $PIECE(IBM,U,13)>1
- IF $PIECE(IBM,U,13)<5
- SET IBTY=IBTY_" ("_$$EXTERNAL^DILFD(361.1,.13,,$PIECE(IBM,U,13))_")"
- +11 SET IBCN=$PIECE(IBM,U,14)
- SET IBPY=$PIECE(IBM,U,2)
- +12 if IBPY
- SET IBPY=$PIECE($GET(^DIC(36,IBPY,0)),U)
- +13 SET IBPR=$$FMTE^XLFDT($PIECE(IBM,U,6))
- SET IBST=$PIECE(IBM,U,16)
- +14 SET IBST=$$EXPAND^IBTRE(361.1,.16,+IBST)
- +15 SET IBM1=$GET(^IBM(361.1,IBI,1))
- +16 ;
- +17 ; patient responsibility 1.02 file
- SET IBPT=$PIECE(IBM1,U,2)
- +18 ; filing error
- IF $PIECE(IBM,U,4)
- IF $DATA(^IBM(361.1,IBI,"ERR"))
- SET IBPT=0
- +19 ; If MRA & UB, then calculate patient responsiblity value
- +20 IF $PIECE(IBM,U,4)
- IF $$FT^IBCEF(+$PIECE(IBM,U,1))=3
- SET IBPT=$$PTRESPI^IBCECOB1(IBI)
- +21 ;
- +22 SET IBCA=$PIECE(IBM1,U)
- +23 SET IBM2=$GET(^IBM(361.1,IBI,2))
- SET IBTA=$PIECE(IBM2,U,3)
- +24 ; if no Total Allowed Amount, sum up amounts on Line Level Adjustment
- +25 IF IBTA=""
- SET IBTA=$$ALLOWED^IBCEMU2(IBI)
- +26 SET IBTS=$PIECE(IBM2,U,4)
- +27 DO MRA2
- +28 SET IBLN=$$SET^IBJTBA("",IBLN)
- +29 IF '$GET(IBEOBDET)
- IF IBSPL
- Begin DoDot:1
- +30 SET IBSTR=$$SETLN^IBJTBA(" **A/R CORRECTED PAYMENT DATA:","",1,50)
- SET IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- +31 SET IBSTR=$$SETLN^IBJTBA(" TOTAL AMT PD: "_$JUSTIFY(+$PIECE($GET(^IBM(361.1,IBI,1)),U,1),"",2),"",1,75)
- SET IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- +32 SET Z=0
- FOR
- SET Z=$ORDER(^IBM(361.1,IBI,8,Z))
- if 'Z
- QUIT
- SET Z0=$GET(^(Z,0))
- Begin DoDot:2
- +33 SET IBSTR=$$SETLN^IBJTBA($EXTRACT($JUSTIFY("",8)_$SELECT($PIECE(Z0,U,3):$$BN1^PRCAFN(+$PIECE(Z0,U,3)),1:"[suspense]"_$PIECE(Z0,U))_$JUSTIFY("",25),1,25)_" "_$JUSTIFY(+$PIECE(Z0,U,2),"",2),"",1,75)
- SET IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- End DoDot:2
- End DoDot:1
- +34 ;
- +35 IF $GET(IBEOBDET)
- Begin DoDot:1
- +36 ; Medicare MRA processing
- IF $PIECE($GET(^IBM(361.1,IBI,0)),U,4)
- Begin DoDot:2
- +37 NEW VALMCNT
- +38 KILL ^TMP("IBCECSD",$JOB)
- +39 DO GETEOB^IBCECSA6(IBI,0,,+$GET(IBLN)-1)
- +40 SET Z=0
- FOR
- SET Z=$ORDER(^TMP("IBCECSD",$JOB,Z))
- if 'Z
- QUIT
- SET IBSTR=$$SETLN^IBJTBA($GET(^TMP("IBCECSD",$JOB,Z,0)),"",1,79)
- SET IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- +41 KILL ^TMP("IBCECSD",$JOB)
- +42 DO EOBERR
- +43 QUIT
- End DoDot:2
- QUIT
- +44 ;
- +45 ; Normal EOB processing
- +46 NEW VALMCNT
- +47 KILL ^TMP("PRCA_EOB",$JOB)
- +48 ; IB*2*511 - do not display EEOB detail if EEOB has been "removed"
- +49 if $PIECE($GET(^IBM(361.1,IBI,102)),U)
- QUIT
- +50 DO GETEOB^IBCECSA6(IBI,1)
- +51 SET Z=0
- FOR
- SET Z=$ORDER(^TMP("PRCA_EOB",$JOB,IBI,Z))
- if 'Z
- QUIT
- SET IBSTR=$$SETLN^IBJTBA($GET(^TMP("PRCA_EOB",$JOB,IBI,Z)),"",1,79)
- SET IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- +52 KILL ^TMP("PRCA_EOB",$JOB)
- +53 DO EOBERR
- +54 QUIT
- End DoDot:1
- +55 ;
- +56 QUIT
- +57 ;
- MRA2 ;
- +1 NEW IBD
- +2 SET IBLN=$$SET^IBJTBA("",IBLN)
- +3 SET IBD="EOB/MRA Information"_$SELECT($DATA(IBCTOF):" ("_$GET(IBEOBCT)_" OF "_IBCTOF_")",1:"")
- +4 SET IBSTR=$$SETLN^IBJTBA(IBD,"",30,45)
- SET $EXTRACT(IBSTR,1,2)=">>"
- SET IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- +5 ; IB*2*511 - do not display EEOB detail if EEOB has been removed
- +6 IF IBTY'["MRA"
- IF $PIECE($GET(^IBM(361.1,IBI,102)),U)
- DO REMOVE
- QUIT
- +7 SET IBD="EOB Type: "_IBTY
- SET IBSTR=$$SETLN^IBJTBA(IBD,"",5,59)
- +8 SET IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- +9 SET IBD="ICN: "_IBCN
- SET IBSTR=$$SETLN^IBJTBA(IBD,"",10,30)
- +10 SET IBD="Patient Resp Amount: "_$SELECT('IBPT:X,1:IBPT)
- +11 SET IBSTR=$$SETLN^IBJTBA(IBD,IBSTR,44,35)
- +12 SET IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- +13 SET IBD="Payer Name: "_IBPY
- SET IBSTR=$$SETLN^IBJTBA(IBD,"",3,40)
- +14 SET IBD="Total Allowed Amount: "_$SELECT('IBTA:X,1:IBTA)
- +15 SET IBSTR=$$SETLN^IBJTBA(IBD,IBSTR,43,36)
- +16 SET IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- +17 SET IBD="EOB Date: "_IBPR
- SET IBSTR=$$SETLN^IBJTBA(IBD,"",5,35)
- +18 SET IBD="Total Submitted Charges: "_$SELECT('IBTS:X,1:IBTS)
- +19 SET IBSTR=$$SETLN^IBJTBA(IBD,IBSTR,40,39)
- +20 SET IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- +21 SET IBD="Svc From Dt: "_$$DAT1^IBOUTL($PIECE(IBM1,U,10))
- +22 SET IBSTR=$$SETLN^IBJTBA(IBD,"",2,38)
- +23 SET IBD="Svc To Dt: "_$$DAT1^IBOUTL($PIECE(IBM1,U,11))
- +24 SET IBSTR=$$SETLN^IBJTBA(IBD,IBSTR,54,25)
- +25 SET IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- +26 SET IBSTR=""
- +27 IF IBTY["MRA"
- SET IBD="MRA Review Status: "_IBST
- SET IBSTR=$$SETLN^IBJTBA(IBD,"",2,38)
- +28 SET IBD=$SELECT('$GET(IBSPL):" ",1:"**")_"Reported Payment Amt: "_$SELECT('IBCA:$JUSTIFY(X,"",2),1:$JUSTIFY(+IBCA,"",2))
- +29 SET IBSTR=$$SETLN^IBJTBA(IBD,IBSTR,41,37)
- +30 SET IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- +31 ;
- +32 ; begin IB*2.0*451
- +33 ; display Trace # and ERA # for every EOB record found. MRAs will not have an ERA #, only a Trace #
- +34 IF IBTY]""
- Begin DoDot:1
- +35 NEW IBAPS,IBERAE,IBTRACE
- +36 SET IBTRACE=$PIECE($GET(^IBM(361.1,IBI,0)),U,7)
- +37 IF IBTRACE]""
- SET IBERAE=$ORDER(^RCY(344.4,"D",IBTRACE,""))
- +38 SET IBD=" ERA #: "_$GET(IBERAE)
- SET IBSTR=$$SETLN^IBJTBA(IBD,"",1,25)
- +39 ; include AUTO-POST STATUS for auto-posted ERAs
- +40 ; *613 to fix undefined variable
- +41 IF $GET(IBERAE)]""
- SET IBAPS=$PIECE($GET(^RCY(344.4,IBERAE,4)),"^",2)
- IF IBAPS]""
- Begin DoDot:2
- +42 SET IBD=IBD_" Auto-Post Status: "_$SELECT(IBAPS=2:"Complete",1:"Not Complete")
- SET IBSTR=$$SETLN^IBJTBA(IBD,"",1,80)
- End DoDot:2
- +43 SET IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- +44 ; Trace # can be up to 50 characters long
- SET IBD=" Trace #: "_$GET(IBTRACE)
- SET IBSTR=$$SETLN^IBJTBA(IBD,"",1,80)
- +45 SET IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- +46 SET IBLN=$$SET^IBJTBA("",IBLN)
- End DoDot:1
- +47 ; end IB*2.0*451
- +48 ;
- +49 IF IBTY["MRA"
- IF $DATA(^IBM(361.1,IBI,21))
- Begin DoDot:1
- +50 SET IBD=$TRANSLATE($JUSTIFY("",35)," ","-")_"Review"_$TRANSLATE($JUSTIFY("",38)," ","-")
- +51 SET IBSTR=$$SETLN^IBJTBA(IBD,"",1,79)
- SET IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- +52 SET (IBST,IBCN)=0
- FOR
- SET IBCN=$ORDER(^IBM(361.1,IBI,21,IBCN))
- if 'IBCN
- QUIT
- SET X=$GET(^(IBCN,0))
- Begin DoDot:2
- +53 SET IBST=0
- +54 SET IBD="Review Date: "_$$DAT1^IBOUTL($PIECE(X,U))
- +55 SET IBSTR=$$SETLN^IBJTBA(IBD,"",1,30)
- +56 SET IBD="Reviewed By: "_$PIECE($GET(^VA(200,+$PIECE(X,U,2),0)),U)
- +57 SET IBSTR=$$SETLN^IBJTBA(IBD,IBSTR,40,39)
- +58 SET IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- +59 SET IBD=0
- FOR
- SET IBD=$ORDER(^IBM(361.1,IBI,21,IBCN,1,IBD))
- if 'IBD
- QUIT
- SET IBSTR=$$SETLN^IBJTBA($SELECT('IBST:"Comments: ",1:"")_$GET(^(IBD,0)),"",1,$SELECT('IBST:69,1:79))
- SET IBST=1
- SET IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- End DoDot:2
- +60 IF 'IBST
- Begin DoDot:2
- +61 SET IBSTR=$$SETLN^IBJTBA("None","",1,10)
- +62 SET IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- End DoDot:2
- End DoDot:1
- +63 ;
- MOVE ;
- +1 ;Display details of any EEOB MOVE/COPY
- +2 IF IBTY'["MRA"
- IF $DATA(^IBM(361.1,IBI,101))
- Begin DoDot:1
- +3 NEW IEN101,FIRST101
- SET IEN101=0
- SET FIRST101=1
- +4 FOR
- SET IEN101=$ORDER(^IBM(361.1,IBI,101,IEN101))
- if 'IEN101
- QUIT
- Begin DoDot:2
- +5 NEW IB101,IB102,IBDATE,IBUSER,IBJS,IBJS1,IBJS2,IBORIG,IBDIR
- +6 SET IB101=$GET(^IBM(361.1,IBI,101,IEN101,0))
- if IB101=""
- QUIT
- +7 DO GETAUDIT(IB101)
- +8 IF FIRST101
- Begin DoDot:3
- +9 SET IBSTR=$$SETLN^IBJTBA("MOVE/COPY/REMOVE HISTORY","",1,78)
- SET FIRST101=0
- +10 SET IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- End DoDot:3
- +11 SET IBLN=$$SET^IBJTBA("",IBLN)
- +12 if IBDIR']""
- SET IBDIR="Move"
- +13 SET IBSTR=$$SETLN^IBJTBA("Date/Time of EEOB "_IBDIR_": "_IBDATE,"",1,78)
- +14 SET IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- +15 SET IBSTR=$$SETLN^IBJTBA(IBDIR_" of EEOB performed by: "_IBUSER,"",1,78)
- +16 SET IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- +17 SET IBSTR=$$SETLN^IBJTBA(IBDIR_" Justification Comments: ","",1,78)
- +18 SET IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- +19 SET IBSTR=$$SETLN^IBJTBA(IBJS,"",1,78)
- +20 SET IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- +21 IF IBJS1]""
- Begin DoDot:3
- +22 SET IBSTR=$$SETLN^IBJTBA(IBJS1,"",1,78)
- +23 SET IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- End DoDot:3
- +24 IF IBORIG]""
- Begin DoDot:3
- +25 SET IBSTR=$$SETLN^IBJTBA("Original Claim Number: "_IBORIG,"",1,78)
- +26 SET IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- End DoDot:3
- +27 ;Other claim numbers
- +28 DO OTHERS(IBI,IEN101)
- End DoDot:2
- End DoDot:1
- +29 QUIT
- +30 ;
- REMOVE ; Display Removal Reason and User
- +1 NEW SUB,IB101,IBDATE,IBUSER,IBJS,IBJS1,IBJS2,IBORIG,IBDIR
- +2 SET SUB=$ORDER(^IBM(361.1,IBI,101,"A"),-1)
- if 'SUB
- QUIT
- +3 SET IB101=$GET(^IBM(361.1,IBI,101,SUB,0))
- if IB101=""
- QUIT
- +4 DO GETAUDIT(IB101)
- +5 SET IBSTR=$$SETLN^IBJTBA(" *** EEOB REMOVED ***","",1,78)
- +6 SET IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- +7 SET IBSTR=$$SETLN^IBJTBA("MOVE/COPY/REMOVE HISTORY","",1,78)
- +8 SET IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- +9 SET IBSTR=$$SETLN^IBJTBA("Date/Time EEOB Removed: "_IBDATE,"",1,78)
- +10 SET IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- +11 SET IBSTR=$$SETLN^IBJTBA("Remove of EEOB performed by: "_IBUSER,"",1,78)
- +12 SET IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- +13 SET IBSTR=$$SETLN^IBJTBA("Remove Justification Comments: ","",1,78)
- +14 SET IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- +15 SET IBSTR=$$SETLN^IBJTBA(IBJS,"",1,78)
- +16 SET IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- +17 IF IBJS1]""
- SET IBSTR=$$SETLN^IBJTBA(IBJS1,"",1,78)
- SET IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- +18 ; display original claim
- +19 IF IBORIG]""
- SET IBSTR=$$SETLN^IBJTBA("Original Claim Number: "_IBORIG,"",1,78)
- SET IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- +20 ;display OTHER claim numbers
- +21 DO OTHERS(IBI,SUB)
- +22 QUIT
- +23 ;
- EOBERR ; Display information about any 361.1 message storage or filing errors
- +1 NEW ERRTXT,DASHES,Z
- +2 SET DASHES="---------------------------------------------------------------------"
- +3 IF '$ORDER(^IBM(361.1,IBI,"ERR",0))
- QUIT
- +4 SET IBSTR=$$SETLN^IBJTBA("VistA could not match all of the Line Level data received in the EEOB","",1,79)
- SET IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- +5 SET IBSTR=$$SETLN^IBJTBA("(835 Record 40) to the claim in VistA.","",1,79)
- SET IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- +6 SET IBLN=$$SET^IBJTBA("",IBLN)
- +7 SET Z=0
- FOR
- SET Z=$ORDER(^IBM(361.1,IBI,"ERR",Z))
- if 'Z
- QUIT
- Begin DoDot:1
- +8 SET ERRTXT=$GET(^IBM(361.1,IBI,"ERR",Z,0))
- +9 IF ERRTXT["##RAW DATA"
- SET ERRTXT=DASHES
- +10 SET IBSTR=$$SETLN^IBJTBA(ERRTXT,"",1,79)
- SET IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- End DoDot:1
- +11 QUIT
- +12 ;
- GETAUDIT(IB101) ; retrieve audit data
- +1 ; IB101 - string of data at the MOVE/COPY/REMOVE HISTORY multiple (361.1,101)
- +2 SET IBDATE=$$EXTERNAL^DILFD(361.1101,.01,,$PIECE(IB101,U,1))
- +3 SET IBUSER=$$EXTERNAL^DILFD(361.1101,.02,,$PIECE(IB101,U,2))
- +4 SET IBJS=$EXTRACT($PIECE(IB101,U,3),1,78)
- SET IBJS1=$EXTRACT($PIECE(IB101,U,3),79,100)
- +5 SET IBDIR=$$EXTERNAL^DILFD(361.1101,.05,,$PIECE(IB101,U,5))
- +6 SET IBORIG=$$EXTERNAL^DILFD(361.1101,.04,,$PIECE(IB101,U,4))
- +7 QUIT
- +8 ;
- OTHERS(IBI,IEN101) ; get other claim(s)
- +1 ; IBI - ien for entry in 361.1
- +2 ; IEN101 - sub-ien for entry in 361.1,101 multiple
- +3 NEW SUB,IBOTH,OTEXT
- +4 SET SUB=0
- SET OTEXT=""
- +5 FOR
- SET SUB=$ORDER(^IBM(361.1,IBI,101,IEN101,1,SUB))
- if 'SUB
- QUIT
- Begin DoDot:1
- +6 SET IBOTH=$PIECE($GET(^IBM(361.1,IBI,101,IEN101,1,SUB,0)),U)
- if 'IBOTH
- QUIT
- +7 SET IBOTH=$$EXTERNAL^DILFD(361.11016,.01,,IBOTH)
- if IBOTH=""
- QUIT
- +8 SET OTEXT=OTEXT_","_IBOTH
- End DoDot:1
- +9 SET OTEXT=$PIECE(OTEXT,",",2,99)
- +10 IF OTEXT]""
- SET IBSTR=$$SETLN^IBJTBA("Other Claims: "_OTEXT,"",1,78)
- SET IBLN=$$SET^IBJTBA(IBSTR,IBLN)
- +11 QUIT
- +12 ;
