RCDPTAR ;ALB/TJB - EFT TRANSACTION AUDIT REPORT ;1/02/15
;;4.5;Accounts Receivable;**303,321,326,380,371**;Mar 20, 1995;Build 29
;;Per VA Directive 6402, this routine should not be modified.
;
Q
; PRCA*4.5*303 - EFT TRANSACTION AUDIT REPORT
;
; Executed by the option "EFT Transaction Audit Report" from the "EDI Lockbox Reports Menu"
;
; DESCRIPTION: The following generates a report that displays an audit history for an EFT
;
EN ; Main entry point for this report
; Ask Summary or Detail output
;
N DIR,DIRUT,DIROUT,DTOUT,DUOUT,RCREP,RCREP2,X,Y
W !
S DIR(0)="SOA^S:Summary Information Only;D:Detail Report"
S DIR("A")="(S)ummary or (D)etail Report format? "
S DIR("B")="SUMMARY"
D ^DIR
I $D(DTOUT)!$D(DUOUT)!(Y="") Q
S RCREP=Y
;
; PRCA*4.5*380 - Ask if display sum. rpt. by Dep. Date or Dep. Num.
S RCREP2=0
S:RCREP="S" RCREP2=$$ASKSUM2()
Q:RCREP2=-1
;
I RCREP="S",RCREP2=1 D SUM^RCDPTAR1
I RCREP="S",RCREP2=2 D SUM2^RCDPTAR1
I RCREP="D" D DET
Q
;
; PRCA*4.5*380 - New Subroutine added
ASKSUM2() ; Ask the user if they want to display the summary report by Deposit Date
; or by Deposit Number
; Input: None
; Returns: -1 - User quit or timed out
; 1 - Display Summary report by Deposit Date
; 2 - Display Summary report by Deposit Number
N DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
S DIR(0)="SOA^EFTS:EFTS by Date;DATE:Deposit Number"
S DIR("A")="(E)FTs by Date or (D)eposit? "
S DIR("B")="DEPOSIT"
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q -1
I $E(Y,1)="E" Q 1
Q 2
;
DET ; Entry point for detailed report
; Input: variable RCREP defined and equal to "D"
; Output: Written to device
;
N RCDATA,RCDET
;
DET1 ; Prompt for user selection criteria
K DIR
S DIR(0)="SO^N:Deposit Number;D:Deposit Date;R:Receipt Number;T:Trace Number"
S DIR("PRE")="S:X?1N X=$S(X=1:""N"",X=2:""d"",X=3:""r"",X=4:""t"",1:""X"")"
S DIR("L",1)="Search for EFT Number by:"
S DIR("L",2)=""
S DIR("L",3)=" 1. Deposit (N)umber"
S DIR("L",4)=" 2. Deposit (D)ate"
S DIR("L",5)=" 3. (R)eceipt #"
S DIR("L")=" 4. (T)race #"
S DIR("A")="Search for EFT by"
D ^DIR
I $D(DTOUT)!$D(DUOUT)!(Y="") Q ;PRCA*4.5*371 Changed G DETQ to Q
S RCDET=Y
;
; Do lookup of EFTs based on the user selection above
S RCDATA=""
D @($S(RCDET="N":"DN",RCDET="D":"DT",RCDET="R":"RC",1:"TR")_"(.RCDATA)")
;PRCA*4.5*371 Moved lines that were here to new method SHOWONE
Q
;
SHOWONE(STOP) ; Prompt for device and output data for one EFT
; Input: STOP - Initially set to 0
; Output: STOP - 1 user entered '^', 0 otherwise
;PRCA*4.5*371 - Added Method
N %ZIS,ZTSK,ZTRTN,ZTIO,ZTDESC,ZTSAVE,POP
S %ZIS="QM"
D ^%ZIS
S STOP=POP
Q:POP
I $D(IO("Q")) D Q
. S ZTRTN="RUN^RCDPTAR(RCDATA)"
. S ZTIO=ION
. S ZTSAVE("*")=""
. S ZTDESC="EFT TRANSACTION SUMMARY REPORT"
. D ^%ZTLOAD
. W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
. D HOME^%ZIS
U IO
D RUN(RCDATA)
Q
;
RUN(RCDATA) ; Compile and output the report
; Input: RCDATA - see subroutine EFTDA for delimited list of fields
; Output: none
;
; Compile Data
D COMPILE(RCDATA)
;
; Generate Report
D REPORT(RCDATA)
;
K ^TMP("RCDPTAR",$J)
Q
;
DN(RCDATA) ; Lookup by Deposit Number
; Input: RCDATA - null on entry
; Output: RCDATA - passed by refence - see subroutine EFTDATA for delimited list of fields
; Note variable RCDEFLUP is needed by LOOKUP^RCDPUDEP, which is called by the .01 field
;
N DIC,DTOUT,DUOUT,LOCKIEN,RCDEFLUP,STOP,USERDN,Y ;PRCA*4.5*371 Added STOP
S STOP=0 ;PRCA*4.5*371 Added line
;
DN2 ; Lookup Deposit Number ;PRCA*4.5*371 Added looping Tag
W !
S DIC="^RCY(344.1,",DIC(0)="QEAMn",DIC("A")="Select DEPOSIT: ",DIC("W")="D DICW^RCDPUDEP"
S RCDEFLUP=1
D ^DIC
I $G(DTOUT)!$G(DUOUT)!(Y=-1) S RCDATA=-1 Q
;
S LOCKIEN=+$O(^RCY(344.3,"ARDEP",+Y,""))
I 'LOCKIEN D G DN2 ;PRCA*4.5*371 Changed Q to G DN2
. W !!,"EFT NOT FOUND - please check Deposit"
. D PAUSE
;
; Get EFT pointer
S RCDATA=$$EFT(LOCKIEN)
;
;PRCA*4.5*371 - Added lines Begin
Q:RCDATA=-1
Q:RCDATA="" ; No EFTs found
D SHOWONE(.STOP) ; Display output
Q:STOP
G DN2
;PRCA*4.5*371 - Added lines End
Q
;
DT(RCDATA) ; Deposit Date
; Input: RCDATA - null on entry
; Output: RCDATA - passed by refence - see subroutine EFTDATA for delimited list of fields
;
;PRCA*4.5*371 Added STOP below
N CNT,DATA,DEPIEN,DIR,DIROUT,DIRUT,DTOUT,DUOUT,ITEM,LINE,LIST,RCDT,RCI,RCIEN,STOP,X,Y
S STOP=0 ;PRCA*4.5*371 Added line
;
DT1 ; Ask the user for the Deposit Date
K DIR
S DIR(0)="DAO^:"_DT_":APE",DIR("B")="T"
S DIR("A")="Select DEPOSIT DATE: "
D ^DIR
I $D(DTOUT)!$D(DUOUT) S RCDATA=-1 Q
S RCDT=Y
;
; Build List
K LIST
S RCI="",CNT=0
F S RCI=$O(^RCY(344.3,"ADEP",RCDT,RCI)) Q:RCI="" D
. S RCIEN=""
. F S RCIEN=$O(^RCY(344.3,"ADEP",RCDT,RCI,RCIEN)) Q:RCIEN="" D
. . S DEPIEN=$P($G(^RCY(344.3,RCIEN,0)),U,3)
. . I DEPIEN="" Q
. . S DATA=$G(^RCY(344.1,DEPIEN,0))
. . I DATA="" Q
. . S CNT=CNT+1
. . ; Code below is similiar to DICW^RCDPUDEP code
. . S LINE=$J(CNT,3)_". "_$P(DATA,U,1)
. . S $E(LINE,19)="by: "_$E($P($G(^VA(200,+$P(DATA,"^",6),0)),"^"),1,15)
. . I '$P(DATA,"^",7) S $P(DATA,"^",7)="???????"
. . S $E(LINE,39)="on: "_$E($P(DATA,"^",7),4,5)_"/"_$E($P(DATA,"^",7),6,7)_"/"_$E($P(DATA,"^",7),2,3)
. . S $E(LINE,52)="amt: $"_$J($P(DATA,"^",4),10,2)
. . S $E(LINE,70)=$P("N/A^OPEN^DEPOSITED^CONFIRMED^PROCESSED^VOID","^",+$P(DATA,"^",12)+1)
. . S LIST(CNT)=RCIEN_"^"_$P(DATA,U,1)_"^"_LINE
;
; If no deposits in the LIST, display a message and try again
I CNT=0 D G DT1
. W !,"Date ",$$DATE^RCDPRU(RCDT)," does not have any valid deposits, please try again...",!
;
; If only one deposit in the list, use it
I CNT=1 D Q:STOP G DT1 ;PRCA*4.5*371 Changed Q to Q:STOP G DT1
. S RCDATA=$$EFT(+LIST(CNT))
. ;
. ;PRCA*4.5*371 Begin Added lines
. Q:RCDATA=-1
. Q:RCDATA="" ; No EFTs found
. D SHOWONE(.STOP) ; Display output
. ;PRCA*4.5*371 End Added lines
;
DT2 ; Multiple entries found so prompt for the one that is wanted ;PRCA*4.5*371 Added looping Tag
W !!,"Deposits on ",$$DATE^RCDPRU(RCDT)
K DIR,ITEM
S DIR(0)="SAO^"
S DIR("A")="Select DEPOSIT: "
S DIR("L",1)=" Choose from:"
F LINE=1:1:CNT D
. S DATA=LIST(LINE),DIR(0)=DIR(0)_LINE_":"_$P(DATA,U,2)_";"
. S DIR("L",LINE+1)=$P(DATA,U,3),ITEM(LINE)=+DATA
. W !," ",$P(DATA,U,3)
S DIR(0)=$E(DIR(0),1,$L(DIR(0))-1)
S DIR("L")=DIR("L",CNT+1) K DIR("L",CNT+1)
W !
D ^DIR
I $D(DTOUT)!$D(DUOUT) S RCDATA=-1 Q
I Y="" G DT1
S RCDATA=$$EFT(ITEM(Y))
;
;PRCA*4.5*371 - Added lines Begin
Q:RCDATA=-1
Q:RCDATA="" ; No EFTs found
D SHOWONE(.STOP) ; Display output
Q:STOP
G DT2
;PRCA*4.5*371 - Added lines End
Q
;
RC(RCDATA) ; Lookup by Receipt Number
; Input: RCDATA - null on entry
; Output: RCDATA - passed by refence - see subroutine EFTDATA for delimited list of fields
;
N D,DIC,DTOUT,DUOUT,RCDTN,RCED,RCIEN,STOP,X,Y ;PRCA*4.5*371 Added Stop
S STOP=0 ;PRCA*4.5*371 Added line
RC2 ; ;PRCA*4.5*371 Added looping Tag
W !
S DIC="^RCY(344,",DIC(0)="QEAMn",DIC("A")="Select RECEIPT: "
S DIC("W")="D DICW^RCDPUREC"
S DIC("S")="I $$EDILBEV^RCDPEU($P($G(^(0)),U,4))"
D ^DIC
I $D(DTOUT)!$D(DUOUT)!(Y=-1) S RCDATA=-1 Q
;
; Check if there is a pointer to the AR Deposit
S RCDATA=""
S RCIEN=$P($G(^RCY(344,+Y,0)),U,6)
;
; If there is, then get the EFT via AR Deposit and EDI LockBox files
I RCIEN D
. ; Get Ticket Number
. S RCDTN=$P($G(^RCY(344.1,RCIEN,0)),U,1)
. I RCDTN="" Q
. ;
. ; Get EDI Lockbox Deposit File
. S RCED=$O(^RCY(344.3,"C",RCDTN,""))
. I RCED="" Q
. S RCDATA=$$EFT(RCED)
;
; If this AR Deposit record is not found, check if it is a receipt on the ERA
I 'RCIEN D
. S ERAIEN=$O(^RCY(344.4,"H",+Y,""))
. I 'ERAIEN S ERAIEN=$O(^RCY(344.4,"ARCT",+Y,""))
. I 'ERAIEN Q
. S EFTIEN=$O(^RCY(344.31,"AERA",ERAIEN,""))
. I EFTIEN S RCDATA=$$EFTDATA(EFTIEN)
;
I RCDATA="" D G RC2 ;PRCA*4.5*371 Changed Q to G RC2
. W !!,"EFT NOT FOUND - please check Receipt"
. D PAUSE
;
;PRCA*4.5*371 - Added lines Begin
Q:RCDATA=-1
Q:RCDATA="" ; No EFTs found
D SHOWONE(.STOP) ; Display output
Q:STOP
G RC2
;PRCA*4.5*371 - Added lines End
Q
;
TR(RCDATA) ; Lookup by Trace Number
; Input: RCDATA - null on entry
; Output: RCDATA - passed by refence - see subroutine EFTDATA for delimited list of fields
N D,DIC,DTOUT,DUOUT,STOP,X,Y ;PRCA*4.5*371 Added STOP
S STOP=0 ;PRCA*4.5*371 Added line
;
TR2 ; Use "F" index in EDI EFT Detail file ;PRCA*4.5*371 Added looping Tag
W !
S DIC="^RCY(344.31,",DIC(0)="QEASn",D="F",DIC("A")="Select TRACE: "
; DIC("W") may need to be fixed if Trace numbers go over 32 characters. The fields
; displayed are the EFT#, Insurance company name, amount and Date Recieved.
S DIC("W")="D EN^DDIOL($J($P(^(0),U,1),7)_"" ""_$$LJ^XLFSTR($E($P(^(0),U,2),1,20),20)_$J($P(^(0),U,7),10)_"" ""_$$DATE^RCDPRU($P(^(0),U,13)),,""?32"")"
D IX^DIC
I $D(DTOUT)!$D(DUOUT)!(Y=-1) S RCDATA=-1 Q
S RCDATA=$$EFTDATA(+Y)
;
;PRCA*4.5*371 - Added lines Begin
Q:RCDATA=-1
Q:RCDATA="" ; No EFTs found
D SHOWONE(.STOP) ; Display output
Q:STOP
G TR2
;PRCA*4.5*371 - Added lines End
Q
;
EFT(LOCKIEN) ; Select a single EFT Number
; Input: LOCKIEN - IEN for LOCKBOX DEPOSIT (#344.3)
; Return: LIST(Y) - Delimiter list of information as returned by suboutine EFTDATA
;
I '$G(LOCKIEN) W !!,"No EFT detail for this selection" D PAUSE Q ""
;
N EFTIEN,CNT,DATA,LIST,Y
;
S EFTIEN="",CNT=0
F S EFTIEN=$O(^RCY(344.31,"B",LOCKIEN,EFTIEN)) Q:EFTIEN="" D ;
. S DATA=$$EFTDATA(EFTIEN) I DATA]"" S CNT=CNT+1,LIST(CNT)=DATA
;
I CNT=0 W !!,"No EFT detail for this selection" D PAUSE Q ""
;
; If only one EFT, select it and quit
I CNT=1 S Y=1 G EFT1
;
; Display and the let the user select the EFT
N DIR,DIRUT,DIROUT,DTOUT,DUOUT,ROW,TRANS,X
S DIR(0)="SO^"
S DIR("A")="Select item from list"
S DIR("L",1)="Select single EFT:"
F ROW=1:1:CNT-1 D
. S DATA=LIST(ROW),LOCKIEN=$P(DATA,U,2),EFTIEN=$P(DATA,U,3),TRANS=$$GET1^DIQ(344.31,EFTIEN_",",.01,"I")
. S DIR(0)=DIR(0)_ROW_":"_TRANS_";"
. S DIR("L",(ROW+1))=$J(ROW,3)_". "_TRANS_$$DISPLAY(EFTIEN,LOCKIEN) ; PRCA*4.5*326
S DATA=LIST(CNT),LOCKIEN=$P(DATA,U,2),EFTIEN=$P(DATA,U,3),TRANS=$$GET1^DIQ(344.31,EFTIEN_",",.01,"I")
S DIR(0)=DIR(0)_CNT_":"_TRANS
S DIR("L")=$J(CNT,3)_". "_TRANS_$$DISPLAY(EFTIEN,LOCKIEN) ; PRCA*4.5*326
D ^DIR
I $D(DTOUT)!$D(DUOUT)!(Y="") Q -1
;
EFT1 ;
Q LIST(Y)
;
EFTDATA(EFTIEN) ; Get associated records for this EFT
; Input: EFTIEN - IEN for EFT [344.31]
; Returns: A1^A2^A3^A4^45
; where A1=ERAIEN - IEN for ERA (#344.4)
; A2=LOCKIEN - IEN for LOCKBOX DEPOSIT (#344.3)
; A3=EFTIEN - IEN for EFT (#344.31)
; A4=DEPIEN - IEN for AR DEPOSIT (#344.1)
; A5=BATCHIEN - IEN for AR BATCH PAYMENT (#344)
;
I '$G(EFTIEN) Q ""
;
N BATCHIEN,DEPIEN,ERAIEN,LOCKIEN ;PRCA*4.5*321 removed DEPOSIT
S (ERAIEN,DEPIEN,BATCHIEN)=""
S ERAIEN=$$GET1^DIQ(344.31,EFTIEN,.1,"I") ;PRCA*4.5*321 use ^DIQ vs global access
S LOCKIEN=$$GET1^DIQ(344.31,EFTIEN,.01,"I") ;PRCA*4.5*321
I LOCKIEN S DEPIEN=$$GET1^DIQ(344.3,LOCKIEN,.03,"I") ;PRCA*4.5*321 instead of $O on B index of 344.1
I DEPIEN S BATCHIEN=$O(^RCY(344,"AD",DEPIEN,""))
Q ERAIEN_U_LOCKIEN_U_EFTIEN_U_DEPIEN_U_BATCHIEN
;
DISPLAY(EFTIEN,LOCKIEN) ; Display EFT detail during user selection process
; Input: EFTIEN - IEN for EFT (#344.31)
; LOCKIEN - IEN for LOCKBOX DEPOSIT (#344.3)
; Return: X1_" "_X2_" "_X3_" "_X4_" "_X5
; where X1=PAYER NAME
; X2=TRACE NUMBER
; X3=AMOUNT OF PAYMENT
; X4=DEPOSIT NUMBER
; X5=DEPOSIT DATE
N SUFX,X ; Added Suffix - PRCA*4.5*326
S EFTIEN=$G(EFTIEN)
S LOCKIEN=$G(LOCKIEN)
S SUFX=$$GET1^DIQ(344.31,EFTIEN_",",.14) ; PRCA*4.5*326
S:SUFX SUFX="."_SUFX ; PRCA*4.5*326
S X=SUFX_$J("",4-$L(SUFX)) ; PRCA*4.5*326
S X=X_$$GET1^DIQ(344.31,EFTIEN_",",.02)_" "_$$GET1^DIQ(344.31,EFTIEN_",",.04)_" " ; PRCA*4.5*326
S X=X_$$GET1^DIQ(344.31,EFTIEN_",",.07)_" "_$$GET1^DIQ(344.3,LOCKIEN_",",.06)_" "
S X=X_$$DATE^RCDPRU($$GET1^DIQ(344.3,LOCKIEN_",",.07,"I"),"2DZ")
Q X
;
COMPILE(RCDATA) ; Compile data for display
; Input: RCDATA - see subroutine EFTDA for delimited list of fields
; Output: ^TMP("RCDPTAR",$J)
;
I $G(RCDATA)="" Q
;
N BATCHIEN,DEPDATE,DEPIEN,EFTIEN,ERAIEN,FILEDATE,FMSDOCNO,IENS,LASTIEN,LINE,LOCKIEN
N MATCHDATE,MATCHIEN,PROCDATE,STATUS,TRANS
K ^TMP("RCDPTAR",$J)
;
; Get Pointers from RCDATA
S ERAIEN=$P(RCDATA,U,1),LOCKIEN=$P(RCDATA,U,2),EFTIEN=$P(RCDATA,U,3)
S DEPIEN=$P(RCDATA,U,4),BATCHIEN=$P(RCDATA,U,5)
;
; Get Inital Creation/Deposit information
K RCDATA
I LOCKIEN D
. D GETS^DIQ(344.3,LOCKIEN_",",".02;.06;.08","IE","RCDATA")
. S FILEDATE=$G(RCDATA(344.3,LOCKIEN_",",.02,"I"))
. I 'FILEDATE Q
. S ^TMP("RCDPTAR",$J,FILEDATE,1)="DEP#:"_$G(RCDATA(344.3,LOCKIEN_",",.06,"E"))_" DEP AMT:"_$G(RCDATA(344.3,LOCKIEN_",",.08,"E"))_"^EFT STATUS:RECEIVED"
;
; Check if posted to revenue code 8NZZ
S TRANS=$$GET1^DIQ(344.31,EFTIEN_",",.14)
I TRANS,$D(^RCY(344,+BATCHIEN,1,TRANS,0)),LOCKIEN,$D(RCDATA(344.3,LOCKIEN_",")) D
. S DEPDATE=$$GET1^DIQ(344.1,DEPIEN_",",.07,"I")
. I 'DEPDATE Q
. S ^TMP("RCDPTAR",$J,DEPDATE,2)="DEP#:"_$G(RCDATA(344.3,LOCKIEN_",",.06,"E"))_" DEP AMT:"_$G(RCDATA(344.3,LOCKIEN_",",.08,"E"))_"^DEP STATUS:POSTED TO 8NZZ"
;
; Get Match Status History information
I EFTIEN D
. ; Get the Last IEN of the multiple
. S LASTIEN=$O(^RCY(344.31,EFTIEN,4,999999),-1)
. ; Loop through history and build data
. S MATCHIEN=0 F S MATCHIEN=$O(^RCY(344.31,EFTIEN,4,MATCHIEN)) Q:'MATCHIEN D
.. S IENS=MATCHIEN_","_EFTIEN_","
.. D GETS^DIQ(344.314,IENS,"*","IE","RCDATA")
.. S MATCHDATE=$G(RCDATA(344.314,IENS,.02,"I"))
.. I MATCHDATE="" Q
.. S STATUS=$G(RCDATA(344.314,IENS,.01,"E"))
.. I STATUS="MATCHED WITH ERRORS" S STATUS="MATCHED W/ERRORS"
.. S LINE="EFT STATUS:"_STATUS
.. ; If this is the last record and the status is matched, add the ERA record to the data
.. I MATCHIEN=LASTIEN,STATUS="MATCHED"!(STATUS="MATCHED W/ERRORS"),$$GET1^DIQ(344.31,EFTIEN_",",.1) S LINE=LINE_" ERA#:"_$$GET1^DIQ(344.31,EFTIEN_",",.1)
.. S ^TMP("RCDPTAR",$J,MATCHDATE,3)=LINE_"^BY "_$E($G(RCDATA(344.314,IENS,.03,"E")),1,14)_" on "_$$DATE^RCDPRU(MATCHDATE,"2ZD")
;
; Get Receipt information (EFT)
I BATCHIEN D
. S PROCDATE=$$GET1^DIQ(344,BATCHIEN_",",.08,"I")
. I 'PROCDATE Q
. I $G(DEPDATE),PROCDATE<DEPDATE S PROCDATE=DEPDATE ;PRCA*4.5*321 add $G
. S FMSDOCNO=$$FMSSTAT^RCDPUREC(BATCHIEN)
. S ^TMP("RCDPTAR",$J,PROCDATE,5)="DEP RCPT#:"_$$GET1^DIQ(344,BATCHIEN_",",.01,"E")_" ENTRY#:"_BATCHIEN_"^FMS DOC#:"_$P(FMSDOCNO,U,1)_"^^DOC STATUS:"_$E($P(FMSDOCNO,U,2),1,18)
;
; Get Receipt information (ERA)
S BATCHIEN=$$GET1^DIQ(344.4,ERAIEN_",",.08,"I")
I BATCHIEN D
. S PROCDATE=$$GET1^DIQ(344,BATCHIEN_",",.08,"I")
. I $G(DEPDATE),PROCDATE<DEPDATE S PROCDATE=DEPDATE ; PRCA*4.5*321 add $G
. I 'PROCDATE Q
. S FMSDOCNO=$$FMSSTAT^RCDPUREC(BATCHIEN)
. ;S ^TMP("RCDPTAR",$J,PROCDATE,6)="RCPT#:"_$$GET1^DIQ(344,BATCHIEN_",",.01,"E")_" EFT DETAIL#:"_EFTIEN_"^BY "_$E($$GET1^DIQ(344,BATCHIEN_",",.02,"E"),1,14)_" on "_$$DATE^RCDPRU(PROCDATE,"2DZ")
. S ^TMP("RCDPTAR",$J,PROCDATE,6)="RCPT#:"_$$GET1^DIQ(344,BATCHIEN_",",.01,"E")_"^BY "_$E($$GET1^DIQ(344,BATCHIEN_",",.02,"E"),1,14)_" on "_$$DATE^RCDPRU(PROCDATE,"2DZ")
. S ^TMP("RCDPTAR",$J,PROCDATE,7)="FMS DOC#:"_$P(FMSDOCNO,U,1)_"^DOC STATUS:"_$E($P(FMSDOCNO,U,2),1,18)
Q
;
REPORT(RCDATA) ; Print out the report
; Input: RCDATA - see subroutine EFTDA about for delimited list of fields
; Output: Write statements
;
N CNT,DATE,DATA,LINES,RCHR,RCNOW,RCPG,RCSCR
;
; Initialize Report Date, Page Number and String of underscores
S RCSCR=$S($E($G(IOST),1,2)="C-":1,1:0)
S RCNOW=$$UP^XLFSTR($$NOW^RCDPRU()),RCPG=0,RCHR="",$P(RCHR,"-",IOM+1)=""
;
U IO
D HEADER(RCNOW,.RCPG,RCHR,RCDATA)
I $G(RCDATA)=""!'$D(^TMP("RCDPTAR",$J)) W !,"No data found"
;
; Display the detail
S DATE="" F S DATE=$O(^TMP("RCDPTAR",$J,DATE)) Q:'DATE D I RCPG=0 Q
. S CNT=0 F S CNT=$O(^TMP("RCDPTAR",$J,DATE,CNT)) Q:'CNT D I RCPG=0 Q
.. S DATA=^TMP("RCDPTAR",$J,DATE,CNT)
.. S LINES=1
.. I $P(DATA,U,3)]""!($P(DATA,U,4)]"") S LINES=2
.. I RCSCR S LINES=LINES+1
.. D CHKP(RCNOW,.RCPG,RCHR,RCDATA,RCSCR,LINES) I RCPG=0 Q
.. W !,$$DATE^RCDPRU(DATE,"2DZ"),?10,$P(DATA,U,1),?51,$P(DATA,U,2)
.. I $P(DATA,U,3)]""!($P(DATA,U,4)]"") W !,?10,$P(DATA,U,3),?51,$P(DATA,U,4)
;
I 'RCSCR W !,@IOF
I $D(ZTQUEUED) S ZTREQ="@" Q
D ^%ZISC
;
; PRCA*4.5*371 - STOP if user enters '^'
I RCPG,RCSCR S STOP=$S('$$PAUSE():1,1:0)
Q
;
; Input: RCNOW - DATE/TIME in external format
; RCPG - Current page number
; RCHR - Line of "-" to margin width
; RCDATA - See subroutine EFTDA about for delimited list of fields
; Output: Write statements
;
N EFTDATA,LINE
S EFTDATA=$G(^RCY(344.31,+$P(RCDATA,U,3),0))
;
W @IOF
S RCPG=RCPG+1
W "EFT TRANSACTION AUDIT REPORT"
S LINE=RCNOW_" PAGE: "_RCPG_" "
W ?(IOM-$L(LINE)),LINE
; Added EFT line identifier nnn.nn - PRCA*4.5*326
W !,"EFT#: ",$$AGED(+$P(RCDATA,U,3)),$$GET1^DIQ(344.31,$P(RCDATA,U,3)_",",.01,"E"),?19,"DEPOSIT#: ",$P($G(^RCY(344.3,+$P(RCDATA,U,2),0)),U,6),?42,"EFT TOTAL AMT: "_$P(EFTDATA,U,7)
W !,"EFT TRACE#: ",$P(EFTDATA,U,4)
W !,"DATE RECEIVED: ",$$DATE^RCDPRU($P(EFTDATA,U,12)),?26,"PAYER/ID: "_$P(EFTDATA,U,2)_"/"_$P(EFTDATA,U,3)
;
W !,"DATE",?10,"ACTION/DETAILS",?51,"STATUS"
W !,RCHR
Q
;
PAUSE() ; Pause at end of each page for user input
; Input: None
; Output: User response
;
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="E"
D ^DIR
Q Y
;
CHKP(RCNOW,RCPG,RCHR,RCDATA,RCSCR,LINES) ; Check if we need to do a page break
; Input: RCNOW - DATE/TIME in external format
; RCPG - Current page number
; RCHR - Line of "-" to margin width
; RCDATA - See subroutine EFTDA about for delimited list of fields
; RCSCR - 1 - Output is going to the users screen, 0 - to printer
; LINES - Current line count
;
I $Y'>(IOSL-LINES) Q
I RCSCR,'$$PAUSE S RCPG=0 Q
D HEADER(RCNOW,.RCPG,RCHR,RCDATA)
Q
;
AGED(EFTIEN) ; Check if EFT is locked or stale
; Input
; EFTIEN: IEN of EDI THIRD PARTY EFT DETAIL (#344.31)
; Output
; "*" - Warning; "**" - Error; Null - Good
N DAYSLIMT,RECVDT,TRARRY
S RECVDT=$$GET1^DIQ(344.31,EFTIEN_",",.13,"I")
I RECVDT<$$CUTOFF^RCDPEWLP Q "" ; EFTs 2 months older than *298 installation do not lock the system
S DAYSLIMT("M")=$$GET1^DIQ(344.61,1,.06),DAYSLIMT("P")=$$GET1^DIQ(344.61,1,.07)
D CHKEFT^RCDPEWLP(RECVDT,EFTIEN,"B",.DAYSLIMT,.TRARRY)
I $D(TRARRY("ERROR")) Q "**"
I $D(TRARRY("WARNING")) Q "*"
Q ""
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPTAR 19863 printed Apr 09, 2024@20:44:16 Page 2
RCDPTAR ;ALB/TJB - EFT TRANSACTION AUDIT REPORT ;1/02/15
+1 ;;4.5;Accounts Receivable;**303,321,326,380,371**;Mar 20, 1995;Build 29
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ; PRCA*4.5*303 - EFT TRANSACTION AUDIT REPORT
+6 ;
+7 ; Executed by the option "EFT Transaction Audit Report" from the "EDI Lockbox Reports Menu"
+8 ;
+9 ; DESCRIPTION: The following generates a report that displays an audit history for an EFT
+10 ;
EN ; Main entry point for this report
+1 ; Ask Summary or Detail output
+2 ;
+3 NEW DIR,DIRUT,DIROUT,DTOUT,DUOUT,RCREP,RCREP2,X,Y
+4 WRITE !
+5 SET DIR(0)="SOA^S:Summary Information Only;D:Detail Report"
+6 SET DIR("A")="(S)ummary or (D)etail Report format? "
+7 SET DIR("B")="SUMMARY"
+8 DO ^DIR
+9 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
QUIT
+10 SET RCREP=Y
+11 ;
+12 ; PRCA*4.5*380 - Ask if display sum. rpt. by Dep. Date or Dep. Num.
+13 SET RCREP2=0
+14 if RCREP="S"
SET RCREP2=$$ASKSUM2()
+15 if RCREP2=-1
QUIT
+16 ;
+17 IF RCREP="S"
IF RCREP2=1
DO SUM^RCDPTAR1
+18 IF RCREP="S"
IF RCREP2=2
DO SUM2^RCDPTAR1
+19 IF RCREP="D"
DO DET
+20 QUIT
+21 ;
+22 ; PRCA*4.5*380 - New Subroutine added
ASKSUM2() ; Ask the user if they want to display the summary report by Deposit Date
+1 ; or by Deposit Number
+2 ; Input: None
+3 ; Returns: -1 - User quit or timed out
+4 ; 1 - Display Summary report by Deposit Date
+5 ; 2 - Display Summary report by Deposit Number
+6 NEW DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
+7 SET DIR(0)="SOA^EFTS:EFTS by Date;DATE:Deposit Number"
+8 SET DIR("A")="(E)FTs by Date or (D)eposit? "
+9 SET DIR("B")="DEPOSIT"
+10 DO ^DIR
+11 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT -1
+12 IF $EXTRACT(Y,1)="E"
QUIT 1
+13 QUIT 2
+14 ;
DET ; Entry point for detailed report
+1 ; Input: variable RCREP defined and equal to "D"
+2 ; Output: Written to device
+3 ;
+4 NEW RCDATA,RCDET
+5 ;
DET1 ; Prompt for user selection criteria
+1 KILL DIR
+2 SET DIR(0)="SO^N:Deposit Number;D:Deposit Date;R:Receipt Number;T:Trace Number"
+3 SET DIR("PRE")="S:X?1N X=$S(X=1:""N"",X=2:""d"",X=3:""r"",X=4:""t"",1:""X"")"
+4 SET DIR("L",1)="Search for EFT Number by:"
+5 SET DIR("L",2)=""
+6 SET DIR("L",3)=" 1. Deposit (N)umber"
+7 SET DIR("L",4)=" 2. Deposit (D)ate"
+8 SET DIR("L",5)=" 3. (R)eceipt #"
+9 SET DIR("L")=" 4. (T)race #"
+10 SET DIR("A")="Search for EFT by"
+11 DO ^DIR
+12 ;PRCA*4.5*371 Changed G DETQ to Q
IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
QUIT
+13 SET RCDET=Y
+14 ;
+15 ; Do lookup of EFTs based on the user selection above
+16 SET RCDATA=""
+17 DO @($SELECT(RCDET="N":"DN",RCDET="D":"DT",RCDET="R":"RC",1:"TR")_"(.RCDATA)")
+18 ;PRCA*4.5*371 Moved lines that were here to new method SHOWONE
+19 QUIT
+20 ;
SHOWONE(STOP) ; Prompt for device and output data for one EFT
+1 ; Input: STOP - Initially set to 0
+2 ; Output: STOP - 1 user entered '^', 0 otherwise
+3 ;PRCA*4.5*371 - Added Method
+4 NEW %ZIS,ZTSK,ZTRTN,ZTIO,ZTDESC,ZTSAVE,POP
+5 SET %ZIS="QM"
+6 DO ^%ZIS
+7 SET STOP=POP
+8 if POP
QUIT
+9 IF $DATA(IO("Q"))
Begin DoDot:1
+10 SET ZTRTN="RUN^RCDPTAR(RCDATA)"
+11 SET ZTIO=ION
+12 SET ZTSAVE("*")=""
+13 SET ZTDESC="EFT TRANSACTION SUMMARY REPORT"
+14 DO ^%ZTLOAD
+15 WRITE !,$SELECT($DATA(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
+16 DO HOME^%ZIS
End DoDot:1
QUIT
+17 USE IO
+18 DO RUN(RCDATA)
+19 QUIT
+20 ;
RUN(RCDATA) ; Compile and output the report
+1 ; Input: RCDATA - see subroutine EFTDA for delimited list of fields
+2 ; Output: none
+3 ;
+4 ; Compile Data
+5 DO COMPILE(RCDATA)
+6 ;
+7 ; Generate Report
+8 DO REPORT(RCDATA)
+9 ;
+10 KILL ^TMP("RCDPTAR",$JOB)
+11 QUIT
+12 ;
DN(RCDATA) ; Lookup by Deposit Number
+1 ; Input: RCDATA - null on entry
+2 ; Output: RCDATA - passed by refence - see subroutine EFTDATA for delimited list of fields
+3 ; Note variable RCDEFLUP is needed by LOOKUP^RCDPUDEP, which is called by the .01 field
+4 ;
+5 ;PRCA*4.5*371 Added STOP
NEW DIC,DTOUT,DUOUT,LOCKIEN,RCDEFLUP,STOP,USERDN,Y
+6 ;PRCA*4.5*371 Added line
SET STOP=0
+7 ;
DN2 ; Lookup Deposit Number ;PRCA*4.5*371 Added looping Tag
+1 WRITE !
+2 SET DIC="^RCY(344.1,"
SET DIC(0)="QEAMn"
SET DIC("A")="Select DEPOSIT: "
SET DIC("W")="D DICW^RCDPUDEP"
+3 SET RCDEFLUP=1
+4 DO ^DIC
+5 IF $GET(DTOUT)!$GET(DUOUT)!(Y=-1)
SET RCDATA=-1
QUIT
+6 ;
+7 SET LOCKIEN=+$ORDER(^RCY(344.3,"ARDEP",+Y,""))
+8 ;PRCA*4.5*371 Changed Q to G DN2
IF 'LOCKIEN
Begin DoDot:1
+9 WRITE !!,"EFT NOT FOUND - please check Deposit"
+10 DO PAUSE
End DoDot:1
GOTO DN2
+11 ;
+12 ; Get EFT pointer
+13 SET RCDATA=$$EFT(LOCKIEN)
+14 ;
+15 ;PRCA*4.5*371 - Added lines Begin
+16 if RCDATA=-1
QUIT
+17 ; No EFTs found
if RCDATA=""
QUIT
+18 ; Display output
DO SHOWONE(.STOP)
+19 if STOP
QUIT
+20 GOTO DN2
+21 ;PRCA*4.5*371 - Added lines End
+22 QUIT
+23 ;
DT(RCDATA) ; Deposit Date
+1 ; Input: RCDATA - null on entry
+2 ; Output: RCDATA - passed by refence - see subroutine EFTDATA for delimited list of fields
+3 ;
+4 ;PRCA*4.5*371 Added STOP below
+5 NEW CNT,DATA,DEPIEN,DIR,DIROUT,DIRUT,DTOUT,DUOUT,ITEM,LINE,LIST,RCDT,RCI,RCIEN,STOP,X,Y
+6 ;PRCA*4.5*371 Added line
SET STOP=0
+7 ;
DT1 ; Ask the user for the Deposit Date
+1 KILL DIR
+2 SET DIR(0)="DAO^:"_DT_":APE"
SET DIR("B")="T"
+3 SET DIR("A")="Select DEPOSIT DATE: "
+4 DO ^DIR
+5 IF $DATA(DTOUT)!$DATA(DUOUT)
SET RCDATA=-1
QUIT
+6 SET RCDT=Y
+7 ;
+8 ; Build List
+9 KILL LIST
+10 SET RCI=""
SET CNT=0
+11 FOR
SET RCI=$ORDER(^RCY(344.3,"ADEP",RCDT,RCI))
if RCI=""
QUIT
Begin DoDot:1
+12 SET RCIEN=""
+13 FOR
SET RCIEN=$ORDER(^RCY(344.3,"ADEP",RCDT,RCI,RCIEN))
if RCIEN=""
QUIT
Begin DoDot:2
+14 SET DEPIEN=$PIECE($GET(^RCY(344.3,RCIEN,0)),U,3)
+15 IF DEPIEN=""
QUIT
+16 SET DATA=$GET(^RCY(344.1,DEPIEN,0))
+17 IF DATA=""
QUIT
+18 SET CNT=CNT+1
+19 ; Code below is similiar to DICW^RCDPUDEP code
+20 SET LINE=$JUSTIFY(CNT,3)_". "_$PIECE(DATA,U,1)
+21 SET $EXTRACT(LINE,19)="by: "_$EXTRACT($PIECE($GET(^VA(200,+$PIECE(DATA,"^",6),0)),"^"),1,15)
+22 IF '$PIECE(DATA,"^",7)
SET $PIECE(DATA,"^",7)="???????"
+23 SET $EXTRACT(LINE,39)="on: "_$EXTRACT($PIECE(DATA,"^",7),4,5)_"/"_$EXTRACT($PIECE(DATA,"^",7),6,7)_"/"_$EXTRACT($PIECE(DATA,"^",7),2,3)
+24 SET $EXTRACT(LINE,52)="amt: $"_$JUSTIFY($PIECE(DATA,"^",4),10,2)
+25 SET $EXTRACT(LINE,70)=$PIECE("N/A^OPEN^DEPOSITED^CONFIRMED^PROCESSED^VOID","^",+$PIECE(DATA,"^",12)+1)
+26 SET LIST(CNT)=RCIEN_"^"_$PIECE(DATA,U,1)_"^"_LINE
End DoDot:2
End DoDot:1
+27 ;
+28 ; If no deposits in the LIST, display a message and try again
+29 IF CNT=0
Begin DoDot:1
+30 WRITE !,"Date ",$$DATE^RCDPRU(RCDT)," does not have any valid deposits, please try again...",!
End DoDot:1
GOTO DT1
+31 ;
+32 ; If only one deposit in the list, use it
+33 ;PRCA*4.5*371 Changed Q to Q:STOP G DT1
IF CNT=1
Begin DoDot:1
+34 SET RCDATA=$$EFT(+LIST(CNT))
+35 ;
+36 ;PRCA*4.5*371 Begin Added lines
+37 if RCDATA=-1
QUIT
+38 ; No EFTs found
if RCDATA=""
QUIT
+39 ; Display output
DO SHOWONE(.STOP)
+40 ;PRCA*4.5*371 End Added lines
End DoDot:1
if STOP
QUIT
GOTO DT1
+41 ;
DT2 ; Multiple entries found so prompt for the one that is wanted ;PRCA*4.5*371 Added looping Tag
+1 WRITE !!,"Deposits on ",$$DATE^RCDPRU(RCDT)
+2 KILL DIR,ITEM
+3 SET DIR(0)="SAO^"
+4 SET DIR("A")="Select DEPOSIT: "
+5 SET DIR("L",1)=" Choose from:"
+6 FOR LINE=1:1:CNT
Begin DoDot:1
+7 SET DATA=LIST(LINE)
SET DIR(0)=DIR(0)_LINE_":"_$PIECE(DATA,U,2)_";"
+8 SET DIR("L",LINE+1)=$PIECE(DATA,U,3)
SET ITEM(LINE)=+DATA
+9 WRITE !," ",$PIECE(DATA,U,3)
End DoDot:1
+10 SET DIR(0)=$EXTRACT(DIR(0),1,$LENGTH(DIR(0))-1)
+11 SET DIR("L")=DIR("L",CNT+1)
KILL DIR("L",CNT+1)
+12 WRITE !
+13 DO ^DIR
+14 IF $DATA(DTOUT)!$DATA(DUOUT)
SET RCDATA=-1
QUIT
+15 IF Y=""
GOTO DT1
+16 SET RCDATA=$$EFT(ITEM(Y))
+17 ;
+18 ;PRCA*4.5*371 - Added lines Begin
+19 if RCDATA=-1
QUIT
+20 ; No EFTs found
if RCDATA=""
QUIT
+21 ; Display output
DO SHOWONE(.STOP)
+22 if STOP
QUIT
+23 GOTO DT2
+24 ;PRCA*4.5*371 - Added lines End
+25 QUIT
+26 ;
RC(RCDATA) ; Lookup by Receipt Number
+1 ; Input: RCDATA - null on entry
+2 ; Output: RCDATA - passed by refence - see subroutine EFTDATA for delimited list of fields
+3 ;
+4 ;PRCA*4.5*371 Added Stop
NEW D,DIC,DTOUT,DUOUT,RCDTN,RCED,RCIEN,STOP,X,Y
+5 ;PRCA*4.5*371 Added line
SET STOP=0
RC2 ; ;PRCA*4.5*371 Added looping Tag
+1 WRITE !
+2 SET DIC="^RCY(344,"
SET DIC(0)="QEAMn"
SET DIC("A")="Select RECEIPT: "
+3 SET DIC("W")="D DICW^RCDPUREC"
+4 SET DIC("S")="I $$EDILBEV^RCDPEU($P($G(^(0)),U,4))"
+5 DO ^DIC
+6 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y=-1)
SET RCDATA=-1
QUIT
+7 ;
+8 ; Check if there is a pointer to the AR Deposit
+9 SET RCDATA=""
+10 SET RCIEN=$PIECE($GET(^RCY(344,+Y,0)),U,6)
+11 ;
+12 ; If there is, then get the EFT via AR Deposit and EDI LockBox files
+13 IF RCIEN
Begin DoDot:1
+14 ; Get Ticket Number
+15 SET RCDTN=$PIECE($GET(^RCY(344.1,RCIEN,0)),U,1)
+16 IF RCDTN=""
QUIT
+17 ;
+18 ; Get EDI Lockbox Deposit File
+19 SET RCED=$ORDER(^RCY(344.3,"C",RCDTN,""))
+20 IF RCED=""
QUIT
+21 SET RCDATA=$$EFT(RCED)
End DoDot:1
+22 ;
+23 ; If this AR Deposit record is not found, check if it is a receipt on the ERA
+24 IF 'RCIEN
Begin DoDot:1
+25 SET ERAIEN=$ORDER(^RCY(344.4,"H",+Y,""))
+26 IF 'ERAIEN
SET ERAIEN=$ORDER(^RCY(344.4,"ARCT",+Y,""))
+27 IF 'ERAIEN
QUIT
+28 SET EFTIEN=$ORDER(^RCY(344.31,"AERA",ERAIEN,""))
+29 IF EFTIEN
SET RCDATA=$$EFTDATA(EFTIEN)
End DoDot:1
+30 ;
+31 ;PRCA*4.5*371 Changed Q to G RC2
IF RCDATA=""
Begin DoDot:1
+32 WRITE !!,"EFT NOT FOUND - please check Receipt"
+33 DO PAUSE
End DoDot:1
GOTO RC2
+34 ;
+35 ;PRCA*4.5*371 - Added lines Begin
+36 if RCDATA=-1
QUIT
+37 ; No EFTs found
if RCDATA=""
QUIT
+38 ; Display output
DO SHOWONE(.STOP)
+39 if STOP
QUIT
+40 GOTO RC2
+41 ;PRCA*4.5*371 - Added lines End
+42 QUIT
+43 ;
TR(RCDATA) ; Lookup by Trace Number
+1 ; Input: RCDATA - null on entry
+2 ; Output: RCDATA - passed by refence - see subroutine EFTDATA for delimited list of fields
+3 ;PRCA*4.5*371 Added STOP
NEW D,DIC,DTOUT,DUOUT,STOP,X,Y
+4 ;PRCA*4.5*371 Added line
SET STOP=0
+5 ;
TR2 ; Use "F" index in EDI EFT Detail file ;PRCA*4.5*371 Added looping Tag
+1 WRITE !
+2 SET DIC="^RCY(344.31,"
SET DIC(0)="QEASn"
SET D="F"
SET DIC("A")="Select TRACE: "
+3 ; DIC("W") may need to be fixed if Trace numbers go over 32 characters. The fields
+4 ; displayed are the EFT#, Insurance company name, amount and Date Recieved.
+5 SET DIC("W")="D EN^DDIOL($J($P(^(0),U,1),7)_"" ""_$$LJ^XLFSTR($E($P(^(0),U,2),1,20),20)_$J($P(^(0),U,7),10)_"" ""_$$DATE^RCDPRU($P(^(0),U,13)),,""?32"")"
+6 DO IX^DIC
+7 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y=-1)
SET RCDATA=-1
QUIT
+8 SET RCDATA=$$EFTDATA(+Y)
+9 ;
+10 ;PRCA*4.5*371 - Added lines Begin
+11 if RCDATA=-1
QUIT
+12 ; No EFTs found
if RCDATA=""
QUIT
+13 ; Display output
DO SHOWONE(.STOP)
+14 if STOP
QUIT
+15 GOTO TR2
+16 ;PRCA*4.5*371 - Added lines End
+17 QUIT
+18 ;
EFT(LOCKIEN) ; Select a single EFT Number
+1 ; Input: LOCKIEN - IEN for LOCKBOX DEPOSIT (#344.3)
+2 ; Return: LIST(Y) - Delimiter list of information as returned by suboutine EFTDATA
+3 ;
+4 IF '$GET(LOCKIEN)
WRITE !!,"No EFT detail for this selection"
DO PAUSE
QUIT ""
+5 ;
+6 NEW EFTIEN,CNT,DATA,LIST,Y
+7 ;
+8 SET EFTIEN=""
SET CNT=0
+9 ;
FOR
SET EFTIEN=$ORDER(^RCY(344.31,"B",LOCKIEN,EFTIEN))
if EFTIEN=""
QUIT
Begin DoDot:1
+10 SET DATA=$$EFTDATA(EFTIEN)
IF DATA]""
SET CNT=CNT+1
SET LIST(CNT)=DATA
End DoDot:1
+11 ;
+12 IF CNT=0
WRITE !!,"No EFT detail for this selection"
DO PAUSE
QUIT ""
+13 ;
+14 ; If only one EFT, select it and quit
+15 IF CNT=1
SET Y=1
GOTO EFT1
+16 ;
+17 ; Display and the let the user select the EFT
+18 NEW DIR,DIRUT,DIROUT,DTOUT,DUOUT,ROW,TRANS,X
+19 SET DIR(0)="SO^"
+20 SET DIR("A")="Select item from list"
+21 SET DIR("L",1)="Select single EFT:"
+22 FOR ROW=1:1:CNT-1
Begin DoDot:1
+23 SET DATA=LIST(ROW)
SET LOCKIEN=$PIECE(DATA,U,2)
SET EFTIEN=$PIECE(DATA,U,3)
SET TRANS=$$GET1^DIQ(344.31,EFTIEN_",",.01,"I")
+24 SET DIR(0)=DIR(0)_ROW_":"_TRANS_";"
+25 ; PRCA*4.5*326
SET DIR("L",(ROW+1))=$JUSTIFY(ROW,3)_". "_TRANS_$$DISPLAY(EFTIEN,LOCKIEN)
End DoDot:1
+26 SET DATA=LIST(CNT)
SET LOCKIEN=$PIECE(DATA,U,2)
SET EFTIEN=$PIECE(DATA,U,3)
SET TRANS=$$GET1^DIQ(344.31,EFTIEN_",",.01,"I")
+27 SET DIR(0)=DIR(0)_CNT_":"_TRANS
+28 ; PRCA*4.5*326
SET DIR("L")=$JUSTIFY(CNT,3)_". "_TRANS_$$DISPLAY(EFTIEN,LOCKIEN)
+29 DO ^DIR
+30 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
QUIT -1
+31 ;
EFT1 ;
+1 QUIT LIST(Y)
+2 ;
EFTDATA(EFTIEN) ; Get associated records for this EFT
+1 ; Input: EFTIEN - IEN for EFT [344.31]
+2 ; Returns: A1^A2^A3^A4^45
+3 ; where A1=ERAIEN - IEN for ERA (#344.4)
+4 ; A2=LOCKIEN - IEN for LOCKBOX DEPOSIT (#344.3)
+5 ; A3=EFTIEN - IEN for EFT (#344.31)
+6 ; A4=DEPIEN - IEN for AR DEPOSIT (#344.1)
+7 ; A5=BATCHIEN - IEN for AR BATCH PAYMENT (#344)
+8 ;
+9 IF '$GET(EFTIEN)
QUIT ""
+10 ;
+11 ;PRCA*4.5*321 removed DEPOSIT
NEW BATCHIEN,DEPIEN,ERAIEN,LOCKIEN
+12 SET (ERAIEN,DEPIEN,BATCHIEN)=""
+13 ;PRCA*4.5*321 use ^DIQ vs global access
SET ERAIEN=$$GET1^DIQ(344.31,EFTIEN,.1,"I")
+14 ;PRCA*4.5*321
SET LOCKIEN=$$GET1^DIQ(344.31,EFTIEN,.01,"I")
+15 ;PRCA*4.5*321 instead of $O on B index of 344.1
IF LOCKIEN
SET DEPIEN=$$GET1^DIQ(344.3,LOCKIEN,.03,"I")
+16 IF DEPIEN
SET BATCHIEN=$ORDER(^RCY(344,"AD",DEPIEN,""))
+17 QUIT ERAIEN_U_LOCKIEN_U_EFTIEN_U_DEPIEN_U_BATCHIEN
+18 ;
DISPLAY(EFTIEN,LOCKIEN) ; Display EFT detail during user selection process
+1 ; Input: EFTIEN - IEN for EFT (#344.31)
+2 ; LOCKIEN - IEN for LOCKBOX DEPOSIT (#344.3)
+3 ; Return: X1_" "_X2_" "_X3_" "_X4_" "_X5
+4 ; where X1=PAYER NAME
+5 ; X2=TRACE NUMBER
+6 ; X3=AMOUNT OF PAYMENT
+7 ; X4=DEPOSIT NUMBER
+8 ; X5=DEPOSIT DATE
+9 ; Added Suffix - PRCA*4.5*326
NEW SUFX,X
+10 SET EFTIEN=$GET(EFTIEN)
+11 SET LOCKIEN=$GET(LOCKIEN)
+12 ; PRCA*4.5*326
SET SUFX=$$GET1^DIQ(344.31,EFTIEN_",",.14)
+13 ; PRCA*4.5*326
if SUFX
SET SUFX="."_SUFX
+14 ; PRCA*4.5*326
SET X=SUFX_$JUSTIFY("",4-$LENGTH(SUFX))
+15 ; PRCA*4.5*326
SET X=X_$$GET1^DIQ(344.31,EFTIEN_",",.02)_" "_$$GET1^DIQ(344.31,EFTIEN_",",.04)_" "
+16 SET X=X_$$GET1^DIQ(344.31,EFTIEN_",",.07)_" "_$$GET1^DIQ(344.3,LOCKIEN_",",.06)_" "
+17 SET X=X_$$DATE^RCDPRU($$GET1^DIQ(344.3,LOCKIEN_",",.07,"I"),"2DZ")
+18 QUIT X
+19 ;
COMPILE(RCDATA) ; Compile data for display
+1 ; Input: RCDATA - see subroutine EFTDA for delimited list of fields
+2 ; Output: ^TMP("RCDPTAR",$J)
+3 ;
+4 IF $GET(RCDATA)=""
QUIT
+5 ;
+6 NEW BATCHIEN,DEPDATE,DEPIEN,EFTIEN,ERAIEN,FILEDATE,FMSDOCNO,IENS,LASTIEN,LINE,LOCKIEN
+7 NEW MATCHDATE,MATCHIEN,PROCDATE,STATUS,TRANS
+8 KILL ^TMP("RCDPTAR",$JOB)
+9 ;
+10 ; Get Pointers from RCDATA
+11 SET ERAIEN=$PIECE(RCDATA,U,1)
SET LOCKIEN=$PIECE(RCDATA,U,2)
SET EFTIEN=$PIECE(RCDATA,U,3)
+12 SET DEPIEN=$PIECE(RCDATA,U,4)
SET BATCHIEN=$PIECE(RCDATA,U,5)
+13 ;
+14 ; Get Inital Creation/Deposit information
+15 KILL RCDATA
+16 IF LOCKIEN
Begin DoDot:1
+17 DO GETS^DIQ(344.3,LOCKIEN_",",".02;.06;.08","IE","RCDATA")
+18 SET FILEDATE=$GET(RCDATA(344.3,LOCKIEN_",",.02,"I"))
+19 IF 'FILEDATE
QUIT
+20 SET ^TMP("RCDPTAR",$JOB,FILEDATE,1)="DEP#:"_$GET(RCDATA(344.3,LOCKIEN_",",.06,"E"))_" DEP AMT:"_$GET(RCDATA(344.3,LOCKIEN_",",.08,"E"))_"^EFT STATUS:RECEIVED"
End DoDot:1
+21 ;
+22 ; Check if posted to revenue code 8NZZ
+23 SET TRANS=$$GET1^DIQ(344.31,EFTIEN_",",.14)
+24 IF TRANS
IF $DATA(^RCY(344,+BATCHIEN,1,TRANS,0))
IF LOCKIEN
IF $DATA(RCDATA(344.3,LOCKIEN_","))
Begin DoDot:1
+25 SET DEPDATE=$$GET1^DIQ(344.1,DEPIEN_",",.07,"I")
+26 IF 'DEPDATE
QUIT
+27 SET ^TMP("RCDPTAR",$JOB,DEPDATE,2)="DEP#:"_$GET(RCDATA(344.3,LOCKIEN_",",.06,"E"))_" DEP AMT:"_$GET(RCDATA(344.3,LOCKIEN_",",.08,"E"))_"^DEP STATUS:POSTED TO 8NZZ"
End DoDot:1
+28 ;
+29 ; Get Match Status History information
+30 IF EFTIEN
Begin DoDot:1
+31 ; Get the Last IEN of the multiple
+32 SET LASTIEN=$ORDER(^RCY(344.31,EFTIEN,4,999999),-1)
+33 ; Loop through history and build data
+34 SET MATCHIEN=0
FOR
SET MATCHIEN=$ORDER(^RCY(344.31,EFTIEN,4,MATCHIEN))
if 'MATCHIEN
QUIT
Begin DoDot:2
+35 SET IENS=MATCHIEN_","_EFTIEN_","
+36 DO GETS^DIQ(344.314,IENS,"*","IE","RCDATA")
+37 SET MATCHDATE=$GET(RCDATA(344.314,IENS,.02,"I"))
+38 IF MATCHDATE=""
QUIT
+39 SET STATUS=$GET(RCDATA(344.314,IENS,.01,"E"))
+40 IF STATUS="MATCHED WITH ERRORS"
SET STATUS="MATCHED W/ERRORS"
+41 SET LINE="EFT STATUS:"_STATUS
+42 ; If this is the last record and the status is matched, add the ERA record to the data
+43 IF MATCHIEN=LASTIEN
IF STATUS="MATCHED"!(STATUS="MATCHED W/ERRORS")
IF $$GET1^DIQ(344.31,EFTIEN_",",.1)
SET LINE=LINE_" ERA#:"_$$GET1^DIQ(344.31,EFTIEN_",",.1)
+44 SET ^TMP("RCDPTAR",$JOB,MATCHDATE,3)=LINE_"^BY "_$EXTRACT($GET(RCDATA(344.314,IENS,.03,"E")),1,14)_" on "_$$DATE^RCDPRU(MATCHDATE,"2ZD")
End DoDot:2
End DoDot:1
+45 ;
+46 ; Get Receipt information (EFT)
+47 IF BATCHIEN
Begin DoDot:1
+48 SET PROCDATE=$$GET1^DIQ(344,BATCHIEN_",",.08,"I")
+49 IF 'PROCDATE
QUIT
+50 ;PRCA*4.5*321 add $G
IF $GET(DEPDATE)
IF PROCDATE<DEPDATE
SET PROCDATE=DEPDATE
+51 SET FMSDOCNO=$$FMSSTAT^RCDPUREC(BATCHIEN)
+52 SET ^TMP("RCDPTAR",$JOB,PROCDATE,5)="DEP RCPT#:"_$$GET1^DIQ(344,BATCHIEN_",",.01,"E")_" ENTRY#:"_BATCHIEN_"^FMS DOC#:"_$PIECE(FMSDOCNO,U,1)_"^^DOC STATUS:"_$EXTRACT($PIECE(FMSDOCNO,U,2),1,18)
End DoDot:1
+53 ;
+54 ; Get Receipt information (ERA)
+55 SET BATCHIEN=$$GET1^DIQ(344.4,ERAIEN_",",.08,"I")
+56 IF BATCHIEN
Begin DoDot:1
+57 SET PROCDATE=$$GET1^DIQ(344,BATCHIEN_",",.08,"I")
+58 ; PRCA*4.5*321 add $G
IF $GET(DEPDATE)
IF PROCDATE<DEPDATE
SET PROCDATE=DEPDATE
+59 IF 'PROCDATE
QUIT
+60 SET FMSDOCNO=$$FMSSTAT^RCDPUREC(BATCHIEN)
+61 ;S ^TMP("RCDPTAR",$J,PROCDATE,6)="RCPT#:"_$$GET1^DIQ(344,BATCHIEN_",",.01,"E")_" EFT DETAIL#:"_EFTIEN_"^BY "_$E($$GET1^DIQ(344,BATCHIEN_",",.02,"E"),1,14)_" on "_$$DATE^RCDPRU(PROCDATE,"2DZ")
+62 SET ^TMP("RCDPTAR",$JOB,PROCDATE,6)="RCPT#:"_$$GET1^DIQ(344,BATCHIEN_",",.01,"E")_"^BY "_$EXTRACT($$GET1^DIQ(344,BATCHIEN_",",.02,"E"),1,14)_" on "_$$DATE^RCDPRU(PROCDATE,"2DZ")
+63 SET ^TMP("RCDPTAR",$JOB,PROCDATE,7)="FMS DOC#:"_$PIECE(FMSDOCNO,U,1)_"^DOC STATUS:"_$EXTRACT($PIECE(FMSDOCNO,U,2),1,18)
End DoDot:1
+64 QUIT
+65 ;
REPORT(RCDATA) ; Print out the report
+1 ; Input: RCDATA - see subroutine EFTDA about for delimited list of fields
+2 ; Output: Write statements
+3 ;
+4 NEW CNT,DATE,DATA,LINES,RCHR,RCNOW,RCPG,RCSCR
+5 ;
+6 ; Initialize Report Date, Page Number and String of underscores
+7 SET RCSCR=$SELECT($EXTRACT($GET(IOST),1,2)="C-":1,1:0)
+8 SET RCNOW=$$UP^XLFSTR($$NOW^RCDPRU())
SET RCPG=0
SET RCHR=""
SET $PIECE(RCHR,"-",IOM+1)=""
+9 ;
+10 USE IO
+11 DO HEADER(RCNOW,.RCPG,RCHR,RCDATA)
+12 IF $GET(RCDATA)=""!'$DATA(^TMP("RCDPTAR",$JOB))
WRITE !,"No data found"
+13 ;
+14 ; Display the detail
+15 SET DATE=""
FOR
SET DATE=$ORDER(^TMP("RCDPTAR",$JOB,DATE))
if 'DATE
QUIT
Begin DoDot:1
+16 SET CNT=0
FOR
SET CNT=$ORDER(^TMP("RCDPTAR",$JOB,DATE,CNT))
if 'CNT
QUIT
Begin DoDot:2
+17 SET DATA=^TMP("RCDPTAR",$JOB,DATE,CNT)
+18 SET LINES=1
+19 IF $PIECE(DATA,U,3)]""!($PIECE(DATA,U,4)]"")
SET LINES=2
+20 IF RCSCR
SET LINES=LINES+1
+21 DO CHKP(RCNOW,.RCPG,RCHR,RCDATA,RCSCR,LINES)
IF RCPG=0
QUIT
+22 WRITE !,$$DATE^RCDPRU(DATE,"2DZ"),?10,$PIECE(DATA,U,1),?51,$PIECE(DATA,U,2)
+23 IF $PIECE(DATA,U,3)]""!($PIECE(DATA,U,4)]"")
WRITE !,?10,$PIECE(DATA,U,3),?51,$PIECE(DATA,U,4)
End DoDot:2
IF RCPG=0
QUIT
End DoDot:1
IF RCPG=0
QUIT
+24 ;
+25 IF 'RCSCR
WRITE !,@IOF
+26 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+27 DO ^%ZISC
+28 ;
+29 ; PRCA*4.5*371 - STOP if user enters '^'
+30 IF RCPG
IF RCSCR
SET STOP=$SELECT('$$PAUSE():1,1:0)
+31 QUIT
+32 ;
+1 ; Input: RCNOW - DATE/TIME in external format
+2 ; RCPG - Current page number
+3 ; RCHR - Line of "-" to margin width
+4 ; RCDATA - See subroutine EFTDA about for delimited list of fields
+5 ; Output: Write statements
+6 ;
+7 NEW EFTDATA,LINE
+8 SET EFTDATA=$GET(^RCY(344.31,+$PIECE(RCDATA,U,3),0))
+9 ;
+10 WRITE @IOF
+11 SET RCPG=RCPG+1
+12 WRITE "EFT TRANSACTION AUDIT REPORT"
+13 SET LINE=RCNOW_" PAGE: "_RCPG_" "
+14 WRITE ?(IOM-$LENGTH(LINE)),LINE
+15 ; Added EFT line identifier nnn.nn - PRCA*4.5*326
+16 WRITE !,"EFT#: ",$$AGED(+$PIECE(RCDATA,U,3)),$$GET1^DIQ(344.31,$PIECE(RCDATA,U,3)_",",.01,"E"),?19,"DEPOSIT#: ",$PIECE($GET(^RCY(344.3,+$PIECE(RCDATA,U,2),0)),U,6),?42,"EFT TOTAL AMT: "_$PIECE(EFTDATA,U,7)
+17 WRITE !,"EFT TRACE#: ",$PIECE(EFTDATA,U,4)
+18 WRITE !,"DATE RECEIVED: ",$$DATE^RCDPRU($PIECE(EFTDATA,U,12)),?26,"PAYER/ID: "_$PIECE(EFTDATA,U,2)_"/"_$PIECE(EFTDATA,U,3)
+19 ;
+20 WRITE !,"DATE",?10,"ACTION/DETAILS",?51,"STATUS"
+21 WRITE !,RCHR
+22 QUIT
+23 ;
PAUSE() ; Pause at end of each page for user input
+1 ; Input: None
+2 ; Output: User response
+3 ;
+4 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+5 SET DIR(0)="E"
+6 DO ^DIR
+7 QUIT Y
+8 ;
CHKP(RCNOW,RCPG,RCHR,RCDATA,RCSCR,LINES) ; Check if we need to do a page break
+1 ; Input: RCNOW - DATE/TIME in external format
+2 ; RCPG - Current page number
+3 ; RCHR - Line of "-" to margin width
+4 ; RCDATA - See subroutine EFTDA about for delimited list of fields
+5 ; RCSCR - 1 - Output is going to the users screen, 0 - to printer
+6 ; LINES - Current line count
+7 ;
+8 IF $Y'>(IOSL-LINES)
QUIT
+9 IF RCSCR
IF '$$PAUSE
SET RCPG=0
QUIT
+10 DO HEADER(RCNOW,.RCPG,RCHR,RCDATA)
+11 QUIT
+12 ;
AGED(EFTIEN) ; Check if EFT is locked or stale
+1 ; Input
+2 ; EFTIEN: IEN of EDI THIRD PARTY EFT DETAIL (#344.31)
+3 ; Output
+4 ; "*" - Warning; "**" - Error; Null - Good
+5 NEW DAYSLIMT,RECVDT,TRARRY
+6 SET RECVDT=$$GET1^DIQ(344.31,EFTIEN_",",.13,"I")
+7 ; EFTs 2 months older than *298 installation do not lock the system
IF RECVDT<$$CUTOFF^RCDPEWLP
QUIT ""
+8 SET DAYSLIMT("M")=$$GET1^DIQ(344.61,1,.06)
SET DAYSLIMT("P")=$$GET1^DIQ(344.61,1,.07)
+9 DO CHKEFT^RCDPEWLP(RECVDT,EFTIEN,"B",.DAYSLIMT,.TRARRY)
+10 IF $DATA(TRARRY("ERROR"))
QUIT "**"
+11 IF $DATA(TRARRY("WARNING"))
QUIT "*"
+12 QUIT ""
