RCDPEDAR ;ALB/TMK - ACTIVITY REPORT ;04-NOV-02 ;;4.5;Accounts Receivable;**173**;Mar 20, 1995 ;;Per VHA Directive 10-93-142, this routine should not be modified. Q ; RPT ; Daily Activity Rpt On Demand N DUOUT,DTOUT,DIR,X,Y,RCDT1,RCDT2,RCDET,ZTRTN,ZTSK,ZTDESC,%ZIS,POP S DIR("A")="(S)UMMARY OR (D)ETAIL?: ",DIR(0)="SA^S:SUMMARY TOTALS ONLY;D:DETAIL AND TOTALS" S DIR("B")="D" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT)!(Y="") G RPTQ S RCDET=(Y="D") S DIR("?")="ENTER THE EARLIEST DATE OF RECEIPT OF DEPOSIT TO INCLUDE ON THE REPORT" S DIR(0)="DAO^:"_DT_":APE",DIR("A")="START DATE: " D ^DIR K DIR I $D(DTOUT)!$D(DUOUT)!(Y="") G RPTQ S RCDT1=Y S DIR("?")="ENTER THE LATEST DATE OF RECEIPT OF DEPOSIT TO INCLUDE ON THE REPORT" S DIR("B")=Y(0) S DIR(0)="DAO^"_RCDT1_":"_DT_":APE",DIR("A")="END DATE: " D ^DIR K DIR I $D(DTOUT)!$D(DUOUT)!(Y="") G RPTQ S RCDT2=Y ; Ask device S %ZIS="QM" D ^%ZIS G:POP RPTQ I $D(IO("Q")) D G RPTQ . S ZTRTN="EN^RCDPEDAR("_RCDET_","_RCDT1_","_RCDT2_")",ZTDESC="AR - EDI LOCKBOX DAILY ACTIVITY REPORT" . D ^%ZTLOAD . W !!,$S($D(ZTSK):"Your task number "_ZTSK_" has been queued.",1:"Unable to queue this job.") . K ZTSK,IO("Q") D HOME^%ZIS U IO D EN(RCDET,RCDT1,RCDT2) RPTQ Q ; EN(RCDET,RCDT1,RCDT2) ; Entry point for queued job ; RCDET = 1 to include detail, 0 for totals only ; RCDT1,RCDT2 = date from,to N Z,Z0,RC,RCT,DATA,RCSTOP,RCPG K ^TMP("RCDAILYACT",$J) S Z=RCDT1-.0001,(RCSTOP,RCT)=0 F S Z=$O(^RCY(344.3,"ARECDT",Z)) Q:'Z!(Z>(RCDT2_".9999"))!RCSTOP S Z0=0 F S Z0=$O(^RCY(344.3,"ARECDT",Z,Z0)) Q:'Z0 S DATA=$G(^RCY(344.3,Z0,0)) D Q:RCSTOP . S RCT=RCT+1 I '(RCT#100),$D(ZTQUEUED),$$S^%ZTLOAD S (RCSTOP,ZTSTOP)=1 K ZTREQ Q ; Check for user stopped every 100 records . S ^TMP("RCDAILYACT",$J,Z\1,Z0)=DATA D:'RCSTOP RPT1(0,RCDET,RCDT1,RCDT2,.RCSTOP,.RCPG) D ENQ(RCSTOP,$G(RCPG)) Q ; RPT1(RCNITE,RCDET,RCDT1,RCDT2,RCSTOP,RCPG) ; Entrypoint for nightly job ; RCNITE = 1 if called from nightly job, 0 if called from on demand ; RCDET = 1 to include detail, 0 for totals only ; RCDT1,RCDT2 = date from,to ; RCSTOP = returned = 1 if user elected to quit job ; RCPG = the last page # printed, returned if passed by reference ; N X,Q,Q0,Z,Z0,Z1,Z2,Z3,ZCT,RCCT,RCDEP,RCDEPA,RCDEPAP,RCFMS,RCFMS1,RCD1,RCFMSTOT,RCEFT,RCMATCH,RCDEPREC,RCDT S (RCSTOP,RCPG,ZCT,RCCT,RCDEP,RCDEPA,RCDEPAP,RCDEPREC,Z)=0,RCD1=1 S RCNITE=+$G(RCNITE) F S Z=$O(^TMP("RCDAILYACT",$J,Z)) Q:'Z D G:RCSTOP RPT1Q ; Z = date . I 'RCPG!$S('$G(RCNITE):($Y+5)>IOSL,1:0) D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) S RCDT=1 Q:RCSTOP . S Q="DATE EFT DEPOSIT RECEIVED: "_$$FMTE^XLFDT(Z,2),Q=$J("",80-$L(Q)\2)_Q ; Center it . I 'RCD1,$G(RCDET) D SETLINE(RCNITE,"",.RCCT) ; Skip line if >1 dt on pg . S RCDT=0 . I '$G(RCNITE),($Y+5)>IOSL D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) Q:RCSTOP . I $G(RCDET) D .. D SETLINE(RCNITE,Q,.RCCT) .. D SETLINE(RCNITE,"",.RCCT) . ; Z0 = ien of entry in file 344.3 . K RCEFT("D"),RCMATCH("D"),RCFMS("D") . S Z0=0 F S Z0=$O(^TMP("RCDAILYACT",$J,Z,Z0)) Q:'Z0 D Q:RCSTOP .. S Z1=$G(^TMP("RCDAILYACT",$J,Z,Z0)) .. S RCDEPREC=+$O(^RCY(344,"AD",+$P(Z1,U,3),0)),RCDEP(Z)=$G(RCDEP(Z))+1,RCDEPA(Z)=$G(RCDEPA(Z))+$P(Z1,U,8) .. I $P($G(^RCY(344,RCDEPREC,2)),U)="" S RCFMS("D",-1)=$G(RCFMS("D",-1))+$P(Z1,U,8),RCFMS="NO FMS DOC" .. I $P($G(^RCY(344,RCDEPREC,2)),U)'="" D ... S X=$$STATUS^GECSSGET($P(^RCY(344,RCDEPREC,2),U)) ... I X=-1 S RCFMS("D",-1)=$G(RCFMS("D",-1))+$P(Z1,U,8) Q ... S RCFMS=$E($P(X," "),1,10),Q=$E(X),Q=$S(Q="E"!(Q="R"):0,Q="Q":2,1:1),RCFMS("D",Q)=$G(RCFMS("D",Q))+$P(Z1,U,8) ... ; .. I $G(RCDET) D Q:RCSTOP ... S X=$$SETSTR^VALM1($P(Z1,U,6),"",1,6) ... S X=$$SETSTR^VALM1($$FMTE^XLFDT($P(Z1,U,7)\1,2),X,9,10) ... S X=$$SETSTR^VALM1("",X,21,10) ... S X=$$SETSTR^VALM1("",X,32,10) ... S X=$$SETSTR^VALM1($E($J($P(Z1,U,8),"",2)_$J("",20),1,20)_RCFMS,X,43,37) ... I '$G(RCNITE),($Y+5)>IOSL D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) Q:RCSTOP ... D SETLINE(RCNITE,X,.RCCT) .. S RCFMSTOT=0,RCFMS1="NO FMS DOC" .. I $O(^RCY(344.3,Z0,2,0)) D Q:RCSTOP ... N V ... I '$G(RCNITE),($Y+5)>IOSL D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) Q:RCSTOP ... D SETLINE(RCNITE,$J("",10)_"ERROR MESSAGES FOR EFT:",.RCCT) ... S V=0 F S V=$O(^RCY(344.3,Z0,2,V)) Q:'V D Q:RCSTOP .... I '$G(RCNITE),($Y+5)>IOSL D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) Q:RCSTOP .... D SETLINE(RCNITE,$J("",12)_$G(^RCY(344.3,Z0,2,V,0)),.RCCT) .. S Z2=0 F S Z2=$O(^RCY(344.31,"B",Z0,Z2)) Q:'Z2 S Z3=$G(^RCY(344.31,Z2,0)) D Q:RCSTOP ... S RCEFT("D")=$G(RCEFT("D"))+1 ... S X=$S($P($G(^RCY(344,+$P(Z3,U,9),2)),U)'="":$$STATUS^GECSSGET($P(^RCY(344,+$P(Z3,U,9),2),U)),1:"") ... I X'="",X'=-1,$E(X)'="R",$E(X)'="E" S RCFMSTOT=RCFMSTOT+$P(Z3,U,7),RCFMS1=$S($E(X)="Q":"QUEUED TO POST",1:"POSTED") ... S RCFMS1(Z2)=$S(X="":"",X=-1:"NO FMS DOC",1:$E($P(X," "),1,10)) ... I $P(Z3,U,8) S RCMATCH("D")=$G(RCMATCH("D"))+1 ... ; ... I $G(RCDET) D EFTDET^RCDPEDA1(Z2,Z3,.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,.RCFMS1,RCNITE) Q:RCSTOP .. ; .. Q:RCSTOP .. I RCDET D SETLINE(RCNITE,"",.RCCT) . ; . Q:RCSTOP . S RCDEPA=RCDEPA+$G(RCDEPA(Z)),RCDEP=RCDEP+$G(RCDEP(Z)),RCDEPAP=RCDEPAP+$G(RCDEPAP(Z)),RCFMSTOT("D")=$G(RCFMSTOT("D"))+$G(RCFMSTOT),RCEFT("T")=$G(RCEFT("T"))+$G(RCEFT("D")),RCMATCH("T")=$G(RCMATCH("T"))+$G(RCMATCH("D")) . F Q=-1,0,1,2 S RCFMS("T",Q)=$G(RCFMS("T",Q))+$G(RCFMS("D",Q)) . D SETLINE(RCNITE,"",.RCCT) . I $S('$G(RCNITE):($Y+5)>IOSL,1:0)!'RCPG D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) Q:RCSTOP . D SETLINE(RCNITE,$E("**TOTALS FOR DATE: "_$$FMTE^XLFDT(Z\1,2)_$J("",30),1,30)_" # OF DEPOSIT TICKETS RECEIVED: "_+$G(RCDEP(Z))_$J("",5),.RCCT) . D SETLINE(RCNITE,$J("",29)_"TOTAL AMOUNT OF DEPOSITS RECEIVED: $"_$J(+$G(RCDEPA(Z)),"",2),.RCCT) . I '$G(RCNITE),($Y+5)>IOSL D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) Q:RCSTOP . D SETLINE(RCNITE,"",.RCCT) . D SETLINE(RCNITE,$J("",20)_"DEPOSIT AMOUNTS SENT TO FMS:",.RCCT) . I '$G(RCNITE),($Y+5)>IOSL D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) Q:RCSTOP . D SETLINE(RCNITE,$J("",39)_"ACCEPTED: $"_$J(+$G(RCFMS("D",1)),"",2),.RCCT) . I '$G(RCNITE),($Y+5)>IOSL D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) Q:RCSTOP . D SETLINE(RCNITE,$J("",41)_"QUEUED: $"_$J(+$G(RCFMS("D",2)),"",2),.RCCT) . I '$G(RCNITE),($Y+5)>IOSL D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) Q:RCSTOP . D SETLINE(RCNITE,$J("",35)_"ERROR/REJECT: $"_$J(+$G(RCFMS("D",0)),"",2),.RCCT) . I '$G(RCNITE),($Y+5)>IOSL D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) Q:RCSTOP . D SETLINE(RCNITE,$J("",37)_"NOT IN FMS: $"_$J(+$G(RCFMS("D",-1)),"",2),.RCCT) . D SETLINE(RCNITE,"",.RCCT) . I '$G(RCNITE),($Y+5)>IOSL D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) Q:RCSTOP . D SETLINE(RCNITE,$J("",26)_"# EFT PAYMENT RECORDS: "_+$G(RCEFT("D")),.RCCT) . I '$G(RCNITE),($Y+5)>IOSL D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) Q:RCSTOP . D SETLINE(RCNITE,$J("",25)_"# EFT PAYMENTS MATCHED: "_+$G(RCMATCH("D")),.RCCT) . I '$G(RCNITE),($Y+5)>IOSL D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) Q:RCSTOP . D SETLINE(RCNITE,$J("",18)_"MATCHED PAYMENT AMOUNT POSTED: $"_$J(+$G(RCDEPAP(Z)),"",2),.RCCT) . D SETLINE(RCNITE,"",.RCCT) I '$O(^TMP("RCDAILYACT",$J,0)) D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) G:RCSTOP!RCNITE RPT1Q D SETLINE(RCNITE,"",.RCCT) I '$G(RCNITE),($Y+5)>IOSL D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) G:RCSTOP RPT1Q D SETLINE(RCNITE,$E("**** TOTALS FOR DATE RANGE:"_$J("",30),1,30)_" # OF DEPOSIT TICKETS RECEIVED: "_+$G(RCDEP)_$J("",5),.RCCT) D SETLINE(RCNITE,$J("",29)_"TOTAL AMOUNT OF DEPOSITS RECEIVED: $"_$J(+$G(RCDEPA),"",2),.RCCT) I '$G(RCNITE),($Y+5)>IOSL D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) G:RCSTOP RPT1Q D SETLINE(RCNITE,"",.RCCT) D SETLINE(RCNITE,$J("",20)_"DEPOSIT AMOUNTS SENT TO FMS:",.RCCT) I '$G(RCNITE),($Y+5)>IOSL D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) G:RCSTOP RPT1Q D SETLINE(RCNITE,$J("",39)_"ACCEPTED: $"_+$G(RCFMS("T",1)),.RCCT) I '$G(RCNITE),($Y+5)>IOSL D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) G:RCSTOP RPT1Q D SETLINE(RCNITE,$J("",41)_"QUEUED: $"_+$G(RCFMS("T",2)),.RCCT) I '$G(RCNITE),($Y+5)>IOSL D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) G:RCSTOP RPT1Q D SETLINE(RCNITE,$J("",35)_"ERROR/REJECT: $"_+$G(RCFMS("T",0)),.RCCT) I '$G(RCNITE),($Y+5)>IOSL D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) G:RCSTOP RPT1Q D SETLINE(RCNITE,$J("",37)_"NOT IN FMS: $"_$J(+$G(RCFMS("T",-1)),"",2),.RCCT) D SETLINE(RCNITE,"",.RCCT) I '$G(RCNITE),($Y+5)>IOSL D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) G:RCSTOP RPT1Q D SETLINE(RCNITE,$J("",26)_"# EFT PAYMENT RECORDS: "_+$G(RCEFT("T")),.RCCT) I '$G(RCNITE),($Y+5)>IOSL D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) G:RCSTOP RPT1Q D SETLINE(RCNITE,$J("",25)_"# EFT PAYMENTS MATCHED: "_+$G(RCMATCH("T")),.RCCT) I '$G(RCNITE),($Y+5)>IOSL D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) G:RCSTOP RPT1Q D SETLINE(RCNITE,$J("",18)_"MATCHED PAYMENT AMOUNT POSTED: $"_$J(+$G(RCDEPAP),"",2),.RCCT) D SETLINE(RCNITE,"",.RCCT) ; RPT1Q K ^TMP("RCDAILYACT",$J) Q ; ENQ(RCSTOP,RCPG) ; Clean up I '$D(ZTQUEUED) D ^%ZISC I 'RCSTOP,RCPG D ASK^RCDPEDA1() I $D(ZTQUEUED) S ZTREQ="@" Q ; SETLINE(RCNITE,Z,RCCT) ; Writes line ; RCNITE = 1 to set array, 0 to write line ; Z = txt to output ; RCCT = line counter S RCCT=RCCT+1 I $G(RCNITE) S ^TMP($J,"RCDPE_DAR",RCCT)=Z Q W !,Z Q ;