RCDPEFTL ;EDE/FA - LIST LOCKED EFT REPORT ;18 July 2018 11:19:25
;;4.5;Accounts Receivable;**332**;Mar 20, 1995;Build 40
;Per VA Directive 6402, this routine should not be modified.
;
EN ; Entry from RCDPE EFT OVERRIDE REPORT option
N RCINPT,RCVAL
K ^TMP("RCDPE_EFTL",$J)
;
; Warn if override set today or not
S RCVAL("OverRide")=+$$GET1^DIQ(344.61,1,20,"I") ; (#20) MEDICAL EFT OVERRIDE [1D]
W !,"Medical Override "_$S($P(RCVAL("OverRide"),".")=DT:"",1:"not ")_"active for today's date"
;
S RCVAL("EFTPostLimit")=+$$GET1^DIQ(344.61,1,.06) ; (#.06) MEDICAL EFT POST PREVENT DAYS [6N]
S RCVAL("CutoffDate")=$$FMADD^XLFDT(DT,-RCVAL("EFTPostLimit")) ; Today's date less post prevent days
W !,"Aged EFT days before Medical posting prevented = "_RCVAL("EFTPostLimit"),!
;
; Check if any medical unposted EFTs exist with aged days greater than site parameter value
S RCVAL("1stEFTDate")=$$GETFRST(RCVAL("EFTPostLimit"),RCVAL("CutoffDate"))
;
; If none stop
I 'RCVAL("1stEFTDate") D Q
. N DIR
. S DIR(0)="EA"
. S DIR("A",1)="The system does not have any aged, unposted EFTs."
. S DIR("A",2)=" "
. S DIR("A")="Press ENTER to continue: "
. D ^DIR
;
; report parameters
S RCINPT("DateRange")=RCVAL("1stEFTDate")_":"_RCVAL("CutoffDate") ; Start Date:End date
S RCINPT("2Excel?")=$$ASKXCEL ; Ask to output to Excel
Q:RCINPT("2Excel?")=-1 ; '^' or timeout
D:RCINPT("2Excel?")=1 INFO^RCDPEM6 ; Display capture information for Excel
S RCINPT("DeviceSelected?")=$$DEVICE(RCINPT("2Excel?")) ; Ask output device
Q:'RCINPT("DeviceSelected?") ; '^' or timeout (POP from %ZIS call)
; done with user questions
S RCINPT("AgedDays")=RCVAL("EFTPostLimit") ; allowed aged days for report
S RCINPT("1stEFT")=RCVAL("1stEFTDate") ; first EFT date for report
; Medical EFT Override parameters
S RCINPT(344.61,20)=$$GET1^DIQ(344.61,1_",",20,"E") ; (#20) MEDICAL EFT OVERRIDE [1D]
S RCINPT(344.61,22)=$$GET1^DIQ(344.61,1_",",22,"E") ; (#22) USER - MEDICAL OVERRIDE [3P:200]
S RCINPT(344.61,24)=$$GET1^DIQ(344.61,1_",",24,"E") ; (#24) COMMENT - MEDICAL OVERRIDE [5F]
; Queue output
I $D(IO("Q")) D D HOME^%ZIS Q
. N ZTDESC,ZTRTN,ZTSAVE,ZTSK
. S ZTRTN="REPORT^RCDPEFTL(.RCINPT)",ZTDESC="RCDPE EFT OVERRIDE REPORT"
. S ZTSAVE("RC*")="",ZTSAVE("IO*")="" D ^%ZTLOAD
. W !!,$S($D(ZTSK):"Task number "_ZTSK_" was queued.",1:"Unable to queue this task.")
. K IO("Q")
;
D REPORT(.RCINPT)
Q
;
REPORT(RCINPT) ; entry point from TaskMan and above
D RPTCOMP(.RCINPT) ; Compile report
D RPTOUT(.RCINPT) ; Output report
I '$D(ZTQUEUED) D ^%ZISC ;if not queued Close device
I $D(ZTQUEUED) S ZTREQ="@"
K ^TMP("RCDPE_EFTL",$J)
K ZTQUEUED
Q
;
RPTCOMP(RCINPT) ; Full EFT scan to compile report
; Input:
; RCINPT("DateRange")= Report start date:Report end date
; Output:
; ^TMP("RCDPE_EFTL",$J) - compilation of report data
;
N END,RCEFT,RECVDT
; RCEFT - array for EFT data, counter, IEN
;
; Initialize report
K ^TMP("RCDPE_EFTL",$J)
S RCEFT("Count")=0,^TMP("RCDPE_EFTL",$J,"EFT count")=0,^TMP("RCDPE_EFTL",$J,"Total Amt")=0
S RECVDT=$P(RCINPT("DateRange"),":")-.1 ; start date minus fraction
S END=$P(RCINPT("DateRange"),":",2) ; report ending date range
; File #344.31 Traditional Cross-Reference: "ADR", REGULAR Field: DATE RECEIVED (344.31,.13)
; Scan EFT received date index for days
F S RECVDT=$O(^RCY(344.31,"ADR",RECVDT)) Q:'RECVDT Q:RECVDT>END D
. S RCEFT("IEN")=""
. ; Scan individual EFTs
. F S RCEFT("IEN")=$O(^RCY(344.31,"ADR",RECVDT,RCEFT("IEN"))) Q:'RCEFT("IEN") D
.. ; Check this is a valid EFT type
.. Q:'$$VALID(RCEFT("IEN"))
.. ; calculate aged number of days of the EFT
.. S RCEFT("DaysAged")=$$FMDIFF^XLFDT(DT,RECVDT) ; get aged number of days of the EFT
.. Q:RCEFT("DaysAged")'>RCVAL("EFTPostLimit") ; Ignore Unposted EFT younger than aged days maximum
.. S RCEFT("Trace#")=$$GET1^DIQ(344.31,RCEFT("IEN"),.04) ;(#.04) TRACE # [4F]
.. S RCEFT("MatchStatus")=$$GET1^DIQ(344.31,RCEFT("IEN"),.08,"E") ;(#.08) MATCH STATUS [8S]
.. S RCEFT("Trans#")=$$GET1^DIQ(344.31,RCEFT("IEN"),.01,"E") ;(#.01) EFT TRANSACTION [1P:344.3]
.. S RCEFT("ERARecord")=$$GET1^DIQ(344.31,RCEFT("IEN"),.1) ;(#.1) ERA RECORD [10P:344.4]
.. S:RCEFT("ERARecord")="" RCEFT("ERARecord")="None"
.. S RCEFT("Amount")=$$GET1^DIQ(344.31,RCEFT("IEN"),.07) ;(#.07) AMOUNT OF PAYMENT [7N]
.. ; Save EFT detail and update totals for report
.. S RCEFT("Count")=RCEFT("Count")+1
.. S ^TMP("RCDPE_EFTL",$J,RCEFT("Count"))=RCEFT("Trans#")_U_RCEFT("MatchStatus")_U_RCEFT("DaysAged")_U_RCEFT("ERARecord")_U_RECVDT_U_RCEFT("Amount")_U_RCEFT("Trace#")
.. S ^TMP("RCDPE_EFTL",$J,"EFT count")=RCEFT("Count")
.. S ^TMP("RCDPE_EFTL",$J,"Total Amt")=^TMP("RCDPE_EFTL",$J,"Total Amt")+RCEFT("Amount")
;
Q
;
RPTOUT(RCINPT) ; Output the report to paper/screen or excel
; Input: RCINPT
; Output: OUTPUT
N A,B,DATA,RCRPRT
; RCRPRT - array used for report
S RCRPRT("LineCount")=0,RCRPRT("Page")=1 ; Initialize Line/Page counters
S RCRPRT("RunDate")=$$FMTE^XLFDT($$NOW^XLFDT)
S RCRPRT("ExcelFrmt?")=RCINPT("2Excel?")
S RCRPRT("Exit")=0,RCRPRT("ListCntr")=0
; create lines 2-4 in the header
S RCRPRT("HeaderLine",2)="Sorted by Aged Days, Comment: "_$S(RCINPT(344.61,24)]"":RCINPT(344.61,24),1:"None")
; place user's name on the right edge of line 3
S A="Medical Override Date: "_$S(RCINPT(344.61,20)]"":RCINPT(344.61,20),1:"None"),B=" User: "_$S(RCINPT(344.61,22)]"":RCINPT(344.61,22),1:"None"),$E(A,IOM-$L(B)+1,IOM)=B
S RCRPRT("HeaderLine",3)=A
S RCRPRT("HeaderLine",4)="Number of Days (Age) of Unposted EFTs to prevent posting: "_$$GET1^DIQ(344.61,1,.06)
S RCRPRT("HeaderBorder")=$TR($J(" ",IOM-1)," ","=") ; row of equal signs for border
I RCRPRT("ExcelFrmt?") W !,"EFT^Match Status^Aged Days^ERA #^Date Received^Amount^Trace #"
I 'RCRPRT("ExcelFrmt?") D RPTHDR(.RCRPRT),RPTTOT S RCRPRT("LineCount")=11
;
F S RCRPRT("ListCntr")=$O(^TMP("RCDPE_EFTL",$J,RCRPRT("ListCntr"))) Q:'RCRPRT("ListCntr") D Q:RCRPRT("Exit")
. S DATA=$G(^TMP("RCDPE_EFTL",$J,RCRPRT("ListCntr")))
. ; Output lines for one EFT
. S RCRPRT("Exit")=$$RPRT1EFT(DATA,.RCRPRT)
;
I 'RCRPRT("ExcelFrmt?") W:'RCRPRT("Exit") !,RCRPRT("HeaderBorder"),!,$$ENDORPRT^RCDPEARL
I RCRPRT("ExcelFrmt?"),$E(IOST,1,2)="C-" D ; if Excel format and user terminal, pause
. N DIR S DIR(0)="EA",DIR("A")="Press ENTER to continue: ",DIR("A",1)=" " D ^DIR
Q
;
RPRT1EFT(DATA,RCRPRT) ; boolean function, Output one EFT record
; Input:
; DATA - EFT to write, See REPORT for a complete description
; RCRPRT("ExcelFrmt?"): zero - formatted Output to Screen /printer
; 1 - Output in Excel format
; RCRPRT("LineCount") - Line Count
; RCRPRT("Page") - Page Count
; Output:
; RCRPRT("LineCount") - Updated Line Count
; RCRPRT("Page") - Updated Page Count
; Returns:
; 1 if user indicates to quit, 0 otherwise
N STOP
I RCRPRT("ExcelFrmt?") D Q 0 ; Excel output, format date received, write record and quit
. N X,Y S Y=DATA,X=$$FMTE^XLFDT($P(DATA,U,5),"5DZ"),$P(Y,U,5)=X
. S RCRPRT("LineCount")=RCRPRT("LineCount")+1 W !,Y
; screen /printer output
S STOP=0 ; stop output flag
I $E(IOST,1,2)="C-",'(RCRPRT("LineCount")+3<IOSL) D ; bottom of screen logic, must be "C-" device subtype
. S STOP=$$PGEND Q:STOP
. S RCRPRT("Page")=RCRPRT("Page")+1 D RPTHDR(.RCRPRT) S RCRPRT("LineCount")=8
;
Q:STOP 1 ; user indicated to stop
S RCRPRT("LineCount")=RCRPRT("LineCount")+3
W !,$$PAD($P(DATA,U),9)_$P(DATA,U,7) ; EFT number & Trace #
; ; ERA number, Match Status, EFT Received Date, Aged Days, Amount
W !,$$PAD(" "_$P(DATA,U,4),10)_$$PAD($P(DATA,U,2),20)_$$PAD($$FMTE^XLFDT($P(DATA,U,5)),15)_$$PAD($P(DATA,U,3),10)_"$"_$FN($P(DATA,U,6),",",2),!
;
Q 0 ; return false, continue writing report
;
RPTHDR(RCRPRT) ; report header, line 1 is dynamic
N A,B
S A="Pending EFT Override Report - Page "_RCRPRT("Page")_" ",B=" Run Date: "_RCRPRT("RunDate"),$E(A,IOM-$L(B)+1,IOM)=B
W !,A,!,RCRPRT("HeaderLine",2),!,RCRPRT("HeaderLine",3),!,RCRPRT("HeaderLine",4)
W !!,"EFT Trace#",!," ERA Match Status EFT Received Aged Amount"
W !,RCRPRT("HeaderBorder")
Q
;
RPTTOT ; Display report totals
W !,"Total Number of Unposted EFTs: "_$G(^TMP("RCDPE_EFTL",$J,"EFT count"))
W !,"Total Amount of Unposted EFTs: $"_$FN($G(^TMP("RCDPE_EFTL",$J,"Total Amt")),",",2)
W !,RCRPRT("HeaderBorder")
Q
;
PGEND() ; boolean function, end-of-page, Ask to continue
; Input: IOST - Device Type
; Returns: 1 - User wants to quit, 0 otherwise
Q:'($E(IOST,1,2)="C-") 0 ; Not a terminal
N DIR,DIROUT,DIRUT,DTOUT,DUOUT
S DIR(0)="EA",DIR("A")="Press ENTER to continue, '^' to exit: " D ^DIR
I ($D(DIRUT))!($D(DUOUT)) Q 1 ; user entered '^' or timeout
Q 0
;
DEVICE(EXCEL) ; boolean function to Select output device
; Input: EXCEL - 1 - Ouput in Excel format, 0 otherwise
; Output: IO,IOST arrays in symbol table
; Returns:
; 0 - No device selected, 1 otherwise
N %ZIS,POP S %ZIS="QM" D ^%ZIS
Q 'POP ; return "not POP"
;
ASKXCEL() ; Ask user to export to Excel
; Input: None
; Returns: -1 - User up-arrowed or timed out
; zero - Output to selected device
; 1 - Output to Excel
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="Y"
S DIR("A")="List the report in Microsoft Excel format"
S DIR("B")="NO"
S DIR("?")="Enter 'YES' to output in Excel format. Otherwise enter 'NO'"
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q -1
Q Y
;
GETFRST(LIMIT,END) ; scan for first EFT
; Input:
; LIMIT - Maximum days before aged UNPOSTED EFT lock the ERA worklist
; END - Today's date less LIMIT
; Output
; RET - Date of first 'lock' EFT or zero if none found
;
N AGED,EFTDA,RECVDT,RET
;
S RET=0,RECVDT=$$CUTOFF^RCDPEWLP ; PRCA*4.5*298 install date less 60 days
; Scan EFT received date index for days
F S RECVDT=$O(^RCY(344.31,"ADR",RECVDT)) Q:'RECVDT Q:RECVDT>END Q:RET D
. S EFTDA=""
. ; Scan individual EFTs
. F S EFTDA=$O(^RCY(344.31,"ADR",RECVDT,EFTDA)) Q:'EFTDA D
.. ; Check this is a valid EFT type
.. Q:'$$VALID(EFTDA)
.. ; Calculate aged number of days of the EFT
.. S AGED=$$FMDIFF^XLFDT(DT,RECVDT)
.. ; Unposted EFT found older than aged days allowed
.. I AGED>LIMIT S RET=RECVDT
;
Q RET
;
VALID(EFTDA) ; Check if EFT is a valid candidate
; Ignore zero payment amts
Q:+$$GET1^DIQ(344.31,EFTDA,.07)=0 0
; Ignore duplicate EFTs which have been removed
Q:$$GET1^DIQ(344.31,EFTDA,.18)]"" 0
; ERA RECORD (344.31, .1) pointer to ERA record
S RCEFT("ERARecord")=$$GET1^DIQ(344.31,EFTDA,.1)
; DETAIL POST STATUS (344.4, .14); ignore posted ERA-EFTs
I RCEFT("ERARecord"),$$GET1^DIQ(344.4,RCEFT("ERARecord"),.14,"I")=1 Q 0
; Ignore EFT matched to Pharmacy ERA
I RCEFT("ERARecord"),$$PHARM^RCDPEWLP(RCEFT("ERARecord")) Q 0
; Exclude EFT matched to Paper EOB if receipt is processed
I 'RCEFT("ERARecord"),($$GET1^DIQ(344.31,EFTDA,.08,"I")=2) Q:$$PROC^RCDPEWLP(EFTDA) 0
; Otherwise valid
Q 1
;
PAD(A,N) ; pad A with spaces to length N
Q A_$J(" ",N-$L(A)) ; always add at least one trailing space
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEFTL 11259 printed Apr 09, 2024@20:51:04 Page 2
RCDPEFTL ;EDE/FA - LIST LOCKED EFT REPORT ;18 July 2018 11:19:25
+1 ;;4.5;Accounts Receivable;**332**;Mar 20, 1995;Build 40
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
EN ; Entry from RCDPE EFT OVERRIDE REPORT option
+1 NEW RCINPT,RCVAL
+2 KILL ^TMP("RCDPE_EFTL",$JOB)
+3 ;
+4 ; Warn if override set today or not
+5 ; (#20) MEDICAL EFT OVERRIDE [1D]
SET RCVAL("OverRide")=+$$GET1^DIQ(344.61,1,20,"I")
+6 WRITE !,"Medical Override "_$SELECT($PIECE(RCVAL("OverRide"),".")=DT:"",1:"not ")_"active for today's date"
+7 ;
+8 ; (#.06) MEDICAL EFT POST PREVENT DAYS [6N]
SET RCVAL("EFTPostLimit")=+$$GET1^DIQ(344.61,1,.06)
+9 ; Today's date less post prevent days
SET RCVAL("CutoffDate")=$$FMADD^XLFDT(DT,-RCVAL("EFTPostLimit"))
+10 WRITE !,"Aged EFT days before Medical posting prevented = "_RCVAL("EFTPostLimit"),!
+11 ;
+12 ; Check if any medical unposted EFTs exist with aged days greater than site parameter value
+13 SET RCVAL("1stEFTDate")=$$GETFRST(RCVAL("EFTPostLimit"),RCVAL("CutoffDate"))
+14 ;
+15 ; If none stop
+16 IF 'RCVAL("1stEFTDate")
Begin DoDot:1
+17 NEW DIR
+18 SET DIR(0)="EA"
+19 SET DIR("A",1)="The system does not have any aged, unposted EFTs."
+20 SET DIR("A",2)=" "
+21 SET DIR("A")="Press ENTER to continue: "
+22 DO ^DIR
End DoDot:1
QUIT
+23 ;
+24 ; report parameters
+25 ; Start Date:End date
SET RCINPT("DateRange")=RCVAL("1stEFTDate")_":"_RCVAL("CutoffDate")
+26 ; Ask to output to Excel
SET RCINPT("2Excel?")=$$ASKXCEL
+27 ; '^' or timeout
if RCINPT("2Excel?")=-1
QUIT
+28 ; Display capture information for Excel
if RCINPT("2Excel?")=1
DO INFO^RCDPEM6
+29 ; Ask output device
SET RCINPT("DeviceSelected?")=$$DEVICE(RCINPT("2Excel?"))
+30 ; '^' or timeout (POP from %ZIS call)
if 'RCINPT("DeviceSelected?")
QUIT
+31 ; done with user questions
+32 ; allowed aged days for report
SET RCINPT("AgedDays")=RCVAL("EFTPostLimit")
+33 ; first EFT date for report
SET RCINPT("1stEFT")=RCVAL("1stEFTDate")
+34 ; Medical EFT Override parameters
+35 ; (#20) MEDICAL EFT OVERRIDE [1D]
SET RCINPT(344.61,20)=$$GET1^DIQ(344.61,1_",",20,"E")
+36 ; (#22) USER - MEDICAL OVERRIDE [3P:200]
SET RCINPT(344.61,22)=$$GET1^DIQ(344.61,1_",",22,"E")
+37 ; (#24) COMMENT - MEDICAL OVERRIDE [5F]
SET RCINPT(344.61,24)=$$GET1^DIQ(344.61,1_",",24,"E")
+38 ; Queue output
+39 IF $DATA(IO("Q"))
Begin DoDot:1
+40 NEW ZTDESC,ZTRTN,ZTSAVE,ZTSK
+41 SET ZTRTN="REPORT^RCDPEFTL(.RCINPT)"
SET ZTDESC="RCDPE EFT OVERRIDE REPORT"
+42 SET ZTSAVE("RC*")=""
SET ZTSAVE("IO*")=""
DO ^%ZTLOAD
+43 WRITE !!,$SELECT($DATA(ZTSK):"Task number "_ZTSK_" was queued.",1:"Unable to queue this task.")
+44 KILL IO("Q")
End DoDot:1
DO HOME^%ZIS
QUIT
+45 ;
+46 DO REPORT(.RCINPT)
+47 QUIT
+48 ;
REPORT(RCINPT) ; entry point from TaskMan and above
+1 ; Compile report
DO RPTCOMP(.RCINPT)
+2 ; Output report
DO RPTOUT(.RCINPT)
+3 ;if not queued Close device
IF '$DATA(ZTQUEUED)
DO ^%ZISC
+4 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+5 KILL ^TMP("RCDPE_EFTL",$JOB)
+6 KILL ZTQUEUED
+7 QUIT
+8 ;
RPTCOMP(RCINPT) ; Full EFT scan to compile report
+1 ; Input:
+2 ; RCINPT("DateRange")= Report start date:Report end date
+3 ; Output:
+4 ; ^TMP("RCDPE_EFTL",$J) - compilation of report data
+5 ;
+6 NEW END,RCEFT,RECVDT
+7 ; RCEFT - array for EFT data, counter, IEN
+8 ;
+9 ; Initialize report
+10 KILL ^TMP("RCDPE_EFTL",$JOB)
+11 SET RCEFT("Count")=0
SET ^TMP("RCDPE_EFTL",$JOB,"EFT count")=0
SET ^TMP("RCDPE_EFTL",$JOB,"Total Amt")=0
+12 ; start date minus fraction
SET RECVDT=$PIECE(RCINPT("DateRange"),":")-.1
+13 ; report ending date range
SET END=$PIECE(RCINPT("DateRange"),":",2)
+14 ; File #344.31 Traditional Cross-Reference: "ADR", REGULAR Field: DATE RECEIVED (344.31,.13)
+15 ; Scan EFT received date index for days
+16 FOR
SET RECVDT=$ORDER(^RCY(344.31,"ADR",RECVDT))
if 'RECVDT
QUIT
if RECVDT>END
QUIT
Begin DoDot:1
+17 SET RCEFT("IEN")=""
+18 ; Scan individual EFTs
+19 FOR
SET RCEFT("IEN")=$ORDER(^RCY(344.31,"ADR",RECVDT,RCEFT("IEN")))
if 'RCEFT("IEN")
QUIT
Begin DoDot:2
+20 ; Check this is a valid EFT type
+21 if '$$VALID(RCEFT("IEN"))
QUIT
+22 ; calculate aged number of days of the EFT
+23 ; get aged number of days of the EFT
SET RCEFT("DaysAged")=$$FMDIFF^XLFDT(DT,RECVDT)
+24 ; Ignore Unposted EFT younger than aged days maximum
if RCEFT("DaysAged")'>RCVAL("EFTPostLimit")
QUIT
+25 ;(#.04) TRACE # [4F]
SET RCEFT("Trace#")=$$GET1^DIQ(344.31,RCEFT("IEN"),.04)
+26 ;(#.08) MATCH STATUS [8S]
SET RCEFT("MatchStatus")=$$GET1^DIQ(344.31,RCEFT("IEN"),.08,"E")
+27 ;(#.01) EFT TRANSACTION [1P:344.3]
SET RCEFT("Trans#")=$$GET1^DIQ(344.31,RCEFT("IEN"),.01,"E")
+28 ;(#.1) ERA RECORD [10P:344.4]
SET RCEFT("ERARecord")=$$GET1^DIQ(344.31,RCEFT("IEN"),.1)
+29 if RCEFT("ERARecord")=""
SET RCEFT("ERARecord")="None"
+30 ;(#.07) AMOUNT OF PAYMENT [7N]
SET RCEFT("Amount")=$$GET1^DIQ(344.31,RCEFT("IEN"),.07)
+31 ; Save EFT detail and update totals for report
+32 SET RCEFT("Count")=RCEFT("Count")+1
+33 SET ^TMP("RCDPE_EFTL",$JOB,RCEFT("Count"))=RCEFT("Trans#")_U_RCEFT("MatchStatus")_U_RCEFT("DaysAged")_U_RCEFT("ERARecord")_U_RECVDT_U_RCEFT("Amount")_U_RCEFT("Trace#")
+34 SET ^TMP("RCDPE_EFTL",$JOB,"EFT count")=RCEFT("Count")
+35 SET ^TMP("RCDPE_EFTL",$JOB,"Total Amt")=^TMP("RCDPE_EFTL",$JOB,"Total Amt")+RCEFT("Amount")
End DoDot:2
End DoDot:1
+36 ;
+37 QUIT
+38 ;
RPTOUT(RCINPT) ; Output the report to paper/screen or excel
+1 ; Input: RCINPT
+2 ; Output: OUTPUT
+3 NEW A,B,DATA,RCRPRT
+4 ; RCRPRT - array used for report
+5 ; Initialize Line/Page counters
SET RCRPRT("LineCount")=0
SET RCRPRT("Page")=1
+6 SET RCRPRT("RunDate")=$$FMTE^XLFDT($$NOW^XLFDT)
+7 SET RCRPRT("ExcelFrmt?")=RCINPT("2Excel?")
+8 SET RCRPRT("Exit")=0
SET RCRPRT("ListCntr")=0
+9 ; create lines 2-4 in the header
+10 SET RCRPRT("HeaderLine",2)="Sorted by Aged Days, Comment: "_$SELECT(RCINPT(344.61,24)]"":RCINPT(344.61,24),1:"None")
+11 ; place user's name on the right edge of line 3
+12 SET A="Medical Override Date: "_$SELECT(RCINPT(344.61,20)]"":RCINPT(344.61,20),1:"None")
SET B=" User: "_$SELECT(RCINPT(344.61,22)]"":RCINPT(344.61,22),1:"None")
SET $EXTRACT(A,IOM-$LENGTH(B)+1,IOM)=B
+13 SET RCRPRT("HeaderLine",3)=A
+14 SET RCRPRT("HeaderLine",4)="Number of Days (Age) of Unposted EFTs to prevent posting: "_$$GET1^DIQ(344.61,1,.06)
+15 ; row of equal signs for border
SET RCRPRT("HeaderBorder")=$TRANSLATE($JUSTIFY(" ",IOM-1)," ","=")
+16 IF RCRPRT("ExcelFrmt?")
WRITE !,"EFT^Match Status^Aged Days^ERA #^Date Received^Amount^Trace #"
+17 IF 'RCRPRT("ExcelFrmt?")
DO RPTHDR(.RCRPRT)
DO RPTTOT
SET RCRPRT("LineCount")=11
+18 ;
+19 FOR
SET RCRPRT("ListCntr")=$ORDER(^TMP("RCDPE_EFTL",$JOB,RCRPRT("ListCntr")))
if 'RCRPRT("ListCntr")
QUIT
Begin DoDot:1
+20 SET DATA=$GET(^TMP("RCDPE_EFTL",$JOB,RCRPRT("ListCntr")))
+21 ; Output lines for one EFT
+22 SET RCRPRT("Exit")=$$RPRT1EFT(DATA,.RCRPRT)
End DoDot:1
if RCRPRT("Exit")
QUIT
+23 ;
+24 IF 'RCRPRT("ExcelFrmt?")
if 'RCRPRT("Exit")
WRITE !,RCRPRT("HeaderBorder"),!,$$ENDORPRT^RCDPEARL
+25 ; if Excel format and user terminal, pause
IF RCRPRT("ExcelFrmt?")
IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:1
+26 NEW DIR
SET DIR(0)="EA"
SET DIR("A")="Press ENTER to continue: "
SET DIR("A",1)=" "
DO ^DIR
End DoDot:1
+27 QUIT
+28 ;
RPRT1EFT(DATA,RCRPRT) ; boolean function, Output one EFT record
+1 ; Input:
+2 ; DATA - EFT to write, See REPORT for a complete description
+3 ; RCRPRT("ExcelFrmt?"): zero - formatted Output to Screen /printer
+4 ; 1 - Output in Excel format
+5 ; RCRPRT("LineCount") - Line Count
+6 ; RCRPRT("Page") - Page Count
+7 ; Output:
+8 ; RCRPRT("LineCount") - Updated Line Count
+9 ; RCRPRT("Page") - Updated Page Count
+10 ; Returns:
+11 ; 1 if user indicates to quit, 0 otherwise
+12 NEW STOP
+13 ; Excel output, format date received, write record and quit
IF RCRPRT("ExcelFrmt?")
Begin DoDot:1
+14 NEW X,Y
SET Y=DATA
SET X=$$FMTE^XLFDT($PIECE(DATA,U,5),"5DZ")
SET $PIECE(Y,U,5)=X
+15 SET RCRPRT("LineCount")=RCRPRT("LineCount")+1
WRITE !,Y
End DoDot:1
QUIT 0
+16 ; screen /printer output
+17 ; stop output flag
SET STOP=0
+18 ; bottom of screen logic, must be "C-" device subtype
IF $EXTRACT(IOST,1,2)="C-"
IF '(RCRPRT("LineCount")+3<IOSL)
Begin DoDot:1
+19 SET STOP=$$PGEND
if STOP
QUIT
+20 SET RCRPRT("Page")=RCRPRT("Page")+1
DO RPTHDR(.RCRPRT)
SET RCRPRT("LineCount")=8
End DoDot:1
+21 ;
+22 ; user indicated to stop
if STOP
QUIT 1
+23 SET RCRPRT("LineCount")=RCRPRT("LineCount")+3
+24 ; EFT number & Trace #
WRITE !,$$PAD($PIECE(DATA,U),9)_$PIECE(DATA,U,7)
+25 ; ; ERA number, Match Status, EFT Received Date, Aged Days, Amount
+26 WRITE !,$$PAD(" "_$PIECE(DATA,U,4),10)_$$PAD($PIECE(DATA,U,2),20)_$$PAD($$FMTE^XLFDT($PIECE(DATA,U,5)),15)_$$PAD($PIECE(DATA,U,3),10)_"$"_$FNUMBER($PIECE(DATA,U,6),",",2),!
+27 ;
+28 ; return false, continue writing report
QUIT 0
+29 ;
RPTHDR(RCRPRT) ; report header, line 1 is dynamic
+1 NEW A,B
+2 SET A="Pending EFT Override Report - Page "_RCRPRT("Page")_" "
SET B=" Run Date: "_RCRPRT("RunDate")
SET $EXTRACT(A,IOM-$LENGTH(B)+1,IOM)=B
+3 WRITE !,A,!,RCRPRT("HeaderLine",2),!,RCRPRT("HeaderLine",3),!,RCRPRT("HeaderLine",4)
+4 WRITE !!,"EFT Trace#",!," ERA Match Status EFT Received Aged Amount"
+5 WRITE !,RCRPRT("HeaderBorder")
+6 QUIT
+7 ;
RPTTOT ; Display report totals
+1 WRITE !,"Total Number of Unposted EFTs: "_$GET(^TMP("RCDPE_EFTL",$JOB,"EFT count"))
+2 WRITE !,"Total Amount of Unposted EFTs: $"_$FNUMBER($GET(^TMP("RCDPE_EFTL",$JOB,"Total Amt")),",",2)
+3 WRITE !,RCRPRT("HeaderBorder")
+4 QUIT
+5 ;
PGEND() ; boolean function, end-of-page, Ask to continue
+1 ; Input: IOST - Device Type
+2 ; Returns: 1 - User wants to quit, 0 otherwise
+3 ; Not a terminal
if '($EXTRACT(IOST,1,2)="C-")
QUIT 0
+4 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT
+5 SET DIR(0)="EA"
SET DIR("A")="Press ENTER to continue, '^' to exit: "
DO ^DIR
+6 ; user entered '^' or timeout
IF ($DATA(DIRUT))!($DATA(DUOUT))
QUIT 1
+7 QUIT 0
+8 ;
DEVICE(EXCEL) ; boolean function to Select output device
+1 ; Input: EXCEL - 1 - Ouput in Excel format, 0 otherwise
+2 ; Output: IO,IOST arrays in symbol table
+3 ; Returns:
+4 ; 0 - No device selected, 1 otherwise
+5 NEW %ZIS,POP
SET %ZIS="QM"
DO ^%ZIS
+6 ; return "not POP"
QUIT 'POP
+7 ;
ASKXCEL() ; Ask user to export to Excel
+1 ; Input: None
+2 ; Returns: -1 - User up-arrowed or timed out
+3 ; zero - Output to selected device
+4 ; 1 - Output to Excel
+5 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+6 SET DIR(0)="Y"
+7 SET DIR("A")="List the report in Microsoft Excel format"
+8 SET DIR("B")="NO"
+9 SET DIR("?")="Enter 'YES' to output in Excel format. Otherwise enter 'NO'"
+10 DO ^DIR
+11 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT -1
+12 QUIT Y
+13 ;
GETFRST(LIMIT,END) ; scan for first EFT
+1 ; Input:
+2 ; LIMIT - Maximum days before aged UNPOSTED EFT lock the ERA worklist
+3 ; END - Today's date less LIMIT
+4 ; Output
+5 ; RET - Date of first 'lock' EFT or zero if none found
+6 ;
+7 NEW AGED,EFTDA,RECVDT,RET
+8 ;
+9 ; PRCA*4.5*298 install date less 60 days
SET RET=0
SET RECVDT=$$CUTOFF^RCDPEWLP
+10 ; Scan EFT received date index for days
+11 FOR
SET RECVDT=$ORDER(^RCY(344.31,"ADR",RECVDT))
if 'RECVDT
QUIT
if RECVDT>END
QUIT
if RET
QUIT
Begin DoDot:1
+12 SET EFTDA=""
+13 ; Scan individual EFTs
+14 FOR
SET EFTDA=$ORDER(^RCY(344.31,"ADR",RECVDT,EFTDA))
if 'EFTDA
QUIT
Begin DoDot:2
+15 ; Check this is a valid EFT type
+16 if '$$VALID(EFTDA)
QUIT
+17 ; Calculate aged number of days of the EFT
+18 SET AGED=$$FMDIFF^XLFDT(DT,RECVDT)
+19 ; Unposted EFT found older than aged days allowed
+20 IF AGED>LIMIT
SET RET=RECVDT
End DoDot:2
End DoDot:1
+21 ;
+22 QUIT RET
+23 ;
VALID(EFTDA) ; Check if EFT is a valid candidate
+1 ; Ignore zero payment amts
+2 if +$$GET1^DIQ(344.31,EFTDA,.07)=0
QUIT 0
+3 ; Ignore duplicate EFTs which have been removed
+4 if $$GET1^DIQ(344.31,EFTDA,.18)]""
QUIT 0
+5 ; ERA RECORD (344.31, .1) pointer to ERA record
+6 SET RCEFT("ERARecord")=$$GET1^DIQ(344.31,EFTDA,.1)
+7 ; DETAIL POST STATUS (344.4, .14); ignore posted ERA-EFTs
+8 IF RCEFT("ERARecord")
IF $$GET1^DIQ(344.4,RCEFT("ERARecord"),.14,"I")=1
QUIT 0
+9 ; Ignore EFT matched to Pharmacy ERA
+10 IF RCEFT("ERARecord")
IF $$PHARM^RCDPEWLP(RCEFT("ERARecord"))
QUIT 0
+11 ; Exclude EFT matched to Paper EOB if receipt is processed
+12 IF 'RCEFT("ERARecord")
IF ($$GET1^DIQ(344.31,EFTDA,.08,"I")=2)
if $$PROC^RCDPEWLP(EFTDA)
QUIT 0
+13 ; Otherwise valid
+14 QUIT 1
+15 ;
PAD(A,N) ; pad A with spaces to length N
+1 ; always add at least one trailing space
QUIT A_$JUSTIFY(" ",N-$LENGTH(A))
+2 ;
