- RCDPEM1 ;ALB/TMK,DWA,PJH - ERA MATCH TO EFT (cont) ; 5/5/11 1:25pm
- ;;4.5;Accounts Receivable;**173,269,318,321,380**;Mar 20, 1995;Build 14
- ;;Per VA Directive 6402, this routine should not be modified.
- Q
- ;
- BULL(RCFILE,RC0,RCER) ; Add the error to the bulletin text array
- ; RCFILE = null, 344.3 or 344.31, depending on the file being worked
- ; RC0 = the 0-node of the RCFILE entry
- ; RCER = the error text to be placed in the bulletin (passed by ref)
- ;
- N RCHCT,CT,Z
- I '$O(^TMP($J,"RCXM",0)) S ^TMP($J,"RCXM",1)="The following exceptions were encountered attempting",^TMP($J,"RCXM",2)="to post EFT deposits OR to match EFT's with ERA's:",^TMP($J,"RCXM",3)=" "
- S (RCHCT,CT)=+$O(^TMP($J,"RCXM",""),-1)
- S ^TMP($J,"RCXM",0)=$G(^TMP($J,"RCXM",0))+1
- I RC0'="" D
- . D BLD("^TMP($J,""RCXM"")",.CT,RCFILE,RC0)
- . S RCER=$G(RCER)+1,RCHCT=RCHCT+1
- . S ^TMP($J,"RCXM",RCHCT)=$E(^TMP($J,"RCXM",0)_$J("",4),1,4)_$G(^TMP($J,"RCXM",RCHCT))
- S Z=1 F S Z=$O(RCER(Z)) Q:'Z S CT=CT+1,^TMP($J,"RCXM",CT)=" "_RCER(Z)
- S CT=CT+1,^TMP($J,"RCXM",CT)=" "
- Q
- ;
- SENDBULL ; Sends the bulletin when all processing is complete
- N XMBODY,XMB,XMINSTR,XMTYPE,XMFULL,XMTO,XMZ,XMERR,XMSUBJ
- S XMTO("I:G.RCDPE PAYMENTS")=""
- S XMBODY="^TMP($J,""RCXM"")"
- S XMSUBJ="EDI LBOX "_$$FMTE^XLFDT(DT,2)_" EXCEPTIONS EFT DEP/MATCH EFTs TO ERAs"
- D ;
- . N DUZ
- . S DUZ=.5,DUZ(0)="@"
- . D SENDMSG^XMXAPI(.5,XMSUBJ,XMBODY,.XMTO,,.XMZ)
- K ^TMP($J,"RCXM")
- Q
- ;
- BLD(RCARRAY,RCT,RCFILE,RC0) ; Build the array for entry 344.31 detail
- ; RCARRAY = the name of the array to be set
- ; RCT = the # of lines already output into this array
- ; RCFILE = 344.3 or 344.31
- ; RC0 = the 0-node of the entry in RCFILE
- ;
- N Z,RC00
- I RCFILE=344.31 D
- . S RC00=$G(^RCY(344.3,+RC0,0))
- . S Z=$$SETSTR^VALM1(" TRACE #: "_$P(RC0,U,4),"",1,61) ; Expand Trace # to 50 characters
- . S RCT=RCT+1,@RCARRAY@(RCT)=Z ; for Ins. Co. below
- . S Z=$$SETSTR^VALM1(" INS CO: "_$E($P(RC0,U,2),1,22)_"/"_$P(RC0,U,3),"",1,76)
- . S RCT=RCT+1,@RCARRAY@(RCT)=Z
- . S Z=$$SETSTR^VALM1(" DEPOSIT DATE: "_$$FMTE^XLFDT($P(RC00,U,7),2),"",1,24)
- . S Z=$$SETSTR^VALM1(" DATE REC'D: "_$S($P(RC00,U,13):$$FMTE^XLFDT($P(RC00,U,13)\1,2),1:""),Z,25,22)
- . S Z=$$SETSTR^VALM1(" PAYMENT AMT: "_$TR($J($P(RC0,U,7),15,2)," "),Z,47,30)
- . S RCT=RCT+1,@RCARRAY@(RCT)=Z
- ;
- I RCFILE=344.3 D
- . S Z=$$SETSTR^VALM1(" DEPOSIT #: "_$P(RC0,U,6),"",1,13)
- . S Z=$$SETSTR^VALM1(" DEPOSIT DATE: "_$$FMTE^XLFDT($P(RC0,U,7),2),Z,16,24)
- . S RCT=RCT+1,@RCARRAY@(RCT)=Z
- . S Z=$$SETSTR^VALM1(" DATE REC'D: "_$S($P(RC0,U,13):$$FMTE^XLFDT($P(RC0,U,13)\1,2),1:""),"",25,22)
- . S Z=$$SETSTR^VALM1(" DEPOSIT AMT: "_$TR($J($P(RC0,U,8),15,2)," "),Z,47,30)
- . S RCT=RCT+1,@RCARRAY@(RCT)=Z
- ;
- Q
- ;
- EN1 ; Queue match job for run on demand
- N DIR,X,Y,ZTIO,ZTRTN,ZTSK,ZTDESC,ZTDTH
- S DIR(0)="YA",DIR("A",1)="THIS OPTION QUEUES THE JOB TO MATCH EFTs TO ELECTRONIC ERAs"
- S DIR("A")="ARE YOU SURE YOU WANT TO RUN THIS JOB?: ",DIR("B")="NO"
- W ! D ^DIR K DIR
- I Y'=1 G EN1Q
- L +^RCY(344.3,"ALOCK"):5 I '$T D G EN1Q
- . S DIR(0)="EA",DIR("A",1)="This job is currently running ... try again later",DIR("A")="Press ENTER to continue: " D ^DIR K DIR
- S ZTIO="",ZTDTH=$$NOW^XLFDT()
- S ZTRTN="MATCH^RCDPEM(1,1)",ZTDESC="AR - MANUAL EFT-ERA MATCH EDI LOCKBOX"
- D ^%ZTLOAD
- W !!,$S($D(ZTSK):"Your job has been queued - task number "_ZTSK,1:"Unable to queue this job.")
- U IO
- EN1Q L -^RCY(344.3,"ALOCK")
- Q
- ;
- EN2 ; Entrypoint from nightly job to put Nightly data into the nightly job's status bulletin
- ; PRCA*4.5*321 dropped call to the Daily Activity Report
- ; data into the nightly job's status bulletin
- N CT,DATA,Z,Z0,RCHD,T,T0
- S CT=+$O(^TMP($J,"RCXM",""),-1)
- S CT=CT+1,^TMP($J,"RCXM",CT)=""
- I $D(^TMP($J,"RCTOT","EFT_DEP")) D
- . S CT=CT+1,^TMP($J,"RCXM",CT)=$J("",12)_"********** TOTALS **********"
- . S CT=CT+1,^TMP($J,"RCXM",CT)="DEPOSITS"
- . S CT=CT+1,^TMP($J,"RCXM",CT)=" TOTAL # UNPOSTED EFT DEPOSITS FOUND: "_+$G(^TMP($J,"RCTOT","EFT_DEP"))
- . S CT=CT+1,^TMP($J,"RCXM",CT)=" TOTAL # NEW EFT DEPOSITS CREATED: "_+$G(^TMP($J,"RCTOT","DEPOSIT"))
- . S CT=CT+1,^TMP($J,"RCXM",CT)=" TOTAL # NEW EFT DEPOSIT RECEIPTS CREATED: "_+$G(^TMP($J,"RCTOT","EFT_RECPT"))
- . S CT=CT+1,^TMP($J,"RCXM",CT)=" TOTAL # EFT DEPOSITS WITH CHECK SUM ERRORS: "_+$G(^TMP($J,"RCTOT","CSUM"))
- . S CT=CT+1,^TMP($J,"RCXM",CT)=" TOTAL # EFT DEPOSITS WITH OTHER ERRORS: "_+$G(^TMP($J,"RCTOT","ERR"))
- . S CT=CT+1,^TMP($J,"RCXM",CT)=" TOTAL EFT DEPOSIT AMOUNT POSTED TO REV SRC CD 8NZZ: "_$J(+$G(^TMP($J,"RCTOT","SUSPAMT")),"",2)
- . S CT=CT+1,^TMP($J,"RCXM",CT)=""
- S CT=CT+1,^TMP($J,"RCXM",CT)="EFT-ERA MATCHES"
- S CT=CT+1,^TMP($J,"RCXM",CT)=" TOTAL # UNMATCHED ERAs CHECKED: "_+$G(^TMP($J,"RCTOT","EFT"))
- S CT=CT+1,^TMP($J,"RCXM",CT)=" TOTAL # ERAs MATCHED TO EFTs: "_+$G(^TMP($J,"RCTOT","MATCH"))_$S($G(^TMP($J,"RCTOT","MATCH"))&$G(^TMP($J,"RCTOT","TOTMIS")):" INCLUDING "_+$G(^TMP($J,"RCTOT","TOTMIS"))_" WITH MISMATCHED TOTALS",1:"")
- S CT=CT+1,^TMP($J,"RCXM",CT)=" TOTAL # ERAs STILL UNMATCHED: "_+$G(^TMP($J,"RCTOT","NO_MATCH"))
- S CT=CT+1,^TMP($J,"RCXM",CT)=""
- ;K ^TMP("RCDAILYACT",$J) ; PRCA*4.5*321 don't need - related to Daily Activity Report
- K ^TMP($J,"RC1")
- ;
- S Z=0 F S Z=$O(^TMP($J,"RCDPETOT",344.31,Z)) Q:'Z S Z0=$G(^RCY(344.31,Z,0)) I Z0 S ^TMP($J,"RC1",+Z0,Z)=Z0
- ;
- S (RCHD,Z)=0 F S Z=$O(^TMP($J,"RCDPETOT",344.3,Z)) Q:'Z S DATA=$G(^(Z)) D
- . I 'RCHD D HDR(.CT,.RCHD) ; Add headers
- . S Z0=$G(^RCY(344.3,Z,0))
- . S CT=CT+1
- . S ^TMP($J,"RCXM",CT)=""
- . I '$G(DATA) D
- .. ;PRCA*4.5*380 - Removed advancing of the counter
- .. ;S CT=CT+1
- .. S ^TMP($J,"RCXM",CT)=^TMP($J,"RCXM",CT)_" "_$E($P($G(^RCY(344.1,+$P(Z0,U,3),0)),U)_$J("",15),1,15)_" "_$E($P($G(^RCY(344,+$O(^RCY(344,"AD",+$P(Z0,U,3),0)),0)),U)_$J("",15),1,15)_" "
- .. S ^TMP($J,"RCXM",CT)=^TMP($J,"RCXM",CT)_$J(+$P(Z0,U,12),"",2)
- . I $G(DATA) D
- .. S ^TMP($J,"RCXM",CT)=^TMP($J,"RCXM",CT)_" "_$E($P($G(^RCY(344.1,+$P(DATA,U,5),0)),U)_$J("",15),1,15)_" "_$E($S($P(DATA,U,5):$P($G(^RCY(344,+DATA,0)),U),1:"")_$J("",15),1,15)_" "
- .. S ^TMP($J,"RCXM",CT)=^TMP($J,"RCXM",CT)_$J($S($P(DATA,U,3):+$P(DATA,U,2),1:0),"",2)
- . I $P(DATA,U,4) S CT=CT+1,^TMP($J,"RCXM",CT)=" ERROR # REFERENCED ABOVE : "_$P(DATA,U,4)
- . S T=0 F S T=$O(^TMP($J,"RC1",Z,T)) Q:'T S T0=$G(^(T)) D
- .. S CT=CT+1
- .. S ^TMP($J,"RCXM",CT)=$J("",5)_$P(T0,U,4)
- .. S CT=CT+1 ; separate TRACE # above from PAYER NAME/ID below
- .. S ^TMP($J,"RCXM",CT)=$J("",5)_$P(T0,U,2)_"/"_$P(T0,U,3)
- .. S CT=CT+1,^TMP($J,"RCXM",CT)=$J("",10)_"PAYMENT AMOUNT: "_$J(+$P(T0,U,7),"",2)_" MATCH STATUS: "_$$EXTERNAL^DILFD(344.31,.08,,$P(T0,U,8))
- .. S:$O(^TMP($J,"RCDPETOT",344.3,Z)) CT=CT+1,^TMP($J,"RCXM",CT)=" "
- ;. I $P(DATA,U,3) S ^TMP("RCDAILYACT",$J,DT,Z)=Z0 ;PRCA*4.5*321 remove
- ;
- K ^TMP($J,"RC1")
- ;I $O(^TMP("RCDAILYACT",$J,0)) D ; Daily activity rep automatic bulletin ;PRCA*4.5*321 remove
- ;. N XMBODY,XMB,XMINSTR,XMTYPE,XMFULL,XMTO,XMZ,XMERR,XMSUBJ
- ;. K ^TMP($J,"RCDPE_DAR")
- ;. D RPT1^RCDPEDAR("1^0^0^0^0^"_DT_"^"_DT) ;PRCA*4.5*318, changed the parameters
- ;. K ^TMP("RCDAILYACT",$J)
- ;. Q:'$O(^TMP($J,"RCDPE_DAR",0))
- ;. S XMTO("I:G.RCDPE PAYMENTS")=""
- ;. S XMBODY="^TMP($J,""RCDPE_DAR"")"
- ;. S XMSUBJ="EDI LBOX - AUTO DAILY ACTIVITY SUMMARY - "_$$FMTE^XLFDT(DT,2)
- ;. D ;
- ;.. N DUZ
- ;.. S DUZ=.5,DUZ(0)="@"
- ;.. D SENDMSG^XMXAPI(.5,XMSUBJ,XMBODY,.XMTO,,.XMZ)
- ;. K ^TMP($J,"RCDPE_DAR")
- Q
- ;
- HDR(CT,HD) ; Header array set
- ; CT = line count, passed by reference
- ; HD = flag returned as 1 so the header is only output once
- N Q
- S CT=CT+1,^TMP($J,"RCXM",CT)=" "
- S CT=CT+1,^TMP($J,"RCXM",CT)=$J("",20)_"********** EFT DEPOSIT RECORDS **********"
- S CT=CT+1,^TMP($J,"RCXM",CT)=" EFT DEPOSIT EFT RECEIPT POSTED AMOUNT"
- S CT=CT+1,^TMP($J,"RCXM",CT)=" "
- S CT=CT+1,^TMP($J,"RCXM",CT)=" TRACE #"
- S CT=CT+1,^TMP($J,"RCXM",CT)=" PAYER NAME/ID"
- S CT=CT+1,Q="",$P(Q,"=",79)="",^TMP($J,"RCXM",CT)=Q
- S HD=1
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEM1 8024 printed Jan 18, 2025@02:45:57 Page 2
- RCDPEM1 ;ALB/TMK,DWA,PJH - ERA MATCH TO EFT (cont) ; 5/5/11 1:25pm
- +1 ;;4.5;Accounts Receivable;**173,269,318,321,380**;Mar 20, 1995;Build 14
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 QUIT
- +4 ;
- BULL(RCFILE,RC0,RCER) ; Add the error to the bulletin text array
- +1 ; RCFILE = null, 344.3 or 344.31, depending on the file being worked
- +2 ; RC0 = the 0-node of the RCFILE entry
- +3 ; RCER = the error text to be placed in the bulletin (passed by ref)
- +4 ;
- +5 NEW RCHCT,CT,Z
- +6 IF '$ORDER(^TMP($JOB,"RCXM",0))
- SET ^TMP($JOB,"RCXM",1)="The following exceptions were encountered attempting"
- SET ^TMP($JOB,"RCXM",2)="to post EFT deposits OR to match EFT's with ERA's:"
- SET ^TMP($JOB,"RCXM",3)=" "
- +7 SET (RCHCT,CT)=+$ORDER(^TMP($JOB,"RCXM",""),-1)
- +8 SET ^TMP($JOB,"RCXM",0)=$GET(^TMP($JOB,"RCXM",0))+1
- +9 IF RC0'=""
- Begin DoDot:1
- +10 DO BLD("^TMP($J,""RCXM"")",.CT,RCFILE,RC0)
- +11 SET RCER=$GET(RCER)+1
- SET RCHCT=RCHCT+1
- +12 SET ^TMP($JOB,"RCXM",RCHCT)=$EXTRACT(^TMP($JOB,"RCXM",0)_$JUSTIFY("",4),1,4)_$GET(^TMP($JOB,"RCXM",RCHCT))
- End DoDot:1
- +13 SET Z=1
- FOR
- SET Z=$ORDER(RCER(Z))
- if 'Z
- QUIT
- SET CT=CT+1
- SET ^TMP($JOB,"RCXM",CT)=" "_RCER(Z)
- +14 SET CT=CT+1
- SET ^TMP($JOB,"RCXM",CT)=" "
- +15 QUIT
- +16 ;
- SENDBULL ; Sends the bulletin when all processing is complete
- +1 NEW XMBODY,XMB,XMINSTR,XMTYPE,XMFULL,XMTO,XMZ,XMERR,XMSUBJ
- +2 SET XMTO("I:G.RCDPE PAYMENTS")=""
- +3 SET XMBODY="^TMP($J,""RCXM"")"
- +4 SET XMSUBJ="EDI LBOX "_$$FMTE^XLFDT(DT,2)_" EXCEPTIONS EFT DEP/MATCH EFTs TO ERAs"
- +5 ;
- Begin DoDot:1
- +6 NEW DUZ
- +7 SET DUZ=.5
- SET DUZ(0)="@"
- +8 DO SENDMSG^XMXAPI(.5,XMSUBJ,XMBODY,.XMTO,,.XMZ)
- End DoDot:1
- +9 KILL ^TMP($JOB,"RCXM")
- +10 QUIT
- +11 ;
- BLD(RCARRAY,RCT,RCFILE,RC0) ; Build the array for entry 344.31 detail
- +1 ; RCARRAY = the name of the array to be set
- +2 ; RCT = the # of lines already output into this array
- +3 ; RCFILE = 344.3 or 344.31
- +4 ; RC0 = the 0-node of the entry in RCFILE
- +5 ;
- +6 NEW Z,RC00
- +7 IF RCFILE=344.31
- Begin DoDot:1
- +8 SET RC00=$GET(^RCY(344.3,+RC0,0))
- +9 ; Expand Trace # to 50 characters
- SET Z=$$SETSTR^VALM1(" TRACE #: "_$PIECE(RC0,U,4),"",1,61)
- +10 ; for Ins. Co. below
- SET RCT=RCT+1
- SET @RCARRAY@(RCT)=Z
- +11 SET Z=$$SETSTR^VALM1(" INS CO: "_$EXTRACT($PIECE(RC0,U,2),1,22)_"/"_$PIECE(RC0,U,3),"",1,76)
- +12 SET RCT=RCT+1
- SET @RCARRAY@(RCT)=Z
- +13 SET Z=$$SETSTR^VALM1(" DEPOSIT DATE: "_$$FMTE^XLFDT($PIECE(RC00,U,7),2),"",1,24)
- +14 SET Z=$$SETSTR^VALM1(" DATE REC'D: "_$SELECT($PIECE(RC00,U,13):$$FMTE^XLFDT($PIECE(RC00,U,13)\1,2),1:""),Z,25,22)
- +15 SET Z=$$SETSTR^VALM1(" PAYMENT AMT: "_$TRANSLATE($JUSTIFY($PIECE(RC0,U,7),15,2)," "),Z,47,30)
- +16 SET RCT=RCT+1
- SET @RCARRAY@(RCT)=Z
- End DoDot:1
- +17 ;
- +18 IF RCFILE=344.3
- Begin DoDot:1
- +19 SET Z=$$SETSTR^VALM1(" DEPOSIT #: "_$PIECE(RC0,U,6),"",1,13)
- +20 SET Z=$$SETSTR^VALM1(" DEPOSIT DATE: "_$$FMTE^XLFDT($PIECE(RC0,U,7),2),Z,16,24)
- +21 SET RCT=RCT+1
- SET @RCARRAY@(RCT)=Z
- +22 SET Z=$$SETSTR^VALM1(" DATE REC'D: "_$SELECT($PIECE(RC0,U,13):$$FMTE^XLFDT($PIECE(RC0,U,13)\1,2),1:""),"",25,22)
- +23 SET Z=$$SETSTR^VALM1(" DEPOSIT AMT: "_$TRANSLATE($JUSTIFY($PIECE(RC0,U,8),15,2)," "),Z,47,30)
- +24 SET RCT=RCT+1
- SET @RCARRAY@(RCT)=Z
- End DoDot:1
- +25 ;
- +26 QUIT
- +27 ;
- EN1 ; Queue match job for run on demand
- +1 NEW DIR,X,Y,ZTIO,ZTRTN,ZTSK,ZTDESC,ZTDTH
- +2 SET DIR(0)="YA"
- SET DIR("A",1)="THIS OPTION QUEUES THE JOB TO MATCH EFTs TO ELECTRONIC ERAs"
- +3 SET DIR("A")="ARE YOU SURE YOU WANT TO RUN THIS JOB?: "
- SET DIR("B")="NO"
- +4 WRITE !
- DO ^DIR
- KILL DIR
- +5 IF Y'=1
- GOTO EN1Q
- +6 LOCK +^RCY(344.3,"ALOCK"):5
- IF '$TEST
- Begin DoDot:1
- +7 SET DIR(0)="EA"
- SET DIR("A",1)="This job is currently running ... try again later"
- SET DIR("A")="Press ENTER to continue: "
- DO ^DIR
- KILL DIR
- End DoDot:1
- GOTO EN1Q
- +8 SET ZTIO=""
- SET ZTDTH=$$NOW^XLFDT()
- +9 SET ZTRTN="MATCH^RCDPEM(1,1)"
- SET ZTDESC="AR - MANUAL EFT-ERA MATCH EDI LOCKBOX"
- +10 DO ^%ZTLOAD
- +11 WRITE !!,$SELECT($DATA(ZTSK):"Your job has been queued - task number "_ZTSK,1:"Unable to queue this job.")
- +12 USE IO
- EN1Q LOCK -^RCY(344.3,"ALOCK")
- +1 QUIT
- +2 ;
- EN2 ; Entrypoint from nightly job to put Nightly data into the nightly job's status bulletin
- +1 ; PRCA*4.5*321 dropped call to the Daily Activity Report
- +2 ; data into the nightly job's status bulletin
- +3 NEW CT,DATA,Z,Z0,RCHD,T,T0
- +4 SET CT=+$ORDER(^TMP($JOB,"RCXM",""),-1)
- +5 SET CT=CT+1
- SET ^TMP($JOB,"RCXM",CT)=""
- +6 IF $DATA(^TMP($JOB,"RCTOT","EFT_DEP"))
- Begin DoDot:1
- +7 SET CT=CT+1
- SET ^TMP($JOB,"RCXM",CT)=$JUSTIFY("",12)_"********** TOTALS **********"
- +8 SET CT=CT+1
- SET ^TMP($JOB,"RCXM",CT)="DEPOSITS"
- +9 SET CT=CT+1
- SET ^TMP($JOB,"RCXM",CT)=" TOTAL # UNPOSTED EFT DEPOSITS FOUND: "_+$GET(^TMP($JOB,"RCTOT","EFT_DEP"))
- +10 SET CT=CT+1
- SET ^TMP($JOB,"RCXM",CT)=" TOTAL # NEW EFT DEPOSITS CREATED: "_+$GET(^TMP($JOB,"RCTOT","DEPOSIT"))
- +11 SET CT=CT+1
- SET ^TMP($JOB,"RCXM",CT)=" TOTAL # NEW EFT DEPOSIT RECEIPTS CREATED: "_+$GET(^TMP($JOB,"RCTOT","EFT_RECPT"))
- +12 SET CT=CT+1
- SET ^TMP($JOB,"RCXM",CT)=" TOTAL # EFT DEPOSITS WITH CHECK SUM ERRORS: "_+$GET(^TMP($JOB,"RCTOT","CSUM"))
- +13 SET CT=CT+1
- SET ^TMP($JOB,"RCXM",CT)=" TOTAL # EFT DEPOSITS WITH OTHER ERRORS: "_+$GET(^TMP($JOB,"RCTOT","ERR"))
- +14 SET CT=CT+1
- SET ^TMP($JOB,"RCXM",CT)=" TOTAL EFT DEPOSIT AMOUNT POSTED TO REV SRC CD 8NZZ: "_$JUSTIFY(+$GET(^TMP($JOB,"RCTOT","SUSPAMT")),"",2)
- +15 SET CT=CT+1
- SET ^TMP($JOB,"RCXM",CT)=""
- End DoDot:1
- +16 SET CT=CT+1
- SET ^TMP($JOB,"RCXM",CT)="EFT-ERA MATCHES"
- +17 SET CT=CT+1
- SET ^TMP($JOB,"RCXM",CT)=" TOTAL # UNMATCHED ERAs CHECKED: "_+$GET(^TMP($JOB,"RCTOT","EFT"))
- +18 SET CT=CT+1
- SET ^TMP($JOB,"RCXM",CT)=" TOTAL # ERAs MATCHED TO EFTs: "_+$GET(^TMP($JOB,"RCTOT","MATCH"))_$SELECT($GET(^TMP($JOB,"RCTOT","MATCH"))&$GET(^TMP($JOB,"RCTOT","TOTMIS")):" INCLUDING "_+$GET(^TMP($JOB,"RCTOT","TOTMIS"))_" WITH MISMATCHED TOTALS",
- 1:"")
- +19 SET CT=CT+1
- SET ^TMP($JOB,"RCXM",CT)=" TOTAL # ERAs STILL UNMATCHED: "_+$GET(^TMP($JOB,"RCTOT","NO_MATCH"))
- +20 SET CT=CT+1
- SET ^TMP($JOB,"RCXM",CT)=""
- +21 ;K ^TMP("RCDAILYACT",$J) ; PRCA*4.5*321 don't need - related to Daily Activity Report
- +22 KILL ^TMP($JOB,"RC1")
- +23 ;
- +24 SET Z=0
- FOR
- SET Z=$ORDER(^TMP($JOB,"RCDPETOT",344.31,Z))
- if 'Z
- QUIT
- SET Z0=$GET(^RCY(344.31,Z,0))
- IF Z0
- SET ^TMP($JOB,"RC1",+Z0,Z)=Z0
- +25 ;
- +26 SET (RCHD,Z)=0
- FOR
- SET Z=$ORDER(^TMP($JOB,"RCDPETOT",344.3,Z))
- if 'Z
- QUIT
- SET DATA=$GET(^(Z))
- Begin DoDot:1
- +27 ; Add headers
- IF 'RCHD
- DO HDR(.CT,.RCHD)
- +28 SET Z0=$GET(^RCY(344.3,Z,0))
- +29 SET CT=CT+1
- +30 SET ^TMP($JOB,"RCXM",CT)=""
- +31 IF '$GET(DATA)
- Begin DoDot:2
- +32 ;PRCA*4.5*380 - Removed advancing of the counter
- +33 ;S CT=CT+1
- +34 SET ^TMP($JOB,"RCXM",CT)=^TMP($JOB,"RCXM",CT)_" "_$EXTRACT($PIECE($GET(^RCY(344.1,+$PIECE(Z0,U,3),0)),U)_$JUSTIFY("",15),1,15)_" "_$EXTRACT($PIECE($GET(^RCY(344,+$ORDER(^RCY(344,"AD",+$PIECE(Z0,U,3),0)),0)),U)_$JUSTIFY("",15),
- 1,15)_" "
- +35 SET ^TMP($JOB,"RCXM",CT)=^TMP($JOB,"RCXM",CT)_$JUSTIFY(+$PIECE(Z0,U,12),"",2)
- End DoDot:2
- +36 IF $GET(DATA)
- Begin DoDot:2
- +37 SET ^TMP($JOB,"RCXM",CT)=^TMP($JOB,"RCXM",CT)_" "_$EXTRACT($PIECE($GET(^RCY(344.1,+$PIECE(DATA,U,5),0)),U)_$JUSTIFY("",15),1,15)_" "_$EXTRACT($SELECT($PIECE(DATA,U,5):$PIECE($GET(^RCY(344,+DATA,0)),U),1:"")_$JUSTIFY("",15),1,1
- 5)_" "
- +38 SET ^TMP($JOB,"RCXM",CT)=^TMP($JOB,"RCXM",CT)_$JUSTIFY($SELECT($PIECE(DATA,U,3):+$PIECE(DATA,U,2),1:0),"",2)
- End DoDot:2
- +39 IF $PIECE(DATA,U,4)
- SET CT=CT+1
- SET ^TMP($JOB,"RCXM",CT)=" ERROR # REFERENCED ABOVE : "_$PIECE(DATA,U,4)
- +40 SET T=0
- FOR
- SET T=$ORDER(^TMP($JOB,"RC1",Z,T))
- if 'T
- QUIT
- SET T0=$GET(^(T))
- Begin DoDot:2
- +41 SET CT=CT+1
- +42 SET ^TMP($JOB,"RCXM",CT)=$JUSTIFY("",5)_$PIECE(T0,U,4)
- +43 ; separate TRACE # above from PAYER NAME/ID below
- SET CT=CT+1
- +44 SET ^TMP($JOB,"RCXM",CT)=$JUSTIFY("",5)_$PIECE(T0,U,2)_"/"_$PIECE(T0,U,3)
- +45 SET CT=CT+1
- SET ^TMP($JOB,"RCXM",CT)=$JUSTIFY("",10)_"PAYMENT AMOUNT: "_$JUSTIFY(+$PIECE(T0,U,7),"",2)_" MATCH STATUS: "_$$EXTERNAL^DILFD(344.31,.08,,$PIECE(T0,U,8))
- +46 if $ORDER(^TMP($JOB,"RCDPETOT",344.3,Z))
- SET CT=CT+1
- SET ^TMP($JOB,"RCXM",CT)=" "
- End DoDot:2
- End DoDot:1
- +47 ;. I $P(DATA,U,3) S ^TMP("RCDAILYACT",$J,DT,Z)=Z0 ;PRCA*4.5*321 remove
- +48 ;
- +49 KILL ^TMP($JOB,"RC1")
- +50 ;I $O(^TMP("RCDAILYACT",$J,0)) D ; Daily activity rep automatic bulletin ;PRCA*4.5*321 remove
- +51 ;. N XMBODY,XMB,XMINSTR,XMTYPE,XMFULL,XMTO,XMZ,XMERR,XMSUBJ
- +52 ;. K ^TMP($J,"RCDPE_DAR")
- +53 ;. D RPT1^RCDPEDAR("1^0^0^0^0^"_DT_"^"_DT) ;PRCA*4.5*318, changed the parameters
- +54 ;. K ^TMP("RCDAILYACT",$J)
- +55 ;. Q:'$O(^TMP($J,"RCDPE_DAR",0))
- +56 ;. S XMTO("I:G.RCDPE PAYMENTS")=""
- +57 ;. S XMBODY="^TMP($J,""RCDPE_DAR"")"
- +58 ;. S XMSUBJ="EDI LBOX - AUTO DAILY ACTIVITY SUMMARY - "_$$FMTE^XLFDT(DT,2)
- +59 ;. D ;
- +60 ;.. N DUZ
- +61 ;.. S DUZ=.5,DUZ(0)="@"
- +62 ;.. D SENDMSG^XMXAPI(.5,XMSUBJ,XMBODY,.XMTO,,.XMZ)
- +63 ;. K ^TMP($J,"RCDPE_DAR")
- +64 QUIT
- +65 ;
- HDR(CT,HD) ; Header array set
- +1 ; CT = line count, passed by reference
- +2 ; HD = flag returned as 1 so the header is only output once
- +3 NEW Q
- +4 SET CT=CT+1
- SET ^TMP($JOB,"RCXM",CT)=" "
- +5 SET CT=CT+1
- SET ^TMP($JOB,"RCXM",CT)=$JUSTIFY("",20)_"********** EFT DEPOSIT RECORDS **********"
- +6 SET CT=CT+1
- SET ^TMP($JOB,"RCXM",CT)=" EFT DEPOSIT EFT RECEIPT POSTED AMOUNT"
- +7 SET CT=CT+1
- SET ^TMP($JOB,"RCXM",CT)=" "
- +8 SET CT=CT+1
- SET ^TMP($JOB,"RCXM",CT)=" TRACE #"
- +9 SET CT=CT+1
- SET ^TMP($JOB,"RCXM",CT)=" PAYER NAME/ID"
- +10 SET CT=CT+1
- SET Q=""
- SET $PIECE(Q,"=",79)=""
- SET ^TMP($JOB,"RCXM",CT)=Q
- +11 SET HD=1
- +12 QUIT
- +13 ;