RCDPEDA2 ;AITC/DW - ACTIVITY REPORT ;Feb 17, 2017@10:37:00
;;4.5;Accounts Receivable;**318,321,326,380,432,439**;Mar 20, 1995;Build 29
;Per VA Directive 6402, this routine should not be modified.
Q
;
RPT2(INPUT) ;EP from RCDPEDAR
; Loop through EDI LOCKBOX DEPOSIT entries
; Input: INPUT - A1^A2^A3^...^An Where:
; A1 - 1 - Called by nightly job, 0 otherwise
; A2 - 1 - Display to list manager, 0 otherwise
; A3 - 1 - Detail report, 0 - Summary report
; A4 - Current Page Number
; A5 - Stop Flag
; A6 - Start of Date Range
; A7 - End of Date Range
; A8 - Current Line Number
; A9 - Internal Date being processed
; A10- 1 - Only Display EFTs with a debit flag of 'D'
; 0 - Display all EFTs
; ^TMP(B1,$J,B2,B3) = ""
; ^TMP(B1,$J,B2,B3,"EFT",B4) = "" Where:
; B1 - "RCDAILYACT"
; B2 - Internal Date from DATE/TIME ADDED
; (344.3, .13)
; B3 - Internal IEN for 344.3
; B4 - Internal IEN for file 344.31
; Output: INPUT - A1^A2^A3^...^An - The following pieces
; may be updated
; A4 - Updated Page Number
; A5 - Stop Flag
; A6 - Updated Line number
; ^TMP($J,"TOTALS","DEBIT") - Current Total # of debits for date range
; ^TMP($J,"TOTALS","DEBIT","D") - Total # of debits for Internal date (C1)
; ^TMP($J,"TOTALS","DEBITA") - Current Total Debit Amount for date range
; ^TMP($J,"TOTALS","DEBITA","D") - Total Debit Amount for Internal date (C1)
; ^TMP($J,"TOTALS","DEP",C1) - Total # of deposits by Internal date (C1)
; ^TMP($J,"TOTALS","DEPA",C1) - Total Deposit Amount by Internal date (C1)
; ^TMP($J,"TOTALS","EFT","D") - Total Deposit Amount by EFTs for date
; ^TMP($J,"TOTALS","FMS") - FMS Document Status or "NO FMS DOC"
; ^TMP($J,"TOTALS","FMS","D",-1) - Total Deposit Amount by FMS Document
; ^TMP($J,"TOTALS","FMS","D",0) - Total Amount for Error/Rejected documents
; ^TMP($J,"TOTALS","FMS","D",1") - Total Amount for 'A','M',"F' or 'T' docs
; ^TMP($J,"TOTALS","FMS","D",2") - Total Amount for queued docs
; ^TMP($J,"TOTALS","FMSTOT") - Updated Total Deposit Amount for date range
; ^TMP($J,"TOTALS","MATCH","D") - Current Total matched EFTs for date
N CRDOC,DETL,DLNCT,DTADD,IEN344,IEN3443,IEN34431,TOTDEP,Q,X,XX,YY
S DETL=$P(INPUT,"^",3),DTADD=$P(INPUT,"^",9)
;
; Clear the following daily totals
K ^TMP($J,"TOTALS","EFT","D")
K ^TMP($J,"TOTALS","FMS","D")
K ^TMP($J,"TOTALS","MATCH","D")
K ^TMP($J,"TOTALS","DEBIT","D") ;PRCA*4.5*321 Add Debit flag logic
K ^TMP($J,"TOTALS","DEBITA","D")
K ^TMP($J,"ONEDEP"),^TMP($J,"DEPERRS") ;PRCA*4.5*321
S IEN3443="",DLNCT=0 ;PRCA*4.5*321 Add DLNCT
F D Q:IEN3443="" Q:$P(INPUT,"^",5)=1
. S IEN3443=$O(^TMP("RCDAILYACT",$J,DTADD,IEN3443))
. Q:IEN3443=""
. S XX=$$GET1^DIQ(344.3,IEN3443,.03,"I") ; IEN for 344.1
. S IEN344=+$O(^RCY(344,"AD",+XX,0)) ; IEN for 344
. S XX=$G(^TMP($J,"TOTALS","DEP",DTADD))
. S ^TMP($J,"TOTALS","DEP",DTADD)=XX+1 ; # of deposits for day
. S TOTDEP=$$GET1^DIQ(344.3,IEN3443,.08,"I") ; Total Deposit Amount
. S XX=$G(^TMP($J,"TOTALS","DEPA",DTADD))
. S ^TMP($J,"TOTALS","DEPA",DTADD)=XX+TOTDEP ; Total Deposit Amount for day
. S CRDOC=$$GET1^DIQ(344,IEN344,200,"I") ; FMS Document Number
. S ^TMP($J,"TOTALS","CRDOC",IEN3443)=CRDOC
. I CRDOC="" D ; No FMS Document Number
. . S YY=$G(^TMP($J,"TOTALS","FMS","D",-1))
. . S ^TMP($J,"TOTALS","FMS","D",-1)=YY+TOTDEP
. . S ^TMP($J,"TOTALS","FMS")="NO FMS DOC"
. I CRDOC'="" D ; FMS Document Number found
. . I $$GET1^DIQ(344,IEN344,201,"I") S YY="ACCEPTED" ; Default ON-LINE entry to accepted - PRCA*4.5*326
. . E S YY=$$STATUS^GECSSGET(CRDOC) ; Get the status of the doc - PRCA*4.5*326
. . I YY=-1 D Q ; Document wasn't found
. . . S XX=$G(^TMP($J,"TOTALS","FMS","D",-1))
. . . S ^TMP($J,"TOTALS","FMS","D",-1)=XX+TOTDEP
. . . S ^TMP($J,"TOTALS","FMS")="STATUS MISSING"
. . S XX=$E($P(YY," "),1,10) ; First Word of the status
. . S ^TMP($J,"TOTALS","FMS")=XX ; First Word of the status
. . S Q=$E(YY,1) ; First Character of the status
. . S Q=$S(Q="E"!(Q="R"):0,Q="Q":2,1:1) ; Q=0 - Reject or Error, 2 - Queued, 1 - good
. . S XX=$G(^TMP($J,"TOTALS","FMS","D",Q))
. . S ^TMP($J,"TOTALS","FMS","D",Q)=XX+TOTDEP ; Rej/Err, Queued OR good Amount for day
. ;
. D ONEDEP(.INPUT,IEN3443,TOTDEP,.DLNCT) ;PRCA*4.5*321 Gather and display one deposit
Q
;
ONEDEP(INPUT,IEN3443,TOTDEP,DLNCT) ; Gather and display lines for one Deposit
; PRCA*4.5*321 new method to first gather all the lines before displaying them
; Input: INPUT - See RPT2 for details
; ^TMP(B1,$J,B2,B3) - See RPT2 for details
; IEN3443 - Internal IEN for file 344.3
; TOTDEP - Total Deposit Amount (344.3, .08)
; DLNCT - Current # of deposit lines displayed
; ^TMP($J,"DEPERRS") - Current Line Count
; Note: Only passed if not in detail mode
; ^TMP($J,"DEPERRS,X) - Error line(s)
; Output: INPUT - See RPT2 for details
; DLNCT - Updated # of deposit lines displayed
; ^TMP(B1,$J,B2,B3,"EFT",B4) - See RPT2 for details
; ^TMP($J,"TOTALS","DEP",C1) - See RPT2 for details
; ^TMP($J,"DEPERRS") - Updated Line Count
; Note: Only passed if not in detail mode
N CURLNS,DEPLNS,DETL,DTADD,EFTCTR,EFTLN,EFTLNS,LSTMAN,XX,YY,ZZ
S DETL=$P(INPUT,"^",3)
S DTADD=$P(INPUT,"^",9)
K:DETL ^TMP($J,"ONEDEP"),^TMP($J,"DEPERRS")
S LSTMAN=$P(INPUT,"^",2)
I DETL D ; Gather Detail Line
. D DETLN(.INPUT,IEN3443,TOTDEP)
S ^TMP($J,"TOTALS","FMSTOT")=0 ; Initialize FMS total for range
D ERRMSGS^RCDPEDA4(.INPUT,IEN3443) ; Gather any error message lines
D PROCEFT(.INPUT,IEN3443) ; Gather lines for EFT records
Q:'DETL
;
; Determine overall line count for deposit
S ZZ=1 ; deposit line (1st line per record)
S ZZ=ZZ+$G(^TMP($J,"DEPERRS")) ; deposit errors line cnt
S XX=0 F XX=$O(^TMP($J,"ONEDEP",XX)) D Q:XX=""
. S ZZ=ZZ+$G(^TMP($J,"ONEDEP",XX))
S DEPLNS=ZZ
;
; If not outputting to listman and at least 1 deposit is already displayed
; on the page, check to see if we have don't have room to display the
; deposit detail line
I 'LSTMAN,DLNCT,(DLNCT+DEPLNS+2)>IOSL D Q:$P(INPUT,"^",5)=1
. S DLNCT=0
. D NEWDHDR(.INPUT,DTADD)
. Q:$P(INPUT,"^",5)=1
; Display first deposit line
S DLNCT=DLNCT+1
S XX=^TMP($J,"ONEDEP",0,1)
D SL^RCDPEDA3(.INPUT,XX)
;
; If not outputting to listman, check to see if we have don't have room to
; display any deposit error info
S XX=$G(^TMP($J,"DEPERRS"))
I 'LSTMAN,XX,XX<IOSL,(DLNCT+XX)>IOSL D Q:$P(INPUT,"^",5)=1
. S DLNCT=0
. D NEWDHDR(.INPUT,DTADD)
. Q:$P(INPUT,"^",5)=1
S DLNCT=DLNCT+XX
;
; Display Deposit Error (if any)
S XX=""
F D Q:XX=""
. S XX=$O(^TMP($J,"DEPERRS",XX))
. Q:XX=""
. S YY=^TMP($J,"DEPERRS",XX)
. D SL^RCDPEDA3(.INPUT,YY)
;
; Display Remaining Deposit lines one EFT at a time
S EFTCTR=0
F D Q:EFTCTR="" Q:$P(INPUT,"^",5)=1
. S EFTCTR=$O(^TMP($J,"ONEDEP",EFTCTR))
. Q:EFTCTR=""
. ;
. ; If not outputting to listman, check to see if we have don't have room to
. ; display any EFT
. S EFTLNS=$G(^TMP($J,"ONEDEP",EFTCTR))
. I 'LSTMAN,EFTLNS<IOSL,(DLNCT+EFTLNS)>IOSL D Q:$P(INPUT,"^",5)=1
. . D NEWDHDR(.INPUT,DTADD)
. . Q:$P(INPUT,"^",5)=1
. . S XX=^TMP($J,"ONEDEP",0,1)
. . D SL^RCDPEDA3(.INPUT,XX)
. . S DLNCT=1
. S EFTLN=""
. F D Q:EFTLN=""
. . S EFTLN=$O(^TMP($J,"ONEDEP",EFTCTR,EFTLN))
. . Q:EFTLN=""
. . S ZZ=^TMP($J,"ONEDEP",EFTCTR,EFTLN)
. . D SL^RCDPEDA3(.INPUT,ZZ)
. . S DLNCT=DLNCT+1
Q
;
NEWDHDR(INPUT,DTADD) ; display a new deposit header for the specified date
; Input: INPUT - See RPT2 for details
; DTADD - Internal Date deposit are being displayed for
N XX
D HDR^RCDPEDA3(.INPUT)
Q:$P(INPUT,"^",5)=1 ; user quit or timed out
S XX="DATE EFT DEPOSIT RECEIVED: "_$$FMTE^XLFDT(DTADD,"2Z")
S XX=$J("",80-$L(XX)\2)_XX ; Center it
D SL^RCDPEDA3(.INPUT,XX)
D SL^RCDPEDA3(.INPUT," ")
Q
;
DETLN(INPUT,IEN3443,TOTDEP) ; Display detail line
; Input: INPUT - See RPT2 for details
; IEN3443 - Internal IEN for file 344.3
; TOTDEP - Total Deposit Amount (344.3, .08)
; ^TMP($J,"TOTALS","FMS") - FMS Document # or "NO FMS DOC"
; Output: INPUT - A1^A2^A3^...^An - The following pieces may be updated
; A5 - Updated Page Number
; A6 - Stop Flag
; A8 - Updated Line Counter
;
N DEPDT,DEPNUM,DETL,DTADD,LSTMAN,MULT,NJ,RCDBAL,X,XX,YY
S LSTMAN=$P(INPUT,"^",2),NJ=$P(INPUT,"^",1)
S DETL=$P(INPUT,"^",3)
;PRCA*4.5*380 - Check for multiple mail messages on this deposit
S:$O(^RCY(344.3,IEN3443,3,0))'="" MULT="*"
;PRCA*4.5*380 - Check if prior deposits exist
S DEPNUM=$$GET1^DIQ(344.3,IEN3443,.06,"I"),DEPDT=$$GET1^DIQ(344.3,IEN3443,.07,"I")
S XX=$O(^RCY(344.3,"ADEP2",DEPNUM,DEPDT,0)),XX=$O(^RCY(344.3,"ADEP2",DEPNUM,DEPDT,XX))
S:XX'="" MULT=$G(MULT)_"+"
S XX=DEPNUM ; Deposit Number
;
S X=$$SETSTR^VALM1(XX,"",1,9)
;
S YY=DEPDT ; Deposit Date
;PRCA*4.5*380 - Include multi-mail message indicator with date
S X=$$SETSTR^VALM1($$FMTE^XLFDT(YY\1,"2Z")_$G(MULT),X,12,10)
;
; Is deposit in balance with EFT totals, PRCA*4.5*439
S RCDBAL=$$DEPBAL^RCDPEDA4(IEN3443),RCDBAL=$S(RCDBAL:"",1:"**UNBALANCED**")
;
;S X=$$SETSTR^VALM1("",X,23,8)
;S X=$$SETSTR^VALM1("",X,32,10)
S X=$$SETSTR^VALM1(RCDBAL,X,23,14) ; PRCA*4.5*439
S X=$$SETSTR^VALM1("",X,38,4) ; PRCA*4.5*439
S XX=^TMP($J,"TOTALS","FMS")
S X=$$SETSTR^VALM1($E($J(TOTDEP,"",2)_$J("",20),1,20)_XX,X,43,37)
S ^TMP($J,"ONEDEP",0,1)=X ; PRCA*4.5*321
Q
;
PROCEFT(INPUT,IEN3443) ; Process EFT records
; Input: INPUT - See RPT2 for details
; IEN3443 - Internal IEN for file 344.3
; ^TMP($J,"ONEDEP",0,1) - Deposit Detail line
; ^TMP($J,"TOTALS","DEBIT","D") - Current Total # of Debit EFTs for date
; ^TMP($J,"TOTALS","DEBITA","D") - Current Total Amount of Debit EFTs for date
; ^TMP($J,"TOTALS","EFT","D") - Current Total Deposit Amount by EFTs for date
; ^TMP($J,"TOTALS","MATCH","D") - Current Total matched EFTs for date
; ^TMP($J,"TOTALS","FMSTOT") - Current Total Deposit Amount for date range
; Output: INPUT - A1^A2^A3^...^An - The following pieces
; may be updated
; A5 - Updated Page Number
; A6 - Stop Flag
; A8 - Updated Line Counter
; ^TMP($J,"ONEDEP",0,1) - Deposit Detail line
; ^TMP($J,"ONEDEP","EFTCTR") - # of lines for This EFT
; ^TMP($J,"ONEDEP","EFTCTR",xx)=LINE - EFT Lines
; ^TMP($J,"TOTALS","DEBIT","D") - Updated Total # of Debit EFTs for date
; ^TMP($J,"TOTALS","DEBITA","D") - Updated Total Amount of Debit EFTs for date
; ^TMP($J,"TOTALS","DEBIT") - Updated Total # of Debit EFTs for date range
; ^TMP($J,"TOTALS","DEBITA") - Updated Total Amount of Debit EFTs for date range
; ^TMP($J,"TOTALS","FMSTOT") - Updated Total Deposit Amount for date range
; ^TMP($J,"TOTALS","EFT","D") - Updated Total Deposit Amount by EFTs for date
; ^TMP($J,"TOTALS","MATCH","D") - Updated Total matched EFTs for date
N DETL,DFLG,DTADD,EFTCTR,IEN34431,PAMT,RCFMS1,TRDOC,X,XX,YY ; PRCA*4.5*321 Added DFLG
; PRCA*4.5*321 capture display and line cnt to ^TMP($J,"ONEDEP")
S ^TMP($J,"TOTALS","FMSTOT")=0,EFTCTR=0
S DTADD=$P(INPUT,"^",9)
S RCFMS1="NO FMS DOC"
S DETL=$P(INPUT,"^",3)
S IEN34431=""
F D Q:IEN34431="" Q:$P(INPUT,"^",5)=1
. S IEN34431=$O(^TMP("RCDAILYACT",$J,DTADD,IEN3443,"EFT",IEN34431))
. Q:IEN34431=""
. S XX=$G(^TMP($J,"TOTALS","EFT","D"))+1
. S ^TMP($J,"TOTALS","EFT","D")=XX ; Total # EFTs for date
. ;
. S YY=$$GET1^DIQ(344.31,IEN34431,3,"E") ; Debit/Credit flag ; PRCA*4.5*321 added line
. S DFLG=$S(YY="D":1,1:0) ; PRCA*4.5*321 added line
. S PAMT=$$GET1^DIQ(344.31,IEN34431,.07,"I") ; Amount of Payment
. I DFLG D ; PRCA*4.5*321 added if Statement
. . S XX=$G(^TMP($J,"TOTALS","DEBIT","D"))+1
. . S ^TMP($J,"TOTALS","DEBIT","D")=XX ; Total # Debit EFTs for date
. . S XX=$G(^TMP($J,"TOTALS","DEBITA","D")) ; Total Debit Amounts for date
. . S ^TMP($J,"TOTALS","DEBITA","D")=XX+PAMT
. ;
. S XX=+$$GET1^DIQ(344.31,IEN34431,.09,"I") ; Receipt # from 344.31
. S TRDOC=$$GET1^DIQ(344,XX,200,"I") ; FMS Document #
. I $$GET1^DIQ(344,XX,201,"I") S X="ACCEPTED" ; Default ON-LINE ENTRY status to accepted - PRCA*4.5*326
. E S X=$S(TRDOC'="":$$STATUS^GECSSGET(TRDOC),1:"") ; PRCA*4.5*326
. I X'="",X'=-1,$E(X,1)'="R",$E(X,1)'="E" D
. . S XX=$G(^TMP($J,"TOTALS","FMSTOT"))
. . S ^TMP($J,"TOTALS","FMSTOT")=XX+PAMT ; Total Amount of Payment
. . S RCFMS1=$S($E(X,1)="Q":"QUEUED TO POST",1:"POSTED")
. S XX=$S(X="":"",X=-1:"NO FMS DOC",1:$E($P(X," ",1),1,10))
. S RCFMS1(IEN34431)=XX ; FMS Document Status for EFT
. S XX=$$GET1^DIQ(344.31,IEN34431,.08,"I") ; Match Status
. I XX D
. . S XX=$G(^TMP($J,"TOTALS","MATCH","D"))
. . S ^TMP($J,"TOTALS","MATCH","D")=XX+1 ; Total Matched EFTS by date
. I DETL D ;PRCA*4.5*321
. . S EFTCTR=EFTCTR+1
. . D EFTDTL(.INPUT,IEN3443,IEN34431,.RCFMS1,EFTCTR)
. . S YY=$G(^TMP($J,"ONEDEP",EFTCTR))+1
. . S ^TMP($J,"ONEDEP",EFTCTR)=YY
. . S ^TMP($J,"ONEDEP",EFTCTR,YY)=" "
Q
;
EFTDTL(INPUT,IEN3443,IEN34431,RCFMS1,EFTCTR) ; Display EFT Detail
; Input: INPUT - See RPT2 for details
; IEN3443 - Internal IEN for file 344.3
; IEN34431 - Internal IEN for file 344.31
; RCFMS1(IEN34431) - FMS Document Status for EFT IEN
; EFTCTR - Used to store lines for an EFT
; ^TMP($J,ONEDEP,0,1) - Deposit Detail line
; Output: INPUT - See RPT2 for details
; ^TMP($J,ONEDEP,0,1) - Deposit Detail line
; ^TMP($J,ONEDEP,EFTCTR) - # of lines for EFT
; ^TMP($J,ONEDEP,EFTCTR,xx)- EFT Deposit Lines ;PRCA*4.5*321 capture display to ^TMP($J,"ONEDEP",EFTRCR) including line cnt
N EFTLN,MDT,PAY,PAYER,PAYID,RCDEBIT,X,XX,YY,ZZ ; RCDEBIT, PRCA*4.5*432
S XX=$$GET1^DIQ(344.31,IEN34431,.01,"E") ; EFT Transaction detail - PRCA*4.5*326
S X=$$SETSTR^VALM1(XX,"",3,9)
S XX=$$GET1^DIQ(344.31,IEN34431,.12,"I") ; Date Claims Paid
S X=$$SETSTR^VALM1($$FMTE^XLFDT(XX\1,"2Z"),X,23,8) ; PRCA*4.5*326 - move 8 back for MATCH DATE
S XX=$$GET1^DIQ(344.31,IEN34431,.07,"I") ; Amount of Payment
S RCDEBIT=$$GET1^DIQ(344.31,IEN34431,3,"E") ; PRCA 4.5*432
I '($E(XX)="-") S XX=$S(RCDEBIT="D":"-",1:"")_XX ; PRCA 4.5*432
S X=$$SETSTR^VALM1($J(XX,"",2),X,33,18) ; PRCA*4.5*326 - move 8 back for MATCH DATE
;
; PRCA*4.5*284, Move to left 3 space (61 to 58) to allow for 10 digit ERA #'s
S XX=$$GET1^DIQ(344.31,IEN34431,.08,"I") ; Match Status
S YY=$$GET1^DIQ(344.31,IEN34431,.1,"I") ; ERA IEN
S MDT=""
I XX=1 S MDT=$$MATCHDT^RCDPEWL7(IEN34431) ; PRCA*4.5*326 - Date matched to ERA
; PRCA*4.5*326 - next line, move 8 back and add MATCH DATE
S X=$$SETSTR^VALM1($$EXTERNAL^DILFD(344.31,.08,"",+XX)_$S(XX=1:"/ERA #"_YY,1:"")_" "_MDT,X,49,30)
S ^TMP($J,"ONEDEP",EFTCTR,1)=X
;
S XX=$$GET1^DIQ(344.31,IEN34431,.04,"I") ; Trace Number
S X=$$SETSTR^VALM1(XX,"",5,$L(XX))
S XX=$G(^TMP($J,"TOTALS","CRDOC",IEN3443))
S X=$$SETSTR^VALM1(XX,X,59,$L(XX)) ; CR Doc
S ^TMP($J,"ONEDEP",EFTCTR,2)=X
;
S PAYER=$$GET1^DIQ(344.31,IEN34431,.02,"I") ; Payer Name
S:PAYER="" PAYER="NO PAYER NAME RECEIVED"
S PAYID=$$GET1^DIQ(344.31,IEN34431,.03,"I") ; Payer ID
S PAY=PAYER_"/"_PAYID
I $L(PAY)>74 D
. S ZZ=$L(PAY,"/"),XX=$P(PAY,"/",1,ZZ-1),YY=$P(PAY,"/",ZZ)
. S XX=$E(XX,1,$L(XX)-($L(PAY)-74)),PAY=XX_"/"_YY
S X=$$SETSTR^VALM1(PAY,"",7,74)
S ^TMP($J,"ONEDEP",EFTCTR,3)=X
S ^TMP($J,"ONEDEP",EFTCTR)=3
;
; PRCA*4.5*318 add TR #s to detail rpt
; Gather & display all TR Doc #s for EFT detail record
D GETTR^RCDPEDA4(IEN34431,.INPUT) ; PRCA*4.5*321 moved for routine size
S X=""
S XX=$$GET1^DIQ(344.31,IEN34431,.09,"I") ; Receipt IEN
I XX'="" D
. S YY=$$GET1^DIQ(344,XX,.01,"I") ; Receipt Number
. S X=$$SETSTR^VALM1(YY,X,45,12) ; PRCA*4.5*321 changed 46 to 45
S X=$$SETSTR^VALM1($G(RCFMS1(IEN34431)),X,61,19)
S EFTLN=$G(^TMP($J,"ONEDEP",EFTCTR))+1
S ^TMP($J,"ONEDEP",EFTCTR)=EFTLN
S ^TMP($J,"ONEDEP",EFTCTR,EFTLN)=X
D EFTERRS^RCDPEDA4(.INPUT,IEN34431,EFTCTR) ; Display any EFT Errors
D DUP^RCDPEDA4(.INPUT,IEN34431,EFTCTR) ; Display any Duplicate Errors
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEDA2 19114 printed Sep 23, 2025@19:20:31 Page 2
RCDPEDA2 ;AITC/DW - ACTIVITY REPORT ;Feb 17, 2017@10:37:00
+1 ;;4.5;Accounts Receivable;**318,321,326,380,432,439**;Mar 20, 1995;Build 29
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
RPT2(INPUT) ;EP from RCDPEDAR
+1 ; Loop through EDI LOCKBOX DEPOSIT entries
+2 ; Input: INPUT - A1^A2^A3^...^An Where:
+3 ; A1 - 1 - Called by nightly job, 0 otherwise
+4 ; A2 - 1 - Display to list manager, 0 otherwise
+5 ; A3 - 1 - Detail report, 0 - Summary report
+6 ; A4 - Current Page Number
+7 ; A5 - Stop Flag
+8 ; A6 - Start of Date Range
+9 ; A7 - End of Date Range
+10 ; A8 - Current Line Number
+11 ; A9 - Internal Date being processed
+12 ; A10- 1 - Only Display EFTs with a debit flag of 'D'
+13 ; 0 - Display all EFTs
+14 ; ^TMP(B1,$J,B2,B3) = ""
+15 ; ^TMP(B1,$J,B2,B3,"EFT",B4) = "" Where:
+16 ; B1 - "RCDAILYACT"
+17 ; B2 - Internal Date from DATE/TIME ADDED
+18 ; (344.3, .13)
+19 ; B3 - Internal IEN for 344.3
+20 ; B4 - Internal IEN for file 344.31
+21 ; Output: INPUT - A1^A2^A3^...^An - The following pieces
+22 ; may be updated
+23 ; A4 - Updated Page Number
+24 ; A5 - Stop Flag
+25 ; A6 - Updated Line number
+26 ; ^TMP($J,"TOTALS","DEBIT") - Current Total # of debits for date range
+27 ; ^TMP($J,"TOTALS","DEBIT","D") - Total # of debits for Internal date (C1)
+28 ; ^TMP($J,"TOTALS","DEBITA") - Current Total Debit Amount for date range
+29 ; ^TMP($J,"TOTALS","DEBITA","D") - Total Debit Amount for Internal date (C1)
+30 ; ^TMP($J,"TOTALS","DEP",C1) - Total # of deposits by Internal date (C1)
+31 ; ^TMP($J,"TOTALS","DEPA",C1) - Total Deposit Amount by Internal date (C1)
+32 ; ^TMP($J,"TOTALS","EFT","D") - Total Deposit Amount by EFTs for date
+33 ; ^TMP($J,"TOTALS","FMS") - FMS Document Status or "NO FMS DOC"
+34 ; ^TMP($J,"TOTALS","FMS","D",-1) - Total Deposit Amount by FMS Document
+35 ; ^TMP($J,"TOTALS","FMS","D",0) - Total Amount for Error/Rejected documents
+36 ; ^TMP($J,"TOTALS","FMS","D",1") - Total Amount for 'A','M',"F' or 'T' docs
+37 ; ^TMP($J,"TOTALS","FMS","D",2") - Total Amount for queued docs
+38 ; ^TMP($J,"TOTALS","FMSTOT") - Updated Total Deposit Amount for date range
+39 ; ^TMP($J,"TOTALS","MATCH","D") - Current Total matched EFTs for date
+40 NEW CRDOC,DETL,DLNCT,DTADD,IEN344,IEN3443,IEN34431,TOTDEP,Q,X,XX,YY
+41 SET DETL=$PIECE(INPUT,"^",3)
SET DTADD=$PIECE(INPUT,"^",9)
+42 ;
+43 ; Clear the following daily totals
+44 KILL ^TMP($JOB,"TOTALS","EFT","D")
+45 KILL ^TMP($JOB,"TOTALS","FMS","D")
+46 KILL ^TMP($JOB,"TOTALS","MATCH","D")
+47 ;PRCA*4.5*321 Add Debit flag logic
KILL ^TMP($JOB,"TOTALS","DEBIT","D")
+48 KILL ^TMP($JOB,"TOTALS","DEBITA","D")
+49 ;PRCA*4.5*321
KILL ^TMP($JOB,"ONEDEP"),^TMP($JOB,"DEPERRS")
+50 ;PRCA*4.5*321 Add DLNCT
SET IEN3443=""
SET DLNCT=0
+51 FOR
Begin DoDot:1
+52 SET IEN3443=$ORDER(^TMP("RCDAILYACT",$JOB,DTADD,IEN3443))
+53 if IEN3443=""
QUIT
+54 ; IEN for 344.1
SET XX=$$GET1^DIQ(344.3,IEN3443,.03,"I")
+55 ; IEN for 344
SET IEN344=+$ORDER(^RCY(344,"AD",+XX,0))
+56 SET XX=$GET(^TMP($JOB,"TOTALS","DEP",DTADD))
+57 ; # of deposits for day
SET ^TMP($JOB,"TOTALS","DEP",DTADD)=XX+1
+58 ; Total Deposit Amount
SET TOTDEP=$$GET1^DIQ(344.3,IEN3443,.08,"I")
+59 SET XX=$GET(^TMP($JOB,"TOTALS","DEPA",DTADD))
+60 ; Total Deposit Amount for day
SET ^TMP($JOB,"TOTALS","DEPA",DTADD)=XX+TOTDEP
+61 ; FMS Document Number
SET CRDOC=$$GET1^DIQ(344,IEN344,200,"I")
+62 SET ^TMP($JOB,"TOTALS","CRDOC",IEN3443)=CRDOC
+63 ; No FMS Document Number
IF CRDOC=""
Begin DoDot:2
+64 SET YY=$GET(^TMP($JOB,"TOTALS","FMS","D",-1))
+65 SET ^TMP($JOB,"TOTALS","FMS","D",-1)=YY+TOTDEP
+66 SET ^TMP($JOB,"TOTALS","FMS")="NO FMS DOC"
End DoDot:2
+67 ; FMS Document Number found
IF CRDOC'=""
Begin DoDot:2
+68 ; Default ON-LINE entry to accepted - PRCA*4.5*326
IF $$GET1^DIQ(344,IEN344,201,"I")
SET YY="ACCEPTED"
+69 ; Get the status of the doc - PRCA*4.5*326
IF '$TEST
SET YY=$$STATUS^GECSSGET(CRDOC)
+70 ; Document wasn't found
IF YY=-1
Begin DoDot:3
+71 SET XX=$GET(^TMP($JOB,"TOTALS","FMS","D",-1))
+72 SET ^TMP($JOB,"TOTALS","FMS","D",-1)=XX+TOTDEP
+73 SET ^TMP($JOB,"TOTALS","FMS")="STATUS MISSING"
End DoDot:3
QUIT
+74 ; First Word of the status
SET XX=$EXTRACT($PIECE(YY," "),1,10)
+75 ; First Word of the status
SET ^TMP($JOB,"TOTALS","FMS")=XX
+76 ; First Character of the status
SET Q=$EXTRACT(YY,1)
+77 ; Q=0 - Reject or Error, 2 - Queued, 1 - good
SET Q=$SELECT(Q="E"!(Q="R"):0,Q="Q":2,1:1)
+78 SET XX=$GET(^TMP($JOB,"TOTALS","FMS","D",Q))
+79 ; Rej/Err, Queued OR good Amount for day
SET ^TMP($JOB,"TOTALS","FMS","D",Q)=XX+TOTDEP
End DoDot:2
+80 ;
+81 ;PRCA*4.5*321 Gather and display one deposit
DO ONEDEP(.INPUT,IEN3443,TOTDEP,.DLNCT)
End DoDot:1
if IEN3443=""
QUIT
if $PIECE(INPUT,"^",5)=1
QUIT
+82 QUIT
+83 ;
ONEDEP(INPUT,IEN3443,TOTDEP,DLNCT) ; Gather and display lines for one Deposit
+1 ; PRCA*4.5*321 new method to first gather all the lines before displaying them
+2 ; Input: INPUT - See RPT2 for details
+3 ; ^TMP(B1,$J,B2,B3) - See RPT2 for details
+4 ; IEN3443 - Internal IEN for file 344.3
+5 ; TOTDEP - Total Deposit Amount (344.3, .08)
+6 ; DLNCT - Current # of deposit lines displayed
+7 ; ^TMP($J,"DEPERRS") - Current Line Count
+8 ; Note: Only passed if not in detail mode
+9 ; ^TMP($J,"DEPERRS,X) - Error line(s)
+10 ; Output: INPUT - See RPT2 for details
+11 ; DLNCT - Updated # of deposit lines displayed
+12 ; ^TMP(B1,$J,B2,B3,"EFT",B4) - See RPT2 for details
+13 ; ^TMP($J,"TOTALS","DEP",C1) - See RPT2 for details
+14 ; ^TMP($J,"DEPERRS") - Updated Line Count
+15 ; Note: Only passed if not in detail mode
+16 NEW CURLNS,DEPLNS,DETL,DTADD,EFTCTR,EFTLN,EFTLNS,LSTMAN,XX,YY,ZZ
+17 SET DETL=$PIECE(INPUT,"^",3)
+18 SET DTADD=$PIECE(INPUT,"^",9)
+19 if DETL
KILL ^TMP($JOB,"ONEDEP"),^TMP($JOB,"DEPERRS")
+20 SET LSTMAN=$PIECE(INPUT,"^",2)
+21 ; Gather Detail Line
IF DETL
Begin DoDot:1
+22 DO DETLN(.INPUT,IEN3443,TOTDEP)
End DoDot:1
+23 ; Initialize FMS total for range
SET ^TMP($JOB,"TOTALS","FMSTOT")=0
+24 ; Gather any error message lines
DO ERRMSGS^RCDPEDA4(.INPUT,IEN3443)
+25 ; Gather lines for EFT records
DO PROCEFT(.INPUT,IEN3443)
+26 if 'DETL
QUIT
+27 ;
+28 ; Determine overall line count for deposit
+29 ; deposit line (1st line per record)
SET ZZ=1
+30 ; deposit errors line cnt
SET ZZ=ZZ+$GET(^TMP($JOB,"DEPERRS"))
+31 SET XX=0
FOR XX=$ORDER(^TMP($JOB,"ONEDEP",XX))
Begin DoDot:1
+32 SET ZZ=ZZ+$GET(^TMP($JOB,"ONEDEP",XX))
End DoDot:1
if XX=""
QUIT
+33 SET DEPLNS=ZZ
+34 ;
+35 ; If not outputting to listman and at least 1 deposit is already displayed
+36 ; on the page, check to see if we have don't have room to display the
+37 ; deposit detail line
+38 IF 'LSTMAN
IF DLNCT
IF (DLNCT+DEPLNS+2)>IOSL
Begin DoDot:1
+39 SET DLNCT=0
+40 DO NEWDHDR(.INPUT,DTADD)
+41 if $PIECE(INPUT,"^",5)=1
QUIT
End DoDot:1
if $PIECE(INPUT,"^",5)=1
QUIT
+42 ; Display first deposit line
+43 SET DLNCT=DLNCT+1
+44 SET XX=^TMP($JOB,"ONEDEP",0,1)
+45 DO SL^RCDPEDA3(.INPUT,XX)
+46 ;
+47 ; If not outputting to listman, check to see if we have don't have room to
+48 ; display any deposit error info
+49 SET XX=$GET(^TMP($JOB,"DEPERRS"))
+50 IF 'LSTMAN
IF XX
IF XX<IOSL
IF (DLNCT+XX)>IOSL
Begin DoDot:1
+51 SET DLNCT=0
+52 DO NEWDHDR(.INPUT,DTADD)
+53 if $PIECE(INPUT,"^",5)=1
QUIT
End DoDot:1
if $PIECE(INPUT,"^",5)=1
QUIT
+54 SET DLNCT=DLNCT+XX
+55 ;
+56 ; Display Deposit Error (if any)
+57 SET XX=""
+58 FOR
Begin DoDot:1
+59 SET XX=$ORDER(^TMP($JOB,"DEPERRS",XX))
+60 if XX=""
QUIT
+61 SET YY=^TMP($JOB,"DEPERRS",XX)
+62 DO SL^RCDPEDA3(.INPUT,YY)
End DoDot:1
if XX=""
QUIT
+63 ;
+64 ; Display Remaining Deposit lines one EFT at a time
+65 SET EFTCTR=0
+66 FOR
Begin DoDot:1
+67 SET EFTCTR=$ORDER(^TMP($JOB,"ONEDEP",EFTCTR))
+68 if EFTCTR=""
QUIT
+69 ;
+70 ; If not outputting to listman, check to see if we have don't have room to
+71 ; display any EFT
+72 SET EFTLNS=$GET(^TMP($JOB,"ONEDEP",EFTCTR))
+73 IF 'LSTMAN
IF EFTLNS<IOSL
IF (DLNCT+EFTLNS)>IOSL
Begin DoDot:2
+74 DO NEWDHDR(.INPUT,DTADD)
+75 if $PIECE(INPUT,"^",5)=1
QUIT
+76 SET XX=^TMP($JOB,"ONEDEP",0,1)
+77 DO SL^RCDPEDA3(.INPUT,XX)
+78 SET DLNCT=1
End DoDot:2
if $PIECE(INPUT,"^",5)=1
QUIT
+79 SET EFTLN=""
+80 FOR
Begin DoDot:2
+81 SET EFTLN=$ORDER(^TMP($JOB,"ONEDEP",EFTCTR,EFTLN))
+82 if EFTLN=""
QUIT
+83 SET ZZ=^TMP($JOB,"ONEDEP",EFTCTR,EFTLN)
+84 DO SL^RCDPEDA3(.INPUT,ZZ)
+85 SET DLNCT=DLNCT+1
End DoDot:2
if EFTLN=""
QUIT
End DoDot:1
if EFTCTR=""
QUIT
if $PIECE(INPUT,"^",5)=1
QUIT
+86 QUIT
+87 ;
NEWDHDR(INPUT,DTADD) ; display a new deposit header for the specified date
+1 ; Input: INPUT - See RPT2 for details
+2 ; DTADD - Internal Date deposit are being displayed for
+3 NEW XX
+4 DO HDR^RCDPEDA3(.INPUT)
+5 ; user quit or timed out
if $PIECE(INPUT,"^",5)=1
QUIT
+6 SET XX="DATE EFT DEPOSIT RECEIVED: "_$$FMTE^XLFDT(DTADD,"2Z")
+7 ; Center it
SET XX=$JUSTIFY("",80-$LENGTH(XX)\2)_XX
+8 DO SL^RCDPEDA3(.INPUT,XX)
+9 DO SL^RCDPEDA3(.INPUT," ")
+10 QUIT
+11 ;
DETLN(INPUT,IEN3443,TOTDEP) ; Display detail line
+1 ; Input: INPUT - See RPT2 for details
+2 ; IEN3443 - Internal IEN for file 344.3
+3 ; TOTDEP - Total Deposit Amount (344.3, .08)
+4 ; ^TMP($J,"TOTALS","FMS") - FMS Document # or "NO FMS DOC"
+5 ; Output: INPUT - A1^A2^A3^...^An - The following pieces may be updated
+6 ; A5 - Updated Page Number
+7 ; A6 - Stop Flag
+8 ; A8 - Updated Line Counter
+9 ;
+10 NEW DEPDT,DEPNUM,DETL,DTADD,LSTMAN,MULT,NJ,RCDBAL,X,XX,YY
+11 SET LSTMAN=$PIECE(INPUT,"^",2)
SET NJ=$PIECE(INPUT,"^",1)
+12 SET DETL=$PIECE(INPUT,"^",3)
+13 ;PRCA*4.5*380 - Check for multiple mail messages on this deposit
+14 if $ORDER(^RCY(344.3,IEN3443,3,0))'=""
SET MULT="*"
+15 ;PRCA*4.5*380 - Check if prior deposits exist
+16 SET DEPNUM=$$GET1^DIQ(344.3,IEN3443,.06,"I")
SET DEPDT=$$GET1^DIQ(344.3,IEN3443,.07,"I")
+17 SET XX=$ORDER(^RCY(344.3,"ADEP2",DEPNUM,DEPDT,0))
SET XX=$ORDER(^RCY(344.3,"ADEP2",DEPNUM,DEPDT,XX))
+18 if XX'=""
SET MULT=$GET(MULT)_"+"
+19 ; Deposit Number
SET XX=DEPNUM
+20 ;
+21 SET X=$$SETSTR^VALM1(XX,"",1,9)
+22 ;
+23 ; Deposit Date
SET YY=DEPDT
+24 ;PRCA*4.5*380 - Include multi-mail message indicator with date
+25 SET X=$$SETSTR^VALM1($$FMTE^XLFDT(YY\1,"2Z")_$GET(MULT),X,12,10)
+26 ;
+27 ; Is deposit in balance with EFT totals, PRCA*4.5*439
+28 SET RCDBAL=$$DEPBAL^RCDPEDA4(IEN3443)
SET RCDBAL=$SELECT(RCDBAL:"",1:"**UNBALANCED**")
+29 ;
+30 ;S X=$$SETSTR^VALM1("",X,23,8)
+31 ;S X=$$SETSTR^VALM1("",X,32,10)
+32 ; PRCA*4.5*439
SET X=$$SETSTR^VALM1(RCDBAL,X,23,14)
+33 ; PRCA*4.5*439
SET X=$$SETSTR^VALM1("",X,38,4)
+34 SET XX=^TMP($JOB,"TOTALS","FMS")
+35 SET X=$$SETSTR^VALM1($EXTRACT($JUSTIFY(TOTDEP,"",2)_$JUSTIFY("",20),1,20)_XX,X,43,37)
+36 ; PRCA*4.5*321
SET ^TMP($JOB,"ONEDEP",0,1)=X
+37 QUIT
+38 ;
PROCEFT(INPUT,IEN3443) ; Process EFT records
+1 ; Input: INPUT - See RPT2 for details
+2 ; IEN3443 - Internal IEN for file 344.3
+3 ; ^TMP($J,"ONEDEP",0,1) - Deposit Detail line
+4 ; ^TMP($J,"TOTALS","DEBIT","D") - Current Total # of Debit EFTs for date
+5 ; ^TMP($J,"TOTALS","DEBITA","D") - Current Total Amount of Debit EFTs for date
+6 ; ^TMP($J,"TOTALS","EFT","D") - Current Total Deposit Amount by EFTs for date
+7 ; ^TMP($J,"TOTALS","MATCH","D") - Current Total matched EFTs for date
+8 ; ^TMP($J,"TOTALS","FMSTOT") - Current Total Deposit Amount for date range
+9 ; Output: INPUT - A1^A2^A3^...^An - The following pieces
+10 ; may be updated
+11 ; A5 - Updated Page Number
+12 ; A6 - Stop Flag
+13 ; A8 - Updated Line Counter
+14 ; ^TMP($J,"ONEDEP",0,1) - Deposit Detail line
+15 ; ^TMP($J,"ONEDEP","EFTCTR") - # of lines for This EFT
+16 ; ^TMP($J,"ONEDEP","EFTCTR",xx)=LINE - EFT Lines
+17 ; ^TMP($J,"TOTALS","DEBIT","D") - Updated Total # of Debit EFTs for date
+18 ; ^TMP($J,"TOTALS","DEBITA","D") - Updated Total Amount of Debit EFTs for date
+19 ; ^TMP($J,"TOTALS","DEBIT") - Updated Total # of Debit EFTs for date range
+20 ; ^TMP($J,"TOTALS","DEBITA") - Updated Total Amount of Debit EFTs for date range
+21 ; ^TMP($J,"TOTALS","FMSTOT") - Updated Total Deposit Amount for date range
+22 ; ^TMP($J,"TOTALS","EFT","D") - Updated Total Deposit Amount by EFTs for date
+23 ; ^TMP($J,"TOTALS","MATCH","D") - Updated Total matched EFTs for date
+24 ; PRCA*4.5*321 Added DFLG
NEW DETL,DFLG,DTADD,EFTCTR,IEN34431,PAMT,RCFMS1,TRDOC,X,XX,YY
+25 ; PRCA*4.5*321 capture display and line cnt to ^TMP($J,"ONEDEP")
+26 SET ^TMP($JOB,"TOTALS","FMSTOT")=0
SET EFTCTR=0
+27 SET DTADD=$PIECE(INPUT,"^",9)
+28 SET RCFMS1="NO FMS DOC"
+29 SET DETL=$PIECE(INPUT,"^",3)
+30 SET IEN34431=""
+31 FOR
Begin DoDot:1
+32 SET IEN34431=$ORDER(^TMP("RCDAILYACT",$JOB,DTADD,IEN3443,"EFT",IEN34431))
+33 if IEN34431=""
QUIT
+34 SET XX=$GET(^TMP($JOB,"TOTALS","EFT","D"))+1
+35 ; Total # EFTs for date
SET ^TMP($JOB,"TOTALS","EFT","D")=XX
+36 ;
+37 ; Debit/Credit flag ; PRCA*4.5*321 added line
SET YY=$$GET1^DIQ(344.31,IEN34431,3,"E")
+38 ; PRCA*4.5*321 added line
SET DFLG=$SELECT(YY="D":1,1:0)
+39 ; Amount of Payment
SET PAMT=$$GET1^DIQ(344.31,IEN34431,.07,"I")
+40 ; PRCA*4.5*321 added if Statement
IF DFLG
Begin DoDot:2
+41 SET XX=$GET(^TMP($JOB,"TOTALS","DEBIT","D"))+1
+42 ; Total # Debit EFTs for date
SET ^TMP($JOB,"TOTALS","DEBIT","D")=XX
+43 ; Total Debit Amounts for date
SET XX=$GET(^TMP($JOB,"TOTALS","DEBITA","D"))
+44 SET ^TMP($JOB,"TOTALS","DEBITA","D")=XX+PAMT
End DoDot:2
+45 ;
+46 ; Receipt # from 344.31
SET XX=+$$GET1^DIQ(344.31,IEN34431,.09,"I")
+47 ; FMS Document #
SET TRDOC=$$GET1^DIQ(344,XX,200,"I")
+48 ; Default ON-LINE ENTRY status to accepted - PRCA*4.5*326
IF $$GET1^DIQ(344,XX,201,"I")
SET X="ACCEPTED"
+49 ; PRCA*4.5*326
IF '$TEST
SET X=$SELECT(TRDOC'="":$$STATUS^GECSSGET(TRDOC),1:"")
+50 IF X'=""
IF X'=-1
IF $EXTRACT(X,1)'="R"
IF $EXTRACT(X,1)'="E"
Begin DoDot:2
+51 SET XX=$GET(^TMP($JOB,"TOTALS","FMSTOT"))
+52 ; Total Amount of Payment
SET ^TMP($JOB,"TOTALS","FMSTOT")=XX+PAMT
+53 SET RCFMS1=$SELECT($EXTRACT(X,1)="Q":"QUEUED TO POST",1:"POSTED")
End DoDot:2
+54 SET XX=$SELECT(X="":"",X=-1:"NO FMS DOC",1:$EXTRACT($PIECE(X," ",1),1,10))
+55 ; FMS Document Status for EFT
SET RCFMS1(IEN34431)=XX
+56 ; Match Status
SET XX=$$GET1^DIQ(344.31,IEN34431,.08,"I")
+57 IF XX
Begin DoDot:2
+58 SET XX=$GET(^TMP($JOB,"TOTALS","MATCH","D"))
+59 ; Total Matched EFTS by date
SET ^TMP($JOB,"TOTALS","MATCH","D")=XX+1
End DoDot:2
+60 ;PRCA*4.5*321
IF DETL
Begin DoDot:2
+61 SET EFTCTR=EFTCTR+1
+62 DO EFTDTL(.INPUT,IEN3443,IEN34431,.RCFMS1,EFTCTR)
+63 SET YY=$GET(^TMP($JOB,"ONEDEP",EFTCTR))+1
+64 SET ^TMP($JOB,"ONEDEP",EFTCTR)=YY
+65 SET ^TMP($JOB,"ONEDEP",EFTCTR,YY)=" "
End DoDot:2
End DoDot:1
if IEN34431=""
QUIT
if $PIECE(INPUT,"^",5)=1
QUIT
+66 QUIT
+67 ;
EFTDTL(INPUT,IEN3443,IEN34431,RCFMS1,EFTCTR) ; Display EFT Detail
+1 ; Input: INPUT - See RPT2 for details
+2 ; IEN3443 - Internal IEN for file 344.3
+3 ; IEN34431 - Internal IEN for file 344.31
+4 ; RCFMS1(IEN34431) - FMS Document Status for EFT IEN
+5 ; EFTCTR - Used to store lines for an EFT
+6 ; ^TMP($J,ONEDEP,0,1) - Deposit Detail line
+7 ; Output: INPUT - See RPT2 for details
+8 ; ^TMP($J,ONEDEP,0,1) - Deposit Detail line
+9 ; ^TMP($J,ONEDEP,EFTCTR) - # of lines for EFT
+10 ; ^TMP($J,ONEDEP,EFTCTR,xx)- EFT Deposit Lines ;PRCA*4.5*321 capture display to ^TMP($J,"ONEDEP",EFTRCR) including line cnt
+11 ; RCDEBIT, PRCA*4.5*432
NEW EFTLN,MDT,PAY,PAYER,PAYID,RCDEBIT,X,XX,YY,ZZ
+12 ; EFT Transaction detail - PRCA*4.5*326
SET XX=$$GET1^DIQ(344.31,IEN34431,.01,"E")
+13 SET X=$$SETSTR^VALM1(XX,"",3,9)
+14 ; Date Claims Paid
SET XX=$$GET1^DIQ(344.31,IEN34431,.12,"I")
+15 ; PRCA*4.5*326 - move 8 back for MATCH DATE
SET X=$$SETSTR^VALM1($$FMTE^XLFDT(XX\1,"2Z"),X,23,8)
+16 ; Amount of Payment
SET XX=$$GET1^DIQ(344.31,IEN34431,.07,"I")
+17 ; PRCA 4.5*432
SET RCDEBIT=$$GET1^DIQ(344.31,IEN34431,3,"E")
+18 ; PRCA 4.5*432
IF '($EXTRACT(XX)="-")
SET XX=$SELECT(RCDEBIT="D":"-",1:"")_XX
+19 ; PRCA*4.5*326 - move 8 back for MATCH DATE
SET X=$$SETSTR^VALM1($JUSTIFY(XX,"",2),X,33,18)
+20 ;
+21 ; PRCA*4.5*284, Move to left 3 space (61 to 58) to allow for 10 digit ERA #'s
+22 ; Match Status
SET XX=$$GET1^DIQ(344.31,IEN34431,.08,"I")
+23 ; ERA IEN
SET YY=$$GET1^DIQ(344.31,IEN34431,.1,"I")
+24 SET MDT=""
+25 ; PRCA*4.5*326 - Date matched to ERA
IF XX=1
SET MDT=$$MATCHDT^RCDPEWL7(IEN34431)
+26 ; PRCA*4.5*326 - next line, move 8 back and add MATCH DATE
+27 SET X=$$SETSTR^VALM1($$EXTERNAL^DILFD(344.31,.08,"",+XX)_$SELECT(XX=1:"/ERA #"_YY,1:"")_" "_MDT,X,49,30)
+28 SET ^TMP($JOB,"ONEDEP",EFTCTR,1)=X
+29 ;
+30 ; Trace Number
SET XX=$$GET1^DIQ(344.31,IEN34431,.04,"I")
+31 SET X=$$SETSTR^VALM1(XX,"",5,$LENGTH(XX))
+32 SET XX=$GET(^TMP($JOB,"TOTALS","CRDOC",IEN3443))
+33 ; CR Doc
SET X=$$SETSTR^VALM1(XX,X,59,$LENGTH(XX))
+34 SET ^TMP($JOB,"ONEDEP",EFTCTR,2)=X
+35 ;
+36 ; Payer Name
SET PAYER=$$GET1^DIQ(344.31,IEN34431,.02,"I")
+37 if PAYER=""
SET PAYER="NO PAYER NAME RECEIVED"
+38 ; Payer ID
SET PAYID=$$GET1^DIQ(344.31,IEN34431,.03,"I")
+39 SET PAY=PAYER_"/"_PAYID
+40 IF $LENGTH(PAY)>74
Begin DoDot:1
+41 SET ZZ=$LENGTH(PAY,"/")
SET XX=$PIECE(PAY,"/",1,ZZ-1)
SET YY=$PIECE(PAY,"/",ZZ)
+42 SET XX=$EXTRACT(XX,1,$LENGTH(XX)-($LENGTH(PAY)-74))
SET PAY=XX_"/"_YY
End DoDot:1
+43 SET X=$$SETSTR^VALM1(PAY,"",7,74)
+44 SET ^TMP($JOB,"ONEDEP",EFTCTR,3)=X
+45 SET ^TMP($JOB,"ONEDEP",EFTCTR)=3
+46 ;
+47 ; PRCA*4.5*318 add TR #s to detail rpt
+48 ; Gather & display all TR Doc #s for EFT detail record
+49 ; PRCA*4.5*321 moved for routine size
DO GETTR^RCDPEDA4(IEN34431,.INPUT)
+50 SET X=""
+51 ; Receipt IEN
SET XX=$$GET1^DIQ(344.31,IEN34431,.09,"I")
+52 IF XX'=""
Begin DoDot:1
+53 ; Receipt Number
SET YY=$$GET1^DIQ(344,XX,.01,"I")
+54 ; PRCA*4.5*321 changed 46 to 45
SET X=$$SETSTR^VALM1(YY,X,45,12)
End DoDot:1
+55 SET X=$$SETSTR^VALM1($GET(RCFMS1(IEN34431)),X,61,19)
+56 SET EFTLN=$GET(^TMP($JOB,"ONEDEP",EFTCTR))+1
+57 SET ^TMP($JOB,"ONEDEP",EFTCTR)=EFTLN
+58 SET ^TMP($JOB,"ONEDEP",EFTCTR,EFTLN)=X
+59 ; Display any EFT Errors
DO EFTERRS^RCDPEDA4(.INPUT,IEN34431,EFTCTR)
+60 ; Display any Duplicate Errors
DO DUP^RCDPEDA4(.INPUT,IEN34431,EFTCTR)
+61 QUIT
+62 ;
