RCDPTAR2 ;AITC/CJE - EFT TRANSACTION AUDIT REPORT (Continued) ;08/14/23
;;4.5;Accounts Receivable;**424**;Mar 20, 1995;Build 11
;;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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPTAR2 1941 printed Sep 15, 2024@21:10:45 Page 2
RCDPTAR2 ;AITC/CJE - EFT TRANSACTION AUDIT REPORT (Continued) ;08/14/23
+1 ;;4.5;Accounts Receivable;**424**;Mar 20, 1995;Build 11
+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
