source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPEDAR.m@ 841

Last change on this file since 841 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 9.5 KB
Line 
1RCDPEDAR ;ALB/TMK - ACTIVITY REPORT ;04-NOV-02
2 ;;4.5;Accounts Receivable;**173**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6RPT ; Daily Activity Rpt On Demand
7 N DUOUT,DTOUT,DIR,X,Y,RCDT1,RCDT2,RCDET,ZTRTN,ZTSK,ZTDESC,%ZIS,POP
8 S DIR("A")="(S)UMMARY OR (D)ETAIL?: ",DIR(0)="SA^S:SUMMARY TOTALS ONLY;D:DETAIL AND TOTALS"
9 S DIR("B")="D" D ^DIR K DIR
10 I $D(DTOUT)!$D(DUOUT)!(Y="") G RPTQ
11 S RCDET=(Y="D")
12 S DIR("?")="ENTER THE EARLIEST DATE OF RECEIPT OF DEPOSIT TO INCLUDE ON THE REPORT"
13 S DIR(0)="DAO^:"_DT_":APE",DIR("A")="START DATE: " D ^DIR K DIR
14 I $D(DTOUT)!$D(DUOUT)!(Y="") G RPTQ
15 S RCDT1=Y
16 S DIR("?")="ENTER THE LATEST DATE OF RECEIPT OF DEPOSIT TO INCLUDE ON THE REPORT"
17 S DIR("B")=Y(0)
18 S DIR(0)="DAO^"_RCDT1_":"_DT_":APE",DIR("A")="END DATE: " D ^DIR K DIR
19 I $D(DTOUT)!$D(DUOUT)!(Y="") G RPTQ
20 S RCDT2=Y
21 ; Ask device
22 S %ZIS="QM" D ^%ZIS G:POP RPTQ
23 I $D(IO("Q")) D G RPTQ
24 . S ZTRTN="EN^RCDPEDAR("_RCDET_","_RCDT1_","_RCDT2_")",ZTDESC="AR - EDI LOCKBOX DAILY ACTIVITY REPORT"
25 . D ^%ZTLOAD
26 . W !!,$S($D(ZTSK):"Your task number "_ZTSK_" has been queued.",1:"Unable to queue this job.")
27 . K ZTSK,IO("Q") D HOME^%ZIS
28 U IO
29 D EN(RCDET,RCDT1,RCDT2)
30RPTQ Q
31 ;
32EN(RCDET,RCDT1,RCDT2) ; Entry point for queued job
33 ; RCDET = 1 to include detail, 0 for totals only
34 ; RCDT1,RCDT2 = date from,to
35 N Z,Z0,RC,RCT,DATA,RCSTOP,RCPG
36 K ^TMP("RCDAILYACT",$J)
37 S Z=RCDT1-.0001,(RCSTOP,RCT)=0
38 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
39 . 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
40 . S ^TMP("RCDAILYACT",$J,Z\1,Z0)=DATA
41 D:'RCSTOP RPT1(0,RCDET,RCDT1,RCDT2,.RCSTOP,.RCPG)
42 D ENQ(RCSTOP,$G(RCPG))
43 Q
44 ;
45RPT1(RCNITE,RCDET,RCDT1,RCDT2,RCSTOP,RCPG) ; Entrypoint for nightly job
46 ; RCNITE = 1 if called from nightly job, 0 if called from on demand
47 ; RCDET = 1 to include detail, 0 for totals only
48 ; RCDT1,RCDT2 = date from,to
49 ; RCSTOP = returned = 1 if user elected to quit job
50 ; RCPG = the last page # printed, returned if passed by reference
51 ;
52 N X,Q,Q0,Z,Z0,Z1,Z2,Z3,ZCT,RCCT,RCDEP,RCDEPA,RCDEPAP,RCFMS,RCFMS1,RCD1,RCFMSTOT,RCEFT,RCMATCH,RCDEPREC,RCDT
53 S (RCSTOP,RCPG,ZCT,RCCT,RCDEP,RCDEPA,RCDEPAP,RCDEPREC,Z)=0,RCD1=1
54 S RCNITE=+$G(RCNITE)
55 F S Z=$O(^TMP("RCDAILYACT",$J,Z)) Q:'Z D G:RCSTOP RPT1Q ; Z = date
56 . 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
57 . S Q="DATE EFT DEPOSIT RECEIVED: "_$$FMTE^XLFDT(Z,2),Q=$J("",80-$L(Q)\2)_Q ; Center it
58 . I 'RCD1,$G(RCDET) D SETLINE(RCNITE,"",.RCCT) ; Skip line if >1 dt on pg
59 . S RCDT=0
60 . I '$G(RCNITE),($Y+5)>IOSL D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) Q:RCSTOP
61 . I $G(RCDET) D
62 .. D SETLINE(RCNITE,Q,.RCCT)
63 .. D SETLINE(RCNITE,"",.RCCT)
64 . ; Z0 = ien of entry in file 344.3
65 . K RCEFT("D"),RCMATCH("D"),RCFMS("D")
66 . S Z0=0 F S Z0=$O(^TMP("RCDAILYACT",$J,Z,Z0)) Q:'Z0 D Q:RCSTOP
67 .. S Z1=$G(^TMP("RCDAILYACT",$J,Z,Z0))
68 .. 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)
69 .. I $P($G(^RCY(344,RCDEPREC,2)),U)="" S RCFMS("D",-1)=$G(RCFMS("D",-1))+$P(Z1,U,8),RCFMS="NO FMS DOC"
70 .. I $P($G(^RCY(344,RCDEPREC,2)),U)'="" D
71 ... S X=$$STATUS^GECSSGET($P(^RCY(344,RCDEPREC,2),U))
72 ... I X=-1 S RCFMS("D",-1)=$G(RCFMS("D",-1))+$P(Z1,U,8) Q
73 ... 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)
74 ... ;
75 .. I $G(RCDET) D Q:RCSTOP
76 ... S X=$$SETSTR^VALM1($P(Z1,U,6),"",1,6)
77 ... S X=$$SETSTR^VALM1($$FMTE^XLFDT($P(Z1,U,7)\1,2),X,9,10)
78 ... S X=$$SETSTR^VALM1("",X,21,10)
79 ... S X=$$SETSTR^VALM1("",X,32,10)
80 ... S X=$$SETSTR^VALM1($E($J($P(Z1,U,8),"",2)_$J("",20),1,20)_RCFMS,X,43,37)
81 ... I '$G(RCNITE),($Y+5)>IOSL D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) Q:RCSTOP
82 ... D SETLINE(RCNITE,X,.RCCT)
83 .. S RCFMSTOT=0,RCFMS1="NO FMS DOC"
84 .. I $O(^RCY(344.3,Z0,2,0)) D Q:RCSTOP
85 ... N V
86 ... I '$G(RCNITE),($Y+5)>IOSL D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) Q:RCSTOP
87 ... D SETLINE(RCNITE,$J("",10)_"ERROR MESSAGES FOR EFT:",.RCCT)
88 ... S V=0 F S V=$O(^RCY(344.3,Z0,2,V)) Q:'V D Q:RCSTOP
89 .... I '$G(RCNITE),($Y+5)>IOSL D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) Q:RCSTOP
90 .... D SETLINE(RCNITE,$J("",12)_$G(^RCY(344.3,Z0,2,V,0)),.RCCT)
91 .. 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
92 ... S RCEFT("D")=$G(RCEFT("D"))+1
93 ... 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:"")
94 ... 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")
95 ... S RCFMS1(Z2)=$S(X="":"",X=-1:"NO FMS DOC",1:$E($P(X," "),1,10))
96 ... I $P(Z3,U,8) S RCMATCH("D")=$G(RCMATCH("D"))+1
97 ... ;
98 ... I $G(RCDET) D EFTDET^RCDPEDA1(Z2,Z3,.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,.RCFMS1,RCNITE) Q:RCSTOP
99 .. ;
100 .. Q:RCSTOP
101 .. I RCDET D SETLINE(RCNITE,"",.RCCT)
102 . ;
103 . Q:RCSTOP
104 . 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"))
105 . F Q=-1,0,1,2 S RCFMS("T",Q)=$G(RCFMS("T",Q))+$G(RCFMS("D",Q))
106 . D SETLINE(RCNITE,"",.RCCT)
107 . I $S('$G(RCNITE):($Y+5)>IOSL,1:0)!'RCPG D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) Q:RCSTOP
108 . 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)
109 . D SETLINE(RCNITE,$J("",29)_"TOTAL AMOUNT OF DEPOSITS RECEIVED: $"_$J(+$G(RCDEPA(Z)),"",2),.RCCT)
110 . I '$G(RCNITE),($Y+5)>IOSL D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) Q:RCSTOP
111 . D SETLINE(RCNITE,"",.RCCT)
112 . D SETLINE(RCNITE,$J("",20)_"DEPOSIT AMOUNTS SENT TO FMS:",.RCCT)
113 . I '$G(RCNITE),($Y+5)>IOSL D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) Q:RCSTOP
114 . D SETLINE(RCNITE,$J("",39)_"ACCEPTED: $"_$J(+$G(RCFMS("D",1)),"",2),.RCCT)
115 . I '$G(RCNITE),($Y+5)>IOSL D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) Q:RCSTOP
116 . D SETLINE(RCNITE,$J("",41)_"QUEUED: $"_$J(+$G(RCFMS("D",2)),"",2),.RCCT)
117 . I '$G(RCNITE),($Y+5)>IOSL D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) Q:RCSTOP
118 . D SETLINE(RCNITE,$J("",35)_"ERROR/REJECT: $"_$J(+$G(RCFMS("D",0)),"",2),.RCCT)
119 . I '$G(RCNITE),($Y+5)>IOSL D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) Q:RCSTOP
120 . D SETLINE(RCNITE,$J("",37)_"NOT IN FMS: $"_$J(+$G(RCFMS("D",-1)),"",2),.RCCT)
121 . D SETLINE(RCNITE,"",.RCCT)
122 . I '$G(RCNITE),($Y+5)>IOSL D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) Q:RCSTOP
123 . D SETLINE(RCNITE,$J("",26)_"# EFT PAYMENT RECORDS: "_+$G(RCEFT("D")),.RCCT)
124 . I '$G(RCNITE),($Y+5)>IOSL D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) Q:RCSTOP
125 . D SETLINE(RCNITE,$J("",25)_"# EFT PAYMENTS MATCHED: "_+$G(RCMATCH("D")),.RCCT)
126 . I '$G(RCNITE),($Y+5)>IOSL D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) Q:RCSTOP
127 . D SETLINE(RCNITE,$J("",18)_"MATCHED PAYMENT AMOUNT POSTED: $"_$J(+$G(RCDEPAP(Z)),"",2),.RCCT)
128 . D SETLINE(RCNITE,"",.RCCT)
129 I '$O(^TMP("RCDAILYACT",$J,0)) D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE)
130 G:RCSTOP!RCNITE RPT1Q
131 D SETLINE(RCNITE,"",.RCCT)
132 I '$G(RCNITE),($Y+5)>IOSL D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) G:RCSTOP RPT1Q
133 D SETLINE(RCNITE,$E("**** TOTALS FOR DATE RANGE:"_$J("",30),1,30)_" # OF DEPOSIT TICKETS RECEIVED: "_+$G(RCDEP)_$J("",5),.RCCT)
134 D SETLINE(RCNITE,$J("",29)_"TOTAL AMOUNT OF DEPOSITS RECEIVED: $"_$J(+$G(RCDEPA),"",2),.RCCT)
135 I '$G(RCNITE),($Y+5)>IOSL D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) G:RCSTOP RPT1Q
136 D SETLINE(RCNITE,"",.RCCT)
137 D SETLINE(RCNITE,$J("",20)_"DEPOSIT AMOUNTS SENT TO FMS:",.RCCT)
138 I '$G(RCNITE),($Y+5)>IOSL D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) G:RCSTOP RPT1Q
139 D SETLINE(RCNITE,$J("",39)_"ACCEPTED: $"_+$G(RCFMS("T",1)),.RCCT)
140 I '$G(RCNITE),($Y+5)>IOSL D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) G:RCSTOP RPT1Q
141 D SETLINE(RCNITE,$J("",41)_"QUEUED: $"_+$G(RCFMS("T",2)),.RCCT)
142 I '$G(RCNITE),($Y+5)>IOSL D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) G:RCSTOP RPT1Q
143 D SETLINE(RCNITE,$J("",35)_"ERROR/REJECT: $"_+$G(RCFMS("T",0)),.RCCT)
144 I '$G(RCNITE),($Y+5)>IOSL D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) G:RCSTOP RPT1Q
145 D SETLINE(RCNITE,$J("",37)_"NOT IN FMS: $"_$J(+$G(RCFMS("T",-1)),"",2),.RCCT)
146 D SETLINE(RCNITE,"",.RCCT)
147 I '$G(RCNITE),($Y+5)>IOSL D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) G:RCSTOP RPT1Q
148 D SETLINE(RCNITE,$J("",26)_"# EFT PAYMENT RECORDS: "_+$G(RCEFT("T")),.RCCT)
149 I '$G(RCNITE),($Y+5)>IOSL D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) G:RCSTOP RPT1Q
150 D SETLINE(RCNITE,$J("",25)_"# EFT PAYMENTS MATCHED: "_+$G(RCMATCH("T")),.RCCT)
151 I '$G(RCNITE),($Y+5)>IOSL D HDR^RCDPEDA1(.RCCT,.RCPG,.RCSTOP,RCDT1,RCDT2,RCDET,RCNITE) G:RCSTOP RPT1Q
152 D SETLINE(RCNITE,$J("",18)_"MATCHED PAYMENT AMOUNT POSTED: $"_$J(+$G(RCDEPAP),"",2),.RCCT)
153 D SETLINE(RCNITE,"",.RCCT)
154 ;
155RPT1Q K ^TMP("RCDAILYACT",$J)
156 Q
157 ;
158ENQ(RCSTOP,RCPG) ; Clean up
159 I '$D(ZTQUEUED) D ^%ZISC I 'RCSTOP,RCPG D ASK^RCDPEDA1()
160 I $D(ZTQUEUED) S ZTREQ="@"
161 Q
162 ;
163SETLINE(RCNITE,Z,RCCT) ; Writes line
164 ; RCNITE = 1 to set array, 0 to write line
165 ; Z = txt to output
166 ; RCCT = line counter
167 S RCCT=RCCT+1
168 I $G(RCNITE) S ^TMP($J,"RCDPE_DAR",RCCT)=Z Q
169 W !,Z
170 Q
171 ;
Note: See TracBrowser for help on using the repository browser.