RCTASFH ;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.
;
; ICR 6682 - ENCODE^XLFJSON
; ICR 10097 - $$EC^%ZOSV
; ICR 1621 - ^%ZTER
; ICR 2053 - ^DIE
; ICR 2263 - $$GET^XPAR
; ICR 4440 - $$PROD^XUPROD
; ICR 10103 - ^XLFDT
;
Q
;
POST(RESULT,ARG) ;Entry point to receive 835 EFT message from ARG array
; Input: ARG
N $ESTACK,$ETRAP,GLBO,RETURN
S $ETRAP="D ERR^RCTASFH",$ECODE=""
S GLBO="^TMP(""RCD835"",$J,""OUT"")"
K ^TMP("RCD835",$J)
I $D(ARG)'>1 D G EXIT
. S @GLBO@("Status")="0^ARG parameter is missing or has bad format"
. D ENCODE^XLFJSON(GLBO,"RESULT") S RESULT(1)="["_RESULT(1)_"]"
;
S RETURN=$$PARSEEFT(.ARG)
; Success or failure returned by PARSEEFT
ERRET ; return here after error
I $D(^TMP("RCD835",$J,"ERROR")) S RETURN=^TMP("RCD835",$J,"ERROR")
S @GLBO@("Status")=RETURN
D ENCODE^XLFJSON(GLBO,"RESULT") S RESULT(1)="["_RESULT(1)_"]" ;
EXIT ; Common exit point
K ^TMP("RCD835",$J)
Q
;
PARSEEFT(ARG) ; Parse the incomming EFT Message
; Get the following fields that are needed to file the deposit info and the EFT detail
;
; paymentnotice-pncdepositnumber VistA Deposit Number is derive from "569"_$E(pncdeposit#,7,12)
; paymentnotice-paymentDate = DepositDate (CCYY-MM-DD)
;
; id = "EFT"_Trace#_"."_PayerTIN
; paymentnotice-created = Date/Time CCYY-MM-DD_"T"_HH:MM_"-"_HH:MM (UTC OFFSET)
;
;
; Fields for 344.31 - 06/17/2025 - Changes for new flattened json
; PAYER ID (.03) - payer-identifier ** BECOMES payer-identifier-value **
; TRACE # (.04) - $P(paymentnotice-identifier,".",1) ** BECOMES paymentnotice-payment-identifier-value **
;
; Fields for 344.3
; FILE DATE/TIME (.02) - paymentnotice-created (convert to FileMan Date/Time)
; DEPOSIT NUMBER (.06) - Bytes 7-13 of paymentnotice-pncdepositnumber
; DEPOSIT DATE (.07) - paymentnotice-paymentDate (convert to FileMan Date/Time)
; TOTAL DEPOSIT AMOUNT (.08) - Sum of paymentnotice-amount from each EFT detail added
; DATE/TIME ADDED (.13) - (Calculated) $$NOW^XLFDT
; AMOUNT POSTED TO DEPOSIT (.12) - Default to 0
; TOTAL AMOUNT MATCHED (.14) - Default to 0
;
; Fields for 344.31
; PAYER NAME (.02) - payer-name
; PAYER ID (.03) - payer-identifier-value
; TRACE # (.04) - $P(paymentnotice-payment-identifier-value,".",1)
; AMOUNT OF PAYMENT (.07) - paymentnotice-amount
; MATCH STATUS (.08) - Default to 0
; EFT RECORDED AT SITE (.11) - Default to 0
; DATE CLAIMS PAID (.12) - paymentnotice-paymentDate (convert to FileMan Date/Time)
; ACH TRACE NUMBERS FDA (.15) - paymentnotice-pnctrackingnumber
;
N AMOUNT,DATE,DEBIT,ERRMSG,ERRSTAT,ERROR,FDA,FDATE,FHRDATE,IENS,LCNT,LTRUE
N RCDDAT,RCDEPNO,RCDUP,RCLOCKTM,RCTDA,RCTT,RCUNIT,RCTRACE,RCODE,RCX,X,Z,Z0
;
S RCLOCKTM=$$GET^XPAR("PKG.ACCOUNTS RECEIVABLE","RCDPE FHIR EFT LOCK TIMEOUT",1)
I 'RCLOCKTM S RCLOCKTM=5
S ERRMSG="Error Filing EFT in VistA"
S ERRSTAT=0
S (RCTT,RCUNIT)=0
; Set debugging flags for non-production system
I '$$PROD^XUPROD D ;
. I $D(RCDPTT) S RCTT=1
. I $D(IrisTestCase) S RCUNIT=1
. ; I 'RCTT,'RCUNIT D MRGTMP(.ARG) ; Save data in ^ZZCJE global
. D MRGTMP(.ARG) ; Save data in ^ZZCJE global
;
S FHRDATE=$G(ARG("paymentnotice-paymentdate"))
S RCDDAT=$$FHRTFM(FHRDATE,0)
S RCDEPNO=$G(ARG("paymentnotice-pncdepositnumber"))
S RCODE=$$VALID(.ARG)
I 'RCODE Q RCODE
;
S RCTRACE=$G(ARG("paymentnotice-payment-identifier-value"))
S AMOUNT=+$G(ARG("paymentnotice-amount"))
;
; Before doing anything with an EDI Lockbox deposit get an overall lock. Lock on ^RCY(344.3,"ALOCK") is also used in AR
; nightly process during posting and matching so will make sure FHIR EFT filing does not happen while that is running.
S (ERROR,LCNT,LTRUE,RCTDA,RCX,Z)=0
F LCNT=1:1:6 D I LTRUE Q ;
. L +^RCY(344.3,"ALOCK"):RCLOCKTM
. I $T S LTRUE=1 Q
. H 5
I 'LTRUE S ERRMSG="Could not get overall lock on EDI Lockbox Deposit",ERROR=1,ERRSTAT=2
I ERROR D Q ERRSTAT_"^"_ERRMSG
. I ERRSTAT=0 D FILERR^RCTASFH1(.ARG,"835EFT",3,ERRMSG)
. I ERRSTAT=2 D LOGFAIL(RCTRACE)
;
; Does deposit already exist?
F S Z=$O(^RCY(344.3,"ADEP",RCDDAT,RCDEPNO,Z)) Q:'Z S Z0=$G(^RCY(344.3,Z,0)) S:'$P(Z0,U,3) RCTDA=Z Q:RCTDA D Q:RCTDA
. ; Deposit found - find receipt
. I $O(^RCY(344,"AD",$P(Z0,U,3),0)) S RCDUP=Z Q
. S RCTDA=Z
; I deposit exists get a lock and keep it till update of 344.3 and 344.31 is complete or there is an error
I RCTDA D ;
. L +^RCY(344.3,RCTDA,0):RCLOCKTM I '$T S ERRMSG="Could not get lock on EDI Lockbox Deposit",ERROR=1,ERRSTAT=2
. L -^RCY(344.3,"ALOCK") ; Deposit exists so release overall lock on 344.3
; Following code to file a new LOCKBOX DEPOSIT in 344.3
E D ;
. K ^TMP("DIERR",$J)
. S RCX=+$O(^RCY(344.3," "),-1)
. F RCX=RCX+1:1 I '$D(^RCY(344.3,RCX,0)) L +^RCY(344.3,RCX,0):DILOCKTM I $T Q
. S IENS(1)=RCX
. S IENS="+1,"
. S FHRDATE=$G(ARG("paymentnotice-created"))
. ; Date to Fileman format
. S FDA(344.3,"+1,",.01)=IENS(1) ; Internal Entry Number
. S FDA(344.3,"+1,",.02)=$$FHRTFM(FHRDATE,1) ; FILE DATE/TIME
. S FDA(344.3,IENS,.06)=RCDEPNO ; DEPOSIT NUMBER
. S FDA(344.3,IENS,.07)=RCDDAT ; DEPOSIT DATE
. S FDA(344.3,IENS,.08)=0 ; DEPOSIT AMOUNT - Default to 0. Is be updated after EFT is added
. S FDA(344.3,IENS,.13)=$$NOW^XLFDT() ; DATE/TIME ADDED
. S FDA(344.3,IENS,.12)=0 ; AMOUNT POSTED ) 0 for new entry
. S FDA(344.3,IENS,.14)=0 ; AMOUNT MATCHED
. S FDA(344.3,IENS,.15)=1 ; UNBALANCED FLAG - Default to unbalanced - set to balanced one EFT total is calculated
. D UPDATE^DIE("","FDA","IENS")
. I RCTT,$E(RCTRACE,1,6)="ERRDEP" D GENERR("D")
. I $D(^TMP("DIERR",$J)) S ERRMSG="Error filing EDI LOCKBOX DEPOSIT in VistA",ERROR=1,ERRSTAT=0
. E D ;
. . S RCTDA=IENS(1)
. . I 'RCTDA S ERRMSG="No deposit IEN returned; not filing EFT detail",ERROR=1,ERRSTAT=0
. . I RCUNIT S IrisTestCase("IEN3443")=RCTDA
. L -^RCY(344.3,"ALOCK") ; Attempt to create EDI Lockbox deposit is complete so release overall lock on 344.3
;
I ERROR D Q ERRSTAT_"^"_ERRMSG
. N KEY3
. I ERRSTAT=0 D FILERR^RCTASFH1(.ARG,"835EFT",3,ERRMSG)
. I ERRSTAT=2 D LOGFAIL(RCTRACE)
. S KEY3=$S(RCTDA:RCTDA,1:RCX)
. L -^RCY(344.3,KEY3,0)
;
; EDI LOCKBOX DEPOSIT has been created or updated, so now add the EFT DETAIL TO 344.31
K IENS,FDA,^TMP("DIERR",$J)
S IENS="+1,"
S FDA(344.31,IENS,.01)=RCTDA
S FDA(344.31,IENS,.02)=$G(ARG("payer-name"))
S FDA(344.31,IENS,.03)=$G(ARG("payer-identifier-value"))
S FDA(344.31,IENS,.04)=$P(RCTRACE,".",1)
; Amount filed in the EFT is always positive. If amount in the message is negative, the debit flag is set.
S FDA(344.31,IENS,.07)=$J($S(AMOUNT<0:-AMOUNT,1:AMOUNT),"",2)
S DEBIT=$S(AMOUNT<0:"D",1:"")
S FDA(344.31,IENS,3)=DEBIT
;
S FDA(344.31,IENS,.08)=0
S FDA(344.31,IENS,.11)=0
S FDA(344.31,IENS,.12)=RCDDAT
S FDA(344.31,IENS,.13)=$$DT^XLFDT()
S FDA(344.31,IENS,.15)=$G(ARG("paymentnotice-pnctrackingnumber"))
D UPDATE^DIE("","FDA","IENS")
I RCTT,$E(RCTRACE,1,6)="ERREFT" D GENERR("E")
I $D(^TMP("DIERR",$J)) D Q ERRSTAT_"^"_ERRMSG
. S ERRMSG="Error filing EFT DETAIL in VistA",ERROR=1,ERRSTAT=0
. D FILERR^RCTASFH1(.ARG,"835EFT",3,ERRMSG)
. L -^RCY(344.3,RCTDA,0)
;
I ERROR D Q ERRSTAT_"^"_ERRMSG
. D FILERR^RCTASFH1(.ARG,"835EFT",3,ERRMSG)
;
I RCUNIT S IrisTestCase("IENS34431")=IENS(1)
;
; EDI LOCKBOX DEPOSIT total should always be the sum on the EFTs. So update now.
K IENS,FDA,^TMP("DIERR",$J)
S IENS=RCTDA_","
S FDA(344.3,IENS,.08)=$$SUMEFT^RCDPESR3(RCTDA)
S FDA(344.3,IENS,.15)="@"
D FILE^DIE("","FDA")
L -^RCY(344.3,RCTDA,0) ; Release lock on EDI Lockbox deposit when all updates are completed
;
I RCUNIT Q "1^EFT message successfully filed^"_$G(IrisTestCase("IEN3443"))_"^"_$G(IrisTestCase("IENS34431"))
Q "1^EFT message successfully filed"
;
FHRTFM(FHRDATE,TIME) ; Convert FHIR date to FileMan format
; Inputs FHRDATE - FHIR date/time in FHIR format
; TIME - Boolean flag to say if time should be included in the output
N D,RETURN,T
S TIME=+$G(TIME)
S D=$P(FHRDATE,"T",1),T=$P(FHRDATE,"T",2)
S D=($E(D,1,2)-17)_$E(D,3,4)_$P(D,"-",2)_$P(D,"-",3)
S RETURN=D
I TIME D ;
. I T["-" S T=$P(T,"-",1)
. I T["+" S T=$P(T,"+",1)
. S T=$TR(T,":","")
. I 'T D ;
. . S RETURN=D
. E D ;
. . S RETURN=+(D_"."_T)
Q RETURN
;
VALID(ARG) ; Check for error conditions before filing. If invalid set return error code.
; Inputs : ARG - Arguments passed from VistALink containing JSON name value pairs.
; RETURNS : 1 - Message is valid
; 0^Error Description - Message is invalid
N X
S X=$G(ARG("paymentnotice-pncdepositnumber"))
I $L(X)<6!($L(X)>9) Q "0^Error. Invalid Deposit Number "_X
S X=$G(ARG("payer-identifier-value"))
I X="" Q "0^Error. Mising Payer ID "_X
Q 1
;
GENERR(TYPE) ; Generate error in ^TMP("DIERR",$J) for testing purposes
S ^TMP("DIERR",$J,1)=999
S ^TMP("DIERR",$J,1,"PARAM",0)=0
S ^TMP("DIERR",$J,1,"PARAM","FILE")=$S(TYPE="D":344.3,1:344.31)
S ^TMP("DIERR",$J,1,"TEXT",1)="Testing tool generated error for filing "_$S(TYPE="D":"Deposit",1:"EFT")
S ^TMP("DIERR",$J,"E",999,1)=""
Q
ERR ; Error trap for parsing message.
N KEY3,RCCODE
S RCCODE=$$EC^%ZOSV
S RCCODE=$TR(RCCODE,"^","~") ; Replace '^' since it is used as delimiter in the return value.
S ^TMP("RCD835",$J,"ERROR")="0^Error. Remote proceedure call crashed. "_RCCODE
D ^%ZTER ; Log error to error trap
L -^RCY(344.3,"ALOCK")
S KEY3=$S($G(RCTDA):$G(RCTDA),1:$G(RCX))
I KEY3 L -^RCY(344.3,KEY3,0)
Q
;
MRGTMP(ARG) ; For DEV/TEST system only save the data to ^XTMP
N J,SH
S SH=+$TR($H,",",".")
F J=1:1 Q:'$D(^ZZCJE("EFT835",SH)) S SH=SH+0.000001
M ^ZZCJE("EFT835",SH)=ARG
Q
LOGFAIL(RCID) ; Log lock failure to XTMP for tuning purposes
N PURGE,RCDATE,RDID,RCKEY,RCKEY2,SH,TODAY
I RCID="" Q
S TODAY=$$DT^XLFDT()
S RCKEY="RCDPE"_TODAY_"FHIRLOCK"
I '$D(^XTMP(RCKEY,0)) D ; Node does not exist so create
. S PURGE=$$FMADD^XLFDT(TODAY,3) ; Allow ^XTMP to be purged after 3 days
. S ^XTMP(RCKEY,0)=PURGE_"^"_TODAY
S ^XTMP(RCKEY,RCID)=$G(^XTMP(RCKEY,RCID))+1 ; Keep count of failures for this ID
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCTASFH 10861 printed Sep 17, 2026@20:33:56 Page 2
RCTASFH ;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 ;
+4 ; ICR 6682 - ENCODE^XLFJSON
+5 ; ICR 10097 - $$EC^%ZOSV
+6 ; ICR 1621 - ^%ZTER
+7 ; ICR 2053 - ^DIE
+8 ; ICR 2263 - $$GET^XPAR
+9 ; ICR 4440 - $$PROD^XUPROD
+10 ; ICR 10103 - ^XLFDT
+11 ;
+12 QUIT
+13 ;
POST(RESULT,ARG) ;Entry point to receive 835 EFT message from ARG array
+1 ; Input: ARG
+2 NEW $ESTACK,$ETRAP,GLBO,RETURN
+3 SET $ETRAP="D ERR^RCTASFH"
SET $ECODE=""
+4 SET GLBO="^TMP(""RCD835"",$J,""OUT"")"
+5 KILL ^TMP("RCD835",$JOB)
+6 IF $DATA(ARG)'>1
Begin DoDot:1
+7 SET @GLBO@("Status")="0^ARG parameter is missing or has bad format"
+8 DO ENCODE^XLFJSON(GLBO,"RESULT")
SET RESULT(1)="["_RESULT(1)_"]"
End DoDot:1
GOTO EXIT
+9 ;
+10 SET RETURN=$$PARSEEFT(.ARG)
+11 ; Success or failure returned by PARSEEFT
ERRET ; return here after error
+1 IF $DATA(^TMP("RCD835",$JOB,"ERROR"))
SET RETURN=^TMP("RCD835",$JOB,"ERROR")
+2 SET @GLBO@("Status")=RETURN
+3 ;
DO ENCODE^XLFJSON(GLBO,"RESULT")
SET RESULT(1)="["_RESULT(1)_"]"
EXIT ; Common exit point
+1 KILL ^TMP("RCD835",$JOB)
+2 QUIT
+3 ;
PARSEEFT(ARG) ; Parse the incomming EFT Message
+1 ; Get the following fields that are needed to file the deposit info and the EFT detail
+2 ;
+3 ; paymentnotice-pncdepositnumber VistA Deposit Number is derive from "569"_$E(pncdeposit#,7,12)
+4 ; paymentnotice-paymentDate = DepositDate (CCYY-MM-DD)
+5 ;
+6 ; id = "EFT"_Trace#_"."_PayerTIN
+7 ; paymentnotice-created = Date/Time CCYY-MM-DD_"T"_HH:MM_"-"_HH:MM (UTC OFFSET)
+8 ;
+9 ;
+10 ; Fields for 344.31 - 06/17/2025 - Changes for new flattened json
+11 ; PAYER ID (.03) - payer-identifier ** BECOMES payer-identifier-value **
+12 ; TRACE # (.04) - $P(paymentnotice-identifier,".",1) ** BECOMES paymentnotice-payment-identifier-value **
+13 ;
+14 ; Fields for 344.3
+15 ; FILE DATE/TIME (.02) - paymentnotice-created (convert to FileMan Date/Time)
+16 ; DEPOSIT NUMBER (.06) - Bytes 7-13 of paymentnotice-pncdepositnumber
+17 ; DEPOSIT DATE (.07) - paymentnotice-paymentDate (convert to FileMan Date/Time)
+18 ; TOTAL DEPOSIT AMOUNT (.08) - Sum of paymentnotice-amount from each EFT detail added
+19 ; DATE/TIME ADDED (.13) - (Calculated) $$NOW^XLFDT
+20 ; AMOUNT POSTED TO DEPOSIT (.12) - Default to 0
+21 ; TOTAL AMOUNT MATCHED (.14) - Default to 0
+22 ;
+23 ; Fields for 344.31
+24 ; PAYER NAME (.02) - payer-name
+25 ; PAYER ID (.03) - payer-identifier-value
+26 ; TRACE # (.04) - $P(paymentnotice-payment-identifier-value,".",1)
+27 ; AMOUNT OF PAYMENT (.07) - paymentnotice-amount
+28 ; MATCH STATUS (.08) - Default to 0
+29 ; EFT RECORDED AT SITE (.11) - Default to 0
+30 ; DATE CLAIMS PAID (.12) - paymentnotice-paymentDate (convert to FileMan Date/Time)
+31 ; ACH TRACE NUMBERS FDA (.15) - paymentnotice-pnctrackingnumber
+32 ;
+33 NEW AMOUNT,DATE,DEBIT,ERRMSG,ERRSTAT,ERROR,FDA,FDATE,FHRDATE,IENS,LCNT,LTRUE
+34 NEW RCDDAT,RCDEPNO,RCDUP,RCLOCKTM,RCTDA,RCTT,RCUNIT,RCTRACE,RCODE,RCX,X,Z,Z0
+35 ;
+36 SET RCLOCKTM=$$GET^XPAR("PKG.ACCOUNTS RECEIVABLE","RCDPE FHIR EFT LOCK TIMEOUT",1)
+37 IF 'RCLOCKTM
SET RCLOCKTM=5
+38 SET ERRMSG="Error Filing EFT in VistA"
+39 SET ERRSTAT=0
+40 SET (RCTT,RCUNIT)=0
+41 ; Set debugging flags for non-production system
+42 ;
IF '$$PROD^XUPROD
Begin DoDot:1
+43 IF $DATA(RCDPTT)
SET RCTT=1
+44 IF $DATA(IrisTestCase)
SET RCUNIT=1
+45 ; I 'RCTT,'RCUNIT D MRGTMP(.ARG) ; Save data in ^ZZCJE global
+46 ; Save data in ^ZZCJE global
DO MRGTMP(.ARG)
End DoDot:1
+47 ;
+48 SET FHRDATE=$GET(ARG("paymentnotice-paymentdate"))
+49 SET RCDDAT=$$FHRTFM(FHRDATE,0)
+50 SET RCDEPNO=$GET(ARG("paymentnotice-pncdepositnumber"))
+51 SET RCODE=$$VALID(.ARG)
+52 IF 'RCODE
QUIT RCODE
+53 ;
+54 SET RCTRACE=$GET(ARG("paymentnotice-payment-identifier-value"))
+55 SET AMOUNT=+$GET(ARG("paymentnotice-amount"))
+56 ;
+57 ; Before doing anything with an EDI Lockbox deposit get an overall lock. Lock on ^RCY(344.3,"ALOCK") is also used in AR
+58 ; nightly process during posting and matching so will make sure FHIR EFT filing does not happen while that is running.
+59 SET (ERROR,LCNT,LTRUE,RCTDA,RCX,Z)=0
+60 ;
FOR LCNT=1:1:6
Begin DoDot:1
+61 LOCK +^RCY(344.3,"ALOCK"):RCLOCKTM
+62 IF $TEST
SET LTRUE=1
QUIT
+63 HANG 5
End DoDot:1
IF LTRUE
QUIT
+64 IF 'LTRUE
SET ERRMSG="Could not get overall lock on EDI Lockbox Deposit"
SET ERROR=1
SET ERRSTAT=2
+65 IF ERROR
Begin DoDot:1
+66 IF ERRSTAT=0
DO FILERR^RCTASFH1(.ARG,"835EFT",3,ERRMSG)
+67 IF ERRSTAT=2
DO LOGFAIL(RCTRACE)
End DoDot:1
QUIT ERRSTAT_"^"_ERRMSG
+68 ;
+69 ; Does deposit already exist?
+70 FOR
SET Z=$ORDER(^RCY(344.3,"ADEP",RCDDAT,RCDEPNO,Z))
if 'Z
QUIT
SET Z0=$GET(^RCY(344.3,Z,0))
if '$PIECE(Z0,U,3)
SET RCTDA=Z
if RCTDA
QUIT
Begin DoDot:1
+71 ; Deposit found - find receipt
+72 IF $ORDER(^RCY(344,"AD",$PIECE(Z0,U,3),0))
SET RCDUP=Z
QUIT
+73 SET RCTDA=Z
End DoDot:1
if RCTDA
QUIT
+74 ; I deposit exists get a lock and keep it till update of 344.3 and 344.31 is complete or there is an error
+75 ;
IF RCTDA
Begin DoDot:1
+76 LOCK +^RCY(344.3,RCTDA,0):RCLOCKTM
IF '$TEST
SET ERRMSG="Could not get lock on EDI Lockbox Deposit"
SET ERROR=1
SET ERRSTAT=2
+77 ; Deposit exists so release overall lock on 344.3
LOCK -^RCY(344.3,"ALOCK")
End DoDot:1
+78 ; Following code to file a new LOCKBOX DEPOSIT in 344.3
+79 ;
IF '$TEST
Begin DoDot:1
+80 KILL ^TMP("DIERR",$JOB)
+81 SET RCX=+$ORDER(^RCY(344.3," "),-1)
+82 FOR RCX=RCX+1:1
IF '$DATA(^RCY(344.3,RCX,0))
LOCK +^RCY(344.3,RCX,0):DILOCKTM
IF $TEST
QUIT
+83 SET IENS(1)=RCX
+84 SET IENS="+1,"
+85 SET FHRDATE=$GET(ARG("paymentnotice-created"))
+86 ; Date to Fileman format
+87 ; Internal Entry Number
SET FDA(344.3,"+1,",.01)=IENS(1)
+88 ; FILE DATE/TIME
SET FDA(344.3,"+1,",.02)=$$FHRTFM(FHRDATE,1)
+89 ; DEPOSIT NUMBER
SET FDA(344.3,IENS,.06)=RCDEPNO
+90 ; DEPOSIT DATE
SET FDA(344.3,IENS,.07)=RCDDAT
+91 ; DEPOSIT AMOUNT - Default to 0. Is be updated after EFT is added
SET FDA(344.3,IENS,.08)=0
+92 ; DATE/TIME ADDED
SET FDA(344.3,IENS,.13)=$$NOW^XLFDT()
+93 ; AMOUNT POSTED ) 0 for new entry
SET FDA(344.3,IENS,.12)=0
+94 ; AMOUNT MATCHED
SET FDA(344.3,IENS,.14)=0
+95 ; UNBALANCED FLAG - Default to unbalanced - set to balanced one EFT total is calculated
SET FDA(344.3,IENS,.15)=1
+96 DO UPDATE^DIE("","FDA","IENS")
+97 IF RCTT
IF $EXTRACT(RCTRACE,1,6)="ERRDEP"
DO GENERR("D")
+98 IF $DATA(^TMP("DIERR",$JOB))
SET ERRMSG="Error filing EDI LOCKBOX DEPOSIT in VistA"
SET ERROR=1
SET ERRSTAT=0
+99 ;
IF '$TEST
Begin DoDot:2
+100 SET RCTDA=IENS(1)
+101 IF 'RCTDA
SET ERRMSG="No deposit IEN returned; not filing EFT detail"
SET ERROR=1
SET ERRSTAT=0
+102 IF RCUNIT
SET IrisTestCase("IEN3443")=RCTDA
End DoDot:2
+103 ; Attempt to create EDI Lockbox deposit is complete so release overall lock on 344.3
LOCK -^RCY(344.3,"ALOCK")
End DoDot:1
+104 ;
+105 IF ERROR
Begin DoDot:1
+106 NEW KEY3
+107 IF ERRSTAT=0
DO FILERR^RCTASFH1(.ARG,"835EFT",3,ERRMSG)
+108 IF ERRSTAT=2
DO LOGFAIL(RCTRACE)
+109 SET KEY3=$SELECT(RCTDA:RCTDA,1:RCX)
+110 LOCK -^RCY(344.3,KEY3,0)
End DoDot:1
QUIT ERRSTAT_"^"_ERRMSG
+111 ;
+112 ; EDI LOCKBOX DEPOSIT has been created or updated, so now add the EFT DETAIL TO 344.31
+113 KILL IENS,FDA,^TMP("DIERR",$JOB)
+114 SET IENS="+1,"
+115 SET FDA(344.31,IENS,.01)=RCTDA
+116 SET FDA(344.31,IENS,.02)=$GET(ARG("payer-name"))
+117 SET FDA(344.31,IENS,.03)=$GET(ARG("payer-identifier-value"))
+118 SET FDA(344.31,IENS,.04)=$PIECE(RCTRACE,".",1)
+119 ; Amount filed in the EFT is always positive. If amount in the message is negative, the debit flag is set.
+120 SET FDA(344.31,IENS,.07)=$JUSTIFY($SELECT(AMOUNT<0:-AMOUNT,1:AMOUNT),"",2)
+121 SET DEBIT=$SELECT(AMOUNT<0:"D",1:"")
+122 SET FDA(344.31,IENS,3)=DEBIT
+123 ;
+124 SET FDA(344.31,IENS,.08)=0
+125 SET FDA(344.31,IENS,.11)=0
+126 SET FDA(344.31,IENS,.12)=RCDDAT
+127 SET FDA(344.31,IENS,.13)=$$DT^XLFDT()
+128 SET FDA(344.31,IENS,.15)=$GET(ARG("paymentnotice-pnctrackingnumber"))
+129 DO UPDATE^DIE("","FDA","IENS")
+130 IF RCTT
IF $EXTRACT(RCTRACE,1,6)="ERREFT"
DO GENERR("E")
+131 IF $DATA(^TMP("DIERR",$JOB))
Begin DoDot:1
+132 SET ERRMSG="Error filing EFT DETAIL in VistA"
SET ERROR=1
SET ERRSTAT=0
+133 DO FILERR^RCTASFH1(.ARG,"835EFT",3,ERRMSG)
+134 LOCK -^RCY(344.3,RCTDA,0)
End DoDot:1
QUIT ERRSTAT_"^"_ERRMSG
+135 ;
+136 IF ERROR
Begin DoDot:1
+137 DO FILERR^RCTASFH1(.ARG,"835EFT",3,ERRMSG)
End DoDot:1
QUIT ERRSTAT_"^"_ERRMSG
+138 ;
+139 IF RCUNIT
SET IrisTestCase("IENS34431")=IENS(1)
+140 ;
+141 ; EDI LOCKBOX DEPOSIT total should always be the sum on the EFTs. So update now.
+142 KILL IENS,FDA,^TMP("DIERR",$JOB)
+143 SET IENS=RCTDA_","
+144 SET FDA(344.3,IENS,.08)=$$SUMEFT^RCDPESR3(RCTDA)
+145 SET FDA(344.3,IENS,.15)="@"
+146 DO FILE^DIE("","FDA")
+147 ; Release lock on EDI Lockbox deposit when all updates are completed
LOCK -^RCY(344.3,RCTDA,0)
+148 ;
+149 IF RCUNIT
QUIT "1^EFT message successfully filed^"_$GET(IrisTestCase("IEN3443"))_"^"_$GET(IrisTestCase("IENS34431"))
+150 QUIT "1^EFT message successfully filed"
+151 ;
FHRTFM(FHRDATE,TIME) ; Convert FHIR date to FileMan format
+1 ; Inputs FHRDATE - FHIR date/time in FHIR format
+2 ; TIME - Boolean flag to say if time should be included in the output
+3 NEW D,RETURN,T
+4 SET TIME=+$GET(TIME)
+5 SET D=$PIECE(FHRDATE,"T",1)
SET T=$PIECE(FHRDATE,"T",2)
+6 SET D=($EXTRACT(D,1,2)-17)_$EXTRACT(D,3,4)_$PIECE(D,"-",2)_$PIECE(D,"-",3)
+7 SET RETURN=D
+8 ;
IF TIME
Begin DoDot:1
+9 IF T["-"
SET T=$PIECE(T,"-",1)
+10 IF T["+"
SET T=$PIECE(T,"+",1)
+11 SET T=$TRANSLATE(T,":","")
+12 ;
IF 'T
Begin DoDot:2
+13 SET RETURN=D
End DoDot:2
+14 ;
IF '$TEST
Begin DoDot:2
+15 SET RETURN=+(D_"."_T)
End DoDot:2
End DoDot:1
+16 QUIT RETURN
+17 ;
VALID(ARG) ; Check for error conditions before filing. If invalid set return error code.
+1 ; Inputs : ARG - Arguments passed from VistALink containing JSON name value pairs.
+2 ; RETURNS : 1 - Message is valid
+3 ; 0^Error Description - Message is invalid
+4 NEW X
+5 SET X=$GET(ARG("paymentnotice-pncdepositnumber"))
+6 IF $LENGTH(X)<6!($LENGTH(X)>9)
QUIT "0^Error. Invalid Deposit Number "_X
+7 SET X=$GET(ARG("payer-identifier-value"))
+8 IF X=""
QUIT "0^Error. Mising Payer ID "_X
+9 QUIT 1
+10 ;
GENERR(TYPE) ; Generate error in ^TMP("DIERR",$J) for testing purposes
+1 SET ^TMP("DIERR",$JOB,1)=999
+2 SET ^TMP("DIERR",$JOB,1,"PARAM",0)=0
+3 SET ^TMP("DIERR",$JOB,1,"PARAM","FILE")=$SELECT(TYPE="D":344.3,1:344.31)
+4 SET ^TMP("DIERR",$JOB,1,"TEXT",1)="Testing tool generated error for filing "_$SELECT(TYPE="D":"Deposit",1:"EFT")
+5 SET ^TMP("DIERR",$JOB,"E",999,1)=""
+6 QUIT
ERR ; Error trap for parsing message.
+1 NEW KEY3,RCCODE
+2 SET RCCODE=$$EC^%ZOSV
+3 ; Replace '^' since it is used as delimiter in the return value.
SET RCCODE=$TRANSLATE(RCCODE,"^","~")
+4 SET ^TMP("RCD835",$JOB,"ERROR")="0^Error. Remote proceedure call crashed. "_RCCODE
+5 ; Log error to error trap
DO ^%ZTER
+6 LOCK -^RCY(344.3,"ALOCK")
+7 SET KEY3=$SELECT($GET(RCTDA):$GET(RCTDA),1:$GET(RCX))
+8 IF KEY3
LOCK -^RCY(344.3,KEY3,0)
+9 QUIT
+10 ;
MRGTMP(ARG) ; For DEV/TEST system only save the data to ^XTMP
+1 NEW J,SH
+2 SET SH=+$TRANSLATE($HOROLOG,",",".")
+3 FOR J=1:1
if '$DATA(^ZZCJE("EFT835",SH))
QUIT
SET SH=SH+0.000001
+4 MERGE ^ZZCJE("EFT835",SH)=ARG
+5 QUIT
LOGFAIL(RCID) ; Log lock failure to XTMP for tuning purposes
+1 NEW PURGE,RCDATE,RDID,RCKEY,RCKEY2,SH,TODAY
+2 IF RCID=""
QUIT
+3 SET TODAY=$$DT^XLFDT()
+4 SET RCKEY="RCDPE"_TODAY_"FHIRLOCK"
+5 ; Node does not exist so create
IF '$DATA(^XTMP(RCKEY,0))
Begin DoDot:1
+6 ; Allow ^XTMP to be purged after 3 days
SET PURGE=$$FMADD^XLFDT(TODAY,3)
+7 SET ^XTMP(RCKEY,0)=PURGE_"^"_TODAY
End DoDot:1
+8 ; Keep count of failures for this ID
SET ^XTMP(RCKEY,RCID)=$GET(^XTMP(RCKEY,RCID))+1
+9 QUIT
