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

RCDPEM0.m

Go to the documentation of this file.
  1. RCDPEM0 ;ALB/TMK - ERA MATCHING TO EFT (cont) ;Jun 11, 2014@13:04:03
  1. ;;4.5;Accounts Receivable;**173,208,220,298,304,345,375,349,409,424**;Mar 20, 1995;Build 11
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. Q
  1. ;
  1. MATCH(RCZ,RCPROC) ;EP from RCDPEM
  1. ; Match EFT to ERA
  1. ; Input: RCZ - IEN of file 344.31
  1. ; RCPROC - 1 if called from EFT-EOB automatch, 0 if from manual match
  1. ;
  1. ; PRCA*4.5*345 - Alphabetized and added MS1,TIN1,TR1,TTL0,TTL1,XX below
  1. ; PRCA*4.5*424 - Removed NAM0,RCERATYP,RCXCLDE,TIN0 to new method PAYEREXC^RCDPEAP2
  1. N DA,DIE,DR,MS1,RCER,RCMATCH,RCRZ,RC0,RC3444,RC34431
  1. N TIN1,TR1,TTL0,TTL1,X,XX,Y,Z,Z0
  1. ;
  1. ; Find ERA to match to EFT by trace, date, amt
  1. ; PRCA*4.5*345 Begin - Added lines
  1. S TIN1=$$GET1^DIQ(344.31,RCZ_",",.03,"I") ; EFT Payer TIN
  1. S TR1=$$GET1^DIQ(344.31,RCZ_",",.04,"I") ; EFT Trace Number
  1. S TTL1=$$GET1^DIQ(344.31,RCZ_",",.07,"I") ; EFT Amount of Payment
  1. S MS1=$$GET1^DIQ(344.31,RCZ_",",.06,"I") ; EFT Match Status
  1. ; PRCA*4.5*345 End
  1. S RC34431=$G(^RCY(344.31,RCZ,0)) ; EFT record
  1. Q:MS1!$O(^RCY(344,"AEFT",RCZ,0)) ; Already matched
  1. I TIN1'="",TR1'="" D ; Must have Payor TIN and Trace #
  1. . ;
  1. . ; Loop through all of the ERAs that match the EFT on Trace Number and TIN
  1. . S RCRZ=0
  1. . F S RCRZ=$O(^RCY(344.4,"ATRIDUP",$$UP^XLFSTR(TR1),$$UP^XLFSTR(TIN1),RCRZ)) Q:'RCRZ S RC3444=$G(^RCY(344.4,RCRZ,0)) I '$O(^RCY(344.31,"AERA",RCRZ,0)),'$P(RC3444,U,9) D Q:$D(Z(1))
  1. . . S Z($S(+TTL1=+$P(RC3444,U,5):1,1:-1),RCRZ)="" ; Total Amount Paid match?
  1. ;
  1. S RCMATCH=+$O(Z(""),-1),RCRZ=+$O(Z(RCMATCH,0))
  1. S $P(^TMP($J,"RCDPETOT",344.31,RCZ),U)=RCMATCH
  1. ;
  1. I 'RCMATCH D Q ; Match failure
  1. . S ^TMP($J,"RCTOT","NO_MATCH")=$G(^TMP($J,"RCTOT","NO_MATCH"))+1
  1. ;
  1. I RCMATCH<0 D
  1. . ;
  1. . ; Bulletin for totals don't match warning
  1. . S ^TMP($J,"RCTOT","TOTMIS")=$G(^TMP($J,"RCTOT","TOTMIS"))+1
  1. . N RCER,RCLESS,RCM,RCT,XMB,XMBODY,XMERR,XMFULL,XMINSTR,XMSUBJ,XMTO,XMTYPE,XMZ
  1. . S RCT=0
  1. . D BLD^RCDPEM1("RCER",.RCT,344.31,RC34431)
  1. . S RCT=RCT+1,RCER(RCT)=""
  1. . K RCM
  1. . S RCM=RCT
  1. . S TTL0=+$$GET1^DIQ(344.4,RCRZ_",",.05,"I") ; ERA Total Amount Paid - PRCA*4.5*345
  1. . S RCLESS=(TTL1<TTL0)
  1. . S RCT=RCT+1,RCER(RCT)=" TOTALS ON ERA AND EFT DON'T MATCH."
  1. . S RCT=RCT+1,RCER(RCT)=" EFT TOTAL IS "_$S(RCLESS:"LESS",1:"GREATER")_" THAN ERA AMOUNT TOTAL"
  1. . I RCLESS D
  1. . . S RCT=RCT+1
  1. . . S RCER(RCT)=" DECREASE ADJUSTMENT IS NEEDED BEFORE THE ERA RECEIPT CAN BE PROCESSED."
  1. . I 'RCLESS D
  1. . . S RCT=RCT+1
  1. . . S RCER(RCT)=" A SUSPENSE LINE IS NEEDED ON THE RECEIPT TO ACCOUNT FOR THE DIFFERENCE."
  1. . S RCT=RCT+1
  1. . S RCER(RCT)=" IF YOU USE THE ERA WORKLIST SCRATCH PAD, THIS WILL BE GENERATED FOR YOU."
  1. . ;
  1. . S RCT=RCT+1,RCER(RCT)=" EFT WAS MATCHED TO ERA ENTRY #: "_RCRZ_" ($"_$J(TTL0,"",2)_")."
  1. . S XMTO("I:G.RCDPE PAYMENTS")=""
  1. . S XMBODY="RCER"
  1. . S XMSUBJ="EDI LBOX TOTALS MISMATCH ON EFT-ERA MATCH"
  1. . D
  1. . . N DUZ S DUZ=.5,DUZ(0)="@"
  1. . . D SENDMSG^XMXAPI(.5,XMSUBJ,XMBODY,.XMTO,,.XMZ)
  1. . ;
  1. . ; Update log
  1. . F S RCM=$O(RCER(RCM)) Q:'RCM S RCT=RCT+1,RCM(RCT)=RCER(RCM)
  1. . D STORERR(344.31,RCZ,.RCM)
  1. ;
  1. ; Many checks done by this are also done AUTOCHK2^RCDPEAP1 so if these are changed,
  1. ; AUTOCHK2 may also need to be changed
  1. I RCMATCH D
  1. . S DIE="^RCY(344.31,",DA=RCZ,DR=".08////"_RCMATCH_";.1////"_RCRZ
  1. . D ^DIE
  1. . S DIE="^RCY(344.4,",DA=RCRZ,DR=".09////"_RCMATCH
  1. . D ^DIE
  1. . S ^TMP($J,"RCTOT","MATCH")=$G(^TMP($J,"RCTOT","MATCH"))+1
  1. . ;
  1. . ; Lines below are added for Auto-posting - PRCA*4.5*298
  1. . ; Quit if this is not nightly job
  1. . Q:'RCPROC
  1. . Q:+$P($G(^RCY(344.4,RCRZ,0)),U,5)=0 ; Quit if this is a zero value ERA
  1. . ;
  1. . ; PRCA*4.5*424 Added new method to move code from below to RCDPEAP2 so that it
  1. . ; can also be checked when auto-posting ZERO balance ERAs
  1. . Q:$$PAYEREXC^RCDPEAP2(RCRZ) ; Quit if the payer is excluded
  1. . ;
  1. . ; Ignore ERA with exceptions, zero balance, or ERA-level adjustments
  1. . Q:'$$AUTOCHK^RCDPEAP1(RCRZ)
  1. . ;
  1. . ; Set AUTO-POST STATUS = UNPOSTED this is trigger for auto-post (EN^RCDPEAP)
  1. . D SETSTA^RCDPEAP(RCRZ,0,"Auto Matching: Marked as Auto-Post Candidate")
  1. Q
  1. ;
  1. ADDDEP(RCD,RCDDT,RCZ) ; Add deposit
  1. ; RCD = deposit #
  1. ; RCDDT = deposit date FM format
  1. ; RCZ = ien of entry in file 344.3
  1. ; Function returns IEN of new deposit entry
  1. ;
  1. N RCDEP,RC0,DIE,DR,DA,X,Y
  1. S RCDEP=+$$ADDDEPT^RCDPUDEP(RCD,RCDDT)
  1. I RCDEP D
  1. . D LOCKDEP^RCDPEM(RCDEP,1)
  1. . S RC0=$G(^RCY(344.3,RCZ,0))
  1. . S DIE="^RCY(344.1,",DA=RCDEP,DR=".04////"_+$P(RC0,U,8)_$S($P(RC0,U,4)'="":";.05////"_$P(RC0,U,4),1:"") D ^DIE
  1. . S DIE="^RCY(344.3,",DR=".03////"_RCDEP,DA=RCZ D ^DIE
  1. . S $P(^TMP($J,"RCDPETOT",344.3,RCZ),U,5)=RCDEP
  1. Q RCDEP
  1. ;
  1. ADDREC(RCDEP,RCZ) ; Add receipt, send CR to FUND 528704, Rev src cd 8NZZ for total EFT amt
  1. ; Input: RCDEP - IEN in AR DEPOSIT file (#344.1)
  1. ; RCZ - IEN in EDI LOCKBOX DEPOSIT file (#344.3) (same as $P(^RCY(344.31,IEN,0),"^",1)
  1. ; Returns: IEN of new receipt entry
  1. ;
  1. ; RCLOCK - Flag indicating lock success
  1. ;PRCA*4.5*409 - Added RCPAYTYP description
  1. ; RCPAYTYP - 14 if the trace number of the EFT does not begin with OGC (EDI LOCKBOX)
  1. ; 18 if the trace number of the EFT begins with OGC (OGC-EFT)
  1. ; RCTRANDA - Transaction number
  1. ; RECTDA - IEN in file #344
  1. ;
  1. ;PRCA*4.5*409 Added RCPAYTYP, XX
  1. N RCER,RCLOCK,RCTRANDA,RECTDA,RCQUIT,RCDPDATA,RCPAYTYP,RCTOTCT,RC0,DIE,DA,DR,X,XX,Y
  1. S RC0=$G(^RCY(344.3,RCZ,0))
  1. S $P(^TMP($J,"RCDPETOT",344.3,RCZ),U,3)=0
  1. ;
  1. ; Single receipt - multiple transactions for EFT payments
  1. ;
  1. ;PRCA*4.5*409 - Added lines Begin
  1. S XX=$O(^RCY(344.31,"B",RCZ,"")) ; Get EFT IEN
  1. S XX=$P(^RCY(344.31,XX,0),"^",4) ; EFT Trace Number
  1. S RCPAYTYP=$S($E(XX,1,3)="OGC":18,1:14) ; IEN in 341.1 AR EVENT TYPE file
  1. ;PRCA*4.5*409 - Added lines End
  1. ;
  1. ;PRCA*4.5*409 - Replaced +$O(^RC(341.1,"AC",14,0)) with +RCPAYTYP below
  1. S RECTDA=+$$ADDRECT^RCDPUREC($P(RC0,U,7),RCDEP,+RCPAYTYP)
  1. ;
  1. ; Create detail lines for deposit amount, process whole receipt to send
  1. ; CR document for deposit amount
  1. I RECTDA D
  1. . L +^RCY(344,RECTDA):DILOCKTM S RCLOCK=$T Q:'RCLOCK ; exit if unable to lock
  1. . N STATUS,RC00,RCT
  1. . S $P(^TMP($J,"RCDPETOT",344.3,RCZ),U)=RECTDA
  1. . S ^TMP($J,"RCTOT","EFT_RECPT")=$G(^TMP($J,"RCTOT","EFT_RECPT"))+1
  1. . ;
  1. . ; Check to see if receipt has been processed (fms document)
  1. . D DIQ344^RCDPRPLM(RECTDA,"200;")
  1. . ;
  1. . ; Code sheet already sent once, this is a retransmission, check it
  1. . I RCDPDATA(344,RECTDA,200,"E")'="" S RCQUIT=0 D Q:RCQUIT
  1. . . S STATUS=$$STATUS^GECSSGET(RCDPDATA(344,RECTDA,200,"E"))
  1. . . ;
  1. . . ; Okay to continue if status is Error, Rejected, or not defined (-1)
  1. . . I $E(STATUS)="E"!($E(STATUS)="R")!(STATUS=-1) Q
  1. . . S RCER(1)=$$SETERR(2),RCER(2)=" Receipt already sent to FMS - No change"
  1. . . D BULL^RCDPEM1(344.3,RC0,.RCER)
  1. . . S $P(^TMP($J,"RCDPETOT",344.3,RCZ),U,4)=+$G(^TMP($J,"RCXM",0))
  1. . . D STORERR(344.3,RCZ,.RCER)
  1. . . L -^RCY(344,RECTDA)
  1. . . L -^RCY(344.1,RCDEP)
  1. . . S RCQUIT=1 K RCER
  1. . ;
  1. . ; Mark receipt as processed (closed) to prevent editing
  1. . D MARKPROC^RCDPUREC(RECTDA,"")
  1. . ;
  1. . ;PRCA*4.5*409 - Replaced +$O(^RC(341.1,"AC",14,0)) with +RCPAYTYP below
  1. . S DIE="^RCY(344,",DR=".04////"_+RCPAYTYP,DA=RECTDA
  1. . D ^DIE ; Add EDI Lockbox payment type
  1. . ;
  1. . ; Add receipt line for each payer's EFT
  1. . S RCT=0 F S RCT=$O(^RCY(344.31,"B",RCZ,RCT)) Q:'RCT D Q:$O(RCER(0))
  1. . . S RC00=$G(^RCY(344.31,RCT,0)),DR=""
  1. . . S RCTRANDA=$S('$P(RC00,U,14):$$ADDTRAN^RCDPURET(RECTDA),1:$P(RC00,U,14)) ; detail line
  1. . . I 'RCTRANDA D Q
  1. . . . S RCER(1)=$$SETERR(2)
  1. . . . S RCER(2)=" The receipt for the EFT deposit was not created correctly"
  1. . . . S RCER(3)=" You may have to add the detail manually to send the FMS CR doc to revenue"
  1. . . . S RCER(4)=" source code 8NZZ in fund "_$S(DT<$$ADDPTEDT^PRCAACC():"5287.4",1:"528704")
  1. . . . S RCER(4)=RCER(4)_". Receipt # is "_$P($G(^RCY(344,RECTDA,0)),U)
  1. . . . S RCER(5)=" Trace # being processed at time of error was: "_$P(RC00,U,4)_"."
  1. . . . D BULL^RCDPEM1(344.3,RC0,.RCER)
  1. . . . S $P(^TMP($J,"RCDPETOT",344.3,RCZ),U,4)=+$G(^TMP($J,"RCXM",0))
  1. . . . D STORERR(344.3,RCZ,.RCER)
  1. . . ;
  1. . . ;PRCA*4.5*409 Added lines Begin
  1. . . S XX=$P(RC00,"^",4),RCPAYTYP=$S($E(XX,1,3)="OGC":18,1:14)
  1. . . S XX=$S(RCPAYTYP=14:"Auto added EDI Lockbox deposit",1:"Auto added OGC-EFT deposit")
  1. . . ;
  1. . . ;PRCA*4.5*409 Added lines End
  1. . . ;
  1. . . ;PRCA*4.5*409 Replaced Auto added EDI Lockbox deposit with _XX_" below
  1. . . S DR=DR_";1.02////"_XX_";.06////"_$P(RC00,U,12)
  1. . . S DR=DR_";.04////"_$J(+$P(RC00,U,7),"",2)_";.14////"_RCTRANDA
  1. . . N N S N=+$O(^VA(200,"B","EDILOCKBOX,AUTOMATIC",0)) S:N=0 N=.5
  1. . . S DR=DR_";.12////"_N_";.29////"_$P(RC00,U,16) ;PRCA*4.5*375 - Add Debit/Credit Flag to Receipt Transactions
  1. . . S DA(1)=RECTDA,DA=RCTRANDA,DIE="^RCY(344,"_DA(1)_",1,"
  1. . . S:$E(DR)=";" DR=$P(DR,";",2,999)
  1. . . D ^DIE
  1. . . S DR=".14///"_RCTRANDA_";.09///"_RECTDA,DIE="^RCY(344.31,",DA=RCT
  1. . . D ^DIE
  1. . . ;
  1. . ;
  1. . ; Post to FUND 528704/RSC 8NZZ
  1. . D PROCESS^RCDPURE1(RECTDA,2)
  1. . ;
  1. . ; Save details for status report
  1. . N Z,TOT
  1. . S (TOT,Z)=0 F S Z=$O(^RCY(344,RECTDA,1,Z)) Q:'Z S TOT=TOT+$P($G(^RCY(344,RECTDA,1,Z,0)),U,4)
  1. . S $P(^TMP($J,"RCDPETOT",344.3,RCZ),U,2)=TOT
  1. . ;
  1. . I $P($G(^RCY(344,RECTDA,2)),U)="" D ; Receipt not processed fully
  1. . . N CT,Z
  1. . . S RCER(1)=$$SETERR(2),RCER(2)=" The receipt "_$P($G(^RCY(344,RECTDA,0)),U)
  1. . . S RCER(1)=RCER(1)_" for the EFT deposit was not processed fully"
  1. . . S:TOT RCER(3)=" You must manually process it to create the FMS CR doc to rev src code 8NZZ"
  1. . . S Z=0,CT=+$O(RCER(" "),-1) F S Z=$O(^TMP($J,"RCDPEMSG",Z)) Q:'Z S CT=CT+1,RCER(CT)=$G(^TMP($J,"RCDPEMSG",Z))
  1. . . D BULL^RCDPEM1(344.3,RC0,.RCER)
  1. . . S $P(^TMP($J,"RCDPETOT",344.3,RCZ),U,4)=+$G(^TMP($J,"RCXM",0))
  1. . . D STORERR(344.3,RCZ,.RCER)
  1. . ;
  1. . S DIE="^RCY(344.3,",DR=".11////^S X=DT;.12////"_$J(+TOT,"",2),DA=RCZ D ^DIE
  1. . S ^TMP($J,"RCTOT","SUSPAMT")=$G(^TMP($J,"RCTOT","SUSPAMT"))+TOT
  1. . S $P(^TMP($J,"RCDPETOT",344.3,RCZ),U,3)="1"
  1. ;
  1. I 'RCLOCK,$G(RECTDA) D ; couldn't get LOCK send MailMan message and store error
  1. . N RCBODY,XMINSTR,XMSUBJ,XMTO,XMZ
  1. . S RCBODY(1)=" > "_$$FMTE^XLFDT($$NOW^XLFDT,10)
  1. . S RCBODY(2)="An exception occurred during Lockbox processing."
  1. . S RCBODY(3)="Receipt "_$P($G(^RCY(344,RECTDA,0)),U)_" was not processed."
  1. . S RCBODY(4)="The ePayments software could not get exclusive access to the entry."
  1. . S XMSUBJ="EDI LBOX "_$$FMTE^XLFDT(DT,10)_" Receipt Not Processed"
  1. . S XMTO("I:G.RCDPE PAYMENTS")="",XMTO(DUZ)=""
  1. . S XMINSTR("FROM")="POSTMASTER"
  1. . D SENDMSG^XMXAPI(DUZ,XMSUBJ,"RCBODY",.XMTO,.XMINSTR,.XMZ)
  1. . I $G(RCZ) D STORERR(344.3,RCZ,.RCBODY)
  1. ;
  1. I RCLOCK L -^RCY(344,RECTDA)
  1. Q $S(RCLOCK:RECTDA,1:0) ; return new IEN or zero if not processed
  1. ;
  1. SETERR(RCPROC) ; Set up first line of error message to be stored
  1. ; RCPROC = 1 if called from EFT-EOB automatch, 0 if from manual match
  1. ; = 2 if called from EFT deposit creation
  1. N LINE1
  1. I RCPROC S LINE1=$$FMTE^XLFDT($$NOW^XLFDT(),2)_" - PROCESS TO "_$S(RCPROC=1:"CREATE RECEIPT FROM ERA",1:"SEND EFT DEPOSIT TO FMS")
  1. Q LINE1
  1. ;
  1. STORERR(RCFILE,RCZ,RCER) ; Store error text in word processing field
  1. ; RCFILE = 344.3 or 344.31
  1. ; RCZ = ien of the entry in file RCFILE
  1. ; RCER = array containing the error text (passed by ref)
  1. D WP^DIE(RCFILE,RCZ_",",2,"A","RCER")
  1. Q
  1. ;