RCTASFH1 ;AITC/CJE - Receive FHIR message for ePayments 835 EFT/ERA
;;4.5;Accounts Receivable;**455**;Oct 4, 2018;Build 19
;;Per VA Directive 6402, this routine should not be modified.
Q
;
FILERR(ARG,RCTYPE,RCERR,ERRMSG) ; File an error
; Inputs : ARG - Array of FHIR data passed into VistaLink
; RCTYPE - type of msg (835ERA/835EFT/etc.)
; RCERR - Line used in ^RCSPESR1 to get error text
; ERRMSG - Error message from PARSE^RCTASFH
;
N GLOB,K,RCOUNT,RCD,RCGBL
; A global reference is needed for the call to ERRUPD^RCSPESR1 but the global is empty in this case
S RCGBL="^TMP(""RCTASFH"","_$J_")"
S RCD("DATE")=$$NOW^XLFDT()
S RCD("SUBJ")="835 EFT FHIR MESSAGE. "_ERRMSG
S RCD("MSG#")="N/A - FHIR Message via VistALink"
;
; Put data from ARG array into message test
S K="",RCOUNT=0
F S K=$O(ARG(K)) Q:K="" D ;
. S RCOUNT=RCOUNT+1,^TMP("RCRAW",$J,RCOUNT)=K_" = "_ARG(K)_" , "
;
I $D(^TMP("DIERR",$J)) S RCOUNT=RCOUNT+1 S ^TMP("RCRAW",$J,RCOUNT)=" "
; Put data from ^TMP("DIERR",$J) into message text
S GLOB="^TMP(""DIERR"",$J)"
F S GLOB=$Q(@GLOB) Q:GLOB'[("^TMP(""DIERR"","_$J) D ;
. S RCOUNT=RCOUNT+1,^TMP("RCRAW",$J,RCOUNT)=GLOB_" = "_@GLOB
;
M ^TMP("RCFHIR",$J)=ARG
S ^TMP("RCFHIR",$J,"ERRORMSG")=ERRMSG
;
D ERRUPD^RCDPESR1(RCGBL,.RCD,RCTYPE,.RCERR)
;
D PERROR^RCDPESR1(.RCERR,"G.RCDPE PAYMENTS EXCEPTIONS",RCD("MSG#"))
;
CLEAN ; Clean up temp globals and variables
K ^TMP("RCERR",$J)
K ^TMP("RCFHIR",$J)
K ^TMP("RCRAW",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCTASFH1 1544 printed Sep 17, 2026@20:33:57 Page 2
RCTASFH1 ;AITC/CJE - Receive FHIR message for ePayments 835 EFT/ERA
+1 ;;4.5;Accounts Receivable;**455**;Oct 4, 2018;Build 19
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
FILERR(ARG,RCTYPE,RCERR,ERRMSG) ; File an error
+1 ; Inputs : ARG - Array of FHIR data passed into VistaLink
+2 ; RCTYPE - type of msg (835ERA/835EFT/etc.)
+3 ; RCERR - Line used in ^RCSPESR1 to get error text
+4 ; ERRMSG - Error message from PARSE^RCTASFH
+5 ;
+6 NEW GLOB,K,RCOUNT,RCD,RCGBL
+7 ; A global reference is needed for the call to ERRUPD^RCSPESR1 but the global is empty in this case
+8 SET RCGBL="^TMP(""RCTASFH"","_$JOB_")"
+9 SET RCD("DATE")=$$NOW^XLFDT()
+10 SET RCD("SUBJ")="835 EFT FHIR MESSAGE. "_ERRMSG
+11 SET RCD("MSG#")="N/A - FHIR Message via VistALink"
+12 ;
+13 ; Put data from ARG array into message test
+14 SET K=""
SET RCOUNT=0
+15 ;
FOR
SET K=$ORDER(ARG(K))
if K=""
QUIT
Begin DoDot:1
+16 SET RCOUNT=RCOUNT+1
SET ^TMP("RCRAW",$JOB,RCOUNT)=K_" = "_ARG(K)_" , "
End DoDot:1
+17 ;
+18 IF $DATA(^TMP("DIERR",$JOB))
SET RCOUNT=RCOUNT+1
SET ^TMP("RCRAW",$JOB,RCOUNT)=" "
+19 ; Put data from ^TMP("DIERR",$J) into message text
+20 SET GLOB="^TMP(""DIERR"",$J)"
+21 ;
FOR
SET GLOB=$QUERY(@GLOB)
if GLOB'[("^TMP(""DIERR"","_$JOB)
QUIT
Begin DoDot:1
+22 SET RCOUNT=RCOUNT+1
SET ^TMP("RCRAW",$JOB,RCOUNT)=GLOB_" = "_@GLOB
End DoDot:1
+23 ;
+24 MERGE ^TMP("RCFHIR",$JOB)=ARG
+25 SET ^TMP("RCFHIR",$JOB,"ERRORMSG")=ERRMSG
+26 ;
+27 DO ERRUPD^RCDPESR1(RCGBL,.RCD,RCTYPE,.RCERR)
+28 ;
+29 DO PERROR^RCDPESR1(.RCERR,"G.RCDPE PAYMENTS EXCEPTIONS",RCD("MSG#"))
+30 ;
CLEAN ; Clean up temp globals and variables
+1 KILL ^TMP("RCERR",$JOB)
+2 KILL ^TMP("RCFHIR",$JOB)
+3 KILL ^TMP("RCRAW",$JOB)
+4 QUIT
