source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCRJRDEP.m@ 613

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

initial load of WorldVistAEHR
File size: 7.8 KB
Line 
1RCRJRDEP ;WISC/RFJ-Deposit Reconciliation Report ;1 Mar 98
2 ;;4.5;Accounts Receivable;**101,114,203,220**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 W !!,"This option will print the Deposit Reconciliation Report. The report will"
6 W !,"display the data on the code sheets sent to FMS on the CR document. Only"
7 W !,"deposits processed after patch PRCA*4.5*90 was installed can be displayed."
8 W !,"Select the starting and ending FMS Document Number without the station"
9 W !,"number, example: K8A0346."
10 ;
11 N DEFAULT,RCRJEND,RCRJFXIT,RCRJSTRT,RCRJSUMM,X
12 ;
13 F D Q:$G(RCRJFXIT)
14 . R !!,"START WITH CR DOCUMENT: FIRST// ",X:DTIME
15 . I X["^" S RCRJFXIT=2 Q
16 . I $L(X),$L(X)'=7 W !?5,"The CR DOCUMENT should be 7 characters in length (example: K8A0804)." Q
17 . S RCRJSTRT=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
18 . ;
19 . S DEFAULT=$S(RCRJSTRT="":" LAST",1:RCRJSTRT)
20 . W !," END WITH CR DOCUMENT: ",DEFAULT,"// " R X:DTIME
21 . I X["^" S RCRJFXIT=2 Q
22 . S RCRJEND=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
23 . I X="LAST" S (RCRJEND,X)="zzzzzzz"
24 . I $L(X),$L(X)'=7 W !?5,"The CR DOCUMENT should be 7 characters in length (example: K8A0804)." Q
25 . I X="" S RCRJEND=$S(DEFAULT=" LAST":"zzzzzzz",1:DEFAULT)
26 . I RCRJEND'=RCRJSTRT,RCRJEND']RCRJSTRT W !?5,"The END CR DOCUMENT should be after (in sequence) the start document." Q
27 . S RCRJFXIT=1
28 I RCRJFXIT=2 Q
29 ;
30 S RCRJSUMM=$$SUMMARY^RCRJRTRA I 'RCRJSUMM Q
31 ;
32 ; select device
33 W ! S %ZIS="Q" D ^%ZIS Q:POP
34 I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK Q
35 . S ZTDESC="Deposit Reconciliation Report",ZTRTN="DQ^RCRJRDEP"
36 . S ZTSAVE("RCRJ*")="",ZTSAVE("ZTREQ")="@"
37 W !!,"<*> please wait <*>"
38 ;
39DQ ; report (queue) starts here
40 N %,%H,%I,CHAMPVA,DA,DEPOSDA,DIQ2,DOCTOTAL,FMSDOCID,FUND,FUNDTOTL,GECSDATA,LINEDA,LINEDATA,NOW,PAGE,RCDATA,RCRJLAST,RCRJLINE,RCRJFLAG,RECEIPDA,RSC,RSCTOTL,SCREEN,SITE,TOTAL,X,Y
41 K ^TMP($J,"RCRJRDEP")
42 ;
43 ; build list of fms documents
44 S SITE=$$SITE^RCMSITE
45 S RCRJLAST="CR-"_SITE_RCRJEND_" "
46 ;
47 ; the fms document was previously stored in the deposit file 344.1
48 ; this code can be removed later on
49 ; this is the starting document, use 31 to start with select doc first
50 S FMSDOCID="CR-"_SITE_RCRJSTRT_$C(31)
51 F S FMSDOCID=$O(^RCY(344.1,"ADOC",FMSDOCID)) Q:FMSDOCID=""!(FMSDOCID]RCRJLAST) D
52 . S DEPOSDA=+$O(^RCY(344.1,"ADOC",FMSDOCID,0))
53 . ; compute deposit (all receipts) total for comparison
54 . S TOTAL=0,CHAMPVA=0
55 . S RECEIPDA=0 F S RECEIPDA=$O(^RCY(344,"AD",DEPOSDA,RECEIPDA)) Q:'RECEIPDA D
56 . . S DA=0 F S DA=$O(^RCY(344,RECEIPDA,1,DA)) Q:'DA S TOTAL=TOTAL+$P(^(DA,0),"^",5)
57 . . S CHAMPVA=CHAMPVA+$$CHAMPVA(RECEIPDA)
58 . ; tmp=deposit ^ depositda ^ depositdate ^ ^ ^ ^ deposittotal ^ champvatotal
59 . S ^TMP($J,"RCRJRDEP",FMSDOCID)=$P($G(^RCY(344.1,DEPOSDA,0)),"^")_"^"_DEPOSDA_"^"_$P($G(^RCY(344.1,DEPOSDA,0)),"^",9)_"^^^^"_TOTAL_"^"_CHAMPVA
60 ;
61 ; the fms document is now stored in the receipt file 344
62 S FMSDOCID="CR-"_SITE_RCRJSTRT_$C(31)
63 F S FMSDOCID=$O(^RCY(344,"ADOC",FMSDOCID)) Q:FMSDOCID=""!(FMSDOCID]RCRJLAST) D
64 . S RECEIPDA=+$O(^RCY(344,"ADOC",FMSDOCID,0))
65 . ; compute deposit (all receipts) total for comparison
66 . S TOTAL=0
67 . ; use the payment amount to pick up suspense deposits
68 . S DA=0 F S DA=$O(^RCY(344,RECEIPDA,1,DA)) Q:'DA S TOTAL=TOTAL+$P(^(DA,0),"^",4)
69 . S CHAMPVA=$$CHAMPVA(RECEIPDA)
70 . S DEPOSDA=+$P($G(^RCY(344,RECEIPDA,0)),"^",6)
71 . ; tmp=deposit ^ depositda ^ depositdate ^ receipt ^receiptda ^ receipt date ^ receipttotal ^ champvatotal
72 . S ^TMP($J,"RCRJRDEP",FMSDOCID)=$P($G(^RCY(344.1,DEPOSDA,0)),"^")_"^"_DEPOSDA_"^"_$P($G(^RCY(344.1,DEPOSDA,0)),"^",11)_"^"_$P($G(^RCY(344,RECEIPDA,0)),"^")_"^"_RECEIPDA_"^"_$P($G(^RCY(344,RECEIPDA,0)),"^",8)_"^"_TOTAL_"^"_CHAMPVA
73 ;
74 ; print report
75 S SCREEN=0 I '$D(ZTQUEUED),IO=IO(0),$E(IOST)="C" S SCREEN=1
76 S RCRJLINE="",$P(RCRJLINE,"-",81)=""
77 D NOW^%DTC S Y=% D DD^%DT S NOW=Y,PAGE=1
78 U IO I $G(RCRJSUMM)'=1 D H
79 ;
80 S FMSDOCID="" F S FMSDOCID=$O(^TMP($J,"RCRJRDEP",FMSDOCID)) Q:FMSDOCID=""!($G(RCRJFLAG)) D
81 . S RCDATA=^TMP($J,"RCRJRDEP",FMSDOCID)
82 . K GECSDATA
83 . D DATA^GECSSGET(FMSDOCID,1)
84 . I $G(RCRJSUMM)'=1 D Q:$G(RCRJFLAG)
85 . . I $Y>(IOSL-7) D:SCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H
86 . . S Y=$P($P(RCDATA,"^",3),".") I Y D DD^%DT
87 . . W !,"FMS DOCUMENT: ",FMSDOCID,?34,"DEPOSIT TICKET: ",$P(RCDATA,"^"),?62,"DATE: ",Y
88 . . I $P(RCDATA,"^",4)'="" W !?41,"RECEIPT: ",$P(RCDATA,"^",4) S Y=$P($P(RCDATA,"^",6),".") I Y D DD^%DT W ?62,"DATE: ",Y
89 . . D H1
90 . S DOCTOTAL=0
91 . I $D(GECSDATA) S LINEDA=0 F S LINEDA=$O(GECSDATA(2100.1,GECSDATA,10,LINEDA)) Q:'LINEDA!($G(RCRJFLAG)) D
92 . . S LINEDATA=GECSDATA(2100.1,GECSDATA,10,LINEDA)
93 . . I $E(LINEDATA,1,4)="CR2^" S DOCTOTAL=$P(LINEDATA,"^",15)
94 . . I $E(LINEDATA,1,9)'="LIN^~CRA^" Q
95 . . I $G(RCRJSUMM)'=1 D
96 . . . I $Y>(IOSL-4) D:SCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H,H1
97 . . . W !?1,$P(LINEDATA,"^",3),?6,$P(LINEDATA,"^",4),?11,$P(LINEDATA,"^",6),?19,$P(LINEDATA,"^",10)
98 . . . W ?30,$J($P(LINEDATA,"^",18),8),?40,$E($P(LINEDATA,"^",25),4,10),?50,$J($P(LINEDATA,"^",20),10,2),?64,$J($P(LINEDATA,"^",23),9)
99 . . ; totals by fund
100 . . S FUND=$P(LINEDATA,"^",6)
101 . . I FUND="" S FUND="0160"
102 . . S FUNDTOTL(FUND)=$G(FUNDTOTL(FUND))+$P(LINEDATA,"^",20)
103 . . ; totals by rsc for the accrued 5287 funds (01,03,04,09)
104 . . S RSC=$P(LINEDATA,"^",10)
105 . . I RSC'="",($$PTACCT^PRCAACC(FUND)!(FUND=4032)) S RSCTOTL(RSC)=$G(RSCTOTL(RSC))+$P(LINEDATA,"^",20)
106 . I $G(RCRJSUMM)=1 Q
107 . I $G(RCRJFLAG) Q
108 . I $Y>(IOSL-6) D:SCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H
109 . W !?23,"LINE TOTAL/DOCUMENT TOTAL: ",$J(DOCTOTAL,10,2)
110 . ; compute receipt total for comparison
111 . S TOTAL=$P(RCDATA,"^",7)
112 . S CHAMPVA=$P(RCDATA,"^",8)
113 . I CHAMPVA W !?35,"CHAMPVA TOTAL: ",$J(CHAMPVA,10,2)
114 . W !?35,"DEPOSIT TOTAL: ",$J(TOTAL,10,2)
115 . I (DOCTOTAL+CHAMPVA)'=TOTAL W !," WARNING: TOTALS DO NOT MATCH, CHECK THE DEPOSIT: **********"
116 . W !
117 ;
118 I $G(RCRJFLAG) D Q Q
119 I $G(RCRJSUMM)'=1 D:SCREEN PAUSE^RCRJRTR1 I $G(RCRJFLAG) D Q Q
120 D H
121 ; print totals by fund/rsc
122 W !!,"TOTAL DEPOSITS BY FUND:"
123 S FUND="" F S FUND=$O(FUNDTOTL(FUND)) Q:FUND=""!($G(RCRJFLAG)) D
124 . I $Y>(IOSL-4) D:SCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H W !!,"TOTAL DEPOSITS BY FUND:"
125 . W !?5,"FUND: ",FUND,?20,$J(FUNDTOTL(FUND),10,2)
126 I $G(RCRJFLAG) D Q Q
127 I DT<$$ADDPTEDT^PRCAACC() W !!,"TOTAL DEPOSITS BY REVENUE SOURCE CODE FOR THE SERIES OF FUNDS 5287.1,5287.3,5287.4:"
128 I DT'<$$ADDPTEDT^PRCAACC() W !!,"TOTAL DEPOSITS BY REVENUE SOURCE CODE FOR THE SERIES OF FUNDS 528701,528703,528704:"
129 S RSC="" F S RSC=$O(RSCTOTL(RSC)) Q:RSC="" D Q:$G(RCRJFLAG)
130 . I $Y>(IOSL-4) D:SCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H W !!,"TOTAL DEPOSITS BY REVENUE SOURCE CODE FOR THE SERIES OF ACCRUED 5287 FUNDS "_$S(DT<$$ADDPTEDT^PRCAACC():"(.1,.3,.4,.9):",1:"(01,03,04,09):")
131 . W !?5,"RSC: ",RSC,?17,$$GETDESC^RCXFMSPR(RSC),?70,$J(RSCTOTL(RSC),10,2)
132 I $G(RCRJFLAG) D Q Q
133 I SCREEN R !,"Press RETURN to continue:",X:DTIME
134 ;
135Q D ^%ZISC
136 K ^TMP($J,"RCRJRDEP")
137 Q
138 ;
139 ;
140H ; report heading
141 I PAGE'=1!(SCREEN) W @IOF
142 S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1
143 W $C(13),"DEPOSIT RECONCILIATION REPORT",?(80-$L(%)),%
144 W !," START WITH DEPOSIT: ",$S(RCRJSTRT="":"**FIRST**",1:RCRJSTRT)," END WITH DEPOSIT: ",$S(RCRJEND="zzzzzzz":"**LAST**",1:RCRJEND),?65,$J("TYPE: "_$S(RCRJSUMM=1:"SUMMARY",1:"DETAILED"),15)
145 W !,RCRJLINE
146 Q
147 ;
148 ;
149H1 ; print line heading
150 W !,"LINE",?5,"BFY",?11,"FUND",?20,"RSC",?30,"PROVIDER",?43,"BILL",?54,"AMOUNT",?64,"TRAN TYPE"
151 Q
152 ;
153 ;
154CHAMPVA(RECEIPDA) ; return dollars for champva
155 N %,CATEGORY,RECEIPT,TOTAL,TRAN3,TRANDA
156 S RECEIPT=$P($G(^RCY(344,RECEIPDA,0)),"^")
157 I RECEIPT="" Q 0
158 ;
159 S TOTAL=0
160 S TRANDA=0 F S TRANDA=$O(^PRCA(433,"AF",RECEIPT,TRANDA)) Q:'TRANDA D
161 . S CATEGORY=$P($G(^PRCA(430,+$P($G(^PRCA(433,TRANDA,0)),"^",2),0)),"^",2)
162 . I CATEGORY'=29 Q
163 . S TRAN3=$G(^PRCA(433,TRANDA,3))
164 . F %=1:1:5 S TOTAL=TOTAL+$P(TRAN3,"^",%)
165 Q TOTAL
Note: See TracBrowser for help on using the repository browser.