RCDPEM6 ;OIFO-BAYPINES/RBN - DUPLICATE EFT DEPOSITS AUDIT REPORT ;Jun 11, 2014@18:03:49
;;4.5;Accounts Receivable;**276,298,326,375,432**;Mar 20, 1995;Build 16
;Per VA Directive 6402, this routine should not be modified.
;
; completely refactored for PRCA*4.5*298
Q
;
; generate an audit report that displays EFTs that have been removed by the user
; user selects a date range to limit the number of EFTs displayed.
; EDI THIRD PARTY EFT DETAIL file (#344.31)
;
; INPUT: user prompted for Date/Time range
;
; OUTPUT:
; report OF EFTs that have been removed.
; The report has the following:
; Trace number, Payer name, Deposit number, Date removed, User, Justification for removal
; data taken from EDI THIRD PARTY EFT DETAIL file (#344.31)
; report formatted for 80 columns
;
; put into ^TMP($J,"RCDPEM6",counter) for ListMan
; $pieces: DEPOSIT NUMBER^EFT DETAIL^PAYER^TRACE NUMBER^AMOUNT^DATE REMOVED^USER^JUSTIFICATION ; PRCA*4.5*326
;
EN1 ; entry point for EFT Audit Report
N I,RCDISPTY,RCDTRNG,RCHDR,RCLSTMGR,RCPGNUM,RCSTOP,RCTMPND,RCTYPE,X,Y
; RCDISPTY - Display/print/Excel flag
; RCDTRNG - date range selected
; RCHDR - header array
; RCLSTMGR - ListMan flag
; RCPGNUM - report page number
; RCSTOP - boolean, User indicated to stop
; RCTMPND - storage node in ^TMP
;
S RCLSTMGR=0,RCSTOP=1 ; PRCA*4.5*326 - Initialize variables used in EXIT
W !," "_$$HDRNM,!
S RCDTRNG=$$DTRNG^RCDPEM4() G:'(RCDTRNG>0) EXIT
S RCTYPE=$$RTYPE^RCDPEU1("A") I RCTYPE=-1 G EXIT ; PRCA*4.5*326
S RCLSTMGR="" ; ListMan flag, set to '^' if sent to Excel
S RCTMPND="" ; if null, report lines not stored in ^TMP, written directly
S RCDISPTY=$$DISPTY^RCDPEM3() G:RCDISPTY<0 EXIT
; display information for Excel, indicate not to ask for ListMan
I RCDISPTY D INFO S RCLSTMGR=U
; if not output to Excel ask for ListMan display, exit if timeout or '^' - PRCA*4.5*298
I RCLSTMGR="" S RCLSTMGR=$$ASKLM^RCDPEARL G:RCLSTMGR<0 EXIT
I RCLSTMGR D G EXIT
.S RCTMPND=$T(+0)_"^DUP EFT" K ^TMP($J,RCTMPND) ; clean any residue
.D GENRPRT,DSPRPRT ; generate report and store it in ^TMP
.N H,L,HDR S L=0
.S HDR("TITLE")=$$HDRNM
.F H=1:1 Q:'$D(RCHDR(H)) S L=H,HDR(H)=RCHDR(H) ; take first 3 lines of report header
.I $O(RCHDR(L)) D ; any remaining header lines at top of report
..N N S N=0,H=L F S H=$O(RCHDR(H)) Q:'H S N=N+.001,^TMP($J,RCTMPND,N)=RCHDR(H)
.D LMRPT^RCDPEARL(.HDR,$NA(^TMP($J,RCTMPND))) ; generate ListMan display
;
; Select output device
S %ZIS="QM" D ^%ZIS Q:POP
I $D(IO("Q")) D Q
.N ZTDESC,ZTRTN,ZTSAVE,ZTSK
.S ZTRTN="ENFRMQ^RCDPEM6",ZTDESC=$$HDRNM,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
; fall through to generate report
;
ENFRMQ ; entry point from TaskMan Queue
D GENRPRT,DSPRPRT
D EXIT
Q
;
GENRPRT ; Generate the report ^TMP array
; INPUT: RCDTRNG - date range for report
;
N EFTIEN,FRSTDT,INDXDT,LSTDT,X,Y
; INDXDT - date of EFT from "E" x-ref
; FRSTDT - Start date of report date range
; LSTDT - End date of report date range
; EFTIEN - IEN of EFT
;
K ^TMP($J,"RC DUP EFT") ; used for report
S FRSTDT=$P(RCDTRNG,U,2) S:FRSTDT<1 FRSTDT=2010101 ; 1 Jan 1901
S LSTDT=$P(RCDTRNG,U,3) S:LSTDT<1 LSTDT=4010101 ; 1 Jan 2101
S INDXDT=FRSTDT-.00000001 ; initial value for x-ref
;
; ^RCY(344.31,D0,3) = (#.17) USER WHO REMOVED EFT [1P:200] ^ (#.18) DATE/TIME DUPLICATE REMOVED [2D] ^ (#.19) EFT REMOVAL REASON [3F]
F S INDXDT=$O(^RCY(344.31,"E",INDXDT)) Q:'INDXDT!($P(INDXDT,".",1)>LSTDT) D ; PRCA*4.5*326
. S EFTIEN=0 F S EFTIEN=$O(^RCY(344.31,"E",INDXDT,EFTIEN)) Q:'EFTIEN D ;
. . I '$$ISTYPE^RCDPEU1(344.31,EFTIEN,RCTYPE) Q ; PRCA*4.5*326
. . D:$D(^RCY(344.31,EFTIEN,3)) PROC(EFTIEN)
;
Q
;
DSPRPRT ; Format display for screen/printer, Excel, or ListMan
; RCDISPTY - display for Excel flag
; RCLSTMGR - display for ListMan flag
;
;PRCA*4.5*375 - Change IEN to RDT because sorting by removal date now
N CNT,DUPEFT,RDT,LINE,RCLNCNT,Y
; CNT - Count of EFT Deposits removed
; RDT - line number of the data in ^TMP
; DUPEFT - Data from ^TMP($J,"RC DUP EFT",RDT)
; RCLNCNT - line counter for SL^RCDPEARL
;
D:'RCLSTMGR HDRBLD
D:RCLSTMGR HDRLM
;
I $G(RCTMPND)'="" K ^TMP($J,RCTMPND) S RCLNCNT=0
D:'RCLSTMGR HDRLST^RCDPEARL(.RCSTOP,.RCHDR) ; initial report header
S RDT="",CNT=0
F S RDT=$O(^TMP($J,"RC DUP EFT",RDT)) Q:'RDT!RCSTOP D
.S CNT=CNT+1,DUPEFT=^TMP($J,"RC DUP EFT",RDT)
.I RCDISPTY D SL^RCDPEARL(DUPEFT,.RCLNCNT,RCTMPND) Q ; Excel format, write line and quit
.I 'RCLSTMGR,$Y>(IOSL-RCHDR(0)) D HDRLST^RCDPEARL(.RCSTOP,.RCHDR) Q:RCSTOP
.; BEGIN PRCA*4.5*326
.S Y=$$PAD^RCDPEARL(" "_$P(DUPEFT,U)_"/"_$P(DUPEFT,U,2),20)_$P(DUPEFT,U,4) D SL^RCDPEARL(Y,.RCLNCNT,RCTMPND)
.S Y=$J(" ",6)_$P(DUPEFT,U,3),$E(Y,80-$L($P(DUPEFT,U,9)))=$P(DUPEFT,U,9) D SL^RCDPEARL(Y,.RCLNCNT,RCTMPND) ; PRCA*4.5*375 - Add Removal Type
.S Y=$$PAD^RCDPEARL($J(" ",16)_$J($P(DUPEFT,U,5),0,2),28)_$P(DUPEFT,U,6)
.S Y=$$PAD^RCDPEARL(Y,50)_$E($P(DUPEFT,U,7),1,25) D SL^RCDPEARL(Y,.RCLNCNT,RCTMPND)
.D WP($P(DUPEFT,U,8)) D SL^RCDPEARL(" ",.RCLNCNT,RCTMPND)
.; END - PRCA*4.5*326
;
I 'RCDISPTY,'RCSTOP D ; not for Excel
.S Y=" Total number of duplicates removed: "_CNT D SL^RCDPEARL(Y,.RCLNCNT,RCTMPND),SL^RCDPEARL(" ",.RCLNCNT,RCTMPND)
;
I 'RCSTOP D SL^RCDPEARL($$ENDORPRT^RCDPEARL,.RCLNCNT,RCTMPND)
;
Q
;
PROC(EFTIEN) ; gather data into ^TMP
; EFTIEN = ien of the EFT
;
N AMT,DEPNO,EFTLID,JUST,PAYER,PTR,RCRD,RC0,RTRNDT,TRACE,USER,RMTYPE ; Added EFTLID - PRCA*4.5*326
; JUST - Justification for returning EFT
; TRACE - EFT Trace number
; AMT - amount of the EFT
; PAYER - EFT payer
; PTR - pointer to #344.3
; RTRNDT - Date EFT returned
; USER - User who completed the transaction
; DEPNO - Deposit # of EFT
; EFTLID - EFT Detail line identifier NNNN.NN
; RMTYPE - Removal Type (Duplicate or Millenial EFT)
;
S RCRD(0)=$G(^RCY(344.31,EFTIEN,0)),RCRD(3)=$G(^(3))
S RC0=RCRD(0),U="^" D DEBEFT^RCDPEARL(.RC0) S RCRD(0)=RC0 ;Add minus sign for debit amounts PRCA*4.5*432
S USER=$$NAME^XUSER($P(RCRD(3),U),"F")
S RTRNDT=$$FMTE^XLFDT($P(^RCY(344.31,EFTIEN,3),U,2),2)
S JUST=$P(RCRD(3),U,3)
S PAYER=$P(RCRD(0),U,2) S:PAYER="" PAYER="Unknown Payer"
S TRACE=$P(RCRD(0),U,4),AMT=$P(RCRD(0),U,7)
S PTR=+$P(RCRD(0),U)
; EDI LOCKBOX DEPOSIT (#344.3), (#.06) DEPOSIT NUMBER [6F]
S:PTR>0 DEPNO=$P($G(^RCY(344.3,PTR,0)),U,6)
S:DEPNO="" DEPNO="Unknown"
S EFTLID=$$GET1^DIQ(344.31,EFTIEN_",",.01,"E") ; PRCA*4.5*326
S RMTYPE=$$GET1^DIQ(344.31,EFTIEN_",",.2,"E") ; PRCA*4.5*375 - Get removal type
S ^TMP($J,"RC DUP EFT",RTRNDT)=DEPNO_"^"_EFTLID_"^"_PAYER_"^"_TRACE_"^"_AMT_"^"_RTRNDT_"^"_USER_"^"_JUST_"^"_RMTYPE ; PRCA*4.5*326 , PRCA*4.5*375 - Add removal type and sort by date removed
Q
;
HDRBLD ; create the report header
; returns RCHDR, RCPGNUM, RCSTOP
; 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
; INPUT:
; RCDISPTY - Display/print/Excel flag
; RCRTYP - Report Type (EOB or ERA)
; RCDTRNG - selected dates
;
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=""
.S RCHDR(1)="DEPOSIT NUMBER^EFT NUMBER^PAYER^TRACE NUMBER^AMOUNT^DATE REMOVED^USER^JUSTIFICATION^REMOVAL TYPE"
;
N DIV,HCNT,Y
S HCNT=0 ; counter for header
;
S Y=$$HDRNM,HCNT=1,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)_",RCHDR(1)=$J("" "",80-$L(Y)\2)_Y_"" Page: ""_RCPGNUM"
S Y="RUN DATE: "_RCHDR("RUNDATE")
; PRCA*4.5*326 - Add M/P/T filter
S Y=Y_$J("",16)_"CHAMPVA/MEDICAL/PHARM/TRICARE: " ;PRCA*4.5*432 Add CHAMPVA, 17->16
S Y=Y_$S(RCTYPE="C":"CHAMPVA",RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",1:"ALL") ;PRCA*4.5*432 Add CHAMPVA
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")_" - "_$$FMTE^XLFDT(Y("LST"),"2Z")_" (DATE EFT REMOVAL)"
S HCNT=HCNT+1,RCHDR(HCNT)=$J("",80-$L(Y)\2)_Y
S HCNT=HCNT+1,RCHDR(HCNT)=""
K Y ; delete Y subscripts
I $G(RCLSTMGR) S HCNT=HCNT+1,RCHDR(HCNT)="",HCNT=HCNT+1,RCHDR(HCNT)=""
S Y=$$PAD^RCDPEARL(" Deposit#/EFT#",20)_"Trace #",HCNT=HCNT+1,RCHDR(HCNT)=Y ; PRCA*4.5*326
S Y=$$PAD^RCDPEARL($J(" ",6)_"Payer Name",28),Y=Y_"Date/Time",Y=$$PAD^RCDPEARL(Y,50)_"User Who",Y=$$PAD^RCDPEARL(Y,68)_"Removal Type"
S HCNT=HCNT+1,RCHDR(HCNT)=Y
S Y=$J(" ",16)_"Amount",Y=$$PAD^RCDPEARL(Y,28)_"Removed",Y=$$PAD^RCDPEARL(Y,50)_"Removed"
S HCNT=HCNT+1,RCHDR(HCNT)=Y
S Y="",$P(Y,"=",81)="",HCNT=HCNT+1,RCHDR(HCNT)=Y
;
S RCHDR(0)=HCNT
Q
;
HDRLM ; create the Listman Screen header section
; returns RCHDR
; RCHDR(0) = header text line count
; INPUT:
; RCDTRNG - selected dates
;
K RCHDR S RCPGNUM=0,RCSTOP=0
;
N DIV,HCNT,Y
S HCNT=0 ; counter for header
;
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")_" - "_$$FMTE^XLFDT(Y("LST"),"2Z")_" (DATE EFT REMOVAL)"
S HCNT=HCNT+1,RCHDR(HCNT)=""
S HCNT=HCNT+1,RCHDR(HCNT)=Y
K Y ; delete Y subscripts
S Y="CHAMPVA/Medical/Pharm/Tricare: " ; PRCA*4.5*326 - Add M/P/T filter ;PRCA*4.5*432 Add CHAMPVA
S Y=Y_$S(RCTYPE="C":"CHAMPVA",RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",1:"ALL") ; ; PRCA*4.5*326 ;PRCA*4.5*432 Add CHAMPVA
S HCNT=HCNT+1,RCHDR(HCNT)=Y
S HCNT=HCNT+1,RCHDR(HCNT)=""
S Y=$$PAD^RCDPEARL(" Deposit#/EFT#",20)_"Trace #",HCNT=HCNT+1,RCHDR(HCNT)=Y ; PRCA*4.5*326
S Y=$$PAD^RCDPEARL($J(" ",6)_"Payer Name",28),Y=Y_"Date/Time",Y=$$PAD^RCDPEARL(Y,50)_"User Who",Y=$$PAD^RCDPEARL(Y,68)_"Removal Type"
S HCNT=HCNT+1,RCHDR(HCNT)=Y
S Y=$J(" ",16)_"Amount",Y=$$PAD^RCDPEARL(Y,28)_"Removed",Y=$$PAD^RCDPEARL(Y,50)_"Removed"
S HCNT=HCNT+1,RCHDR(HCNT)=Y
;
S RCHDR(0)=HCNT
Q
;
; extrinsic variable, header text
HDRNM() Q "Duplicate EFT Deposits - Audit Report"
;
EXIT ;
I '$D(ZTQUEUED),'RCLSTMGR,'RCSTOP D ASK^RCDPEARL(.RCSTOP) ; PRCA*4.5*326
D ^%ZISC
K ^TMP($J,"RC DUP EFT") ; clean up
Q
;
INFO ; Useful Info for Excel capture
N SP S SP=$J(" ",10) ; spaces
W !!!,SP_"Before continuing, please set up your terminal to capture the"
W !,SP_"report data as this report may take a while to run."
W !!,SP_"To avoid undesired wrapping of the data saved to the"
W !,SP_"file, please enter '0;256;999' at the 'DEVICE:' prompt."
W !!,SP_"It may be necessary to set the terminal's display width"
W !,SP_"to 256 characters, which can be performed by selecting the"
W !,SP_"Display option located within the 'Setup' menu on the"
W !,SP_"tool bar of the terminal emulation software (e.g. KEA,"
W !,SP_"Reflection, or Smarterm).",!!
Q
;
WP(JC) ; format justification comments
; JC - Justification Comment
I JC="" Q
N PCS,I,CNTR,CMNT,Y
; PCS - Number of " " $pieces in the comment
; CNTR - CMNT line counter
; CMNT - comment text to be displayed
S PCS=$L(JC," "),CNTR=1,CMNT(CNTR)=" Justification Comments: "
F I=1:1:PCS D
.S Y=$P(JC," ",I)
.S:$L(CMNT(CNTR))+$L(Y)>72 CNTR=CNTR+1,CMNT(CNTR)=$J(" ",25)
.S CMNT(CNTR)=CMNT(CNTR)_" "_Y
;
F I=1:1:CNTR D SL^RCDPEARL(CMNT(I),.RCLNCNT,RCTMPND)
Q
;
NOW() ;function, Returns current date/time in format mm/dd/yy@hh:mm:ss
Q $$FMTE^XLFDT($$NOW^XLFDT,2)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEM6 11935 printed Dec 13, 2024@01:44:51 Page 2
RCDPEM6 ;OIFO-BAYPINES/RBN - DUPLICATE EFT DEPOSITS AUDIT REPORT ;Jun 11, 2014@18:03:49
+1 ;;4.5;Accounts Receivable;**276,298,326,375,432**;Mar 20, 1995;Build 16
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; completely refactored for PRCA*4.5*298
+5 QUIT
+6 ;
+7 ; generate an audit report that displays EFTs that have been removed by the user
+8 ; user selects a date range to limit the number of EFTs displayed.
+9 ; EDI THIRD PARTY EFT DETAIL file (#344.31)
+10 ;
+11 ; INPUT: user prompted for Date/Time range
+12 ;
+13 ; OUTPUT:
+14 ; report OF EFTs that have been removed.
+15 ; The report has the following:
+16 ; Trace number, Payer name, Deposit number, Date removed, User, Justification for removal
+17 ; data taken from EDI THIRD PARTY EFT DETAIL file (#344.31)
+18 ; report formatted for 80 columns
+19 ;
+20 ; put into ^TMP($J,"RCDPEM6",counter) for ListMan
+21 ; $pieces: DEPOSIT NUMBER^EFT DETAIL^PAYER^TRACE NUMBER^AMOUNT^DATE REMOVED^USER^JUSTIFICATION ; PRCA*4.5*326
+22 ;
EN1 ; entry point for EFT Audit Report
+1 NEW I,RCDISPTY,RCDTRNG,RCHDR,RCLSTMGR,RCPGNUM,RCSTOP,RCTMPND,RCTYPE,X,Y
+2 ; RCDISPTY - Display/print/Excel flag
+3 ; RCDTRNG - date range selected
+4 ; RCHDR - header array
+5 ; RCLSTMGR - ListMan flag
+6 ; RCPGNUM - report page number
+7 ; RCSTOP - boolean, User indicated to stop
+8 ; RCTMPND - storage node in ^TMP
+9 ;
+10 ; PRCA*4.5*326 - Initialize variables used in EXIT
SET RCLSTMGR=0
SET RCSTOP=1
+11 WRITE !," "_$$HDRNM,!
+12 SET RCDTRNG=$$DTRNG^RCDPEM4()
if '(RCDTRNG>0)
GOTO EXIT
+13 ; PRCA*4.5*326
SET RCTYPE=$$RTYPE^RCDPEU1("A")
IF RCTYPE=-1
GOTO EXIT
+14 ; ListMan flag, set to '^' if sent to Excel
SET RCLSTMGR=""
+15 ; if null, report lines not stored in ^TMP, written directly
SET RCTMPND=""
+16 SET RCDISPTY=$$DISPTY^RCDPEM3()
if RCDISPTY<0
GOTO EXIT
+17 ; display information for Excel, indicate not to ask for ListMan
+18 IF RCDISPTY
DO INFO
SET RCLSTMGR=U
+19 ; if not output to Excel ask for ListMan display, exit if timeout or '^' - PRCA*4.5*298
+20 IF RCLSTMGR=""
SET RCLSTMGR=$$ASKLM^RCDPEARL
if RCLSTMGR<0
GOTO EXIT
+21 IF RCLSTMGR
Begin DoDot:1
+22 ; clean any residue
SET RCTMPND=$TEXT(+0)_"^DUP EFT"
KILL ^TMP($JOB,RCTMPND)
+23 ; generate report and store it in ^TMP
DO GENRPRT
DO DSPRPRT
+24 NEW H,L,HDR
SET L=0
+25 SET HDR("TITLE")=$$HDRNM
+26 ; take first 3 lines of report header
FOR H=1:1
if '$DATA(RCHDR(H))
QUIT
SET L=H
SET HDR(H)=RCHDR(H)
+27 ; any remaining header lines at top of report
IF $ORDER(RCHDR(L))
Begin DoDot:2
+28 NEW N
SET N=0
SET H=L
FOR
SET H=$ORDER(RCHDR(H))
if 'H
QUIT
SET N=N+.001
SET ^TMP($JOB,RCTMPND,N)=RCHDR(H)
End DoDot:2
+29 ; generate ListMan display
DO LMRPT^RCDPEARL(.HDR,$NAME(^TMP($JOB,RCTMPND)))
End DoDot:1
GOTO EXIT
+30 ;
+31 ; Select output device
+32 SET %ZIS="QM"
DO ^%ZIS
if POP
QUIT
+33 IF $DATA(IO("Q"))
Begin DoDot:1
+34 NEW ZTDESC,ZTRTN,ZTSAVE,ZTSK
+35 SET ZTRTN="ENFRMQ^RCDPEM6"
SET ZTDESC=$$HDRNM
SET ZTSAVE("RC*")=""
SET ZTSAVE("VAUTD")=""
+36 DO ^%ZTLOAD
+37 WRITE !!,$SELECT($GET(ZTSK):"Task number "_ZTSK_" queued.",1:"Unable to queue this task.")
+38 KILL IO("Q")
DO HOME^%ZIS
End DoDot:1
QUIT
+39 ;
+40 USE IO
+41 ; fall through to generate report
+42 ;
ENFRMQ ; entry point from TaskMan Queue
+1 DO GENRPRT
DO DSPRPRT
+2 DO EXIT
+3 QUIT
+4 ;
GENRPRT ; Generate the report ^TMP array
+1 ; INPUT: RCDTRNG - date range for report
+2 ;
+3 NEW EFTIEN,FRSTDT,INDXDT,LSTDT,X,Y
+4 ; INDXDT - date of EFT from "E" x-ref
+5 ; FRSTDT - Start date of report date range
+6 ; LSTDT - End date of report date range
+7 ; EFTIEN - IEN of EFT
+8 ;
+9 ; used for report
KILL ^TMP($JOB,"RC DUP EFT")
+10 ; 1 Jan 1901
SET FRSTDT=$PIECE(RCDTRNG,U,2)
if FRSTDT<1
SET FRSTDT=2010101
+11 ; 1 Jan 2101
SET LSTDT=$PIECE(RCDTRNG,U,3)
if LSTDT<1
SET LSTDT=4010101
+12 ; initial value for x-ref
SET INDXDT=FRSTDT-.00000001
+13 ;
+14 ; ^RCY(344.31,D0,3) = (#.17) USER WHO REMOVED EFT [1P:200] ^ (#.18) DATE/TIME DUPLICATE REMOVED [2D] ^ (#.19) EFT REMOVAL REASON [3F]
+15 ; PRCA*4.5*326
FOR
SET INDXDT=$ORDER(^RCY(344.31,"E",INDXDT))
if 'INDXDT!($PIECE(INDXDT,".",1)>LSTDT)
QUIT
Begin DoDot:1
+16 ;
SET EFTIEN=0
FOR
SET EFTIEN=$ORDER(^RCY(344.31,"E",INDXDT,EFTIEN))
if 'EFTIEN
QUIT
Begin DoDot:2
+17 ; PRCA*4.5*326
IF '$$ISTYPE^RCDPEU1(344.31,EFTIEN,RCTYPE)
QUIT
+18 if $DATA(^RCY(344.31,EFTIEN,3))
DO PROC(EFTIEN)
End DoDot:2
End DoDot:1
+19 ;
+20 QUIT
+21 ;
DSPRPRT ; Format display for screen/printer, Excel, or ListMan
+1 ; RCDISPTY - display for Excel flag
+2 ; RCLSTMGR - display for ListMan flag
+3 ;
+4 ;PRCA*4.5*375 - Change IEN to RDT because sorting by removal date now
+5 NEW CNT,DUPEFT,RDT,LINE,RCLNCNT,Y
+6 ; CNT - Count of EFT Deposits removed
+7 ; RDT - line number of the data in ^TMP
+8 ; DUPEFT - Data from ^TMP($J,"RC DUP EFT",RDT)
+9 ; RCLNCNT - line counter for SL^RCDPEARL
+10 ;
+11 if 'RCLSTMGR
DO HDRBLD
+12 if RCLSTMGR
DO HDRLM
+13 ;
+14 IF $GET(RCTMPND)'=""
KILL ^TMP($JOB,RCTMPND)
SET RCLNCNT=0
+15 ; initial report header
if 'RCLSTMGR
DO HDRLST^RCDPEARL(.RCSTOP,.RCHDR)
+16 SET RDT=""
SET CNT=0
+17 FOR
SET RDT=$ORDER(^TMP($JOB,"RC DUP EFT",RDT))
if 'RDT!RCSTOP
QUIT
Begin DoDot:1
+18 SET CNT=CNT+1
SET DUPEFT=^TMP($JOB,"RC DUP EFT",RDT)
+19 ; Excel format, write line and quit
IF RCDISPTY
DO SL^RCDPEARL(DUPEFT,.RCLNCNT,RCTMPND)
QUIT
+20 IF 'RCLSTMGR
IF $Y>(IOSL-RCHDR(0))
DO HDRLST^RCDPEARL(.RCSTOP,.RCHDR)
if RCSTOP
QUIT
+21 ; BEGIN PRCA*4.5*326
+22 SET Y=$$PAD^RCDPEARL(" "_$PIECE(DUPEFT,U)_"/"_$PIECE(DUPEFT,U,2),20)_$PIECE(DUPEFT,U,4)
DO SL^RCDPEARL(Y,.RCLNCNT,RCTMPND)
+23 ; PRCA*4.5*375 - Add Removal Type
SET Y=$JUSTIFY(" ",6)_$PIECE(DUPEFT,U,3)
SET $EXTRACT(Y,80-$LENGTH($PIECE(DUPEFT,U,9)))=$PIECE(DUPEFT,U,9)
DO SL^RCDPEARL(Y,.RCLNCNT,RCTMPND)
+24 SET Y=$$PAD^RCDPEARL($JUSTIFY(" ",16)_$JUSTIFY($PIECE(DUPEFT,U,5),0,2),28)_$PIECE(DUPEFT,U,6)
+25 SET Y=$$PAD^RCDPEARL(Y,50)_$EXTRACT($PIECE(DUPEFT,U,7),1,25)
DO SL^RCDPEARL(Y,.RCLNCNT,RCTMPND)
+26 DO WP($PIECE(DUPEFT,U,8))
DO SL^RCDPEARL(" ",.RCLNCNT,RCTMPND)
+27 ; END - PRCA*4.5*326
End DoDot:1
+28 ;
+29 ; not for Excel
IF 'RCDISPTY
IF 'RCSTOP
Begin DoDot:1
+30 SET Y=" Total number of duplicates removed: "_CNT
DO SL^RCDPEARL(Y,.RCLNCNT,RCTMPND)
DO SL^RCDPEARL(" ",.RCLNCNT,RCTMPND)
End DoDot:1
+31 ;
+32 IF 'RCSTOP
DO SL^RCDPEARL($$ENDORPRT^RCDPEARL,.RCLNCNT,RCTMPND)
+33 ;
+34 QUIT
+35 ;
PROC(EFTIEN) ; gather data into ^TMP
+1 ; EFTIEN = ien of the EFT
+2 ;
+3 ; Added EFTLID - PRCA*4.5*326
NEW AMT,DEPNO,EFTLID,JUST,PAYER,PTR,RCRD,RC0,RTRNDT,TRACE,USER,RMTYPE
+4 ; JUST - Justification for returning EFT
+5 ; TRACE - EFT Trace number
+6 ; AMT - amount of the EFT
+7 ; PAYER - EFT payer
+8 ; PTR - pointer to #344.3
+9 ; RTRNDT - Date EFT returned
+10 ; USER - User who completed the transaction
+11 ; DEPNO - Deposit # of EFT
+12 ; EFTLID - EFT Detail line identifier NNNN.NN
+13 ; RMTYPE - Removal Type (Duplicate or Millenial EFT)
+14 ;
+15 SET RCRD(0)=$GET(^RCY(344.31,EFTIEN,0))
SET RCRD(3)=$GET(^(3))
+16 ;Add minus sign for debit amounts PRCA*4.5*432
SET RC0=RCRD(0)
SET U="^"
DO DEBEFT^RCDPEARL(.RC0)
SET RCRD(0)=RC0
+17 SET USER=$$NAME^XUSER($PIECE(RCRD(3),U),"F")
+18 SET RTRNDT=$$FMTE^XLFDT($PIECE(^RCY(344.31,EFTIEN,3),U,2),2)
+19 SET JUST=$PIECE(RCRD(3),U,3)
+20 SET PAYER=$PIECE(RCRD(0),U,2)
if PAYER=""
SET PAYER="Unknown Payer"
+21 SET TRACE=$PIECE(RCRD(0),U,4)
SET AMT=$PIECE(RCRD(0),U,7)
+22 SET PTR=+$PIECE(RCRD(0),U)
+23 ; EDI LOCKBOX DEPOSIT (#344.3), (#.06) DEPOSIT NUMBER [6F]
+24 if PTR>0
SET DEPNO=$PIECE($GET(^RCY(344.3,PTR,0)),U,6)
+25 if DEPNO=""
SET DEPNO="Unknown"
+26 ; PRCA*4.5*326
SET EFTLID=$$GET1^DIQ(344.31,EFTIEN_",",.01,"E")
+27 ; PRCA*4.5*375 - Get removal type
SET RMTYPE=$$GET1^DIQ(344.31,EFTIEN_",",.2,"E")
+28 ; PRCA*4.5*326 , PRCA*4.5*375 - Add removal type and sort by date removed
SET ^TMP($JOB,"RC DUP EFT",RTRNDT)=DEPNO_"^"_EFTLID_"^"_PAYER_"^"_TRACE_"^"_AMT_"^"_RTRNDT_"^"_USER_"^"_JUST_"^"_RMTYPE
+29 QUIT
+30 ;
HDRBLD ; create the report header
+1 ; returns RCHDR, RCPGNUM, RCSTOP
+2 ; RCHDR(0) = header text line count
+3 ; RCHDR("XECUTE") = M code for page number
+4 ; RCHDR("RUNDATE") = date/time report generated, external format
+5 ; RCPGNUM - page counter
+6 ; RCSTOP - flag to exit
+7 ; INPUT:
+8 ; RCDISPTY - Display/print/Excel flag
+9 ; RCRTYP - Report Type (EOB or ERA)
+10 ; RCDTRNG - selected dates
+11 ;
+12 KILL RCHDR
SET RCHDR("RUNDATE")=$$NOW^RCDPEARL
SET RCPGNUM=0
SET RCSTOP=0
+13 ;
+14 ; Excel format, xecute code is QUIT, null page number
IF RCDISPTY
Begin DoDot:1
+15 SET RCHDR(0)=1
SET RCHDR("XECUTE")="Q"
SET RCPGNUM=""
+16 SET RCHDR(1)="DEPOSIT NUMBER^EFT NUMBER^PAYER^TRACE NUMBER^AMOUNT^DATE REMOVED^USER^JUSTIFICATION^REMOVAL TYPE"
End DoDot:1
QUIT
+17 ;
+18 NEW DIV,HCNT,Y
+19 ; counter for header
SET HCNT=0
+20 ;
+21 ; line 1 will be replaced by XECUTE code below
SET Y=$$HDRNM
SET HCNT=1
SET RCHDR(HCNT)=$JUSTIFY("",80-$LENGTH(Y)\2)_Y
+22 SET RCHDR("XECUTE")="N Y S RCPGNUM=RCPGNUM+1,Y=$$HDRNM^"_$TEXT(+0)_",RCHDR(1)=$J("" "",80-$L(Y)\2)_Y_"" Page: ""_RCPGNUM"
+23 SET Y="RUN DATE: "_RCHDR("RUNDATE")
+24 ; PRCA*4.5*326 - Add M/P/T filter
+25 ;PRCA*4.5*432 Add CHAMPVA, 17->16
SET Y=Y_$JUSTIFY("",16)_"CHAMPVA/MEDICAL/PHARM/TRICARE: "
+26 ;PRCA*4.5*432 Add CHAMPVA
SET Y=Y_$SELECT(RCTYPE="C":"CHAMPVA",RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",1:"ALL")
+27 ; line 1 will be replaced by XECUTE code below
SET HCNT=HCNT+1
SET RCHDR(HCNT)=$JUSTIFY("",80-$LENGTH(Y)\2)_Y
+28 ;
+29 SET Y("1ST")=$PIECE(RCDTRNG,U,2)
SET Y("LST")=$PIECE(RCDTRNG,U,3)
+30 FOR Y="1ST","LST"
SET Y(Y)=$$FMTE^XLFDT(Y(Y),"2Z")
+31 SET Y="Date Range: "_Y("1ST")_" - "_$$FMTE^XLFDT(Y("LST"),"2Z")_" (DATE EFT REMOVAL)"
+32 SET HCNT=HCNT+1
SET RCHDR(HCNT)=$JUSTIFY("",80-$LENGTH(Y)\2)_Y
+33 SET HCNT=HCNT+1
SET RCHDR(HCNT)=""
+34 ; delete Y subscripts
KILL Y
+35 IF $GET(RCLSTMGR)
SET HCNT=HCNT+1
SET RCHDR(HCNT)=""
SET HCNT=HCNT+1
SET RCHDR(HCNT)=""
+36 ; PRCA*4.5*326
SET Y=$$PAD^RCDPEARL(" Deposit#/EFT#",20)_"Trace #"
SET HCNT=HCNT+1
SET RCHDR(HCNT)=Y
+37 SET Y=$$PAD^RCDPEARL($JUSTIFY(" ",6)_"Payer Name",28)
SET Y=Y_"Date/Time"
SET Y=$$PAD^RCDPEARL(Y,50)_"User Who"
SET Y=$$PAD^RCDPEARL(Y,68)_"Removal Type"
+38 SET HCNT=HCNT+1
SET RCHDR(HCNT)=Y
+39 SET Y=$JUSTIFY(" ",16)_"Amount"
SET Y=$$PAD^RCDPEARL(Y,28)_"Removed"
SET Y=$$PAD^RCDPEARL(Y,50)_"Removed"
+40 SET HCNT=HCNT+1
SET RCHDR(HCNT)=Y
+41 SET Y=""
SET $PIECE(Y,"=",81)=""
SET HCNT=HCNT+1
SET RCHDR(HCNT)=Y
+42 ;
+43 SET RCHDR(0)=HCNT
+44 QUIT
+45 ;
HDRLM ; create the Listman Screen header section
+1 ; returns RCHDR
+2 ; RCHDR(0) = header text line count
+3 ; INPUT:
+4 ; RCDTRNG - selected dates
+5 ;
+6 KILL RCHDR
SET RCPGNUM=0
SET RCSTOP=0
+7 ;
+8 NEW DIV,HCNT,Y
+9 ; counter for header
SET HCNT=0
+10 ;
+11 SET Y("1ST")=$PIECE(RCDTRNG,U,2)
SET Y("LST")=$PIECE(RCDTRNG,U,3)
+12 FOR Y="1ST","LST"
SET Y(Y)=$$FMTE^XLFDT(Y(Y),"2Z")
+13 SET Y="Date Range: "_Y("1ST")_" - "_$$FMTE^XLFDT(Y("LST"),"2Z")_" (DATE EFT REMOVAL)"
+14 SET HCNT=HCNT+1
SET RCHDR(HCNT)=""
+15 SET HCNT=HCNT+1
SET RCHDR(HCNT)=Y
+16 ; delete Y subscripts
KILL Y
+17 ; PRCA*4.5*326 - Add M/P/T filter ;PRCA*4.5*432 Add CHAMPVA
SET Y="CHAMPVA/Medical/Pharm/Tricare: "
+18 ; ; PRCA*4.5*326 ;PRCA*4.5*432 Add CHAMPVA
SET Y=Y_$SELECT(RCTYPE="C":"CHAMPVA",RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",1:"ALL")
+19 SET HCNT=HCNT+1
SET RCHDR(HCNT)=Y
+20 SET HCNT=HCNT+1
SET RCHDR(HCNT)=""
+21 ; PRCA*4.5*326
SET Y=$$PAD^RCDPEARL(" Deposit#/EFT#",20)_"Trace #"
SET HCNT=HCNT+1
SET RCHDR(HCNT)=Y
+22 SET Y=$$PAD^RCDPEARL($JUSTIFY(" ",6)_"Payer Name",28)
SET Y=Y_"Date/Time"
SET Y=$$PAD^RCDPEARL(Y,50)_"User Who"
SET Y=$$PAD^RCDPEARL(Y,68)_"Removal Type"
+23 SET HCNT=HCNT+1
SET RCHDR(HCNT)=Y
+24 SET Y=$JUSTIFY(" ",16)_"Amount"
SET Y=$$PAD^RCDPEARL(Y,28)_"Removed"
SET Y=$$PAD^RCDPEARL(Y,50)_"Removed"
+25 SET HCNT=HCNT+1
SET RCHDR(HCNT)=Y
+26 ;
+27 SET RCHDR(0)=HCNT
+28 QUIT
+29 ;
+30 ; extrinsic variable, header text
HDRNM() QUIT "Duplicate EFT Deposits - Audit Report"
+1 ;
EXIT ;
+1 ; PRCA*4.5*326
IF '$DATA(ZTQUEUED)
IF 'RCLSTMGR
IF 'RCSTOP
DO ASK^RCDPEARL(.RCSTOP)
+2 DO ^%ZISC
+3 ; clean up
KILL ^TMP($JOB,"RC DUP EFT")
+4 QUIT
+5 ;
INFO ; Useful Info for Excel capture
+1 ; spaces
NEW SP
SET SP=$JUSTIFY(" ",10)
+2 WRITE !!!,SP_"Before continuing, please set up your terminal to capture the"
+3 WRITE !,SP_"report data as this report may take a while to run."
+4 WRITE !!,SP_"To avoid undesired wrapping of the data saved to the"
+5 WRITE !,SP_"file, please enter '0;256;999' at the 'DEVICE:' prompt."
+6 WRITE !!,SP_"It may be necessary to set the terminal's display width"
+7 WRITE !,SP_"to 256 characters, which can be performed by selecting the"
+8 WRITE !,SP_"Display option located within the 'Setup' menu on the"
+9 WRITE !,SP_"tool bar of the terminal emulation software (e.g. KEA,"
+10 WRITE !,SP_"Reflection, or Smarterm).",!!
+11 QUIT
+12 ;
WP(JC) ; format justification comments
+1 ; JC - Justification Comment
+2 IF JC=""
QUIT
+3 NEW PCS,I,CNTR,CMNT,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(JC," ")
SET CNTR=1
SET CMNT(CNTR)=" Justification Comments: "
+8 FOR I=1:1:PCS
Begin DoDot:1
+9 SET Y=$PIECE(JC," ",I)
+10 if $LENGTH(CMNT(CNTR))+$LENGTH(Y)>72
SET CNTR=CNTR+1
SET CMNT(CNTR)=$JUSTIFY(" ",25)
+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 ;
NOW() ;function, Returns current date/time in format mm/dd/yy@hh:mm:ss
+1 QUIT $$FMTE^XLFDT($$NOW^XLFDT,2)
+2 ;
