172 lines
9.5 KiB
Mathematica
172 lines
9.5 KiB
Mathematica
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
|
|
;
|