RCDPESR2 ;ALB/TMK/DWA - Server auto-upd - EDI Lockbox ;30 July 2018 20:13:45
;;4.5;Accounts Receivable;**173,216,208,230,252,264,269,271,298,321,332,424**;Mar 20, 1995;Build 11
;Per VA Directive 6402, this routine should not be modified.
; IA 4042 (IBCEOB)
;Reference to $$VALECME^BPSUTIL2 supported by IA# 6139
;
TASKERA(RCTDA) ; Task to upd ERA
; RCTDA = ien 344.5
N ZTDTH,ZTUCI,ZTSAVE,ZTIO,ZTDESC,ZTRTN,ZTSK,DIE,DR,DA
S (ZTSAVE("DT"),ZTSAVE("U"),ZTSAVE("DUZ"))="",ZTSAVE("ZTREQ")="@",ZTRTN="NEWERA^RCDPESR2("_RCTDA_",0)",ZTDTH=$H,ZTIO=""
D ^%ZTLOAD
Q
;
NEWERA(RCTDA,RCREFILE) ;Tasked
; Add new EOB's to IB & ERA tot rec to AR
; RCTDA = ien 344.5
; RCREFILE = 1: re-filing rec via exc proc
N DA,DIE,DR,Q,RCADJ,RCDUPERR,RCE,RCEC,RCERR,RCNEWTRC,RCPAYER,RCR1,RCRTOT,Z
S ZTREQ="@"
K ^TMP($J,"RCDPERA")
L +^RCY(344.5,RCTDA):5
I $D(ZTQUEUED) S DIE="^RCY(344.5,",DA=RCTDA,DR=".05////"_ZTSK_";.04////1" D ^DIE
I $P($G(^RCY(344.5,RCTDA,0)),U,5),'$G(RCREFILE) S DIE="^RCY(344.5,",DA=RCTDA,DR=".1////4;.08///1" D ^DIE
S RCR1=$P($G(^RCY(344.5,RCTDA,0)),U,7),RCPAYER=$P($G(^RCY(344.5,RCTDA,3)),U)
S RCRTOT=$S(RCR1:RCR1,1:$$ERATOT^RCDPESR6(RCTDA,.RCERR)) ; ERA rec
S RCDUPERR=$S($G(RCERR)="DUP"!($G(RCERR(1))=-2):$G(RCERR(1)),1:0) K RCERR(1)
I RCRTOT,'RCR1 S DIE="^RCY(344.5,",DR=".07////"_RCRTOT,DA=RCTDA D ^DIE
D:RCDUPERR'=-2 UPDEOB(RCTDA,5,$S('$G(RCREFILE):RCDUPERR,1:-1)) ; Add EOB det to IB
;PRCA*4.5*424 - Mark new zero balance ERA for auto-post
I RCRTOT D ;
. D UPDCON^RCDPESR6(RCRTOT),UPDADJ^RCDPESR6(RCRTOT),UPD3444^RCDPESR6(.RCRTOT) ; Bills added 344.41
. I $$ISZERO^RCDPEAP1(RCRTOT),$$AUTOCHK2^RCDPEAP1(RCRTOT,1) D ;
. . N RCFDA
. . S RCFDA(344.4,RCRTOT_",",4.02)=0
. . D FILE^DIE("","RCFDA")
; PRCA*4.5*424 - End modified code block
I RCRTOT,RCTDA S DIE="^RCY(344.5,",DR=".08////0;.1///@",DA=RCTDA D ^DIE
I 'RCRTOT D G QNEW
. I RCDUPERR Q:'RCTDA D S RCTDA="" Q
. . ;PRCA*4.5*332 - 27 July 2018
. . S DIE="^RCY(344.5,",DA=RCTDA,DR=".15///1" D ^DIE
. . L -^RCY(344.5,RCTDA)
. . ;PRCA*4.5*332 end
. S RCE(1)=$$FMTE^XLFDT($$NOW^XLFDT(),2)_" An error occurred while storing ERA data.",RCE(2)="No totals data was stored for this ERA record"_$S('$G(RCREFILE):" and an",1:" on this re-file attempt.")
. S RCE(3)=$S('$G(RCREFILE):"ERA transmission exception was created.",1:"")
. D WP^DIE(344.5,RCTDA_",",5,"A","RCE")
. S DIE="^RCY(344.5,",DA=RCTDA,DR=".07///@;.08////1;.1////1" D ^DIE
. K RCERR
. S RCERR(1)=$$FMTE^XLFDT($$NOW^XLFDT(),2)_" The ERA data could not be stored. The AR receipt",RCERR(2)=" for this data must be created/processed manually for the bills included"
. S RCERR(3)=" in this ERA."_$S('$G(RCREFILE):"",1:" This error occurred during a refile attempt."),RCERR(4)=" "
. D BULLERA^RCDPESR0("DF",RCTDA,$P($G(^RCY(344.5,RCTDA,0)),U,11),"EDI LBOX - TOTALS FILE EXCEPTION "_$E(RCPAYER,1,20),.RCERR,0)
. K RCERR
;
; PRCA*4.5*298 - MailMan message disabled, logic retained - 14 Feb 2014
;I $$ADJ^RCDPEU(RCRTOT,.RCADJ) D ;Bulletin adjs
;.S RCEC=$$ADJERR^RCDPESR3(.RCERR)
;.I RCADJ'=2 S RCEC=RCEC+1,RCERR(RCEC)=" THERE ARE ERA LEVEL ADJUSTMENT(S)",RCEC=RCEC+1,RCERR(RCEC)=" "
;.I RCADJ'=1 S RCEC=RCEC+1,RCERR(RCEC)=" THE FOLLOWING BILL(S) HAVE RETRACTIONS:" D
;..S (Q,Z)=0 S Z=0 F S Z=$O(RCADJ(RCRTOT,Z)) Q:'Z S:'Q RCEC=RCEC+1,RCERR(RCEC)=" " S Q=Q+1,RCERR(RCEC)=RCERR(RCEC)_" "_RCADJ(RCRTOT,Z) S:Q=4 Q=0
;..S RCEC=RCEC+1,RCERR(RCEC)=" "
;.D BULLERA^RCDPESR0("D",RCTDA,$P($G(^RCY(344.5,RCTDA,0)),U,11),"EDI LBOX - ERA HAS ADJ/TAKEBACKS "_$E(RCPAYER,1,20),.RCERR,0)
;-----
;
QNEW I RCTDA,'$P($G(^RCY(344.5,RCTDA,0)),U,8) D TEMPDEL^RCDPESR1(RCTDA) S RCTDA=""
I RCTDA,$P($G(^RCY(344.5,RCTDA,0)),U)'="" S DIE="^RCY(344.5,",DR=".04////0;.05///@"_$S('$G(RCR1)&$G(RCRTOT):";.07////"_RCRTOT,1:""),DA=RCTDA D ^DIE
K ^TMP($J,"RCDPERA")
I RCTDA L -^RCY(344.5,RCTDA)
Q
;
UPDEOB(RCTDA,RCFILE,DUP) ;Upd 361.1 from ERA msg in 344.5 or .4
;RCTDA = ien ERA msg in 344.5 or ;subfile in 344.4
;RCFILE = 4 file 344.4, 5 if 344.5
;DUP = msg # if dup msg, but not same # or -1 if same msg #
;Returned for each bill in ERA:
;^TMP($J,"RCDPEOB",n)=Bill ien^AR bill#^SrvDt^ECME#
;^TMP($J,"RCDPEOB",n,"EOB")=EOB ien^amt pd^ins co ptr^rev flg^EEOB pn^amtbld^^^^BPNPI^RNPI^ETQual^LN^FN
;^TMP($J,"RCDPEOB","ADJ",x)=adj rec ('02')
;Also:
;^TMP($J,"RCDPEOB","HDR")=hdr rec from txmn
;^TMP($J,"RCDPEOB","CONTACT")=ERA contact rec ('01')
;
;N RCGBL,RC,RC0,RCCT,RCCT1,RCEOB,RCBILL,RCDPBNPI,RCMNUM,RCIFN,RCIB,RCERR,RCSTAR,RCET,RCX,RCXMG,Z,Q,DA,DR,DIE
;N RCPAYER,RCFILED,RCEOBD,RCNOUPD,REFORM,RCSD,RCERR1,C5,ECMENUM
; PRCA*4.5*321 - re-ordered newed fields and added RCSTART
N C5,DA,DIE,DR,ECMENUM,N,Q,RC,RC0,RCBILL,RCCT,RCCT1,RCDPBNPI,RCEOB,RCEOBD,RCERR
N RCERR1,RCET,RCFILED,RCGBL,RCIB,RCIFN,RCMNUM,RCNOUPD,RCPAYER,RCSD,RCSRV,RCSTART
N RCX,RCXMG,REFORM,X,Y,Z
K ^TMP($J,"RCDP-EOB"),^TMP("RCDPERR-EOB",$J)
;
S RCPAYER="",RCFILED=1,RCNOUPD=0
I RCFILE=5 D
.S RCGBL=$NA(^RCY(344.5,RCTDA,2))
.S RCMNUM=+$G(^RCY(344.5,RCTDA,0)),RCXMG=$P($G(^(0)),U,11)
.I $G(DUP) S RCNOUPD=$S(DUP>0:+DUP,1:RCXMG)
.S ^TMP($J,"RCDPEOB","HDR")=$G(^RCY(344.5,RCTDA,2,1,0))
.I $G(RCNEWTRC)'="" S $P(^TMP($J,"RCDPEOB","HDR"),U,8)=RCNEWTRC ; PRCA*4.5*332 Update EEOB with -DUP trace#
.I $P(^TMP($J,"RCDPEOB","HDR"),U)["XFR",'$P($G(^RCY(344.5,RCTDA,0)),U,14) D
..D SENDACK^RCDPESR5(RCTDA,1)
..S DR=".14////1",DIE="^RCY(344.5,",DA=RCTDA D ^DIE
;
I RCFILE=4 D
.S RCGBL=$NA(^RCY(344.4,+RCTDA,1,+$P(RCTDA,";",2),1))
.S RCMNUM=$P($G(^RCY(344.4,+RCTDA,0)),U,12),RCXMG=$P($G(^(0)),U,12)
.S ^TMP($J,"RCDPEOB","HDR")=$G(^RCY(344.4,+RCTDA,1,+$P(RCTDA,";",2),1,1,0))
;
S RCPAYER=$P($G(^TMP($J,"RCDPEOB","HDR")),U,6)
S RCDPBNPI=$P($G(^TMP($J,"RCDPEOB","HDR")),U,18)
;
;srv dates
S RCSD=$NA(^TMP($J,"RCSRVDT")) K @RCSD
S RCSRV=0 ; PRCA*4.5*424
N CP5 S CP5="",RC=1,C5=0 ;retrofit 264 into 269
F S RC=$O(@RCGBL@(RC)) Q:'RC S RC0=$G(^(RC,0)) D
.I RC0<5 Q
.; PRCA*4.5*424 Use statement start date if service date is not present
.; Statement Start Date - 05 Record is mandatory
.I +RC0=5 D Q ;
..S C5=RC,CP5=$P(RC0,U,2) ;retrofit 264 into 269
..S @RCSD@(C5)=+$P(RC0,U,9)
..S RCSRV=0
.; service date for possible ECME# matching
.; PRCA*4.3*321 BEGIN
.I +RC0=40,$$VALECME^BPSUTIL2(CP5),C5,'RCSRV D
..I $P(RC0,U,19) S @RCSD@(C5)=+$P(RC0,U,19),RCSRV=1
;
S RC=1,(RCCT,RCCT1,RCX,REFORM)=0,RCBILL=""
S RCERR1=$NA(^TMP("RCERR1",$J)) K @RCERR1
F S RC=$O(@RCGBL@(RC)) Q:'RC S RC0=$G(^(RC,0)) D
.I RCFILE=5,+RC0=1 D Q
..S ^TMP($J,"RCDPEOB","CONTACT")=RC0
.;
.I RCFILE=5,+RC0=2 D Q
..S RCX=RCX+1,^TMP($J,"RCDPEOB","ADJ",RCX)=RC0
.I RCFILE=5,+RC0=3 D Q ; Adding logic for line type 03,Patch 269,DWA
..S $P(^TMP($J,"RCDPEOB","ADJ",RCX),U,5)=$P(RC0,U,2)
.;
.I +RC0=5 S RCCT=RCCT+1,RCCT1=0 D
..S REFORM=0,ECMENUM="" I $$VALECME^BPSUTIL2($P(RC0,U,2)) S ECMENUM=$P(RC0,U,2)
..S Z=$$BILL^RCDPESR1($P(RC0,U,2),$G(@RCSD@(RC)),.RCIB) ; look up claim ien by claim# or by ECME#
..I Z S RCBILL=$P($G(^PRCA(430,Z,0)),U) I RCBILL'="",RCBILL'=$P(RC0,U,2) S REFORM=1,$P(RC0,U,2)=RCBILL
..S RCBILL=$P(RC0,U,2)
..S Z=$S(Z>0:$S($G(RCIB):Z,1:-1),1:-1)
..S ^TMP($J,"RCDP-EOB",RCCT,0)=Z_U_RCBILL_U_$G(@RCSD@(RC))_U_ECMENUM
..S $P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U,5)=$P(RC0,U,3)_","_$P(RC0,U,4)_" "_$P(RC0,U,5) ;Save pt nm
..I Z>0 S Q=+$P($G(^PRCA(430,Z,0)),U,9) I $P($G(^RCD(340,Q,0)),U)["DIC(36," S $P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U,3)=+^RCD(340,Q,0) ;Save ins co
.;
.I +RC0>5,REFORM S $P(RC0,U,2)=RCBILL ;
.I +RC0=10 D ;Save amt pd/billed, rev flg
..S $P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U,2)=$S(+$P(RC0,U,11):$J($P(RC0,U,11)/100,"",2),1:0),$P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U,6)=$J($P(RC0,U,11),"",2)
..I $P(RC0,U,6)="Y"!($P(RC0,U,7)=22) S $P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U,4)=1
..S $P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U,10,14)=RCDPBNPI_U_$P(RC0,U,16,19)
.I +RC0=11 D ; Save Rendering Provider information from new style message
..S $P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U,10,14)=RCDPBNPI_U_$P(RC0,U,3,6)
..; End save of Rendering Provider
.I RCBILL=$P(RC0,U,2) S RCCT1=RCCT1+1,^TMP($J,"RCDP-EOB",RCCT,RCCT1,0)=RC0
;
S RCSTAR=$TR($J("",15)," ","*"),RCET=RCSTAR_"ERROR/WARNING EEOB DETAIL SEQ #"
S RCCT=0 F S RCCT=$O(^TMP($J,"RCDP-EOB",RCCT)) Q:'RCCT S RCIFN=+$G(^(RCCT,0)),RCBILL=$P($G(^(0)),U,2),^TMP($J,"RCDPEOB",RCCT)=$G(^TMP($J,"RCDP-EOB",RCCT,0)) D
.S RCEOB=-1,RCEOBD=""
.I $S(RCIFN>0:$P(^PRCA(430.3,+$P($G(^PRCA(430,+RCIFN,0)),U,8),0),U,3)'=102,RCIFN'>0&($G(DUP)'>0):1,1:0) D
..S @RCERR1@(RCCT)=" ",@RCERR1@(RCCT,1)=RCET_RCCT_RCSTAR
..S @RCERR1@(RCCT,2)="Bill "_RCBILL_" is"_$S(RCIFN>0:" not in an ACTIVE status in your A/R",1:"n't valid/wasn't found so its detail wasn't stored in IB")
..S:RCFILE=5 @RCERR1@(RCCT,"*")=@RCERR1@(RCCT,2)
..S @RCERR1@(RCCT,3)=" The reported amount paid on this bill was: "_$P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U,2)
..I RCIFN'>0 D
...S @RCERR1@(RCCT,4)=" If the bill is not for your site, it must be transferred to the"
...S @RCERR1@(RCCT,5)=" correct site and manually adjusted in your AR."
...S @RCERR1@(RCCT,6)=" You can perform this transfer using EDI Lockbox ERA/EEOB exception process."
...S @RCERR1@(RCCT,7)=" "
..D DISP1^RCDPESR5(RCCT,1)
..S Q=0 F S Q=$O(^TMP($J,"RCDP-EOB",RCCT,Q)) Q:'Q S ^TMP($J,"RCDPEOB",RCCT,Q)=$G(^TMP($J,"RCDP-EOB",RCCT,Q,0))
..S ^TMP($J,"RCDPEOB",RCCT)=^TMP($J,"RCDP-EOB",RCCT,0) M ^TMP($J,"RCDPEOB",RCCT,"ERR")=@RCERR1@(RCCT)
..I RCFILE=5 D ;Store err if trans-in failed
...N RCE,RC,DIE,X,Y,DA,DR
...S RCE(1)=$$FMTE^XLFDT($$NOW^XLFDT(),2)_" "_$G(@RCERR1@(RCCT,"*"))
...S RCE(2)=" ",RCFILED=0
...D WP^DIE(344.5,RCTDA_",",5,"A","RCE")
.I RCIFN>0 D
..N RCDUPEOB,RCALLDUP
..;Chk rec exists
..S RCDUPEOB=0
..S RCEOB=$$DUP^RCDPESR3(RCMNUM,RCIFN,$P($G(^TMP($J,"RCDPEOB",RCCT,"EOB")),U,2),$P($G(^TMP($J,"RCDPEOB",RCCT,"EOB")),U,6)) ;Same msg for update?
..I RCEOB,$P(RCEOB,U,2) S RCEOB=0 ;If chksum exists, let below check it
..S ^TMP($J,"RCDP-EOB",RCCT,.5,0)="835ERA" ;Needed - checksum
..S RCALLDUP=$$DUP^IBCEOB("^TMP("_$J_",""RCDP-EOB"","_RCCT_")",RCIFN)
..I $S(RCALLDUP:1,RCEOB:$G(DUP)'>0,1:0) D
...S RCDUPEOB=1
...D DUPREC^RCDPESR6(RCET,RCCT,RCSTAR,RCFILE,RCALLDUP,RCEOB,RCBILL,.RCDUPEOB)
...S:RCALLDUP RCEOBD=RCALLDUP
..;Add stub to 361.1
..I 'RCDUPEOB S RCEOB=+$$ADD3611^IBCEOB(RCMNUM,"","",RCIFN,1,"^TMP("_$J_",""RCDP-EOB"","_RCCT_")") ;IA 4042
..K ^TMP($J,"RCDP-EOB",RCCT,.5,0)
..I RCEOB<0 D:$G(DUP)'>0 Q
...S @RCERR1@(RCCT)=" ",^(RCCT,1)=RCET_RCCT_RCSTAR,RCFILED=0
...S @RCERR1@(RCCT,2)="Error - EEOB detail not added to IB for bill "_RCBILL,$P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U)=""
...S:RCFILE=5 @RCERR1@(RCCT,"*")=@RCERR1@(RCCT,2)
...D DISP1^RCDPESR5(RCCT,1)
...S Q=0 F S Q=$O(^TMP($J,"RCDP-EOB",RCCT,Q)) Q:'Q S ^TMP($J,"RCDPEOB",RCCT,Q)=$G(^TMP($J,"RCDP-EOB",RCCT,Q,0))
...S ^TMP($J,"RCDPEOB",RCCT)=^TMP($J,"RCDP-EOB",RCCT,0) M ^TMP($J,"RCDPEOB",RCCT,"ERR")=@RCERR1@(RCCT)
..;Upd 361.1, needs ^TMP($J,"RCDPEOB","HDR" and $J,"RCDP-EOB"
..I RCDUPEOB'<0 S RCNOUPD=0 D UPD3611^IBCEOB(RCEOB,RCCT,1)
..;errors in ^TMP("RCDPERR-EOB",$J
..I $O(^TMP("RCDPERR-EOB",$J,0)) D ERRUPD^IBCEOB(RCEOB,"RCDPERR-EOB")
..S $P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U)=$S('$G(RCEOBD):RCEOB,1:RCEOBD)
.K ^TMP("RCDPERR-EOB",$J)
;
I RCNOUPD D DUPERA^RCDPESR3($G(DUP),RCNOUPD)
I $O(@RCERR1@("")) D BULLS^RCDPESR3(RCFILE,RCTDA,$S(RCNOUPD:RCNOUPD,1:$G(DUP)),$G(RCXMG))
K ^TMP("RCDPERR-EOB",$J),^TMP($J,"RCDP-EOB"),@RCERR1,@RCSD
D CLEAN^DILF
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPESR2 11618 printed Oct 16, 2024@17:46:14 Page 2
RCDPESR2 ;ALB/TMK/DWA - Server auto-upd - EDI Lockbox ;30 July 2018 20:13:45
+1 ;;4.5;Accounts Receivable;**173,216,208,230,252,264,269,271,298,321,332,424**;Mar 20, 1995;Build 11
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ; IA 4042 (IBCEOB)
+4 ;Reference to $$VALECME^BPSUTIL2 supported by IA# 6139
+5 ;
TASKERA(RCTDA) ; Task to upd ERA
+1 ; RCTDA = ien 344.5
+2 NEW ZTDTH,ZTUCI,ZTSAVE,ZTIO,ZTDESC,ZTRTN,ZTSK,DIE,DR,DA
+3 SET (ZTSAVE("DT"),ZTSAVE("U"),ZTSAVE("DUZ"))=""
SET ZTSAVE("ZTREQ")="@"
SET ZTRTN="NEWERA^RCDPESR2("_RCTDA_",0)"
SET ZTDTH=$HOROLOG
SET ZTIO=""
+4 DO ^%ZTLOAD
+5 QUIT
+6 ;
NEWERA(RCTDA,RCREFILE) ;Tasked
+1 ; Add new EOB's to IB & ERA tot rec to AR
+2 ; RCTDA = ien 344.5
+3 ; RCREFILE = 1: re-filing rec via exc proc
+4 NEW DA,DIE,DR,Q,RCADJ,RCDUPERR,RCE,RCEC,RCERR,RCNEWTRC,RCPAYER,RCR1,RCRTOT,Z
+5 SET ZTREQ="@"
+6 KILL ^TMP($JOB,"RCDPERA")
+7 LOCK +^RCY(344.5,RCTDA):5
+8 IF $DATA(ZTQUEUED)
SET DIE="^RCY(344.5,"
SET DA=RCTDA
SET DR=".05////"_ZTSK_";.04////1"
DO ^DIE
+9 IF $PIECE($GET(^RCY(344.5,RCTDA,0)),U,5)
IF '$GET(RCREFILE)
SET DIE="^RCY(344.5,"
SET DA=RCTDA
SET DR=".1////4;.08///1"
DO ^DIE
+10 SET RCR1=$PIECE($GET(^RCY(344.5,RCTDA,0)),U,7)
SET RCPAYER=$PIECE($GET(^RCY(344.5,RCTDA,3)),U)
+11 ; ERA rec
SET RCRTOT=$SELECT(RCR1:RCR1,1:$$ERATOT^RCDPESR6(RCTDA,.RCERR))
+12 SET RCDUPERR=$SELECT($GET(RCERR)="DUP"!($GET(RCERR(1))=-2):$GET(RCERR(1)),1:0)
KILL RCERR(1)
+13 IF RCRTOT
IF 'RCR1
SET DIE="^RCY(344.5,"
SET DR=".07////"_RCRTOT
SET DA=RCTDA
DO ^DIE
+14 ; Add EOB det to IB
if RCDUPERR'=-2
DO UPDEOB(RCTDA,5,$SELECT('$GET(RCREFILE):RCDUPERR,1:-1))
+15 ;PRCA*4.5*424 - Mark new zero balance ERA for auto-post
+16 ;
IF RCRTOT
Begin DoDot:1
+17 ; Bills added 344.41
DO UPDCON^RCDPESR6(RCRTOT)
DO UPDADJ^RCDPESR6(RCRTOT)
DO UPD3444^RCDPESR6(.RCRTOT)
+18 ;
IF $$ISZERO^RCDPEAP1(RCRTOT)
IF $$AUTOCHK2^RCDPEAP1(RCRTOT,1)
Begin DoDot:2
+19 NEW RCFDA
+20 SET RCFDA(344.4,RCRTOT_",",4.02)=0
+21 DO FILE^DIE("","RCFDA")
End DoDot:2
End DoDot:1
+22 ; PRCA*4.5*424 - End modified code block
+23 IF RCRTOT
IF RCTDA
SET DIE="^RCY(344.5,"
SET DR=".08////0;.1///@"
SET DA=RCTDA
DO ^DIE
+24 IF 'RCRTOT
Begin DoDot:1
+25 IF RCDUPERR
if 'RCTDA
QUIT
Begin DoDot:2
+26 ;PRCA*4.5*332 - 27 July 2018
+27 SET DIE="^RCY(344.5,"
SET DA=RCTDA
SET DR=".15///1"
DO ^DIE
+28 LOCK -^RCY(344.5,RCTDA)
+29 ;PRCA*4.5*332 end
End DoDot:2
SET RCTDA=""
QUIT
+30 SET RCE(1)=$$FMTE^XLFDT($$NOW^XLFDT(),2)_" An error occurred while storing ERA data."
SET RCE(2)="No totals data was stored for this ERA record"_$SELECT('$GET(RCREFILE):" and an",1:" on this re-file attempt.")
+31 SET RCE(3)=$SELECT('$GET(RCREFILE):"ERA transmission exception was created.",1:"")
+32 DO WP^DIE(344.5,RCTDA_",",5,"A","RCE")
+33 SET DIE="^RCY(344.5,"
SET DA=RCTDA
SET DR=".07///@;.08////1;.1////1"
DO ^DIE
+34 KILL RCERR
+35 SET RCERR(1)=$$FMTE^XLFDT($$NOW^XLFDT(),2)_" The ERA data could not be stored. The AR receipt"
SET RCERR(2)=" for this data must be created/processed manually for the bills included"
+36 SET RCERR(3)=" in this ERA."_$SELECT('$GET(RCREFILE):"",1:" This error occurred during a refile attempt.")
SET RCERR(4)=" "
+37 DO BULLERA^RCDPESR0("DF",RCTDA,$PIECE($GET(^RCY(344.5,RCTDA,0)),U,11),"EDI LBOX - TOTALS FILE EXCEPTION "_$EXTRACT(RCPAYER,1,20),.RCERR,0)
+38 KILL RCERR
End DoDot:1
GOTO QNEW
+39 ;
+40 ; PRCA*4.5*298 - MailMan message disabled, logic retained - 14 Feb 2014
+41 ;I $$ADJ^RCDPEU(RCRTOT,.RCADJ) D ;Bulletin adjs
+42 ;.S RCEC=$$ADJERR^RCDPESR3(.RCERR)
+43 ;.I RCADJ'=2 S RCEC=RCEC+1,RCERR(RCEC)=" THERE ARE ERA LEVEL ADJUSTMENT(S)",RCEC=RCEC+1,RCERR(RCEC)=" "
+44 ;.I RCADJ'=1 S RCEC=RCEC+1,RCERR(RCEC)=" THE FOLLOWING BILL(S) HAVE RETRACTIONS:" D
+45 ;..S (Q,Z)=0 S Z=0 F S Z=$O(RCADJ(RCRTOT,Z)) Q:'Z S:'Q RCEC=RCEC+1,RCERR(RCEC)=" " S Q=Q+1,RCERR(RCEC)=RCERR(RCEC)_" "_RCADJ(RCRTOT,Z) S:Q=4 Q=0
+46 ;..S RCEC=RCEC+1,RCERR(RCEC)=" "
+47 ;.D BULLERA^RCDPESR0("D",RCTDA,$P($G(^RCY(344.5,RCTDA,0)),U,11),"EDI LBOX - ERA HAS ADJ/TAKEBACKS "_$E(RCPAYER,1,20),.RCERR,0)
+48 ;-----
+49 ;
QNEW IF RCTDA
IF '$PIECE($GET(^RCY(344.5,RCTDA,0)),U,8)
DO TEMPDEL^RCDPESR1(RCTDA)
SET RCTDA=""
+1 IF RCTDA
IF $PIECE($GET(^RCY(344.5,RCTDA,0)),U)'=""
SET DIE="^RCY(344.5,"
SET DR=".04////0;.05///@"_$SELECT('$GET(RCR1)&$GET(RCRTOT):";.07////"_RCRTOT,1:"")
SET DA=RCTDA
DO ^DIE
+2 KILL ^TMP($JOB,"RCDPERA")
+3 IF RCTDA
LOCK -^RCY(344.5,RCTDA)
+4 QUIT
+5 ;
UPDEOB(RCTDA,RCFILE,DUP) ;Upd 361.1 from ERA msg in 344.5 or .4
+1 ;RCTDA = ien ERA msg in 344.5 or ;subfile in 344.4
+2 ;RCFILE = 4 file 344.4, 5 if 344.5
+3 ;DUP = msg # if dup msg, but not same # or -1 if same msg #
+4 ;Returned for each bill in ERA:
+5 ;^TMP($J,"RCDPEOB",n)=Bill ien^AR bill#^SrvDt^ECME#
+6 ;^TMP($J,"RCDPEOB",n,"EOB")=EOB ien^amt pd^ins co ptr^rev flg^EEOB pn^amtbld^^^^BPNPI^RNPI^ETQual^LN^FN
+7 ;^TMP($J,"RCDPEOB","ADJ",x)=adj rec ('02')
+8 ;Also:
+9 ;^TMP($J,"RCDPEOB","HDR")=hdr rec from txmn
+10 ;^TMP($J,"RCDPEOB","CONTACT")=ERA contact rec ('01')
+11 ;
+12 ;N RCGBL,RC,RC0,RCCT,RCCT1,RCEOB,RCBILL,RCDPBNPI,RCMNUM,RCIFN,RCIB,RCERR,RCSTAR,RCET,RCX,RCXMG,Z,Q,DA,DR,DIE
+13 ;N RCPAYER,RCFILED,RCEOBD,RCNOUPD,REFORM,RCSD,RCERR1,C5,ECMENUM
+14 ; PRCA*4.5*321 - re-ordered newed fields and added RCSTART
+15 NEW C5,DA,DIE,DR,ECMENUM,N,Q,RC,RC0,RCBILL,RCCT,RCCT1,RCDPBNPI,RCEOB,RCEOBD,RCERR
+16 NEW RCERR1,RCET,RCFILED,RCGBL,RCIB,RCIFN,RCMNUM,RCNOUPD,RCPAYER,RCSD,RCSRV,RCSTART
+17 NEW RCX,RCXMG,REFORM,X,Y,Z
+18 KILL ^TMP($JOB,"RCDP-EOB"),^TMP("RCDPERR-EOB",$JOB)
+19 ;
+20 SET RCPAYER=""
SET RCFILED=1
SET RCNOUPD=0
+21 IF RCFILE=5
Begin DoDot:1
+22 SET RCGBL=$NAME(^RCY(344.5,RCTDA,2))
+23 SET RCMNUM=+$GET(^RCY(344.5,RCTDA,0))
SET RCXMG=$PIECE($GET(^(0)),U,11)
+24 IF $GET(DUP)
SET RCNOUPD=$SELECT(DUP>0:+DUP,1:RCXMG)
+25 SET ^TMP($JOB,"RCDPEOB","HDR")=$GET(^RCY(344.5,RCTDA,2,1,0))
+26 ; PRCA*4.5*332 Update EEOB with -DUP trace#
IF $GET(RCNEWTRC)'=""
SET $PIECE(^TMP($JOB,"RCDPEOB","HDR"),U,8)=RCNEWTRC
+27 IF $PIECE(^TMP($JOB,"RCDPEOB","HDR"),U)["XFR"
IF '$PIECE($GET(^RCY(344.5,RCTDA,0)),U,14)
Begin DoDot:2
+28 DO SENDACK^RCDPESR5(RCTDA,1)
+29 SET DR=".14////1"
SET DIE="^RCY(344.5,"
SET DA=RCTDA
DO ^DIE
End DoDot:2
End DoDot:1
+30 ;
+31 IF RCFILE=4
Begin DoDot:1
+32 SET RCGBL=$NAME(^RCY(344.4,+RCTDA,1,+$PIECE(RCTDA,";",2),1))
+33 SET RCMNUM=$PIECE($GET(^RCY(344.4,+RCTDA,0)),U,12)
SET RCXMG=$PIECE($GET(^(0)),U,12)
+34 SET ^TMP($JOB,"RCDPEOB","HDR")=$GET(^RCY(344.4,+RCTDA,1,+$PIECE(RCTDA,";",2),1,1,0))
End DoDot:1
+35 ;
+36 SET RCPAYER=$PIECE($GET(^TMP($JOB,"RCDPEOB","HDR")),U,6)
+37 SET RCDPBNPI=$PIECE($GET(^TMP($JOB,"RCDPEOB","HDR")),U,18)
+38 ;
+39 ;srv dates
+40 SET RCSD=$NAME(^TMP($JOB,"RCSRVDT"))
KILL @RCSD
+41 ; PRCA*4.5*424
SET RCSRV=0
+42 ;retrofit 264 into 269
NEW CP5
SET CP5=""
SET RC=1
SET C5=0
+43 FOR
SET RC=$ORDER(@RCGBL@(RC))
if 'RC
QUIT
SET RC0=$GET(^(RC,0))
Begin DoDot:1
+44 IF RC0<5
QUIT
+45 ; PRCA*4.5*424 Use statement start date if service date is not present
+46 ; Statement Start Date - 05 Record is mandatory
+47 ;
IF +RC0=5
Begin DoDot:2
+48 ;retrofit 264 into 269
SET C5=RC
SET CP5=$PIECE(RC0,U,2)
+49 SET @RCSD@(C5)=+$PIECE(RC0,U,9)
+50 SET RCSRV=0
End DoDot:2
QUIT
+51 ; service date for possible ECME# matching
+52 ; PRCA*4.3*321 BEGIN
+53 IF +RC0=40
IF $$VALECME^BPSUTIL2(CP5)
IF C5
IF 'RCSRV
Begin DoDot:2
+54 IF $PIECE(RC0,U,19)
SET @RCSD@(C5)=+$PIECE(RC0,U,19)
SET RCSRV=1
End DoDot:2
End DoDot:1
+55 ;
+56 SET RC=1
SET (RCCT,RCCT1,RCX,REFORM)=0
SET RCBILL=""
+57 SET RCERR1=$NAME(^TMP("RCERR1",$JOB))
KILL @RCERR1
+58 FOR
SET RC=$ORDER(@RCGBL@(RC))
if 'RC
QUIT
SET RC0=$GET(^(RC,0))
Begin DoDot:1
+59 IF RCFILE=5
IF +RC0=1
Begin DoDot:2
+60 SET ^TMP($JOB,"RCDPEOB","CONTACT")=RC0
End DoDot:2
QUIT
+61 ;
+62 IF RCFILE=5
IF +RC0=2
Begin DoDot:2
+63 SET RCX=RCX+1
SET ^TMP($JOB,"RCDPEOB","ADJ",RCX)=RC0
End DoDot:2
QUIT
+64 ; Adding logic for line type 03,Patch 269,DWA
IF RCFILE=5
IF +RC0=3
Begin DoDot:2
+65 SET $PIECE(^TMP($JOB,"RCDPEOB","ADJ",RCX),U,5)=$PIECE(RC0,U,2)
End DoDot:2
QUIT
+66 ;
+67 IF +RC0=5
SET RCCT=RCCT+1
SET RCCT1=0
Begin DoDot:2
+68 SET REFORM=0
SET ECMENUM=""
IF $$VALECME^BPSUTIL2($PIECE(RC0,U,2))
SET ECMENUM=$PIECE(RC0,U,2)
+69 ; look up claim ien by claim# or by ECME#
SET Z=$$BILL^RCDPESR1($PIECE(RC0,U,2),$GET(@RCSD@(RC)),.RCIB)
+70 IF Z
SET RCBILL=$PIECE($GET(^PRCA(430,Z,0)),U)
IF RCBILL'=""
IF RCBILL'=$PIECE(RC0,U,2)
SET REFORM=1
SET $PIECE(RC0,U,2)=RCBILL
+71 SET RCBILL=$PIECE(RC0,U,2)
+72 SET Z=$SELECT(Z>0:$SELECT($GET(RCIB):Z,1:-1),1:-1)
+73 SET ^TMP($JOB,"RCDP-EOB",RCCT,0)=Z_U_RCBILL_U_$GET(@RCSD@(RC))_U_ECMENUM
+74 ;Save pt nm
SET $PIECE(^TMP($JOB,"RCDPEOB",RCCT,"EOB"),U,5)=$PIECE(RC0,U,3)_","_$PIECE(RC0,U,4)_" "_$PIECE(RC0,U,5)
+75 ;Save ins co
IF Z>0
SET Q=+$PIECE($GET(^PRCA(430,Z,0)),U,9)
IF $PIECE($GET(^RCD(340,Q,0)),U)["DIC(36,"
SET $PIECE(^TMP($JOB,"RCDPEOB",RCCT,"EOB"),U,3)=+^RCD(340,Q,0)
End DoDot:2
+76 ;
+77 ;
IF +RC0>5
IF REFORM
SET $PIECE(RC0,U,2)=RCBILL
+78 ;Save amt pd/billed, rev flg
IF +RC0=10
Begin DoDot:2
+79 SET $PIECE(^TMP($JOB,"RCDPEOB",RCCT,"EOB"),U,2)=$SELECT(+$PIECE(RC0,U,11):$JUSTIFY($PIECE(RC0,U,11)/100,"",2),1:0)
SET $PIECE(^TMP($JOB,"RCDPEOB",RCCT,"EOB"),U,6)=$JUSTIFY($PIECE(RC0,U,11),"",2)
+80 IF $PIECE(RC0,U,6)="Y"!($PIECE(RC0,U,7)=22)
SET $PIECE(^TMP($JOB,"RCDPEOB",RCCT,"EOB"),U,4)=1
+81 SET $PIECE(^TMP($JOB,"RCDPEOB",RCCT,"EOB"),U,10,14)=RCDPBNPI_U_$PIECE(RC0,U,16,19)
End DoDot:2
+82 ; Save Rendering Provider information from new style message
IF +RC0=11
Begin DoDot:2
+83 SET $PIECE(^TMP($JOB,"RCDPEOB",RCCT,"EOB"),U,10,14)=RCDPBNPI_U_$PIECE(RC0,U,3,6)
+84 ; End save of Rendering Provider
End DoDot:2
+85 IF RCBILL=$PIECE(RC0,U,2)
SET RCCT1=RCCT1+1
SET ^TMP($JOB,"RCDP-EOB",RCCT,RCCT1,0)=RC0
End DoDot:1
+86 ;
+87 SET RCSTAR=$TRANSLATE($JUSTIFY("",15)," ","*")
SET RCET=RCSTAR_"ERROR/WARNING EEOB DETAIL SEQ #"
+88 SET RCCT=0
FOR
SET RCCT=$ORDER(^TMP($JOB,"RCDP-EOB",RCCT))
if 'RCCT
QUIT
SET RCIFN=+$GET(^(RCCT,0))
SET RCBILL=$PIECE($GET(^(0)),U,2)
SET ^TMP($JOB,"RCDPEOB",RCCT)=$GET(^TMP($JOB,"RCDP-EOB",RCCT,0))
Begin DoDot:1
+89 SET RCEOB=-1
SET RCEOBD=""
+90 IF $SELECT(RCIFN>0:$PIECE(^PRCA(430.3,+$PIECE($GET(^PRCA(430,+RCIFN,0)),U,8),0),U,3)'=102,RCIFN'>0&($GET(DUP)'>0):1,1:0)
Begin DoDot:2
+91 SET @RCERR1@(RCCT)=" "
SET @RCERR1@(RCCT,1)=RCET_RCCT_RCSTAR
+92 SET @RCERR1@(RCCT,2)="Bill "_RCBILL_" is"_$SELECT(RCIFN>0:" not in an ACTIVE status in your A/R",1:"n't valid/wasn't found so its detail wasn't stored in IB")
+93 if RCFILE=5
SET @RCERR1@(RCCT,"*")=@RCERR1@(RCCT,2)
+94 SET @RCERR1@(RCCT,3)=" The reported amount paid on this bill was: "_$PIECE(^TMP($JOB,"RCDPEOB",RCCT,"EOB"),U,2)
+95 IF RCIFN'>0
Begin DoDot:3
+96 SET @RCERR1@(RCCT,4)=" If the bill is not for your site, it must be transferred to the"
+97 SET @RCERR1@(RCCT,5)=" correct site and manually adjusted in your AR."
+98 SET @RCERR1@(RCCT,6)=" You can perform this transfer using EDI Lockbox ERA/EEOB exception process."
+99 SET @RCERR1@(RCCT,7)=" "
End DoDot:3
+100 DO DISP1^RCDPESR5(RCCT,1)
+101 SET Q=0
FOR
SET Q=$ORDER(^TMP($JOB,"RCDP-EOB",RCCT,Q))
if 'Q
QUIT
SET ^TMP($JOB,"RCDPEOB",RCCT,Q)=$GET(^TMP($JOB,"RCDP-EOB",RCCT,Q,0))
+102 SET ^TMP($JOB,"RCDPEOB",RCCT)=^TMP($JOB,"RCDP-EOB",RCCT,0)
MERGE ^TMP($JOB,"RCDPEOB",RCCT,"ERR")=@RCERR1@(RCCT)
+103 ;Store err if trans-in failed
IF RCFILE=5
Begin DoDot:3
+104 NEW RCE,RC,DIE,X,Y,DA,DR
+105 SET RCE(1)=$$FMTE^XLFDT($$NOW^XLFDT(),2)_" "_$GET(@RCERR1@(RCCT,"*"))
+106 SET RCE(2)=" "
SET RCFILED=0
+107 DO WP^DIE(344.5,RCTDA_",",5,"A","RCE")
End DoDot:3
End DoDot:2
+108 IF RCIFN>0
Begin DoDot:2
+109 NEW RCDUPEOB,RCALLDUP
+110 ;Chk rec exists
+111 SET RCDUPEOB=0
+112 ;Same msg for update?
SET RCEOB=$$DUP^RCDPESR3(RCMNUM,RCIFN,$PIECE($GET(^TMP($JOB,"RCDPEOB",RCCT,"EOB")),U,2),$PIECE($GET(^TMP($JOB,"RCDPEOB",RCCT,"EOB")),U,6))
+113 ;If chksum exists, let below check it
IF RCEOB
IF $PIECE(RCEOB,U,2)
SET RCEOB=0
+114 ;Needed - checksum
SET ^TMP($JOB,"RCDP-EOB",RCCT,.5,0)="835ERA"
+115 SET RCALLDUP=$$DUP^IBCEOB("^TMP("_$JOB_",""RCDP-EOB"","_RCCT_")",RCIFN)
+116 IF $SELECT(RCALLDUP:1,RCEOB:$GET(DUP)'>0,1:0)
Begin DoDot:3
+117 SET RCDUPEOB=1
+118 DO DUPREC^RCDPESR6(RCET,RCCT,RCSTAR,RCFILE,RCALLDUP,RCEOB,RCBILL,.RCDUPEOB)
+119 if RCALLDUP
SET RCEOBD=RCALLDUP
End DoDot:3
+120 ;Add stub to 361.1
+121 ;IA 4042
IF 'RCDUPEOB
SET RCEOB=+$$ADD3611^IBCEOB(RCMNUM,"","",RCIFN,1,"^TMP("_$JOB_",""RCDP-EOB"","_RCCT_")")
+122 KILL ^TMP($JOB,"RCDP-EOB",RCCT,.5,0)
+123 IF RCEOB<0
if $GET(DUP)'>0
Begin DoDot:3
+124 SET @RCERR1@(RCCT)=" "
SET ^(RCCT,1)=RCET_RCCT_RCSTAR
SET RCFILED=0
+125 SET @RCERR1@(RCCT,2)="Error - EEOB detail not added to IB for bill "_RCBILL
SET $PIECE(^TMP($JOB,"RCDPEOB",RCCT,"EOB"),U)=""
+126 if RCFILE=5
SET @RCERR1@(RCCT,"*")=@RCERR1@(RCCT,2)
+127 DO DISP1^RCDPESR5(RCCT,1)
+128 SET Q=0
FOR
SET Q=$ORDER(^TMP($JOB,"RCDP-EOB",RCCT,Q))
if 'Q
QUIT
SET ^TMP($JOB,"RCDPEOB",RCCT,Q)=$GET(^TMP($JOB,"RCDP-EOB",RCCT,Q,0))
+129 SET ^TMP($JOB,"RCDPEOB",RCCT)=^TMP($JOB,"RCDP-EOB",RCCT,0)
MERGE ^TMP($JOB,"RCDPEOB",RCCT,"ERR")=@RCERR1@(RCCT)
End DoDot:3
QUIT
+130 ;Upd 361.1, needs ^TMP($J,"RCDPEOB","HDR" and $J,"RCDP-EOB"
+131 IF RCDUPEOB'<0
SET RCNOUPD=0
DO UPD3611^IBCEOB(RCEOB,RCCT,1)
+132 ;errors in ^TMP("RCDPERR-EOB",$J
+133 IF $ORDER(^TMP("RCDPERR-EOB",$JOB,0))
DO ERRUPD^IBCEOB(RCEOB,"RCDPERR-EOB")
+134 SET $PIECE(^TMP($JOB,"RCDPEOB",RCCT,"EOB"),U)=$SELECT('$GET(RCEOBD):RCEOB,1:RCEOBD)
End DoDot:2
+135 KILL ^TMP("RCDPERR-EOB",$JOB)
End DoDot:1
+136 ;
+137 IF RCNOUPD
DO DUPERA^RCDPESR3($GET(DUP),RCNOUPD)
+138 IF $ORDER(@RCERR1@(""))
DO BULLS^RCDPESR3(RCFILE,RCTDA,$SELECT(RCNOUPD:RCNOUPD,1:$GET(DUP)),$GET(RCXMG))
+139 KILL ^TMP("RCDPERR-EOB",$JOB),^TMP($JOB,"RCDP-EOB"),@RCERR1,@RCSD
+140 DO CLEAN^DILF
+141 QUIT
