RCDPESR4 ;ALB/TMK/PJH - Server interface 835ERA processing ;Jun 06, 2014@19:11:19
;;4.5;Accounts Receivable;**173,216,208,230,269,271,298,321**;Mar 20, 1995;Build 48
;Per VA Directive 6402, this routine should not be modified.
;
;Reference to $$VALECME^BPSUTIL2 supported by IA# 6139
;
ERAEOBIN(RCTXN,RCD,RCGBL,RCEFLG) ; Store/process 835ERA or 835XFR
; transaction coming into the site
; RCTXN = data on the hdr record of the msg text
; RCD = array with formatted hdr data
; RCGBL = name of the array or global where the msg is stored
; RCEFLG = error flag returned if passed by REF
;
N RCLAST,RCBILL,RCTDA,RCMSG,RCERR
S (RCTDA,RCEFLG)=0
;
;
F L +^RCY(344.5,"AMSEQ",+$P(RCTXN,U,13)):30 Q:$T
S RCMSG=$$EXTERA(RCTXN,.RCLAST,.RCBILL) ; Extract from mail msg
;
; If full msg received (99^$ record exists), file it
I 'RCLAST,'$G(RCERR) D ;No $ as last character of msg
. S RCERR=2
;
I RCLAST S RCTDA=+$$ADD(RCGBL,RCD("MSG#"),RCMSG,.RCBILL,.RCERR,.RCD)
;
I $G(RCERR)>0 D
. D ERRUPD^RCDPESR1(RCGBL,.RCD,$P(RCTXN,U),.RCERR)
. I RCTDA D ; Store exception msgs in file 344.5
.. N A,C,Z
.. S C=1,A(1)="Date: "_$$FMTE^XLFDT($$NOW^XLFDT(),2)
.. I $G(^TMP("RCERR",$J,"TEXT"))'="" S C=C+1,A(C)=^TMP("RCERR",$J,"TEXT"),C=C+1,A(C)=" "
.. S Z=0 F S Z=$O(^TMP("RCERR",$J,"MSG",Z)) Q:'Z S C=C+1,A(C)=^(Z)
.. I $O(A(0)) D WP^DIE(344.5,RCTDA_",",5,"A","A")
. S RCEFLG=1
;
L -^RCY(344.5,"AMSEQ",+$P(RCTXN,U,13))
I $P(RCTXN,U)'["XFR",$P(RCTXN,U,12)'="" D TAXERR^RCDPESR1("ERA",$P(RCTXN,U,6)_" Payer ID: "_$P(RCTXN,U,7),$P(RCTXN,U,11),$P(RCTXN,U,12)) ; Send bad tax id bulletin
;
Q
;
EXTERA(RCTXN,RCLAST,RCBILL) ;Extract 835ERA or 835XFR transaction
;INPUT:
; RCTXN = data on 835ERA/835XFR hdr record
; RCLAST = passed by REF and returned=1 if entire record exists
;
;OUTPUT:
; ^TMP("RCMSG",$J,1,"D",line #)=formatted hdr data
; ^TMP("RCMSG",$J,2,"D",line #)=raw msg data
; if passed by ref, RCLAST = 1 if '99' record found
; if passed by ref, RCBILL(AR bill number) is returned
; with a 'list' of bills included in the ERA. If an
; entry = 1, 3rd party bill was found in file 430.
; If the entry = 2, the 3rd party bill found was not active
; Function returns existing ien in file 344.5 for multi part ERAs
;
;N CT,CT1,LINE,HCT,RCH,RCMSG,RCREFORM,RCINS,RCSTAT,B,RCSD,C5
N B,C5,CT,CT1,HCT,LINE,RCH,RCINS,RCMSG,RCREFORM,RCSD,RCSTART,RCSTAT ;PRCA*4.5*321 reordered and RCSTART added
S (HCT,RCH)=0
;
;
; Check if sequence control # already exists or if a new record needed
S RCMSG=+$O(^RCY(344.5,"AMSEQ",+$P(RCTXN,U,13),0))
S CT=0
I 'RCMSG D ; Build display data for the first sequence only
. S HCT=HCT+1 S LINE(HCT)="Payer Name: "_$P(RCTXN,U,6)
. S HCT=HCT+1 S LINE(HCT)="Payer ID: "_$P(RCTXN,U,7)
. S HCT=HCT+1,LINE(HCT)="Trace #: "_$P(RCTXN,U,8)
. S HCT=HCT+1,LINE(HCT)="Date Paid: "_$$FDT^RCDPESR9($P(RCTXN,U,9))_" Total Amt Paid: "_$J($P(RCTXN,U,10)/100,0,2)
. I $P(RCTXN,U)["XFR",$P(RCTXN,U,19)'="" S HCT=HCT+1,LINE(HCT)="Contact Info: "_$P(RCTXN,U,19)
. M ^TMP("RCMSG",$J,1,"D")=LINE
. S CT=CT+1,^TMP("RCMSG",$J,2,"D",CT)=RCTXN
;
S CT1=CT
S ^TMP("RCMSG",$J,0)=RCTXN
;
S RCSD=$NA(^TMP($J,"RCSRVDT")) K @RCSD ;service dates
S C5=0
S RCLAST=0,RCSTART=0 ; PRCA*4.5*321
F X XMREC Q:XMER<0 D Q:RCLAST
. Q:XMRG=""
. I +XMRG=99,$P(XMRG,U,2)="$" S RCLAST=1 Q
. S CT=CT+1
. I +XMRG=5,$P(XMRG,U,2)'="" S C5=CT
. ;Statement Start Date - 05 Record is mandatory
. I +XMRG=5 S RCSTART=+$P(XMRG,U,9) ;PRCA*4.5*321
. ; save the service date for possible ECME# look up
. ;PRCA*4.5*321 BEGIN
. I +XMRG=40,$$VALECME^BPSUTIL2($P(XMRG,U,2)),C5,'$D(@RCSD@(C5)) D
. . I $P(XMRG,U,19) S @RCSD@(C5)=+$P(XMRG,U,19) Q
. . ; If service date not present use statement start date instead
. . S:RCSTART @RCSD@(C5)=RCSTART
. ; PRCA*4.5*321 END
. S ^TMP("RCMSG",$J,2,"D",CT)=XMRG
;
; reformat bill# if needed
S RCREFORM=""
S CT=CT1
F S CT=$O(^TMP("RCMSG",$J,2,"D",CT)) Q:'CT S XMRG=$G(^(CT)) D
. Q:XMRG=""
. I +XMRG=5,$P(XMRG,U,2)'="" D
.. S RCREFORM="",RCSTAT=1
.. ; Check if bill is in AR & is a 3rd party bill
.. S RCBILL=$$BILL^RCDPESR1($P(XMRG,U,2),$G(@RCSD@(CT)),.RCINS) ; look up claim ien by claim# or ECME#
.. I '$G(RCINS)!(RCBILL<0) S (RCBILL,RCSTAT)=0
.. I RCBILL S B=$P($G(^PRCA(430,RCBILL,0)),U) I B'=$P(XMRG,U,2) S $P(XMRG,U,2)=B,RCREFORM=B
.. I RCBILL,$P(^PRCA(430.3,+$P($G(^PRCA(430,+RCBILL,0)),U,8),0),U,3)'=102 S RCSTAT=2
.. S RCBILL($P(XMRG,U,2))=RCSTAT
. I RCREFORM'="",+XMRG>5 S $P(XMRG,U,2)=RCREFORM,^TMP("RCMSG",$J,2,"D",CT)=XMRG
;
K @RCSD
Q RCMSG
;
ADD(RCGBL,RCDMSG,RCMSG,RCBILL,RCERR,RCD) ; Add msg(s) in @RCGBL to
; file 344.5
; RCGBL = name of the global used to store the msg data
; RCDMSG = Mailman msg number the ERA arrived in.
; RCMSG = ien of the existing entry in file 344.5 for multipart ERAs
; RCBILL(AR bill number) = list of bills included, pass by REF
; RCD = array with formatted hdr data
;
; Errors returned in RCERR and RCERR(n)
; Function returns entry # of msg added or "" if none added
;
;
N RCHDR,RCTYP,RCIEN
S RCHDR=$G(^TMP("RCMSGH",$J,0))
S RCTYP=$P(RCHDR,U)
S RCIEN=$S($G(RCMSG):RCMSG,1:$$ADDTXN(RCHDR,RCDMSG)) ;File msg hdr
I RCIEN'>0 S RCERR=3 ;msg hdr can't be filed
I '$G(RCERR) D LOADDET(RCIEN,RCGBL,RCHDR,.RCBILL,.RCD,.RCERR)
I '$G(RCERR),'$O(RCERR(0)),RCTYP["835ERA",'$P($G(^RCY(344.5,RCIEN,0)),U,8) D TASKERA^RCDPESR2(RCIEN) ;Task to upd VistA for complete 835ERA only
;
Q $S($G(RCIEN)>0&'$G(RCERR):RCIEN,1:"")
;
ADDTXN(RCDATA,RCDMSG) ; Add a trxn for msg in RCDATA to file 344.5
; RCDATA = data on the msg hdr record
; RCDMSG = Mailman msg number the ERA arrived in
;Function returns ien of the new entry in file 344.5 or "" if an error
;
N A,RCY,DLAYGO,DIC,DD,DO,DA,X,Y,Z
;
;
S (X,A)=RCDMSG ;Use msg ID as basis for the .01 field
F Z=1:1 Q:'$D(^RCY(344.5,"B",A)) S A=X_"."_Z
S X=A
S DIC(0)="L",DIC="^RCY(344.5,",DLAYGO=344.5
S DIC("DR")=".02////"_$E($P(RCDATA,U),1,6)_";.03///^S X=""NOW"";.04////0;.06////"_$S($P(RCDATA,U)'["XFR":1,1:0)_$S($P(RCDATA,U,13)'="":";.09////"_+$P(RCDATA,U,13)_";.08////1",1:"")_";.1////2;.11////"_RCDMSG
I $P(RCDATA,U,6)'="" S DIC("DR")=DIC("DR")_";3.01////"_$P(RCDATA,U,6)
D FILE^DICN K DO,DD,DLAYGO,DA,DIC
S RCY=+Y
;
;
Q $S(RCY>0:+RCY,1:"")
;
LOADDET(RCTDA,RCGBL,RCHDR,RCBILL,RCD,RCERR) ; Load the rest of the text
; into the msg
; RCTDA = ien in file 344.5
; RCGBL = name of the array holding the detail msg text to be loaded
; RCHDR = data on ERA hdr record
; RCBILL(AR bill number) = list of bills included, pass by REF
; RCD = array with formatted hdr data
;
; OUTPUT: RCERR if any errors found, pass by REF
;
;
N RCE,RCDATA,RCMSG,RCFROM,Z,Z0
K ^TMP("RCTEXT",$J),^TMP("RCRAW",$J)
M ^TMP("RCTEXT",$J)=@RCGBL@(1,"D")
M ^TMP("RCRAW",$J)=@RCGBL@(2,"D")
;
S RCDATA=$G(^RCY(344.5,RCTDA,0)),RCMSG=$G(RCD("MSG#")),RCFROM=$G(RCD("FROM"))
;
; For multi-part ERA, don't update if sequence already filed
; Add seq # if not already there
I $P(RCHDR,U)'["XFR",$P(RCHDR,U,13) Q:$D(^RCY(344.5,RCTDA,"S","B",+$P(RCHDR,U,14)))
;
D STOREM(+$G(RCTDA),"^TMP(""RCTEXT"",$J)","^TMP(""RCRAW"",$J)",.RCE)
;
I $D(RCE("DIERR")) D ; Extract error
. N DIE,DA,DR,X,Y
. D EXTERR^RCDPESR1(.RCERR,.RCE)
. S:$L($G(RCE)) RCERR(+$O(RCERR(""),-1)+1)=RCE
. I $D(^RCY(344.5,RCTDA,0)) S DIE="^RCY(344.5,",DR=".1////4",DA=RCTDA D ^DIE
E D ; No error - store rest of data
. N Z,RCT,RCCT,RCX,RCB ; Add bills included in ERA
. S RCT=0,RCCT=0,RCX=$J("",4)
. S Z="" F S Z=$O(RCBILL(Z)) Q:Z="" D
.. N DO,DD,DIC,DLAYGO,X,Y
.. S:RCT=4 RCCT=RCCT+1,RCB(RCCT)=RCX,RCT=0,RCX=$J("",4) S RCX=RCX_$E($S(+RCBILL(Z):"",1:"*")_Z_$J("",15),1,15),RCT=RCT+1
.. S DIC(0)="L",DIC("DR")=".02////"_$S($G(RCBILL(Z)):1,1:0),X=Z,DA(1)=RCTDA,DIC="^RCY(344.5,"_DA(1)_",""B"",",DLAYGO=344.54 D FILE^DICN K DO,DD,DLAYGO,DIC
.. ;
. I $L(RCX)>4 S RCCT=RCCT+1,RCB(RCCT)=RCX
. ; Add list of bills to display data
. I $O(RCB(0)) D WP^DIE(344.5,RCTDA_",",1,"A","RCB")
. ; Add seq #
. S DA(1)=RCTDA,DIC="^RCY(344.5,"_DA(1)_",""S"",",DIC(0)="L",X=$P(RCHDR,U,14),DIC("DR")=".02////"_$S($P(RCHDR,U,15)="Y":1,1:0)_";.03///^S X=""NOW"";.04////"_RCMSG,X=+$P(RCHDR,U,14),DLAYGO=344.53
. D FILE^DICN K DO,DD,DLAYGO,DIC
. ;
. I $P(RCHDR,U)["835XFR" D XFR^RCDPESR5(RCTDA,RCFROM,RCMSG,.RCD) Q
. ;
. ; Proceed only if not a transfer record
. I $P(RCDATA,U,9)'="" D ; Determine if all sequences received yet
.. N RCOK,RCLAST
.. S RCOK=1,RCLAST=0
.. F Z=1:1 Q:'RCOK!RCLAST D
... I 'RCLAST,'$D(^RCY(344.5,RCTDA,"S","B",Z)) S RCOK=0 Q
... S Z0=+$O(^RCY(344.5,RCTDA,"S","B",Z,0)),Z0=$G(^RCY(344.5,RCTDA,"S",Z0,0))
... I Z0="" S RCOK=0 Q
... I $P(Z0,U,2) S RCLAST=1 ; Last sequence received and all before it
.. ;
.. I RCOK D
... N DA,DIE,DR,X,Y
... S DA=RCTDA,DR=".08////0;.1///@",DIE="^RCY(344.5," D ^DIE
... I '$O(^RCY(344.5,RCTDA,"B","AV",1,0)) D ; No valid bills found
....;-----
....; PRCA*4.5*298 - MailMan message disabled, logic retained - 14 Feb 2014
....;N RCE
....;S RCE(1)="No valid bills for this site were found in this ERA"
....;S RCE(2)="Review/correct the bill #'s on this ERA in your transmission exceptions"
....;S RCE(3)="Please contact the Implementation Manager group to report this situation",RCE(4)=" "
....;D BULLERA^RCDPESR0("D"_$S($O(^RCY(344.5,RCTDA,2,0)):"F",1:""),RCTDA,$G(RCD("MSG#")),"EDI LBOX - NO VALID BILLS ON ERA "_$E($G(RCD("PAYFROM")),1,20),.RCE,0)
....;-----
.... S DA=RCTDA,DR=".08////1;.1////6",DIE="^RCY(344.5," D ^DIE
;
;
K ^TMP("RCTEXT",$J),^TMP("RCRAW",$J)
Q
;
STOREM(RCTDA,RCDISP,RCTEXT,RCE) ;Store msg text in file 344.5
;INPUT:
; RCTDA = ien of the entry in file 344.5
; RCDISP = name of the array where display msg text is retrieved from
; or "@" to delete the text from the display text field
; RCTEXT = name of the array where raw msg text is retrieved from
; or "@" to delete the text from the raw msg field
;OUTPUT:
; RCE = array of errors (RCE("DIERR")) returned, pass by REF
;
N RCZ,X,Y,DIE
K RCE("DIERR")
;
I $S($G(RCDISP)="@":1,1:$D(@RCDISP)'<10) D
. F RCZ=1:1:20 D WP^DIE(344.5,RCTDA_",",1,"AK",""_RCDISP_"","RCE") Q:$S('$D(RCE("DIERR")):1,+RCE("DIERR")=1:$G(RCE("DIERR",1))'=110,1:1) K:RCZ<20 RCE("DIERR") ; On lock error, retry up to 20 times
;
I '$O(RCE("DIERR",0)),$S($G(RCTEXT)="@":1,1:$D(@RCTEXT)'<10) D
. F RCZ=1:1:20 D WP^DIE(344.5,RCTDA_",",2,"AK",""_RCTEXT_"","RCE") Q:$S('$D(RCE("DIERR")):1,+RCE("DIERR")=1:$G(RCE("DIERR",1))'=110,1:1) K:RCZ<20 RCE("DIERR") ; On lock error, retry up to 20 times
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPESR4 10747 printed Apr 09, 2024@20:46:53 Page 2
RCDPESR4 ;ALB/TMK/PJH - Server interface 835ERA processing ;Jun 06, 2014@19:11:19
+1 ;;4.5;Accounts Receivable;**173,216,208,230,269,271,298,321**;Mar 20, 1995;Build 48
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;Reference to $$VALECME^BPSUTIL2 supported by IA# 6139
+5 ;
ERAEOBIN(RCTXN,RCD,RCGBL,RCEFLG) ; Store/process 835ERA or 835XFR
+1 ; transaction coming into the site
+2 ; RCTXN = data on the hdr record of the msg text
+3 ; RCD = array with formatted hdr data
+4 ; RCGBL = name of the array or global where the msg is stored
+5 ; RCEFLG = error flag returned if passed by REF
+6 ;
+7 NEW RCLAST,RCBILL,RCTDA,RCMSG,RCERR
+8 SET (RCTDA,RCEFLG)=0
+9 ;
+10 ;
+11 FOR
LOCK +^RCY(344.5,"AMSEQ",+$PIECE(RCTXN,U,13)):30
if $TEST
QUIT
+12 ; Extract from mail msg
SET RCMSG=$$EXTERA(RCTXN,.RCLAST,.RCBILL)
+13 ;
+14 ; If full msg received (99^$ record exists), file it
+15 ;No $ as last character of msg
IF 'RCLAST
IF '$GET(RCERR)
Begin DoDot:1
+16 SET RCERR=2
End DoDot:1
+17 ;
+18 IF RCLAST
SET RCTDA=+$$ADD(RCGBL,RCD("MSG#"),RCMSG,.RCBILL,.RCERR,.RCD)
+19 ;
+20 IF $GET(RCERR)>0
Begin DoDot:1
+21 DO ERRUPD^RCDPESR1(RCGBL,.RCD,$PIECE(RCTXN,U),.RCERR)
+22 ; Store exception msgs in file 344.5
IF RCTDA
Begin DoDot:2
+23 NEW A,C,Z
+24 SET C=1
SET A(1)="Date: "_$$FMTE^XLFDT($$NOW^XLFDT(),2)
+25 IF $GET(^TMP("RCERR",$JOB,"TEXT"))'=""
SET C=C+1
SET A(C)=^TMP("RCERR",$JOB,"TEXT")
SET C=C+1
SET A(C)=" "
+26 SET Z=0
FOR
SET Z=$ORDER(^TMP("RCERR",$JOB,"MSG",Z))
if 'Z
QUIT
SET C=C+1
SET A(C)=^(Z)
+27 IF $ORDER(A(0))
DO WP^DIE(344.5,RCTDA_",",5,"A","A")
End DoDot:2
+28 SET RCEFLG=1
End DoDot:1
+29 ;
+30 LOCK -^RCY(344.5,"AMSEQ",+$PIECE(RCTXN,U,13))
+31 ; Send bad tax id bulletin
IF $PIECE(RCTXN,U)'["XFR"
IF $PIECE(RCTXN,U,12)'=""
DO TAXERR^RCDPESR1("ERA",$PIECE(RCTXN,U,6)_" Payer ID: "_$PIECE(RCTXN,U,7),$PIECE(RCTXN,U,11),$PIECE(RCTXN,U,12))
+32 ;
+33 QUIT
+34 ;
EXTERA(RCTXN,RCLAST,RCBILL) ;Extract 835ERA or 835XFR transaction
+1 ;INPUT:
+2 ; RCTXN = data on 835ERA/835XFR hdr record
+3 ; RCLAST = passed by REF and returned=1 if entire record exists
+4 ;
+5 ;OUTPUT:
+6 ; ^TMP("RCMSG",$J,1,"D",line #)=formatted hdr data
+7 ; ^TMP("RCMSG",$J,2,"D",line #)=raw msg data
+8 ; if passed by ref, RCLAST = 1 if '99' record found
+9 ; if passed by ref, RCBILL(AR bill number) is returned
+10 ; with a 'list' of bills included in the ERA. If an
+11 ; entry = 1, 3rd party bill was found in file 430.
+12 ; If the entry = 2, the 3rd party bill found was not active
+13 ; Function returns existing ien in file 344.5 for multi part ERAs
+14 ;
+15 ;N CT,CT1,LINE,HCT,RCH,RCMSG,RCREFORM,RCINS,RCSTAT,B,RCSD,C5
+16 ;PRCA*4.5*321 reordered and RCSTART added
NEW B,C5,CT,CT1,HCT,LINE,RCH,RCINS,RCMSG,RCREFORM,RCSD,RCSTART,RCSTAT
+17 SET (HCT,RCH)=0
+18 ;
+19 ;
+20 ; Check if sequence control # already exists or if a new record needed
+21 SET RCMSG=+$ORDER(^RCY(344.5,"AMSEQ",+$PIECE(RCTXN,U,13),0))
+22 SET CT=0
+23 ; Build display data for the first sequence only
IF 'RCMSG
Begin DoDot:1
+24 SET HCT=HCT+1
SET LINE(HCT)="Payer Name: "_$PIECE(RCTXN,U,6)
+25 SET HCT=HCT+1
SET LINE(HCT)="Payer ID: "_$PIECE(RCTXN,U,7)
+26 SET HCT=HCT+1
SET LINE(HCT)="Trace #: "_$PIECE(RCTXN,U,8)
+27 SET HCT=HCT+1
SET LINE(HCT)="Date Paid: "_$$FDT^RCDPESR9($PIECE(RCTXN,U,9))_" Total Amt Paid: "_$JUSTIFY($PIECE(RCTXN,U,10)/100,0,2)
+28 IF $PIECE(RCTXN,U)["XFR"
IF $PIECE(RCTXN,U,19)'=""
SET HCT=HCT+1
SET LINE(HCT)="Contact Info: "_$PIECE(RCTXN,U,19)
+29 MERGE ^TMP("RCMSG",$JOB,1,"D")=LINE
+30 SET CT=CT+1
SET ^TMP("RCMSG",$JOB,2,"D",CT)=RCTXN
End DoDot:1
+31 ;
+32 SET CT1=CT
+33 SET ^TMP("RCMSG",$JOB,0)=RCTXN
+34 ;
+35 ;service dates
SET RCSD=$NAME(^TMP($JOB,"RCSRVDT"))
KILL @RCSD
+36 SET C5=0
+37 ; PRCA*4.5*321
SET RCLAST=0
SET RCSTART=0
+38 FOR
XECUTE XMREC
if XMER<0
QUIT
Begin DoDot:1
+39 if XMRG=""
QUIT
+40 IF +XMRG=99
IF $PIECE(XMRG,U,2)="$"
SET RCLAST=1
QUIT
+41 SET CT=CT+1
+42 IF +XMRG=5
IF $PIECE(XMRG,U,2)'=""
SET C5=CT
+43 ;Statement Start Date - 05 Record is mandatory
+44 ;PRCA*4.5*321
IF +XMRG=5
SET RCSTART=+$PIECE(XMRG,U,9)
+45 ; save the service date for possible ECME# look up
+46 ;PRCA*4.5*321 BEGIN
+47 IF +XMRG=40
IF $$VALECME^BPSUTIL2($PIECE(XMRG,U,2))
IF C5
IF '$DATA(@RCSD@(C5))
Begin DoDot:2
+48 IF $PIECE(XMRG,U,19)
SET @RCSD@(C5)=+$PIECE(XMRG,U,19)
QUIT
+49 ; If service date not present use statement start date instead
+50 if RCSTART
SET @RCSD@(C5)=RCSTART
End DoDot:2
+51 ; PRCA*4.5*321 END
+52 SET ^TMP("RCMSG",$JOB,2,"D",CT)=XMRG
End DoDot:1
if RCLAST
QUIT
+53 ;
+54 ; reformat bill# if needed
+55 SET RCREFORM=""
+56 SET CT=CT1
+57 FOR
SET CT=$ORDER(^TMP("RCMSG",$JOB,2,"D",CT))
if 'CT
QUIT
SET XMRG=$GET(^(CT))
Begin DoDot:1
+58 if XMRG=""
QUIT
+59 IF +XMRG=5
IF $PIECE(XMRG,U,2)'=""
Begin DoDot:2
+60 SET RCREFORM=""
SET RCSTAT=1
+61 ; Check if bill is in AR & is a 3rd party bill
+62 ; look up claim ien by claim# or ECME#
SET RCBILL=$$BILL^RCDPESR1($PIECE(XMRG,U,2),$GET(@RCSD@(CT)),.RCINS)
+63 IF '$GET(RCINS)!(RCBILL<0)
SET (RCBILL,RCSTAT)=0
+64 IF RCBILL
SET B=$PIECE($GET(^PRCA(430,RCBILL,0)),U)
IF B'=$PIECE(XMRG,U,2)
SET $PIECE(XMRG,U,2)=B
SET RCREFORM=B
+65 IF RCBILL
IF $PIECE(^PRCA(430.3,+$PIECE($GET(^PRCA(430,+RCBILL,0)),U,8),0),U,3)'=102
SET RCSTAT=2
+66 SET RCBILL($PIECE(XMRG,U,2))=RCSTAT
End DoDot:2
+67 IF RCREFORM'=""
IF +XMRG>5
SET $PIECE(XMRG,U,2)=RCREFORM
SET ^TMP("RCMSG",$JOB,2,"D",CT)=XMRG
End DoDot:1
+68 ;
+69 KILL @RCSD
+70 QUIT RCMSG
+71 ;
ADD(RCGBL,RCDMSG,RCMSG,RCBILL,RCERR,RCD) ; Add msg(s) in @RCGBL to
+1 ; file 344.5
+2 ; RCGBL = name of the global used to store the msg data
+3 ; RCDMSG = Mailman msg number the ERA arrived in.
+4 ; RCMSG = ien of the existing entry in file 344.5 for multipart ERAs
+5 ; RCBILL(AR bill number) = list of bills included, pass by REF
+6 ; RCD = array with formatted hdr data
+7 ;
+8 ; Errors returned in RCERR and RCERR(n)
+9 ; Function returns entry # of msg added or "" if none added
+10 ;
+11 ;
+12 NEW RCHDR,RCTYP,RCIEN
+13 SET RCHDR=$GET(^TMP("RCMSGH",$JOB,0))
+14 SET RCTYP=$PIECE(RCHDR,U)
+15 ;File msg hdr
SET RCIEN=$SELECT($GET(RCMSG):RCMSG,1:$$ADDTXN(RCHDR,RCDMSG))
+16 ;msg hdr can't be filed
IF RCIEN'>0
SET RCERR=3
+17 IF '$GET(RCERR)
DO LOADDET(RCIEN,RCGBL,RCHDR,.RCBILL,.RCD,.RCERR)
+18 ;Task to upd VistA for complete 835ERA only
IF '$GET(RCERR)
IF '$ORDER(RCERR(0))
IF RCTYP["835ERA"
IF '$PIECE($GET(^RCY(344.5,RCIEN,0)),U,8)
DO TASKERA^RCDPESR2(RCIEN)
+19 ;
+20 QUIT $SELECT($GET(RCIEN)>0&'$GET(RCERR):RCIEN,1:"")
+21 ;
ADDTXN(RCDATA,RCDMSG) ; Add a trxn for msg in RCDATA to file 344.5
+1 ; RCDATA = data on the msg hdr record
+2 ; RCDMSG = Mailman msg number the ERA arrived in
+3 ;Function returns ien of the new entry in file 344.5 or "" if an error
+4 ;
+5 NEW A,RCY,DLAYGO,DIC,DD,DO,DA,X,Y,Z
+6 ;
+7 ;
+8 ;Use msg ID as basis for the .01 field
SET (X,A)=RCDMSG
+9 FOR Z=1:1
if '$DATA(^RCY(344.5,"B",A))
QUIT
SET A=X_"."_Z
+10 SET X=A
+11 SET DIC(0)="L"
SET DIC="^RCY(344.5,"
SET DLAYGO=344.5
+12 SET DIC("DR")=".02////"_$EXTRACT($PIECE(RCDATA,U),1,6)_";.03///^S X=""NOW"";.04////0;.06////"_$SELECT($PIECE(RCDATA,U)'["XFR":1,1:0)_$SELECT($PIECE(RCDATA,U,13)'="":";.09////"_+$PIECE(RCDATA,U,13)_";.08////1",1:"")_";.1////2;.11////"_RCDMSG
+13 IF $PIECE(RCDATA,U,6)'=""
SET DIC("DR")=DIC("DR")_";3.01////"_$PIECE(RCDATA,U,6)
+14 DO FILE^DICN
KILL DO,DD,DLAYGO,DA,DIC
+15 SET RCY=+Y
+16 ;
+17 ;
+18 QUIT $SELECT(RCY>0:+RCY,1:"")
+19 ;
LOADDET(RCTDA,RCGBL,RCHDR,RCBILL,RCD,RCERR) ; Load the rest of the text
+1 ; into the msg
+2 ; RCTDA = ien in file 344.5
+3 ; RCGBL = name of the array holding the detail msg text to be loaded
+4 ; RCHDR = data on ERA hdr record
+5 ; RCBILL(AR bill number) = list of bills included, pass by REF
+6 ; RCD = array with formatted hdr data
+7 ;
+8 ; OUTPUT: RCERR if any errors found, pass by REF
+9 ;
+10 ;
+11 NEW RCE,RCDATA,RCMSG,RCFROM,Z,Z0
+12 KILL ^TMP("RCTEXT",$JOB),^TMP("RCRAW",$JOB)
+13 MERGE ^TMP("RCTEXT",$JOB)=@RCGBL@(1,"D")
+14 MERGE ^TMP("RCRAW",$JOB)=@RCGBL@(2,"D")
+15 ;
+16 SET RCDATA=$GET(^RCY(344.5,RCTDA,0))
SET RCMSG=$GET(RCD("MSG#"))
SET RCFROM=$GET(RCD("FROM"))
+17 ;
+18 ; For multi-part ERA, don't update if sequence already filed
+19 ; Add seq # if not already there
+20 IF $PIECE(RCHDR,U)'["XFR"
IF $PIECE(RCHDR,U,13)
if $DATA(^RCY(344.5,RCTDA,"S","B",+$PIECE(RCHDR,U,14)))
QUIT
+21 ;
+22 DO STOREM(+$GET(RCTDA),"^TMP(""RCTEXT"",$J)","^TMP(""RCRAW"",$J)",.RCE)
+23 ;
+24 ; Extract error
IF $DATA(RCE("DIERR"))
Begin DoDot:1
+25 NEW DIE,DA,DR,X,Y
+26 DO EXTERR^RCDPESR1(.RCERR,.RCE)
+27 if $LENGTH($GET(RCE))
SET RCERR(+$ORDER(RCERR(""),-1)+1)=RCE
+28 IF $DATA(^RCY(344.5,RCTDA,0))
SET DIE="^RCY(344.5,"
SET DR=".1////4"
SET DA=RCTDA
DO ^DIE
End DoDot:1
+29 ; No error - store rest of data
IF '$TEST
Begin DoDot:1
+30 ; Add bills included in ERA
NEW Z,RCT,RCCT,RCX,RCB
+31 SET RCT=0
SET RCCT=0
SET RCX=$JUSTIFY("",4)
+32 SET Z=""
FOR
SET Z=$ORDER(RCBILL(Z))
if Z=""
QUIT
Begin DoDot:2
+33 NEW DO,DD,DIC,DLAYGO,X,Y
+34 if RCT=4
SET RCCT=RCCT+1
SET RCB(RCCT)=RCX
SET RCT=0
SET RCX=$JUSTIFY("",4)
SET RCX=RCX_$EXTRACT($SELECT(+RCBILL(Z):"",1:"*")_Z_$JUSTIFY("",15),1,15)
SET RCT=RCT+1
+35 SET DIC(0)="L"
SET DIC("DR")=".02////"_$SELECT($GET(RCBILL(Z)):1,1:0)
SET X=Z
SET DA(1)=RCTDA
SET DIC="^RCY(344.5,"_DA(1)_",""B"","
SET DLAYGO=344.54
DO FILE^DICN
KILL DO,DD,DLAYGO,DIC
+36 ;
End DoDot:2
+37 IF $LENGTH(RCX)>4
SET RCCT=RCCT+1
SET RCB(RCCT)=RCX
+38 ; Add list of bills to display data
+39 IF $ORDER(RCB(0))
DO WP^DIE(344.5,RCTDA_",",1,"A","RCB")
+40 ; Add seq #
+41 SET DA(1)=RCTDA
SET DIC="^RCY(344.5,"_DA(1)_",""S"","
SET DIC(0)="L"
SET X=$PIECE(RCHDR,U,14)
SET DIC("DR")=".02////"_$SELECT($PIECE(RCHDR,U,15)="Y":1,1:0)_";.03///^S X=""NOW"";.04////"_RCMSG
SET X=+$PIECE(RCHDR,U,14)
SET DLAYGO=344.53
+42 DO FILE^DICN
KILL DO,DD,DLAYGO,DIC
+43 ;
+44 IF $PIECE(RCHDR,U)["835XFR"
DO XFR^RCDPESR5(RCTDA,RCFROM,RCMSG,.RCD)
QUIT
+45 ;
+46 ; Proceed only if not a transfer record
+47 ; Determine if all sequences received yet
IF $PIECE(RCDATA,U,9)'=""
Begin DoDot:2
+48 NEW RCOK,RCLAST
+49 SET RCOK=1
SET RCLAST=0
+50 FOR Z=1:1
if 'RCOK!RCLAST
QUIT
Begin DoDot:3
+51 IF 'RCLAST
IF '$DATA(^RCY(344.5,RCTDA,"S","B",Z))
SET RCOK=0
QUIT
+52 SET Z0=+$ORDER(^RCY(344.5,RCTDA,"S","B",Z,0))
SET Z0=$GET(^RCY(344.5,RCTDA,"S",Z0,0))
+53 IF Z0=""
SET RCOK=0
QUIT
+54 ; Last sequence received and all before it
IF $PIECE(Z0,U,2)
SET RCLAST=1
End DoDot:3
+55 ;
+56 IF RCOK
Begin DoDot:3
+57 NEW DA,DIE,DR,X,Y
+58 SET DA=RCTDA
SET DR=".08////0;.1///@"
SET DIE="^RCY(344.5,"
DO ^DIE
+59 ; No valid bills found
IF '$ORDER(^RCY(344.5,RCTDA,"B","AV",1,0))
Begin DoDot:4
+60 ;-----
+61 ; PRCA*4.5*298 - MailMan message disabled, logic retained - 14 Feb 2014
+62 ;N RCE
+63 ;S RCE(1)="No valid bills for this site were found in this ERA"
+64 ;S RCE(2)="Review/correct the bill #'s on this ERA in your transmission exceptions"
+65 ;S RCE(3)="Please contact the Implementation Manager group to report this situation",RCE(4)=" "
+66 ;D BULLERA^RCDPESR0("D"_$S($O(^RCY(344.5,RCTDA,2,0)):"F",1:""),RCTDA,$G(RCD("MSG#")),"EDI LBOX - NO VALID BILLS ON ERA "_$E($G(RCD("PAYFROM")),1,20),.RCE,0)
+67 ;-----
+68 SET DA=RCTDA
SET DR=".08////1;.1////6"
SET DIE="^RCY(344.5,"
DO ^DIE
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+69 ;
+70 ;
+71 KILL ^TMP("RCTEXT",$JOB),^TMP("RCRAW",$JOB)
+72 QUIT
+73 ;
STOREM(RCTDA,RCDISP,RCTEXT,RCE) ;Store msg text in file 344.5
+1 ;INPUT:
+2 ; RCTDA = ien of the entry in file 344.5
+3 ; RCDISP = name of the array where display msg text is retrieved from
+4 ; or "@" to delete the text from the display text field
+5 ; RCTEXT = name of the array where raw msg text is retrieved from
+6 ; or "@" to delete the text from the raw msg field
+7 ;OUTPUT:
+8 ; RCE = array of errors (RCE("DIERR")) returned, pass by REF
+9 ;
+10 NEW RCZ,X,Y,DIE
+11 KILL RCE("DIERR")
+12 ;
+13 IF $SELECT($GET(RCDISP)="@":1,1:$DATA(@RCDISP)'<10)
Begin DoDot:1
+14 ; On lock error, retry up to 20 times
FOR RCZ=1:1:20
DO WP^DIE(344.5,RCTDA_",",1,"AK",""_RCDISP_"","RCE")
if $SELECT('$DATA(RCE("DIERR"))
QUIT
if RCZ<20
KILL RCE("DIERR")
End DoDot:1
+15 ;
+16 IF '$ORDER(RCE("DIERR",0))
IF $SELECT($GET(RCTEXT)="@":1,1:$DATA(@RCTEXT)'<10)
Begin DoDot:1
+17 ; On lock error, retry up to 20 times
FOR RCZ=1:1:20
DO WP^DIE(344.5,RCTDA_",",2,"AK",""_RCTEXT_"","RCE")
if $SELECT('$DATA(RCE("DIERR"))
QUIT
if RCZ<20
KILL RCE("DIERR")
End DoDot:1
+18 QUIT
