- 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 Jan 18, 2025@02:45:52 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 ;