RCDPEM3 ;OIFO-BAYPINES/RBN - ERA AUDIT REPORT and return EFT function ;Jun 06, 2014@19:11:19
;;4.5;Accounts Receivable;**276,284,298,326,375,371**;Mar 20, 1995;Build 29
;Per VA Directive 6402, this routine should not be modified.
;
; General read access of IB EOB file #361.1 is allowed from AR (IA 4051)
; completely refactored for PRCA*4.5*298
Q
;
; PRCA*4.5*284 - Changed report name from 'Mark ERA returned to Payer' to 'Remove ERA from active worklist'
;
; Generates an audit report that displays all ERAs that have been removed from the worklist.
; The user can select filters with which to limit the number of ERAs displayed:
; Station/Division - Default is all
; Date Range - Default is all
; Start Date type - No default, P:Date removed from worklist, R:Date ERA Received, B:Both Dates
;
; INPUT:
; user is prompted for the Station/Division, Date/Time range, and start/end dates
;
; OUTPUT:
; report which displays removed ERAs, it contains:
; User's name - who performed the transaction
; Date/Time ERA received from the payer
; Date/Time ERA removed from worklist
; Free text reasons for returning the ERA to the payer
; ERA number
; Trace number
; Dollar amount of ERA
; Payer name
;
; Data taken from ELECTRONIC REMITTANCE ADVICE file (#344.4)
;
EN ; EP - Remove ERA from Active Worklist Audit Report [RCDPE REMOVED ERA AUDIT]
N %ZIS,I,POP,RCDISPTY,RCDIV,RCDTRNG,RCEND,RCHDR,RCLNCNT,RCLSTMGR,RCPGNUM,RCPG
N RCSSD,RCSTA,RCSTART,RCSTNO,RCSTOP,RCTMPND,RCTYPE,VAUTD,X,Y
;
S RCLSTMGR="" ; ListMan flag, set to '^' if sent to Excel
S RCTMPND="" ; If null, report lines not stored in ^TMP, written directly
S (RCSTOP,RCPG,RCLNCNT)=0 ; Initial values of zero
S RCPGNUM=0 ; Report page number
; PRCA*4.5*276 - Modify Header display
S RCDIV="ALL" ; Default to All divisions
S RCSSD=$$DTPRB^RCDPEM4()
I RCSSD=0 D EXIT Q
S RCDTRNG=$$DTRNG^RCDPEM4()
I 'RCDTRNG D EXIT Q
S RCSTART=$P(RCDTRNG,U,2),RCEND=$P(RCDTRNG,U,3)
; VAUTD=1 for 'ALL'
D DIVISION^VAUTOMA
Q:Y=-1
I 'VAUTD,($D(VAUTD)'=11) D EXIT Q
I VAUTD=0 D
. N C,J
. S (J,C)=0,RCDIV=""
. F S J=$O(VAUTD(J)) Q:'J S C=C+1,$P(RCDIV,", ",C)=VAUTD(J)
;
S RCTYPE=$$RTYPE^RCDPEU1("A") ;PRCA*4.5*326 M/P/T filter
I RCTYPE=-1 D EXIT Q
S RCDISPTY=$$DISPTY() ; Ask display type for Excel
I RCDISPTY<0 D EXIT Q
;
; Display Excel info, set ListMan flag to prevent question
I RCDISPTY D
. D INFO^RCDPEM6
. S RCLSTMGR="^"
;
; If not output to Excel ask for ListMan display, exit if timeout or '^' - PRCA*4.5*298
I RCLSTMGR="" D Q:RCLSTMGR<0
. S RCLSTMGR=$$ASKLM^RCDPEARL
. I RCLSTMGR<0 D EXIT Q
;
; Display in ListMan format and exit on return
I RCLSTMGR D Q
. S RCTMPND=$T(+0)_"^REMOVE ERA AUDIT"
. K ^TMP($J,RCTMPND) ; clean any residue
. D REPRT,DISP(RCDISPTY)
. N H,HDR,L,N
. S L=0
. S HDR("TITLE")=$$HDRNM
. F H=1:1:7 D ; Take first 7 lines of report header
. . I $D(RCHDR(H)) S L=H,HDR(H)=RCHDR(H)
. I $O(RCHDR(L)) D ; Any remaining header lines at top of report
. . S N=0,H=L
. . F S H=$O(RCHDR(H)) Q:'H S N=N+.001,^TMP($J,RCTMPND,N)=RCHDR(H)
. ;
. ; invoke ListMan
. D LMRPT^RCDPEARL(.HDR,$NA(^TMP($J,RCTMPND))) ; Generate ListMan display
. D EXIT
;
S %ZIS="QM"
D ^%ZIS
Q:POP
I $D(IO("Q")) D Q
. N ZTDESC,ZTRTN,ZTSAVE,ZTSK
. S ZTRTN="ENFRMQ^RCDPEM3"
. S ZTDESC=$$HDRNM
. S ZTSAVE("RC*")="",ZTSAVE("VAUTD")=""
. D ^%ZTLOAD
. W !!,$S($G(ZTSK):"Task number "_ZTSK_" queued.",1:"Unable to queue this task.")
. K IO("Q")
. D HOME^%ZIS
;
U IO
;
ENFRMQ ; entry point from queue
D REPRT
D DISP(RCDISPTY)
D EXIT
Q
;
DISPTY() ; Ask display/output type
; Input: None
; Returns: 0-Display, 1-MS Excel, -1=timeout or '^'
N DIR,DIRUT,DUOUT,X,Y
S DIR(0)="YA",DIR("A")="Export the report to Microsoft Excel? (Y/N): "
S DIR("B")="NO"
D ^DIR
I $D(DUOUT)!$D(DIRUT) S Y=-1
Q Y
;
ERASTA(ERAIEN) ; Returns "station name ^ station #" for an ERA
; Input: ERAIEN - IEN of the ERA
Q:'($G(ERAIEN)>0) "-1^" ; Must have valid IEN
N BILLPTR,ERAEOB,J,M,P,STAPTR,STNAM,STANMBR,Y
; ERAEOB - EOB corresponding to the ERA
; BILLPTR - pointer to Bill corresponding to the ERA
; STAPTR - IEN of the Station of the ERA
S STNAM="" ; Initial value
D
. ;^RCY(344.4,D0,1,D1,0)= (#.01) SEQUENCE # [1N] ^ (#.02) EOB DETAIL [2P:361.1]
. S J=0
. F S J=$O(^RCY(344.4,ERAIEN,1,J)) Q:'J!(STNAM'="") D
. . S M=^RCY(344.4,ERAIEN,1,J,0)
. . S ERAEOB=0,P=+$P(M,U,2)
. . I P>0,$D(^IBM(361.1,P,0)) S Y=$G(^IBM(361.1,P,0)),ERAEOB=P
. . Q:'ERAEOB ; Pointer to ^IBM(361.1,0) = EXPLANATION OF BENEFITS^361.1
. . S BILLPTR=$P(Y,U,1)
. . Q:'(BILLPTR>0)
. . ;
. . ; ^DGCR(399,0) = BILL/CLAIMS^399
. . S STAPTR=$P($G(^DGCR(399,BILLPTR,0)),U,22)
. . Q:'(STAPTR>0)
. . ;
. . ; ^DG(40.8,0) = MEDICAL CENTER DIVISION^40.8
. . S STNAM=$$GET1^DIQ(40.8,STAPTR_",",.01,"","","RCDIERR") ; 40.8,.01 = NAME
. . Q:STNAM=""
. . S STANMBR=$P(^DG(40.8,STAPTR,0),U,2) ; IA 417
;
S:STNAM="" STNAM="STATION UNKNOWN",STANMBR="000"
Q STNAM_"^"_STANMBR
;
REPRT ; Generate the report lines into ^TMP array
; Input: RCSSD - Selected Start Date
; W:Date Removed from Worklist R:Date ERA Received B:Both Dates
; RCDTRNG - Date/Time range of report (range flag^start date^end date)
N DTERA,DTXREF,END,ERAIEN,N,START,X,ZROND
K ^TMP($J,"RC REMV ERA"),^TMP($J,"RC TOTAL")
; If user picked W:Date Removed from Worklist or B:Both Dates, use x-ref "AD" (REMOVED DATE)
I (RCSSD="W")!(RCSSD="B") D
. S END=$P(RCDTRNG,U,3),START=$P(RCDTRNG,U,2),DTXREF=START-.0000001
. F S DTXREF=$O(^RCY(344.4,"AD",DTXREF)) Q:'DTXREF!(DTXREF\1>END) D
. . S ERAIEN=0
. . F S ERAIEN=$O(^RCY(344.4,"AD",DTXREF,ERAIEN)) Q:'ERAIEN D
. . . Q:'$D(^RCY(344.4,ERAIEN,6))
. . . S ZROND=$G(^(0))
. . . Q:ZROND=""
. . . I $$ISTYPE^RCDPEU1(344.4,ERAIEN,"T") D
. . . . S N=$G(^TMP($J,"RC TOTAL","TRICARE"))+1
. . . . S ^TMP($J,"RC TOTAL","TRICARE")=N ; total can be listed
. . . Q:'$$ISTYPE^RCDPEU1(344.4,ERAIEN,RCTYPE) ; PRCA*4.5*326 Filter by payer type
. . . ;
. . . D PROC(ERAIEN)
;
; If user picked R:Date ERA Received or B:Both Dates, use x-ref "AC" (ERA DATE)
I (RCSSD="R")!(RCSSD="B") D
. S END=$P(RCDTRNG,U,3),START=$P(RCDTRNG,U,2),DTXREF=START-.0000001
. F S DTXREF=$O(^RCY(344.4,"AC",DTXREF)) Q:'DTXREF!(DTXREF\1>END) D
. . S ERAIEN=0
. . F S ERAIEN=$O(^RCY(344.4,"AC",DTXREF,ERAIEN)) Q:'ERAIEN D
. . . Q:'$D(^RCY(344.4,ERAIEN,6))
. . . S ZROND=$G(^RCY(344.4,ERAIEN,0))
. . . Q:ZROND=""
. . . Q:$D(^TMP($J,"RC REMV ERA",$P(ZROND,U,1))) ; Data is in ^TMP
. . . I $$ISTYPE^RCDPEU1(344.4,ERAIEN,"T") D
. . . . S N=$G(^TMP($J,"RC TOTAL","TRICARE"))+1
. . . . S ^TMP($J,"RC TOTAL","TRICARE")=N ; Total can be listed
. . . Q:'$$ISTYPE^RCDPEU1(344.4,ERAIEN,RCTYPE) ; PRCA*4.5*326 Filter by payer type
. . . S DTERA=$P(ZROND,U,4)
. . . Q:'DTERA
. . . D PROC(ERAIEN)
Q
;
DISP(RCDISPTY) ; Format the display for screen/printer or MS Excel
; RCDISPTY - Display/print/Excel flag
; LOCAL VARIABLES: IEN - line number of the data in ^TMP (see above)
D:'RCLSTMGR HDRBLD
D:RCLSTMGR HDRLM
N A,IEN,LEN,RCNAM,Y,ZZ
D:'RCLSTMGR HDRLST^RCDPEARL(.RCSTOP,.RCHDR)
S IEN=0
; PRCA*4.5*276 - Modify Display
F S IEN=$O(^TMP($J,"RC REMV ERA",IEN)) Q:'IEN!RCSTOP D
. S Y=^TMP($J,"RC REMV ERA",IEN)
. ;
. ;PRCA*4.5*371 - Added Trace # as the second column
. I RCDISPTY D Q
. . S ZZ=$P(Y,U,1)_U_$P(Y,U,9)_U_$P(Y,U,2,8)
. . W !,ZZ
. I 'RCLSTMGR,$Y>(IOSL-RCHDR(0)) D HDRLST^RCDPEARL(.RCSTOP,.RCHDR) Q:RCSTOP
. ;
. ;PRCA*4.5*371 - Changed the Payer column to Trace #/Payer and m
. S A=$$PAD^RCDPEARL($P(Y,U,3),12)
. S ZZ=$P(Y,U,9)_"/"_$P(Y,U,2) ; Trace #/Payer Name
. S:$L(ZZ)>63 ZZ=$E(ZZ,1,63) ; Truncated Payer Name if necessary
. S A=A_ZZ
. D SL^RCDPEARL(A,.RCLNCNT,RCTMPND) ; ERA & Trace #/Payer
. S A=$$PAD^RCDPEARL($J("",5)_$P(Y,U,4),29) ; Date ERA received
. S A=$$PAD^RCDPEARL(A_$P(Y,U,5),46) ; Date/Time Removed
. S RCNAM=$P(Y,U,7) ; User who removed
. ;
. ; Add ERA amount and user who removed
. S A=$$PAD^RCDPEARL(A_"$"_$P(Y,U,6),58)_$E(RCNAM,1,19) ; limit name to 19 chars.
. D SL^RCDPEARL(A,.RCLNCNT,RCTMPND)
. D WP($P(Y,U,8)) ; reason removed
;
Q:RCSTOP
;
; End of report
D SL^RCDPEARL(" ",.RCLNCNT,RCTMPND) ; Skip a line
D SL^RCDPEARL($$ENDORPRT^RCDPEARL,.RCLNCNT,RCTMPND)
;
I '$D(ZTQUEUED),'RCLSTMGR,'RCSTOP D ASK^RCDPEARL(.RCSTOP)
Q
;
PROC(ERAIEN) ; Put data into ^TMP based on filters
; Input: ERAIEN - IEN of the ERA
N AMT,DEPTCKT,DTERA,DTRTN,ERA,ERAEOB,P,PAYER,RCLOCDV,RCNTRY,RMVRSN,TRACE,USER,Y
; ERAEOB - EOB corresponding to this ERA
; RCDIV - Name of station
; STANMBR - Station number
; DTERA - Date of ERA
; DTRTN - Date ERA removed from worklist
; RMVRSN - Justification for removal of ERA
; TRACE - Trace number of the ERA
; AMT - Total amount of the ERA
; PAYER - ERA payer
; USER - User who completed the removal of the ERA from the worklist
; DEPTCKT - deposit ticket
; RCNTRY - Entry from ^RCY(344.4,ERAIEN)
;
S Y=$$ERASTA(ERAIEN) ; Station name and number
S RCSTA=$P(Y,U,1),RCSTNO=$P(Y,U,2)
;
; PRCA*4.5*276 - Modify Display
I 'VAUTD Q:RCDIV'[RCSTA
M RCNTRY=^RCY(344.4,ERAIEN)
S ERAEOB=$P($G(RCNTRY(1,1,0)),U,2)
S Y=$P(RCNTRY(0),U,4)
S DTERA=$$FMTE^XLFDT(Y,"2D") ; (#.O4) ERA DATE
S ERA=$P(RCNTRY(0),U,1) ; (#.01) ENTRY [1N]
S TRACE=$P(RCNTRY(0),U,2) ; (#.02) TRACE NUMBER
S AMT=$P(RCNTRY(0),U,5) ; (#.05) TOTAL AMOUNT PAID
S Y=$P(RCNTRY(6),U,2),DTRTN=$$FMTE^XLFDT(Y,2) ; (#.17) REMOVED DATE [2D]
S RMVRSN=$P(RCNTRY(6),U,3) ; (#.18) REMOVE REASON [3F]
;
; User's name for report
S USER="",Y=+$P(RCNTRY(6),U,1)
S:Y>0 USER=$$NAME^XUSER(Y,"F") ; (#.16) REMOVED BY
S PAYER=$P(RCNTRY(0),U,6) ; (#.06) PAYMENT FROM ;PRCA*4.5*371
;
; PRCA*4.5*371 - Commented out next two lines because we now get the payer from the ERA
;I ERAEOB S P=+$P($G(^IBM(361.1,ERAEOB,0)),U,2) S:P>0 PAYER=$$GET1^DIQ(36,P_",",.01,"","","RCDIERR")
;S:PAYER="" PAYER="PAYER UNKNOWN"
; get Deposit Ticket
;
; PRCA*4.5*371 - Added Trace#
S ^TMP($J,"RC REMV ERA",ERA)=RCSTA_U_PAYER_U_ERA_U_DTRTN_U_DTERA_U_AMT_U_USER_U_RMVRSN_U_TRACE
Q
;
;
HDRBLD ; Create the report header
; Input: RCDISPTY - Display/print/Excel flag
; RCDTRNG - Date range
; RCXCLUDE - TRICARE /CHAMPVA flags
; Returns: RCHDR(0) - Header text line count
; RCHDR("XECUTE") - M code for page number
; RCHDR("RUNDATE")- Date/time report generated, external format
; RCPGNUM - Page counter
; RCSTOP - Flag to exit
;
K RCHDR
S RCHDR("RUNDATE")=$$NOW^RCDPEARL,RCPGNUM=0,RCSTOP=0
I RCDISPTY D Q ; Excel format, xecute code is QUIT, null page number
. S RCHDR(0)=1,RCHDR("XECUTE")="Q",RCPGNUM=""
. ;
. ;PRCA*4.5*371 Added Trace Number below
. S RCHDR(1)="STATION NAME^TRACE #^PAYER^ERA NUMBER^DATE REMOVED^DATE RECEIVED^AMOUNT^USER^REMOVED REASON"
;
N DIV,HCNT,Y
S HCNT=0 ; Counter for header
S Y=$$HDRNM,HCNT=1
S RCHDR(HCNT)=$J("",80-$L(Y)\2)_Y ; line 1 will be replaced by XECUTE code below
S RCHDR("XECUTE")="N Y S RCPGNUM=RCPGNUM+1,Y=$$HDRNM^"_$T(+0)_"_$S(RCLSTMGR:"""",1:$J(""Page: ""_RCPGNUM,12)),RCHDR(1)=$J("" "",80-$L(Y)\2)_Y"
S Y="Run Date/Time: "_RCHDR("RUNDATE")
S HCNT=HCNT+1,RCHDR(HCNT)=$J("",80-$L(Y)\2)_Y ; Line 1 will be replaced by XECUTE code below
;
S Y("1ST")=$P(RCDTRNG,U,2),Y("LST")=$P(RCDTRNG,U,3)
F Y="1ST","LST" S Y(Y)=$$FMTE^XLFDT(Y(Y),"2Z")
S Y="Date Range: "_Y("1ST")_" - "_Y("LST")
S Y=Y_" ("_$S(RCSSD="B":"Received & Removed",RCSSD="W":"Date Removed from Worklist",1:"Date ERA Received")_")"
S HCNT=HCNT+1,RCHDR(HCNT)=$J("",80-$L(Y)\2)_Y
K Y ; Delete Y subscripts
S Y="DIVISIONS: "_RCDIV
S Y=$J("",80-$L(Y)\2)_Y,HCNT=HCNT+1,RCHDR(HCNT)=Y
S Y="MEDICAL/PHARMACY/TRICARE: "
S Y=Y_$S(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",1:"ALL")
S HCNT=HCNT+1,RCHDR(HCNT)=$J("",80-$L(Y)\2)_Y
S HCNT=HCNT+1,RCHDR(HCNT)=""
;
;PRCA*4.5*371 Added TRACE #/below, moved the start of the column closer to the ERA#
S HCNT=HCNT+1,RCHDR(HCNT)="ERA# Trace #/Payer Name"
S HCNT=HCNT+1,RCHDR(HCNT)=" Date/Time Date ERA Total Amt User Who"
S HCNT=HCNT+1,RCHDR(HCNT)=" Removed Received Paid Removed"
S Y="",$P(Y,"=",81)="",HCNT=HCNT+1,RCHDR(HCNT)=Y ; row of equal signs at bottom
S RCHDR(0)=HCNT ; Line count for header
Q
;
HDRLM ; Create the Listman header
; Input: RCDTRNG - Date range
; RCXCLUDE - TRICARE /CHAMPVA flags
; Returns: RCHDR(0) - Header text line count
N DIV,HCNT,Y
S HCNT=0 ; Counter for header
S Y("1ST")=$P(RCDTRNG,U,2)
S Y("LST")=$P(RCDTRNG,U,3)
F Y="1ST","LST" S Y(Y)=$$FMTE^XLFDT(Y(Y),"2Z")
S Y="Date Range: "_Y("1ST")_" - "_Y("LST")
S Y=Y_" ("_$S(RCSSD="B":"Received & Removed",RCSSD="W":"Date Removed from Worklist",1:"Date ERA Received")_")"
S HCNT=1,RCHDR(HCNT)=Y
K Y ; Delete Y subscripts
S Y="DIVISIONS: "_RCDIV,Y=Y,HCNT=HCNT+1
S RCHDR(HCNT)=Y
S Y="MEDICAL/PHARMACY/TRICARE: "
S Y=Y_$S(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",1:"ALL")
S HCNT=HCNT+1,RCHDR(HCNT)=Y
S HCNT=HCNT+1,RCHDR(HCNT)=""
;
;PRCA*4.5*371 Added TRACE #/below, moved the start of the column closer to the ERA#
S HCNT=HCNT+1,RCHDR(HCNT)="ERA# Trace #/Payer Name"
S HCNT=HCNT+1,RCHDR(HCNT)=" Date/Time Date ERA Total Amt User Who"
S HCNT=HCNT+1,RCHDR(HCNT)=" Removed Received Paid Removed"
S RCHDR(0)=HCNT ; Lne count for header
Q
;
HDRNM() ; Returns the report name
Q "ERAs Removed from Active Worklist - Audit Report"
;
EXIT ; Exit the report
D ^%ZISC
K ^TMP($J,"RC REMV ERA"),^TMP($J,"RC TOTAL")
Q
;
WP(RR) ; Format Removed Reason comments
; Input: RR - Removed Reason
Q:RR=""
N CMNT,CNTR,I,PCS,Y
; PCS - Number of " " $pieces in the comment
; CNTR - CMNT line counter
; CMNT - Comment text to be displayed
S PCS=$L(RR," "),CNTR=1,CMNT(CNTR)=" Removed Reason: "
F I=1:1:PCS D
. S Y=$P(RR," ",I)
. S:$L(CMNT(CNTR))+$L(Y)>72 CNTR=CNTR+1,CMNT(CNTR)=$J(" ",17)
. S CMNT(CNTR)=CMNT(CNTR)_" "_Y
;
F I=1:1:CNTR D SL^RCDPEARL(CMNT(I),.RCLNCNT,RCTMPND)
Q
;
RETN ; Entry point for Remove Duplicate EFT Deposits [RCDPE REMOVE DUP DEPOSITS]
N DA,DIC,DIE,DIR,DR,DTOUT,MSG,RCERANUM,RCY,X,Y
D OWNSKEY^XUSRB(.MSG,"RCDPE REMOVE DUPLICATES",DUZ)
I 'MSG(0) W !,"You are not authorized to use this option.",! S DIR(0)="E" D ^DIR K DIR Q
W !!," WARNING: Removing an EFT is **NOT** reversible."
W !," Use this option only if you are sure you want to remove this EFT."
W !," Please be aware that once an EFT is removed - it cannot be restored.",!!
S DIR(0)="YA",DIR("B")="NO"
S DIR("A")="Are you sure you want to continue? "
D ^DIR K DIR
I $D(DUOUT)!$D(DTOUT)!'Y Q
; EDI THIRD PARTY EFT DETAIL (#344.31)
; PRCA*4.5*326 - Use EFT picker utility instead of DIC call
; screening logic for field #.08 MATCH STATUS [8S], must be UNMATCHED
S DIC("S")="I '$P(^(0),U,8)"
S DIC("A")="Select EDI THIRD PARTY EFT DETAIL EFT TRANSACTION: "
S RCY=$$ASKEFT^RCDPEU2(DIC("A"),DIC("S"))
I RCY'>0 Q
S RCERANUM=$$GET1^DIQ(344.31,RCY_",",.01,"E") ; Get EFT number
; PRCA*4.5*326 - End changed block
;
K DIR S DIR(0)="YA",DIR("B")="NO"
S DIR("A",1)="This will mark EFT # "_RCERANUM_" as removed."
S DIR("A")="Are you sure you want to continue? "
W !
D ^DIR K DIR
I $D(DUOUT)!$D(DTOUT)!(Y=0) D NOCHNG Q
S DIE="^RCY(344.31,",DA=RCY,DR=".19;.2R" D ^DIE ;PRCA*4.5*375 - Add Removal Type field for Duplicate/Millenium EFTs
I $D(Y) D NOCHNG Q ; user aborted edit
;
; 344.31,.08 - MATCH STATUS
; 344.31,.17 - USER WHO REMOVED EFT
; 344.31,.18 - DATE/TIME DUPLICATE REMOVED
S DR=".08////1;.17////"_DUZ_";.18////"_$$NOW^XLFDT D ^DIE
W !!
K DIR S DIR(0)="EA"
S DIR("A")="Press return to continue: "
S DIR("A",1)="EFT # "_RCERANUM_" has been marked as removed."
D ^DIR
Q
;
NOCHNG ;
N DIR,DTOUT,DUOUT,X,Y
S DIR(0)="EA"
S DIR("A")="Press return to continue: "
S DIR("A",1)="*** This EFT was NOT removed. ***"
W !! D ^DIR
Q
;
; BEGIN PRCA*4.5*326
DICW ; Identifier code for EFT lookup - EP MATCH1^RCDPEM3 and MATCH2^RCDPEM2
; Input - Y = EFT DETAIL #344.31 IEN
; D = Index ("B","C","E","F","FNLZ")
; DZ = User input from ^DIE call, "?" or "??" if help list was requested
;
; PRCA*4.5*371 - Removed D and DZ from new statement
N DATA,DEPDAT,DEPNO,EFTID,EFTIEN,EFTTR,PAYAMT,PAYNAM,PAYTR,SP,TIN
S DATA=$G(^RCY(344.31,Y,0)) I DATA="" Q
S SP=$J("",3),EFTIEN=$P(DATA,U,1)
S EFTTR="",EFTID=EFTIEN I $P(DATA,U,14) S EFTID=EFTID_"."_$P(DATA,U,14)
S PAYNAM=$$GET1^DIQ(344.31,Y,.02,"E")
S TIN=$$GET1^DIQ(344.31,Y,.03,"E")
S PAYTR=$$GET1^DIQ(344.31,Y,.04,"E")
S PAYAMT=$$GET1^DIQ(344.31,Y,.07,"E")
S DEPNO=$$GET1^DIQ(344.3,EFTIEN,.03,"E")
S DEPDAT=$$FMTE^XLFDT($$GET1^DIQ(344.3,EFTIEN,.07,"I"),"2DZ")
; EFT DETAIL lookup
I $G(DZ)="??"!($G(DZ)="?") D ;
. S PAYNAM=$E(PAYNAM,1,58-$L(TIN))_"/"_TIN I PAYNAM="/" S PAYNAM=""
. W ?10,EFTID,?20," ",PAYNAM
. W !,?20," ",PAYTR,?48," ",$J(PAYAMT,10)
. W ?59," ",DEPNO,?71," ",DEPDAT
E D ;
. S PAYNAM=$E(PAYNAM,1,52-$L(TIN))_"/"_TIN I PAYNAM="/" S PAYNAM=""
. I D="B"!(D="D") D Q ; Search index EFT# or EFT ID#
. . W ?25," ",PAYNAM
. . W !,?25," ",PAYTR,?48," ",$J(PAYAMT,10)
. . W ?59," ",DEPNO,?71," ",DEPDAT
. I D="C" D Q ; Search index PAYER NAME
. . W " ",EFTID
. . W !,?20," ",PAYTR,?48," ",$J(PAYAMT,10)
. . W ?59," ",DEPNO,?71," ",DEPDAT
. I D="E" D Q ; Search index DATE/TIME DUPLICATE REMOVED
. . W " ",EFTID,?25," ",PAYNAM
. . W !,?25," ",PAYTR,?48," ",$J(PAYAMT,10)
. . W ?59," ",DEPNO,?71," ",DEPDAT
. I D="F" D Q ; Search index TRACE#
. . W " ",EFTID,?48,$J(PAYAMT,10),?59," ",DEPNO,?71," ",DEPDAT
. . W !,?25," ",PAYNAM
;
; Next line required to fix problem when ??, ^ from help, then ?? again reverts back to old help.
; If DIC(0)["A" DIC("W") is not killed off.
I $G(DIC(0))'["A" S DIC(0)="A"_$G(DIC(0))
Q
;
OUT(RCEFT) ; EP UNMATCH^RCDPEM2
; INPUT - RCEFT - #344.31 ien
; OUTPUT - EFT_"."_TRAN - formatted EFT line
N EFT,TRAN
S EFT=$$GET1^DIQ(344.31,RCEFT_",",.01,"I")
S TRAN=$$GET1^DIQ(344.31,RCEFT_",",.14)
Q EFT_"."_TRAN
; END PRCA*4,5*326
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEM3 19754 printed Apr 09, 2024@20:46:42 Page 2
RCDPEM3 ;OIFO-BAYPINES/RBN - ERA AUDIT REPORT and return EFT function ;Jun 06, 2014@19:11:19
+1 ;;4.5;Accounts Receivable;**276,284,298,326,375,371**;Mar 20, 1995;Build 29
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; General read access of IB EOB file #361.1 is allowed from AR (IA 4051)
+5 ; completely refactored for PRCA*4.5*298
+6 QUIT
+7 ;
+8 ; PRCA*4.5*284 - Changed report name from 'Mark ERA returned to Payer' to 'Remove ERA from active worklist'
+9 ;
+10 ; Generates an audit report that displays all ERAs that have been removed from the worklist.
+11 ; The user can select filters with which to limit the number of ERAs displayed:
+12 ; Station/Division - Default is all
+13 ; Date Range - Default is all
+14 ; Start Date type - No default, P:Date removed from worklist, R:Date ERA Received, B:Both Dates
+15 ;
+16 ; INPUT:
+17 ; user is prompted for the Station/Division, Date/Time range, and start/end dates
+18 ;
+19 ; OUTPUT:
+20 ; report which displays removed ERAs, it contains:
+21 ; User's name - who performed the transaction
+22 ; Date/Time ERA received from the payer
+23 ; Date/Time ERA removed from worklist
+24 ; Free text reasons for returning the ERA to the payer
+25 ; ERA number
+26 ; Trace number
+27 ; Dollar amount of ERA
+28 ; Payer name
+29 ;
+30 ; Data taken from ELECTRONIC REMITTANCE ADVICE file (#344.4)
+31 ;
EN ; EP - Remove ERA from Active Worklist Audit Report [RCDPE REMOVED ERA AUDIT]
+1 NEW %ZIS,I,POP,RCDISPTY,RCDIV,RCDTRNG,RCEND,RCHDR,RCLNCNT,RCLSTMGR,RCPGNUM,RCPG
+2 NEW RCSSD,RCSTA,RCSTART,RCSTNO,RCSTOP,RCTMPND,RCTYPE,VAUTD,X,Y
+3 ;
+4 ; ListMan flag, set to '^' if sent to Excel
SET RCLSTMGR=""
+5 ; If null, report lines not stored in ^TMP, written directly
SET RCTMPND=""
+6 ; Initial values of zero
SET (RCSTOP,RCPG,RCLNCNT)=0
+7 ; Report page number
SET RCPGNUM=0
+8 ; PRCA*4.5*276 - Modify Header display
+9 ; Default to All divisions
SET RCDIV="ALL"
+10 SET RCSSD=$$DTPRB^RCDPEM4()
+11 IF RCSSD=0
DO EXIT
QUIT
+12 SET RCDTRNG=$$DTRNG^RCDPEM4()
+13 IF 'RCDTRNG
DO EXIT
QUIT
+14 SET RCSTART=$PIECE(RCDTRNG,U,2)
SET RCEND=$PIECE(RCDTRNG,U,3)
+15 ; VAUTD=1 for 'ALL'
+16 DO DIVISION^VAUTOMA
+17 if Y=-1
QUIT
+18 IF 'VAUTD
IF ($DATA(VAUTD)'=11)
DO EXIT
QUIT
+19 IF VAUTD=0
Begin DoDot:1
+20 NEW C,J
+21 SET (J,C)=0
SET RCDIV=""
+22 FOR
SET J=$ORDER(VAUTD(J))
if 'J
QUIT
SET C=C+1
SET $PIECE(RCDIV,", ",C)=VAUTD(J)
End DoDot:1
+23 ;
+24 ;PRCA*4.5*326 M/P/T filter
SET RCTYPE=$$RTYPE^RCDPEU1("A")
+25 IF RCTYPE=-1
DO EXIT
QUIT
+26 ; Ask display type for Excel
SET RCDISPTY=$$DISPTY()
+27 IF RCDISPTY<0
DO EXIT
QUIT
+28 ;
+29 ; Display Excel info, set ListMan flag to prevent question
+30 IF RCDISPTY
Begin DoDot:1
+31 DO INFO^RCDPEM6
+32 SET RCLSTMGR="^"
End DoDot:1
+33 ;
+34 ; If not output to Excel ask for ListMan display, exit if timeout or '^' - PRCA*4.5*298
+35 IF RCLSTMGR=""
Begin DoDot:1
+36 SET RCLSTMGR=$$ASKLM^RCDPEARL
+37 IF RCLSTMGR<0
DO EXIT
QUIT
End DoDot:1
if RCLSTMGR<0
QUIT
+38 ;
+39 ; Display in ListMan format and exit on return
+40 IF RCLSTMGR
Begin DoDot:1
+41 SET RCTMPND=$TEXT(+0)_"^REMOVE ERA AUDIT"
+42 ; clean any residue
KILL ^TMP($JOB,RCTMPND)
+43 DO REPRT
DO DISP(RCDISPTY)
+44 NEW H,HDR,L,N
+45 SET L=0
+46 SET HDR("TITLE")=$$HDRNM
+47 ; Take first 7 lines of report header
FOR H=1:1:7
Begin DoDot:2
+48 IF $DATA(RCHDR(H))
SET L=H
SET HDR(H)=RCHDR(H)
End DoDot:2
+49 ; Any remaining header lines at top of report
IF $ORDER(RCHDR(L))
Begin DoDot:2
+50 SET N=0
SET H=L
+51 FOR
SET H=$ORDER(RCHDR(H))
if 'H
QUIT
SET N=N+.001
SET ^TMP($JOB,RCTMPND,N)=RCHDR(H)
End DoDot:2
+52 ;
+53 ; invoke ListMan
+54 ; Generate ListMan display
DO LMRPT^RCDPEARL(.HDR,$NAME(^TMP($JOB,RCTMPND)))
+55 DO EXIT
End DoDot:1
QUIT
+56 ;
+57 SET %ZIS="QM"
+58 DO ^%ZIS
+59 if POP
QUIT
+60 IF $DATA(IO("Q"))
Begin DoDot:1
+61 NEW ZTDESC,ZTRTN,ZTSAVE,ZTSK
+62 SET ZTRTN="ENFRMQ^RCDPEM3"
+63 SET ZTDESC=$$HDRNM
+64 SET ZTSAVE("RC*")=""
SET ZTSAVE("VAUTD")=""
+65 DO ^%ZTLOAD
+66 WRITE !!,$SELECT($GET(ZTSK):"Task number "_ZTSK_" queued.",1:"Unable to queue this task.")
+67 KILL IO("Q")
+68 DO HOME^%ZIS
End DoDot:1
QUIT
+69 ;
+70 USE IO
+71 ;
ENFRMQ ; entry point from queue
+1 DO REPRT
+2 DO DISP(RCDISPTY)
+3 DO EXIT
+4 QUIT
+5 ;
DISPTY() ; Ask display/output type
+1 ; Input: None
+2 ; Returns: 0-Display, 1-MS Excel, -1=timeout or '^'
+3 NEW DIR,DIRUT,DUOUT,X,Y
+4 SET DIR(0)="YA"
SET DIR("A")="Export the report to Microsoft Excel? (Y/N): "
+5 SET DIR("B")="NO"
+6 DO ^DIR
+7 IF $DATA(DUOUT)!$DATA(DIRUT)
SET Y=-1
+8 QUIT Y
+9 ;
ERASTA(ERAIEN) ; Returns "station name ^ station #" for an ERA
+1 ; Input: ERAIEN - IEN of the ERA
+2 ; Must have valid IEN
if '($GET(ERAIEN)>0)
QUIT "-1^"
+3 NEW BILLPTR,ERAEOB,J,M,P,STAPTR,STNAM,STANMBR,Y
+4 ; ERAEOB - EOB corresponding to the ERA
+5 ; BILLPTR - pointer to Bill corresponding to the ERA
+6 ; STAPTR - IEN of the Station of the ERA
+7 ; Initial value
SET STNAM=""
+8 Begin DoDot:1
+9 ;^RCY(344.4,D0,1,D1,0)= (#.01) SEQUENCE # [1N] ^ (#.02) EOB DETAIL [2P:361.1]
+10 SET J=0
+11 FOR
SET J=$ORDER(^RCY(344.4,ERAIEN,1,J))
if 'J!(STNAM'="")
QUIT
Begin DoDot:2
+12 SET M=^RCY(344.4,ERAIEN,1,J,0)
+13 SET ERAEOB=0
SET P=+$PIECE(M,U,2)
+14 IF P>0
IF $DATA(^IBM(361.1,P,0))
SET Y=$GET(^IBM(361.1,P,0))
SET ERAEOB=P
+15 ; Pointer to ^IBM(361.1,0) = EXPLANATION OF BENEFITS^361.1
if 'ERAEOB
QUIT
+16 SET BILLPTR=$PIECE(Y,U,1)
+17 if '(BILLPTR>0)
QUIT
+18 ;
+19 ; ^DGCR(399,0) = BILL/CLAIMS^399
+20 SET STAPTR=$PIECE($GET(^DGCR(399,BILLPTR,0)),U,22)
+21 if '(STAPTR>0)
QUIT
+22 ;
+23 ; ^DG(40.8,0) = MEDICAL CENTER DIVISION^40.8
+24 ; 40.8,.01 = NAME
SET STNAM=$$GET1^DIQ(40.8,STAPTR_",",.01,"","","RCDIERR")
+25 if STNAM=""
QUIT
+26 ; IA 417
SET STANMBR=$PIECE(^DG(40.8,STAPTR,0),U,2)
End DoDot:2
End DoDot:1
+27 ;
+28 if STNAM=""
SET STNAM="STATION UNKNOWN"
SET STANMBR="000"
+29 QUIT STNAM_"^"_STANMBR
+30 ;
REPRT ; Generate the report lines into ^TMP array
+1 ; Input: RCSSD - Selected Start Date
+2 ; W:Date Removed from Worklist R:Date ERA Received B:Both Dates
+3 ; RCDTRNG - Date/Time range of report (range flag^start date^end date)
+4 NEW DTERA,DTXREF,END,ERAIEN,N,START,X,ZROND
+5 KILL ^TMP($JOB,"RC REMV ERA"),^TMP($JOB,"RC TOTAL")
+6 ; If user picked W:Date Removed from Worklist or B:Both Dates, use x-ref "AD" (REMOVED DATE)
+7 IF (RCSSD="W")!(RCSSD="B")
Begin DoDot:1
+8 SET END=$PIECE(RCDTRNG,U,3)
SET START=$PIECE(RCDTRNG,U,2)
SET DTXREF=START-.0000001
+9 FOR
SET DTXREF=$ORDER(^RCY(344.4,"AD",DTXREF))
if 'DTXREF!(DTXREF\1>END)
QUIT
Begin DoDot:2
+10 SET ERAIEN=0
+11 FOR
SET ERAIEN=$ORDER(^RCY(344.4,"AD",DTXREF,ERAIEN))
if 'ERAIEN
QUIT
Begin DoDot:3
+12 if '$DATA(^RCY(344.4,ERAIEN,6))
QUIT
+13 SET ZROND=$GET(^(0))
+14 if ZROND=""
QUIT
+15 IF $$ISTYPE^RCDPEU1(344.4,ERAIEN,"T")
Begin DoDot:4
+16 SET N=$GET(^TMP($JOB,"RC TOTAL","TRICARE"))+1
+17 ; total can be listed
SET ^TMP($JOB,"RC TOTAL","TRICARE")=N
End DoDot:4
+18 ; PRCA*4.5*326 Filter by payer type
if '$$ISTYPE^RCDPEU1(344.4,ERAIEN,RCTYPE)
QUIT
+19 ;
+20 DO PROC(ERAIEN)
End DoDot:3
End DoDot:2
End DoDot:1
+21 ;
+22 ; If user picked R:Date ERA Received or B:Both Dates, use x-ref "AC" (ERA DATE)
+23 IF (RCSSD="R")!(RCSSD="B")
Begin DoDot:1
+24 SET END=$PIECE(RCDTRNG,U,3)
SET START=$PIECE(RCDTRNG,U,2)
SET DTXREF=START-.0000001
+25 FOR
SET DTXREF=$ORDER(^RCY(344.4,"AC",DTXREF))
if 'DTXREF!(DTXREF\1>END)
QUIT
Begin DoDot:2
+26 SET ERAIEN=0
+27 FOR
SET ERAIEN=$ORDER(^RCY(344.4,"AC",DTXREF,ERAIEN))
if 'ERAIEN
QUIT
Begin DoDot:3
+28 if '$DATA(^RCY(344.4,ERAIEN,6))
QUIT
+29 SET ZROND=$GET(^RCY(344.4,ERAIEN,0))
+30 if ZROND=""
QUIT
+31 ; Data is in ^TMP
if $DATA(^TMP($JOB,"RC REMV ERA",$PIECE(ZROND,U,1)))
QUIT
+32 IF $$ISTYPE^RCDPEU1(344.4,ERAIEN,"T")
Begin DoDot:4
+33 SET N=$GET(^TMP($JOB,"RC TOTAL","TRICARE"))+1
+34 ; Total can be listed
SET ^TMP($JOB,"RC TOTAL","TRICARE")=N
End DoDot:4
+35 ; PRCA*4.5*326 Filter by payer type
if '$$ISTYPE^RCDPEU1(344.4,ERAIEN,RCTYPE)
QUIT
+36 SET DTERA=$PIECE(ZROND,U,4)
+37 if 'DTERA
QUIT
+38 DO PROC(ERAIEN)
End DoDot:3
End DoDot:2
End DoDot:1
+39 QUIT
+40 ;
DISP(RCDISPTY) ; Format the display for screen/printer or MS Excel
+1 ; RCDISPTY - Display/print/Excel flag
+2 ; LOCAL VARIABLES: IEN - line number of the data in ^TMP (see above)
+3 if 'RCLSTMGR
DO HDRBLD
+4 if RCLSTMGR
DO HDRLM
+5 NEW A,IEN,LEN,RCNAM,Y,ZZ
+6 if 'RCLSTMGR
DO HDRLST^RCDPEARL(.RCSTOP,.RCHDR)
+7 SET IEN=0
+8 ; PRCA*4.5*276 - Modify Display
+9 FOR
SET IEN=$ORDER(^TMP($JOB,"RC REMV ERA",IEN))
if 'IEN!RCSTOP
QUIT
Begin DoDot:1
+10 SET Y=^TMP($JOB,"RC REMV ERA",IEN)
+11 ;
+12 ;PRCA*4.5*371 - Added Trace # as the second column
+13 IF RCDISPTY
Begin DoDot:2
+14 SET ZZ=$PIECE(Y,U,1)_U_$PIECE(Y,U,9)_U_$PIECE(Y,U,2,8)
+15 WRITE !,ZZ
End DoDot:2
QUIT
+16 IF 'RCLSTMGR
IF $Y>(IOSL-RCHDR(0))
DO HDRLST^RCDPEARL(.RCSTOP,.RCHDR)
if RCSTOP
QUIT
+17 ;
+18 ;PRCA*4.5*371 - Changed the Payer column to Trace #/Payer and m
+19 SET A=$$PAD^RCDPEARL($PIECE(Y,U,3),12)
+20 ; Trace #/Payer Name
SET ZZ=$PIECE(Y,U,9)_"/"_$PIECE(Y,U,2)
+21 ; Truncated Payer Name if necessary
if $LENGTH(ZZ)>63
SET ZZ=$EXTRACT(ZZ,1,63)
+22 SET A=A_ZZ
+23 ; ERA & Trace #/Payer
DO SL^RCDPEARL(A,.RCLNCNT,RCTMPND)
+24 ; Date ERA received
SET A=$$PAD^RCDPEARL($JUSTIFY("",5)_$PIECE(Y,U,4),29)
+25 ; Date/Time Removed
SET A=$$PAD^RCDPEARL(A_$PIECE(Y,U,5),46)
+26 ; User who removed
SET RCNAM=$PIECE(Y,U,7)
+27 ;
+28 ; Add ERA amount and user who removed
+29 ; limit name to 19 chars.
SET A=$$PAD^RCDPEARL(A_"$"_$PIECE(Y,U,6),58)_$EXTRACT(RCNAM,1,19)
+30 DO SL^RCDPEARL(A,.RCLNCNT,RCTMPND)
+31 ; reason removed
DO WP($PIECE(Y,U,8))
End DoDot:1
+32 ;
+33 if RCSTOP
QUIT
+34 ;
+35 ; End of report
+36 ; Skip a line
DO SL^RCDPEARL(" ",.RCLNCNT,RCTMPND)
+37 DO SL^RCDPEARL($$ENDORPRT^RCDPEARL,.RCLNCNT,RCTMPND)
+38 ;
+39 IF '$DATA(ZTQUEUED)
IF 'RCLSTMGR
IF 'RCSTOP
DO ASK^RCDPEARL(.RCSTOP)
+40 QUIT
+41 ;
PROC(ERAIEN) ; Put data into ^TMP based on filters
+1 ; Input: ERAIEN - IEN of the ERA
+2 NEW AMT,DEPTCKT,DTERA,DTRTN,ERA,ERAEOB,P,PAYER,RCLOCDV,RCNTRY,RMVRSN,TRACE,USER,Y
+3 ; ERAEOB - EOB corresponding to this ERA
+4 ; RCDIV - Name of station
+5 ; STANMBR - Station number
+6 ; DTERA - Date of ERA
+7 ; DTRTN - Date ERA removed from worklist
+8 ; RMVRSN - Justification for removal of ERA
+9 ; TRACE - Trace number of the ERA
+10 ; AMT - Total amount of the ERA
+11 ; PAYER - ERA payer
+12 ; USER - User who completed the removal of the ERA from the worklist
+13 ; DEPTCKT - deposit ticket
+14 ; RCNTRY - Entry from ^RCY(344.4,ERAIEN)
+15 ;
+16 ; Station name and number
SET Y=$$ERASTA(ERAIEN)
+17 SET RCSTA=$PIECE(Y,U,1)
SET RCSTNO=$PIECE(Y,U,2)
+18 ;
+19 ; PRCA*4.5*276 - Modify Display
+20 IF 'VAUTD
if RCDIV'[RCSTA
QUIT
+21 MERGE RCNTRY=^RCY(344.4,ERAIEN)
+22 SET ERAEOB=$PIECE($GET(RCNTRY(1,1,0)),U,2)
+23 SET Y=$PIECE(RCNTRY(0),U,4)
+24 ; (#.O4) ERA DATE
SET DTERA=$$FMTE^XLFDT(Y,"2D")
+25 ; (#.01) ENTRY [1N]
SET ERA=$PIECE(RCNTRY(0),U,1)
+26 ; (#.02) TRACE NUMBER
SET TRACE=$PIECE(RCNTRY(0),U,2)
+27 ; (#.05) TOTAL AMOUNT PAID
SET AMT=$PIECE(RCNTRY(0),U,5)
+28 ; (#.17) REMOVED DATE [2D]
SET Y=$PIECE(RCNTRY(6),U,2)
SET DTRTN=$$FMTE^XLFDT(Y,2)
+29 ; (#.18) REMOVE REASON [3F]
SET RMVRSN=$PIECE(RCNTRY(6),U,3)
+30 ;
+31 ; User's name for report
+32 SET USER=""
SET Y=+$PIECE(RCNTRY(6),U,1)
+33 ; (#.16) REMOVED BY
if Y>0
SET USER=$$NAME^XUSER(Y,"F")
+34 ; (#.06) PAYMENT FROM ;PRCA*4.5*371
SET PAYER=$PIECE(RCNTRY(0),U,6)
+35 ;
+36 ; PRCA*4.5*371 - Commented out next two lines because we now get the payer from the ERA
+37 ;I ERAEOB S P=+$P($G(^IBM(361.1,ERAEOB,0)),U,2) S:P>0 PAYER=$$GET1^DIQ(36,P_",",.01,"","","RCDIERR")
+38 ;S:PAYER="" PAYER="PAYER UNKNOWN"
+39 ; get Deposit Ticket
+40 ;
+41 ; PRCA*4.5*371 - Added Trace#
+42 SET ^TMP($JOB,"RC REMV ERA",ERA)=RCSTA_U_PAYER_U_ERA_U_DTRTN_U_DTERA_U_AMT_U_USER_U_RMVRSN_U_TRACE
+43 QUIT
+44 ;
+45 ;
HDRBLD ; Create the report header
+1 ; Input: RCDISPTY - Display/print/Excel flag
+2 ; RCDTRNG - Date range
+3 ; RCXCLUDE - TRICARE /CHAMPVA flags
+4 ; Returns: RCHDR(0) - Header text line count
+5 ; RCHDR("XECUTE") - M code for page number
+6 ; RCHDR("RUNDATE")- Date/time report generated, external format
+7 ; RCPGNUM - Page counter
+8 ; RCSTOP - Flag to exit
+9 ;
+10 KILL RCHDR
+11 SET RCHDR("RUNDATE")=$$NOW^RCDPEARL
SET RCPGNUM=0
SET RCSTOP=0
+12 ; Excel format, xecute code is QUIT, null page number
IF RCDISPTY
Begin DoDot:1
+13 SET RCHDR(0)=1
SET RCHDR("XECUTE")="Q"
SET RCPGNUM=""
+14 ;
+15 ;PRCA*4.5*371 Added Trace Number below
+16 SET RCHDR(1)="STATION NAME^TRACE #^PAYER^ERA NUMBER^DATE REMOVED^DATE RECEIVED^AMOUNT^USER^REMOVED REASON"
End DoDot:1
QUIT
+17 ;
+18 NEW DIV,HCNT,Y
+19 ; Counter for header
SET HCNT=0
+20 SET Y=$$HDRNM
SET HCNT=1
+21 ; line 1 will be replaced by XECUTE code below
SET RCHDR(HCNT)=$JUSTIFY("",80-$LENGTH(Y)\2)_Y
+22 SET RCHDR("XECUTE")="N Y S RCPGNUM=RCPGNUM+1,Y=$$HDRNM^"_$TEXT(+0)_"_$S(RCLSTMGR:"""",1:$J(""Page: ""_RCPGNUM,12)),RCHDR(1)=$J("" "",80-$L(Y)\2)_Y"
+23 SET Y="Run Date/Time: "_RCHDR("RUNDATE")
+24 ; Line 1 will be replaced by XECUTE code below
SET HCNT=HCNT+1
SET RCHDR(HCNT)=$JUSTIFY("",80-$LENGTH(Y)\2)_Y
+25 ;
+26 SET Y("1ST")=$PIECE(RCDTRNG,U,2)
SET Y("LST")=$PIECE(RCDTRNG,U,3)
+27 FOR Y="1ST","LST"
SET Y(Y)=$$FMTE^XLFDT(Y(Y),"2Z")
+28 SET Y="Date Range: "_Y("1ST")_" - "_Y("LST")
+29 SET Y=Y_" ("_$SELECT(RCSSD="B":"Received & Removed",RCSSD="W":"Date Removed from Worklist",1:"Date ERA Received")_")"
+30 SET HCNT=HCNT+1
SET RCHDR(HCNT)=$JUSTIFY("",80-$LENGTH(Y)\2)_Y
+31 ; Delete Y subscripts
KILL Y
+32 SET Y="DIVISIONS: "_RCDIV
+33 SET Y=$JUSTIFY("",80-$LENGTH(Y)\2)_Y
SET HCNT=HCNT+1
SET RCHDR(HCNT)=Y
+34 SET Y="MEDICAL/PHARMACY/TRICARE: "
+35 SET Y=Y_$SELECT(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",1:"ALL")
+36 SET HCNT=HCNT+1
SET RCHDR(HCNT)=$JUSTIFY("",80-$LENGTH(Y)\2)_Y
+37 SET HCNT=HCNT+1
SET RCHDR(HCNT)=""
+38 ;
+39 ;PRCA*4.5*371 Added TRACE #/below, moved the start of the column closer to the ERA#
+40 SET HCNT=HCNT+1
SET RCHDR(HCNT)="ERA# Trace #/Payer Name"
+41 SET HCNT=HCNT+1
SET RCHDR(HCNT)=" Date/Time Date ERA Total Amt User Who"
+42 SET HCNT=HCNT+1
SET RCHDR(HCNT)=" Removed Received Paid Removed"
+43 ; row of equal signs at bottom
SET Y=""
SET $PIECE(Y,"=",81)=""
SET HCNT=HCNT+1
SET RCHDR(HCNT)=Y
+44 ; Line count for header
SET RCHDR(0)=HCNT
+45 QUIT
+46 ;
HDRLM ; Create the Listman header
+1 ; Input: RCDTRNG - Date range
+2 ; RCXCLUDE - TRICARE /CHAMPVA flags
+3 ; Returns: RCHDR(0) - Header text line count
+4 NEW DIV,HCNT,Y
+5 ; Counter for header
SET HCNT=0
+6 SET Y("1ST")=$PIECE(RCDTRNG,U,2)
+7 SET Y("LST")=$PIECE(RCDTRNG,U,3)
+8 FOR Y="1ST","LST"
SET Y(Y)=$$FMTE^XLFDT(Y(Y),"2Z")
+9 SET Y="Date Range: "_Y("1ST")_" - "_Y("LST")
+10 SET Y=Y_" ("_$SELECT(RCSSD="B":"Received & Removed",RCSSD="W":"Date Removed from Worklist",1:"Date ERA Received")_")"
+11 SET HCNT=1
SET RCHDR(HCNT)=Y
+12 ; Delete Y subscripts
KILL Y
+13 SET Y="DIVISIONS: "_RCDIV
SET Y=Y
SET HCNT=HCNT+1
+14 SET RCHDR(HCNT)=Y
+15 SET Y="MEDICAL/PHARMACY/TRICARE: "
+16 SET Y=Y_$SELECT(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",1:"ALL")
+17 SET HCNT=HCNT+1
SET RCHDR(HCNT)=Y
+18 SET HCNT=HCNT+1
SET RCHDR(HCNT)=""
+19 ;
+20 ;PRCA*4.5*371 Added TRACE #/below, moved the start of the column closer to the ERA#
+21 SET HCNT=HCNT+1
SET RCHDR(HCNT)="ERA# Trace #/Payer Name"
+22 SET HCNT=HCNT+1
SET RCHDR(HCNT)=" Date/Time Date ERA Total Amt User Who"
+23 SET HCNT=HCNT+1
SET RCHDR(HCNT)=" Removed Received Paid Removed"
+24 ; Lne count for header
SET RCHDR(0)=HCNT
+25 QUIT
+26 ;
HDRNM() ; Returns the report name
+1 QUIT "ERAs Removed from Active Worklist - Audit Report"
+2 ;
EXIT ; Exit the report
+1 DO ^%ZISC
+2 KILL ^TMP($JOB,"RC REMV ERA"),^TMP($JOB,"RC TOTAL")
+3 QUIT
+4 ;
WP(RR) ; Format Removed Reason comments
+1 ; Input: RR - Removed Reason
+2 if RR=""
QUIT
+3 NEW CMNT,CNTR,I,PCS,Y
+4 ; PCS - Number of " " $pieces in the comment
+5 ; CNTR - CMNT line counter
+6 ; CMNT - Comment text to be displayed
+7 SET PCS=$LENGTH(RR," ")
SET CNTR=1
SET CMNT(CNTR)=" Removed Reason: "
+8 FOR I=1:1:PCS
Begin DoDot:1
+9 SET Y=$PIECE(RR," ",I)
+10 if $LENGTH(CMNT(CNTR))+$LENGTH(Y)>72
SET CNTR=CNTR+1
SET CMNT(CNTR)=$JUSTIFY(" ",17)
+11 SET CMNT(CNTR)=CMNT(CNTR)_" "_Y
End DoDot:1
+12 ;
+13 FOR I=1:1:CNTR
DO SL^RCDPEARL(CMNT(I),.RCLNCNT,RCTMPND)
+14 QUIT
+15 ;
RETN ; Entry point for Remove Duplicate EFT Deposits [RCDPE REMOVE DUP DEPOSITS]
+1 NEW DA,DIC,DIE,DIR,DR,DTOUT,MSG,RCERANUM,RCY,X,Y
+2 DO OWNSKEY^XUSRB(.MSG,"RCDPE REMOVE DUPLICATES",DUZ)
+3 IF 'MSG(0)
WRITE !,"You are not authorized to use this option.",!
SET DIR(0)="E"
DO ^DIR
KILL DIR
QUIT
+4 WRITE !!," WARNING: Removing an EFT is **NOT** reversible."
+5 WRITE !," Use this option only if you are sure you want to remove this EFT."
+6 WRITE !," Please be aware that once an EFT is removed - it cannot be restored.",!!
+7 SET DIR(0)="YA"
SET DIR("B")="NO"
+8 SET DIR("A")="Are you sure you want to continue? "
+9 DO ^DIR
KILL DIR
+10 IF $DATA(DUOUT)!$DATA(DTOUT)!'Y
QUIT
+11 ; EDI THIRD PARTY EFT DETAIL (#344.31)
+12 ; PRCA*4.5*326 - Use EFT picker utility instead of DIC call
+13 ; screening logic for field #.08 MATCH STATUS [8S], must be UNMATCHED
+14 SET DIC("S")="I '$P(^(0),U,8)"
+15 SET DIC("A")="Select EDI THIRD PARTY EFT DETAIL EFT TRANSACTION: "
+16 SET RCY=$$ASKEFT^RCDPEU2(DIC("A"),DIC("S"))
+17 IF RCY'>0
QUIT
+18 ; Get EFT number
SET RCERANUM=$$GET1^DIQ(344.31,RCY_",",.01,"E")
+19 ; PRCA*4.5*326 - End changed block
+20 ;
+21 KILL DIR
SET DIR(0)="YA"
SET DIR("B")="NO"
+22 SET DIR("A",1)="This will mark EFT # "_RCERANUM_" as removed."
+23 SET DIR("A")="Are you sure you want to continue? "
+24 WRITE !
+25 DO ^DIR
KILL DIR
+26 IF $DATA(DUOUT)!$DATA(DTOUT)!(Y=0)
DO NOCHNG
QUIT
+27 ;PRCA*4.5*375 - Add Removal Type field for Duplicate/Millenium EFTs
SET DIE="^RCY(344.31,"
SET DA=RCY
SET DR=".19;.2R"
DO ^DIE
+28 ; user aborted edit
IF $DATA(Y)
DO NOCHNG
QUIT
+29 ;
+30 ; 344.31,.08 - MATCH STATUS
+31 ; 344.31,.17 - USER WHO REMOVED EFT
+32 ; 344.31,.18 - DATE/TIME DUPLICATE REMOVED
+33 SET DR=".08////1;.17////"_DUZ_";.18////"_$$NOW^XLFDT
DO ^DIE
+34 WRITE !!
+35 KILL DIR
SET DIR(0)="EA"
+36 SET DIR("A")="Press return to continue: "
+37 SET DIR("A",1)="EFT # "_RCERANUM_" has been marked as removed."
+38 DO ^DIR
+39 QUIT
+40 ;
NOCHNG ;
+1 NEW DIR,DTOUT,DUOUT,X,Y
+2 SET DIR(0)="EA"
+3 SET DIR("A")="Press return to continue: "
+4 SET DIR("A",1)="*** This EFT was NOT removed. ***"
+5 WRITE !!
DO ^DIR
+6 QUIT
+7 ;
+8 ; BEGIN PRCA*4.5*326
DICW ; Identifier code for EFT lookup - EP MATCH1^RCDPEM3 and MATCH2^RCDPEM2
+1 ; Input - Y = EFT DETAIL #344.31 IEN
+2 ; D = Index ("B","C","E","F","FNLZ")
+3 ; DZ = User input from ^DIE call, "?" or "??" if help list was requested
+4 ;
+5 ; PRCA*4.5*371 - Removed D and DZ from new staPress return to continue:Press return to continue:tement
+6 NEW DATA,DEPDAT,DEPNO,EFTID,EFTIEN,EFTTR,PAYAMT,PAYNAM,PAYTR,SP,TIN
+7 SET DATA=$GET(^RCY(344.31,Y,0))
IF DATA=""
QUIT
+8 SET SP=$JUSTIFY("",3)
SET EFTIEN=$PIECE(DATA,U,1)
+9 SET EFTTR=""
SET EFTID=EFTIEN
IF $PIECE(DATA,U,14)
SET EFTID=EFTID_"."_$PIECE(DATA,U,14)
+10 SET PAYNAM=$$GET1^DIQ(344.31,Y,.02,"E")
+11 SET TIN=$$GET1^DIQ(344.31,Y,.03,"E")
+12 SET PAYTR=$$GET1^DIQ(344.31,Y,.04,"E")
+13 SET PAYAMT=$$GET1^DIQ(344.31,Y,.07,"E")
+14 SET DEPNO=$$GET1^DIQ(344.3,EFTIEN,.03,"E")
+15 SET DEPDAT=$$FMTE^XLFDT($$GET1^DIQ(344.3,EFTIEN,.07,"I"),"2DZ")
+16 ; EFT DETAIL lookup
+17 ;
IF $GET(DZ)="??"!($GET(DZ)="?")
Begin DoDot:1
+18 SET PAYNAM=$EXTRACT(PAYNAM,1,58-$LENGTH(TIN))_"/"_TIN
IF PAYNAM="/"
SET PAYNAM=""
+19 WRITE ?10,EFTID,?20," ",PAYNAM
+20 WRITE !,?20," ",PAYTR,?48," ",$JUSTIFY(PAYAMT,10)
+21 WRITE ?59," ",DEPNO,?71," ",DEPDAT
End DoDot:1
+22 ;
IF '$TEST
Begin DoDot:1
+23 SET PAYNAM=$EXTRACT(PAYNAM,1,52-$LENGTH(TIN))_"/"_TIN
IF PAYNAM="/"
SET PAYNAM=""
+24 ; Search index EFT# or EFT ID#
IF D="B"!(D="D")
Begin DoDot:2
+25 WRITE ?25," ",PAYNAM
+26 WRITE !,?25," ",PAYTR,?48," ",$JUSTIFY(PAYAMT,10)
+27 WRITE ?59," ",DEPNO,?71," ",DEPDAT
End DoDot:2
QUIT
+28 ; Search index PAYER NAME
IF D="C"
Begin DoDot:2
+29 WRITE " ",EFTID
+30 WRITE !,?20," ",PAYTR,?48," ",$JUSTIFY(PAYAMT,10)
+31 WRITE ?59," ",DEPNO,?71," ",DEPDAT
End DoDot:2
QUIT
+32 ; Search index DATE/TIME DUPLICATE REMOVED
IF D="E"
Begin DoDot:2
+33 WRITE " ",EFTID,?25," ",PAYNAM
+34 WRITE !,?25," ",PAYTR,?48," ",$JUSTIFY(PAYAMT,10)
+35 WRITE ?59," ",DEPNO,?71," ",DEPDAT
End DoDot:2
QUIT
+36 ; Search index TRACE#
IF D="F"
Begin DoDot:2
+37 WRITE " ",EFTID,?48,$JUSTIFY(PAYAMT,10),?59," ",DEPNO,?71," ",DEPDAT
+38 WRITE !,?25," ",PAYNAM
End DoDot:2
QUIT
End DoDot:1
+39 ;
+40 ; Next line required to fix problem when ??, ^ from help, then ?? again reverts back to old help.
+41 ; If DIC(0)["A" DIC("W") is not killed off.
+42 IF $GET(DIC(0))'["A"
SET DIC(0)="A"_$GET(DIC(0))
+43 QUIT
+44 ;
OUT(RCEFT) ; EP UNMATCH^RCDPEM2
+1 ; INPUT - RCEFT - #344.31 ien
+2 ; OUTPUT - EFT_"."_TRAN - formatted EFT line
+3 NEW EFT,TRAN
+4 SET EFT=$$GET1^DIQ(344.31,RCEFT_",",.01,"I")
+5 SET TRAN=$$GET1^DIQ(344.31,RCEFT_",",.14)
+6 QUIT EFT_"."_TRAN
+7 ; END PRCA*4,5*326
