Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCDPEFTL

RCDPEFTL.m

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