RCDPEDA4 ;AITC/DW - ACTIVITY REPORT ;Feb 17, 2017@10:37:00
;;4.5;Accounts Receivable;**318,321,326,432,439**;Mar 20, 1995;Build 29
;Per VA Directive 6402, this routine should not be modified.
; Continuation of RCDPEDAR - Daily activity Report
Q
;
ERRMSGS(INPUT,IEN3443) ;EP from RCDPEDA2
; Display any EFT error messages
; Input: INPUT - See EFTERRS for details
; IEN3443 - Internal IEN for file 344.3
; ^TMP($J,"DEPERRS") - Current Line Count
; Note: Only passed if not in detail mode
; ^TMP($J,"DEPERRS,X) - Error line(s)
; Output: ^TMP($J,"DEPERRS") - Current Line Count
; Note: Only passed if not in detail mode
;
; PRCA*4.5*321 capture display and line cnt to ^TMP($J,"DEPERRS")
N DETL,ERRS,LNCT,XX,ZZ
S DETL=$P(INPUT,"^",3)
S XX=$$GET1^DIQ(344.3,IEN3443,2,"I","ERRS") ; Error Message WP field
Q:'$D(ERRS) ; No errors
S XX=$J("",3)_"ERROR MESSAGES FOR EFT:"
S LNCT=$G(^TMP($J,"DEPERRS"))+1
S ^TMP($J,"DEPERRS")=LNCT
S ^TMP($J,"DEPERRS",LNCT)=XX
S XX=""
F D Q:XX=""
. S XX=$O(ERRS(XX))
. Q:XX=""
. S ZZ=$J("",5)_ERRS(XX)
. S LNCT=$G(^TMP($J,"DEPERRS"))+1
. S ^TMP($J,"DEPERRS")=LNCT
. S ^TMP($J,"DEPERRS",LNCT)=ZZ
Q
;
EFTERRS(INPUT,IEN34431,EFTCTR) ;EP from RCDPEDA2
; Output any EFT Detail errors
; Input: INPUT - A1^A2^A3^...^An Where:
; A1 - 1 if called from Nightly Process, 0 otherwise
; A2 - 1 if displaying to Listman, 0 otherwise
; A3 - 1 if Detail report, 0 if summary report
; A4 - Current Page Number
; A5 - Stop Flag
; A6 - Start of Date Range
; A7 - End of Date Range
; A8 - Current Line Counter
; A9 - Internal Date being processed
; A10- 1 - Only Display EFTs with a debit flag of 'D'
; 0 - Display all EFTs
; IEN34431 - Internal IEN for file 344.31
; EFTCTR - Used to store lines for EFT
; ^TMP($J,ONEDEP,0,1) - Deposit Detail line
; ^TMP($J,ONEDEP,EFTCTR) - Current # of lines for EFT
; ^TMP($J,ONEDEP,EFTCTR,xx)- EFT Deposit Lines
; Output ^TMP($J,ONEDEP,EFTCTR) - Updated # of lines for EFT
; ^TMP($J,ONEDEP,EFTCTR,xx)- Updated EFT Deposit Lines
Q:'$O(^RCY(344.31,IEN34431,2,0)) ; No error message
N EFTLN,ERRS,V,XX,YY
S XX=$J("",3)_"ERROR MESSAGES FOR EFT DETAIL:"
S EFTLN=$G(^TMP($J,"ONEDEP",EFTCTR))+1
S ^TMP($J,"ONEDEP",EFTCTR)=EFTLN
S ^TMP($J,"ONEDEP",EFTCTR,EFTLN)=XX
S XX=$$GET1^DIQ(344.31,IEN34431,2,"I","ERRS")
S V=""
F D Q:V=""
. S V=$O(ERRS(V))
. Q:V=""
. S XX=$J("",5)_ERRS(V)
. S EFTLN=EFTLN+1
. S ^TMP($J,"ONEDEP",EFTCTR)=EFTLN
. S ^TMP($J,"ONEDEP",EFTCTR,EFTLN)=XX
Q
;
LMHDR(RCSTOP,RCDET,RCNJ,RCDT1,RCDT2,RCHDR,DONLY) ;EP from RCDPEDAR
; ListMan report heading
; Input: RCDET - 1 to display detail, 0 otherwise
; RCNJ - Set 1, indicates report was called from the nightly
; process OR displaying to listman. Used to set lines
; into a ^TMP array instead of displaying them.
; RCDT1 - Internal Start Date of date range
; RCDT2 - Internal End Date of date range
; DONLY - 1 - Only EFTs with debits, 0 - display all EFTs
; RCNP - Payer Selection flag A1^A2^A3 Where:
; A1 - 1 - Range,2 - All,3 -Specific
; A2 - From Payer text (only set if A1=1)
; A3 - Through text (only set if A1=1)
; ^TMP("RCSELPAY",$J,B1) - Selected payers to be displayed
; Output: RCHDR - Array of listman header lines
; RCSTOP - 1 if user stopped
;
N RCCT,X,XX,Y,Z,Z0,Z1
S RCCT=0
S XX=$S(RCDET:"DETAIL",1:"SUMMARY")_" REPORT"
S RCHDR("TITLE")="EDI LOCKBOX EFT DAILY ACTIVITY "_XX
S Z1=""
I 'VAUTD D
. S Z0=0
. F D Q:'Z0
. . S Z0=$O(VAUTD(Z0))
. . Q:'Z0
. . S XX=$$GET1^DIQ(40.8,Z0,1,"I") ; Facility Number ;PRCA*4.5*321
. . ;S Z1=Z1_VAUTD(Z0)_", "
. . S Z1=Z1_XX_", "
S Z="DIVISIONS: "_$S(VAUTD:"ALL",1:$E(Z1,1,$L(Z1)-2))
; PRCA*4.5*439 Add Deposit Balance/Unbalance/All filter to header
S Z1=$L(Z),Z1=59-Z1,Z0="",$P(Z0," ",Z1)="" ;Add spaces
S Z=Z_Z0_"DEPOSITS: "
S Z=Z_$S(RCUNBAL="U":"UNBALANCED ",RCUNBAL="B":"BALANCED ",1:"ALL ")
S Z=$J("",80-$L(Z)\2)_Z
I 'RCDET D
. S RCCT=RCCT+1,RCHDR(RCCT)=""
S RCCT=RCCT+1,RCHDR(RCCT)=Z
;
I 'RCDET D
. S RCCT=RCCT+1,RCHDR(RCCT)=""
S Z="DATE RANGE: "_$$FMTE^XLFDT(RCDT1,"2Z")_" - "
S Z=Z_$$FMTE^XLFDT(RCDT2,"2Z")_" (DATE DEPOSIT ADDED)"
S Z=Z_" DEBIT ONLY EFTs: "_$S(DONLY=1:"YES",1:"NO") ; PRCA*4.5*321 Added line
I 'RCDET D
. S RCCT=RCCT+1,RCHDR(RCCT)=""
S RCCT=RCCT+1,RCHDR(RCCT)=Z
I RCDET D
. S XX="DEP # DEPOSIT DT "_$J("",19)
. S XX=XX_"DEP AMOUNT FMS DEPOSIT STAT"
. S Z=$$SETSTR^VALM1(XX,"",1,80)
. S RCCT=RCCT+1,RCHDR(RCCT)=Z
. ; PRCA*4.5*318, Move entire EFT # row to left 1 space to adjust for other rows needing space
. ; PRCA*4.5*326 - make room and add match date
. S XX=$J("",2)_"EFT #"_$J("",15)_"DATE PD PAYMENT AMOUNT ERA MATCH STATUS & DATE"
. S Z=$$SETSTR^VALM1(XX,"",1,80)
. S RCCT=RCCT+1,RCHDR(RCCT)=Z
. ; PRCA*4.5*318, Move entire EFT Payer Trace # row to left 6 spaces to adjust for other rows needing space
. S Z=$$SETSTR^VALM1($J("",4)_"EFT PAYER TRACE #","",1,30)
. ;PRCA*4.5*318 add CR #
. S Z=$$SETSTR^VALM1("CR #",Z,59,80)
. S RCCT=RCCT+1,RCHDR(RCCT)=Z
. ; PRCA*4.5*318, Move entire Payment From row to left 8 spaces to adjust
. ; a possible 60 character Payer Name and 20 character Payer ID
. S Z=$$SETSTR^VALM1($J("",6)_"PAYMENT FROM","",1,30)
. S Z=$$SETSTR^VALM1("DEP RECEIPT #",Z,45,30) ; PRCA*4.5*321 used to be 31,30
. S Z=$$SETSTR^VALM1("DEP RECEIPT STATUS",Z,61,19)
. S RCCT=RCCT+1,RCHDR(RCCT)=Z
. ;PRCA*4.5*318 add TR #s
. S Z=$$SETSTR^VALM1("TR #","",4,30)
. S RCCT=RCCT+1,RCHDR(RCCT)=Z
Q
;
GETTR(IEN34431,INPUT) ;EP from RCDPEDA2
; Gathers and Displays all TR Doc #s for a specified EFT detail record
; PRCA*4.5*318 add TR #s to detail rpt
; Input: IEN34431 - Internal IEN for file #344.31
; INPUT - See EFTERRS for details
; EFTCTR - Used to store lines for EFT
; ^TMP($J,ONEDEP,0,1) - Deposit Detail line
; ^TMP($J,ONEDEP,EFTCTR) - Current # of lines for EFT
; ^TMP($J,ONEDEP,EFTCTR,xx)- EFT Deposit Lines
; Output ^TMP($J,ONEDEP,0,1) - Updated Detail line
; ^TMP($J,ONEDEP,EFTCTR) - Updated # 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 CTR,EFTLN,IEN3444,IENS,LNCT,RECEIPT,TRDOC,TRDOCS,XX,ZZ
;
; First gather up all the TR Document numbers into as many lines as needed
S CTR=1,LNCT=$G(^TMP($J,"ONEDEP"))
S EFTLN=$G(^TMP($J,"ONEDEP",EFTCTR))
S IEN3444=$$GET1^DIQ(344.31,IEN34431,.1,"I") ; Internal IEN for for 344.4
S RECEIPT=$$GET1^DIQ(344.4,IEN3444,.08,"I") ; Receipt # from 344.4
I RECEIPT'="" D
. S TRDOC=$TR($$GET1^DIQ(344,RECEIPT,200,"I")," ") ; FMS Document #
. I TRDOC="" Q
. S TRDOCS(CTR)=TRDOC
. S XX=""
. F D Q:XX=""
. . S XX=$O(^RCY(344.4,IEN3444,8,XX))
. . Q:XX=""
. . S IENS=XX_","_IEN3444_","
. . S RECEIPT=$$GET1^DIQ(344.48,IENS,.01,"I") ; Other receipt numbers
. . I RECEIPT="" Q
. . S TRDOC=$TR($$GET1^DIQ(344,RECEIPT,200,"I")," ") ; FMS Document #
. . Q:TRDOC=""
. . I $L(TRDOC)+$L($G(TRDOCS(CTR)))+1>73 D Q
. . . S CTR=CTR+1,TRDOCS(CTR)=TRDOC
. . S TRDOCS(CTR)=TRDOCS(CTR)_", "_TRDOC
;
; Now display the TR Document numbers
I '$D(TRDOCS) D Q ; blank line for TR#s
. S EFTLN=EFTLN+1
. S ^TMP($J,"ONEDEP",EFTCTR)=EFTLN
. S ^TMP($J,"ONEDEP",EFTCTR,EFTLN)=" "
S XX=""
F D Q:XX=""
. S XX=$O(TRDOCS(XX))
. Q:XX=""
. S EFTLN=EFTLN+1
. S ^TMP($J,"ONEDEP",EFTCTR)=EFTLN
. S ^TMP($J,"ONEDEP",EFTCTR,EFTLN)=$J("",3)_TRDOCS(XX)
Q
;
DEPBAL(RCDIEN) ;Is the deposit total in balance with EFT amounts ; New subroutine PRCA*4.5*439
; If modified, also check DEPBAL^RCDPTAR2
; Input: RCDIEN - IEN for EDI LOCKBOX DEPOSIT, #344.3
;
; Output: RCBALS, returned via function call
; Piece 1 - 1 if in balance, 0 if out of balance
; Piece 2 - Total of EFTs on the deposit
; Piece 3 - Deposit Total
;
N DTOT,DEPDATA,EFTDATA,EFTIEN,EFTTOT,RCBALS,XX
S RCBALS="0^0^0"
;
Q:'$G(RCDIEN) RCBALS ; Error condition, IEN is missing or incorrect
;
S DEPDATA=$G(^RCY(344.3,RCDIEN,0)) Q:'$L($G(DEPDATA)) RCBALS ; Quit if zero node does not exist or has bad data
S DTOT=$P(DEPDATA,U,8) ; Get total deposit amount
;
; Find all EFTs on the deposit and total the EFT amounts, EDI THRID PARTY EFT, #344.31
S EFTIEN="",EFTTOT=0
F S EFTIEN=$O(^RCY(344.31,"B",RCDIEN,EFTIEN)) Q:'EFTIEN D
. S EFTDATA=$G(^RCY(344.31,EFTIEN,0)) Q:'$L($G(EFTDATA)) ; Quit if zero node does not exist or has bad data
. S XX=$S($P(EFTDATA,U,16)="D":"-",1:"")_$P(EFTDATA,"^",7) ; Get the amount and make amount negative if debit indicator
. S EFTTOT=EFTTOT+XX ; Accumulate EFT Total
;
S $P(RCBALS,U,2)=EFTTOT,$P(RCBALS,U,3)=DTOT
S $P(RCBALS,U,1)=(+EFTTOT=+DTOT) ; Equal to 1 if EFTTOT=DTOT, 0 otherwise
;
Q RCBALS
;
UNBALONLY() ; Allows the user to select filter to only show Balanced, Unbalanced or All deposits
; PRCA*4.5*439 Added subroutine
; Input: None
; Returns: A - All, B - Balanced, U - Unbalanced, (-1) - User '^' or timeout
;
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,RTNFLG,Y
;
S RTNFLG=0
;
; Select option required (All, Balanced or Unbalanced)
S DIR(0)="SA^B:Balanced;U:Unbalanced;A:All"
S DIR("A")="(B)alanced deposits, (U)nbalanced deposits or (A)LL?: " ; PRCA*4.5*332
S DIR("?",2)="Enter 'A' to select all deposits, both balanced and unbalanced."
S DIR("B")="All"
S DIR("?",1)="Enter 'U' to select only unbalanced deposits."
S DIR("?")="Enter 'B' to select only balanced deposits."
D ^DIR K DIR
;
; Abort on ^ exit or timeout
I $D(DTOUT)!$D(DUOUT) S RTNFLG=-1 Q RTNFLG
;
I Y="" S Y="A"
;
Q Y
;
RTYPE() ; Allows the user to select the report type (Summary/Detail)
; Input: None
; Returns: 0 - Summary Display
; 1 - Detail Display
; -1 - User up-arrowed or timed out
N DIR,DIROUT,DIRUT,DTOUT,DUOUT
S DIR("A")="(S)UMMARY OR (D)ETAIL?: "
S DIR(0)="SA^S:SUMMARY TOTALS ONLY;D:DETAIL AND TOTALS"
S DIR("B")="D"
D ^DIR
I $D(DTOUT)!$D(DUOUT)!(Y="") Q -1
Q Y="D"
;
DTRANGE(STDATE,ENDDATE) ; Allows the user to select the date range to by used
; Input: None
; Output: STDATE = Internal Fileman Date to start at
; ENDDATE - Internal Fileman Date to end at
; Returns: 0 - User up-arrowed or timed out, 1 otherwise
N DIR,DIROUT,DIRUT,DTOUT,DUOUT
S DIR("?")="Enter the earliest date of receipt of deposit to include on the report."
S DIR(0)="DAO^:"_DT_":APE"
S DIR("A")="START DATE: "
D ^DIR
Q:$D(DTOUT)!$D(DUOUT)!(Y="") 0
S STDATE=Y
K DIR
S DIR("?")="Enter the latest date of receipt of deposit to include on the report."
S DIR("B")=Y(0)
S DIR(0)="DAO^"_RCDT1_":"_DT_":APE",DIR("A")="END DATE: "
D ^DIR
Q:$D(DTOUT)!$D(DUOUT)!(Y="") 0
S ENDDATE=Y
Q 1
;
DBTONLY() ; Allows the user to select filter to only show EFTs with debits
; PRCA*4.5*321 Added subroutine
; Input: None
; Returns: 0 - All EFTs to display
; 1 - Only EFTs with debits to be displayed
; -1 - User up-arrowed or timed out
N DIR,DIROUT,DIRUT,DTOUT,DUOUT
S DIR("A")="Show EFTs with debits only? "
S DIR(0)="SA^Y:YES;N:NO"
S DIR("B")="NO"
S DIR("?",1)="Enter 'YES' to only show EFTs with a debit flag of 'D'."
S DIR("?")="Enter 'NO' to show all EFTs."
D ^DIR
I $D(DTOUT)!$D(DUOUT)!(Y="") Q -1
Q $E(Y,1)="Y"
;
DUP(INPUT,IEN34431,EFTCTR) ; Check to see if the EFT was a duplicate
; Input: IEN34431 - Internal IEN for file 344.31
; INPUT - See RPT2 for details
; EFTCTR - Used to store lines for EFT
; ^TMP($J,ONEDEP,EFTCTE) - Current # of lines for EFT
; ^TMP($J,ONEDEP,EFTCTR,xx)- Current Deposit Lines
; Output: ^TMP($J,ONEDEP,EFTCTR) - Updated # of lines for EFT
; ^TMP($J,ONEDEP,EFTCTR,xx)- Updated EFT Lines
;
;PRCA*4.5*321 capture display to ^TMP($J,"ONEDEP",EFTRCR) including line cnt
N EFTLN,X,XX,YY
Q:'$D(^RCY(344.31,IEN34431,3)) ; Not a duplicate
S XX=$$GET1^DIQ(344.31,IEN34431,.18,"I") ; Date/Time Removed
S YY=$$GET1^DIQ(344.31,IEN34431,.17,"I") ; User who removed it
S X=" MARKED AS DUPLICATE: "_$$FMTE^XLFDT(XX)_" "_$$EXTERNAL^DILFD(344.31,.17,,YY)
S EFTLN=$G(^TMP($J,"ONEDEP",EFTCTR))+1
S ^TMP($J,"ONEDEP",EFTCTR)=EFTLN
S ^TMP($J,"ONEDEP",EFTCTR,EFTLN)=X
S EFTLN=EFTLN+1
S ^TMP($J,"ONEDEP",EFTCTR)=EFTLN
S ^TMP($J,"ONEDEP",EFTCTR,EFTLN)=" "
Q
;
EXCELHDR ;Excel header ; PRCA*4.5*439 Add EXCELHDR tag
;
W !!,"DEP #^UNBALANCED^DEPOSIT DT^DEP AMOUNT^FMS DEPOSIT STAT^"
W "EFT #^DATE PD^PAYMENT AMOUNT^ERA MATCH STATUS^ERA^DATE^EFT PAYER TRACE #^CR #^PAYMENT FROM^PAYER TIN^TR #^DEP RECEIPT #^DEP RECEIPT STATUS"
Q
;
; Moved tag DUP to RCDPEDA4 from RCDPEDA2 PRCA*4.5*439
; Moved tags to RCDPEDA4 from RCDPEDAR: RTYPE, DTRANGE, DBTONLY, EXCELHDR; PRCA*4.5*439
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEDA4 14125 printed Aug 26, 2025@22:00:17 Page 2
RCDPEDA4 ;AITC/DW - ACTIVITY REPORT ;Feb 17, 2017@10:37:00
+1 ;;4.5;Accounts Receivable;**318,321,326,432,439**;Mar 20, 1995;Build 29
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ; Continuation of RCDPEDAR - Daily activity Report
+4 QUIT
+5 ;
ERRMSGS(INPUT,IEN3443) ;EP from RCDPEDA2
+1 ; Display any EFT error messages
+2 ; Input: INPUT - See EFTERRS for details
+3 ; IEN3443 - Internal IEN for file 344.3
+4 ; ^TMP($J,"DEPERRS") - Current Line Count
+5 ; Note: Only passed if not in detail mode
+6 ; ^TMP($J,"DEPERRS,X) - Error line(s)
+7 ; Output: ^TMP($J,"DEPERRS") - Current Line Count
+8 ; Note: Only passed if not in detail mode
+9 ;
+10 ; PRCA*4.5*321 capture display and line cnt to ^TMP($J,"DEPERRS")
+11 NEW DETL,ERRS,LNCT,XX,ZZ
+12 SET DETL=$PIECE(INPUT,"^",3)
+13 ; Error Message WP field
SET XX=$$GET1^DIQ(344.3,IEN3443,2,"I","ERRS")
+14 ; No errors
if '$DATA(ERRS)
QUIT
+15 SET XX=$JUSTIFY("",3)_"ERROR MESSAGES FOR EFT:"
+16 SET LNCT=$GET(^TMP($JOB,"DEPERRS"))+1
+17 SET ^TMP($JOB,"DEPERRS")=LNCT
+18 SET ^TMP($JOB,"DEPERRS",LNCT)=XX
+19 SET XX=""
+20 FOR
Begin DoDot:1
+21 SET XX=$ORDER(ERRS(XX))
+22 if XX=""
QUIT
+23 SET ZZ=$JUSTIFY("",5)_ERRS(XX)
+24 SET LNCT=$GET(^TMP($JOB,"DEPERRS"))+1
+25 SET ^TMP($JOB,"DEPERRS")=LNCT
+26 SET ^TMP($JOB,"DEPERRS",LNCT)=ZZ
End DoDot:1
if XX=""
QUIT
+27 QUIT
+28 ;
EFTERRS(INPUT,IEN34431,EFTCTR) ;EP from RCDPEDA2
+1 ; Output any EFT Detail errors
+2 ; Input: INPUT - A1^A2^A3^...^An Where:
+3 ; A1 - 1 if called from Nightly Process, 0 otherwise
+4 ; A2 - 1 if displaying to Listman, 0 otherwise
+5 ; A3 - 1 if Detail report, 0 if 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 Counter
+11 ; A9 - Internal Date being processed
+12 ; A10- 1 - Only Display EFTs with a debit flag of 'D'
+13 ; 0 - Display all EFTs
+14 ; IEN34431 - Internal IEN for file 344.31
+15 ; EFTCTR - Used to store lines for EFT
+16 ; ^TMP($J,ONEDEP,0,1) - Deposit Detail line
+17 ; ^TMP($J,ONEDEP,EFTCTR) - Current # of lines for EFT
+18 ; ^TMP($J,ONEDEP,EFTCTR,xx)- EFT Deposit Lines
+19 ; Output ^TMP($J,ONEDEP,EFTCTR) - Updated # of lines for EFT
+20 ; ^TMP($J,ONEDEP,EFTCTR,xx)- Updated EFT Deposit Lines
+21 ; No error message
if '$ORDER(^RCY(344.31,IEN34431,2,0))
QUIT
+22 NEW EFTLN,ERRS,V,XX,YY
+23 SET XX=$JUSTIFY("",3)_"ERROR MESSAGES FOR EFT DETAIL:"
+24 SET EFTLN=$GET(^TMP($JOB,"ONEDEP",EFTCTR))+1
+25 SET ^TMP($JOB,"ONEDEP",EFTCTR)=EFTLN
+26 SET ^TMP($JOB,"ONEDEP",EFTCTR,EFTLN)=XX
+27 SET XX=$$GET1^DIQ(344.31,IEN34431,2,"I","ERRS")
+28 SET V=""
+29 FOR
Begin DoDot:1
+30 SET V=$ORDER(ERRS(V))
+31 if V=""
QUIT
+32 SET XX=$JUSTIFY("",5)_ERRS(V)
+33 SET EFTLN=EFTLN+1
+34 SET ^TMP($JOB,"ONEDEP",EFTCTR)=EFTLN
+35 SET ^TMP($JOB,"ONEDEP",EFTCTR,EFTLN)=XX
End DoDot:1
if V=""
QUIT
+36 QUIT
+37 ;
LMHDR(RCSTOP,RCDET,RCNJ,RCDT1,RCDT2,RCHDR,DONLY) ;EP from RCDPEDAR
+1 ; ListMan report heading
+2 ; Input: RCDET - 1 to display detail, 0 otherwise
+3 ; RCNJ - Set 1, indicates report was called from the nightly
+4 ; process OR displaying to listman. Used to set lines
+5 ; into a ^TMP array instead of displaying them.
+6 ; RCDT1 - Internal Start Date of date range
+7 ; RCDT2 - Internal End Date of date range
+8 ; DONLY - 1 - Only EFTs with debits, 0 - display all EFTs
+9 ; RCNP - Payer Selection flag A1^A2^A3 Where:
+10 ; A1 - 1 - Range,2 - All,3 -Specific
+11 ; A2 - From Payer text (only set if A1=1)
+12 ; A3 - Through text (only set if A1=1)
+13 ; ^TMP("RCSELPAY",$J,B1) - Selected payers to be displayed
+14 ; Output: RCHDR - Array of listman header lines
+15 ; RCSTOP - 1 if user stopped
+16 ;
+17 NEW RCCT,X,XX,Y,Z,Z0,Z1
+18 SET RCCT=0
+19 SET XX=$SELECT(RCDET:"DETAIL",1:"SUMMARY")_" REPORT"
+20 SET RCHDR("TITLE")="EDI LOCKBOX EFT DAILY ACTIVITY "_XX
+21 SET Z1=""
+22 IF 'VAUTD
Begin DoDot:1
+23 SET Z0=0
+24 FOR
Begin DoDot:2
+25 SET Z0=$ORDER(VAUTD(Z0))
+26 if 'Z0
QUIT
+27 ; Facility Number ;PRCA*4.5*321
SET XX=$$GET1^DIQ(40.8,Z0,1,"I")
+28 ;S Z1=Z1_VAUTD(Z0)_", "
+29 SET Z1=Z1_XX_", "
End DoDot:2
if 'Z0
QUIT
End DoDot:1
+30 SET Z="DIVISIONS: "_$SELECT(VAUTD:"ALL",1:$EXTRACT(Z1,1,$LENGTH(Z1)-2))
+31 ; PRCA*4.5*439 Add Deposit Balance/Unbalance/All filter to header
+32 ;Add spaces
SET Z1=$LENGTH(Z)
SET Z1=59-Z1
SET Z0=""
SET $PIECE(Z0," ",Z1)=""
+33 SET Z=Z_Z0_"DEPOSITS: "
+34 SET Z=Z_$SELECT(RCUNBAL="U":"UNBALANCED ",RCUNBAL="B":"BALANCED ",1:"ALL ")
+35 SET Z=$JUSTIFY("",80-$LENGTH(Z)\2)_Z
+36 IF 'RCDET
Begin DoDot:1
+37 SET RCCT=RCCT+1
SET RCHDR(RCCT)=""
End DoDot:1
+38 SET RCCT=RCCT+1
SET RCHDR(RCCT)=Z
+39 ;
+40 IF 'RCDET
Begin DoDot:1
+41 SET RCCT=RCCT+1
SET RCHDR(RCCT)=""
End DoDot:1
+42 SET Z="DATE RANGE: "_$$FMTE^XLFDT(RCDT1,"2Z")_" - "
+43 SET Z=Z_$$FMTE^XLFDT(RCDT2,"2Z")_" (DATE DEPOSIT ADDED)"
+44 ; PRCA*4.5*321 Added line
SET Z=Z_" DEBIT ONLY EFTs: "_$SELECT(DONLY=1:"YES",1:"NO")
+45 IF 'RCDET
Begin DoDot:1
+46 SET RCCT=RCCT+1
SET RCHDR(RCCT)=""
End DoDot:1
+47 SET RCCT=RCCT+1
SET RCHDR(RCCT)=Z
+48 IF RCDET
Begin DoDot:1
+49 SET XX="DEP # DEPOSIT DT "_$JUSTIFY("",19)
+50 SET XX=XX_"DEP AMOUNT FMS DEPOSIT STAT"
+51 SET Z=$$SETSTR^VALM1(XX,"",1,80)
+52 SET RCCT=RCCT+1
SET RCHDR(RCCT)=Z
+53 ; PRCA*4.5*318, Move entire EFT # row to left 1 space to adjust for other rows needing space
+54 ; PRCA*4.5*326 - make room and add match date
+55 SET XX=$JUSTIFY("",2)_"EFT #"_$JUSTIFY("",15)_"DATE PD PAYMENT AMOUNT ERA MATCH STATUS & DATE"
+56 SET Z=$$SETSTR^VALM1(XX,"",1,80)
+57 SET RCCT=RCCT+1
SET RCHDR(RCCT)=Z
+58 ; PRCA*4.5*318, Move entire EFT Payer Trace # row to left 6 spaces to adjust for other rows needing space
+59 SET Z=$$SETSTR^VALM1($JUSTIFY("",4)_"EFT PAYER TRACE #","",1,30)
+60 ;PRCA*4.5*318 add CR #
+61 SET Z=$$SETSTR^VALM1("CR #",Z,59,80)
+62 SET RCCT=RCCT+1
SET RCHDR(RCCT)=Z
+63 ; PRCA*4.5*318, Move entire Payment From row to left 8 spaces to adjust
+64 ; a possible 60 character Payer Name and 20 character Payer ID
+65 SET Z=$$SETSTR^VALM1($JUSTIFY("",6)_"PAYMENT FROM","",1,30)
+66 ; PRCA*4.5*321 used to be 31,30
SET Z=$$SETSTR^VALM1("DEP RECEIPT #",Z,45,30)
+67 SET Z=$$SETSTR^VALM1("DEP RECEIPT STATUS",Z,61,19)
+68 SET RCCT=RCCT+1
SET RCHDR(RCCT)=Z
+69 ;PRCA*4.5*318 add TR #s
+70 SET Z=$$SETSTR^VALM1("TR #","",4,30)
+71 SET RCCT=RCCT+1
SET RCHDR(RCCT)=Z
End DoDot:1
+72 QUIT
+73 ;
GETTR(IEN34431,INPUT) ;EP from RCDPEDA2
+1 ; Gathers and Displays all TR Doc #s for a specified EFT detail record
+2 ; PRCA*4.5*318 add TR #s to detail rpt
+3 ; Input: IEN34431 - Internal IEN for file #344.31
+4 ; INPUT - See EFTERRS for details
+5 ; EFTCTR - Used to store lines for EFT
+6 ; ^TMP($J,ONEDEP,0,1) - Deposit Detail line
+7 ; ^TMP($J,ONEDEP,EFTCTR) - Current # of lines for EFT
+8 ; ^TMP($J,ONEDEP,EFTCTR,xx)- EFT Deposit Lines
+9 ; Output ^TMP($J,ONEDEP,0,1) - Updated Detail line
+10 ; ^TMP($J,ONEDEP,EFTCTR) - Updated # of lines for EFT
+11 ; ^TMP($J,ONEDEP,EFTCTR,xx)- EFT Deposit Lines
+12 ;
+13 ; PRCA*4.5*321 capture display to ^TMP($J,"ONEDEP",EFTRCR) including line cnt
+14 NEW CTR,EFTLN,IEN3444,IENS,LNCT,RECEIPT,TRDOC,TRDOCS,XX,ZZ
+15 ;
+16 ; First gather up all the TR Document numbers into as many lines as needed
+17 SET CTR=1
SET LNCT=$GET(^TMP($JOB,"ONEDEP"))
+18 SET EFTLN=$GET(^TMP($JOB,"ONEDEP",EFTCTR))
+19 ; Internal IEN for for 344.4
SET IEN3444=$$GET1^DIQ(344.31,IEN34431,.1,"I")
+20 ; Receipt # from 344.4
SET RECEIPT=$$GET1^DIQ(344.4,IEN3444,.08,"I")
+21 IF RECEIPT'=""
Begin DoDot:1
+22 ; FMS Document #
SET TRDOC=$TRANSLATE($$GET1^DIQ(344,RECEIPT,200,"I")," ")
+23 IF TRDOC=""
QUIT
+24 SET TRDOCS(CTR)=TRDOC
+25 SET XX=""
+26 FOR
Begin DoDot:2
+27 SET XX=$ORDER(^RCY(344.4,IEN3444,8,XX))
+28 if XX=""
QUIT
+29 SET IENS=XX_","_IEN3444_","
+30 ; Other receipt numbers
SET RECEIPT=$$GET1^DIQ(344.48,IENS,.01,"I")
+31 IF RECEIPT=""
QUIT
+32 ; FMS Document #
SET TRDOC=$TRANSLATE($$GET1^DIQ(344,RECEIPT,200,"I")," ")
+33 if TRDOC=""
QUIT
+34 IF $LENGTH(TRDOC)+$LENGTH($GET(TRDOCS(CTR)))+1>73
Begin DoDot:3
+35 SET CTR=CTR+1
SET TRDOCS(CTR)=TRDOC
End DoDot:3
QUIT
+36 SET TRDOCS(CTR)=TRDOCS(CTR)_", "_TRDOC
End DoDot:2
if XX=""
QUIT
End DoDot:1
+37 ;
+38 ; Now display the TR Document numbers
+39 ; blank line for TR#s
IF '$DATA(TRDOCS)
Begin DoDot:1
+40 SET EFTLN=EFTLN+1
+41 SET ^TMP($JOB,"ONEDEP",EFTCTR)=EFTLN
+42 SET ^TMP($JOB,"ONEDEP",EFTCTR,EFTLN)=" "
End DoDot:1
QUIT
+43 SET XX=""
+44 FOR
Begin DoDot:1
+45 SET XX=$ORDER(TRDOCS(XX))
+46 if XX=""
QUIT
+47 SET EFTLN=EFTLN+1
+48 SET ^TMP($JOB,"ONEDEP",EFTCTR)=EFTLN
+49 SET ^TMP($JOB,"ONEDEP",EFTCTR,EFTLN)=$JUSTIFY("",3)_TRDOCS(XX)
End DoDot:1
if XX=""
QUIT
+50 QUIT
+51 ;
DEPBAL(RCDIEN) ;Is the deposit total in balance with EFT amounts ; New subroutine PRCA*4.5*439
+1 ; If modified, also check DEPBAL^RCDPTAR2
+2 ; Input: RCDIEN - IEN for EDI LOCKBOX DEPOSIT, #344.3
+3 ;
+4 ; Output: RCBALS, returned via function call
+5 ; Piece 1 - 1 if in balance, 0 if out of balance
+6 ; Piece 2 - Total of EFTs on the deposit
+7 ; Piece 3 - Deposit Total
+8 ;
+9 NEW DTOT,DEPDATA,EFTDATA,EFTIEN,EFTTOT,RCBALS,XX
+10 SET RCBALS="0^0^0"
+11 ;
+12 ; Error condition, IEN is missing or incorrect
if '$GET(RCDIEN)
QUIT RCBALS
+13 ;
+14 ; Quit if zero node does not exist or has bad data
SET DEPDATA=$GET(^RCY(344.3,RCDIEN,0))
if '$LENGTH($GET(DEPDATA))
QUIT RCBALS
+15 ; Get total deposit amount
SET DTOT=$PIECE(DEPDATA,U,8)
+16 ;
+17 ; Find all EFTs on the deposit and total the EFT amounts, EDI THRID PARTY EFT, #344.31
+18 SET EFTIEN=""
SET EFTTOT=0
+19 FOR
SET EFTIEN=$ORDER(^RCY(344.31,"B",RCDIEN,EFTIEN))
if 'EFTIEN
QUIT
Begin DoDot:1
+20 ; Quit if zero node does not exist or has bad data
SET EFTDATA=$GET(^RCY(344.31,EFTIEN,0))
if '$LENGTH($GET(EFTDATA))
QUIT
+21 ; Get the amount and make amount negative if debit indicator
SET XX=$SELECT($PIECE(EFTDATA,U,16)="D":"-",1:"")_$PIECE(EFTDATA,"^",7)
+22 ; Accumulate EFT Total
SET EFTTOT=EFTTOT+XX
End DoDot:1
+23 ;
+24 SET $PIECE(RCBALS,U,2)=EFTTOT
SET $PIECE(RCBALS,U,3)=DTOT
+25 ; Equal to 1 if EFTTOT=DTOT, 0 otherwise
SET $PIECE(RCBALS,U,1)=(+EFTTOT=+DTOT)
+26 ;
+27 QUIT RCBALS
+28 ;
UNBALONLY() ; Allows the user to select filter to only show Balanced, Unbalanced or All deposits
+1 ; PRCA*4.5*439 Added subroutine
+2 ; Input: None
+3 ; Returns: A - All, B - Balanced, U - Unbalanced, (-1) - User '^' or timeout
+4 ;
+5 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,RTNFLG,Y
+6 ;
+7 SET RTNFLG=0
+8 ;
+9 ; Select option required (All, Balanced or Unbalanced)
+10 SET DIR(0)="SA^B:Balanced;U:Unbalanced;A:All"
+11 ; PRCA*4.5*332
SET DIR("A")="(B)alanced deposits, (U)nbalanced deposits or (A)LL?: "
+12 SET DIR("?",2)="Enter 'A' to select all deposits, both balanced and unbalanced."
+13 SET DIR("B")="All"
+14 SET DIR("?",1)="Enter 'U' to select only unbalanced deposits."
+15 SET DIR("?")="Enter 'B' to select only balanced deposits."
+16 DO ^DIR
KILL DIR
+17 ;
+18 ; Abort on ^ exit or timeout
+19 IF $DATA(DTOUT)!$DATA(DUOUT)
SET RTNFLG=-1
QUIT RTNFLG
+20 ;
+21 IF Y=""
SET Y="A"
+22 ;
+23 QUIT Y
+24 ;
RTYPE() ; Allows the user to select the report type (Summary/Detail)
+1 ; Input: None
+2 ; Returns: 0 - Summary Display
+3 ; 1 - Detail Display
+4 ; -1 - User up-arrowed or timed out
+5 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT
+6 SET DIR("A")="(S)UMMARY OR (D)ETAIL?: "
+7 SET DIR(0)="SA^S:SUMMARY TOTALS ONLY;D:DETAIL AND TOTALS"
+8 SET DIR("B")="D"
+9 DO ^DIR
+10 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
QUIT -1
+11 QUIT Y="D"
+12 ;
DTRANGE(STDATE,ENDDATE) ; Allows the user to select the date range to by used
+1 ; Input: None
+2 ; Output: STDATE = Internal Fileman Date to start at
+3 ; ENDDATE - Internal Fileman Date to end at
+4 ; Returns: 0 - User up-arrowed or timed out, 1 otherwise
+5 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT
+6 SET DIR("?")="Enter the earliest date of receipt of deposit to include on the report."
+7 SET DIR(0)="DAO^:"_DT_":APE"
+8 SET DIR("A")="START DATE: "
+9 DO ^DIR
+10 if $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
QUIT 0
+11 SET STDATE=Y
+12 KILL DIR
+13 SET DIR("?")="Enter the latest date of receipt of deposit to include on the report."
+14 SET DIR("B")=Y(0)
+15 SET DIR(0)="DAO^"_RCDT1_":"_DT_":APE"
SET DIR("A")="END DATE: "
+16 DO ^DIR
+17 if $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
QUIT 0
+18 SET ENDDATE=Y
+19 QUIT 1
+20 ;
DBTONLY() ; Allows the user to select filter to only show EFTs with debits
+1 ; PRCA*4.5*321 Added subroutine
+2 ; Input: None
+3 ; Returns: 0 - All EFTs to display
+4 ; 1 - Only EFTs with debits to be displayed
+5 ; -1 - User up-arrowed or timed out
+6 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT
+7 SET DIR("A")="Show EFTs with debits only? "
+8 SET DIR(0)="SA^Y:YES;N:NO"
+9 SET DIR("B")="NO"
+10 SET DIR("?",1)="Enter 'YES' to only show EFTs with a debit flag of 'D'."
+11 SET DIR("?")="Enter 'NO' to show all EFTs."
+12 DO ^DIR
+13 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
QUIT -1
+14 QUIT $EXTRACT(Y,1)="Y"
+15 ;
DUP(INPUT,IEN34431,EFTCTR) ; Check to see if the EFT was a duplicate
+1 ; Input: IEN34431 - Internal IEN for file 344.31
+2 ; INPUT - See RPT2 for details
+3 ; EFTCTR - Used to store lines for EFT
+4 ; ^TMP($J,ONEDEP,EFTCTE) - Current # of lines for EFT
+5 ; ^TMP($J,ONEDEP,EFTCTR,xx)- Current Deposit Lines
+6 ; Output: ^TMP($J,ONEDEP,EFTCTR) - Updated # of lines for EFT
+7 ; ^TMP($J,ONEDEP,EFTCTR,xx)- Updated EFT Lines
+8 ;
+9 ;PRCA*4.5*321 capture display to ^TMP($J,"ONEDEP",EFTRCR) including line cnt
+10 NEW EFTLN,X,XX,YY
+11 ; Not a duplicate
if '$DATA(^RCY(344.31,IEN34431,3))
QUIT
+12 ; Date/Time Removed
SET XX=$$GET1^DIQ(344.31,IEN34431,.18,"I")
+13 ; User who removed it
SET YY=$$GET1^DIQ(344.31,IEN34431,.17,"I")
+14 SET X=" MARKED AS DUPLICATE: "_$$FMTE^XLFDT(XX)_" "_$$EXTERNAL^DILFD(344.31,.17,,YY)
+15 SET EFTLN=$GET(^TMP($JOB,"ONEDEP",EFTCTR))+1
+16 SET ^TMP($JOB,"ONEDEP",EFTCTR)=EFTLN
+17 SET ^TMP($JOB,"ONEDEP",EFTCTR,EFTLN)=X
+18 SET EFTLN=EFTLN+1
+19 SET ^TMP($JOB,"ONEDEP",EFTCTR)=EFTLN
+20 SET ^TMP($JOB,"ONEDEP",EFTCTR,EFTLN)=" "
+21 QUIT
+22 ;
EXCELHDR ;Excel header ; PRCA*4.5*439 Add EXCELHDR tag
+1 ;
+2 WRITE !!,"DEP #^UNBALANCED^DEPOSIT DT^DEP AMOUNT^FMS DEPOSIT STAT^"
+3 WRITE "EFT #^DATE PD^PAYMENT AMOUNT^ERA MATCH STATUS^ERA^DATE^EFT PAYER TRACE #^CR #^PAYMENT FROM^PAYER TIN^TR #^DEP RECEIPT #^DEP RECEIPT STATUS"
+4 QUIT
+5 ;
+6 ; Moved tag DUP to RCDPEDA4 from RCDPEDA2 PRCA*4.5*439
+7 ; Moved tags to RCDPEDA4 from RCDPEDAR: RTYPE, DTRANGE, DBTONLY, EXCELHDR; PRCA*4.5*439
