RCDPTAR2 ;AITC/CJE - EFT TRANSACTION AUDIT REPORT (Continued) ;08/14/23
;;4.5;Accounts Receivable;**424,439**;Mar 20, 1995;Build 29
;;Per VA Directive 6402, this routine should not be modified.
;
Q
; PRCA*4.5*424 - Moved subroutine RC from ^RCDPTAR and added FMS doc ID search
RC(RCDATA) ; Lookup by Receipt Number
; Input: RCDATA - null on entry
; RCDET - Environmental variable assumed to be set to "R" - Reciept or "F" - FMS Document
; Output: RCDATA - passed by refence - see subroutine EFTDATA for delimited list of fields
;
N D,DIC,DTOUT,DUOUT,EFTIEN,ERAIEN,RCDTN,RCED,RCIEN,STOP,X,Y
S STOP=0
RC2 ;
W !
S DIC="^RCY(344,"
S DIC(0)=$S(RCDET="F":"QEAn",1:"QEAMn")
S DIC("A")=$S(RCDET="F":"Select FMS DOCUMENT NUMBER: ",1:"Select RECEIPT: ")
S DIC("W")="D DICW^RCDPUREC"
S DIC("S")="I $$EDILBEV^RCDPEU($P($G(^(0)),U,4))"
I RCDET="R" D ^DIC
I RCDET="F" S D="ADOC" D IX^DIC
I $D(DTOUT)!$D(DUOUT)!(Y=-1) S RCDATA=-1 Q
;
; Check if there is a pointer to the AR Deposit
S RCDATA=""
S RCIEN=$P($G(^RCY(344,+Y,0)),U,6)
;
; If there is, then get the EFT via AR Deposit and EDI LockBox files
I RCIEN D
. ; Get Ticket Number
. S RCDTN=$P($G(^RCY(344.1,RCIEN,0)),U,1)
. I RCDTN="" Q
. ;
. ; Get EDI Lockbox Deposit File
. S RCED=$O(^RCY(344.3,"C",RCDTN,""))
. I RCED="" Q
. S RCDATA=$$EFT^RCDPTAR(RCED)
;
; If this AR Deposit record is not found, check if it is a receipt on the ERA
I 'RCIEN D
. S ERAIEN=$O(^RCY(344.4,"H",+Y,""))
. I 'ERAIEN S ERAIEN=$O(^RCY(344.4,"ARCT",+Y,""))
. I 'ERAIEN Q
. S EFTIEN=$O(^RCY(344.31,"AERA",ERAIEN,""))
. I EFTIEN S RCDATA=$$EFTDATA^RCDPTAR(EFTIEN)
;
I RCDATA="" D G RC2
. W !!,"EFT NOT FOUND - please check Receipt"
. D PAUSE^RCDPTAR
;
Q:RCDATA=-1
Q:RCDATA="" ; No EFTs found
D SHOWONE^RCDPTAR(.STOP) ; Display output
Q:STOP
G RC2
Q
;
DEPBAL(RCDIEN) ;Is the deposit total in balance with EFT amounts ; New subroutine PRCA*4.5*439
; If modified, also check DEPBAL^RCDPEDA4
; 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
;
;Moved ASKSUM2 from RCDPTAR to RCDPTAR2 because of space, PRCA*4.5*439
ASKSUM2() ; Ask the user if they want to display the summary report by Deposit Date
; or by Deposit Number
; Input: None
; Returns: -1 - User quit or timed out
; 1 - Display Summary report by Deposit Date
; 2 - Display Summary report by Deposit Number
N DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
S DIR(0)="SOA^EFTS:EFTS by Date;DATE:Deposit Number"
S DIR("A")="(E)FTs by Date or (D)eposit? "
S DIR("B")="DEPOSIT"
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q -1
I $E(Y,1)="E" Q 1
Q 2
;
;Moved HEADER from RCDPTAR to RCDPTAR2 because of space, PRCA*4.5*439
; Input: RCNOW - DATE/TIME in external format
; RCPG - Current page number
; RCHR - Line of "-" to margin width
; RCDATA - See subroutine EFTDA about for delimited list of fields
; RCDBAL - Piece 1: 1 if deposit is in balance, 0 otherwise ; Add parameter PRCA*4.5*439
; Piece 2: Total of EFTs on the deposit
; Piece 3: Deposit Total
; Output: Write statements
;
I '$L($G(RCDBAL)) S RCDBAL=1 ; if RCDBAL was not passed, set to 1 to indicate deposit is in balance PRCA*4.5*439
N EFTDATA,LINE
S EFTDATA=$G(^RCY(344.31,+$P(RCDATA,U,3),0))
;
W @IOF
S RCPG=RCPG+1
W "EFT TRANSACTION AUDIT REPORT"
S LINE=RCNOW_" PAGE: "_RCPG_" "
W ?(IOM-$L(LINE)),LINE
; Added EFT line identifier nnn.nn - PRCA*4.5*326
W !,"EFT#: ",$$AGED^RCDPTAR(+$P(RCDATA,U,3)),$$GET1^DIQ(344.31,$P(RCDATA,U,3)_",",.01,"E"),?19,"DEPOSIT#: ",$P($G(^RCY(344.3,+$P(RCDATA,U,2),0)),U,6)
I 'RCDBAL W " *UNBAL*",?51,"EFT TOTAL AMT: "_$S($P(EFTDATA,U,16)="D":"-",1:"")_$P(EFTDATA,U,7) ; If Out of Balance Deposit PRCA*4.5*439
I RCDBAL W ?42,"EFT TOTAL AMT: "_$S($P(EFTDATA,U,16)="D":"-",1:"")_$P(EFTDATA,U,7) ; If not Out of Balance Deposit PRCA*4.5*439
W !,"EFT TRACE#: ",$P(EFTDATA,U,4)
W !,"DATE RECEIVED: ",$$DATE^RCDPRU($P(EFTDATA,U,12)),?26,"PAYER/ID: "_$P(EFTDATA,U,2)_"/"_$P(EFTDATA,U,3)
;
W !,"DATE",?10,"ACTION/DETAILS",?51,"STATUS"
W !,RCHR
Q
;
MDATE(STATUS,EFTIEN) ; Finds the Match Date from the Match History Global for the EFT
; Input: STATUS - Internal value from the EFT MATCH STATUS field
; EFTIEN - EDI THIRD PARTY EFT DETAIL (#344.31) IEN
; Returns: Match Date from the MATCH STATUS HISTORY (#344.314) multiple
;
; Validate Parameters. If STATUS is equal to UNMATCHED, quit with "" (no match date)
I $G(STATUS)=0 Q ""
I $G(EFTIEN)="" Q ""
;
N MIEN,RCDATA,IENS
;
; Get last record from the Match status history global. If no history, then quit with "" (no match date)
S MIEN=$O(^RCY(344.31,EFTIEN,4,999999),-1)
I 'MIEN Q "<No History>"
;
; Get data from match history
S IENS=MIEN_","_EFTIEN_","
D GETS^DIQ(344.314,IENS,".01;.02","I","RCDATA")
;
; If the most recent record is UNMATCHED, then it is does not match the EFT status so return "" (no match date)
I RCDATA(344.314,IENS,.01,"I")=0 Q ""
Q RCDATA(344.314,IENS,.02,"I")
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPTAR2 6550 printed Aug 26, 2025@22:02:20 Page 2
RCDPTAR2 ;AITC/CJE - EFT TRANSACTION AUDIT REPORT (Continued) ;08/14/23
+1 ;;4.5;Accounts Receivable;**424,439**;Mar 20, 1995;Build 29
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ; PRCA*4.5*424 - Moved subroutine RC from ^RCDPTAR and added FMS doc ID search
RC(RCDATA) ; Lookup by Receipt Number
+1 ; Input: RCDATA - null on entry
+2 ; RCDET - Environmental variable assumed to be set to "R" - Reciept or "F" - FMS Document
+3 ; Output: RCDATA - passed by refence - see subroutine EFTDATA for delimited list of fields
+4 ;
+5 NEW D,DIC,DTOUT,DUOUT,EFTIEN,ERAIEN,RCDTN,RCED,RCIEN,STOP,X,Y
+6 SET STOP=0
RC2 ;
+1 WRITE !
+2 SET DIC="^RCY(344,"
+3 SET DIC(0)=$SELECT(RCDET="F":"QEAn",1:"QEAMn")
+4 SET DIC("A")=$SELECT(RCDET="F":"Select FMS DOCUMENT NUMBER: ",1:"Select RECEIPT: ")
+5 SET DIC("W")="D DICW^RCDPUREC"
+6 SET DIC("S")="I $$EDILBEV^RCDPEU($P($G(^(0)),U,4))"
+7 IF RCDET="R"
DO ^DIC
+8 IF RCDET="F"
SET D="ADOC"
DO IX^DIC
+9 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y=-1)
SET RCDATA=-1
QUIT
+10 ;
+11 ; Check if there is a pointer to the AR Deposit
+12 SET RCDATA=""
+13 SET RCIEN=$PIECE($GET(^RCY(344,+Y,0)),U,6)
+14 ;
+15 ; If there is, then get the EFT via AR Deposit and EDI LockBox files
+16 IF RCIEN
Begin DoDot:1
+17 ; Get Ticket Number
+18 SET RCDTN=$PIECE($GET(^RCY(344.1,RCIEN,0)),U,1)
+19 IF RCDTN=""
QUIT
+20 ;
+21 ; Get EDI Lockbox Deposit File
+22 SET RCED=$ORDER(^RCY(344.3,"C",RCDTN,""))
+23 IF RCED=""
QUIT
+24 SET RCDATA=$$EFT^RCDPTAR(RCED)
End DoDot:1
+25 ;
+26 ; If this AR Deposit record is not found, check if it is a receipt on the ERA
+27 IF 'RCIEN
Begin DoDot:1
+28 SET ERAIEN=$ORDER(^RCY(344.4,"H",+Y,""))
+29 IF 'ERAIEN
SET ERAIEN=$ORDER(^RCY(344.4,"ARCT",+Y,""))
+30 IF 'ERAIEN
QUIT
+31 SET EFTIEN=$ORDER(^RCY(344.31,"AERA",ERAIEN,""))
+32 IF EFTIEN
SET RCDATA=$$EFTDATA^RCDPTAR(EFTIEN)
End DoDot:1
+33 ;
+34 IF RCDATA=""
Begin DoDot:1
+35 WRITE !!,"EFT NOT FOUND - please check Receipt"
+36 DO PAUSE^RCDPTAR
End DoDot:1
GOTO RC2
+37 ;
+38 if RCDATA=-1
QUIT
+39 ; No EFTs found
if RCDATA=""
QUIT
+40 ; Display output
DO SHOWONE^RCDPTAR(.STOP)
+41 if STOP
QUIT
+42 GOTO RC2
+43 QUIT
+44 ;
DEPBAL(RCDIEN) ;Is the deposit total in balance with EFT amounts ; New subroutine PRCA*4.5*439
+1 ; If modified, also check DEPBAL^RCDPEDA4
+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 ;
+29 ;Moved ASKSUM2 from RCDPTAR to RCDPTAR2 because of space, PRCA*4.5*439
ASKSUM2() ; Ask the user if they want to display the summary report by Deposit Date
+1 ; or by Deposit Number
+2 ; Input: None
+3 ; Returns: -1 - User quit or timed out
+4 ; 1 - Display Summary report by Deposit Date
+5 ; 2 - Display Summary report by Deposit Number
+6 NEW DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
+7 SET DIR(0)="SOA^EFTS:EFTS by Date;DATE:Deposit Number"
+8 SET DIR("A")="(E)FTs by Date or (D)eposit? "
+9 SET DIR("B")="DEPOSIT"
+10 DO ^DIR
+11 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT -1
+12 IF $EXTRACT(Y,1)="E"
QUIT 1
+13 QUIT 2
+14 ;
+15 ;Moved HEADER from RCDPTAR to RCDPTAR2 because of space, PRCA*4.5*439
+1 ; Input: RCNOW - DATE/TIME in external format
+2 ; RCPG - Current page number
+3 ; RCHR - Line of "-" to margin width
+4 ; RCDATA - See subroutine EFTDA about for delimited list of fields
+5 ; RCDBAL - Piece 1: 1 if deposit is in balance, 0 otherwise ; Add parameter PRCA*4.5*439
+6 ; Piece 2: Total of EFTs on the deposit
+7 ; Piece 3: Deposit Total
+8 ; Output: Write statements
+9 ;
+10 ; if RCDBAL was not passed, set to 1 to indicate deposit is in balance PRCA*4.5*439
IF '$LENGTH($GET(RCDBAL))
SET RCDBAL=1
+11 NEW EFTDATA,LINE
+12 SET EFTDATA=$GET(^RCY(344.31,+$PIECE(RCDATA,U,3),0))
+13 ;
+14 WRITE @IOF
+15 SET RCPG=RCPG+1
+16 WRITE "EFT TRANSACTION AUDIT REPORT"
+17 SET LINE=RCNOW_" PAGE: "_RCPG_" "
+18 WRITE ?(IOM-$LENGTH(LINE)),LINE
+19 ; Added EFT line identifier nnn.nn - PRCA*4.5*326
+20 WRITE !,"EFT#: ",$$AGED^RCDPTAR(+$PIECE(RCDATA,U,3)),$$GET1^DIQ(344.31,$PIECE(RCDATA,U,3)_",",.01,"E"),?19,"DEPOSIT#: ",$PIECE($GET(^RCY(344.3,+$PIECE(RCDATA,U,2),0)),U,6)
+21 ; If Out of Balance Deposit PRCA*4.5*439
IF 'RCDBAL
WRITE " *UNBAL*",?51,"EFT TOTAL AMT: "_$SELECT($PIECE(EFTDATA,U,16)="D":"-",1:"")_$PIECE(EFTDATA,U,7)
+22 ; If not Out of Balance Deposit PRCA*4.5*439
IF RCDBAL
WRITE ?42,"EFT TOTAL AMT: "_$SELECT($PIECE(EFTDATA,U,16)="D":"-",1:"")_$PIECE(EFTDATA,U,7)
+23 WRITE !,"EFT TRACE#: ",$PIECE(EFTDATA,U,4)
+24 WRITE !,"DATE RECEIVED: ",$$DATE^RCDPRU($PIECE(EFTDATA,U,12)),?26,"PAYER/ID: "_$PIECE(EFTDATA,U,2)_"/"_$PIECE(EFTDATA,U,3)
+25 ;
+26 WRITE !,"DATE",?10,"ACTION/DETAILS",?51,"STATUS"
+27 WRITE !,RCHR
+28 QUIT
+29 ;
MDATE(STATUS,EFTIEN) ; Finds the Match Date from the Match History Global for the EFT
+1 ; Input: STATUS - Internal value from the EFT MATCH STATUS field
+2 ; EFTIEN - EDI THIRD PARTY EFT DETAIL (#344.31) IEN
+3 ; Returns: Match Date from the MATCH STATUS HISTORY (#344.314) multiple
+4 ;
+5 ; Validate Parameters. If STATUS is equal to UNMATCHED, quit with "" (no match date)
+6 IF $GET(STATUS)=0
QUIT ""
+7 IF $GET(EFTIEN)=""
QUIT ""
+8 ;
+9 NEW MIEN,RCDATA,IENS
+10 ;
+11 ; Get last record from the Match status history global. If no history, then quit with "" (no match date)
+12 SET MIEN=$ORDER(^RCY(344.31,EFTIEN,4,999999),-1)
+13 IF 'MIEN
QUIT "<No History>"
+14 ;
+15 ; Get data from match history
+16 SET IENS=MIEN_","_EFTIEN_","
+17 DO GETS^DIQ(344.314,IENS,".01;.02","I","RCDATA")
+18 ;
+19 ; If the most recent record is UNMATCHED, then it is does not match the EFT status so return "" (no match date)
+20 IF RCDATA(344.314,IENS,.01,"I")=0
QUIT ""
+21 QUIT RCDATA(344.314,IENS,.02,"I")
+22 ;
