source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPEREC.m@ 1671

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

initial load of FOIAVistA 6/30/08 version
File size: 6.2 KB
Line 
1RCDPEREC ;ALB/TMK - RECONCILIATION REPORT FOR EDI LOCKBOX FMS DOCS ;19-APR-2004
2 ;;4.5;Accounts Receivable;**208,244**;Mar 20, 1995
3 ;
4EN ; Entrypoint for producing the report
5 N RCDDT,RCSEL,ZTRTN,ZTDESC,ZTSAVE,ZTSK,%ZIS,POP,DIR,DTOUT,DUOUT
6 S DIR(0)="DA^3000101:"_DT_":AEPX",DIR("A")="SELECT THE EFT DEPOSIT DATE TO START WITH: " W ! D ^DIR K DIR
7 S RCDDT=$S($D(DTOUT)!$D(DUOUT):"",1:Y)
8 Q:'RCDDT
9 S DIR("B")="ALL"
10 S DIR(0)="SA^A:ALL;N:NOT FULLY TRANSFERRED",DIR("A")="DO YOU WANT (A)LL DEPOSITS OR ONLY THOSE (N)OT FULLY TRANSFERRED?: " W ! D ^DIR K DIR
11 S RCSEL=$S($D(DTOUT)!$D(DUOUT):"",1:Y)
12 Q:RCSEL=""
13 W !
14 S %ZIS="QM" D ^%ZIS Q:POP
15 I $D(IO("Q")) D Q
16 . S ZTRTN="ENQUE^RCDPEREC",ZTDESC="AR - CR/TR RELATED DOCUMENTS FOR e-PAYMENTS"
17 . S ZTSAVE("RCDDT")="",ZTSAVE("RCSEL")=""
18 . D ^%ZTLOAD
19 . W !!,$S($D(ZTSK):"Your task number"_ZTSK_" has been queued.",1:"Unable to queue this job.")
20 . K ZTSK,IO("Q") D HOME^%ZIS
21 U IO
22 D ENQUE
23 Q
24 ;
25ENQUE ; Queued entrypoint for the report
26 ; RCDDT = starting EFT deposit date
27 ; RCSEL = 'A' if all deposits included ... 'N' if only those not fully
28 ; transferred out of 8NZZ
29 ;
30 N Z,Z0,RCSTOP,RCD,RCR,RCSTAT,RCDEP,RCEFT,RCEFT1,RCT,RC0,RC00,RC000,RCTOT,RCTOT1,RCTRANS
31 K ^TMP($J,"RCDEP")
32 ;
33 S (RCSTOP,RCT)=0,RCDDT=RCDDT-.1
34 F S RCDDT=$O(^RCY(344.3,"ADEP",RCDDT)) Q:'RCDDT!RCSTOP S RCDEP=0 F S RCDEP=$O(^RCY(344.3,"ADEP",RCDDT,RCDEP)) Q:'RCDEP S RCEFT=0 F S RCEFT=$O(^RCY(344.3,"ADEP",RCDDT,RCDEP,RCEFT)) Q:'RCEFT!RCSTOP D
35 . S RCTOT=0,RC0=$G(^RCY(344.3,RCEFT,0))
36 . S RCD=$E(RCDDT_$J("",8),1,8)_RCDEP
37 . S RCEFT1=0 F S RCEFT1=$O(^RCY(344.31,"B",RCEFT,RCEFT1)) Q:'RCEFT1!RCSTOP S RC00=$G(^RCY(344.31,RCEFT1,0)) D
38 .. ;
39 .. I $D(ZTQUEUED) S RCT=RCT+1 I '(RCT#100),$$S^%ZTLOAD S (RCSTOP,ZTSTOP)=1 K ZTREQ Q
40 .. ;
41 .. I '$D(^TMP($J,"RCDEP",RCD)) S ^TMP($J,"RCDEP",RCD)=$P(RC0,U,6,11),^TMP($J,"RCDEP",RCD,0)=$S($P(RC00,U,9):$$FMSSTAT^RCDPUREC($P(RC00,U,9)),1:"NO CR DOCUMENT"),^TMP($J,"RCDEP",RCD,"EFT")=RCEFT
42 .. S RCTRANS=+$P(RC00,U,14) S:'RCTRANS RCTRANS=1
43 .. ;
44 .. I '$P(RC00,U,8) S ^TMP($J,"RCDEP",RCD,RCTRANS,"RCUNM")=RCEFT1 Q ; Not matched
45 .. ;
46 .. I '$O(^RCY(344,"AEFT",RCEFT1,0)) D Q ; No receipt
47 ... I $P(RC00,U,16)'="" D Q ; EFT detail entered on-line
48 .... S ^TMP($J,"RCDEP",RCD,RCTRANS)=RCEFT1_U_"ENTERED ON-LINE"_U_$S($P(RC000,U,18):"ERA #"_$P($G(^RCY(344.4,+$P(RC00,U,10),0)),U),1:"PAPER EOB")_U_$P(RC00,U,16)_U_"NO RECEIPT",RCTOT=RCTOT+$P(RC00,U,7)
49 ... S ^TMP($J,"RCDEP",RCD,RCTRANS)=RCEFT1_U_"NO TR DOC"_U_$S($P(RC00,U,10):"ERA #"_$P($G(^RCY(344.4,+$P(RC00,U,10),0)),U),1:"PAPER EOB")_"^^NO RECEIPT"
50 .. ;
51 .. S RCR=0 F S RCR=$O(^RCY(344,"AEFT",RCEFT1,RCR)) Q:'RCR S RC000=$G(^RCY(344,RCR,0)) D
52 ... S RCTOT=RCTOT+$$PAYTOTAL^RCDPURED(RCR)
53 ... S RCSTAT=$$FMSSTAT^RCDPUREC(RCR) S:$P(RCSTAT,U)="" RCSTAT="NO TR DOC"
54 ... S ^TMP($J,"RCDEP",RCD,RCTRANS)=RCEFT1_U_$P(RCSTAT,U)_U_$S($P(RC000,U,18):"ERA #"_$P($G(^RCY(344.4,+$P(RC000,U,18),0)),U),1:"PAPER EOB")_U_$P(RCSTAT,U,2)_U_RCR
55 . Q:RCSTOP
56 . I RCSEL="N",+RCTOT=+$P(RC0,U,8) K ^TMP($J,"RCDEP",RCD) Q
57 . S ^TMP($J,"RCDEP",RCD,"TOT")=RCTOT_U_$P(RC0,U,8)
58 ;
59 ; Output the report
60 S RCD="",RCPG=0
61 I RCSTOP K ^TMP($J,"RCDEP")
62 F S RCD=$O(^TMP($J,"RCDEP",RCD)) Q:RCD=""!RCSTOP D Q:RCSTOP D TOT(RCD,.RCSTOP,.RCPG)
63 . S RC0=$G(^TMP($J,"RCDEP",RCD)) D EFTDEP(RCD,.RCSTOP,.RCPG) ; EFT dep
64 . Q:RCSTOP
65 . S RCTRANS=0 F S RCTRANS=$O(^TMP($J,"RCDEP",RCD,RCTRANS)) Q:'RCTRANS!RCSTOP S RC00=$G(^(RCTRANS)) D ; EFT detail deposits
66 .. S RCSTOP=$$NEWPG(.RCPG) Q:RCSTOP
67 .. I RC00="",$D(^TMP($J,"RCDEP",RCD,RCTRANS,"RCUNM")) S Z=$G(^("RCUNM")) D Q ; Unmatched
68 ... W !,?3,$J("",6)," UNMATCHED ",$E($P(Z,U,2)_$J("",30),1,30)_" "_$E($P(Z,U,3)_$J("",20),1,20)
69 ... W !,?13,$P(Z,U,4)
70 .. ;
71 .. I RC00="" W !,?3,"ERROR IN EFT DETAIL LINE #: ",RCTRANS Q ; Error
72 .. ;
73 .. S Z=$G(^RCY(344.31,+RC00,0))
74 .. W !,?3,$E(+RC00_$J("",6),1,6)_" "_$E($P(RC00,U,3)_$J("",10),1,10)_" "_$E($P(Z,U,2)_$J("",30),1,30)_" "_$E($P(Z,U,3)_$J("",20),1,20)
75 .. W !,?13,$E($P(Z,U,4)_$J("",30),1,30)_" "_$E($P(RC00,U,5)_$J("",10),1,10),!,?15,$E($P(RC00,U,2)_$J("",10),1,10)_" "_$E($P(RC00,U,4)_$J("",15),1,15)
76 ;
77 I 'RCSTOP,RCPG D ASK(.RCSTOP)
78 ;
79 I $D(ZTQUEUED) D
80 . I $G(RCSTOP) D HDR1(0) W !,"TASK STOPPED BY USER" Q
81 . S ZTREQ="@"
82 I '$D(ZTQUEUED) D ^%ZISC
83 K ^TMP($J,"RCDEP")
84 Q
85 ;
86EFTDEP(RCD,RCSTOP,RCPG) ;
87 ; RCD = deposit date (FM) concatenated with the deposit #
88 N Z,Z0
89 I $D(ZTQUEUED),$$S^%ZTLOAD S (RCSTOP,ZTSTOP)=1 K ZTREQ Q
90 S Z=$G(^TMP($J,"RCDEP",RCD)),Z0=$G(^(RCD,0))
91 S RCSTOP=$$NEWPG(.RCPG) Q:RCSTOP
92 I $Y+7>IOSL W !! S RCSTOP=$$NEWPG(.RCPG) Q:RCSTOP
93 W:'$P(RCPG,U,2) !!
94 W !,$E($$FMTE^XLFDT($P(Z,U,2),"2D")_$J("",8),1,8)," ",$E(+$G(^TMP($J,"RCDEP",RCD,"EFT"))_$J("",6),1,6)," ",$E($P(Z,U)_$J("",6),1,6)," ",$J($P(Z,U,3),13,2)," ",$E($S($P(Z,U,6):$$FMTE^XLFDT($P(Z,U,6),"2D"),1:"UNPOSTED")_$J("",8),1,8)
95 W !,?5,$E($P(Z0,U)_$J("",20),1,20)," ",$P(Z0,U,2)
96 Q
97 ;
98TOT(RCD,RCSTOP,RCPG) ; Output the total lines for the deposit
99 S RCSTOP=$$NEWPG(.RCPG) Q:RCSTOP
100 W !,$J("",26),"TOTAL AMOUNT SENT VIA 'TR' DOCUMENTS: ",$J($G(^TMP($J,"RCDEP",RCD,"TOT")),15,2)
101 W !,$J("",26),"TOTAL AMOUNT STILL TO BE TRANSFERRED: ",$J($P($G(^TMP($J,"RCDEP",RCD,"TOT")),U,2)-$G(^TMP($J,"RCD",RCD,"TOT")),15,2)
102 Q
103 ;
104NEWPG(RCPG) ; Check for new page needed, output header
105 ; Function returns 1 if user chooses to stop output
106 N RCX,RCZ
107 S RCZ=0,RCX=$P(RCPG,U,2)
108 I 'RCPG!(($Y+5)>IOSL) D
109 . D:RCPG ASK(.RCZ) I RCZ Q
110 . D HDR1(.RCPG)
111 I RCX S $P(RCPG,U,2)=0
112 Q RCZ
113 ;
114SELECT() ; Select first deposit #
115 ; Function returns values selected for first deposit #
116 ;
117 N DIR,X,Y,DTOUT,DUOUT
118 ;
119HDR1(RCPG) ;Print report hdr
120 ; RCPG = last page #^0/1 for top of page indicator
121 N Z,Z0,X
122 I RCPG!($E(IOST,1,2)="C-") W @IOF,*13
123 S RCPG=$G(RCPG)+1_U_1
124 W !,"EDI LOCKBOX FUND 5287.4/8NZZ RECONCILIATION REPORT",?55,$$FMTE^XLFDT(DT,2),?70,"Page: ",+RCPG
125 W !!,"DEP DATE ENTRY# DEP # TOTAL DEP AMT POST DT RECEIPT #",!,?5,"CR DOCUMENT CR DOC STATUS"
126 W !,?3,"EFT # MATCHED TO PAYER NAME PAYER ID ",!,?13,"TRACE # RECEIPT #"
127 W !,?15,"TR DOCUMENT TR DOC STATUS"
128 W !,$TR($J("",IOM)," ","=")
129 Q
130 ;
131ASK(RCSTOP) ;
132 I $E(IOST,1,2)'["C-" Q
133 N DIR,DIROUT,DIRUT,DTOUT,DUOUT
134 S DIR(0)="E" W ! D ^DIR
135 I ($D(DIRUT))!($D(DUOUT)) S RCSTOP=1 Q
136 Q
137 ;
Note: See TracBrowser for help on using the repository browser.