RCDPTAR1.m

RCDPTAR1 ;ALB/DMB - EFT TRANSACTION AUDIT REPORT (Summary) ;08/19/15

 ;;4.5;Accounts Receivable;**303,326,380,409,424**;Mar 20, 1995;Build 11

 ;;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 RCDDT,RCDNUM,RCDT1,RCDT2,RCEXCEL,RCSTOP,X,XX,Y     ; PRCA*4.5*409 - Added RCSTOP

 S RCDNUM=$$ASKDNUM()

 Q:RCDNUM=-1

 S CTR=0,RCDDT="",CDDT="",RCSTOP=0              ; PRCA*4.5*409 - Added RCSTOP=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)                  ; Final selection choice

 . . I RCDDT=-1 S RCSTOP=1                      ; PRCA*4.5*409 - Added line

 . S CTR=CTR+1,ARR(CTR)=CDDT

 . S XX=$$FMTE^XLFDT(CDDT,"5DZ")

 . W !,$J(CTR,3)," ",RCDNUM," on: ",XX

 . I CTR#10=0 D  Q:RCDDT'=""                    ; Ask selection every 10 times

 . . S RCDDT=$$SELDT(CTR,.ARR)

 . . I RCDDT=-1 S RCSTOP=1                      ; PRCA*4.5*409 - Added line

 Q:RCDDT=""  Q:RCSTOP                           ; No Deposit Date selected, PRCA*4.5*409 - Added Q:RCSTOP

 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) ; 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

 ; 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^1:"_CTR_":0",DIR("A")="CHOOSE 1 - "_CTR_": "

 S DIR("?")="Select a number between 1 and "_CTR

 D ^DIR

 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

 ;

 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($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)

 ;

 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")

 ;

 ; 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 ^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,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

 . ; If Excel, display as delimited and quit

 . I RCEXCEL W !,$P(DATA,U,9),$$EFT(EFTIEN),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)

 . 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,RCHR,RCNOW,RCPG,RCSCR

 ;

 ; 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)=""

 ;

 ; Display header for first page

 U IO

 D HEADER(RCNOW,.RCPG,RCHR,"","",RCEXCEL,RCDNUM,RCDDT)

 ;

 ; 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

 . ;

 . ; If Excel, display as delimited and quit

 . I RCEXCEL W !,$$EFT(EFTIEN),"^",DATA Q

 . ;

 . ; Display non-Excel output

 . W !,$$EFT(EFTIEN),?13,$P(DATA,"^",1),?26,$P(DATA,"^",2)

 . W ?40,$P(DATA,"^",3),?55,$J($P(DATA,"^",4),13,2)

 . W !,?4,$P(DATA,"^",5)

 . W !,?11,$P(DATA,"^",6),"/",$P(DATA,"^",7)

 ;

 I 'RCEXCEL,RCPG D

 . W !!,"Total for Deposit #: ",RCDNUM," Deposit Date: ",$$FMTE^XLFDT(RCDDT,"5DZ")

 . W ?51,$J(GTOT,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

HEADER(RCNOW,RCPG,RCHR,RCDT1,RCDT2,RCEXCEL,RCDNUM,RCDDT) ; Display the report header

 ; 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

 ; Output:  RCPG    - Updated page number

 ;

 W @IOF

 ;

 ; 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

 . I RCDT1'="" D

 . . W !,"EFT#^DATE RECEIVED^DEPOSIT#^EFT TOTAL AMT^DATE MATCHED^DATE POSTED^TRACE #^PAYER NAME^PAYER ID"

 . E  D

 . . W !,"EFT#^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")

 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")

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---RCDPTAR1   15907     printed  Apr 23, 2025@18:00:58                                                                                                                                                                                                   Page 2

RCDPTAR1  ;ALB/DMB - EFT TRANSACTION AUDIT REPORT (Summary) ;08/19/15

 +1       ;;4.5;Accounts Receivable;**303,326,380,409,424**;Mar 20, 1995;Build 11

 +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

           NEW RCDDT,RCDNUM,RCDT1,RCDT2,RCEXCEL,RCSTOP,X,XX,Y

 +4        SET RCDNUM=$$ASKDNUM()

 +5        if RCDNUM=-1

               QUIT 

 +6       ; PRCA*4.5*409 - Added RCSTOP=0

           SET CTR=0

           SET RCDDT=""

           SET CDDT=""

           SET RCSTOP=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

                           SET RCDDT=$$SELDT(CTR,.ARR)

 +13      ; PRCA*4.5*409 - Added line

                           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      ; Ask selection every 10 times

                   IF CTR#10=0

                       Begin DoDot:2

 +18                       SET RCDDT=$$SELDT(CTR,.ARR)

 +19      ; PRCA*4.5*409 - Added line

                           IF RCDDT=-1

                               SET RCSTOP=1

                       End DoDot:2

                       if RCDDT'=""

                           QUIT 

               End DoDot:1

               if RCDDT'=""

                   QUIT 

               if RCSTOP

                   QUIT 

 +20      ; No Deposit Date selected, PRCA*4.5*409 - Added Q:RCSTOP

           if RCDDT=""

               QUIT 

           if RCSTOP

               QUIT 

 +21      ; Ask Excel output

           SET RCEXCEL=$$EXCEL^RCDMCUT2()

 +22       if RCEXCEL="^"

               QUIT 

 +23       IF RCEXCEL

               DO EXMSG

 +24      ;

 +25      ; Prompt for device

           if $$ASKDEV(0)=-1

               QUIT 

 +26       USE IO

 +27      ; Output the report

           DO RUN2(RCDNUM,RCDDT,RCEXCEL)

 +28       QUIT 

 +29      ;

 +30      ; 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) ; 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       ; Returns: ""  - Nothing selected, Otherwise selected deposit date is returned

 +6       ;                -1 if user '^' or timed out

 +7        NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y

 +8        SET DIR(0)="NA^1:"_CTR_":0"

           SET DIR("A")="CHOOSE 1 - "_CTR_": "

 +9        SET DIR("?")="Select a number between 1 and "_CTR

 +10       DO ^DIR

 +11      ; PRCA*4.5*409 Added line

           IF $GET(DTOUT)!$GET(DUOUT)!(Y=-1)

               QUIT -1

 +12       QUIT $SELECT($DATA(DIRUT):"",1:ARR(Y))

 +13      ; 

 +14      ; 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       ; Compile the report

           DO COMPILE2(RCDNUM,RCDDT)

 +6       ;

 +7       ; Display the report

           DO REPORT2(RCDNUM,RCDDT,RCEXCEL)

 +8        KILL ^TMP("RCDPTAR1",$JOB)

 +9        QUIT 

 +10      ;

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($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)

                               End DoDot:3

                               if 'EFTIEN

                                   QUIT 

                       End DoDot:2

                       if 'LOCKIEN

                           QUIT 

               End DoDot:1

               if 'RCDT!(RCDT>RCDT2)

                   QUIT 

 +35      ;

 +36       QUIT 

 +37      ;

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      ;

 +23      ; 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)