RCDPTAR1 ;ALB/DMB - EFT TRANSACTION AUDIT REPORT (Summary) ;08/19/15
;;4.5;Accounts Receivable;**303,326,380,409,424,439**;Mar 20, 1995;Build 29
;;Per VA Directive 6402, this routine should not be modified.
;
Q
; PRCA*4.5*303 - EFT TRANSACTION AUDIT REPORT (SUMMARY VERSION)
;
SUM ;EP from RCDPTAR
; Display EFT Transaction Audit Report in original summary mode by Deposit Date
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,RCDT1,RCDT2,RCEXCEL,X,Y
;
; Start Date
S DIR(0)="DAO^:"_DT_":APE",DIR("A")="Start Date: ",DIR("B")="T"
S DIR("?")="ENTER THE EARLIEST DATE OF RECEIPT OF DEPOSIT TO INCLUDE ON THE REPORT"
D ^DIR
I $D(DTOUT)!$D(DUOUT)!(Y="") Q
S RCDT1=Y
;
; End Date
K DIR
S DIR(0)="DAO^"_RCDT1_":"_DT_":APE",DIR("A")="End Date: ",DIR("B")="T"
S DIR("?")="ENTER THE LATEST DATE OF RECEIPT OF DEPOSIT TO INCLUDE ON THE REPORT"
D ^DIR
I $D(DTOUT)!$D(DUOUT)!(Y="") Q
S RCDT2=Y
;
S RCEXCEL=$$EXCEL^RCDMCUT2() ; Ask Excel output
I RCEXCEL="^" Q
I RCEXCEL D EXMSG
;
Q:$$ASKDEV(0)=-1 ; PRCA*4.5*380 - Prompt for device
;
U IO
D RUN(RCDT1,RCDT2,RCEXCEL)
Q
;
; PRCA*4.5*380 - Added subroutine
SUM2 ;EP from RCDPTAR
; Display EFT Transaction Audit Report in summary mode by Deposit Number
N ARR,CDDT,CTR,DIR,DIROUT,DIRUT,DTOUT,DUOUT
N RCDBAL,RCDDT,RCDIEN,RCDNUM,RCDT1,RCDT2,RCEXCEL,RCLOOP,RCSTOP,X,XX,Y ; PRCA*4.5*409 - Added RCSTOP ; PRCA*4.5*439 - Added RCDBAL, RCDIEN
S RCDNUM=$$ASKDNUM()
Q:RCDNUM=-1
S CTR=0,RCDDT="",CDDT="",RCSTOP=0,RCLOOP=0 ; PRCA*4.5*409 - Added RCSTOP=0,RCLOOP=0
W !,"Select Deposit:"
F D Q:RCDDT'="" Q:RCSTOP ; PRCA*4.5*409 - Added Q:RCSTOP
. S CDDT=$O(^RCY(344.3,"ADEP2",RCDNUM,CDDT),-1)
. I CDDT="" D Q ; No more Deposit Dates to display for Deposit Number
. . Q:CTR=0
. . S RCDDT=$$SELDT(CTR,.ARR,RCLOOP) ; Final selection choice ; PRCA*4.5*439 add RCLOOP to call
. . I RCDDT=-1 S RCSTOP=1
. S CTR=CTR+1,ARR(CTR)=CDDT
. S XX=$$FMTE^XLFDT(CDDT,"5DZ")
. W !,$J(CTR,3)," ",RCDNUM," on: ",XX
. S RCDIEN="",RCDBAL="0^0^0"
. F S RCDIEN=$O(^RCY(344.3,"ADEP2",RCDNUM,CDDT,RCDIEN)) Q:'RCDIEN D ; PRCA*4.5*439
. . S RCDBAL1=$$DEPBAL^RCDPTAR2(RCDIEN) ; Is deposit in balance with EFT totals, PRCA*4.5*439
. . S $P(RCDBAL,U,2)=$P(RCDBAL,U,2)+$P(RCDBAL1,U,2),$P(RCDBAL,U,3)=$P(RCDBAL,U,3)+$P(RCDBAL1,U,3)
. S $P(RCDBAL,U,1)=($P(RCDBAL,U,2)=$P(RCDBAL,U,3))
. W $J($P(RCDBAL,U,3),19,2) ; Deposit total
. I 'RCDBAL W " **UNBALANCED**" ; Add UNBALANCED indicator if deposit is not in balance, PRCA*4.5*439
. I CTR#10=0 D Q:RCDDT'="" ; Ask selection every 10 times
. . S RCDDT=$$SELDT(CTR,.ARR,RCLOOP) ; PRCA*4.5*439 add RCLOOP to parameters
. . I RCDDT=-1 S RCSTOP=1
Q:RCDDT="" Q:RCSTOP ; No Deposit Date selected
S RCEXCEL=$$EXCEL^RCDMCUT2() ; Ask Excel output
Q:RCEXCEL="^"
I RCEXCEL D EXMSG
;
Q:$$ASKDEV(0)=-1 ; Prompt for device
U IO
D RUN2(RCDNUM,RCDDT,RCEXCEL) ; Output the report
Q
;
; PRCA*4.5*380 - Added subroutine
ASKDNUM() ; Ask the user for the deposit number to select
; Input: None
; Returns: -1 - User quit or timed out
; Deposit Number
N DA,DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
DNUM2 ; looping tag
S DIR(0)="344.3,.06"
S DIR("A")="Enter Deposit Number"
S DIR("?")="Enter a valid deposit number"
D ^DIR
I $D(DTOUT)!$D(DUOUT)!(Y="") Q -1
I '$D(^RCY(344.3,"ADEP2",X)) D G DNUM2
. W *7,"Deposit Number: ",X," does not exist"
Q X
;
; PRCA*4.5*380 - Added subroutine
SELDT(CTR,ARR,RCLOOP) ; Ask the user to select a deposit date for the selected Deposit Number
; Input: CTR - Current # of choices displayed
; ARR - Array of available choices ARR(A1)=A2 Where:
; A1 - Selection #
; A2 - Deposit Date
; RCLOOP - Flag that indicates if selection is being made after displaying a EFT for the first time.
; Makes selection optional. PRCA*4.5*439
; Returns: "" - Nothing selected, Otherwise selected deposit date is returned
; -1 if user '^' or timed out
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="NA" I $G(RCLOOP) S DIR(0)="NAO" ; PRCA*4.5*439
S DIR(0)=DIR(0)_"^1:"_CTR_":0",DIR("A")="CHOOSE 1 - "_CTR_": "
S DIR("?")="Select a number between 1 and "_CTR
D ^DIR
I $G(RCLOOP),Y="" Q -1 ; PRCA*4.5*439
I $G(DTOUT)!$G(DUOUT)!(Y=-1) Q -1 ; PRCA*4.5*409 Added line
Q $S($D(DIRUT):"",1:ARR(Y))
;
; PRCA*4.5*380 - Added subroutine
ASKDEV(WHICH) ; Prompt user for device
; Input: WHICH - 0 - Original summary report, 1 - New summary report
; Retunrs: -1 - Unable to open device, 1 otherwise
; Prompt for device
N %ZIS,POP,ZTSK,ZTRTN,ZTIO,ZTDESC,ZTSAVE
S %ZIS="QM"
D ^%ZIS
Q:POP -1
I $D(IO("Q")) D Q 1
. S:WHICH=1 ZTRTN="RUN^RCDPTAR1(RCDT1,RCDT2,RCEXCEL)"
. S:WHICH=2 ZTRTN="RUN2^RCDPTAR1(RCDNUM,RCDDT,RCEXCEL)"
. S ZTIO=ION
. S ZTSAVE("*")=""
. S ZTDESC="EFT TRANSACTION SUMMARY REPORT"
. D ^%ZTLOAD
. W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
. D HOME^%ZIS
Q 1
;
RUN(RCDT1,RCDT2,RCEXCEL) ; Compile and run the report (original summary mode)
; Input: RCDT1 - Start Date
; RCDT2 - End Date
; RCEXCEL - 1 - Excel output, 0 otherwise
;
D COMPILE(RCDT1,RCDT2)
;
D REPORT(RCDT1,RCDT2,RCEXCEL)
K ^TMP("RCDPTAR1",$J)
Q
;
; PRCA*4.5*380 - Added subroutine
RUN2(RDNUM,RCDDT,RCEXCEL) ; Compile and run the report (new summary mode)
; Input: RCDNUM - Deposit Number
; RCDDT - Deposit Date
; RCEXCEL - 1 - Excel output, 0 otherwise
;
;I '$L($G(RCDBAL)) S RCDBAL=1 ; If called from code that doesn't use RCDBAL, set RCDBAL to 1 to default to a balanced deposit. PRCA*4.5*439
;
D COMPILE2(RCDNUM,RCDDT) ; Compile the report
;
D REPORT2(RCDNUM,RCDDT,RCEXCEL) ; Display the report
K ^TMP("RCDPTAR1",$J)
Q
;
COMPILE(RCDT1,RCDT2) ; Compile the report (original summary mode)
; Input: RCDT1 - Start Date
; RCDT2 - End Date
N EFTDATA,EFTIEN,LOCKDATA,LOCKIEN,MDATE,RCDT,XX
;
K ^TMP("RCDPTAR1",$J)
S RCDT=RCDT1-.0001,RCDT2=RCDT2_".9999"
F D Q:'RCDT!(RCDT>RCDT2)
. S RCDT=$O(^RCY(344.3,"ARECDT",RCDT))
. Q:'RCDT!(RCDT>RCDT2)
. S LOCKIEN=""
. F D Q:'LOCKIEN
. . S LOCKIEN=$O(^RCY(344.3,"ARECDT",RCDT,LOCKIEN))
. . Q:'LOCKIEN
. . S LOCKDATA=$G(^RCY(344.3,LOCKIEN,0))
. . ;
. . ; Deposit-0|3 (P344.1);Date Posted-0|11;
. . S EFTIEN=""
. . F D Q:'EFTIEN
. . . S EFTIEN=$O(^RCY(344.31,"B",LOCKIEN,EFTIEN))
. . . Q:'EFTIEN
. . . S EFTDATA=$G(^RCY(344.31,EFTIEN,0))
. . . ;
. . . ; Date Received-0|13;Amount-0|7;Match Status-0|8 (hist);Trace-0|4;Payer Name-0|2;Payer ID-0|3
. . . S MDATE=$$MDATE^RCDPTAR2($P(EFTDATA,U,8),EFTIEN)
. . . ;
. . . ; Date Received^Deposit #^EFT Amount^Date Matched^Date Posted^Trace #^Payer Name^Payer ID^Stale/Lock
. . . S ^TMP("RCDPTAR1",$J,EFTIEN)=$$DATE^RCDPRU($P(EFTDATA,U,13),"2ZD")_U_$$GET1^DIQ(344.3,LOCKIEN_",",.03,"E")
. . . S $P(^TMP("RCDPTAR1",$J,EFTIEN),U,3)=$S($P(EFTDATA,U,16)="D":"-",1:"")_$P(EFTDATA,U,7)
. . . S $P(^TMP("RCDPTAR1",$J,EFTIEN),U,4)=$$DATE^RCDPRU(MDATE,"2ZD")
. . . S $P(^TMP("RCDPTAR1",$J,EFTIEN),U,5)=$$DATE^RCDPRU($P(LOCKDATA,U,11),"2ZD")
. . . S $P(^TMP("RCDPTAR1",$J,EFTIEN),U,6)=$P(EFTDATA,U,4)
. . . S $P(^TMP("RCDPTAR1",$J,EFTIEN),U,7)=$P(EFTDATA,U,2)
. . . S $P(^TMP("RCDPTAR1",$J,EFTIEN),U,8)=$P(EFTDATA,U,3)
. . . S $P(^TMP("RCDPTAR1",$J,EFTIEN),U,9)=$$AGED^RCDPTAR(EFTIEN)
. . . S $P(^TMP("RCDPTAR1",$J,EFTIEN),U,10)=LOCKIEN ; Save Deposit IEN, #344.3, PRCA*4.5*439
;
Q
;
; PRCA*4.5*380 - Added subroutine
COMPILE2(RCDNUM,RCDDT) ; Compile the report (new summary mode)
; Input: RCDNUM - Deposit Number
; RCDDT - Deposit Date
N EFTDATA,EFTIEN,GTOT,RCDIEN,RCDTREC,XX
K ^TMP("RCDPTAR1",$J)
S GTOT=0
S RCDIEN=""
F D Q:RCDIEN=""
. S RCDIEN=$O(^RCY(344.3,"ADEP2",RCDNUM,RCDDT,RCDIEN))
. Q:RCDIEN=""
. S RCDTREC=$$GET1^DIQ(344.3,.13) ; Date/Time Added
. S EFTIEN=""
. F D Q:'EFTIEN
. . S EFTIEN=$O(^RCY(344.31,"B",RCDIEN,EFTIEN))
. . Q:'EFTIEN
. . S EFTDATA=$G(^RCY(344.31,EFTIEN,0))
. . S $P(^TMP("RCDPTAR1",$J,EFTIEN),"^",1)=RCDNUM ; Deposit #
. . S XX=$$DATE^RCDPRU(RCDDT,"2ZD")
. . S $P(^TMP("RCDPTAR1",$J,EFTIEN),"^",2)=XX ; Deposit Date
. . S XX=$$DATE^RCDPRU($P(EFTDATA,"^",13),"2ZD")
. . S $P(^TMP("RCDPTAR1",$J,EFTIEN),"^",3)=XX ; Date Received
. . S XX=$S($P(EFTDATA,U,16)="D":"-",1:"")_$P(EFTDATA,"^",7),GTOT=GTOT+XX
. . S $P(^TMP("RCDPTAR1",$J,EFTIEN),"^",4)=XX ; EFT Amount of Payment
. . S XX=$P(EFTDATA,"^",4)
. . S $P(^TMP("RCDPTAR1",$J,EFTIEN),"^",5)=XX ; Trace #
. . S XX=$P(EFTDATA,"^",2)
. . S $P(^TMP("RCDPTAR1",$J,EFTIEN),"^",6)=XX ; Payer Name
. . S XX=$P(EFTDATA,"^",3)
. . S $P(^TMP("RCDPTAR1",$J,EFTIEN),"^",7)=XX ; Payer ID
. . S $P(^TMP("RCDPTAR1",$J,EFTIEN),"^",10)=RCDIEN ; Save Deposit IEN, #344.3, PRCA*4.5*439
S ^TMP("RCDPTAR1",$J)=GTOT
Q
;
REPORT(RCDT1,RCDT2,RCEXCEL) ; Output the report (original summary mode)
; Input: RCDT1 - Start Date
; RCDT2 - End Date
; RCEXCEL - 1 - Excel output, 0 otherwise
N DATA,EFTIEN,LINES,RCDBAL,RCDIEN,RCHR,RCNOW,RCPG,RCSCR
;
; Initialize Report Date, Page Number and Sting of underscores
S RCSCR=$S($E($G(IOST),1,2)="C-":1,1:0)
S RCNOW=$$UP^XLFSTR($$NOW^RCDPRU(2)),RCPG=0,RCHR="",$P(RCHR,"-",IOM+1)=""
;
; Display header for first page
U IO
D HEADER(RCNOW,.RCPG,RCHR,RCDT1,RCDT2,RCEXCEL,"","") ; PRCA*4.5*380 - Added dep. number & date to hearder call
;
; No data, display message and quit
I '$D(^TMP("RCDPTAR1",$J)) W !,"No data found"
;
; Display the detail
S EFTIEN=0 F S EFTIEN=$O(^TMP("RCDPTAR1",$J,EFTIEN)) Q:'EFTIEN D I RCPG=0 Q
. S DATA=^TMP("RCDPTAR1",$J,EFTIEN)
. S LINES=$S(RCEXCEL:1,1:3)
. I RCSCR S LINES=LINES+1
. D CHKP(RCNOW,.RCPG,RCHR,RCDT1,RCDT2,RCEXCEL,RCSCR,LINES,"","") ; PRCA*4.5*380 - Added dep. number & date to header call
. Q:RCPG=0
. S RCDIEN=$P(DATA,U,10),RCDBAL=$$DEPBAL^RCDPTAR2(RCDIEN),RCDBAL=+RCDBAL,RCDBAL=$S('RCDBAL:"UNBALANCED",1:"")
. ; If Excel, display as delimited and quit
. I RCEXCEL W !,$P(DATA,U,9),$$EFT(EFTIEN),U,RCDBAL,U,$$DEPBAL^RCDPTAR2(RCDIEN),U,$P(DATA,U,1,8) Q
. ;
. ; Display non-Excel output
. W !,$P(DATA,U,9),$$EFT(EFTIEN),?13,$P(DATA,U,1),?25,$P(DATA,U,2),?37,$J($P(DATA,U,3),13,2),?54,$P(DATA,U,4),?69,$P(DATA,U,5)
. ;W !,?4,$P(DATA,U,6)," ",RCDBAL ; Display unbalanced indicator, PRCA*4.5*439
. W !,?4,$P(DATA,U,6) ; Remove unbalanced indicator at EFT level, PRCA*4.5*439
. W !,?11,$P(DATA,U,7),"/",$P(DATA,U,8)
;
I 'RCSCR W !,@IOF
I $D(ZTQUEUED) S ZTREQ="@" Q
D ^%ZISC
;
I RCPG,RCSCR D PAUSE
Q
;
; PRCA*4.5*380 - Added subroutine
REPORT2(RCDNUM,RCDDT,RCEXCEL) ; Output the report (new summary mode)
; Input: RCDNUM - Deposit Number
; RCDDT - Deposit Date
; RCEXCEL - 1 - Excel output, 0 otherwise
;
N DATA,EFTIEN,GTOT,LINES,RCDBAL,RCDBAL2,RCDIEN,RCHR,RCNOW,RCPG,RCSCR
;
;I '$L($G(RCDBAL)) S RCDBAL=1 ; If called from code that doesn't use RCDBAL, set RCDBAL to 1 to default to a balanced deposit. PRCA*4.5*439
;
; Initialize Report Date, Page Number and String of underscores
S RCSCR=$S($E($G(IOST),1,2)="C-":1,1:0)
S RCNOW=$$UP^XLFSTR($$NOW^RCDPRU(2)),RCPG=0,RCHR="",$P(RCHR,"-",IOM+1)=""
;
S RCDBAL=$$DEPBAL^RCDPTAR2(RCDNUM)
; Display header for first page
U IO
D HEADER(RCNOW,.RCPG,RCHR,"","",RCEXCEL,RCDNUM,RCDDT,RCDBAL) ; Add parameter RCDBAL PRCA*4.5*439
;
; No data, display message and quit
I '$D(^TMP("RCDPTAR1",$J)) W !,"No data found"
;
; Display the detail
S EFTIEN=0,GTOT=^TMP("RCDPTAR1",$J)
F S EFTIEN=$O(^TMP("RCDPTAR1",$J,EFTIEN)) Q:'EFTIEN D I RCPG=0 Q
. S DATA=^TMP("RCDPTAR1",$J,EFTIEN)
. S LINES=$S(RCEXCEL:1,1:3)
. I RCSCR S LINES=LINES+1
. D CHKP(RCNOW,.RCPG,RCHR,"","",RCEXCEL,RCSCR,LINES,RCDNUM,RCDDT)
. Q:RCPG=0
. ;
. S RCDIEN=$P(DATA,U,10),RCDBAL=$$DEPBAL^RCDPTAR2(RCDIEN),RCDBAL2=$S('RCDBAL:"UNBALANCED",1:"")
. ; If Excel, display as delimited and quit
. I RCEXCEL W !,$P(DATA,U,9),$$EFT(EFTIEN),U,RCDBAL2,U,DATA Q
. ;
. ; Display non-Excel output
. W !,$$EFT(EFTIEN),?13,$P(DATA,U,1),?26,$P(DATA,U,2)
. W ?40,$P(DATA,U,3),?55,$J($P(DATA,U,4),13,2)
. ;W !,?4,$P(DATA,U,5)," ",RCDBAL2
. W !,?4,$P(DATA,U,5) ; Remove unbalanced indicator at EFT level, PRCA*4.5*439
. W !,?11,$P(DATA,U,6),"/",$P(DATA,U,7)
;
I 'RCEXCEL,RCPG D
. W !!,"Total for Deposit #: ",RCDNUM," Deposit Date: ",$$FMTE^XLFDT(RCDDT,"5DZ")
. ; Add coding to account for out-of-balance deposits ; PRCA*4.5*439
. I RCDBAL W ?51,$J(GTOT,13,2) Q
. W ?55,$J($P(RCDBAL,U,3),13,2)
. W !,"Sum of EFT Amounts : **UNBALANCED**",?55,$J($P(RCDBAL,U,2),13,2)
I 'RCSCR W !,@IOF
I $D(ZTQUEUED) S ZTREQ="@" Q
D ^%ZISC
;
I RCPG,RCSCR D PAUSE
Q
;
; PRCA*4.5*380 - Added deposit number & deposit date
; Input: RCNOW - External Run Date/Time
; RCPG - Current page number
; RCHR - Dashed line
; RCDT1 - Start Date or null if new summary report
; RCDT2 - End Date or null if new summary report
; RCEXCEL - 1 - Excel output, 0 otherwise
; RCDNUM - Deposit Number or null if original summary report
; RCDDT - Internal Deposit Date or null if original summary report
; 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: RCPG - Updated page number
;
W @IOF
;
I '$L($G(RCDBAL)) S RCDBAL=1 ; If called from code that doesn't use RCDBAL, set RCDBAL to 1 to default to a balanced deposit. PRCA*4.5*439
;
; If Excel, print column headers separated with up-arrows and quit
I $G(RCEXCEL) D Q
. ; PRCA*4.5*380 - New header for Dep. Num/Date report
. ; PRCA*4.5*439 - Add UNBALANCED to Excel header
. I RCDT1'="" D
. . W !,"EFT#^UNBALANCED^DATE RECEIVED^DEPOSIT#^EFT TOTAL AMT^DATE MATCHED^DATE POSTED^TRACE #^PAYER NAME^PAYER ID"
. E D
. . W !,"EFT#^UNBALANCED^DEPOSIT#^DEPOSIT DATE^DATE RECEIVED^EFT TOTAL AMT^TRACE #^PAYER NAME^PAYER ID"
. S RCPG=1
;
; Non-Excel Header
N LINE
S RCPG=RCPG+1
S LINE="EFT TRANSACTION AUDIT REPORT - SUMMARY Page: "_RCPG
W !?(IOM-$L(LINE)\2),LINE
S LINE="RUN DATE: "_RCNOW
W !?(IOM-$L(LINE)\2),LINE
; PRCA*4.5*380 - New header for Dep. Num/Date report
I RCDT1'="" D Q
. S LINE="DATE RANGE: "_$$DATE^RCDPRU(RCDT1,"2D")_" - "_$$DATE^RCDPRU(RCDT2,"2D")_" (DATE DEPOSIT ADDED)"
. W !?(IOM-$L(LINE)\2),LINE
. W !!,"EFT#",?13,"DATE RECVD",?25,"DEPOSIT#",?37,"EFT TOTAL AMT",?54,"DATE MATCHED",?69,"DATE POSTED"
. W !,?4,"TRACE #",!,?11,"PAYER NAME/ID"
. W !,RCHR
;
S LINE="DEPOSIT #: "_RCDNUM_" Deposit Date "_$$DATE^RCDPRU(RCDDT,"2D")_$S('RCDBAL:" **UNBALANCED**",1:"") ;Unbalance indicator PRCA*4.5*439
I RCDNUM'="" D
. W !?(IOM-$L(LINE)\2),LINE
. W !!,"EFT#",?13,"DEPOSIT#",?26,"DEPOSIT DATE",?40,"DATE RECEIVED",?55,"EFT TOTAL AMT"
. W !,?4,"TRACE #",!,?11,"PAYER NAME/ID"
. W !,RCHR
; end PRCA*4.5*380 changes
Q
;
EXMSG ;
;Displays the message about capturing to an Excel file format
;
W !!?5,"To capture as an Excel format, it is recommended that you queue this"
W !?5,"report to a spool device with margins of 256 and page length of 99999"
W !?5,"(e.g. spoolname;256;99999). This should help avoid wrapping problems."
W !!?5,"Another method would be to set up your terminal to capture the detail"
W !?5,"report data. On some terminals, this can be done by clicking on the"
W !?5,"'Tools' menu above, then click on 'Capture Incoming Data' to save to"
W !?5,"Desktop. To avoid undesired wrapping of the data saved to the file,"
W !?5,"please enter '0;256;99999' at the 'DEVICE:' prompt.",!
Q
;
PAUSE() ; Display press return to continue message
N DIR,X,Y,DTOUT,DUOUT,DIROUT,DIRUT
S DIR(0)="E"
D ^DIR
Q Y
;
; PRCA*4.5*380 - Add deposit number/date to header
CHKP(RCNOW,RCPG,RCHR,RCDT1,RCDT2,RCEXCEL,RCSCR,LINES,RCDNUM,RCDDT) ; Check if we need to do a page break
; Input: RCNOW - Run date/time
; RCPG - Current Page Number
; RCHR - Dashed line
; RCDT1 - Start Date or null if new summary report
; RCDT2 - End Date or null if new summary report
; RCEXCEL - 1 if output to Excel, 0 otherwise
; RSCR - 1 output to screen, otherwise output to paper
; LINES - Current # of lines on the page
; RCDNUM - Deposit Number or null if original summary report
; RCDDT - Deposit Date or null if original summary report
; Output: RCPG - New Page Number or 0 if user quit display
;
I $Y'>(IOSL-LINES) Q
I RCSCR,'$$PAUSE S RCPG=0 Q
D HEADER(RCNOW,.RCPG,RCHR,RCDT1,RCDT2,RCEXCEL,RCDNUM,RCDDT)
Q
;
EFT(EFTIEN) ; Format EFT output - EFT.SEQ - PRCA*4.5*326
; Input: EFTIEN - Internal EFT number
; Returns: EFT.Sequence #
Q $$GET1^DIQ(344.31,EFTIEN_",",.01,"E")
;
DEPEFTS(RCDNUM,RCDDT,RCEFTCNT) ; List EFTs for a given deposit number and date. Added for PRCA*4.5*439
; Input - RCDNUM - Deposit #
; RCDDT - Deposit Date
; Output - Return value LIST(Y) containing data of selected EFT
; RCEFTCNT - Count of EFTs passed by reference
;
N EFTIEN,CNT,DATA,J,LIST,RCBAL,RCDBAL,RCDBAL1,RCDIEN,Y
;
S (CNT,RCDIEN,RCDBAL)=0
F D Q:RCDIEN=""
. S RCDIEN=$O(^RCY(344.3,"ADEP2",RCDNUM,RCDDT,RCDIEN))
. I RCDIEN="" Q
. S RCDBAL1=$$DEPBAL^RCDPTAR2(RCDIEN)
. F J=2:1:3 S $P(RCDBAL,U,J)=$P(RCDBAL1,U,J)+$P(RCDBAL,U,J)
. S EFTIEN=""
. F D Q:'EFTIEN
. . S EFTIEN=$O(^RCY(344.31,"B",RCDIEN,EFTIEN))
. . Q:'EFTIEN
. . S DATA=$$EFTDATA^RCDPTAR(EFTIEN) I DATA]"" S CNT=CNT+1,LIST(CNT)=DATA
;
S RCEFTCNT=CNT
I CNT=0 W !!,"No EFT detail for this selection" D PAUSE Q ""
;
; If only one EFT, select it and quit
I CNT=1 S Y=1 G EFT1
;
; Display list of EFTs. Manual display and reading so we can put data on two lines. PRCA*4.5*439
N ROW,TRANS,X
W !!,"Deposit #: "_$J($$GET1^DIQ(344.3,LOCKIEN_",",.06),10)_" "
W "Deposit Date: "_$$DATE^RCDPRU(RCDDT,"2DZ")
W $J($P(RCDBAL,U,3),19,2) ; Deposit Total
;I '($P(RCDBAL,U,2)=$P(RCDBAL,U,3)) W " **UNBALANCED**" ; Remove unbalanced indicator at EFT level
N LCNT,QUIT ; PRCA*4.5*439
S LCNT=0,QUIT=0,Y=-1
F ROW=1:1:CNT D Q:QUIT
. S DATA=LIST(ROW),EFTIEN=$P(DATA,U,3)
. D DISPLAY^RCDPTAR(ROW,EFTIEN)
. ;I ROW#5=0!(ROW=CNT) D I Y>0!(Y=-1) S QUIT=1 Q ;
S Y=$$READ^RCDPTAR(1,ROW,CNT)
I Y'>0 Q 0
;
EFT1 ;
Q LIST(Y)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPTAR1 19281 printed Aug 26, 2025@22:02:19 Page 2
RCDPTAR1 ;ALB/DMB - EFT TRANSACTION AUDIT REPORT (Summary) ;08/19/15
+1 ;;4.5;Accounts Receivable;**303,326,380,409,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*303 - EFT TRANSACTION AUDIT REPORT (SUMMARY VERSION)
+6 ;
SUM ;EP from RCDPTAR
+1 ; Display EFT Transaction Audit Report in original summary mode by Deposit Date
+2 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,RCDT1,RCDT2,RCEXCEL,X,Y
+3 ;
+4 ; Start Date
+5 SET DIR(0)="DAO^:"_DT_":APE"
SET DIR("A")="Start Date: "
SET DIR("B")="T"
+6 SET DIR("?")="ENTER THE EARLIEST DATE OF RECEIPT OF DEPOSIT TO INCLUDE ON THE REPORT"
+7 DO ^DIR
+8 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
QUIT
+9 SET RCDT1=Y
+10 ;
+11 ; End Date
+12 KILL DIR
+13 SET DIR(0)="DAO^"_RCDT1_":"_DT_":APE"
SET DIR("A")="End Date: "
SET DIR("B")="T"
+14 SET DIR("?")="ENTER THE LATEST DATE OF RECEIPT OF DEPOSIT TO INCLUDE ON THE REPORT"
+15 DO ^DIR
+16 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
QUIT
+17 SET RCDT2=Y
+18 ;
+19 ; Ask Excel output
SET RCEXCEL=$$EXCEL^RCDMCUT2()
+20 IF RCEXCEL="^"
QUIT
+21 IF RCEXCEL
DO EXMSG
+22 ;
+23 ; PRCA*4.5*380 - Prompt for device
if $$ASKDEV(0)=-1
QUIT
+24 ;
+25 USE IO
+26 DO RUN(RCDT1,RCDT2,RCEXCEL)
+27 QUIT
+28 ;
+29 ; PRCA*4.5*380 - Added subroutine
SUM2 ;EP from RCDPTAR
+1 ; Display EFT Transaction Audit Report in summary mode by Deposit Number
+2 NEW ARR,CDDT,CTR,DIR,DIROUT,DIRUT,DTOUT,DUOUT
+3 ; PRCA*4.5*409 - Added RCSTOP ; PRCA*4.5*439 - Added RCDBAL, RCDIEN
NEW RCDBAL,RCDDT,RCDIEN,RCDNUM,RCDT1,RCDT2,RCEXCEL,RCLOOP,RCSTOP,X,XX,Y
+4 SET RCDNUM=$$ASKDNUM()
+5 if RCDNUM=-1
QUIT
+6 ; PRCA*4.5*409 - Added RCSTOP=0,RCLOOP=0
SET CTR=0
SET RCDDT=""
SET CDDT=""
SET RCSTOP=0
SET RCLOOP=0
+7 WRITE !,"Select Deposit:"
+8 ; PRCA*4.5*409 - Added Q:RCSTOP
FOR
Begin DoDot:1
+9 SET CDDT=$ORDER(^RCY(344.3,"ADEP2",RCDNUM,CDDT),-1)
+10 ; No more Deposit Dates to display for Deposit Number
IF CDDT=""
Begin DoDot:2
+11 if CTR=0
QUIT
+12 ; Final selection choice ; PRCA*4.5*439 add RCLOOP to call
SET RCDDT=$$SELDT(CTR,.ARR,RCLOOP)
+13 IF RCDDT=-1
SET RCSTOP=1
End DoDot:2
QUIT
+14 SET CTR=CTR+1
SET ARR(CTR)=CDDT
+15 SET XX=$$FMTE^XLFDT(CDDT,"5DZ")
+16 WRITE !,$JUSTIFY(CTR,3)," ",RCDNUM," on: ",XX
+17 SET RCDIEN=""
SET RCDBAL="0^0^0"
+18 ; PRCA*4.5*439
FOR
SET RCDIEN=$ORDER(^RCY(344.3,"ADEP2",RCDNUM,CDDT,RCDIEN))
if 'RCDIEN
QUIT
Begin DoDot:2
+19 ; Is deposit in balance with EFT totals, PRCA*4.5*439
SET RCDBAL1=$$DEPBAL^RCDPTAR2(RCDIEN)
+20 SET $PIECE(RCDBAL,U,2)=$PIECE(RCDBAL,U,2)+$PIECE(RCDBAL1,U,2)
SET $PIECE(RCDBAL,U,3)=$PIECE(RCDBAL,U,3)+$PIECE(RCDBAL1,U,3)
End DoDot:2
+21 SET $PIECE(RCDBAL,U,1)=($PIECE(RCDBAL,U,2)=$PIECE(RCDBAL,U,3))
+22 ; Deposit total
WRITE $JUSTIFY($PIECE(RCDBAL,U,3),19,2)
+23 ; Add UNBALANCED indicator if deposit is not in balance, PRCA*4.5*439
IF 'RCDBAL
WRITE " **UNBALANCED**"
+24 ; Ask selection every 10 times
IF CTR#10=0
Begin DoDot:2
+25 ; PRCA*4.5*439 add RCLOOP to parameters
SET RCDDT=$$SELDT(CTR,.ARR,RCLOOP)
+26 IF RCDDT=-1
SET RCSTOP=1
End DoDot:2
if RCDDT'=""
QUIT
End DoDot:1
if RCDDT'=""
QUIT
if RCSTOP
QUIT
+27 ; No Deposit Date selected
if RCDDT=""
QUIT
if RCSTOP
QUIT
+28 ; Ask Excel output
SET RCEXCEL=$$EXCEL^RCDMCUT2()
+29 if RCEXCEL="^"
QUIT
+30 IF RCEXCEL
DO EXMSG
+31 ;
+32 ; Prompt for device
if $$ASKDEV(0)=-1
QUIT
+33 USE IO
+34 ; Output the report
DO RUN2(RCDNUM,RCDDT,RCEXCEL)
+35 QUIT
+36 ;
+37 ; PRCA*4.5*380 - Added subroutine
ASKDNUM() ; Ask the user for the deposit number to select
+1 ; Input: None
+2 ; Returns: -1 - User quit or timed out
+3 ; Deposit Number
+4 NEW DA,DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
DNUM2 ; looping tag
+1 SET DIR(0)="344.3,.06"
+2 SET DIR("A")="Enter Deposit Number"
+3 SET DIR("?")="Enter a valid deposit number"
+4 DO ^DIR
+5 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
QUIT -1
+6 IF '$DATA(^RCY(344.3,"ADEP2",X))
Begin DoDot:1
+7 WRITE *7,"Deposit Number: ",X," does not exist"
End DoDot:1
GOTO DNUM2
+8 QUIT X
+9 ;
+10 ; PRCA*4.5*380 - Added subroutine
SELDT(CTR,ARR,RCLOOP) ; Ask the user to select a deposit date for the selected Deposit Number
+1 ; Input: CTR - Current # of choices displayed
+2 ; ARR - Array of available choices ARR(A1)=A2 Where:
+3 ; A1 - Selection #
+4 ; A2 - Deposit Date
+5 ; RCLOOP - Flag that indicates if selection is being made after displaying a EFT for the first time.
+6 ; Makes selection optional. PRCA*4.5*439
+7 ; Returns: "" - Nothing selected, Otherwise selected deposit date is returned
+8 ; -1 if user '^' or timed out
+9 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+10 ; PRCA*4.5*439
SET DIR(0)="NA"
IF $GET(RCLOOP)
SET DIR(0)="NAO"
+11 SET DIR(0)=DIR(0)_"^1:"_CTR_":0"
SET DIR("A")="CHOOSE 1 - "_CTR_": "
+12 SET DIR("?")="Select a number between 1 and "_CTR
+13 DO ^DIR
+14 ; PRCA*4.5*439
IF $GET(RCLOOP)
IF Y=""
QUIT -1
+15 ; PRCA*4.5*409 Added line
IF $GET(DTOUT)!$GET(DUOUT)!(Y=-1)
QUIT -1
+16 QUIT $SELECT($DATA(DIRUT):"",1:ARR(Y))
+17 ;
+18 ; PRCA*4.5*380 - Added subroutine
ASKDEV(WHICH) ; Prompt user for device
+1 ; Input: WHICH - 0 - Original summary report, 1 - New summary report
+2 ; Retunrs: -1 - Unable to open device, 1 otherwise
+3 ; Prompt for device
+4 NEW %ZIS,POP,ZTSK,ZTRTN,ZTIO,ZTDESC,ZTSAVE
+5 SET %ZIS="QM"
+6 DO ^%ZIS
+7 if POP
QUIT -1
+8 IF $DATA(IO("Q"))
Begin DoDot:1
+9 if WHICH=1
SET ZTRTN="RUN^RCDPTAR1(RCDT1,RCDT2,RCEXCEL)"
+10 if WHICH=2
SET ZTRTN="RUN2^RCDPTAR1(RCDNUM,RCDDT,RCEXCEL)"
+11 SET ZTIO=ION
+12 SET ZTSAVE("*")=""
+13 SET ZTDESC="EFT TRANSACTION SUMMARY REPORT"
+14 DO ^%ZTLOAD
+15 WRITE !,$SELECT($DATA(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
+16 DO HOME^%ZIS
End DoDot:1
QUIT 1
+17 QUIT 1
+18 ;
RUN(RCDT1,RCDT2,RCEXCEL) ; Compile and run the report (original summary mode)
+1 ; Input: RCDT1 - Start Date
+2 ; RCDT2 - End Date
+3 ; RCEXCEL - 1 - Excel output, 0 otherwise
+4 ;
+5 DO COMPILE(RCDT1,RCDT2)
+6 ;
+7 DO REPORT(RCDT1,RCDT2,RCEXCEL)
+8 KILL ^TMP("RCDPTAR1",$JOB)
+9 QUIT
+10 ;
+11 ; PRCA*4.5*380 - Added subroutine
RUN2(RDNUM,RCDDT,RCEXCEL) ; Compile and run the report (new summary mode)
+1 ; Input: RCDNUM - Deposit Number
+2 ; RCDDT - Deposit Date
+3 ; RCEXCEL - 1 - Excel output, 0 otherwise
+4 ;
+5 ;I '$L($G(RCDBAL)) S RCDBAL=1 ; If called from code that doesn't use RCDBAL, set RCDBAL to 1 to default to a balanced deposit. PRCA*4.5*439
+6 ;
+7 ; Compile the report
DO COMPILE2(RCDNUM,RCDDT)
+8 ;
+9 ; Display the report
DO REPORT2(RCDNUM,RCDDT,RCEXCEL)
+10 KILL ^TMP("RCDPTAR1",$JOB)
+11 QUIT
+12 ;
COMPILE(RCDT1,RCDT2) ; Compile the report (original summary mode)
+1 ; Input: RCDT1 - Start Date
+2 ; RCDT2 - End Date
+3 NEW EFTDATA,EFTIEN,LOCKDATA,LOCKIEN,MDATE,RCDT,XX
+4 ;
+5 KILL ^TMP("RCDPTAR1",$JOB)
+6 SET RCDT=RCDT1-.0001
SET RCDT2=RCDT2_".9999"
+7 FOR
Begin DoDot:1
+8 SET RCDT=$ORDER(^RCY(344.3,"ARECDT",RCDT))
+9 if 'RCDT!(RCDT>RCDT2)
QUIT
+10 SET LOCKIEN=""
+11 FOR
Begin DoDot:2
+12 SET LOCKIEN=$ORDER(^RCY(344.3,"ARECDT",RCDT,LOCKIEN))
+13 if 'LOCKIEN
QUIT
+14 SET LOCKDATA=$GET(^RCY(344.3,LOCKIEN,0))
+15 ;
+16 ; Deposit-0|3 (P344.1);Date Posted-0|11;
+17 SET EFTIEN=""
+18 FOR
Begin DoDot:3
+19 SET EFTIEN=$ORDER(^RCY(344.31,"B",LOCKIEN,EFTIEN))
+20 if 'EFTIEN
QUIT
+21 SET EFTDATA=$GET(^RCY(344.31,EFTIEN,0))
+22 ;
+23 ; Date Received-0|13;Amount-0|7;Match Status-0|8 (hist);Trace-0|4;Payer Name-0|2;Payer ID-0|3
+24 SET MDATE=$$MDATE^RCDPTAR2($PIECE(EFTDATA,U,8),EFTIEN)
+25 ;
+26 ; Date Received^Deposit #^EFT Amount^Date Matched^Date Posted^Trace #^Payer Name^Payer ID^Stale/Lock
+27 SET ^TMP("RCDPTAR1",$JOB,EFTIEN)=$$DATE^RCDPRU($PIECE(EFTDATA,U,13),"2ZD")_U_$$GET1^DIQ(344.3,LOCKIEN_",",.03,"E")
+28 SET $PIECE(^TMP("RCDPTAR1",$JOB,EFTIEN),U,3)=$SELECT($PIECE(EFTDATA,U,16)="D":"-",1:"")_$PIECE(EFTDATA,U,7)
+29 SET $PIECE(^TMP("RCDPTAR1",$JOB,EFTIEN),U,4)=$$DATE^RCDPRU(MDATE,"2ZD")
+30 SET $PIECE(^TMP("RCDPTAR1",$JOB,EFTIEN),U,5)=$$DATE^RCDPRU($PIECE(LOCKDATA,U,11),"2ZD")
+31 SET $PIECE(^TMP("RCDPTAR1",$JOB,EFTIEN),U,6)=$PIECE(EFTDATA,U,4)
+32 SET $PIECE(^TMP("RCDPTAR1",$JOB,EFTIEN),U,7)=$PIECE(EFTDATA,U,2)
+33 SET $PIECE(^TMP("RCDPTAR1",$JOB,EFTIEN),U,8)=$PIECE(EFTDATA,U,3)
+34 SET $PIECE(^TMP("RCDPTAR1",$JOB,EFTIEN),U,9)=$$AGED^RCDPTAR(EFTIEN)
+35 ; Save Deposit IEN, #344.3, PRCA*4.5*439
SET $PIECE(^TMP("RCDPTAR1",$JOB,EFTIEN),U,10)=LOCKIEN
End DoDot:3
if 'EFTIEN
QUIT
End DoDot:2
if 'LOCKIEN
QUIT
End DoDot:1
if 'RCDT!(RCDT>RCDT2)
QUIT
+36 ;
+37 QUIT
+38 ;
+39 ; PRCA*4.5*380 - Added subroutine
COMPILE2(RCDNUM,RCDDT) ; Compile the report (new summary mode)
+1 ; Input: RCDNUM - Deposit Number
+2 ; RCDDT - Deposit Date
+3 NEW EFTDATA,EFTIEN,GTOT,RCDIEN,RCDTREC,XX
+4 KILL ^TMP("RCDPTAR1",$JOB)
+5 SET GTOT=0
+6 SET RCDIEN=""
+7 FOR
Begin DoDot:1
+8 SET RCDIEN=$ORDER(^RCY(344.3,"ADEP2",RCDNUM,RCDDT,RCDIEN))
+9 if RCDIEN=""
QUIT
+10 ; Date/Time Added
SET RCDTREC=$$GET1^DIQ(344.3,.13)
+11 SET EFTIEN=""
+12 FOR
Begin DoDot:2
+13 SET EFTIEN=$ORDER(^RCY(344.31,"B",RCDIEN,EFTIEN))
+14 if 'EFTIEN
QUIT
+15 SET EFTDATA=$GET(^RCY(344.31,EFTIEN,0))
+16 ; Deposit #
SET $PIECE(^TMP("RCDPTAR1",$JOB,EFTIEN),"^",1)=RCDNUM
+17 SET XX=$$DATE^RCDPRU(RCDDT,"2ZD")
+18 ; Deposit Date
SET $PIECE(^TMP("RCDPTAR1",$JOB,EFTIEN),"^",2)=XX
+19 SET XX=$$DATE^RCDPRU($PIECE(EFTDATA,"^",13),"2ZD")
+20 ; Date Received
SET $PIECE(^TMP("RCDPTAR1",$JOB,EFTIEN),"^",3)=XX
+21 SET XX=$SELECT($PIECE(EFTDATA,U,16)="D":"-",1:"")_$PIECE(EFTDATA,"^",7)
SET GTOT=GTOT+XX
+22 ; EFT Amount of Payment
SET $PIECE(^TMP("RCDPTAR1",$JOB,EFTIEN),"^",4)=XX
+23 SET XX=$PIECE(EFTDATA,"^",4)
+24 ; Trace #
SET $PIECE(^TMP("RCDPTAR1",$JOB,EFTIEN),"^",5)=XX
+25 SET XX=$PIECE(EFTDATA,"^",2)
+26 ; Payer Name
SET $PIECE(^TMP("RCDPTAR1",$JOB,EFTIEN),"^",6)=XX
+27 SET XX=$PIECE(EFTDATA,"^",3)
+28 ; Payer ID
SET $PIECE(^TMP("RCDPTAR1",$JOB,EFTIEN),"^",7)=XX
+29 ; Save Deposit IEN, #344.3, PRCA*4.5*439
SET $PIECE(^TMP("RCDPTAR1",$JOB,EFTIEN),"^",10)=RCDIEN
End DoDot:2
if 'EFTIEN
QUIT
End DoDot:1
if RCDIEN=""
QUIT
+30 SET ^TMP("RCDPTAR1",$JOB)=GTOT
+31 QUIT
+32 ;
REPORT(RCDT1,RCDT2,RCEXCEL) ; Output the report (original summary mode)
+1 ; Input: RCDT1 - Start Date
+2 ; RCDT2 - End Date
+3 ; RCEXCEL - 1 - Excel output, 0 otherwise
+4 NEW DATA,EFTIEN,LINES,RCDBAL,RCDIEN,RCHR,RCNOW,RCPG,RCSCR
+5 ;
+6 ; Initialize Report Date, Page Number and Sting of underscores
+7 SET RCSCR=$SELECT($EXTRACT($GET(IOST),1,2)="C-":1,1:0)
+8 SET RCNOW=$$UP^XLFSTR($$NOW^RCDPRU(2))
SET RCPG=0
SET RCHR=""
SET $PIECE(RCHR,"-",IOM+1)=""
+9 ;
+10 ; Display header for first page
+11 USE IO
+12 ; PRCA*4.5*380 - Added dep. number & date to hearder call
DO HEADER(RCNOW,.RCPG,RCHR,RCDT1,RCDT2,RCEXCEL,"","")
+13 ;
+14 ; No data, display message and quit
+15 IF '$DATA(^TMP("RCDPTAR1",$JOB))
WRITE !,"No data found"
+16 ;
+17 ; Display the detail
+18 SET EFTIEN=0
FOR
SET EFTIEN=$ORDER(^TMP("RCDPTAR1",$JOB,EFTIEN))
if 'EFTIEN
QUIT
Begin DoDot:1
+19 SET DATA=^TMP("RCDPTAR1",$JOB,EFTIEN)
+20 SET LINES=$SELECT(RCEXCEL:1,1:3)
+21 IF RCSCR
SET LINES=LINES+1
+22 ; PRCA*4.5*380 - Added dep. number & date to header call
DO CHKP(RCNOW,.RCPG,RCHR,RCDT1,RCDT2,RCEXCEL,RCSCR,LINES,"","")
+23 if RCPG=0
QUIT
+24 SET RCDIEN=$PIECE(DATA,U,10)
SET RCDBAL=$$DEPBAL^RCDPTAR2(RCDIEN)
SET RCDBAL=+RCDBAL
SET RCDBAL=$SELECT('RCDBAL:"UNBALANCED",1:"")
+25 ; If Excel, display as delimited and quit
+26 IF RCEXCEL
WRITE !,$PIECE(DATA,U,9),$$EFT(EFTIEN),U,RCDBAL,U,$$DEPBAL^RCDPTAR2(RCDIEN),U,$PIECE(DATA,U,1,8)
QUIT
+27 ;
+28 ; Display non-Excel output
+29 WRITE !,$PIECE(DATA,U,9),$$EFT(EFTIEN),?13,$PIECE(DATA,U,1),?25,$PIECE(DATA,U,2),?37,$JUSTIFY($PIECE(DATA,U,3),13,2),?54,$PIECE(DATA,U,4),?69,$PIECE(DATA,U,5)
+30 ;W !,?4,$P(DATA,U,6)," ",RCDBAL ; Display unbalanced indicator, PRCA*4.5*439
+31 ; Remove unbalanced indicator at EFT level, PRCA*4.5*439
WRITE !,?4,$PIECE(DATA,U,6)
+32 WRITE !,?11,$PIECE(DATA,U,7),"/",$PIECE(DATA,U,8)
End DoDot:1
IF RCPG=0
QUIT
+33 ;
+34 IF 'RCSCR
WRITE !,@IOF
+35 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+36 DO ^%ZISC
+37 ;
+38 IF RCPG
IF RCSCR
DO PAUSE
+39 QUIT
+40 ;
+41 ; PRCA*4.5*380 - Added subroutine
REPORT2(RCDNUM,RCDDT,RCEXCEL) ; Output the report (new summary mode)
+1 ; Input: RCDNUM - Deposit Number
+2 ; RCDDT - Deposit Date
+3 ; RCEXCEL - 1 - Excel output, 0 otherwise
+4 ;
+5 NEW DATA,EFTIEN,GTOT,LINES,RCDBAL,RCDBAL2,RCDIEN,RCHR,RCNOW,RCPG,RCSCR
+6 ;
+7 ;I '$L($G(RCDBAL)) S RCDBAL=1 ; If called from code that doesn't use RCDBAL, set RCDBAL to 1 to default to a balanced deposit. PRCA*4.5*439
+8 ;
+9 ; Initialize Report Date, Page Number and String of underscores
+10 SET RCSCR=$SELECT($EXTRACT($GET(IOST),1,2)="C-":1,1:0)
+11 SET RCNOW=$$UP^XLFSTR($$NOW^RCDPRU(2))
SET RCPG=0
SET RCHR=""
SET $PIECE(RCHR,"-",IOM+1)=""
+12 ;
+13 SET RCDBAL=$$DEPBAL^RCDPTAR2(RCDNUM)
+14 ; Display header for first page
+15 USE IO
+16 ; Add parameter RCDBAL PRCA*4.5*439
DO HEADER(RCNOW,.RCPG,RCHR,"","",RCEXCEL,RCDNUM,RCDDT,RCDBAL)
+17 ;
+18 ; No data, display message and quit
+19 IF '$DATA(^TMP("RCDPTAR1",$JOB))
WRITE !,"No data found"
+20 ;
+21 ; Display the detail
+22 SET EFTIEN=0
SET GTOT=^TMP("RCDPTAR1",$JOB)
+23 FOR
SET EFTIEN=$ORDER(^TMP("RCDPTAR1",$JOB,EFTIEN))
if 'EFTIEN
QUIT
Begin DoDot:1
+24 SET DATA=^TMP("RCDPTAR1",$JOB,EFTIEN)
+25 SET LINES=$SELECT(RCEXCEL:1,1:3)
+26 IF RCSCR
SET LINES=LINES+1
+27 DO CHKP(RCNOW,.RCPG,RCHR,"","",RCEXCEL,RCSCR,LINES,RCDNUM,RCDDT)
+28 if RCPG=0
QUIT
+29 ;
+30 SET RCDIEN=$PIECE(DATA,U,10)
SET RCDBAL=$$DEPBAL^RCDPTAR2(RCDIEN)
SET RCDBAL2=$SELECT('RCDBAL:"UNBALANCED",1:"")
+31 ; If Excel, display as delimited and quit
+32 IF RCEXCEL
WRITE !,$PIECE(DATA,U,9),$$EFT(EFTIEN),U,RCDBAL2,U,DATA
QUIT
+33 ;
+34 ; Display non-Excel output
+35 WRITE !,$$EFT(EFTIEN),?13,$PIECE(DATA,U,1),?26,$PIECE(DATA,U,2)
+36 WRITE ?40,$PIECE(DATA,U,3),?55,$JUSTIFY($PIECE(DATA,U,4),13,2)
+37 ;W !,?4,$P(DATA,U,5)," ",RCDBAL2
+38 ; Remove unbalanced indicator at EFT level, PRCA*4.5*439
WRITE !,?4,$PIECE(DATA,U,5)
+39 WRITE !,?11,$PIECE(DATA,U,6),"/",$PIECE(DATA,U,7)
End DoDot:1
IF RCPG=0
QUIT
+40 ;
+41 IF 'RCEXCEL
IF RCPG
Begin DoDot:1
+42 WRITE !!,"Total for Deposit #: ",RCDNUM," Deposit Date: ",$$FMTE^XLFDT(RCDDT,"5DZ")
+43 ; Add coding to account for out-of-balance deposits ; PRCA*4.5*439
+44 IF RCDBAL
WRITE ?51,$JUSTIFY(GTOT,13,2)
QUIT
+45 WRITE ?55,$JUSTIFY($PIECE(RCDBAL,U,3),13,2)
+46 WRITE !,"Sum of EFT Amounts : **UNBALANCED**",?55,$JUSTIFY($PIECE(RCDBAL,U,2),13,2)
End DoDot:1
+47 IF 'RCSCR
WRITE !,@IOF
+48 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+49 DO ^%ZISC
+50 ;
+51 IF RCPG
IF RCSCR
DO PAUSE
+52 QUIT
+53 ;
+54 ; PRCA*4.5*380 - Added deposit number & deposit date
+1 ; Input: RCNOW - External Run Date/Time
+2 ; RCPG - Current page number
+3 ; RCHR - Dashed line
+4 ; RCDT1 - Start Date or null if new summary report
+5 ; RCDT2 - End Date or null if new summary report
+6 ; RCEXCEL - 1 - Excel output, 0 otherwise
+7 ; RCDNUM - Deposit Number or null if original summary report
+8 ; RCDDT - Internal Deposit Date or null if original summary report
+9 ; RCDBAL - Piece 1: 1 if deposit is in balance, 0 otherwise ; Add parameter PRCA*4.5*439
+10 ; Piece 2: Total of EFTs on the deposit
+11 ; Piece 3: Deposit Total
+12 ;
+13 ; Output: RCPG - Updated page number
+14 ;
+15 WRITE @IOF
+16 ;
+17 ; If called from code that doesn't use RCDBAL, set RCDBAL to 1 to default to a balanced deposit. PRCA*4.5*439
IF '$LENGTH($GET(RCDBAL))
SET RCDBAL=1
+18 ;
+19 ; If Excel, print column headers separated with up-arrows and quit
+20 IF $GET(RCEXCEL)
Begin DoDot:1
+21 ; PRCA*4.5*380 - New header for Dep. Num/Date report
+22 ; PRCA*4.5*439 - Add UNBALANCED to Excel header
+23 IF RCDT1'=""
Begin DoDot:2
+24 WRITE !,"EFT#^UNBALANCED^DATE RECEIVED^DEPOSIT#^EFT TOTAL AMT^DATE MATCHED^DATE POSTED^TRACE #^PAYER NAME^PAYER ID"
End DoDot:2
+25 IF '$TEST
Begin DoDot:2
+26 WRITE !,"EFT#^UNBALANCED^DEPOSIT#^DEPOSIT DATE^DATE RECEIVED^EFT TOTAL AMT^TRACE #^PAYER NAME^PAYER ID"
End DoDot:2
+27 SET RCPG=1
End DoDot:1
QUIT
+28 ;
+29 ; Non-Excel Header
+30 NEW LINE
+31 SET RCPG=RCPG+1
+32 SET LINE="EFT TRANSACTION AUDIT REPORT - SUMMARY Page: "_RCPG
+33 WRITE !?(IOM-$LENGTH(LINE)\2),LINE
+34 SET LINE="RUN DATE: "_RCNOW
+35 WRITE !?(IOM-$LENGTH(LINE)\2),LINE
+36 ; PRCA*4.5*380 - New header for Dep. Num/Date report
+37 IF RCDT1'=""
Begin DoDot:1
+38 SET LINE="DATE RANGE: "_$$DATE^RCDPRU(RCDT1,"2D")_" - "_$$DATE^RCDPRU(RCDT2,"2D")_" (DATE DEPOSIT ADDED)"
+39 WRITE !?(IOM-$LENGTH(LINE)\2),LINE
+40 WRITE !!,"EFT#",?13,"DATE RECVD",?25,"DEPOSIT#",?37,"EFT TOTAL AMT",?54,"DATE MATCHED",?69,"DATE POSTED"
+41 WRITE !,?4,"TRACE #",!,?11,"PAYER NAME/ID"
+42 WRITE !,RCHR
End DoDot:1
QUIT
+43 ;
+44 ;Unbalance indicator PRCA*4.5*439
SET LINE="DEPOSIT #: "_RCDNUM_" Deposit Date "_$$DATE^RCDPRU(RCDDT,"2D")_$SELECT('RCDBAL:" **UNBALANCED**",1:"")
+45 IF RCDNUM'=""
Begin DoDot:1
+46 WRITE !?(IOM-$LENGTH(LINE)\2),LINE
+47 WRITE !!,"EFT#",?13,"DEPOSIT#",?26,"DEPOSIT DATE",?40,"DATE RECEIVED",?55,"EFT TOTAL AMT"
+48 WRITE !,?4,"TRACE #",!,?11,"PAYER NAME/ID"
+49 WRITE !,RCHR
End DoDot:1
+50 ; end PRCA*4.5*380 changes
+51 QUIT
+52 ;
EXMSG ;
+1 ;Displays the message about capturing to an Excel file format
+2 ;
+3 WRITE !!?5,"To capture as an Excel format, it is recommended that you queue this"
+4 WRITE !?5,"report to a spool device with margins of 256 and page length of 99999"
+5 WRITE !?5,"(e.g. spoolname;256;99999). This should help avoid wrapping problems."
+6 WRITE !!?5,"Another method would be to set up your terminal to capture the detail"
+7 WRITE !?5,"report data. On some terminals, this can be done by clicking on the"
+8 WRITE !?5,"'Tools' menu above, then click on 'Capture Incoming Data' to save to"
+9 WRITE !?5,"Desktop. To avoid undesired wrapping of the data saved to the file,"
+10 WRITE !?5,"please enter '0;256;99999' at the 'DEVICE:' prompt.",!
+11 QUIT
+12 ;
PAUSE() ; Display press return to continue message
+1 NEW DIR,X,Y,DTOUT,DUOUT,DIROUT,DIRUT
+2 SET DIR(0)="E"
+3 DO ^DIR
+4 QUIT Y
+5 ;
+6 ; PRCA*4.5*380 - Add deposit number/date to header
CHKP(RCNOW,RCPG,RCHR,RCDT1,RCDT2,RCEXCEL,RCSCR,LINES,RCDNUM,RCDDT) ; Check if we need to do a page break
+1 ; Input: RCNOW - Run date/time
+2 ; RCPG - Current Page Number
+3 ; RCHR - Dashed line
+4 ; RCDT1 - Start Date or null if new summary report
+5 ; RCDT2 - End Date or null if new summary report
+6 ; RCEXCEL - 1 if output to Excel, 0 otherwise
+7 ; RSCR - 1 output to screen, otherwise output to paper
+8 ; LINES - Current # of lines on the page
+9 ; RCDNUM - Deposit Number or null if original summary report
+10 ; RCDDT - Deposit Date or null if original summary report
+11 ; Output: RCPG - New Page Number or 0 if user quit display
+12 ;
+13 IF $Y'>(IOSL-LINES)
QUIT
+14 IF RCSCR
IF '$$PAUSE
SET RCPG=0
QUIT
+15 DO HEADER(RCNOW,.RCPG,RCHR,RCDT1,RCDT2,RCEXCEL,RCDNUM,RCDDT)
+16 QUIT
+17 ;
EFT(EFTIEN) ; Format EFT output - EFT.SEQ - PRCA*4.5*326
+1 ; Input: EFTIEN - Internal EFT number
+2 ; Returns: EFT.Sequence #
+3 QUIT $$GET1^DIQ(344.31,EFTIEN_",",.01,"E")
+4 ;
DEPEFTS(RCDNUM,RCDDT,RCEFTCNT) ; List EFTs for a given deposit number and date. Added for PRCA*4.5*439
+1 ; Input - RCDNUM - Deposit #
+2 ; RCDDT - Deposit Date
+3 ; Output - Return value LIST(Y) containing data of selected EFT
+4 ; RCEFTCNT - Count of EFTs passed by reference
+5 ;
+6 NEW EFTIEN,CNT,DATA,J,LIST,RCBAL,RCDBAL,RCDBAL1,RCDIEN,Y
+7 ;
+8 SET (CNT,RCDIEN,RCDBAL)=0
+9 FOR
Begin DoDot:1
+10 SET RCDIEN=$ORDER(^RCY(344.3,"ADEP2",RCDNUM,RCDDT,RCDIEN))
+11 IF RCDIEN=""
QUIT
+12 SET RCDBAL1=$$DEPBAL^RCDPTAR2(RCDIEN)
+13 FOR J=2:1:3
SET $PIECE(RCDBAL,U,J)=$PIECE(RCDBAL1,U,J)+$PIECE(RCDBAL,U,J)
+14 SET EFTIEN=""
+15 FOR
Begin DoDot:2
+16 SET EFTIEN=$ORDER(^RCY(344.31,"B",RCDIEN,EFTIEN))
+17 if 'EFTIEN
QUIT
+18 SET DATA=$$EFTDATA^RCDPTAR(EFTIEN)
IF DATA]""
SET CNT=CNT+1
SET LIST(CNT)=DATA
End DoDot:2
if 'EFTIEN
QUIT
End DoDot:1
if RCDIEN=""
QUIT
+19 ;
+20 SET RCEFTCNT=CNT
+21 IF CNT=0
WRITE !!,"No EFT detail for this selection"
DO PAUSE
QUIT ""
+22 ;
+23 ; If only one EFT, select it and quit
+24 IF CNT=1
SET Y=1
GOTO EFT1
+25 ;
+26 ; Display list of EFTs. Manual display and reading so we can put data on two lines. PRCA*4.5*439
+27 NEW ROW,TRANS,X
+28 WRITE !!,"Deposit #: "_$JUSTIFY($$GET1^DIQ(344.3,LOCKIEN_",",.06),10)_" "
+29 WRITE "Deposit Date: "_$$DATE^RCDPRU(RCDDT,"2DZ")
+30 ; Deposit Total
WRITE $JUSTIFY($PIECE(RCDBAL,U,3),19,2)
+31 ;I '($P(RCDBAL,U,2)=$P(RCDBAL,U,3)) W " **UNBALANCED**" ; Remove unbalanced indicator at EFT level
+32 ; PRCA*4.5*439
NEW LCNT,QUIT
+33 SET LCNT=0
SET QUIT=0
SET Y=-1
+34 FOR ROW=1:1:CNT
Begin DoDot:1
+35 SET DATA=LIST(ROW)
SET EFTIEN=$PIECE(DATA,U,3)
+36 DO DISPLAY^RCDPTAR(ROW,EFTIEN)
+37 ;I ROW#5=0!(ROW=CNT) D I Y>0!(Y=-1) S QUIT=1 Q ;
End DoDot:1
if QUIT
QUIT
+38 SET Y=$$READ^RCDPTAR(1,ROW,CNT)
+39 IF Y'>0
QUIT 0
+40 ;
EFT1 ;
+1 QUIT LIST(Y)
