Produced by Araxis Merge on 2/13/2017 11:55:29 AM Eastern Standard Time. See www.araxis.com for information about Merge. This report uses XHTML and CSS2, and is best viewed with a modern standards-compliant browser. For optimum results when printing this report, use landscape orientation and enable printing of background images and colours in your browser.
# | Location | File | Last Modified |
---|---|---|---|
1 | CPAC.zip\Cpac billing patches.zip | PRCA_4_5_310_TEST_V1.KID | Tue Jan 31 16:09:16 2017 UTC |
2 | CPAC.zip\Cpac billing patches.zip | PRCA_4_5_310_TEST_V1.KID | Mon Feb 13 15:51:22 2017 UTC |
Description | Between Files 1 and 2 |
|
---|---|---|
Text Blocks | Lines | |
Unchanged | 2 | 7646 |
Changed | 1 | 3 |
Inserted | 0 | 0 |
Removed | 0 | 0 |
Whitespace | |
---|---|
Character case | Differences in character case are significant |
Line endings | Differences in line endings (CR and LF characters) are ignored |
CR/LF characters | Not shown in the comparison detail |
No regular expressions were active.
1 | PRCA*4.5*3 10 TEST v1 4 | ||||
2 | Extracted from mail message | ||||
3 | **KIDS**:P RCA*4.5*31 0^ | ||||
4 | |||||
5 | **INSTALL NAME** | ||||
6 | PRCA*4.5*3 10 | ||||
7 | "BLD",9717 ,0) | ||||
8 | PRCA*4.5*3 10^ACCOUNT S RECEIVAB LE^0^31609 29^y | ||||
9 | "BLD",9717 ,4,0) | ||||
10 | ^9.64PA^^ | ||||
11 | "BLD",9717 ,6.3) | ||||
12 | 14 | ||||
13 | "BLD",9717 ,"ABPKG") | ||||
14 | n | ||||
15 | "BLD",9717 ,"INIT") | ||||
16 | POSTINIT^P RCAP310 | ||||
17 | "BLD",9717 ,"KRN",0) | ||||
18 | ^9.67PA^77 9.2^20 | ||||
19 | "BLD",9717 ,"KRN",.4, 0) | ||||
20 | .4 | ||||
21 | "BLD",9717 ,"KRN",.40 1,0) | ||||
22 | .401 | ||||
23 | "BLD",9717 ,"KRN",.40 2,0) | ||||
24 | .402 | ||||
25 | "BLD",9717 ,"KRN",.40 3,0) | ||||
26 | .403 | ||||
27 | "BLD",9717 ,"KRN",.5, 0) | ||||
28 | .5 | ||||
29 | "BLD",9717 ,"KRN",.84 ,0) | ||||
30 | .84 | ||||
31 | "BLD",9717 ,"KRN",3.6 ,0) | ||||
32 | 3.6 | ||||
33 | "BLD",9717 ,"KRN",3.8 ,0) | ||||
34 | 3.8 | ||||
35 | "BLD",9717 ,"KRN",9.2 ,0) | ||||
36 | 9.2 | ||||
37 | "BLD",9717 ,"KRN",9.8 ,0) | ||||
38 | 9.8 | ||||
39 | "BLD",9717 ,"KRN",9.8 ,"NM",0) | ||||
40 | ^9.68A^10^ 10 | ||||
41 | "BLD",9717 ,"KRN",9.8 ,"NM",1,0) | ||||
42 | RCXFMSPR^^ 0^B2761357 9 | ||||
43 | "BLD",9717 ,"KRN",9.8 ,"NM",2,0) | ||||
44 | PRCAACC^^0 ^B8690733 | ||||
45 | "BLD",9717 ,"KRN",9.8 ,"NM",3,0) | ||||
46 | RCRJRBD^^0 ^B74247917 | ||||
47 | "BLD",9717 ,"KRN",9.8 ,"NM",4,0) | ||||
48 | RCRJRDEP^^ 0^B6433768 4 | ||||
49 | "BLD",9717 ,"KRN",9.8 ,"NM",5,0) | ||||
50 | RCXFMSUF^^ 0^B3745070 0 | ||||
51 | "BLD",9717 ,"KRN",9.8 ,"NM",6,0) | ||||
52 | RCXFMSUR^^ 0^B6095086 3 | ||||
53 | "BLD",9717 ,"KRN",9.8 ,"NM",7,0) | ||||
54 | RCTRAN1^^0 ^B8197752 | ||||
55 | "BLD",9717 ,"KRN",9.8 ,"NM",8,0) | ||||
56 | RCRJRBDT^^ 0^B5791773 6 | ||||
57 | "BLD",9717 ,"KRN",9.8 ,"NM",9,0) | ||||
58 | PRCABJV^^0 ^B30343584 | ||||
59 | "BLD",9717 ,"KRN",9.8 ,"NM",10,0 ) | ||||
60 | RCRJRBDR^^ 0^B7628086 7 | ||||
61 | "BLD",9717 ,"KRN",9.8 ,"NM","B", "PRCAACC", 2) | ||||
62 | |||||
63 | "BLD",9717 ,"KRN",9.8 ,"NM","B", "PRCABJV", 9) | ||||
64 | |||||
65 | "BLD",9717 ,"KRN",9.8 ,"NM","B", "RCRJRBD", 3) | ||||
66 | |||||
67 | "BLD",9717 ,"KRN",9.8 ,"NM","B", "RCRJRBDR" ,10) | ||||
68 | |||||
69 | "BLD",9717 ,"KRN",9.8 ,"NM","B", "RCRJRBDT" ,8) | ||||
70 | |||||
71 | "BLD",9717 ,"KRN",9.8 ,"NM","B", "RCRJRDEP" ,4) | ||||
72 | |||||
73 | "BLD",9717 ,"KRN",9.8 ,"NM","B", "RCTRAN1", 7) | ||||
74 | |||||
75 | "BLD",9717 ,"KRN",9.8 ,"NM","B", "RCXFMSPR" ,1) | ||||
76 | |||||
77 | "BLD",9717 ,"KRN",9.8 ,"NM","B", "RCXFMSUF" ,5) | ||||
78 | |||||
79 | "BLD",9717 ,"KRN",9.8 ,"NM","B", "RCXFMSUR" ,6) | ||||
80 | |||||
81 | "BLD",9717 ,"KRN",19, 0) | ||||
82 | 19 | ||||
83 | "BLD",9717 ,"KRN",19, "NM",0) | ||||
84 | ^9.68A^^ | ||||
85 | "BLD",9717 ,"KRN",19. 1,0) | ||||
86 | 19.1 | ||||
87 | "BLD",9717 ,"KRN",101 ,0) | ||||
88 | 101 | ||||
89 | "BLD",9717 ,"KRN",409 .61,0) | ||||
90 | 409.61 | ||||
91 | "BLD",9717 ,"KRN",771 ,0) | ||||
92 | 771 | ||||
93 | "BLD",9717 ,"KRN",779 .2,0) | ||||
94 | 779.2 | ||||
95 | "BLD",9717 ,"KRN",870 ,0) | ||||
96 | 870 | ||||
97 | "BLD",9717 ,"KRN",898 9.51,0) | ||||
98 | 8989.51 | ||||
99 | "BLD",9717 ,"KRN",898 9.52,0) | ||||
100 | 8989.52 | ||||
101 | "BLD",9717 ,"KRN",899 4,0) | ||||
102 | 8994 | ||||
103 | "BLD",9717 ,"KRN","B" ,.4,.4) | ||||
104 | |||||
105 | "BLD",9717 ,"KRN","B" ,.401,.401 ) | ||||
106 | |||||
107 | "BLD",9717 ,"KRN","B" ,.402,.402 ) | ||||
108 | |||||
109 | "BLD",9717 ,"KRN","B" ,.403,.403 ) | ||||
110 | |||||
111 | "BLD",9717 ,"KRN","B" ,.5,.5) | ||||
112 | |||||
113 | "BLD",9717 ,"KRN","B" ,.84,.84) | ||||
114 | |||||
115 | "BLD",9717 ,"KRN","B" ,3.6,3.6) | ||||
116 | |||||
117 | "BLD",9717 ,"KRN","B" ,3.8,3.8) | ||||
118 | |||||
119 | "BLD",9717 ,"KRN","B" ,9.2,9.2) | ||||
120 | |||||
121 | "BLD",9717 ,"KRN","B" ,9.8,9.8) | ||||
122 | |||||
123 | "BLD",9717 ,"KRN","B" ,19,19) | ||||
124 | |||||
125 | "BLD",9717 ,"KRN","B" ,19.1,19.1 ) | ||||
126 | |||||
127 | "BLD",9717 ,"KRN","B" ,101,101) | ||||
128 | |||||
129 | "BLD",9717 ,"KRN","B" ,409.61,40 9.61) | ||||
130 | |||||
131 | "BLD",9717 ,"KRN","B" ,771,771) | ||||
132 | |||||
133 | "BLD",9717 ,"KRN","B" ,779.2,779 .2) | ||||
134 | |||||
135 | "BLD",9717 ,"KRN","B" ,870,870) | ||||
136 | |||||
137 | "BLD",9717 ,"KRN","B" ,8989.51,8 989.51) | ||||
138 | |||||
139 | "BLD",9717 ,"KRN","B" ,8989.52,8 989.52) | ||||
140 | |||||
141 | "BLD",9717 ,"KRN","B" ,8994,8994 ) | ||||
142 | |||||
143 | "BLD",9717 ,"QDEF") | ||||
144 | ^^^^^^^^^^ YES | ||||
145 | "BLD",9717 ,"QUES",0) | ||||
146 | ^9.62^^ | ||||
147 | "BLD",9717 ,"REQB",0) | ||||
148 | ^9.611^3^3 | ||||
149 | "BLD",9717 ,"REQB",1, 0) | ||||
150 | PRCA*4.5*2 73^1 | ||||
151 | "BLD",9717 ,"REQB",2, 0) | ||||
152 | PRCA*4.5*2 82^1 | ||||
153 | "BLD",9717 ,"REQB",3, 0) | ||||
154 | PRCA*4.5*1 04^1 | ||||
155 | "BLD",9717 ,"REQB","B ","PRCA*4. 5*104",3) | ||||
156 | |||||
157 | "BLD",9717 ,"REQB","B ","PRCA*4. 5*273",1) | ||||
158 | |||||
159 | "BLD",9717 ,"REQB","B ","PRCA*4. 5*282",2) | ||||
160 | |||||
161 | "INIT") | ||||
162 | POSTINIT^P RCAP310 | ||||
163 | "MBREQ") | ||||
164 | 0 | ||||
165 | "PKG",142, -1) | ||||
166 | 1^1 | ||||
167 | "PKG",142, 0) | ||||
168 | ACCOUNTS R ECEIVABLE^ PRCA^BILL COLLECTION S | ||||
169 | "PKG",142, 20,0) | ||||
170 | ^9.402P^1^ 1 | ||||
171 | "PKG",142, 20,1,0) | ||||
172 | 2^^PRCAMRG | ||||
173 | "PKG",142, 20,1,1) | ||||
174 | |||||
175 | "PKG",142, 20,"B",2,1 ) | ||||
176 | |||||
177 | "PKG",142, 22,0) | ||||
178 | ^9.49I^1^1 | ||||
179 | "PKG",142, 22,1,0) | ||||
180 | 4.5^^29503 20 | ||||
181 | "PKG",142, 22,1,"PAH" ,1,0) | ||||
182 | 310^316092 9^101114 | ||||
183 | "QUES","XP F1",0) | ||||
184 | Y | ||||
185 | "QUES","XP F1","??") | ||||
186 | ^D REP^XPD H | ||||
187 | "QUES","XP F1","A") | ||||
188 | Shall I wr ite over y our |FLAG| File | ||||
189 | "QUES","XP F1","B") | ||||
190 | YES | ||||
191 | "QUES","XP F1","M") | ||||
192 | D XPF1^XPD IQ | ||||
193 | "QUES","XP F2",0) | ||||
194 | Y | ||||
195 | "QUES","XP F2","??") | ||||
196 | ^D DTA^XPD H | ||||
197 | "QUES","XP F2","A") | ||||
198 | Want my da ta |FLAG| yours | ||||
199 | "QUES","XP F2","B") | ||||
200 | YES | ||||
201 | "QUES","XP F2","M") | ||||
202 | D XPF2^XPD IQ | ||||
203 | "QUES","XP I1",0) | ||||
204 | YO | ||||
205 | "QUES","XP I1","??") | ||||
206 | ^D INHIBIT ^XPDH | ||||
207 | "QUES","XP I1","A") | ||||
208 | Want KIDS to INHIBIT LOGONs du ring the i nstall | ||||
209 | "QUES","XP I1","B") | ||||
210 | NO | ||||
211 | "QUES","XP I1","M") | ||||
212 | D XPI1^XPD IQ | ||||
213 | "QUES","XP M1",0) | ||||
214 | PO^VA(200, :EM | ||||
215 | "QUES","XP M1","??") | ||||
216 | ^D MG^XPDH | ||||
217 | "QUES","XP M1","A") | ||||
218 | Enter the Coordinato r for Mail Group '|F LAG|' | ||||
219 | "QUES","XP M1","B") | ||||
220 | |||||
221 | "QUES","XP M1","M") | ||||
222 | D XPM1^XPD IQ | ||||
223 | "QUES","XP O1",0) | ||||
224 | Y | ||||
225 | "QUES","XP O1","??") | ||||
226 | ^D MENU^XP DH | ||||
227 | "QUES","XP O1","A") | ||||
228 | Want KIDS to Rebuild Menu Tree s Upon Com pletion of Install | ||||
229 | "QUES","XP O1","B") | ||||
230 | NO | ||||
231 | "QUES","XP O1","M") | ||||
232 | D XPO1^XPD IQ | ||||
233 | "QUES","XP Z1",0) | ||||
234 | Y | ||||
235 | "QUES","XP Z1","??") | ||||
236 | ^D OPT^XPD H | ||||
237 | "QUES","XP Z1","A") | ||||
238 | Want to DI SABLE Sche duled Opti ons, Menu Options, a nd Protoco ls | ||||
239 | "QUES","XP Z1","B") | ||||
240 | YES | ||||
241 | "QUES","XP Z1","M") | ||||
242 | D XPZ1^XPD IQ | ||||
243 | "QUES","XP Z2",0) | ||||
244 | Y | ||||
245 | "QUES","XP Z2","??") | ||||
246 | ^D RTN^XPD H | ||||
247 | "QUES","XP Z2","A") | ||||
248 | Want to MO VE routine s to other CPUs | ||||
249 | "QUES","XP Z2","B") | ||||
250 | NO | ||||
251 | "QUES","XP Z2","M") | ||||
252 | D XPZ2^XPD IQ | ||||
253 | "RTN") | ||||
254 | 11 | ||||
255 | "RTN","PRC AACC") | ||||
256 | 0^2^B86907 33^B884685 9 | ||||
257 | "RTN","PRC AACC",1,0) | ||||
258 | PRCAACC ;W ASH-ISC@AL TOONA,PA/C MS-AR ACCR UAL TOTALS ;10/19/10 1:36pm | ||||
259 | "RTN","PRC AACC",2,0) | ||||
260 | ;;4.5;Acc ounts Rece ivable;**6 0,74,90,10 1,157,203, 220,273,31 0**;Mar 20 , 1995;Bui ld 14 | ||||
261 | "RTN","PRC AACC",3,0) | ||||
262 | ;Per VA D irective 6 402, this routine sh ould not b e modified . | ||||
263 | "RTN","PRC AACC",4,0) | ||||
264 | NEW PRCAQ UE,PRCADEV ,PRCA,ZTSK | ||||
265 | "RTN","PRC AACC",5,0) | ||||
266 | S PRCA("M ESS")="Do you wish t o queue th is report" D QUE^PRC AQUE G:'$D (PRCAQUE) Q | ||||
267 | "RTN","PRC AACC",6,0) | ||||
268 | I $D(IO(" Q")) S ZTR TN="DQ^PRC AACC",ZTDE SC="AR Acc rual Total s" D ^%ZTL OAD G Q | ||||
269 | "RTN","PRC AACC",7,0) | ||||
270 | DQ ; | ||||
271 | "RTN","PRC AACC",8,0) | ||||
272 | U IO | ||||
273 | "RTN","PRC AACC",9,0) | ||||
274 | NEW BILLN ,COM,TOT,S TAT,X,Y | ||||
275 | "RTN","PRC AACC",10,0 ) | ||||
276 | S BILLN=0 | ||||
277 | "RTN","PRC AACC",11,0 ) | ||||
278 | D COM G:$ O(COM("")) ="" RPT | ||||
279 | "RTN","PRC AACC",12,0 ) | ||||
280 | F STAT=42 ,16 F S B ILLN=$O(^P RCA(430,"A C",STAT,BI LLN)) Q:'B ILLN I $$ ACCK(BILLN ) D | ||||
281 | "RTN","PRC AACC",13,0 ) | ||||
282 | .S X=("," _$P(^PRCA( 430,BILLN, 0),"^",2)_ ",") | ||||
283 | "RTN","PRC AACC",14,0 ) | ||||
284 | .S TOT(X) =$G(TOT(X) )+$G(^PRCA (430,BILLN ,7)) | ||||
285 | "RTN","PRC AACC",15,0 ) | ||||
286 | .QUIT | ||||
287 | "RTN","PRC AACC",16,0 ) | ||||
288 | RPT D NOW^ %DTC W @IO F,!!,?23," Accrual To tals Repor t",!?20,"A s of: " S Y=% X ^DD( "DD") W Y, ! | ||||
289 | "RTN","PRC AACC",17,0 ) | ||||
290 | S X="",$P (X,"=",80) ="" W X | ||||
291 | "RTN","PRC AACC",18,0 ) | ||||
292 | W:$O(COM( ""))="" !! ,"WARNING: Accruals are *NOT* set-up cor rectly.",! ,"No RX ac crual comm on numberi ng series are set-up in AR Bil l Number F ile!",!! | ||||
293 | "RTN","PRC AACC",19,0 ) | ||||
294 | S TOT=$G( TOT(",22," ))+$G(TOT( ",23,")) I TOT W !!! ,"RX CO-PA YMENT Acc rual Amoun t: $",$FN( TOT,",",2) | ||||
295 | "RTN","PRC AACC",20,0 ) | ||||
296 | I $G(TOT( ",18,"))>0 W !!!,"C (MEANS TES T) Accrua l Amount: $",$FN(TOT (",18,")," ,",2) | ||||
297 | "RTN","PRC AACC",21,0 ) | ||||
298 | W !!!!,"I ncludes Co mmon Numbe ring Serie s:",! S CO M="" F S COM=$O(COM (COM)) Q:C OM="" W ! ,COM,?20,C OM(COM) | ||||
299 | "RTN","PRC AACC",22,0 ) | ||||
300 | Q D ^%ZISC S IOP=IO( 0) D ^%ZIS K IOP,IO( "Q") Q | ||||
301 | "RTN","PRC AACC",23,0 ) | ||||
302 | ACCK(BN) ; Check BILL N to see i f Accrual | ||||
303 | "RTN","PRC AACC",24,0 ) | ||||
304 | N ACC,ACT DATE,CAT,F UND,DB | ||||
305 | "RTN","PRC AACC",25,0 ) | ||||
306 | S CAT=+$P (^PRCA(430 ,BN,0),"^" ,2) | ||||
307 | "RTN","PRC AACC",26,0 ) | ||||
308 | ; field 12, ACCRUE D ? where 0=no 1=yes , 2=could be either | ||||
309 | "RTN","PRC AACC",27,0 ) | ||||
310 | S ACC=+$P ($G(^PRCA( 430.2,CAT, 0)),"^",9) | ||||
311 | "RTN","PRC AACC",28,0 ) | ||||
312 | ; it cou ld be eith er accrued or non-ac crued | ||||
313 | "RTN","PRC AACC",29,0 ) | ||||
314 | I ACC=2 D | ||||
315 | "RTN","PRC AACC",30,0 ) | ||||
316 | . S FUN D=$P($G(^P RCA(430,BN ,11)),"^", 17) | ||||
317 | "RTN","PRC AACC",31,0 ) | ||||
318 | . S ACC =$S(FUND=5 014:1,FUND =2431:1,1: 0) | ||||
319 | "RTN","PRC AACC",32,0 ) | ||||
320 | . I $E( FUND,1,4)= 5287 S ACC =$$PTACCT( FUND) | ||||
321 | "RTN","PRC AACC",33,0 ) | ||||
322 | . ; sp ecial case with Work man's Comp | ||||
323 | "RTN","PRC AACC",34,0 ) | ||||
324 | . I ACC =0,CAT=6,F UND="" D | ||||
325 | "RTN","PRC AACC",35,0 ) | ||||
326 | . . S DB=$P($G( ^RCD(340,+ $P($G(^PRC A(430,BN,0 )),U,9),0) ),U) | ||||
327 | "RTN","PRC AACC",36,0 ) | ||||
328 | . . I DB[";DPT" !($P($G(^P RCA(430,BN ,0)),U,7)' ="") S ACC =1 | ||||
329 | "RTN","PRC AACC",37,0 ) | ||||
330 | ; | ||||
331 | "RTN","PRC AACC",38,0 ) | ||||
332 | ; public law state s that bil ls in the category i neligible (1), | ||||
333 | "RTN","PRC AACC",39,0 ) | ||||
334 | ; emerg/ human (2), torts (10 ), or medi care (21) which are older | ||||
335 | "RTN","PRC AACC",40,0 ) | ||||
336 | ; than o ct 1, 1992 should be treated a s non-accr ued. | ||||
337 | "RTN","PRC AACC",41,0 ) | ||||
338 | I CAT=1!( CAT=2)!(CA T=10)!(CAT =21) D | ||||
339 | "RTN","PRC AACC",42,0 ) | ||||
340 | . S ACT DATE=$P($G (^PRCA(430 ,BN,6)),"^ ",21) I 'A CTDATE S A CTDATE=DT | ||||
341 | "RTN","PRC AACC",43,0 ) | ||||
342 | . I ACT DATE<29210 01 S ACC=0 | ||||
343 | "RTN","PRC AACC",44,0 ) | ||||
344 | . ; | ||||
345 | "RTN","PRC AACC",45,0 ) | ||||
346 | . ; pa tch157 cha nges ineli gibles. a n ineligib le created before | ||||
347 | "RTN","PRC AACC",46,0 ) | ||||
348 | . ; oc t 1, 1992 or after s ep 30, 200 0 will be non-accrue d. | ||||
349 | "RTN","PRC AACC",47,0 ) | ||||
350 | . ; ot herwise it will be a ccrued. | ||||
351 | "RTN","PRC AACC",48,0 ) | ||||
352 | . I CAT =1,ACTDATE >3000930 S ACC=0 | ||||
353 | "RTN","PRC AACC",49,0 ) | ||||
354 | ; | ||||
355 | "RTN","PRC AACC",50,0 ) | ||||
356 | Q ACC | ||||
357 | "RTN","PRC AACC",51,0 ) | ||||
358 | COM ;Find Accrual co mmon numbe ring serie s | ||||
359 | "RTN","PRC AACC",52,0 ) | ||||
360 | S COM=0 | ||||
361 | "RTN","PRC AACC",53,0 ) | ||||
362 | F S COM= $O(^PRCA(4 30.4,COM)) Q:'COM I $P(^PRCA( 430.4,COM, 0),"^",6) S COM($P(^ PRCA(430.4 ,COM,0),"^ "))=$P($G( ^DIC(49,$P (^(0),"^", 5),0)),"^" ,1) | ||||
363 | "RTN","PRC AACC",54,0 ) | ||||
364 | Q | ||||
365 | "RTN","PRC AACC",55,0 ) | ||||
366 | PTACCT(FUN D) ;Determ ines wheth er Point A ccounts ar e accrued | ||||
367 | "RTN","PRC AACC",56,0 ) | ||||
368 | ;returns 1 for accr ued funds 528701,528 702,528703 ,528704,52 8709,52871 1 | ||||
369 | "RTN","PRC AACC",57,0 ) | ||||
370 | ;returns 0 for any other fund | ||||
371 | "RTN","PRC AACC",58,0 ) | ||||
372 | ;PRCA*4.5 *310/DRF A dded 52871 3 to accru ed funds | ||||
373 | "RTN","PRC AACC",59,0 ) | ||||
374 | I FUND'[5 287 Q 0 | ||||
375 | "RTN","PRC AACC",60,0 ) | ||||
376 | S X=$E(FU ND,5,6),X= $S(X="09"! (X="11")!( X="13"):1, X<"05":1,1 :0) | ||||
377 | "RTN","PRC AACC",61,0 ) | ||||
378 | Q X | ||||
379 | "RTN","PRC AACC",62,0 ) | ||||
380 | ADDPTEDT() ;Effectiv e date of additional point acc ounts | ||||
381 | "RTN","PRC AACC",63,0 ) | ||||
382 | ; ( 528705 - 5 28708 and 528710) | ||||
383 | "RTN","PRC AACC",64,0 ) | ||||
384 | ;Effectiv e date of switch fro m 4032 to 528709 | ||||
385 | "RTN","PRC AACC",65,0 ) | ||||
386 | Q 3040928 | ||||
387 | "RTN","PRC ABJV") | ||||
388 | 0^9^B30343 584^B30084 731 | ||||
389 | "RTN","PRC ABJV",1,0) | ||||
390 | PRCABJV ;W ASH-ISC@AL TOONA,PA/T JK-FILE VE RIFICATION FOR BACKG ROUND JOB ;4/6/95 1 0:13 AM | ||||
391 | "RTN","PRC ABJV",2,0) | ||||
392 | V ;;4.5;Ac counts Rec eivable;** 1,48,63,11 4,141,170, 176,173,19 2,220,296, 310**;Mar 20, 1995;B uild 14 | ||||
393 | "RTN","PRC ABJV",3,0) | ||||
394 | ;;patch 1 92 changes all occur rences of CHAMPUS to TRICARE | ||||
395 | "RTN","PRC ABJV",4,0) | ||||
396 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | ||||
397 | "RTN","PRC ABJV",5,0) | ||||
398 | EN1(FILE,X 1,X2,ERROR ) ; | ||||
399 | "RTN","PRC ABJV",6,0) | ||||
400 | ;FILE IS THE FILE N UMBER | ||||
401 | "RTN","PRC ABJV",7,0) | ||||
402 | ;X1 AND X 2 ARE 3 PA RT VARIABL ES SEPARAT ED BY SEMI -COLONS WI TH | ||||
403 | "RTN","PRC ABJV",8,0) | ||||
404 | ;THE FORM AT (X-REF INDEX;NODE ;PIECE) | ||||
405 | "RTN","PRC ABJV",9,0) | ||||
406 | ;AN ERROR ARRAY IS SET IF VAL IDATION FA ILS | ||||
407 | "RTN","PRC ABJV",10,0 ) | ||||
408 | NEW LT,CN T,I,I1,I2, I3,REC,IND ,ND,PC,DAT A,J,LN,FIL ENT | ||||
409 | "RTN","PRC ABJV",11,0 ) | ||||
410 | S LT=$S(F ILE[430.3: "TRANST",F ILE[430.2: "CAT",1:"E VENT"),CNT =0 | ||||
411 | "RTN","PRC ABJV",12,0 ) | ||||
412 | F I=1,2 S J=@("X"_I ),IND(I)=$ P(J,";"),N D(I)=$P(J, ";",2),PC( I)=$P(J,"; ",3) | ||||
413 | "RTN","PRC ABJV",13,0 ) | ||||
414 | F I1=1:1 D Q:(DATA (0)="EOF") !(ERROR) | ||||
415 | "RTN","PRC ABJV",14,0 ) | ||||
416 | .S LN= $T(@LT+I1) F I=3:1:6 S DATA(I- 3)=$P(LN," ;",I) | ||||
417 | "RTN","PRC ABJV",15,0 ) | ||||
418 | .Q:DAT A(0)="EOF" | ||||
419 | "RTN","PRC ABJV",16,0 ) | ||||
420 | .G RC: FILE<430 | ||||
421 | "RTN","PRC ABJV",17,0 ) | ||||
422 | .I '$D (^PRCA(FIL E,"B",DATA (0))) S ER ROR=1 Q | ||||
423 | "RTN","PRC ABJV",18,0 ) | ||||
424 | .S REC =$O(^PRCA( FILE,"B",D ATA(0),0)) I 'REC S ERROR=1 Q | ||||
425 | "RTN","PRC ABJV",19,0 ) | ||||
426 | .I DAT A(3)'=REC S ERROR=1 Q | ||||
427 | "RTN","PRC ABJV",20,0 ) | ||||
428 | .I $P( ^PRCA(FILE ,REC,0),U) '=DATA(0) S ERROR=1 Q | ||||
429 | "RTN","PRC ABJV",21,0 ) | ||||
430 | .G CNT :X1="" | ||||
431 | "RTN","PRC ABJV",22,0 ) | ||||
432 | .F I2= 1,2 D Q:E RROR I I2 =1,X2="" Q | ||||
433 | "RTN","PRC ABJV",23,0 ) | ||||
434 | ..I '$D(^PRCA (FILE,IND( I2),DATA(I 2))) S ERR OR=1 G Q2 | ||||
435 | "RTN","PRC ABJV",24,0 ) | ||||
436 | ..; do not c heck if ca tegory num ber is a z ero | ||||
437 | "RTN","PRC ABJV",25,0 ) | ||||
438 | ..I I2=1,DATA (1)'=0,$O( ^PRCA(FILE ,IND(I2),D ATA(I2),0) )'=REC S E RROR=1 G Q 2 | ||||
439 | "RTN","PRC ABJV",26,0 ) | ||||
440 | ..I $P(^PRCA( FILE,REC,N D(I2)),U,P C(I2))'=DA TA(I2) S E RROR=1 | ||||
441 | "RTN","PRC ABJV",27,0 ) | ||||
442 | Q2 . .Q | ||||
443 | "RTN","PRC ABJV",28,0 ) | ||||
444 | CNT .Q: ERROR | ||||
445 | "RTN","PRC ABJV",29,0 ) | ||||
446 | .S CNT =CNT+1 | ||||
447 | "RTN","PRC ABJV",30,0 ) | ||||
448 | Q1 .Q | ||||
449 | "RTN","PRC ABJV",31,0 ) | ||||
450 | RC .I ' $D(^RC(FIL E,"B",DATA (0))) S ER ROR=1 Q | ||||
451 | "RTN","PRC ABJV",32,0 ) | ||||
452 | .S REC =$O(^RC(FI LE,"B",DAT A(0),0)) I 'REC S ER ROR=1 Q | ||||
453 | "RTN","PRC ABJV",33,0 ) | ||||
454 | .I DAT A(3)'=REC S ERROR=1 Q | ||||
455 | "RTN","PRC ABJV",34,0 ) | ||||
456 | .I $P( ^RC(FILE,R EC,0),U)'= DATA(0) S ERROR=1 Q | ||||
457 | "RTN","PRC ABJV",35,0 ) | ||||
458 | .G CNT :X1="" | ||||
459 | "RTN","PRC ABJV",36,0 ) | ||||
460 | .F I3= 1,2 D Q:E RROR I I3 =1,X2="" Q | ||||
461 | "RTN","PRC ABJV",37,0 ) | ||||
462 | ..I '$D(^RC(F ILE,IND(I3 ),DATA(I3) )) S ERROR =1 G Q3 | ||||
463 | "RTN","PRC ABJV",38,0 ) | ||||
464 | ..I $O(^RC(FI LE,IND(I3) ,DATA(I3), 0))'=REC S ERROR=1 G Q3 | ||||
465 | "RTN","PRC ABJV",39,0 ) | ||||
466 | ..I $P(^RC(FI LE,REC,ND( I3)),U,PC( I3))'=DATA (I3) S ERR OR=1 | ||||
467 | "RTN","PRC ABJV",40,0 ) | ||||
468 | Q3 . .Q | ||||
469 | "RTN","PRC ABJV",41,0 ) | ||||
470 | .G CNT | ||||
471 | "RTN","PRC ABJV",42,0 ) | ||||
472 | I FILE>42 9.99,$P(^P RCA(FILE,0 ),U,4)'=CN T S ERROR= 1 G EXIT | ||||
473 | "RTN","PRC ABJV",43,0 ) | ||||
474 | G EXIT:FI LE>429.99 | ||||
475 | "RTN","PRC ABJV",44,0 ) | ||||
476 | I $P(^RC( FILE,0),U, 4)'=CNT S ERROR=1 | ||||
477 | "RTN","PRC ABJV",45,0 ) | ||||
478 | EXIT Q:'ER ROR | ||||
479 | "RTN","PRC ABJV",46,0 ) | ||||
480 | S FILENT= $S(FILE>42 9.99:$P(^P RCA(FILE,0 ),U,4),1:$ P(^RC(FILE ,0),U,4)) | ||||
481 | "RTN","PRC ABJV",47,0 ) | ||||
482 | S ERROR(1 )="An erro r has been detected in the "_$ P(^DIC(FIL E,0),U)_" File." | ||||
483 | "RTN","PRC ABJV",48,0 ) | ||||
484 | I DATA(0) ="EOF" S E RROR(2)="T here are t oo many en tries in y our file." | ||||
485 | "RTN","PRC ABJV",49,0 ) | ||||
486 | I DATA(0) '="EOF" S ERROR(2)=" The "_DATA (0)_" Entr y in your file is mi ssing or c orrupted." | ||||
487 | "RTN","PRC ABJV",50,0 ) | ||||
488 | Q | ||||
489 | "RTN","PRC ABJV",51,0 ) | ||||
490 | TRANST ; | ||||
491 | "RTN","PRC ABJV",52,0 ) | ||||
492 | ;;ACTIVE; 102;A;16 | ||||
493 | "RTN","PRC ABJV",53,0 ) | ||||
494 | ;;ADD (AM END);302;A D;37 | ||||
495 | "RTN","PRC ABJV",54,0 ) | ||||
496 | ;;ADMIN.C OST CHARGE ;12;AC;12 | ||||
497 | "RTN","PRC ABJV",55,0 ) | ||||
498 | ;;AMEND;3 03;AM;38 | ||||
499 | "RTN","PRC ABJV",56,0 ) | ||||
500 | ;;AMENDED BILL;110; AB;33 | ||||
501 | "RTN","PRC ABJV",57,0 ) | ||||
502 | ;;ARCHIVE D;115;XX;4 9 | ||||
503 | "RTN","PRC ABJV",58,0 ) | ||||
504 | ;;BILL IN COMPLETE;2 01;BI;27 | ||||
505 | "RTN","PRC ABJV",59,0 ) | ||||
506 | ;;CANCELL ATION;111; CN;39 | ||||
507 | "RTN","PRC ABJV",60,0 ) | ||||
508 | ;;CANCELL ED BILL;21 0;CB;26 | ||||
509 | "RTN","PRC ABJV",61,0 ) | ||||
510 | ;;CASH CO LLECTION B Y RC/DOJ;7 ;CJ;7 | ||||
511 | "RTN","PRC ABJV",62,0 ) | ||||
512 | ;;CHARGE SUSPENDED; 19;CS;47 | ||||
513 | "RTN","PRC ABJV",63,0 ) | ||||
514 | ;;COLLECT ED/CLOSED; 108;CC;22 | ||||
515 | "RTN","PRC ABJV",64,0 ) | ||||
516 | ;;COMMENT ;17;CM;45 | ||||
517 | "RTN","PRC ABJV",65,0 ) | ||||
518 | ;;DEBIT V OUCHER (SF 5515);30; DV;30 | ||||
519 | "RTN","PRC ABJV",66,0 ) | ||||
520 | ;;DECREAS E ADJUSTME NT;21;DA;3 5 | ||||
521 | "RTN","PRC ABJV",67,0 ) | ||||
522 | ;;DELETE (AMEND);30 1;DL;36 | ||||
523 | "RTN","PRC ABJV",68,0 ) | ||||
524 | ;;EXEMPT INT/ADM. C OST;14;E;1 4 | ||||
525 | "RTN","PRC ABJV",69,0 ) | ||||
526 | ;;IN-ACTI VE;103;IA; 17 | ||||
527 | "RTN","PRC ABJV",70,0 ) | ||||
528 | ;;INCOMPL ETE;101;IN ;15 | ||||
529 | "RTN","PRC ABJV",71,0 ) | ||||
530 | ;;INCREAS E ADJUSTME NT;1;AJ;1 | ||||
531 | "RTN","PRC ABJV",72,0 ) | ||||
532 | ;;INTERES T/ADM. CHA RGE;13;IC; 13 | ||||
533 | "RTN","PRC ABJV",73,0 ) | ||||
534 | ;;MARSHAL /COURT COS T;15;ML;24 | ||||
535 | "RTN","PRC ABJV",74,0 ) | ||||
536 | ;;NEW BIL L;104;N;18 | ||||
537 | "RTN","PRC ABJV",75,0 ) | ||||
538 | ;;OLD BIL L;106;OB;2 8 | ||||
539 | "RTN","PRC ABJV",76,0 ) | ||||
540 | ;;OPEN;11 2;OP;42 | ||||
541 | "RTN","PRC ABJV",77,0 ) | ||||
542 | ;;PAYMENT (IN FULL) ;20;PF;34 | ||||
543 | "RTN","PRC ABJV",78,0 ) | ||||
544 | ;;PAYMENT (IN PART) ;2;PP;2 | ||||
545 | "RTN","PRC ABJV",79,0 ) | ||||
546 | ;;PENDING APPROVAL; 205;PA;20 | ||||
547 | "RTN","PRC ABJV",80,0 ) | ||||
548 | ;;PENDING ARCHIVE;1 14;X;48 | ||||
549 | "RTN","PRC ABJV",81,0 ) | ||||
550 | ;;PENDING CALM CODE ;107;PC;21 | ||||
551 | "RTN","PRC ABJV",82,0 ) | ||||
552 | ;;RE-ESTA BLISH;250; RW;43 | ||||
553 | "RTN","PRC ABJV",83,0 ) | ||||
554 | ;;REESTAB LISH TO RC /DOJ;5;RR; 5 | ||||
555 | "RTN","PRC ABJV",84,0 ) | ||||
556 | ;;REFER T O RC;3;RC; 3 | ||||
557 | "RTN","PRC ABJV",85,0 ) | ||||
558 | ;;REFER T O DOJ;4;RJ ;4 | ||||
559 | "RTN","PRC ABJV",86,0 ) | ||||
560 | ;;REFUND REVIEW;113 ;PR;44 | ||||
561 | "RTN","PRC ABJV",87,0 ) | ||||
562 | ;;REFUNDE D;120;RF;4 1 | ||||
563 | "RTN","PRC ABJV",88,0 ) | ||||
564 | ;;REPAYME NT PLAN;16 ;RP;25 | ||||
565 | "RTN","PRC ABJV",89,0 ) | ||||
566 | ;;RETURNE D BY RC/DO J;6;RD;6 | ||||
567 | "RTN","PRC ABJV",90,0 ) | ||||
568 | ;;RETURNE D FOR AMEN DMENT;230; RA;32 | ||||
569 | "RTN","PRC ABJV",91,0 ) | ||||
570 | ;;RETURNE D FROM AR (NEW);220; RT;31 | ||||
571 | "RTN","PRC ABJV",92,0 ) | ||||
572 | ;;SUSPEND ED;240;SP; 40 | ||||
573 | "RTN","PRC ABJV",93,0 ) | ||||
574 | ;;SUSPENS E;105;S;19 | ||||
575 | "RTN","PRC ABJV",94,0 ) | ||||
576 | ;;TERM.BY COMPROMIS E;9;TC;9 | ||||
577 | "RTN","PRC ABJV",95,0 ) | ||||
578 | ;;TERM.BY RC/DOJ;29 ;TJ;29 | ||||
579 | "RTN","PRC ABJV",96,0 ) | ||||
580 | ;;TERM.BY FIS.OFFIC ER;8;TO;8 | ||||
581 | "RTN","PRC ABJV",97,0 ) | ||||
582 | ;;UNSUSPE NDED;18;US ;46 | ||||
583 | "RTN","PRC ABJV",98,0 ) | ||||
584 | ;;WAIVED IN FULL;10 ;WF;10 | ||||
585 | "RTN","PRC ABJV",99,0 ) | ||||
586 | ;;WAIVED IN PART;11 ;WP;11 | ||||
587 | "RTN","PRC ABJV",100, 0) | ||||
588 | ;;WRITE-O FF;109;WO; 23 | ||||
589 | "RTN","PRC ABJV",101, 0) | ||||
590 | ;;EOF | ||||
591 | "RTN","PRC ABJV",102, 0) | ||||
592 | CAT ;patch 192 - ISC -0502-N280 3 change C hampus to Tricare | ||||
593 | "RTN","PRC ABJV",103, 0) | ||||
594 | ;;ADULT D AY HEALTH CARE;40;AD ;33 | ||||
595 | "RTN","PRC ABJV",104, 0) | ||||
596 | ;;C (MEAN S TEST);24 ;C;18 | ||||
597 | "RTN","PRC ABJV",105, 0) | ||||
598 | ;;TRICARE ;37;T1;30 | ||||
599 | "RTN","PRC ABJV",106, 0) | ||||
600 | ;;TRICARE PATIENT;3 8;T2;31 | ||||
601 | "RTN","PRC ABJV",107, 0) | ||||
602 | ;;TRICARE THIRD PAR TY;39;T3;3 2 | ||||
603 | "RTN","PRC ABJV",108, 0) | ||||
604 | ;;CHAMPVA ;36;CV;29 | ||||
605 | "RTN","PRC ABJV",109, 0) | ||||
606 | ;;CHAMPVA SUBSISTEN CE;34;CS;2 7 | ||||
607 | "RTN","PRC ABJV",110, 0) | ||||
608 | ;;CHAMPVA THIRD PAR TY;35;CT;2 8 | ||||
609 | "RTN","PRC ABJV",111, 0) | ||||
610 | ;;COMP & PEN PROCEE DS;8;CM;43 | ||||
611 | "RTN","PRC ABJV",112, 0) | ||||
612 | ;;CRIME O F PER.VIO. ;27;CP;8 | ||||
613 | "RTN","PRC ABJV",113, 0) | ||||
614 | ;;CURRENT EMP.;14;C E;16 | ||||
615 | "RTN","PRC ABJV",114, 0) | ||||
616 | ;;CWT PRO CEEDS;7;CW ;42 | ||||
617 | "RTN","PRC ABJV",115, 0) | ||||
618 | ;;DOMICIL IARY;41;DO ;34 | ||||
619 | "RTN","PRC ABJV",116, 0) | ||||
620 | ;;EMERGEN CY/HUMANIT ARIAN;25;H ;2 | ||||
621 | "RTN","PRC ABJV",117, 0) | ||||
622 | ;;ENHANCE D USE LEAS E PROCEEDS ;10;EP;44 | ||||
623 | "RTN","PRC ABJV",118, 0) | ||||
624 | ;;EX-EMPL OYEE;13;E; 15 | ||||
625 | "RTN","PRC ABJV",119, 0) | ||||
626 | ;;FEDERAL AGENCIES- REFUND;15; F2;13 | ||||
627 | "RTN","PRC ABJV",120, 0) | ||||
628 | ;;FEDERAL AGENCIES- REIMB.;16; F1;14 | ||||
629 | "RTN","PRC ABJV",121, 0) | ||||
630 | ;;FEE REI MB INS;47; FR;45 | ||||
631 | "RTN","PRC ABJV",122, 0) | ||||
632 | ;;GERIATR IC EVAL-IN STITUTIONA L;44;GE;37 | ||||
633 | "RTN","PRC ABJV",123, 0) | ||||
634 | ;;GERIATR IC EVAL-NO N-INSTITUT ION;45;GN; 38 | ||||
635 | "RTN","PRC ABJV",124, 0) | ||||
636 | ;;HOSPITA L CARE (NS C);1;HC;5 | ||||
637 | "RTN","PRC ABJV",125, 0) | ||||
638 | ;;HOSPITA L CARE PER DIEM;32;H P;25 | ||||
639 | "RTN","PRC ABJV",126, 0) | ||||
640 | ;;INELIGI BLE HOSP.; 20;I;1 | ||||
641 | "RTN","PRC ABJV",127, 0) | ||||
642 | ;;INTERAG ENCY;19;IA ;20 | ||||
643 | "RTN","PRC ABJV",128, 0) | ||||
644 | ;;MEDICAR E;28;MC;21 | ||||
645 | "RTN","PRC ABJV",129, 0) | ||||
646 | ;;MILITAR Y;17;M;12 | ||||
647 | "RTN","PRC ABJV",130, 0) | ||||
648 | ;;NO-FAUL T AUTO ACC .;26;NA;7 | ||||
649 | "RTN","PRC ABJV",131, 0) | ||||
650 | ;;NURSING HOME CARE PER DIEM; 31;NP;24 | ||||
651 | "RTN","PRC ABJV",132, 0) | ||||
652 | ;;NURSING HOME CARE (NSC);3;NC ;3 | ||||
653 | "RTN","PRC ABJV",133, 0) | ||||
654 | ;;NURSING HOME CARE -LTC;46;NL ;39 | ||||
655 | "RTN","PRC ABJV",134, 0) | ||||
656 | ;;NURSING HOME PROC EEDS;5;NH; 40 | ||||
657 | "RTN","PRC ABJV",135, 0) | ||||
658 | ;;OUTPATI ENT CARE(N SC);2;OC;4 | ||||
659 | "RTN","PRC ABJV",136, 0) | ||||
660 | ;;PARKING FEES;6;PF ;41 | ||||
661 | "RTN","PRC ABJV",137, 0) | ||||
662 | ;;PREPAYM ENT;33;PP; 26 | ||||
663 | "RTN","PRC ABJV",138, 0) | ||||
664 | ;;REIMBUR S.HEALTH I NS.;21;RI; 9 | ||||
665 | "RTN","PRC ABJV",139, 0) | ||||
666 | ;;RESPITE CARE-INST ITUTIONAL; 42;RC;35 | ||||
667 | "RTN","PRC ABJV",140, 0) | ||||
668 | ;;RESPITE CARE-NON- INSTITUTIO NAL;43;RN; 36 | ||||
669 | "RTN","PRC ABJV",141, 0) | ||||
670 | ;;RX CO-P AYMENT/NSC VET;30;PN ;23 | ||||
671 | "RTN","PRC ABJV",142, 0) | ||||
672 | ;;RX CO-P AYMENT/SC VET;29;PS; 22 | ||||
673 | "RTN","PRC ABJV",143, 0) | ||||
674 | ;;SHARING AGREEMENT S;18;SA;19 | ||||
675 | "RTN","PRC ABJV",144, 0) | ||||
676 | ;;TORT FE ASOR;22;TF ;10 | ||||
677 | "RTN","PRC ABJV",145, 0) | ||||
678 | ;;VENDOR; 11;V;17 | ||||
679 | "RTN","PRC ABJV",146, 0) | ||||
680 | ;;WORKMAN 'S COMP.;2 3;WC;6 | ||||
681 | "RTN","PRC ABJV",147, 0) | ||||
682 | ;;EOF | ||||
683 | "RTN","PRC ABJV",148, 0) | ||||
684 | EVENT ; | ||||
685 | "RTN","PRC ABJV",149, 0) | ||||
686 | ;;CASH PA YMENT;6;;6 | ||||
687 | "RTN","PRC ABJV",150, 0) | ||||
688 | ;;CHECK/M O PAYMENT; 4;;4 | ||||
689 | "RTN","PRC ABJV",151, 0) | ||||
690 | ;;COMMENT ;1;;1 | ||||
691 | "RTN","PRC ABJV",152, 0) | ||||
692 | ;;CREDIT CARD PAYME NT;7;;7 | ||||
693 | "RTN","PRC ABJV",153, 0) | ||||
694 | ;;DEPT OF JUSTICE P AYMENT;5;; 5 | ||||
695 | "RTN","PRC ABJV",154, 0) | ||||
696 | ;;REGIONA L COUNSEL PAYMENT;3; ;3 | ||||
697 | "RTN","PRC ABJV",155, 0) | ||||
698 | ;;FOLLOW- UP LETTER; 10;;10 | ||||
699 | "RTN","PRC ABJV",156, 0) | ||||
700 | ;;IRS PAY MENT;11;;1 1 | ||||
701 | "RTN","PRC ABJV",157, 0) | ||||
702 | ;;PATIENT STATEMENT ;2;;2 | ||||
703 | "RTN","PRC ABJV",158, 0) | ||||
704 | ;;TDA PAY MENT;8;;8 | ||||
705 | "RTN","PRC ABJV",159, 0) | ||||
706 | ;;UB PRIN TED;9;;9 | ||||
707 | "RTN","PRC ABJV",160, 0) | ||||
708 | ;;LOCKBOX ;12;;12 | ||||
709 | "RTN","PRC ABJV",161, 0) | ||||
710 | ;;TOP PAY MENT;13;;1 3 | ||||
711 | "RTN","PRC ABJV",162, 0) | ||||
712 | ;;EDI LOC KBOX;14;;1 4 | ||||
713 | "RTN","PRC ABJV",163, 0) | ||||
714 | ;;ADMINIS TRATIVE OF FSET;15;;1 5 | ||||
715 | "RTN","PRC ABJV",164, 0) | ||||
716 | ;;PRIVATE COLLECTIO N AGENCY;1 6;;16 | ||||
717 | "RTN","PRC ABJV",165, 0) | ||||
718 | ;;EOF | ||||
719 | "RTN","PRC AP310") | ||||
720 | 0^^B126955 59^n/a | ||||
721 | "RTN","PRC AP310",1,0 ) | ||||
722 | PRCAP310 ; DRF/Albany - PRCA*4. 5*310 POST INSTALL;0 9/10/15 2: 10pm | ||||
723 | "RTN","PRC AP310",2,0 ) | ||||
724 | ;;4.5;Acc ounts Rece ivable;**3 10**;Mar 2 0, 1995;Bu ild 14 | ||||
725 | "RTN","PRC AP310",3,0 ) | ||||
726 | ;Per VA D irective 6 402, this routine sh ould not b e modified . | ||||
727 | "RTN","PRC AP310",4,0 ) | ||||
728 | Q | ||||
729 | "RTN","PRC AP310",5,0 ) | ||||
730 | ; | ||||
731 | "RTN","PRC AP310",6,0 ) | ||||
732 | POSTINIT ; Post Insta ll for PRC A*4.5*310 | ||||
733 | "RTN","PRC AP310",7,0 ) | ||||
734 | D BMES^XP DUTL(" >> Starting the Post-I nitializat ion routin e ") | ||||
735 | "RTN","PRC AP310",8,0 ) | ||||
736 | ; AR CATE GORIES and REVENUE S OURCE CODE S | ||||
737 | "RTN","PRC AP310",9,0 ) | ||||
738 | D ARCAT | ||||
739 | "RTN","PRC AP310",10, 0) | ||||
740 | D REVSC | ||||
741 | "RTN","PRC AP310",11, 0) | ||||
742 | D FUND | ||||
743 | "RTN","PRC AP310",12, 0) | ||||
744 | D APPR | ||||
745 | "RTN","PRC AP310",13, 0) | ||||
746 | D BMES^XP DUTL(" >> End of th e Post-Ini tializatio n routine ") | ||||
747 | "RTN","PRC AP310",14, 0) | ||||
748 | Q | ||||
749 | "RTN","PRC AP310",15, 0) | ||||
750 | ; | ||||
751 | "RTN","PRC AP310",16, 0) | ||||
752 | ; | ||||
753 | "RTN","PRC AP310",17, 0) | ||||
754 | ARCAT ;AR CATEGORY E NTRIES (43 0.2) | ||||
755 | "RTN","PRC AP310",18, 0) | ||||
756 | N DA,DIC, DIE,DIK,DI NUM,DLAYGO ,DR,RCDATA ,RCDINUM,X ,Y | ||||
757 | "RTN","PRC AP310",19, 0) | ||||
758 | D MES^XPD UTL(" -> Adding new AR CAT EGORY entr ies to fil e 430.2 .. .") | ||||
759 | "RTN","PRC AP310",20, 0) | ||||
760 | S RCDINUM =45,(DIC,D IE)="^PRCA (430.2,",D IC(0)="L", DLAYGO=430 .2 | ||||
761 | "RTN","PRC AP310",21, 0) | ||||
762 | ; if the entry is in the fil e, delete it first t o add fiel ds unedita ble | ||||
763 | "RTN","PRC AP310",22, 0) | ||||
764 | I $D(^PRC A(430.2,RC DINUM,0)) S DIK="^PR CA(430.2," ,DA=RCDINU M D ^DIK | ||||
765 | "RTN","PRC AP310",23, 0) | ||||
766 | S DINUM=R CDINUM | ||||
767 | "RTN","PRC AP310",24, 0) | ||||
768 | S X="FEE REIMB INS" | ||||
769 | "RTN","PRC AP310",25, 0) | ||||
770 | ; set th e field va lues | ||||
771 | "RTN","PRC AP310",26, 0) | ||||
772 | S DA=RCDI NUM,DIC("D R")="" | ||||
773 | "RTN","PRC AP310",27, 0) | ||||
774 | S DIC("DR ")=DIC("DR ")_"1///FR ;" | ||||
775 | "RTN","PRC AP310",28, 0) | ||||
776 | S DIC("DR ")=DIC("DR ")_"2///24 9;" | ||||
777 | "RTN","PRC AP310",29, 0) | ||||
778 | S DIC("DR ")=DIC("DR ")_"3///12 12;" | ||||
779 | "RTN","PRC AP310",30, 0) | ||||
780 | S DIC("DR ")=DIC("DR ")_"4///;" | ||||
781 | "RTN","PRC AP310",31, 0) | ||||
782 | S DIC("DR ")=DIC("DR ")_"5///T; " | ||||
783 | "RTN","PRC AP310",32, 0) | ||||
784 | S DIC("DR ")=DIC("DR ")_"6///47 ;" | ||||
785 | "RTN","PRC AP310",33, 0) | ||||
786 | S DIC("DR ")=DIC("DR ")_"7///2; " | ||||
787 | "RTN","PRC AP310",34, 0) | ||||
788 | S DIC("DR ")=DIC("DR ")_"12///1 ;" | ||||
789 | "RTN","PRC AP310",35, 0) | ||||
790 | S DIC("DR ")=DIC("DR ")_"9///0; " | ||||
791 | "RTN","PRC AP310",36, 0) | ||||
792 | S DIC("DR ")=DIC("DR ")_"10///0 ;" | ||||
793 | "RTN","PRC AP310",37, 0) | ||||
794 | S DIC("DR ")=DIC("DR ")_"11///0 ;" | ||||
795 | "RTN","PRC AP310",38, 0) | ||||
796 | S DIC("DR ")=DIC("DR ")_"13///2 ;" | ||||
797 | "RTN","PRC AP310",39, 0) | ||||
798 | D FILE^DI CN | ||||
799 | "RTN","PRC AP310",40, 0) | ||||
800 | D MES^XPD UTL(" AR CATE GORY compl eted.") | ||||
801 | "RTN","PRC AP310",41, 0) | ||||
802 | Q | ||||
803 | "RTN","PRC AP310",42, 0) | ||||
804 | ; | ||||
805 | "RTN","PRC AP310",43, 0) | ||||
806 | ; | ||||
807 | "RTN","PRC AP310",44, 0) | ||||
808 | REVSC ;REV ENUE SOURC E CODE ent ries in fi le #347.3 | ||||
809 | "RTN","PRC AP310",45, 0) | ||||
810 | N I,RSCDA TA,DIC,Y,G BL,DA,X,DI E,DR | ||||
811 | "RTN","PRC AP310",46, 0) | ||||
812 | D MES^XPD UTL(" -> Adding new REVENU E SOURCE C ODE entrie s to file 347.3 ..." ) | ||||
813 | "RTN","PRC AP310",47, 0) | ||||
814 | S GBL="^R C(347.3," | ||||
815 | "RTN","PRC AP310",48, 0) | ||||
816 | F I=1:1 D Q:RSCDAT A="END" | ||||
817 | "RTN","PRC AP310",49, 0) | ||||
818 | . S RSCDA TA=$P($T(N EWRSC+I)," ;",3,99) | ||||
819 | "RTN","PRC AP310",50, 0) | ||||
820 | . Q:RSCDA TA="END" | ||||
821 | "RTN","PRC AP310",51, 0) | ||||
822 | . ; do a lookup and continue if exists. | ||||
823 | "RTN","PRC AP310",52, 0) | ||||
824 | . S DIC=G BL,X=$P(RS CDATA,";") D ^DIC | ||||
825 | "RTN","PRC AP310",53, 0) | ||||
826 | . I +Y>0 S DIK=GBL, DA=+Y D ^D IK | ||||
827 | "RTN","PRC AP310",54, 0) | ||||
828 | . ; add e ntry | ||||
829 | "RTN","PRC AP310",55, 0) | ||||
830 | . S X=$P( RSCDATA,"; ") | ||||
831 | "RTN","PRC AP310",56, 0) | ||||
832 | . S DIC(" DR")=".02/ //"_$P(RSC DATA,";",2 )_";" | ||||
833 | "RTN","PRC AP310",57, 0) | ||||
834 | . S DIC(" DR")=DIC(" DR")_".03/ //0;" | ||||
835 | "RTN","PRC AP310",58, 0) | ||||
836 | . D FILE^ DICN | ||||
837 | "RTN","PRC AP310",59, 0) | ||||
838 | . I +Y=-1 D | ||||
839 | "RTN","PRC AP310",60, 0) | ||||
840 | . . D MES ^XPDUTL(" "_$ P(RSCDATA, ";")_" fai led to add !") | ||||
841 | "RTN","PRC AP310",61, 0) | ||||
842 | D MES^XPD UTL(" REVENUE SOURCE CO DES comple ted.") | ||||
843 | "RTN","PRC AP310",62, 0) | ||||
844 | Q | ||||
845 | "RTN","PRC AP310",63, 0) | ||||
846 | ; | ||||
847 | "RTN","PRC AP310",64, 0) | ||||
848 | ; | ||||
849 | "RTN","PRC AP310",65, 0) | ||||
850 | FUND ;PRCD FUND entr y in 420.1 4 | ||||
851 | "RTN","PRC AP310",66, 0) | ||||
852 | N DA,DIC, DIK,DLAYGO ,FUND,X,Y | ||||
853 | "RTN","PRC AP310",67, 0) | ||||
854 | D MES^XPD UTL(" -> Adding new PRCD F UND entry to file 42 0.14 ...") | ||||
855 | "RTN","PRC AP310",68, 0) | ||||
856 | S DIC="^P RCD(420.14 ,",DIC(0)= "L",DLAYGO =420.14,FU ND=528713 | ||||
857 | "RTN","PRC AP310",69, 0) | ||||
858 | ; if the entry is i n the file , delete i t first to add field s uneditab le | ||||
859 | "RTN","PRC AP310",70, 0) | ||||
860 | S X=FUND D ^DIC I + Y>0 S DA=+ Y,DIK="^PR CD(420.14, " D ^DIK | ||||
861 | "RTN","PRC AP310",71, 0) | ||||
862 | ; add ent ry | ||||
863 | "RTN","PRC AP310",72, 0) | ||||
864 | S X=FUND | ||||
865 | "RTN","PRC AP310",73, 0) | ||||
866 | S DIC("DR ")="1////M CCF-FEE-CO LL FUND-3R D PARTY;" | ||||
867 | "RTN","PRC AP310",74, 0) | ||||
868 | S DIC("DR ")=DIC("DR ")_"2///20 16;" | ||||
869 | "RTN","PRC AP310",75, 0) | ||||
870 | S DIC("DR ")=DIC("DR ")_"3///20 16;" | ||||
871 | "RTN","PRC AP310",76, 0) | ||||
872 | S DIC("DR ")=DIC("DR ")_"4.7/// NET;" | ||||
873 | "RTN","PRC AP310",77, 0) | ||||
874 | S DIC("DR ")=DIC("DR ")_"5///A; " | ||||
875 | "RTN","PRC AP310",78, 0) | ||||
876 | S DIC("DR ")=DIC("DR ")_"4.5/// N;" | ||||
877 | "RTN","PRC AP310",79, 0) | ||||
878 | D FILE^DI CN | ||||
879 | "RTN","PRC AP310",80, 0) | ||||
880 | D MES^XPD UTL(" PRCD FU ND complet ed.") | ||||
881 | "RTN","PRC AP310",81, 0) | ||||
882 | Q | ||||
883 | "RTN","PRC AP310",82, 0) | ||||
884 | ; | ||||
885 | "RTN","PRC AP310",83, 0) | ||||
886 | ; | ||||
887 | "RTN","PRC AP310",84, 0) | ||||
888 | APPR ;PRCD FUND/APPR OPRIATION CODE entry in 420.3 | ||||
889 | "RTN","PRC AP310",85, 0) | ||||
890 | N DA,DIC, DIE,DIK,DI NUM,DLAYGO ,DR,RCDATA ,RCDINUM,X ,Y | ||||
891 | "RTN","PRC AP310",86, 0) | ||||
892 | D MES^XPD UTL(" -> Adding new PRCD F UND/APPROP RIATION CO DE entry t o file 420 .3 ...") | ||||
893 | "RTN","PRC AP310",87, 0) | ||||
894 | ; instal l entries in file 42 0.3 | ||||
895 | "RTN","PRC AP310",88, 0) | ||||
896 | S FUND=52 8713,DIC=" ^PRCD(420. 3,",DIC(0) ="L",DLAYG O=420.3 | ||||
897 | "RTN","PRC AP310",89, 0) | ||||
898 | ; if the entry is in the fil e, delete it first t o add fiel ds unedita ble | ||||
899 | "RTN","PRC AP310",90, 0) | ||||
900 | S X=FUND D ^DIC I + Y>0 S DA=+ Y,DIK="^PR CD(420.3," D ^DIK | ||||
901 | "RTN","PRC AP310",91, 0) | ||||
902 | ; add en try | ||||
903 | "RTN","PRC AP310",92, 0) | ||||
904 | S X=FUND | ||||
905 | "RTN","PRC AP310",93, 0) | ||||
906 | S DIC("DR ")="2////3 6_5287.13; " | ||||
907 | "RTN","PRC AP310",94, 0) | ||||
908 | S DIC("DR ")=DIC("DR ")_"4///36 _5287.13;" | ||||
909 | "RTN","PRC AP310",95, 0) | ||||
910 | S DIC("DR ")=DIC("DR ")_"6///52 8713;" | ||||
911 | "RTN","PRC AP310",96, 0) | ||||
912 | S DIC("DR ")=DIC("DR ")_"7///Y; " | ||||
913 | "RTN","PRC AP310",97, 0) | ||||
914 | D FILE^DI CN | ||||
915 | "RTN","PRC AP310",98, 0) | ||||
916 | D MES^XPD UTL(" PRCD FU ND/APPROPR IATION COD E complete d.") | ||||
917 | "RTN","PRC AP310",99, 0) | ||||
918 | Q | ||||
919 | "RTN","PRC AP310",100 ,0) | ||||
920 | ; | ||||
921 | "RTN","PRC AP310",101 ,0) | ||||
922 | ; | ||||
923 | "RTN","PRC AP310",102 ,0) | ||||
924 | ;Revenue Source Cod es (RSC#) | ||||
925 | "RTN","PRC AP310",103 ,0) | ||||
926 | NEWRSC ;SO URCE CODE; NAME | ||||
927 | "RTN","PRC AP310",104 ,0) | ||||
928 | ;;8F1Z;FE E BASIS IN PATIENT | ||||
929 | "RTN","PRC AP310",105 ,0) | ||||
930 | ;;8F2Z;FE E BASIS OU TPATIENT | ||||
931 | "RTN","PRC AP310",106 ,0) | ||||
932 | ;;END | ||||
933 | "RTN","RCR JRBD") | ||||
934 | 0^3^B74247 917^B70206 811 | ||||
935 | "RTN","RCR JRBD",1,0) | ||||
936 | RCRJRBD ;W ISC/RFJ,TJ K-bad debt extractor and repor t ;10/18/1 0 9:00am | ||||
937 | "RTN","RCR JRBD",2,0) | ||||
938 | ;;4.5;Acc ounts Rece ivable;**1 01,139,170 ,193,203,2 15,220,138 ,239,273,2 82,310**;M ar 20, 199 5;Build 14 | ||||
939 | "RTN","RCR JRBD",3,0) | ||||
940 | ;Per VA D irective 6 402, this routine sh ould not b e modified . | ||||
941 | "RTN","RCR JRBD",4,0) | ||||
942 | ; IA 4385 for calls to $$MRAT YPE^IBCEMU 2 and $$MR ADTACT^IBC EMU2 | ||||
943 | "RTN","RCR JRBD",5,0) | ||||
944 | Q | ||||
945 | "RTN","RCR JRBD",6,0) | ||||
946 | ; | ||||
947 | "RTN","RCR JRBD",7,0) | ||||
948 | ; | ||||
949 | "RTN","RCR JRBD",8,0) | ||||
950 | START(DATE END) ; ru n bad debt report | ||||
951 | "RTN","RCR JRBD",9,0) | ||||
952 | ; the DA TEEND is t he last da y of the m onth being run | ||||
953 | "RTN","RCR JRBD",10,0 ) | ||||
954 | ; from t he routine RCRJRCOL which is t he data ex tractor. The | ||||
955 | "RTN","RCR JRBD",11,0 ) | ||||
956 | ; curren t receivab le dollars is stored in ^TMP($ J,"RCRJRBD ",SGL) | ||||
957 | "RTN","RCR JRBD",12,0 ) | ||||
958 | ; where SGL is the standard general le dger 1319, 1338, or 1339. | ||||
959 | "RTN","RCR JRBD",13,0 ) | ||||
960 | ; | ||||
961 | "RTN","RCR JRBD",14,0 ) | ||||
962 | N ACTDATE ,ACTUALCA, ACTUALWO,B EGDATE,BIL LDA,CATEGO RY | ||||
963 | "RTN","RCR JRBD",15,0 ) | ||||
964 | N COLLECT ,CONTRACT, DR,ENDDATE ,FUND,PAY, PAYMENT,PR IN,PRINCPA L | ||||
965 | "RTN","RCR JRBD",16,0 ) | ||||
966 | N RCRJFMM ,RCRJDATE, SGL,TRANDA ,TRANDATE, TRANTYPE,V ALUE,WRITE OFF | ||||
967 | "RTN","RCR JRBD",17,0 ) | ||||
968 | N RCPRIN, RCTOMCCF,R CVALUE,RSC ,MRATYPE,A RACTDT | ||||
969 | "RTN","RCR JRBD",18,0 ) | ||||
970 | ; | ||||
971 | "RTN","RCR JRBD",19,0 ) | ||||
972 | ; lock t he bad deb t file for storing d ata, lock cannot fai l | ||||
973 | "RTN","RCR JRBD",20,0 ) | ||||
974 | ; this l ock can be used to m onitor if the report is runnin g | ||||
975 | "RTN","RCR JRBD",21,0 ) | ||||
976 | F L +^RC (348.1):$S ($G(DILOCK TM)>5:DILO CKTM,1:5) Q:$T | ||||
977 | "RTN","RCR JRBD",22,0 ) | ||||
978 | ; | ||||
979 | "RTN","RCR JRBD",23,0 ) | ||||
980 | ; calcul ate the ba se percent ages from past data | ||||
981 | "RTN","RCR JRBD",24,0 ) | ||||
982 | ; exampl e: DATEEN D=2980331 => BEGDAT E=2970300 | ||||
983 | "RTN","RCR JRBD",25,0 ) | ||||
984 | ; => ENDDAT E=2980229 | ||||
985 | "RTN","RCR JRBD",26,0 ) | ||||
986 | ; add o ne day to ending dat e to go to next mont h | ||||
987 | "RTN","RCR JRBD",27,0 ) | ||||
988 | S BEGDATE =($E(DATEE ND,1,3)-1) _$E(DATEEN D,4,5)_"00 " | ||||
989 | "RTN","RCR JRBD",28,0 ) | ||||
990 | S ENDDATE =($$FMADD^ XLFDT($E(D ATEEND,1,5 )_"00",-1) )+1 | ||||
991 | "RTN","RCR JRBD",29,0 ) | ||||
992 | ; loop b ills activ ated betwe en these d ates | ||||
993 | "RTN","RCR JRBD",30,0 ) | ||||
994 | S ACTDATE =BEGDATE | ||||
995 | "RTN","RCR JRBD",31,0 ) | ||||
996 | F S ACTD ATE=$O(^PR CA(430,"AC TDT",ACTDA TE)) Q:'AC TDATE!(ACT DATE>ENDDA TE) D | ||||
997 | "RTN","RCR JRBD",32,0 ) | ||||
998 | . S BILLD A=0 F S B ILLDA=$O(^ PRCA(430," ACTDT",ACT DATE,BILLD A)) Q:'BIL LDA D | ||||
999 | "RTN","RCR JRBD",33,0 ) | ||||
1000 | . . S CAT EGORY=+$P( $G(^PRCA(4 30,BILLDA, 0)),"^",2) | ||||
1001 | "RTN","RCR JRBD",34,0 ) | ||||
1002 | . . ; do not look at prepaym ents | ||||
1003 | "RTN","RCR JRBD",35,0 ) | ||||
1004 | . . I 'CA TEGORY!(CA TEGORY=26) Q | ||||
1005 | "RTN","RCR JRBD",36,0 ) | ||||
1006 | . . ; | ||||
1007 | "RTN","RCR JRBD",37,0 ) | ||||
1008 | . . ; only look at bills w ith a 0 pr inc
|
||||
1009 | al balance | ||||
1010 | "RTN","RCR JRBD",38,0 ) | ||||
1011 | . . I $P( $G(^PRCA(4 30,BILLDA, 7)),"^") Q | ||||
1012 | "RTN","RCR JRBD",39,0 ) | ||||
1013 | . . ; | ||||
1014 | "RTN","RCR JRBD",40,0 ) | ||||
1015 | . . ; on ly report fund 52870 1,03,04,11 and 4032/ 528709 bil ls | ||||
1016 | "RTN","RCR JRBD",41,0 ) | ||||
1017 | . . S FUN D=$$GETFUN DB^RCXFMSU F(BILLDA,1 ) | ||||
1018 | "RTN","RCR JRBD",42,0 ) | ||||
1019 | . . I '$$ PTACCT^PRC AACC(FUND) ,$E(FUND,1 ,4)'=4032 Q | ||||
1020 | "RTN","RCR JRBD",43,0 ) | ||||
1021 | . . ; | ||||
1022 | "RTN","RCR JRBD",44,0 ) | ||||
1023 | . . ; de termine MR A type of bill, give n bill# an d bill act ive date | ||||
1024 | "RTN","RCR JRBD",45,0 ) | ||||
1025 | . . ; DB IA #4385 a ctivated o n 31-Mar-2 004 | ||||
1026 | "RTN","RCR JRBD",46,0 ) | ||||
1027 | . . S MRA TYPE=$$MRA TYPE^IBCEM U2(BILLDA, ACTDATE) | ||||
1028 | "RTN","RCR JRBD",47,0 ) | ||||
1029 | . . ; | ||||
1030 | "RTN","RCR JRBD",48,0 ) | ||||
1031 | . . ; de rive stand ard genera l ledger ( SGL) from cat/fund/M RA type | ||||
1032 | "RTN","RCR JRBD",49,0 ) | ||||
1033 | . . S SGL =$$BDRSGL( CATEGORY,F UND,MRATYP E) | ||||
1034 | "RTN","RCR JRBD",50,0 ) | ||||
1035 | . . ; | ||||
1036 | "RTN","RCR JRBD",51,0 ) | ||||
1037 | . . ; de termine th e original amount of the bill (add incre ase | ||||
1038 | "RTN","RCR JRBD",52,0 ) | ||||
1039 | . . ; ad justments below) | ||||
1040 | "RTN","RCR JRBD",53,0 ) | ||||
1041 | . . S PRI N=$P($G(^P RCA(430,BI LLDA,0))," ^",3) | ||||
1042 | "RTN","RCR JRBD",54,0 ) | ||||
1043 | . . S PAY =0 | ||||
1044 | "RTN","RCR JRBD",55,0 ) | ||||
1045 | . . ; | ||||
1046 | "RTN","RCR JRBD",56,0 ) | ||||
1047 | . . ; ge t the $ tr ansations for bills | ||||
1048 | "RTN","RCR JRBD",57,0 ) | ||||
1049 | . . S TRA NDA=0 | ||||
1050 | "RTN","RCR JRBD",58,0 ) | ||||
1051 | . . F S TRANDA=$O( ^PRCA(433, "C",BILLDA ,TRANDA)) Q:'TRANDA D | ||||
1052 | "RTN","RCR JRBD",59,0 ) | ||||
1053 | . . . S T RANTYPE=$P ($G(^PRCA( 433,TRANDA ,1)),"^",2 ) | ||||
1054 | "RTN","RCR JRBD",60,0 ) | ||||
1055 | . . . I " ^1^2^34^43 ^"'[("^"_T RANTYPE_"^ ") Q | ||||
1056 | "RTN","RCR JRBD",61,0 ) | ||||
1057 | . . . S V ALUE=$$TRA NBAL^RCRJR COT(TRANDA ) I VALUE= "" Q | ||||
1058 | "RTN","RCR JRBD",62,0 ) | ||||
1059 | . . . ; increase a djustments or re-est ablish | ||||
1060 | "RTN","RCR JRBD",63,0 ) | ||||
1061 | . . . I T RANTYPE=1! (TRANTYPE= 43) S PRIN =PRIN+$P(V ALUE,"^") Q | ||||
1062 | "RTN","RCR JRBD",64,0 ) | ||||
1063 | . . . ; payments | ||||
1064 | "RTN","RCR JRBD",65,0 ) | ||||
1065 | . . . I T RANTYPE=2! (TRANTYPE= 34) S PAY= PAY+$P(VAL UE,"^") Q | ||||
1066 | "RTN","RCR JRBD",66,0 ) | ||||
1067 | . . ; | ||||
1068 | "RTN","RCR JRBD",67,0 ) | ||||
1069 | . . ; pa yment cann ot be grea ter than p rinciple | ||||
1070 | "RTN","RCR JRBD",68,0 ) | ||||
1071 | . . I PAY >PRIN S PA Y=PRIN | ||||
1072 | "RTN","RCR JRBD",69,0 ) | ||||
1073 | . . ; | ||||
1074 | "RTN","RCR JRBD",70,0 ) | ||||
1075 | . . ; st ore the da ta | ||||
1076 | "RTN","RCR JRBD",71,0 ) | ||||
1077 | . . S PRI NCPAL(SGL) =$G(PRINCP AL(SGL))+P RIN | ||||
1078 | "RTN","RCR JRBD",72,0 ) | ||||
1079 | . . S PAY MENT(SGL)= $G(PAYMENT (SGL))+PAY | ||||
1080 | "RTN","RCR JRBD",73,0 ) | ||||
1081 | . . ; | ||||
1082 | "RTN","RCR JRBD",74,0 ) | ||||
1083 | ; | ||||
1084 | "RTN","RCR JRBD",75,0 ) | ||||
1085 | ; calcul ate the wr iteoffs fr om 2/0/98 | ||||
1086 | "RTN","RCR JRBD",76,0 ) | ||||
1087 | ; 2/0/98 is when f ms cleared out actua l writeoff s and cont ract adj | ||||
1088 | "RTN","RCR JRBD",77,0 ) | ||||
1089 | K ^XTMP(" PRCABDET") | ||||
1090 | "RTN","RCR JRBD",78,0 ) | ||||
1091 | S ^XTMP(" PRCABDET", 0)=$$FMADD ^XLFDT(DT, 10)_"^"_DT _"^BAD DEB T REPORT A UDIT" | ||||
1092 | "RTN","RCR JRBD",79,0 ) | ||||
1093 | F TRANTYP E=8,9,10,1 1,35 D | ||||
1094 | "RTN","RCR JRBD",80,0 ) | ||||
1095 | . S TRAND ATE=298020 0 | ||||
1096 | "RTN","RCR JRBD",81,0 ) | ||||
1097 | . ; do n ot pick up transacti ons after the end da te | ||||
1098 | "RTN","RCR JRBD",82,0 ) | ||||
1099 | . F S TR ANDATE=$O( ^PRCA(433, "AT",TRANT YPE,TRANDA TE)) Q:'TR ANDATE!($P (TRANDATE, ".")>DATEE ND) D | ||||
1100 | "RTN","RCR JRBD",83,0 ) | ||||
1101 | . . S TRA NDA=0 F S TRANDA=$O (^PRCA(433 ,"AT",TRAN TYPE,TRAND ATE,TRANDA )) Q:'TRAN DA D | ||||
1102 | "RTN","RCR JRBD",84,0 ) | ||||
1103 | . . . ; do not loo k at decre ase adj wh ich are no t contract adj | ||||
1104 | "RTN","RCR JRBD",85,0 ) | ||||
1105 | . . . I T RANTYPE=35 ,'$P($G(^P RCA(433,TR ANDA,8))," ^",8) Q | ||||
1106 | "RTN","RCR JRBD",86,0 ) | ||||
1107 | . . . ; | ||||
1108 | "RTN","RCR JRBD",87,0 ) | ||||
1109 | . . . S B ILLDA=$P($ G(^PRCA(43 3,TRANDA,0 )),"^",2) | ||||
1110 | "RTN","RCR JRBD",88,0 ) | ||||
1111 | . . . I ' BILLDA Q | ||||
1112 | "RTN","RCR JRBD",89,0 ) | ||||
1113 | . . . S C ATEGORY=+$ P($G(^PRCA (430,BILLD A,0)),"^", 2) | ||||
1114 | "RTN","RCR JRBD",90,0 ) | ||||
1115 | . . . ; do not loo k at prepa yments | ||||
1116 | "RTN","RCR JRBD",91,0 ) | ||||
1117 | . . . I ' CATEGORY!( CATEGORY=2 6) Q | ||||
1118 | "RTN","RCR JRBD",92,0 ) | ||||
1119 | . . . ; | ||||
1120 | "RTN","RCR JRBD",93,0 ) | ||||
1121 | . . . ; only repor t fund 528 701,03,04, 11 and 403 2/528709 ( ltc) bills | ||||
1122 | "RTN","RCR JRBD",94,0 ) | ||||
1123 | . . . S F UND=$$GETF UNDB^RCXFM SUF(BILLDA ,1) | ||||
1124 | "RTN","RCR JRBD",95,0 ) | ||||
1125 | . . . I ' $$PTACCT^P RCAACC(FUN D),$E(FUND ,1,4)'=403 2 Q | ||||
1126 | "RTN","RCR JRBD",96,0 ) | ||||
1127 | . . . ; | ||||
1128 | "RTN","RCR JRBD",97,0 ) | ||||
1129 | . . . ; get bill a ctive date | ||||
1130 | "RTN","RCR JRBD",98,0 ) | ||||
1131 | . . . S A RACTDT=+$P ($P($G(^PR CA(430,BIL LDA,6)),"^ ",21),".") | ||||
1132 | "RTN","RCR JRBD",99,0 ) | ||||
1133 | . . . ; determine MRA type o f bill, gi ven bill# and bill a ctive date | ||||
1134 | "RTN","RCR JRBD",100, 0) | ||||
1135 | . . . ; DBIA #4385 activated on 31-Mar -2004 | ||||
1136 | "RTN","RCR JRBD",101, 0) | ||||
1137 | . . . S M RATYPE=$$M RATYPE^IBC EMU2(BILLD A,ARACTDT) | ||||
1138 | "RTN","RCR JRBD",102, 0) | ||||
1139 | . . . ; | ||||
1140 | "RTN","RCR JRBD",103, 0) | ||||
1141 | . . . ; d erive stan dard gener al ledger (SGL) from cat/fund/ MRA type | ||||
1142 | "RTN","RCR JRBD",104, 0) | ||||
1143 | . . . S S GL=$$BDRSG L(CATEGORY ,FUND,MRAT YPE) | ||||
1144 | "RTN","RCR JRBD",105, 0) | ||||
1145 | . . . ; | ||||
1146 | "RTN","RCR JRBD",106, 0) | ||||
1147 | . . . ; get the pr incipal tr ansaction value | ||||
1148 | "RTN","RCR JRBD",107, 0) | ||||
1149 | . . . S R CVALUE=+$P ($$TRANBAL ^RCRJRCOT( TRANDA),"^ ") | ||||
1150 | "RTN","RCR JRBD",108, 0) | ||||
1151 | . . . ; temp varia ble for va lue (used below) | ||||
1152 | "RTN","RCR JRBD",109, 0) | ||||
1153 | . . . S R CPRIN=RCVA LUE | ||||
1154 | "RTN","RCR JRBD",110, 0) | ||||
1155 | . . . ; | ||||
1156 | "RTN","RCR JRBD",111, 0) | ||||
1157 | . . . ; add actual writeoff amount for fiscal ye ar | ||||
1158 | "RTN","RCR JRBD",112, 0) | ||||
1159 | . . . I T RANTYPE'=3 5 S ACTUAL WO(SGL)=$G (ACTUALWO( SGL))+RCVA LUE | ||||
1160 | "RTN","RCR JRBD",113, 0) | ||||
1161 | . . . ; add actual contract adjustment s for fisc al year | ||||
1162 | "RTN","RCR JRBD",114, 0) | ||||
1163 | . . . I T RANTYPE=35 S ACTUALC A(SGL)=$G( ACTUALCA(S GL))+RCVAL UE | ||||
1164 | "RTN","RCR JRBD",115, 0) | ||||
1165 | . . . S R SC=$$CALCR SC^RCXFMSU R(BILLDA) | ||||
1166 | "RTN","RCR JRBD",116, 0) | ||||
1167 | . . . S ^ XTMP("PRCA BDET",BILL DA,CATEGOR Y,FUND,RSC ,SGL,TRAND A,TRANDATE ,TRANTYPE, RCPRIN,RCV ALUE,0,0)= "" | ||||
1168 | "RTN","RCR JRBD",117, 0) | ||||
1169 | ; | ||||
1170 | "RTN","RCR JRBD",118, 0) | ||||
1171 | ; remove all the e ntries fro m the bad debt file | ||||
1172 | "RTN","RCR JRBD",119, 0) | ||||
1173 | D DELETAL L | ||||
1174 | "RTN","RCR JRBD",120, 0) | ||||
1175 | ; | ||||
1176 | "RTN","RCR JRBD",121, 0) | ||||
1177 | ; calcul ate percen tages and store them | ||||
1178 | "RTN","RCR JRBD",122, 0) | ||||
1179 | F SGL=131 9,1319.2,1 319.3,1319 .4,1319.5, 1319.6,133 8,1338.2,1 338.3,1339 ,1339.1,"1 33N","133N .2","133.N 3" D | ||||
1180 | "RTN","RCR JRBD",123, 0) | ||||
1181 | . ; coll ection % | ||||
1182 | "RTN","RCR JRBD",124, 0) | ||||
1183 | . S COLLE CT=0 I $G( PRINCPAL(S GL)) S COL LECT=$J($G (PAYMENT(S GL))/PRINC PAL(SGL)*1 00,0,2) | ||||
1184 | "RTN","RCR JRBD",125, 0) | ||||
1185 | . ; patc h PRCA*4.5 *138: for the first year from when MRA i s activate d at a sit e, there i s no colle ction | ||||
1186 | "RTN","RCR JRBD",126, 0) | ||||
1187 | . ; hist ory for po st-MRA non -Medicare bills(SGL 133N). So, to calcul ate the pe rcentage f or SGL 133 N, the | ||||
1188 | "RTN","RCR JRBD",127, 0) | ||||
1189 | . ; paym ent and th e principa l for SGL 1339 are u sed in the first yea r. | ||||
1190 | "RTN","RCR JRBD",128, 0) | ||||
1191 | . ; over ride the c ollection value for SGL=133N f or the fir st year fr om MRA act ivation. | ||||
1192 | "RTN","RCR JRBD",129, 0) | ||||
1193 | . ;; Re- evaluate t he calc. o f the perc entage for 133N as w ell as 133 9. | ||||
1194 | "RTN","RCR JRBD",130, 0) | ||||
1195 | . ;;I SGL ="133N",$G (PRINCIPAL (1339)) D ; | ||||
1196 | "RTN","RCR JRBD",131, 0) | ||||
1197 | . ;;. N X 1,X2,X,%Y | ||||
1198 | "RTN","RCR JRBD",132, 0) | ||||
1199 | . ;;. ; X2=MRA Act ivation Da te, X1=Tod ay, X=diff in days, %Y=0 inval id dates | ||||
1200 | "RTN","RCR JRBD",133, 0) | ||||
1201 | . ;;. ; DBIA #4385 activated on 31-Mar -2004 | ||||
1202 | "RTN","RCR JRBD",134, 0) | ||||
1203 | . ;;. S X 2=$$MRADTA CT^IBCEMU2 ,X1=$$DT^X LFDT D ^%D TC | ||||
1204 | "RTN","RCR JRBD",135, 0) | ||||
1205 | . ;;. I % Y,X'>364.2 5 S COLLEC T=$J($G(PA YMENT(1339 ))/PRINCPA L(1339)*10 0,0,2) | ||||
1206 | "RTN","RCR JRBD",136, 0) | ||||
1207 | . S DR=". 02////"_+C OLLECT_";" | ||||
1208 | "RTN","RCR JRBD",137, 0) | ||||
1209 | . ; | ||||
1210 | "RTN","RCR JRBD",138, 0) | ||||
1211 | . ; curr ent month receivable (this is built in t he routine | ||||
1212 | "RTN","RCR JRBD",139, 0) | ||||
1213 | . ; RCRJ RCO1 and i s stored i n ^TMP($J, "RCRJRBD", SGL)) | ||||
1214 | "RTN","RCR JRBD",140, 0) | ||||
1215 | . S DR=DR _".07////" _+$G(^TMP( $J,"RCRJRB D",SGL))_" ;" | ||||
1216 | "RTN","RCR JRBD",141, 0) | ||||
1217 | . ; | ||||
1218 | "RTN","RCR JRBD",142, 0) | ||||
1219 | . ; calc ulate allo wance esti mate for 1 319 and 13 38 | ||||
1220 | "RTN","RCR JRBD",143, 0) | ||||
1221 | . ; .08 allowance estimate = (writeoff % * curre nt receiva bles) | ||||
1222 | "RTN","RCR JRBD",144, 0) | ||||
1223 | . ; .09 actual wri teoffs fyt d | ||||
1224 | "RTN","RCR JRBD",145, 0) | ||||
1225 | . I SGL=1 319!(SGL=1 319.2)!(SG L=1319.3)! (SGL=1319. 4)!(SGL=13 19.5)!(SGL =1319.6)!( SGL=1338)! (SGL=1338. 2)!(SGL=13 38.3) D | ||||
1226 | "RTN","RCR JRBD",146, 0) | ||||
1227 | . . S WRI TEOFF=100- COLLECT | ||||
1228 | "RTN","RCR JRBD",147, 0) | ||||
1229 | . . S DR= DR_".03/// /"_WRITEOF F_";" | ||||
1230 | "RTN","RCR JRBD",148, 0) | ||||
1231 | . . S DR= DR_".08/// /"_$J((WRI TEOFF/100) *$G(^TMP($ J,"RCRJRBD ",SGL)),0, 2)_";" | ||||
1232 | "RTN","RCR JRBD",149, 0) | ||||
1233 | . . S DR= DR_".09/// /"_+$G(ACT UALWO(SGL) )_";" | ||||
1234 | "RTN","RCR JRBD",150, 0) | ||||
1235 | . ; calc ulate allo wance esti mate for 1 339 | ||||
1236 | "RTN","RCR JRBD",151, 0) | ||||
1237 | . ; .08 allowance estimate = (contract % * curre nt receiva bles) | ||||
1238 | "RTN","RCR JRBD",152, 0) | ||||
1239 | . ; .09 actual con tract adju stments fy td | ||||
1240 | "RTN","RCR JRBD",153, 0) | ||||
1241 | . I SGL=1 339!(SGL=1 339.1)!(SG L="133N")! (SGL="133N .2")!(SGL= "133N.3") D | ||||
1242 | "RTN","RCR JRBD",154, 0) | ||||
1243 | . . S CON TRACT=100- COLLECT | ||||
1244 | "RTN","RCR JRBD",155, 0) | ||||
1245 | . . S DR= DR_".04/// /"_CONTRAC T_";" | ||||
1246 | "RTN","RCR JRBD",156, 0) | ||||
1247 | . . S DR= DR_".08/// /"_$J((CON TRACT/100) *$G(^TMP($ J,"RCRJRBD ",SGL)),0, 2)_";" | ||||
1248 | "RTN","RCR JRBD",157, 0) | ||||
1249 | . . S DR= DR_".09/// /"_+$G(ACT UALCA(SGL) )_";" | ||||
1250 | "RTN","RCR JRBD",158, 0) | ||||
1251 | . ; | ||||
1252 | "RTN","RCR JRBD",159, 0) | ||||
1253 | . ; set changed lo cally flag to no | ||||
1254 | "RTN","RCR JRBD",160, 0) | ||||
1255 | . S DR=DR _".1////0; " | ||||
1256 | "RTN","RCR JRBD",161, 0) | ||||
1257 | . D STORE (SGL,DR) | ||||
1258 | "RTN","RCR JRBD",162, 0) | ||||
1259 | ; | ||||
1260 | "RTN","RCR JRBD",163, 0) | ||||
1261 | L -^RC(34 8.1) | ||||
1262 | "RTN","RCR JRBD",164, 0) | ||||
1263 | ; | ||||
1264 | "RTN","RCR JRBD",165, 0) | ||||
1265 | ; ; pu t the repo rt in a ma il message (rcrjfmm= 1) | ||||
1266 | "RTN","RCR JRBD",166, 0) | ||||
1267 | ; S RCR JFMM=1 | ||||
1268 | "RTN","RCR JRBD",167, 0) | ||||
1269 | ; S RCR JDATE=DATE END | ||||
1270 | "RTN","RCR JRBD",168, 0) | ||||
1271 | ; D DQ^ RCRJRBDR | ||||
1272 | "RTN","RCR JRBD",169, 0) | ||||
1273 | ; | ||||
1274 | "RTN","RCR JRBD",170, 0) | ||||
1275 | ; transm it the all owances to FMS, and then gener ate the re port. | ||||
1276 | "RTN","RCR JRBD",171, 0) | ||||
1277 | D BADDEBT ^RCXFMSSV( DATEEND) | ||||
1278 | "RTN","RCR JRBD",172, 0) | ||||
1279 | Q | ||||
1280 | "RTN","RCR JRBD",173, 0) | ||||
1281 | ; | ||||
1282 | "RTN","RCR JRBD",174, 0) | ||||
1283 | ; | ||||
1284 | "RTN","RCR JRBD",175, 0) | ||||
1285 | STORE(SGL, DR) ; sto re data fo r Standard Ledger Ac count | ||||
1286 | "RTN","RCR JRBD",176, 0) | ||||
1287 | N D0,DA,D D,DI,DIC,D IE,DINUM,D O,DQ,X,Y | ||||
1288 | "RTN","RCR JRBD",177, 0) | ||||
1289 | S DIC="^R C(348.1,", DIC(0)="L" ,X=SGL,DIC ("DR")=DR | ||||
1290 | "RTN","RCR JRBD",178, 0) | ||||
1291 | D FILE^DI CN | ||||
1292 | "RTN","RCR JRBD",179, 0) | ||||
1293 | Q | ||||
1294 | "RTN","RCR JRBD",180, 0) | ||||
1295 | ; | ||||
1296 | "RTN","RCR JRBD",181, 0) | ||||
1297 | ; | ||||
1298 | "RTN","RCR JRBD",182, 0) | ||||
1299 | DELETALL ; delete a ll the ent ries from the bad de bt file | ||||
1300 | "RTN","RCR JRBD",183, 0) | ||||
1301 | N %,DA,DI C,DIK,X,Y | ||||
1302 | "RTN","RCR JRBD",184, 0) | ||||
1303 | S DIK="^R C(348.1," | ||||
1304 | "RTN","RCR JRBD",185, 0) | ||||
1305 | S DA=0 F S DA=$O(^ RC(348.1,D A)) Q:'DA D ^DIK | ||||
1306 | "RTN","RCR JRBD",186, 0) | ||||
1307 | Q | ||||
1308 | "RTN","RCR JRBD",187, 0) | ||||
1309 | ; | ||||
1310 | "RTN","RCR JRBD",188, 0) | ||||
1311 | ; | ||||
1312 | "RTN","RCR JRBD",189, 0) | ||||
1313 | WD3() ; r eturn the third work day of th e month | ||||
1314 | "RTN","RCR JRBD",190, 0) | ||||
1315 | N J,P,V,X | ||||
1316 | "RTN","RCR JRBD",191, 0) | ||||
1317 | S J=0 F P =$E(DT,1,5 )_"01":1 S V=$$DOW^X LFDT(P,1) I V,V<6,'$ D(^HOLIDAY ("B",P)) S J=J+1 Q:J =3 | ||||
1318 | "RTN","RCR JRBD",192, 0) | ||||
1319 | S X=+$E(P ,6,7) | ||||
1320 | "RTN","RCR JRBD",193, 0) | ||||
1321 | Q X | ||||
1322 | "RTN","RCR JRBD",194, 0) | ||||
1323 | ; | ||||
1324 | "RTN","RCR JRBD",195, 0) | ||||
1325 | ; | ||||
1326 | "RTN","RCR JRBD",196, 0) | ||||
1327 | PREVMONT(F ORDATE) ; return the previous month's da te | ||||
1328 | "RTN","RCR JRBD",197, 0) | ||||
1329 | N PREVDAT E | ||||
1330 | "RTN","RCR JRBD",198, 0) | ||||
1331 | S PREVDAT E=$E(FORDA TE,1,5)-1 | ||||
1332 | "RTN","RCR JRBD",199, 0) | ||||
1333 | I $E(PREV DATE,4,5)= "00" S PRE VDATE=($E( PREVDATE,1 ,3)-1)_12 | ||||
1334 | "RTN","RCR JRBD",200, 0) | ||||
1335 | Q PREVDAT E_"00" | ||||
1336 | "RTN","RCR JRBD",201, 0) | ||||
1337 | ; | ||||
1338 | "RTN","RCR JRBD",202, 0) | ||||
1339 | ; derive standard g eneral led ger (SGL) from categ ory and fu nd | ||||
1340 | "RTN","RCR JRBD",203, 0) | ||||
1341 | SGL(CATEGO RY,FUND) ; | ||||
1342 | "RTN","RCR JRBD",204, 0) | ||||
1343 | I $G(FUND )=528709 Q 1319.2 ;n ew long te rm care fu nd | ||||
1344 | "RTN","RCR JRBD",205, 0) | ||||
1345 | I $E($G(F UND),1,4)= 4032 Q 131 9.2 ; brea kout long term care as a subse t | ||||
1346 | "RTN","RCR JRBD",206, 0) | ||||
1347 | I $G(FUND )=528711&( CAT=6)!(CA T=7) Q 131 9.5 ; bre akout phar macy | ||||
1348 | "RTN","RCR JRBD",207, 0) | ||||
1349 | I $G(FUND )=528711&( CAT=9) Q " 133N.2" ; pharmacy reimburs h ealth ins | ||||
1350 | "RTN","RCR JRBD",208, 0) | ||||
1351 | I $G(FUND )=528711&( CAT=10) Q 1338.2 ; pharmacy t ort feasor | ||||
1352 | "RTN","RCR JRBD",209, 0) | ||||
1353 | I CATEGOR Y=8 Q 1339 ; crime or per. v io. | ||||
1354 | "RTN","RCR JRBD",210, 0) | ||||
1355 | I CATEGOR Y=9 Q 1339 ; reimb ursable he alth insur ance | ||||
1356 | "RTN","RCR JRBD",211, 0) | ||||
1357 | I CATEGOR Y=10 Q 133 8 ; tort feasor | ||||
1358 | "RTN","RCR JRBD",212, 0) | ||||
1359 | I CATEGOR Y=21 Q 133 9 ; medic are | ||||
1360 | "RTN","RCR JRBD",213, 0) | ||||
1361 | I CATEGOR Y=45 Q 133 9.1 ; Fee Basis | ||||
1362 | "RTN","RCR JRBD",214, 0) | ||||
1363 | Q 1319 | ||||
1364 | "RTN","RCR JRBD",215, 0) | ||||
1365 | ; | ||||
1366 | "RTN","RCR JRBD",216, 0) | ||||
1367 | ; | ||||
1368 | "RTN","RCR JRBD",217, 0) | ||||
1369 | BDRSGL(CAT ,FUND,MRAT YPE) ; Cal culate SGL s for the BDR proces s | ||||
1370 | "RTN","RCR JRBD",218, 0) | ||||
1371 | ;PRCA*4.5 *310/DRF A dded fund 528713, No n-VA Reimb ursable In surance | ||||
1372 | "RTN","RCR JRBD",219, 0) | ||||
1373 | ; | ||||
1374 | "RTN","RCR JRBD",220, 0) | ||||
1375 | ; This AP I will be used by bo th the ARD C (routine RCRJRCOC) | ||||
1376 | "RTN","RCR JRBD",221, 0) | ||||
1377 | ; and the BDR estim ate calcul ator to as sociate re ceivables | ||||
1378 | "RTN","RCR JRBD",222, 0) | ||||
1379 | ; with th e correct standard g eneral led ger accoun t (SGL). | ||||
1380 | "RTN","RCR JRBD",223, 0) | ||||
1381 | ; The fol lowing tab le will be implement ed: | ||||
1382 | "RTN","RCR JRBD",224, 0) | ||||
1383 | ; | ||||
1384 | "RTN","RCR JRBD",225, 0) | ||||
1385 | ; Receiva ble Type ( Category) Fun d SGL | ||||
1386 | "RTN","RCR JRBD",226, 0) | ||||
1387 | ;======== ========== ========== ========== ========== == | ||||
1388 | "RTN","RCR JRBD",227, 0) | ||||
1389 | ; Medical Care Co-p ayments 528703 1319 | ||||
1390 | "RTN","RCR JRBD",228, 0) | ||||
1391 | ; (plus Inelig, Em erg./Hum. rec.) | ||||
1392 | "RTN","RCR JRBD",229, 0) | ||||
1393 | ; Long Te rm Care Co -payments 528709 1319.2 | ||||
1394 | "RTN","RCR JRBD",230, 0) | ||||
1395 | ; Medicat ion Co-pay ments 528701 1319.3 | ||||
1396 | "RTN","RCR JRBD",231, 0) | ||||
1397 | ; Crimes of Persona l Violence (8), 528704 1319.4 | ||||
1398 | "RTN","RCR JRBD",232, 0) | ||||
1399 | ; Medica re (21), N o-Fault Au to | ||||
1400 | "RTN","RCR JRBD",233, 0) | ||||
1401 | ; (7), W orkman's C omp (6) | ||||
1402 | "RTN","RCR JRBD",234, 0) | ||||
1403 | ; Tort Fe asor (10) 528704 1338 | ||||
1404 | "RTN","RCR JRBD",235, 0) | ||||
1405 | ; RHI (9) , pre-MRA 528704 1339 | ||||
1406 | "RTN","RCR JRBD",236, 0) | ||||
1407 | ; RHI (9) , post-MRA , MRA rec. 528704 133H | ||||
1408 | "RTN","RCR JRBD",237, 0) | ||||
1409 | ; RHI (9) , post-MRA , non-MRA rec. 528704 133N | ||||
1410 | "RTN","RCR JRBD",238, 0) | ||||
1411 | ; Non-VA RHI Tort F easor 528713 1338.3 | ||||
1412 | "RTN","RCR JRBD",239, 0) | ||||
1413 | ; Non-VA RHI (45), pre-MRA 528713 1339.1 | ||||
1414 | "RTN","RCR JRBD",240, 0) | ||||
1415 | ; Non-VA RHI (45), post-MRA, MRA rec. 528713 133H.2 | ||||
1416 | "RTN","RCR JRBD",241, 0) | ||||
1417 | ; Non-VA RHI (45), post-MRA, non-MRA re c. 528713 133N.3 | ||||
1418 | "RTN","RCR JRBD",242, 0) | ||||
1419 | ; Crimes of Persona l Violence (8), 528713 1319.6 | ||||
1420 | "RTN","RCR JRBD",243, 0) | ||||
1421 | ; Medica re (21), N o-Fault Au to | ||||
1422 | "RTN","RCR JRBD",244, 0) | ||||
1423 | ; (7), W orkman's C omp (6) | ||||
1424 | "RTN","RCR JRBD",245, 0) | ||||
1425 | ; Pharmac y No Fault Auto(7), 528711 1319.5 | ||||
1426 | "RTN","RCR JRBD",246, 0) | ||||
1427 | ; Pharmac y Workman' s Comp(6) | ||||
1428 | "RTN","RCR JRBD",247, 0) | ||||
1429 | ; Pharmac y RHI, non MRA (9) 528711 133N.2 | ||||
1430 | "RTN","RCR JRBD",248, 0) | ||||
1431 | ; Pharmac y Tort Fea sor (10) 528711 1338.2 | ||||
1432 | "RTN","RCR JRBD",249, 0) | ||||
1433 | ; | ||||
1434 | "RTN","RCR JRBD",250, 0) | ||||
1435 | ; Input: CAT -- Pointer t o the rece ivable cat egory in f ile 430.2 | ||||
1436 | "RTN","RCR JRBD",251, 0) | ||||
1437 | ; FUND -- Receivabl e fund cal culated by routine R CXFMSUF | ||||
1438 | "RTN","RCR JRBD",252, 0) | ||||
1439 | ; MR ATYPE -- Indicator of an MRA (2) or no n-MRA (3) receivable | ||||
1440 | "RTN","RCR JRBD",253, 0) | ||||
1441 | ; | ||||
1442 | "RTN","RCR JRBD",254, 0) | ||||
1443 | ; | ||||
1444 | "RTN","RCR JRBD",255, 0) | ||||
1445 | I $G(FUND )=528709 Q 1319.2 | ||||
1446 | "RTN","RCR JRBD",256, 0) | ||||
1447 | I $E($G(F UND),1,4)= 4032 Q 131 9.2 | ||||
1448 | "RTN","RCR JRBD",257, 0) | ||||
1449 | I $G(FUND )=528701 Q 1319.3 | ||||
1450 | "RTN","RCR JRBD",258, 0) | ||||
1451 | I $G(FUND )=528711&( (CAT=6)!(C AT=7)) Q 1 319.5 | ||||
1452 | "RTN","RCR JRBD",259, 0) | ||||
1453 | I $G(FUND )=528711&( CAT=9) Q " 133N.2" | ||||
1454 | "RTN","RCR JRBD",260, 0) | ||||
1455 | I $G(FUND )=528711&( CAT=10) Q 1338.2 | ||||
1456 | "RTN","RCR JRBD",261, 0) | ||||
1457 | I $G(FUND )=528713&( CAT=10) Q 1338.3 | ||||
1458 | "RTN","RCR JRBD",262, 0) | ||||
1459 | I $G(FUND )=528713&( CAT=8!(CAT =21)!(CAT= 6)!(CAT=7) ) Q 1319.6 | ||||
1460 | "RTN","RCR JRBD",263, 0) | ||||
1461 | I CAT=8!( CAT=21)!(C AT=7)!(CAT =6) Q 1319 .4 | ||||
1462 | "RTN","RCR JRBD",264, 0) | ||||
1463 | I CAT=10 Q 1338 | ||||
1464 | "RTN","RCR JRBD",265, 0) | ||||
1465 | I CAT=9 Q $S(MRATYP E=2:"133H" ,MRATYPE=3 :"133N",1: 1339) | ||||
1466 | "RTN","RCR JRBD",266, 0) | ||||
1467 | I CAT=45 Q $S(MRATY PE=2:"133H .2",MRATYP E=3:"133N. 3",1:1339. 1) | ||||
1468 | "RTN","RCR JRBD",267, 0) | ||||
1469 | Q 1319 | ||||
1470 | "RTN","RCR JRBDR") | ||||
1471 | 0^10^B7628 0867^B7582 6184 | ||||
1472 | "RTN","RCR JRBDR",1,0 ) | ||||
1473 | RCRJRBDR ; WISC/RFJ,T JK-bad deb t report g enerator ; 1 Feb 98 | ||||
1474 | "RTN","RCR JRBDR",2,0 ) | ||||
1475 | ;;4.5;Acc ounts Rece ivable;**1 01,139,170 ,191,203,2 15,220,138 ,239,310** ;Mar 20, 1 995;Build 14 | ||||
1476 | "RTN","RCR JRBDR",3,0 ) | ||||
1477 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | ||||
1478 | "RTN","RCR JRBDR",4,0 ) | ||||
1479 | Q | ||||
1480 | "RTN","RCR JRBDR",5,0 ) | ||||
1481 | ; | ||||
1482 | "RTN","RCR JRBDR",6,0 ) | ||||
1483 | ; | ||||
1484 | "RTN","RCR JRBDR",7,0 ) | ||||
1485 | PRINT ; p rint repor t on print er, called from menu option | ||||
1486 | "RTN","RCR JRBDR",8,0 ) | ||||
1487 | N RCRJDAT E | ||||
1488 | "RTN","RCR JRBDR",9,0 ) | ||||
1489 | W !!,"Thi s option w ill print the Bad De bt Report. The Bad Debt allow ance" | ||||
1490 | "RTN","RCR JRBDR",10, 0) | ||||
1491 | W !,"esti mates are computed b y the AR D ata Collec tor at the end of th e" | ||||
1492 | "RTN","RCR JRBDR",11, 0) | ||||
1493 | W !,"acco unting mon th, and se nt to FMS at that ti me. The a llowance" | ||||
1494 | "RTN","RCR JRBDR",12, 0) | ||||
1495 | W !,"esti mate is no longer ed itable pri or to tran smission t o FMS.",! | ||||
1496 | "RTN","RCR JRBDR",13, 0) | ||||
1497 | N %ZIS,PO P,ZTRTN,ZT DESC S %ZI S="QM" D ^ %ZIS Q:POP | ||||
1498 | "RTN","RCR JRBDR",14, 0) | ||||
1499 | I $D(IO(" Q")) D Q | ||||
1500 | "RTN","RCR JRBDR",15, 0) | ||||
1501 | . S ZTRTN ="DQ^RCRJR BDR",ZTDES C="Bad Deb t Report" | ||||
1502 | "RTN","RCR JRBDR",16, 0) | ||||
1503 | . D ^%ZTL OAD | ||||
1504 | "RTN","RCR JRBDR",17, 0) | ||||
1505 | ; | ||||
1506 | "RTN","RCR JRBDR",18, 0) | ||||
1507 | W !,"plea se wait" | ||||
1508 | "RTN","RCR JRBDR",19, 0) | ||||
1509 | D DQ | ||||
1510 | "RTN","RCR JRBDR",20, 0) | ||||
1511 | Q | ||||
1512 | "RTN","RCR JRBDR",21, 0) | ||||
1513 | ; | ||||
1514 | "RTN","RCR JRBDR",22, 0) | ||||
1515 | ; | ||||
1516 | "RTN","RCR JRBDR",23, 0) | ||||
1517 | DQ ; gene rate the r eport | ||||
1518 | "RTN","RCR JRBDR",24, 0) | ||||
1519 | ; rcrjfm m = flag t o put in m ail messag e (if $g(r crjfmm)) ( optional) | ||||
1520 | "RTN","RCR JRBDR",25, 0) | ||||
1521 | ; rcrjda te = date month and year for r eport (opt ional) | ||||
1522 | "RTN","RCR JRBDR",26, 0) | ||||
1523 | ; rcrjfx sv = fms d ocument id number if sent to f ms (option al) | ||||
1524 | "RTN","RCR JRBDR",27, 0) | ||||
1525 | ; (newe d and set by rcxfmss v, label Q ) | ||||
1526 | "RTN","RCR JRBDR",28, 0) | ||||
1527 | ; | ||||
1528 | "RTN","RCR JRBDR",29, 0) | ||||
1529 | N %,%I,CH ANGED,DATA ,DATA1319, DATA1338,D ATA1339,DA TALTC,DATE REPT,ENDDA TE,X | ||||
1530 | "RTN","RCR JRBDR",30, 0) | ||||
1531 | N LINE,RC RJFLAG,SCR EEN,SPACE, Y,DATA133N | ||||
1532 | "RTN","RCR JRBDR",31, 0) | ||||
1533 | ; | ||||
1534 | "RTN","RCR JRBDR",32, 0) | ||||
1535 | K ^TMP($J ,"RCRJRCOR MM") | ||||
1536 | "RTN","RCR JRBDR",33, 0) | ||||
1537 | S SPACE=" ",$P(SPACE ," ",81)=" " | ||||
1538 | "RTN","RCR JRBDR",34, 0) | ||||
1539 | ; the da te of the report is for previo us month i f the DT i s before t he EOAM da te of the current mo nth, it i s for the current mo nth if the date is a fter the E OAM cut-of f date. | ||||
1540 | "RTN","RCR JRBDR",35, 0) | ||||
1541 | I $G(RCRJ DATE) S RC RJDATE=$E( $$LDATE^RC RJR(RCRJDA TE),1,5)_" 00" | ||||
1542 | "RTN","RCR JRBDR",36, 0) | ||||
1543 | I '$G(RCR JDATE) D | ||||
1544 | "RTN","RCR JRBDR",37, 0) | ||||
1545 | .I $E(DT, 6,7)'>$E($ $LDATE^RCR JR(DT),6,7 ) S RCRJDA TE=$$PREVM ONT^RCRJRB D(DT) | ||||
1546 | "RTN","RCR JRBDR",38, 0) | ||||
1547 | .I $E(DT, 6,7)>$E($$ LDATE^RCRJ R(DT),6,7) S RCRJDAT E=$E($$LDA TE^RCRJR(D T),1,5)_"0 0" | ||||
1548 | "RTN","RCR JRBDR",39, 0) | ||||
1549 | S Y=$E(RC RJDATE,1,5 )_"00" D D D^%DT S DA TEREPT=Y | ||||
1550 | "RTN","RCR JRBDR",40, 0) | ||||
1551 | S LINE=0 | ||||
1552 | "RTN","RCR JRBDR",41, 0) | ||||
1553 | ; | ||||
1554 | "RTN","RCR JRBDR",42, 0) | ||||
1555 | ; jump t o RCRJRBDT to genera te the new Bad Debt Report, | ||||
1556 | "RTN","RCR JRBDR",43, 0) | ||||
1557 | ; in ord er to save the code for the ol der report . | ||||
1558 | "RTN","RCR JRBDR",44, 0) | ||||
1559 | D BDR^RCR JRBDT G MA IL | ||||
1560 | "RTN","RCR JRBDR",45, 0) | ||||
1561 | ; | ||||
1562 | "RTN","RCR JRBDR",46, 0) | ||||
1563 | D SETLINE (" ") | ||||
1564 | "RTN","RCR JRBDR",47, 0) | ||||
1565 | D SETLINE ($E(SPACE, 1,32)_"Bad Debt Repo rt") | ||||
1566 | "RTN","RCR JRBDR",48, 0) | ||||
1567 | D SETLINE ($E(SPACE, 1,13)_"All owance for Bad Debt and Contra ct Adjustm ent Report ") | ||||
1568 | "RTN","RCR JRBDR",49, 0) | ||||
1569 | D SETLINE ($E(SPACE, 1,27)_"for the month of "_DATE REPT) | ||||
1570 | "RTN","RCR JRBDR",50, 0) | ||||
1571 | I $D(RCRJ FXSV) D | ||||
1572 | "RTN","RCR JRBDR",51, 0) | ||||
1573 | . D SETLI NE(" ") | ||||
1574 | "RTN","RCR JRBDR",52, 0) | ||||
1575 | . I $E(RC RJFXSV,1,2 )="SV" D S ETLINE($E( SPACE,1,13 )_"***** R eport sent to FMS, d oc id: "_R CRJFXSV_" *****") Q | ||||
1576 | "RTN","RCR JRBDR",53, 0) | ||||
1577 | . ; repo rt errored out or di d not get generated to fms | ||||
1578 | "RTN","RCR JRBDR",54, 0) | ||||
1579 | . D SETLI NE($E(SPAC E,1,10)_"* **** NOTIC E: Report was NOT s ent to FMS , the mess age is *** **") | ||||
1580 | "RTN","RCR JRBDR",55, 0) | ||||
1581 | . D SETLI NE($E(SPAC E,1,10)_"* **** "_RCR JFXSV_" ** ***") | ||||
1582 | "RTN","RCR JRBDR",56, 0) | ||||
1583 | ; | ||||
1584 | "RTN","RCR JRBDR",57, 0) | ||||
1585 | ; show m ccf | ||||
1586 | "RTN","RCR JRBDR",58, 0) | ||||
1587 | ; Add 528 713 PRCA*4 .5*310/DRF | ||||
1588 | "RTN","RCR JRBDR",59, 0) | ||||
1589 | D SETLINE (" ") | ||||
1590 | "RTN","RCR JRBDR",60, 0) | ||||
1591 | D SETLINE ($E(SPACE, 1,26)_"Med ical Care Collection Fund") | ||||
1592 | "RTN","RCR JRBDR",61, 0) | ||||
1593 | I $E($G(R CRJDATE),2 ,5)'<"0410 " D SETLIN E($E(SPACE ,1,26)_" F unds 52870 1, 528703, 528704 & 528713") | ||||
1594 | "RTN","RCR JRBDR",62, 0) | ||||
1595 | I $E($G(R CRJDATE),2 ,5)<"0410" D SETLINE ($E(SPACE, 1,26)_" Fu nds 5287.1 , 5287.3, & 5287.4") | ||||
1596 | "RTN","RCR JRBDR",63, 0) | ||||
1597 | D SETLINE ($E(SPACE, 1,26)_"--- ---------- ---------- -----") | ||||
1598 | "RTN","RCR JRBDR",64, 0) | ||||
1599 | D SETLINE (" ") | ||||
1600 | "RTN","RCR JRBDR",65, 0) | ||||
1601 | D SETLINE ("Calculat ed "_$J(" ",14)_$J( " Third Pa rty",14)_$ J(" Third Party",14) ) | ||||
1602 | "RTN","RCR JRBDR",66, 0) | ||||
1603 | D SETLINE ("Percenta ges "_$J(" First Part y",14)_$J( " Cont Adj",14)_$ J(" Con t Adj",14) _$J("Tort Feasors",1 4)) | ||||
1604 | "RTN","RCR JRBDR",67, 0) | ||||
1605 | D SETLINE ("For "_$J(" SGL 131 9",14)_$J( " SGL 1 339",14)_$ J(" SGL 133N",14) _$J(" S GL 1338",1 4)) | ||||
1606 | "RTN","RCR JRBDR",68, 0) | ||||
1607 | D SETLINE ("-------- ---------- ---"_$J("- ---------- -",14)_$J( "--------- ---",14)_$ J("------- -----",14) _$J("----- -------",1 4)) | ||||
1608 | "RTN","RCR JRBDR",69, 0) | ||||
1609 | S DATA131 9=$G(^RC(3 48.1,+$O(^ RC(348.1," B",1319,0) ),0)) | ||||
1610 | "RTN","RCR JRBDR",70, 0) | ||||
1611 | S DATA133 8=$G(^RC(3 48.1,+$O(^ RC(348.1," B",1338,0) ),0)) | ||||
1612 | "RTN","RCR JRBDR",71, 0) | ||||
1613 | S DATA133 9=$G(^RC(3 48.1,+$O(^ RC(348.1," B",1339,0) ),0)) | ||||
1614 | "RTN","RCR JRBDR",72, 0) | ||||
1615 | S DATA133 N=$G(^RC(3 48.1,+$O(^ RC(348.1," B","133N", 0)),0)) | ||||
1616 | "RTN","RCR JRBDR",73, 0) | ||||
1617 | D SETLINE ("Collecti on %"_$J($P (DATA1319, "^",2),14, 2)_$J($P(D ATA1339,"^ ",2),14,2) _$J($P(DAT A133N,"^", 2),14,2)_$ J($P(DATA1 338,"^",2) ,14,2)) | ||||
1618 | "RTN","RCR JRBDR",74, 0) | ||||
1619 | D SETLINE ("Write-Of f %"_$J($P (DATA1319, "^",3),14, 2)_$J($P(D ATA1339,"^ ",3),14,2) _$J($P(DAT A133N,"^", 3),14,2)_$ J($P(DATA1 338,"^",3) ,14,2)) | ||||
1620 | "RTN","RCR JRBDR",75, 0) | ||||
1621 | D SETLINE ("Contract Adjustmen t %"_$J($P (DATA1319, "^",4),14, 2)_$J($P(D ATA1339,"^ ",4),14,2) _$J($P(DAT A133N,"^", 4),14,2)_$ J($P(DATA1 338,"^",4) ,14,2)) | ||||
1622 | "RTN","RCR JRBDR",76, 0) | ||||
1623 | D SETLINE ("-------- ---------- ---"_$J("- ---------- -",14)_$J( "--------- ---",14)_$ J("------- -----",14) _$J("----- -------",1 4)) | ||||
1624 | "RTN","RCR JRBDR",77, 0) | ||||
1625 | D SETLINE ("TOTAL %"_$J(10 0,14,2)_$J (100,14,2) _$J(100,14 ,2)_$J(100 ,14,2)) | ||||
1626 | "RTN","RCR JRBDR",78, 0) | ||||
1627 | D SETLINE (" ") | ||||
1628 | "RTN","RCR JRBDR",79, 0) | ||||
1629 | ; | ||||
1630 | "RTN","RCR JRBDR",80, 0) | ||||
1631 | S DATALTC =$G(^RC(34 8.1,+$O(^R C(348.1,"B ",1319.2,0 )),0)) | ||||
1632 | "RTN","RCR JRBDR",81, 0) | ||||
1633 | I $E($G(R CRJDATE),2 ,5)'<"0410 " D SETLIN E($E(SPACE ,1,26)_" Extended ( LTC) Care Fund 52870 9") | ||||
1634 | "RTN","RCR JRBDR",82, 0) | ||||
1635 | I $E($G(R CRJDATE),2 ,5)<"0410" D SETLINE ($E(SPACE, 1,26)_" E xtended (L TC) Care F und 4032") | ||||
1636 | "RTN","RCR JRBDR",83, 0) | ||||
1637 | D SETLINE ($E(SPACE, 1,26)_"--- ---------- ---------- ---------- ") | ||||
1638 | "RTN","RCR JRBDR",84, 0) | ||||
1639 | D SETLINE (" ") | ||||
1640 | "RTN","RCR JRBDR",85, 0) | ||||
1641 | I $E($G(R CRJDATE),2 ,5)'<"0410 " D SETLIN E("Calcula ted "_$J(" Fund 52 8709",18)) | ||||
1642 | "RTN","RCR JRBDR",86, 0) | ||||
1643 | I $E($G(R CRJDATE),2 ,5)<"0410" D SETLINE ("Calculat ed "_$J(" Fund 403 2",18)) | ||||
1644 | "RTN","RCR JRBDR",87, 0) | ||||
1645 | D SETLINE ("Percenta ges "_$J(" First Part y",18)) | ||||
1646 | "RTN","RCR JRBDR",88, 0) | ||||
1647 | D SETLINE ("For "_$J(" SGL 131 9",18)) | ||||
1648 | "RTN","RCR JRBDR",89, 0) | ||||
1649 | D SETLINE ("-------- ---------- ---"_$J("- ---------- -",18)) | ||||
1650 | "RTN","RCR JRBDR",90, 0) | ||||
1651 | D SETLINE ("Collecti on %"_$J($P (DATALTC," ^",2),18,2 )) | ||||
1652 | "RTN","RCR JRBDR",91, 0) | ||||
1653 | D SETLINE ("Write-Of f %"_$J($P (DATALTC," ^",3),18,2 )) | ||||
1654 | "RTN","RCR JRBDR",92, 0) | ||||
1655 | D SETLINE ("Contract Adjustmen t %"_$J($P (DATALTC," ^",4),18,2 )) | ||||
1656 | "RTN","RCR JRBDR",93, 0) | ||||
1657 | D SETLINE ("-------- ---------- ---"_$J("- ---------- -",18)) | ||||
1658 | "RTN","RCR JRBDR",94, 0) | ||||
1659 | D SETLINE ("TOTAL %"_$J(10 0,18,2)) | ||||
1660 | "RTN","RCR JRBDR",95, 0) | ||||
1661 | D SETLINE (" ") | ||||
1662 | "RTN","RCR JRBDR",96, 0) | ||||
1663 | ; | ||||
1664 | "RTN","RCR JRBDR",97, 0) | ||||
1665 | ; show t otals | ||||
1666 | "RTN","RCR JRBDR",98, 0) | ||||
1667 | ; 1319 m ccf allowa nce | ||||
1668 | "RTN","RCR JRBDR",99, 0) | ||||
1669 | D SETLINE ("Allowanc e for Bad Debt - Fir st Party ( SGL 1319 M CCF):") | ||||
1670 | "RTN","RCR JRBDR",100 ,0) | ||||
1671 | D SETLINE ("-------- ---------- ---------- ---------- ---------- ----") | ||||
1672 | "RTN","RCR JRBDR",101 ,0) | ||||
1673 | S CHANGED =" " I $P (DATA1319, "^",10) S CHANGED="* *" | ||||
1674 | "RTN","RCR JRBDR",102 ,0) | ||||
1675 | D SETLINE ($E("Allow ance Estim ate for "_ DATEREPT_S PACE,1,35) _":"_$J($P (DATA1319, "^",8),16, 2)_" "_CHA NGED_" (No rmally Cre dit Value) ") | ||||
1676 | "RTN","RCR JRBDR",103 ,0) | ||||
1677 | D SETLINE ($E("Bad D ebt Write- Off (Plus) "_SPACE, 1,35)_":"_ $J($P(DATA 1319,"^",9 ),16,2)_" (Normal ly Debit V alue )") | ||||
1678 | "RTN","RCR JRBDR",104 ,0) | ||||
1679 | D SETLINE ("-------- ---------- ---------- ---------- ---------- ----") | ||||
1680 | "RTN","RCR JRBDR",105 ,0) | ||||
1681 | D SETLINE ($E("Trans mitted Amo unt to FMS for Month "_SPACE,1, 35)_":"_$J ($P(DATA13 19,"^",8)+ $P(DATA131 9,"^",9),1 6,2)_" "_C HANGED_" ( Normally C redit Valu e)") | ||||
1682 | "RTN","RCR JRBDR",106 ,0) | ||||
1683 | I $P(DATA 1319,"^",1 0) D SETLI NE($E(SPAC E,1,53)_"* * Changed Locally") | ||||
1684 | "RTN","RCR JRBDR",107 ,0) | ||||
1685 | D SETLINE (" ") | ||||
1686 | "RTN","RCR JRBDR",108 ,0) | ||||
1687 | ; | ||||
1688 | "RTN","RCR JRBDR",109 ,0) | ||||
1689 | ; 1319 l tc allowan ce | ||||
1690 | "RTN","RCR JRBDR",110 ,0) | ||||
1691 | D SETLINE ("Allowanc e for Bad Debt - Fir st Party ( SGL 1319 L TC 528709) :") | ||||
1692 | "RTN","RCR JRBDR",111 ,0) | ||||
1693 | D SETLINE ("-------- ---------- ---------- ---------- ---------- ----") | ||||
1694 | "RTN","RCR JRBDR",112 ,0) | ||||
1695 | S CHANGED =" " I $P (DATALTC," ^",10) S C HANGED="** " | ||||
1696 | "RTN","RCR JRBDR",113 ,0) | ||||
1697 | D SETLINE ($E("Allow ance Estim ate for "_ DATEREPT_S PACE,1,35) _":"_$J($P (DATALTC," ^",8),16,2 )_" "_CHAN GED_" (Nor mally Cred it Value)" ) | ||||
1698 | "RTN","RCR JRBDR",114 ,0) | ||||
1699 | D SETLINE ($E("Bad D ebt Write- Off (Plus) "_SPACE, 1,35)_":"_ $J($P(DATA LTC,"^",9) ,16,2)_" (Normall y Debit Va lue )") | ||||
1700 | "RTN","RCR JRBDR",115 ,0) | ||||
1701 | D SETLINE ("-------- ---------- ---------- ---------- ---------- ----") | ||||
1702 | "RTN","RCR JRBDR",116 ,0) | ||||
1703 | D SETLINE ($E("Trans mitted Amo unt to FMS for Month "_SPACE,1, 35)_":"_$J ($P(DATALT C,"^",8)+$ P(DATALTC, "^",9),16, 2)_" "_CHA NGED_" (No rmally Cre dit Value) ") | ||||
1704 | "RTN","RCR JRBDR",117 ,0) | ||||
1705 | I $P(DATA LTC,"^",10 ) D SETLIN E($E(SPACE ,1,53)_"** Changed Locally") | ||||
1706 | "RTN","RCR JRBDR",118 ,0) | ||||
1707 | D SETLINE (" ") | ||||
1708 | "RTN","RCR JRBDR",119 ,0) | ||||
1709 | ; | ||||
1710 | "RTN","RCR JRBDR",120 ,0) | ||||
1711 | ; 1339 a llowance | ||||
1712 | "RTN","RCR JRBDR",121 ,0) | ||||
1713 | D SETLINE ("Allowanc e for Cont ract Adj - Third Par ty (SGL 13 39):") | ||||
1714 | "RTN","RCR JRBDR",122 ,0) | ||||
1715 | D SETLINE ("-------- ---------- ---------- ---------- ---------- ----") | ||||
1716 | "RTN","RCR JRBDR",123 ,0) | ||||
1717 | S CHANGED =" " I $P (DATA1339, "^",10) S CHANGED="* *" | ||||
1718 | "RTN","RCR JRBDR",124 ,0) | ||||
1719 | D SETLINE ($E("Allow ance Estim ate for "_ DATEREPT_S PACE,1,35) _":"_$J($P (DATA1339, "^",8),16, 2)_" "_CHA NGED_" (No rmally Cre dit Value) ") | ||||
1720 | "RTN","RCR JRBDR",125 ,0) | ||||
1721 | D SETLINE ($E("Bad D ebt Contra ct Adj (Pl us) "_SPA CE,1,35)_" :"_$J($P(D ATA1339,"^ ",9),16,2) _" (Nor mally Debi t Value )" ) | ||||
1722 | "RTN","RCR JRBDR",126 ,0) | ||||
1723 | D SETLINE ("-------- ---------- ---------- ---------- ---------- ----") | ||||
1724 | "RTN","RCR JRBDR",127 ,0) | ||||
1725 | D SETLINE ($E("Trans mitted Amo unt to FMS for Month "_SPACE,1, 35)_":"_$J ($P(DATA13 39,"^",8)+ $P(DATA133 9,"^",9),1 6,2)_" "_C HANGED_" ( Normally C redit Valu e)") | ||||
1726 | "RTN","RCR JRBDR",128 ,0) | ||||
1727 | I $P(DATA 1339,"^",1 0) D SETLI NE($E(SPAC E,1,53)_"* * Changed Locally") | ||||
1728 | "RTN","RCR JRBDR",129 ,0) | ||||
1729 | D SETLINE (" ") | ||||
1730 | "RTN","RCR JRBDR",130 ,0) | ||||
1731 | ; | ||||
1732 | "RTN","RCR JRBDR",131 ,0) | ||||
1733 | ; 133N a llowance - Post-MRA non-Medica re | ||||
1734 | "RTN","RCR JRBDR",132 ,0) | ||||
1735 | D SETLINE ("Allowanc e for Cont ract Adj - Third Par ty (SGL 13 3N):") | ||||
1736 | "RTN","RCR JRBDR",133 ,0) | ||||
1737 | D SETLINE ("-------- ---------- ---------- ---------- ---------- ----") | ||||
1738 | "RTN","RCR JRBDR",134 ,0) | ||||
1739 | S CHANGED =" " I $P (DATA133N, "^",10) S CHANGED="* *" | ||||
1740 | "RTN","RCR JRBDR",135 ,0) | ||||
1741 | D SETLINE ($E("Allow ance Estim ate for "_ DATEREPT_S PACE,1,35) _":"_$J($P (DATA133N, "^",8),16, 2)_" "_CHA NGED_" (No rmally Cre dit Value) ") | ||||
1742 | "RTN","RCR JRBDR",136 ,0) | ||||
1743 | D SETLINE ($E("Bad D ebt Contra ct Adj (Pl us) "_SPA CE,1,35)_" :"_$J($P(D ATA133N,"^ ",9),16,2) _" (Nor mally Debi t Value )" ) | ||||
1744 | "RTN","RCR JRBDR",137 ,0) | ||||
1745 | D SETLINE ("-------- ---------- ---------- ---------- ---------- ----") | ||||
1746 | "RTN","RCR JRBDR",138 ,0) | ||||
1747 | D SETLINE ($E("Trans mitted Amo unt to FMS for Month "_SPACE,1, 35)_":"_$J ($P(DATA13 3N,"^",8)+ $P(DATA133 N,"^",9),1 6,2)_" "_C HANGED_" ( Normally C redit Valu e)") | ||||
1748 | "RTN","RCR JRBDR",139 ,0) | ||||
1749 | I $P(DATA 133N,"^",1 0) D SETLI NE($E(SPAC E,1,53)_"* * Changed Locally") | ||||
1750 | "RTN","RCR JRBDR",140 ,0) | ||||
1751 | D SETLINE (" ") | ||||
1752 | "RTN","RCR JRBDR",141 ,0) | ||||
1753 | ; | ||||
1754 | "RTN","RCR JRBDR",142 ,0) | ||||
1755 | ; 1338 a llowance | ||||
1756 | "RTN","RCR JRBDR",143 ,0) | ||||
1757 | D SETLINE ("Allowanc e for Bad Debt - Tor t Feasors (SGL 1338) :") | ||||
1758 | "RTN","RCR JRBDR",144 ,0) | ||||
1759 | D SETLINE ("-------- ---------- ---------- ---------- ---------- ----") | ||||
1760 | "RTN","RCR JRBDR",145 ,0) | ||||
1761 | S CHANGED =" " I $P (DATA1338, "^",10) S CHANGED="* *" | ||||
1762 | "RTN","RCR JRBDR",146 ,0) | ||||
1763 | D SETLINE ($E("Allow ance Estim ate for "_ DATEREPT_S PACE,1,35) _":"_$J($P (DATA1338, "^",8),16, 2)_" "_CHA NGED_" (No rmally Cre dit Value) ") | ||||
1764 | "RTN","RCR JRBDR",147 ,0) | ||||
1765 | D SETLINE ($E("Bad D ebt Write- Off (Plus) "_SPACE, 1,35)_":"_ $J($P(DATA 1338,"^",9 ),16,2)_" (Normal ly Debit V alue )") | ||||
1766 | "RTN","RCR JRBDR",148 ,0) | ||||
1767 | D SETLINE ("-------- ---------- ---------- ---------- ---------- ----") | ||||
1768 | "RTN","RCR JRBDR",149 ,0) | ||||
1769 | D SETLINE ($E("Trans mitted Amo unt to FMS for Month "_SPACE,1, 35)_":"_$J ($P(DATA13 38,"^",8)+ $P(DATA133 8,"^",9),1 6,2)_" "_C HANGED_" ( Normally C redit Valu e)") | ||||
1770 | "RTN","RCR JRBDR",150 ,0) | ||||
1771 | I $P(DATA 1338,"^",1 0) D SETLI NE($E(SPAC E,1,53)_"* * Changed Locally") | ||||
1772 | "RTN","RCR JRBDR",151 ,0) | ||||
1773 | D SETLINE (" ") | ||||
1774 | "RTN","RCR JRBDR",152 ,0) | ||||
1775 | D SETLINE ("Report F ootnotes:" ) | ||||
1776 | "RTN","RCR JRBDR",153 ,0) | ||||
1777 | D SETLINE ("-------- ---------" ) | ||||
1778 | "RTN","RCR JRBDR",154 ,0) | ||||
1779 | ; | ||||
1780 | "RTN","RCR JRBDR",155 ,0) | ||||
1781 | D ENDOFRE P^RCRJRBDT | ||||
1782 | "RTN","RCR JRBDR",156 ,0) | ||||
1783 | ; | ||||
1784 | "RTN","RCR JRBDR",157 ,0) | ||||
1785 | MAIL ; pu t report i n mailman | ||||
1786 | "RTN","RCR JRBDR",158 ,0) | ||||
1787 | I $G(RCRJ FMM) D D Q Q | ||||
1788 | "RTN","RCR JRBDR",159 ,0) | ||||
1789 | . N XMY | ||||
1790 | "RTN","RCR JRBDR",160 ,0) | ||||
1791 | . S XMY(" G.RC AR DA TA COLLECT OR")="" | ||||
1792 | "RTN","RCR JRBDR",161 ,0) | ||||
1793 | . S %=$$S ENDMSG^RCR JRCOR("BAD DEBT REPO RT",.XMY) | ||||
1794 | "RTN","RCR JRBDR",162 ,0) | ||||
1795 | ; | ||||
1796 | "RTN","RCR JRBDR",163 ,0) | ||||
1797 | ; print report | ||||
1798 | "RTN","RCR JRBDR",164 ,0) | ||||
1799 | S SCREEN= 0 I '$D(ZT QUEUED),IO =IO(0),$E( IOST)="C" S SCREEN=1 | ||||
1800 | "RTN","RCR JRBDR",165 ,0) | ||||
1801 | U IO I SC REEN W @IO F | ||||
1802 | "RTN","RCR JRBDR",166 ,0) | ||||
1803 | S LINE=1 F S LINE= $O(^TMP($J ,"RCRJRCOR MM",LINE)) Q:'LINE!( $G(RCRJFLA G)) D | ||||
1804 | "RTN","RCR JRBDR",167 ,0) | ||||
1805 | . I $Y>(I OSL-5) D:S CREEN PAUS E^RCRJRTR1 Q:$G(RCRJ FLAG) W @ IOF F %=2: 1:5 W !,^T MP($J,"RCR JRCORMM",% ) | ||||
1806 | "RTN","RCR JRBDR",168 ,0) | ||||
1807 | . W !,^TM P($J,"RCRJ RCORMM",LI NE) | ||||
1808 | "RTN","RCR JRBDR",169 ,0) | ||||
1809 | I '$G(RCR JFLAG),SCR EEN R !!," <end of re port, pres s return t o continue >",X:DTIME | ||||
1810 | "RTN","RCR JRBDR",170 ,0) | ||||
1811 | D ^%ZISC | ||||
1812 | "RTN","RCR JRBDR",171 ,0) | ||||
1813 | ; | ||||
1814 | "RTN","RCR JRBDR",172 ,0) | ||||
1815 | Q K ^TMP($ J,"RCRJRCO RMM") | ||||
1816 | "RTN","RCR JRBDR",173 ,0) | ||||
1817 | Q | ||||
1818 | "RTN","RCR JRBDR",174 ,0) | ||||
1819 | ; | ||||
1820 | "RTN","RCR JRBDR",175 ,0) | ||||
1821 | ; | ||||
1822 | "RTN","RCR JRBDR",176 ,0) | ||||
1823 | SETLINE(DA TA) ; bui ld the lin e for the report | ||||
1824 | "RTN","RCR JRBDR",177 ,0) | ||||
1825 | S LINE=LI NE+1,^TMP( $J,"RCRJRC ORMM",LINE )=DATA | ||||
1826 | "RTN","RCR JRBDR",178 ,0) | ||||
1827 | Q | ||||
1828 | "RTN","RCR JRBDT") | ||||
1829 | 0^8^B57917 736^B55944 684 | ||||
1830 | "RTN","RCR JRBDT",1,0 ) | ||||
1831 | RCRJRBDT ; WISC/RFJ-b ad debt re transmit ; 9/2/10 8:4 7am | ||||
1832 | "RTN","RCR JRBDT",2,0 ) | ||||
1833 | ;;4.5;Acc ounts Rece ivable;**1 01,170,191 ,138,239,2 73,310**;M ar 20, 199 5;Build 14 | ||||
1834 | "RTN","RCR JRBDT",3,0 ) | ||||
1835 | ;Per VA D irective 6 402, this routine sh ould not b e modified . | ||||
1836 | "RTN","RCR JRBDT",4,0 ) | ||||
1837 | ; | ||||
1838 | "RTN","RCR JRBDT",5,0 ) | ||||
1839 | ; | ||||
1840 | "RTN","RCR JRBDT",6,0 ) | ||||
1841 | ; - deact ivate this option wi th patch P RCA*4.5*23 9 | ||||
1842 | "RTN","RCR JRBDT",7,0 ) | ||||
1843 | W !!,"Thi s option m ay no long er be used to retran smit the B ad Debt" | ||||
1844 | "RTN","RCR JRBDT",8,0 ) | ||||
1845 | W !,"allo wance esti mates to F MS." | ||||
1846 | "RTN","RCR JRBDT",9,0 ) | ||||
1847 | W !!,"Ple ase use th e option ' Monthly ND B, SV and WR Regener ate' to" | ||||
1848 | "RTN","RCR JRBDT",10, 0) | ||||
1849 | W !,"reca lculate th e allowanc e estimate s and tran smit them to FMS.",! ! | ||||
1850 | "RTN","RCR JRBDT",11, 0) | ||||
1851 | ; | ||||
1852 | "RTN","RCR JRBDT",12, 0) | ||||
1853 | S DIR(0)= "E" D ^DIR K DIR,DIR UT,DUOUT,D TOUT,DIROU T,X,Y | ||||
1854 | "RTN","RCR JRBDT",13, 0) | ||||
1855 | ; | ||||
1856 | "RTN","RCR JRBDT",14, 0) | ||||
1857 | Q | ||||
1858 | "RTN","RCR JRBDT",15, 0) | ||||
1859 | ; | ||||
1860 | "RTN","RCR JRBDT",16, 0) | ||||
1861 | ; | ||||
1862 | "RTN","RCR JRBDT",17, 0) | ||||
1863 | N DA347,D ATEMOYR,FM SDOCNO,GEC SDATA,RCRJ FSV | ||||
1864 | "RTN","RCR JRBDT",18, 0) | ||||
1865 | ; the da te of the report is for previo us month i f the DT i s before t he EOAM da te of the current mo nth, it i s for the current mo nth if the date is a fter the E OAM cut-of f date. | ||||
1866 | "RTN","RCR JRBDT",19, 0) | ||||
1867 | I $E(DT,6 ,7)'>$E($$ LDATE^RCRJ R(DT),6,7) S DATEMOY R=$$PREVMO NT^RCRJRBD (DT) | ||||
1868 | "RTN","RCR JRBDT",20, 0) | ||||
1869 | I $E(DT,6 ,7)>$E($$L DATE^RCRJR (DT),6,7) S DATEMOYR =$E($$LDAT E^RCRJR(DT ),1,5)_"00 " | ||||
1870 | "RTN","RCR JRBDT",21, 0) | ||||
1871 | ;S DATEMO YR=$$PREVM ONT^RCRJRB D(DT) | ||||
1872 | "RTN","RCR JRBDT",22, 0) | ||||
1873 | W !!,"Thi s option w ill retran smit the B ad Debt do cuments to FMS (SV23 , SV27, SV 2B)." | ||||
1874 | "RTN","RCR JRBDT",23, 0) | ||||
1875 | ; | ||||
1876 | "RTN","RCR JRBDT",24, 0) | ||||
1877 | ;I +$E(DT ,6,7)<$$WD 3^RCRJRBD D Q | ||||
1878 | "RTN","RCR JRBDT",25, 0) | ||||
1879 | I $E(DT,6 ,7)<$E($$L DATE^RCRJR (DT),6,7)! ($E(DT,6,7 )'<$E($$LD AY^RCRJR(D T),6,7)) D Q | ||||
1880 | "RTN","RCR JRBDT",26, 0) | ||||
1881 | . W !,"T he FMS doc uments wil l be autom atically s ent to FMS on the se cond to la st ",!,"wo rkday of t his month. " | ||||
1882 | "RTN","RCR JRBDT",27, 0) | ||||
1883 | ; try an d find SV document t o see if i ts accepte d | ||||
1884 | "RTN","RCR JRBDT",28, 0) | ||||
1885 | S FMSDOCN O="" | ||||
1886 | "RTN","RCR JRBDT",29, 0) | ||||
1887 | K GECSDAT A | ||||
1888 | "RTN","RCR JRBDT",30, 0) | ||||
1889 | S DA347=$ O(^RC(347, "D","SV-"_ $E(DATEMOY R,1,5)_"01 ",0)) | ||||
1890 | "RTN","RCR JRBDT",31, 0) | ||||
1891 | I DA347 S FMSDOCNO= $P($G(^RC( 347,DA347, 0)),"^",9) | ||||
1892 | "RTN","RCR JRBDT",32, 0) | ||||
1893 | ; if the re is an e ntry, find the code sheet in g cs to rebu ild | ||||
1894 | "RTN","RCR JRBDT",33, 0) | ||||
1895 | ; gecsda ta will be the ien f or file 21 00.1 | ||||
1896 | "RTN","RCR JRBDT",34, 0) | ||||
1897 | I FMSDOCN O'="" D DA TA^GECSSGE T(FMSDOCNO ,0) | ||||
1898 | "RTN","RCR JRBDT",35, 0) | ||||
1899 | I $G(GECS DATA) D | ||||
1900 | "RTN","RCR JRBDT",36, 0) | ||||
1901 | . W !!, "The SV do cument has been tran smitted to fms, docu ment numbe r: "_FMSDO CNO | ||||
1902 | "RTN","RCR JRBDT",37, 0) | ||||
1903 | . I $E( $G(GECSDAT A(2100.1,G ECSDATA,3, "E")))="A" D Q | ||||
1904 | "RTN","RCR JRBDT",38, 0) | ||||
1905 | . . W !,"The SV document has been A CCEPTED in FMS and w ill not be resent." | ||||
1906 | "RTN","RCR JRBDT",39, 0) | ||||
1907 | . . S RCRJFSV=1 | ||||
1908 | "RTN","RCR JRBDT",40, 0) | ||||
1909 | . W !," The SV doc ument has NOT been A CCEPTED an d will be RETRANSMIT TED." | ||||
1910 | "RTN","RCR JRBDT",41, 0) | ||||
1911 | I $G(RCRJ FSV) Q | ||||
1912 | "RTN","RCR JRBDT",42, 0) | ||||
1913 | ; | ||||
1914 | "RTN","RCR JRBDT",43, 0) | ||||
1915 | I $$ASKOK AY(DATEMOY R)'=1 Q | ||||
1916 | "RTN","RCR JRBDT",44, 0) | ||||
1917 | ; | ||||
1918 | "RTN","RCR JRBDT",45, 0) | ||||
1919 | ; make s ure this c ode is not executed. | ||||
1920 | "RTN","RCR JRBDT",46, 0) | ||||
1921 | ;W !!,"Re -sending t he documen ts to FMS ..." | ||||
1922 | "RTN","RCR JRBDT",47, 0) | ||||
1923 | ;D BADDEB T^RCXFMSSV | ||||
1924 | "RTN","RCR JRBDT",48, 0) | ||||
1925 | ;W " Done .",!,"The Bad Debt R eport will be sent t o the G.FM S mail gro up." | ||||
1926 | "RTN","RCR JRBDT",49, 0) | ||||
1927 | Q | ||||
1928 | "RTN","RCR JRBDT",50, 0) | ||||
1929 | ; | ||||
1930 | "RTN","RCR JRBDT",51, 0) | ||||
1931 | ; | ||||
1932 | "RTN","RCR JRBDT",52, 0) | ||||
1933 | ASKOKAY(DA TEMOYR) ; ask if it s okay | ||||
1934 | "RTN","RCR JRBDT",53, 0) | ||||
1935 | ; 1 is y es, otherw ise no | ||||
1936 | "RTN","RCR JRBDT",54, 0) | ||||
1937 | N DIR,DIQ 2,DTOUT,DU OUT,X,Y | ||||
1938 | "RTN","RCR JRBDT",55, 0) | ||||
1939 | S Y=DATEM OYR D DD^% DT | ||||
1940 | "RTN","RCR JRBDT",56, 0) | ||||
1941 | S DIR(0)= "YO",DIR(" B")="NO" | ||||
1942 | "RTN","RCR JRBDT",57, 0) | ||||
1943 | S DIR("A" )=" Are y ou SURE yo u want to resend the Bad Debt Report for "_Y | ||||
1944 | "RTN","RCR JRBDT",58, 0) | ||||
1945 | W ! D ^DI R | ||||
1946 | "RTN","RCR JRBDT",59, 0) | ||||
1947 | I $G(DTOU T)!($G(DUO UT)) S Y=- 1 | ||||
1948 | "RTN","RCR JRBDT",60, 0) | ||||
1949 | Q Y | ||||
1950 | "RTN","RCR JRBDT",61, 0) | ||||
1951 | ; | ||||
1952 | "RTN","RCR JRBDT",62, 0) | ||||
1953 | ; | ||||
1954 | "RTN","RCR JRBDT",63, 0) | ||||
1955 | ENDOFREP ; print en d of bad d ebt report footnotes | ||||
1956 | "RTN","RCR JRBDT",64, 0) | ||||
1957 | ; called from rcrj rbdr | ||||
1958 | "RTN","RCR JRBDT",65, 0) | ||||
1959 | ; | ||||
1960 | "RTN","RCR JRBDT",66, 0) | ||||
1961 | ; print footnote | ||||
1962 | "RTN","RCR JRBDT",67, 0) | ||||
1963 | S Y=RCRJD ATE D DD^% DT S ENDDA TE=Y | ||||
1964 | "RTN","RCR JRBDT",68, 0) | ||||
1965 | F %=1:1 S DATA=$P($ T(FOOTNOTE +%),";",3, 99) Q:DATA ="" D | ||||
1966 | "RTN","RCR JRBDT",69, 0) | ||||
1967 | . I DAT A["DATEREP T" S DATA= $P(DATA,"D ATEREPT")_ DATEREPT_$ P(DATA,"DA TEREPT",2) | ||||
1968 | "RTN","RCR JRBDT",70, 0) | ||||
1969 | . I DAT A["ENDDATE " S DATA=$ P(DATA,"EN DDATE")_EN DDATE_$P(D ATA,"ENDDA TE",2) | ||||
1970 | "RTN","RCR JRBDT",71, 0) | ||||
1971 | . D SET LINE^RCRJR BDR(DATA) | ||||
1972 | "RTN","RCR JRBDT",72, 0) | ||||
1973 | Q | ||||
1974 | "RTN","RCR JRBDT",73, 0) | ||||
1975 | ; | ||||
1976 | "RTN","RCR JRBDT",74, 0) | ||||
1977 | ; | ||||
1978 | "RTN","RCR JRBDT",75, 0) | ||||
1979 | FOOTNOTE ; report f ootnotes ( from rcrjr bdr) | ||||
1980 | "RTN","RCR JRBDT",76, 0) | ||||
1981 | ;;(1) Cal culated Pe rcentages and the Al lowance fo r Contract Adj - Thi rd Party | ||||
1982 | "RTN","RCR JRBDT",77, 0) | ||||
1983 | ;; for SGL 1339 are based on bills c reated pri or to the activation of the | ||||
1984 | "RTN","RCR JRBDT",78, 0) | ||||
1985 | ;; Med icare Remi ttance Adv ice softwa re. Over time, ther e will no longer be | ||||
1986 | "RTN","RCR JRBDT",79, 0) | ||||
1987 | ;; any bills in this categ ory. | ||||
1988 | "RTN","RCR JRBDT",80, 0) | ||||
1989 | ;; | ||||
1990 | "RTN","RCR JRBDT",81, 0) | ||||
1991 | ;;(2) Cal culated Pe rcentages and the Al lowance fo r Contract Adj - Thi rd Party | ||||
1992 | "RTN","RCR JRBDT",82, 0) | ||||
1993 | ;; for SGL 133N are based on non-Med icare WNR bills crea ted after the | ||||
1994 | "RTN","RCR JRBDT",83, 0) | ||||
1995 | ;; act ivation of the Medic are Remitt ance Advic e software . | ||||
1996 | "RTN","RCR JRBDT",84, 0) | ||||
1997 | ;; | ||||
1998 | "RTN","RCR JRBDT",85, 0) | ||||
1999 | ;;(3) The "Allowanc e Estimate for DATER EPT" is th e dollar v alue estim ated | ||||
2000 | "RTN","RCR JRBDT",86, 0) | ||||
2001 | ;; as the Allowa nce for Ba d Debt or Contract A djustment for the mo nth. | ||||
2002 | "RTN","RCR JRBDT",87, 0) | ||||
2003 | ;; | ||||
2004 | "RTN","RCR JRBDT",88, 0) | ||||
2005 | ;;(4) The "Bad Debt Write-Off (Plus)" i s the actu al write-o ffs or con tract | ||||
2006 | "RTN","RCR JRBDT",89, 0) | ||||
2007 | ;; adj ustments a ccomplishe d from FEB 1,1998 th ru ENDDATE . | ||||
2008 | "RTN","RCR JRBDT",90, 0) | ||||
2009 | ;; | ||||
2010 | "RTN","RCR JRBDT",91, 0) | ||||
2011 | ;;(5) The "Transmit ted Amount to FMS fo r Month" i s the sum of (3) and (4). | ||||
2012 | "RTN","RCR JRBDT",92, 0) | ||||
2013 | ;; The transmitt ed dollar value is n ormally a credit val ue. | ||||
2014 | "RTN","RCR JRBDT",93, 0) | ||||
2015 | ;; | ||||
2016 | "RTN","RCR JRBDT",94, 0) | ||||
2017 | ;;(6) Fac ilities ar e responsi ble for re porting mo nthly accr ued unbill ed | ||||
2018 | "RTN","RCR JRBDT",95, 0) | ||||
2019 | ;; amo unts. Whe n such amo unts are i dentified and report ed, a port ion of | ||||
2020 | "RTN","RCR JRBDT",96, 0) | ||||
2021 | ;; tho se dollars should be reported as uncolle ctable. T he estimat ed | ||||
2022 | "RTN","RCR JRBDT",97, 0) | ||||
2023 | ;; unc ollectable value of the unbill ed amounts should be included as part | ||||
2024 | "RTN","RCR JRBDT",98, 0) | ||||
2025 | ;; of the facili ty's month ly allowan ce for bad debt or c ontract ad justments. | ||||
2026 | "RTN","RCR JRBDT",99, 0) | ||||
2027 | ;; The AR Overri de Option should be used to ad just the v alue provi ded to | ||||
2028 | "RTN","RCR JRBDT",100 ,0) | ||||
2029 | ;; rep ort the es timated un collectabl e accrued unbilled a mounts for the | ||||
2030 | "RTN","RCR JRBDT",101 ,0) | ||||
2031 | ;; mon th. Facil ities may wish to co nsider usi ng the all owance per centages | ||||
2032 | "RTN","RCR JRBDT",102 ,0) | ||||
2033 | ;; pro vided with this repo rt, if no other mean s of deter mining the | ||||
2034 | "RTN","RCR JRBDT",103 ,0) | ||||
2035 | ;; est imated all owance for the accru ed unbille d amount i s acceptab le. | ||||
2036 | "RTN","RCR JRBDT",104 ,0) | ||||
2037 | ;; | ||||
2038 | "RTN","RCR JRBDT",105 ,0) | ||||
2039 | ;;(7) Onl y members in the fac ility's lo cal RC AR DATA COLLE CTOR mail group | ||||
2040 | "RTN","RCR JRBDT",106 ,0) | ||||
2041 | ;; wil l receive this repor t. | ||||
2042 | "RTN","RCR JRBDT",107 ,0) | ||||
2043 | ; | ||||
2044 | "RTN","RCR JRBDT",108 ,0) | ||||
2045 | ; | ||||
2046 | "RTN","RCR JRBDT",109 ,0) | ||||
2047 | ; | ||||
2048 | "RTN","RCR JRBDT",110 ,0) | ||||
2049 | BDR ; Comp ile new Ba d Debt Rep ort. | ||||
2050 | "RTN","RCR JRBDT",111 ,0) | ||||
2051 | ; This code will be used to compile t he new Bad Debt Repo rt. | ||||
2052 | "RTN","RCR JRBDT",112 ,0) | ||||
2053 | ; This routine is invokved by routine RCRJRBDR when the B ad | ||||
2054 | "RTN","RCR JRBDT",113 ,0) | ||||
2055 | ; Debt Report nee ds to be p rinted. | ||||
2056 | "RTN","RCR JRBDT",114 ,0) | ||||
2057 | ; | ||||
2058 | "RTN","RCR JRBDT",115 ,0) | ||||
2059 | ; Var iable inpu t: LINE -- set to 0 | ||||
2060 | "RTN","RCR JRBDT",116 ,0) | ||||
2061 | ; SPACE -- set to 81 space characters | ||||
2062 | "RTN","RCR JRBDT",117 ,0) | ||||
2063 | ; DATEREPT -- format ted month and year | ||||
2064 | "RTN","RCR JRBDT",118 ,0) | ||||
2065 | ; | ||||
2066 | "RTN","RCR JRBDT",119 ,0) | ||||
2067 | N RCARR,R CX,RCD,RCD ATA,RCREC, X | ||||
2068 | "RTN","RCR JRBDT",120 ,0) | ||||
2069 | D SETLINE (" ") | ||||
2070 | "RTN","RCR JRBDT",121 ,0) | ||||
2071 | D SETLINE ($E(SPACE, 1,32)_"Bad Debt Repo rt") | ||||
2072 | "RTN","RCR JRBDT",122 ,0) | ||||
2073 | D SETLINE ($E(SPACE, 1,13)_"All owance for Bad Debt and Contra ct Adjustm ent Report ") | ||||
2074 | "RTN","RCR JRBDT",123 ,0) | ||||
2075 | D SETLINE ($E(SPACE, 1,27)_"for the month of "_DATE REPT) | ||||
2076 | "RTN","RCR JRBDT",124 ,0) | ||||
2077 | I $D(RCRJ FXSV) D | ||||
2078 | "RTN","RCR JRBDT",125 ,0) | ||||
2079 | . D SETLI NE(" ") | ||||
2080 | "RTN","RCR JRBDT",126 ,0) | ||||
2081 | . I $E(RC RJFXSV,1,2 )="SV" D S ETLINE($E( SPACE,1,13 )_"***** R eport sent to FMS, d oc id: "_R CRJFXSV_" *****") Q | ||||
2082 | "RTN","RCR JRBDT",127 ,0) | ||||
2083 | . ; repo rt errored out or di d not get generated to fms | ||||
2084 | "RTN","RCR JRBDT",128 ,0) | ||||
2085 | . D SETLI NE($E(SPAC E,1,10)_"* **** NOTIC E: Report was NOT s ent to FMS , the mess age is *** **") | ||||
2086 | "RTN","RCR JRBDT",129 ,0) | ||||
2087 | . D SETLI NE($E(SPAC E,1,10)_"* **** "_RCR JFXSV_" ** ***") | ||||
2088 | "RTN","RCR JRBDT",130 ,0) | ||||
2089 | ; | ||||
2090 | "RTN","RCR JRBDT",131 ,0) | ||||
2091 | ; show m ccf | ||||
2092 | "RTN","RCR JRBDT",132 ,0) | ||||
2093 | ; PRCA*4. 5*310/DRF - add fee basis fund (528713) to report | ||||
2094 | "RTN","RCR JRBDT",133 ,0) | ||||
2095 | D SETLINE (" ") | ||||
2096 | "RTN","RCR JRBDT",134 ,0) | ||||
2097 | D SETLINE ($E(SPACE, 1,26)_"Med ical Care Collection Fund") | ||||
2098 | "RTN","RCR JRBDT",135 ,0) | ||||
2099 | D SETLINE ($E(SPACE, 1,20)_" Fu nds 528701 ; 528703; 528704; 52 8709; 5287 11; and 52 8713") | ||||
2100 | "RTN","RCR JRBDT",136 ,0) | ||||
2101 | D SETLINE ($E(SPACE, 1,26)_"--- ---------- ---------- -----") | ||||
2102 | "RTN","RCR JRBDT",137 ,0) | ||||
2103 | D SETLINE (" ") | ||||
2104 | "RTN","RCR JRBDT",138 ,0) | ||||
2105 | D SETLINE (" ") | ||||
2106 | "RTN","RCR JRBDT",139 ,0) | ||||
2107 | D SETLINE ($E(SPACE, 1,57)_"Con tract EOM" ) | ||||
2108 | "RTN","RCR JRBDT",140 ,0) | ||||
2109 | D SETLINE ("FUND - S GL Account Colle ction% Write-Off % Adju stment% Allowanc e") | ||||
2110 | "RTN","RCR JRBDT",141 ,0) | ||||
2111 | D SETLINE (" ") | ||||
2112 | "RTN","RCR JRBDT",142 ,0) | ||||
2113 | ; | ||||
2114 | "RTN","RCR JRBDT",143 ,0) | ||||
2115 | ; List th e fund/SGL s as: | ||||
2116 | "RTN","RCR JRBDT",144 ,0) | ||||
2117 | ; Order SGL i n file Fund - S GL on repo rt | ||||
2118 | "RTN","RCR JRBDT",145 ,0) | ||||
2119 | ; ===== ========== ========== ========== ========== == | ||||
2120 | "RTN","RCR JRBDT",146 ,0) | ||||
2121 | ; 1 1319.3 5 28701 - 13 19 | ||||
2122 | "RTN","RCR JRBDT",147 ,0) | ||||
2123 | ; 2 1319 5 28703 - 13 19 | ||||
2124 | "RTN","RCR JRBDT",148 ,0) | ||||
2125 | ; 3 1319.4 5 28704 - 13 19 | ||||
2126 | "RTN","RCR JRBDT",149 ,0) | ||||
2127 | ; 4 1339 5 28704 - 13 39 | ||||
2128 | "RTN","RCR JRBDT",150 ,0) | ||||
2129 | ; 5 133N 5 28704 - 13 3N | ||||
2130 | "RTN","RCR JRBDT",151 ,0) | ||||
2131 | ; 6 1338 5 28704 - 13 38 | ||||
2132 | "RTN","RCR JRBDT",152 ,0) | ||||
2133 | ; 7 1319.2 5 28709 - 13 19 | ||||
2134 | "RTN","RCR JRBDT",153 ,0) | ||||
2135 | ; 8 1319.5 5 28711 - 13 19 | ||||
2136 | "RTN","RCR JRBDT",154 ,0) | ||||
2137 | ; 9 133N.2 5 28711 - 13 3N | ||||
2138 | "RTN","RCR JRBDT",155 ,0) | ||||
2139 | ; 10 1338.2 5 28711 - 13 38 | ||||
2140 | "RTN","RCR JRBDT",156 ,0) | ||||
2141 | ; 11 1319.6 5 28713 - 13 19 | ||||
2142 | "RTN","RCR JRBDT",157 ,0) | ||||
2143 | ; 12 1339.1 5 28713 - 13 39 | ||||
2144 | "RTN","RCR JRBDT",158 ,0) | ||||
2145 | ; 13 133N.3 5 28713 - 13 3N | ||||
2146 | "RTN","RCR JRBDT",159 ,0) | ||||
2147 | ; 14 1338.3 5 28713 - 13 38 | ||||
2148 | "RTN","RCR JRBDT",160 ,0) | ||||
2149 | ; | ||||
2150 | "RTN","RCR JRBDT",161 ,0) | ||||
2151 | S RCARR(1 )="1319.3^ 528701 - 1 319" | ||||
2152 | "RTN","RCR JRBDT",162 ,0) | ||||
2153 | S RCARR(2 )="1319^52 8703 - 131 9" | ||||
2154 | "RTN","RCR JRBDT",163 ,0) | ||||
2155 | S RCARR(3 )="1319.4^ 528704 - 1 319" | ||||
2156 | "RTN","RCR JRBDT",164 ,0) | ||||
2157 | S RCARR(4 )="1339^52 8704 - 133 9" | ||||
2158 | "RTN","RCR JRBDT",165 ,0) | ||||
2159 | S RCARR(5 )="133N^52 8704 - 133 N" | ||||
2160 | "RTN","RCR JRBDT",166 ,0) | ||||
2161 | S RCARR(6 )="1338^52 8704 - 133 8" | ||||
2162 | "RTN","RCR JRBDT",167 ,0) | ||||
2163 | S RCARR(7 )="1319.2^ 528709 - 1 319" | ||||
2164 | "RTN","RCR JRBDT",168 ,0) | ||||
2165 | S RCARR(8 )="1319.5^ 528711 - 1 319" | ||||
2166 | "RTN","RCR JRBDT",169 ,0) | ||||
2167 | S RCARR(9 )="133N.2^ 528711 - 1 33N" | ||||
2168 | "RTN","RCR JRBDT",170 ,0) | ||||
2169 | S RCARR(1 0)="1338.2 ^528711 - 1338" | ||||
2170 | "RTN","RCR JRBDT",171 ,0) | ||||
2171 | S RCARR(1 1)="1319.6 ^528713 - 1319" | ||||
2172 | "RTN","RCR JRBDT",172 ,0) | ||||
2173 | S RCARR(1 2)="1339.1 ^528713 - 1339" | ||||
2174 | "RTN","RCR JRBDT",173 ,0) | ||||
2175 | S RCARR(1 3)="133N.3 ^528713 - 133N" | ||||
2176 | "RTN","RCR JRBDT",174 ,0) | ||||
2177 | S RCARR(1 4)="1338.3 ^528713 - 1338" | ||||
2178 | "RTN","RCR JRBDT",175 ,0) | ||||
2179 | ; | ||||
2180 | "RTN","RCR JRBDT",176 ,0) | ||||
2181 | S RCX="" F S RCX=$ O(RCARR(RC X)) Q:RCX= "" S RCD= RCARR(RCX) D | ||||
2182 | "RTN","RCR JRBDT",177 ,0) | ||||
2183 | .S RCDATA =$G(^RC(34 8.1,+$O(^R C(348.1,"B ",$P(RCD," ^"),0)),0) ) | ||||
2184 | "RTN","RCR JRBDT",178 ,0) | ||||
2185 | .Q:RCDATA ="" | ||||
2186 | "RTN","RCR JRBDT",179 ,0) | ||||
2187 | .S RCREC= $P(RCD,"^" ,2)_$J($P( RCDATA,"^" ,2),21,2) | ||||
2188 | "RTN","RCR JRBDT",180 ,0) | ||||
2189 | .S RCREC= RCREC_$J($ P(RCDATA," ^",3),15,2 ) | ||||
2190 | "RTN","RCR JRBDT",181 ,0) | ||||
2191 | .S RCREC= RCREC_$J($ P(RCDATA," ^",4),16,2 ) | ||||
2192 | "RTN","RCR JRBDT",182 ,0) | ||||
2193 | .S X=+$P( RCDATA,"^" ,8) | ||||
2194 | "RTN","RCR JRBDT",183 ,0) | ||||
2195 | .S X=$FN( X,",")_$S( X[".":"",1 :".")_$E(" 00",$L($P( X,".",2))+ 1,2) | ||||
2196 | "RTN","RCR JRBDT",184 ,0) | ||||
2197 | .S RCREC= RCREC_$J(X ,14) | ||||
2198 | "RTN","RCR JRBDT",185 ,0) | ||||
2199 | .D SETLIN E(RCREC) | ||||
2200 | "RTN","RCR JRBDT",186 ,0) | ||||
2201 | ; | ||||
2202 | "RTN","RCR JRBDT",187 ,0) | ||||
2203 | D SETLINE (" ") | ||||
2204 | "RTN","RCR JRBDT",188 ,0) | ||||
2205 | D SETLINE (" ") | ||||
2206 | "RTN","RCR JRBDT",189 ,0) | ||||
2207 | D SETLINE ("SGL Defi nitions") | ||||
2208 | "RTN","RCR JRBDT",190 ,0) | ||||
2209 | D SETLINE (" ") | ||||
2210 | "RTN","RCR JRBDT",191 ,0) | ||||
2211 | D SETLINE ("1319 - A llowance f or Bad Deb t") | ||||
2212 | "RTN","RCR JRBDT",192 ,0) | ||||
2213 | D SETLINE ("1338 - A llowance f or Tort Fe asors") | ||||
2214 | "RTN","RCR JRBDT",193 ,0) | ||||
2215 | D SETLINE ("1339 - A llowance f or Contrac t Adjustme nts pre-MR A (Medicar e Remittan ce Advice) ") | ||||
2216 | "RTN","RCR JRBDT",194 ,0) | ||||
2217 | D SETLINE ("133N - A llowance f or Contrac t Adjustme nts post-M RA") | ||||
2218 | "RTN","RCR JRBDT",195 ,0) | ||||
2219 | D SETLINE (" ") | ||||
2220 | "RTN","RCR JRBDT",196 ,0) | ||||
2221 | D SETLINE (" ") | ||||
2222 | "RTN","RCR JRBDT",197 ,0) | ||||
2223 | D SETLINE ("Only mem bers in th e facility 's local R C AR DATA COLLECTOR mail group ") | ||||
2224 | "RTN","RCR JRBDT",198 ,0) | ||||
2225 | D SETLINE ("will rec eive this report.") | ||||
2226 | "RTN","RCR JRBDT",199 ,0) | ||||
2227 | Q | ||||
2228 | "RTN","RCR JRBDT",200 ,0) | ||||
2229 | ; | ||||
2230 | "RTN","RCR JRBDT",201 ,0) | ||||
2231 | SETLINE(DA TA) ; bui ld the lin e for the report | ||||
2232 | "RTN","RCR JRBDT",202 ,0) | ||||
2233 | S LINE=LI NE+1,^TMP( $J,"RCRJRC ORMM",LINE )=DATA | ||||
2234 | "RTN","RCR JRBDT",203 ,0) | ||||
2235 | Q | ||||
2236 | "RTN","RCR JRDEP") | ||||
2237 | 0^4^B64337 684^B57617 465 | ||||
2238 | "RTN","RCR JRDEP",1,0 ) | ||||
2239 | RCRJRDEP ; WISC/RFJ-D eposit Rec onciliatio n Report ; 9/7/10 8:1 9am | ||||
2240 | "RTN","RCR JRDEP",2,0 ) | ||||
2241 | ;;4.5;Acc ounts Rece ivable;**1 01,114,203 ,220,273,3 10**;Mar 2 0, 1995;Bu ild 14 | ||||
2242 | "RTN","RCR JRDEP",3,0 ) | ||||
2243 | ;Per VA D irective 6 402, this routine sh ould not b e modified . | ||||
2244 | "RTN","RCR JRDEP",4,0 ) | ||||
2245 | ; | ||||
2246 | "RTN","RCR JRDEP",5,0 ) | ||||
2247 | W !!,"Thi s option w ill print the Deposi t Reconcil iation Rep ort. The report wil l" | ||||
2248 | "RTN","RCR JRDEP",6,0 ) | ||||
2249 | W !,"disp lay the da ta on the code sheet s sent to FMS on the CR docume nt. Only" | ||||
2250 | "RTN","RCR JRDEP",7,0 ) | ||||
2251 | W !,"depo sits proce ssed after patch PRC A*4.5*90 w as install ed can be displayed. " | ||||
2252 | "RTN","RCR JRDEP",8,0 ) | ||||
2253 | W !,"Sele ct the sta rting and ending FMS Document Number wit hout the s tation" | ||||
2254 | "RTN","RCR JRDEP",9,0 ) | ||||
2255 | W !,"numb er, exampl e: K8A0346 ." | ||||
2256 | "RTN","RCR JRDEP",10, 0) | ||||
2257 | ; | ||||
2258 | "RTN","RCR JRDEP",11, 0) | ||||
2259 | N DEFAULT ,RCRJEND,R CRJFXIT,RC RJSTRT,RCR JSUMM,X | ||||
2260 | "RTN","RCR JRDEP",12, 0) | ||||
2261 | ; | ||||
2262 | "RTN","RCR JRDEP",13, 0) | ||||
2263 | F D Q:$ G(RCRJFXIT ) | ||||
2264 | "RTN","RCR JRDEP",14, 0) | ||||
2265 | . R !!,"S TART WITH CR DOCUMEN T: FIRST// ",X:DTIME | ||||
2266 | "RTN","RCR JRDEP",15, 0) | ||||
2267 | . I X["^" S RCRJFXI T=2 Q | ||||
2268 | "RTN","RCR JRDEP",16, 0) | ||||
2269 | . I $L(X) ,$L(X)'=7 W !?5,"The CR DOCUME NT should be 7 chara cters in l ength (exa mple: K8A0 804)." Q | ||||
2270 | "RTN","RCR JRDEP",17, 0) | ||||
2271 | . S RCRJS TRT=$TR(X, "abcdefghi jklmnopqrs tuvwxyz"," ABCDEFGHIJ KLMNOPQRST UVWXYZ") | ||||
2272 | "RTN","RCR JRDEP",18, 0) | ||||
2273 | . ; | ||||
2274 | "RTN","RCR JRDEP",19, 0) | ||||
2275 | . S DEFAU LT=$S(RCRJ STRT="":" LAST",1:RC RJSTRT) | ||||
2276 | "RTN","RCR JRDEP",20, 0) | ||||
2277 | . W !," END WITH C R DOCUMENT : ",DEFAUL T,"// " R X:DTIME | ||||
2278 | "RTN","RCR JRDEP",21, 0) | ||||
2279 | . I X["^" S RCRJFXI T=2 Q | ||||
2280 | "RTN","RCR JRDEP",22, 0) | ||||
2281 | . S RCRJE ND=$TR(X," abcdefghij klmnopqrst uvwxyz","A BCDEFGHIJK LMNOPQRSTU VWXYZ") | ||||
2282 | "RTN","RCR JRDEP",23, 0) | ||||
2283 | . I X="LA ST" S (RCR JEND,X)="z zzzzzz" | ||||
2284 | "RTN","RCR JRDEP",24, 0) | ||||
2285 | . I $L(X) ,$L(X)'=7 W !?5,"The CR DOCUME NT should be 7 chara cters in l ength (exa mple: K8A0 804)." Q | ||||
2286 | "RTN","RCR JRDEP",25, 0) | ||||
2287 | . I X="" S RCRJEND= $S(DEFAULT =" LAST":" zzzzzzz",1 :DEFAULT) | ||||
2288 | "RTN","RCR JRDEP",26, 0) | ||||
2289 | . I RCRJE ND'=RCRJST RT,RCRJEND ']RCRJSTRT W !?5,"Th e END CR D OCUMENT sh ould be af ter (in se quence) th e start do cument." Q | ||||
2290 | "RTN","RCR JRDEP",27, 0) | ||||
2291 | . S RCRJF XIT=1 | ||||
2292 | "RTN","RCR JRDEP",28, 0) | ||||
2293 | I RCRJFXI T=2 Q | ||||
2294 | "RTN","RCR JRDEP",29, 0) | ||||
2295 | ; | ||||
2296 | "RTN","RCR JRDEP",30, 0) | ||||
2297 | S RCRJSUM M=$$SUMMAR Y^RCRJRTRA I 'RCRJSU MM Q | ||||
2298 | "RTN","RCR JRDEP",31, 0) | ||||
2299 | ; | ||||
2300 | "RTN","RCR JRDEP",32, 0) | ||||
2301 | ; select device | ||||
2302 | "RTN","RCR JRDEP",33, 0) | ||||
2303 | W ! S %ZI S="Q" D ^% ZIS Q:POP | ||||
2304 | "RTN","RCR JRDEP",34, 0) | ||||
2305 | I $D(IO(" Q")) D D ^%ZTLOAD K IO("Q"),Z TSK Q | ||||
2306 | "RTN","RCR JRDEP",35, 0) | ||||
2307 | . S ZTDES C="Deposit Reconcili ation Repo rt",ZTRTN= "DQ^RCRJRD EP" | ||||
2308 | "RTN","RCR JRDEP",36, 0) | ||||
2309 | . S ZTSAV E("RCRJ*") ="",ZTSAVE ("ZTREQ")= "@" | ||||
2310 | "RTN","RCR JRDEP",37, 0) | ||||
2311 | W !!,"<*> please wa it <*>" | ||||
2312 | "RTN","RCR JRDEP",38, 0) | ||||
2313 | ; | ||||
2314 | "RTN","RCR JRDEP",39, 0) | ||||
2315 | DQ ; repo rt (queue) starts he re | ||||
2316 | "RTN","RCR JRDEP",40, 0) | ||||
2317 | N %,%H,%I ,CHAMPVA,D A,DEPOSDA, DIQ2,DOCTO TAL,FEE,FM SDOCID,FUN D,FUNDTOTL ,GECSDATA, LINEDA,LIN EDATA,NOW, PAGE,RCDAT A,RCRJLAST ,RCRJLINE, RCRJFLAG,R ECEIPDA,RS C,RSCTOTL, SCREEN,SIT E,TOTAL,X, Y | ||||
2318 | "RTN","RCR JRDEP",41, 0) | ||||
2319 | K ^TMP($J ,"RCRJRDEP ") | ||||
2320 | "RTN","RCR JRDEP",42, 0) | ||||
2321 | ; | ||||
2322 | "RTN","RCR JRDEP",43, 0) | ||||
2323 | ; build list of fm s document s | ||||
2324 | "RTN","RCR JRDEP",44, 0) | ||||
2325 | S SITE=$$ SITE^RCMSI TE | ||||
2326 | "RTN","RCR JRDEP",45, 0) | ||||
2327 | S RCRJLAS T="CR-"_SI TE_RCRJEND _" " | ||||
2328 | "RTN","RCR JRDEP",46, 0) | ||||
2329 | ; | ||||
2330 | "RTN","RCR JRDEP",47, 0) | ||||
2331 | ; the fm s document was previ ously stor ed in the deposit fi le 344.1 | ||||
2332 | "RTN","RCR JRDEP",48, 0) | ||||
2333 | ; this c ode can be removed l ater on | ||||
2334 | "RTN","RCR JRDEP",49, 0) | ||||
2335 | ; this i s the star ting docum ent, use 3 1 to start with sele ct doc fir st | ||||
2336 | "RTN","RCR JRDEP",50, 0) | ||||
2337 | S FMSDOCI D="CR-"_SI TE_RCRJSTR T_$C(31) | ||||
2338 | "RTN","RCR JRDEP",51, 0) | ||||
2339 | F S FMSD OCID=$O(^R CY(344.1," ADOC",FMSD OCID)) Q:F MSDOCID="" !(FMSDOCID ]RCRJLAST) D | ||||
2340 | "RTN","RCR JRDEP",52, 0) | ||||
2341 | . S DEPOS DA=+$O(^RC Y(344.1,"A DOC",FMSDO CID,0)) | ||||
2342 | "RTN","RCR JRDEP",53, 0) | ||||
2343 | . ; comp ute deposi t (all rec eipts) tot al for com parison | ||||
2344 | "RTN","RCR JRDEP",54, 0) | ||||
2345 | . S TOTAL =0,CHAMPVA =0,FEE=0 | ||||
2346 | "RTN","RCR JRDEP",55, 0) | ||||
2347 | . S RECEI PDA=0 F S RECEIPDA= $O(^RCY(34 4,"AD",DEP OSDA,RECEI PDA)) Q:'R ECEIPDA D | ||||
2348 | "RTN","RCR JRDEP",56, 0) | ||||
2349 | . . S DA= 0 F S DA= $O(^RCY(34 4,RECEIPDA ,1,DA)) Q: 'DA S TOT AL=TOTAL+$ P(^(DA,0), "^",5) | ||||
2350 | "RTN","RCR JRDEP",57, 0) | ||||
2351 | . . S CHA MPVA=CHAMP VA+$$CHAMP VA(RECEIPD A) | ||||
2352 | "RTN","RCR JRDEP",58, 0) | ||||
2353 | . . S FEE =FEE+$$FEE (RECEIPDA) | ||||
2354 | "RTN","RCR JRDEP",59, 0) | ||||
2355 | . ; tmp= deposit ^ depositda ^ depositd ate ^ ^ ^ ^ depositt otal ^ cha mpvatotal ^ feetotal | ||||
2356 | "RTN","RCR JRDEP",60, 0) | ||||
2357 | . S ^TMP( $J,"RCRJRD EP",FMSDOC ID)=$P($G( ^RCY(344.1 ,DEPOSDA,0 )),"^")_"^ "_DEPOSDA_ "^"_$P($G( ^RCY(344.1 ,DEPOSDA,0 )),"^",9)_ "^^^^"_TOT AL_"^"_CHA MPVA_"^"_F EE | ||||
2358 | "RTN","RCR JRDEP",61, 0) | ||||
2359 | ; | ||||
2360 | "RTN","RCR JRDEP",62, 0) | ||||
2361 | ; the fm s document is now st ored in th e receipt file 344 | ||||
2362 | "RTN","RCR JRDEP",63, 0) | ||||
2363 | S FMSDOCI D="CR-"_SI TE_RCRJSTR T_$C(31) | ||||
2364 | "RTN","RCR JRDEP",64, 0) | ||||
2365 | F S FMSD OCID=$O(^R CY(344,"AD OC",FMSDOC ID)) Q:FMS DOCID=""!( FMSDOCID]R CRJLAST) D | ||||
2366 | "RTN","RCR JRDEP",65, 0) | ||||
2367 | . S RECEI PDA=+$O(^R CY(344,"AD OC",FMSDOC ID,0)) | ||||
2368 | "RTN","RCR JRDEP",66, 0) | ||||
2369 | . ; comp ute deposi t (all rec eipts) tot al for com parison | ||||
2370 | "RTN","RCR JRDEP",67, 0) | ||||
2371 | . S TOTAL =0 | ||||
2372 | "RTN","RCR JRDEP",68, 0) | ||||
2373 | . ; use the paymen t amount t o pick up suspense d eposits | ||||
2374 | "RTN","RCR JRDEP",69, 0) | ||||
2375 | . S DA=0 F S DA=$O (^RCY(344, RECEIPDA,1 ,DA)) Q:'D A S TOTAL =TOTAL+$P( ^(DA,0),"^ ",4) | ||||
2376 | "RTN","RCR JRDEP",70, 0) | ||||
2377 | . S CHAMP VA=$$CHAMP VA(RECEIPD A) | ||||
2378 | "RTN","RCR JRDEP",71, 0) | ||||
2379 | . S FEE=$ $FEE(RECEI PDA) | ||||
2380 | "RTN","RCR JRDEP",72, 0) | ||||
2381 | . S DEPOS DA=+$P($G( ^RCY(344,R ECEIPDA,0) ),"^",6) | ||||
2382 | "RTN","RCR JRDEP",73, 0) | ||||
2383 | . ; tmp= deposit ^ depositda ^ depositd ate ^ rece ipt ^recei ptda ^ rec eipt date ^ receiptt otal ^ cha mpvatotal ^ feetotal | ||||
2384 | "RTN","RCR JRDEP",74, 0) | ||||
2385 | . S ^TMP( $J,"RCRJRD EP",FMSDOC ID)=$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_ "^"_CHAMPV A_"^"_FEE | ||||
2386 | "RTN","RCR JRDEP",75, 0) | ||||
2387 | ; | ||||
2388 | "RTN","RCR JRDEP",76, 0) | ||||
2389 | ; print report | ||||
2390 | "RTN","RCR JRDEP",77, 0) | ||||
2391 | S SCREEN= 0 I '$D(ZT QUEUED),IO =IO(0),$E( IOST)="C" S SCREEN=1 | ||||
2392 | "RTN","RCR JRDEP",78, 0) | ||||
2393 | S RCRJLIN E="",$P(RC RJLINE,"-" ,81)="" | ||||
2394 | "RTN","RCR JRDEP",79, 0) | ||||
2395 | D NOW^%DT C S Y=% D DD^%DT S N OW=Y,PAGE= 1 | ||||
2396 | "RTN","RCR JRDEP",80, 0) | ||||
2397 | U IO I $G (RCRJSUMM) '=1 D H | ||||
2398 | "RTN","RCR JRDEP",81, 0) | ||||
2399 | ; | ||||
2400 | "RTN","RCR JRDEP",82, 0) | ||||
2401 | S FMSDOCI D="" F S FMSDOCID=$ O(^TMP($J, "RCRJRDEP" ,FMSDOCID) ) Q:FMSDOC ID=""!($G( RCRJFLAG)) D | ||||
2402 | "RTN","RCR JRDEP",83, 0) | ||||
2403 | . S RCDAT A=^TMP($J, "RCRJRDEP" ,FMSDOCID) | ||||
2404 | "RTN","RCR JRDEP",84, 0) | ||||
2405 | . K GECSD ATA | ||||
2406 | "RTN","RCR JRDEP",85, 0) | ||||
2407 | . D DATA^ GECSSGET(F MSDOCID,1) | ||||
2408 | "RTN","RCR JRDEP",86, 0) | ||||
2409 | . I $G(RC RJSUMM)'=1 D Q:$G(R CRJFLAG) | ||||
2410 | "RTN","RCR JRDEP",87, 0) | ||||
2411 | . . I $Y> (IOSL-7) D :SCREEN PA USE^RCRJRT R1 Q:$G(RC RJFLAG) D H | ||||
2412 | "RTN","RCR JRDEP",88, 0) | ||||
2413 | . . S Y=$ P($P(RCDAT A,"^",3)," .") I Y D DD^%DT | ||||
2414 | "RTN","RCR JRDEP",89, 0) | ||||
2415 | . . W !," FMS DOCUME NT: ",FMSD OCID,?34," DEPOSIT TI CKET: ",$P (RCDATA,"^ "),?62,"DA TE: ",Y | ||||
2416 | "RTN","RCR JRDEP",90, 0) | ||||
2417 | . . I $P( RCDATA,"^" ,4)'="" W !?41,"RECE IPT: ",$P( RCDATA,"^" ,4) S Y=$P ($P(RCDATA ,"^",6),". ") I Y D D D^%DT W ?6 2,"DATE: " ,Y | ||||
2418 | "RTN","RCR JRDEP",91, 0) | ||||
2419 | . . D H1 | ||||
2420 | "RTN","RCR JRDEP",92, 0) | ||||
2421 | . S DOCTO TAL=0 | ||||
2422 | "RTN","RCR JRDEP",93, 0) | ||||
2423 | . I $D(GE CSDATA) S LINEDA=0 F S LINEDA =$O(GECSDA TA(2100.1, GECSDATA,1 0,LINEDA)) Q:'LINEDA !($G(RCRJF LAG)) D | ||||
2424 | "RTN","RCR JRDEP",94, 0) | ||||
2425 | . . S LIN EDATA=GECS DATA(2100. 1,GECSDATA ,10,LINEDA ) | ||||
2426 | "RTN","RCR JRDEP",95, 0) | ||||
2427 | . . I $E( LINEDATA,1 ,4)="CR2^" S DOCTOTA L=$P(LINED ATA,"^",15 ) | ||||
2428 | "RTN","RCR JRDEP",96, 0) | ||||
2429 | . . I $E( LINEDATA,1 ,9)'="LIN^ ~CRA^" Q | ||||
2430 | "RTN","RCR JRDEP",97, 0) | ||||
2431 | . . I $G( RCRJSUMM)' =1 D | ||||
2432 | "RTN","RCR JRDEP",98, 0) | ||||
2433 | . . . I $ Y>(IOSL-4) D:SCREEN PAUSE^RCRJ RTR1 Q:$G( RCRJFLAG) D H,H1 | ||||
2434 | "RTN","RCR JRDEP",99, 0) | ||||
2435 | . . . W ! ?1,$P(LINE DATA,"^",3 ),?6,$P(LI NEDATA,"^" ,4),?11,$P (LINEDATA, "^",6),?19 ,$P(LINEDA TA,"^",10) | ||||
2436 | "RTN","RCR JRDEP",100 ,0) | ||||
2437 | . . . W ? 30,$J($P(L INEDATA,"^ ",18),8),? 40,$E($P(L INEDATA,"^ ",25),4,10 ),?50,$J($ P(LINEDATA ,"^",20),1 0,2),?64,$ J($P(LINED ATA,"^",23 ),9) | ||||
2438 | "RTN","RCR JRDEP",101 ,0) | ||||
2439 | . . ; to tals by fu nd | ||||
2440 | "RTN","RCR JRDEP",102 ,0) | ||||
2441 | . . S FUN D=$P(LINED ATA,"^",6) | ||||
2442 | "RTN","RCR JRDEP",103 ,0) | ||||
2443 | . . I FUN D="" S FUN D="0160" | ||||
2444 | "RTN","RCR JRDEP",104 ,0) | ||||
2445 | . . S FUN DTOTL(FUND )=$G(FUNDT OTL(FUND)) +$P(LINEDA TA,"^",20) | ||||
2446 | "RTN","RCR JRDEP",105 ,0) | ||||
2447 | . . ; to tals by rs c for the accrued 52 87 funds ( 01,03,04,0 9,11) | ||||
2448 | "RTN","RCR JRDEP",106 ,0) | ||||
2449 | . . S RSC =$P(LINEDA TA,"^",10) | ||||
2450 | "RTN","RCR JRDEP",107 ,0) | ||||
2451 | . . I RSC '="",($$PT ACCT^PRCAA CC(FUND)!( FUND=4032) ) S RSCTOT L(RSC)=$G( RSCTOTL(RS C))+$P(LIN EDATA,"^", 20) | ||||
2452 | "RTN","RCR JRDEP",108 ,0) | ||||
2453 | . I $G(RC RJSUMM)=1 Q | ||||
2454 | "RTN","RCR JRDEP",109 ,0) | ||||
2455 | . I $G(RC RJFLAG) Q | ||||
2456 | "RTN","RCR JRDEP",110 ,0) | ||||
2457 | . I $Y>(I OSL-6) D:S CREEN PAUS E^RCRJRTR1 Q:$G(RCRJ FLAG) D H | ||||
2458 | "RTN","RCR JRDEP",111 ,0) | ||||
2459 | . W !?23, "LINE TOTA L/DOCUMENT TOTAL: ", $J(DOCTOTA L,10,2) | ||||
2460 | "RTN","RCR JRDEP",112 ,0) | ||||
2461 | . ; comp ute receip t total fo r comparis on | ||||
2462 | "RTN","RCR JRDEP",113 ,0) | ||||
2463 | . S TOTAL =$P(RCDATA ,"^",7) | ||||
2464 | "RTN","RCR JRDEP",114 ,0) | ||||
2465 | . S CHAMP VA=$P(RCDA TA,"^",8) | ||||
2466 | "RTN","RCR JRDEP",115 ,0) | ||||
2467 | . S FEE=$ P(RCDATA," ^",9) | ||||
2468 | "RTN","RCR JRDEP",116 ,0) | ||||
2469 | . I CHAMP VA W !?35, "CHAMPVA T OTAL: ",$J (CHAMPVA,1 0,2) | ||||
2470 | "RTN","RCR JRDEP",117 ,0) | ||||
2471 | . I FEE W !?35,"NON -VA TOTAL : ",$J(FEE ,10,2) | ||||
2472 | "RTN","RCR JRDEP",118 ,0) | ||||
2473 | . W !?35, "DEPOSIT T OTAL: ",$J (TOTAL,10, 2) | ||||
2474 | "RTN","RCR JRDEP",119 ,0) | ||||
2475 | . I (DOCT OTAL+CHAMP VA+FEE)'=T OTAL W !," WARNING: TOTALS DO NOT MATCH, CHECK THE DEPOSIT: ********** " | ||||
2476 | "RTN","RCR JRDEP",120 ,0) | ||||
2477 | . W ! | ||||
2478 | "RTN","RCR JRDEP",121 ,0) | ||||
2479 | ; | ||||
2480 | "RTN","RCR JRDEP",122 ,0) | ||||
2481 | I $G(RCRJ FLAG) D Q Q | ||||
2482 | "RTN","RCR JRDEP",123 ,0) | ||||
2483 | I $G(RCRJ SUMM)'=1 D :SCREEN PA USE^RCRJRT R1 I $G(RC RJFLAG) D Q Q | ||||
2484 | "RTN","RCR JRDEP",124 ,0) | ||||
2485 | D H | ||||
2486 | "RTN","RCR JRDEP",125 ,0) | ||||
2487 | ; print totals by fund/rsc | ||||
2488 | "RTN","RCR JRDEP",126 ,0) | ||||
2489 | W !!,"TOT AL DEPOSIT S BY FUND: " | ||||
2490 | "RTN","RCR JRDEP",127 ,0) | ||||
2491 | S FUND="" F S FUND =$O(FUNDTO TL(FUND)) Q:FUND=""! ($G(RCRJFL AG)) D | ||||
2492 | "RTN","RCR JRDEP",128 ,0) | ||||
2493 | . I $Y>( IOSL-4) D: SCREEN PAU SE^RCRJRTR 1 Q:$G(RCR JFLAG) D H W !!,"TO TAL DEPOSI TS BY FUND :" | ||||
2494 | "RTN","RCR JRDEP",129 ,0) | ||||
2495 | . W !?5, "FUND: ",F UND,?20,$J (FUNDTOTL( FUND),10,2 ) | ||||
2496 | "RTN","RCR JRDEP",130 ,0) | ||||
2497 | I $G(RCRJ FLAG) D Q Q | ||||
2498 | "RTN","RCR JRDEP",131 ,0) | ||||
2499 | I DT<$$AD DPTEDT^PRC AACC() W ! !,"TOTAL D EPOSITS BY REVENUE S OURCE CODE FOR THE S ERIES OF F UNDS 5287. 1,5287.3,5 287.4:" | ||||
2500 | "RTN","RCR JRDEP",132 ,0) | ||||
2501 | I DT'<$$A DDPTEDT^PR CAACC() W !!,"TOTAL DEPOSITS B Y REVENUE SOURCE COD E FOR THE SERIES OF FUNDS 5287 01,528703, 528704,528 711:" | ||||
2502 | "RTN","RCR JRDEP",133 ,0) | ||||
2503 | S RSC="" F S RSC=$ O(RSCTOTL( RSC)) Q:RS C="" D Q :$G(RCRJFL AG) | ||||
2504 | "RTN","RCR JRDEP",134 ,0) | ||||
2505 | . I $Y>(I OSL-4) D:S CREEN PAUS E^RCRJRTR1 Q:$G(RCRJ FLAG) D H W !!,"TOT AL DEPOSIT S BY REVEN UE SOURCE CODE FOR T HE SERIES OF ACCRUED 5287 FUND S "_$S(DT< $$ADDPTEDT ^PRCAACC() :"(.1,.3,. 4,.9):",1: "(01,03,04 ,09,11):") | ||||
2506 | "RTN","RCR JRDEP",135 ,0) | ||||
2507 | . W !?5," RSC: ",RSC ,?17,$$GET DESC^RCXFM SPR(RSC),? 70,$J(RSCT OTL(RSC),1 0,2) | ||||
2508 | "RTN","RCR JRDEP",136 ,0) | ||||
2509 | I $G(RCRJ FLAG) D Q Q | ||||
2510 | "RTN","RCR JRDEP",137 ,0) | ||||
2511 | I SCREEN R !,"Press RETURN to continue: ",X:DTIME | ||||
2512 | "RTN","RCR JRDEP",138 ,0) | ||||
2513 | ; | ||||
2514 | "RTN","RCR JRDEP",139 ,0) | ||||
2515 | Q D ^%ZISC | ||||
2516 | "RTN","RCR JRDEP",140 ,0) | ||||
2517 | K ^TMP($J ,"RCRJRDEP ") | ||||
2518 | "RTN","RCR JRDEP",141 ,0) | ||||
2519 | Q | ||||
2520 | "RTN","RCR JRDEP",142 ,0) | ||||
2521 | ; | ||||
2522 | "RTN","RCR JRDEP",143 ,0) | ||||
2523 | ; | ||||
2524 | "RTN","RCR JRDEP",144 ,0) | ||||
2525 | H ; repor t heading | ||||
2526 | "RTN","RCR JRDEP",145 ,0) | ||||
2527 | I PAGE'=1 !(SCREEN) W @IOF | ||||
2528 | "RTN","RCR JRDEP",146 ,0) | ||||
2529 | S %=NOW_" PAGE "_P AGE,PAGE=P AGE+1 | ||||
2530 | "RTN","RCR JRDEP",147 ,0) | ||||
2531 | W $C(13), "DEPOSIT R ECONCILIAT ION REPORT ",?(80-$L( %)),% | ||||
2532 | "RTN","RCR JRDEP",148 ,0) | ||||
2533 | W !," ST ART WITH D EPOSIT: ", $S(RCRJSTR T="":"**FI RST**",1:R CRJSTRT)," END WITH DEPOSIT: ",$S(RCRJE ND="zzzzzz z":"**LAST **",1:RCRJ END),?65,$ J("TYPE: " _$S(RCRJSU MM=1:"SUMM ARY",1:"DE TAILED"),1 5) | ||||
2534 | "RTN","RCR JRDEP",149 ,0) | ||||
2535 | W !,RCRJL INE | ||||
2536 | "RTN","RCR JRDEP",150 ,0) | ||||
2537 | Q | ||||
2538 | "RTN","RCR JRDEP",151 ,0) | ||||
2539 | ; | ||||
2540 | "RTN","RCR JRDEP",152 ,0) | ||||
2541 | ; | ||||
2542 | "RTN","RCR JRDEP",153 ,0) | ||||
2543 | H1 ; prin t line hea ding | ||||
2544 | "RTN","RCR JRDEP",154 ,0) | ||||
2545 | W !,"LINE ",?5,"BFY" ,?11,"FUND ",?20,"RSC ",?30,"PRO VIDER",?43 ,"BILL",?5 4,"AMOUNT" ,?64,"TRAN TYPE" | ||||
2546 | "RTN","RCR JRDEP",155 ,0) | ||||
2547 | Q | ||||
2548 | "RTN","RCR JRDEP",156 ,0) | ||||
2549 | ; | ||||
2550 | "RTN","RCR JRDEP",157 ,0) | ||||
2551 | ; | ||||
2552 | "RTN","RCR JRDEP",158 ,0) | ||||
2553 | CHAMPVA(RE CEIPDA) ; return do llars for champva | ||||
2554 | "RTN","RCR JRDEP",159 ,0) | ||||
2555 | N %,CATEG ORY,RECEIP T,TOTAL,TR AN3,TRANDA | ||||
2556 | "RTN","RCR JRDEP",160 ,0) | ||||
2557 | S RECEIPT =$P($G(^RC Y(344,RECE IPDA,0))," ^") | ||||
2558 | "RTN","RCR JRDEP",161 ,0) | ||||
2559 | I RECEIPT ="" Q 0 | ||||
2560 | "RTN","RCR JRDEP",162 ,0) | ||||
2561 | ; | ||||
2562 | "RTN","RCR JRDEP",163 ,0) | ||||
2563 | S TOTAL=0 | ||||
2564 | "RTN","RCR JRDEP",164 ,0) | ||||
2565 | S TRANDA= 0 F S TRA NDA=$O(^PR CA(433,"AF ",RECEIPT, TRANDA)) Q :'TRANDA D | ||||
2566 | "RTN","RCR JRDEP",165 ,0) | ||||
2567 | . S CATEG ORY=$P($G( ^PRCA(430, +$P($G(^PR CA(433,TRA NDA,0)),"^ ",2),0))," ^",2) | ||||
2568 | "RTN","RCR JRDEP",166 ,0) | ||||
2569 | . I CATEG ORY'=29 Q | ||||
2570 | "RTN","RCR JRDEP",167 ,0) | ||||
2571 | . S TRAN3 =$G(^PRCA( 433,TRANDA ,3)) | ||||
2572 | "RTN","RCR JRDEP",168 ,0) | ||||
2573 | . F %=1:1 :5 S TOTAL =TOTAL+$P( TRAN3,"^", %) | ||||
2574 | "RTN","RCR JRDEP",169 ,0) | ||||
2575 | Q TOTAL | ||||
2576 | "RTN","RCR JRDEP",170 ,0) | ||||
2577 | ; | ||||
2578 | "RTN","RCR JRDEP",171 ,0) | ||||
2579 | ; | ||||
2580 | "RTN","RCR JRDEP",172 ,0) | ||||
2581 | FEE(RECEIP DA) ; ret urn dollar s for Fee Basis PRCA *4.5*310/D RF 12/9/20 15 | ||||
2582 | "RTN","RCR JRDEP",173 ,0) | ||||
2583 | N %,CATEG ORY,RECEIP T,TOTAL,TR AN3,TRANDA | ||||
2584 | "RTN","RCR JRDEP",174 ,0) | ||||
2585 | S RECEIPT =$P($G(^RC Y(344,RECE IPDA,0))," ^") | ||||
2586 | "RTN","RCR JRDEP",175 ,0) | ||||
2587 | I RECEIPT ="" Q 0 | ||||
2588 | "RTN","RCR JRDEP",176 ,0) | ||||
2589 | S TOTAL=0 | ||||
2590 | "RTN","RCR JRDEP",177 ,0) | ||||
2591 | S TRANDA= 0 F S TRA NDA=$O(^PR CA(433,"AF ",RECEIPT, TRANDA)) Q :'TRANDA D | ||||
2592 | "RTN","RCR JRDEP",178 ,0) | ||||
2593 | . S CATEG ORY=$P($G( ^PRCA(430, +$P($G(^PR CA(433,TRA NDA,0)),"^ ",2),0))," ^",2) | ||||
2594 | "RTN","RCR JRDEP",179 ,0) | ||||
2595 | . I CATEG ORY'=45 Q | ||||
2596 | "RTN","RCR JRDEP",180 ,0) | ||||
2597 | . S TRAN3 =$G(^PRCA( 433,TRANDA ,3)) | ||||
2598 | "RTN","RCR JRDEP",181 ,0) | ||||
2599 | . F %=1:1 :5 S TOTAL =TOTAL+$P( TRAN3,"^", %) | ||||
2600 | "RTN","RCR JRDEP",182 ,0) | ||||
2601 | Q TOTAL | ||||
2602 | "RTN","RCT RAN1") | ||||
2603 | 0^7^B81977 52^B735470 1 | ||||
2604 | "RTN","RCT RAN1",1,0) | ||||
2605 | RCTRAN1 ;W ASH-ISC@AL TOONA,PA/L DB-Transac tion Histo ry Report ;11/14/94 5:25 PM | ||||
2606 | "RTN","RCT RAN1",2,0) | ||||
2607 | ;;4.5;Acc ounts Rece ivable;**1 04,310**;M ar 20, 199 5;Build 14 | ||||
2608 | "RTN","RCT RAN1",3,0) | ||||
2609 | ;Per VA D irective 6 402, this routine sh ould not b e modified . | ||||
2610 | "RTN","RCT RAN1",4,0) | ||||
2611 | ; | ||||
2612 | "RTN","RCT RAN1",5,0) | ||||
2613 | ;Subrouti nes Called by RCTRAN | ||||
2614 | "RTN","RCT RAN1",6,0) | ||||
2615 | ; | ||||
2616 | "RTN","RCT RAN1",7,0) | ||||
2617 | TRANS ;Fin d transact ions of se lected typ e for sele cted date range | ||||
2618 | "RTN","RCT RAN1",8,0) | ||||
2619 | S CAT("X" )=CAT D DT ^DICRW | ||||
2620 | "RTN","RCT RAN1",9,0) | ||||
2621 | S BDATE(1 )=BDATE,BD ATE=(BDATE -1)+.99999 9999 | ||||
2622 | "RTN","RCT RAN1",10,0 ) | ||||
2623 | S EDATE(1 )=EDATE,ED ATE=$S('ED ATE:999999 9,1:EDATE+ .99999999) | ||||
2624 | "RTN","RCT RAN1",11,0 ) | ||||
2625 | S RCX=0 F S RCX=$O (^PRCA(433 ,RCX)) Q:' RCX I $D( ^PRCA(433, RCX,0)),+$ G(^(1)) D | ||||
2626 | "RTN","RCT RAN1",12,0 ) | ||||
2627 | .S NODE0= ^(0),NODE1 =^(1),NODE 2=$G(^(2)) ,NODE3=$G( ^(3)) | ||||
2628 | "RTN","RCT RAN1",13,0 ) | ||||
2629 | .S TDAT=$ S($P(NODE1 ,"^",9):$P (NODE1,"^" ,9),1:+NOD E1) | ||||
2630 | "RTN","RCT RAN1",14,0 ) | ||||
2631 | .S BILL=$ P(NODE0,"^ ",2) Q:'BI LL | ||||
2632 | "RTN","RCT RAN1",15,0 ) | ||||
2633 | .S CAT=$P ($G(^PRCA( 430,+BILL, 0)),"^",2) Q:'CAT | ||||
2634 | "RTN","RCT RAN1",16,0 ) | ||||
2635 | .I ($D(TY P(+$P(NODE 1,"^",2))) !'TYP),($D (CAT(+CAT) )!'CAT("X" )),TDAT>BD ATE,TDAT<E DATE D | ||||
2636 | "RTN","RCT RAN1",17,0 ) | ||||
2637 | ..S APP=$ P($G(^PRCA (430,+BILL ,11)),"^", 17) | ||||
2638 | "RTN","RCT RAN1",18,0 ) | ||||
2639 | ..I APP=" ",",5,4,3, 18,25,"[(" ,"_CAT_"," ) S APP="2 431" | ||||
2640 | "RTN","RCT RAN1",19,0 ) | ||||
2641 | ..I APP=" ",",9,6,7, 8,21,22,23 ,26,45,"[( ","_CAT_", ") S APP=" 5014" ;PR CA*4.5*310 /DRF added category 47 for FEE REIMB INS | ||||
2642 | "RTN","RCT RAN1",20,0 ) | ||||
2643 | ..I APP=" ",",14,12, 19,20,1,10 ,2,"[(","_ CAT_",") S APP="0160 " | ||||
2644 | "RTN","RCT RAN1",21,0 ) | ||||
2645 | ..I CAT=2 6 S APP="5 014" | ||||
2646 | "RTN","RCT RAN1",22,0 ) | ||||
2647 | ..I APP=" " S APP="N O FUND W/B ILL" | ||||
2648 | "RTN","RCT RAN1",23,0 ) | ||||
2649 | ..S BILL= $P($G(^PRC A(430,+BIL L,0)),"^") | ||||
2650 | "RTN","RCT RAN1",24,0 ) | ||||
2651 | ..I ",12, 13,14,"[(" ,"_TYP_"," ) D Q | ||||
2652 | "RTN","RCT RAN1",25,0 ) | ||||
2653 | ...F I=5: 1:8 S AMT= $P(NODE2," ^",I) I AM T S APP=$S (I=8:1435, I=7:3220,1 :"0869") D SET | ||||
2654 | "RTN","RCT RAN1",26,0 ) | ||||
2655 | ..I ",2,3 4,"[(","_T YP_",") D Q | ||||
2656 | "RTN","RCT RAN1",27,0 ) | ||||
2657 | ...F I=1: 1:5 I $P(N ODE3,"^",I ) S AMT=+$ P(NODE3,"^ ",I),APP=$ S(I=1:APP, I=2:1435,I =3:3220,1: "0869") D SET | ||||
2658 | "RTN","RCT RAN1",28,0 ) | ||||
2659 | ..S AMT=+ $P(NODE1," ^",5) | ||||
2660 | "RTN","RCT RAN1",29,0 ) | ||||
2661 | ..D SET | ||||
2662 | "RTN","RCT RAN1",30,0 ) | ||||
2663 | Q | ||||
2664 | "RTN","RCT RAN1",31,0 ) | ||||
2665 | ; | ||||
2666 | "RTN","RCT RAN1",32,0 ) | ||||
2667 | SET S ^TMP ($J,+$P(NO DE1,"^",2) ,+CAT,APP, TDAT,RCX)= AMT_"^"_BI LL_"^"_$P( NODE0,"^", 9) | ||||
2668 | "RTN","RCT RAN1",33,0 ) | ||||
2669 | Q | ||||
2670 | "RTN","RCT RAN1",34,0 ) | ||||
2671 | ; | ||||
2672 | "RTN","RCT RAN1",35,0 ) | ||||
2673 | SUB ;Sub-t otal categ ories | ||||
2674 | "RTN","RCT RAN1",36,0 ) | ||||
2675 | I RCX'=45 S:AMT(X11 )<0 AMT(X1 1)=-AMT(X1 1) W !?64, "--------- --",!?64,$ J(AMT(X11) ,11,2),! | ||||
2676 | "RTN","RCT RAN1",37,0 ) | ||||
2677 | Q | ||||
2678 | "RTN","RCT RAN1",38,0 ) | ||||
2679 | ; | ||||
2680 | "RTN","RCT RAN1",39,0 ) | ||||
2681 | KEY ;Key t o category abbreviat ions | ||||
2682 | "RTN","RCT RAN1",40,0 ) | ||||
2683 | W !!?30," CATEGORY A BBREVIATIO NS",!! | ||||
2684 | "RTN","RCT RAN1",41,0 ) | ||||
2685 | W !,"C - C (MEANS TEST), CE - CURRENT EMPLOYEE, CP - CRIM E OF PER. VIO." | ||||
2686 | "RTN","RCT RAN1",42,0 ) | ||||
2687 | W !,"E - EX-EMPLO YEE" | ||||
2688 | "RTN","RCT RAN1",43,0 ) | ||||
2689 | W !,"F1 - FEDERAL AGENGIES-R EIMB., F2 - FEDERAL AGENCIES-R EFUND" | ||||
2690 | "RTN","RCT RAN1",44,0 ) | ||||
2691 | W !,"FR - FEE BASI S REIMBURS ABLE HEALT H INSURANC E" ;PRCA* 4.5*310/DR F - Added FEE REIMB INS | ||||
2692 | "RTN","RCT RAN1",45,0 ) | ||||
2693 | W !,"H - EMERGENC Y HUMANITA RIAN" | ||||
2694 | "RTN","RCT RAN1",46,0 ) | ||||
2695 | W !,"I - INELIGIB LE HOSP., IA - INTER AGENCY, M - MILITARY , MC - MED ICARN" | ||||
2696 | "RTN","RCT RAN1",47,0 ) | ||||
2697 | W !,"NA - NO-FAULT AUTO ACC. " | ||||
2698 | "RTN","RCT RAN1",48,0 ) | ||||
2699 | W !,"PN - RX CO-PA Y NSC, PS - RX CO-PA Y SC, PP - PREPAY" | ||||
2700 | "RTN","RCT RAN1",49,0 ) | ||||
2701 | W !,"RI - REIMBURS IBLE HEALT H INSURANC E" | ||||
2702 | "RTN","RCT RAN1",50,0 ) | ||||
2703 | W !,"SA - SHARING AGREEMENTS , TF - TOR T FEASOR, V - VENDOR , WC - WOR KMAN'S COM P." | ||||
2704 | "RTN","RCT RAN1",51,0 ) | ||||
2705 | Q | ||||
2706 | "RTN","RCT RAN1",52,0 ) | ||||
2707 | HDR ;;Head ing | ||||
2708 | "RTN","RCT RAN1",53,0 ) | ||||
2709 | S PG=PG+1 | ||||
2710 | "RTN","RCT RAN1",54,0 ) | ||||
2711 | W !?30,"H ISTORY OF TRANSACTIO NS",?70,"P AGE ",?75, PG | ||||
2712 | "RTN","RCT RAN1",55,0 ) | ||||
2713 | W !,LINE | ||||
2714 | "RTN","RCT RAN1",56,0 ) | ||||
2715 | W !,"Date ",?12,"Tra ns.",?37," Cat",?44," Bill#",?57 ,"Trans#", ?66,"Amoun t",?75,"BY " | ||||
2716 | "RTN","RCT RAN1",57,0 ) | ||||
2717 | W !,LINE | ||||
2718 | "RTN","RCT RAN1",58,0 ) | ||||
2719 | S LN=0 | ||||
2720 | "RTN","RCT RAN1",59,0 ) | ||||
2721 | Q | ||||
2722 | "RTN","RCX FMSPR") | ||||
2723 | 0^1^B27613 579^B25382 600 | ||||
2724 | "RTN","RCX FMSPR",1,0 ) | ||||
2725 | RCXFMSPR ; WISC/RFJ-p rint reven ue source codes ;8/3 1/10 11:34 am | ||||
2726 | "RTN","RCX FMSPR",2,0 ) | ||||
2727 | ;;4.5;Acc ounts Rece ivable;**9 0,96,101,1 56,170,203 ,273,310** ;Mar 20, 1 995;Build 14 | ||||
2728 | "RTN","RCX FMSPR",3,0 ) | ||||
2729 | ;Per VA D irective 6 402, this routine sh ould not b e modified . | ||||
2730 | "RTN","RCX FMSPR",4,0 ) | ||||
2731 | W !,"This option wi ll print o ut a list of the rev enue sourc e codes se nt from" | ||||
2732 | "RTN","RCX FMSPR",5,0 ) | ||||
2733 | W !,"the VISTA syst em to FMS. " | ||||
2734 | "RTN","RCX FMSPR",6,0 ) | ||||
2735 | ; | ||||
2736 | "RTN","RCX FMSPR",7,0 ) | ||||
2737 | ; select device | ||||
2738 | "RTN","RCX FMSPR",8,0 ) | ||||
2739 | W ! S %ZI S="Q" D ^% ZIS Q:POP | ||||
2740 | "RTN","RCX FMSPR",9,0 ) | ||||
2741 | I $D(IO(" Q")) D D ^%ZTLOAD K IO("Q"),Z TSK Q | ||||
2742 | "RTN","RCX FMSPR",10, 0) | ||||
2743 | . S ZTD ESC="Reven ue Source Code Repor t",ZTRTN=" DQ^RCXFMSP R" | ||||
2744 | "RTN","RCX FMSPR",11, 0) | ||||
2745 | . S ZTS AVE("ZTREQ ")="@" | ||||
2746 | "RTN","RCX FMSPR",12, 0) | ||||
2747 | W !!,"<*> please wa it <*>" | ||||
2748 | "RTN","RCX FMSPR",13, 0) | ||||
2749 | ; | ||||
2750 | "RTN","RCX FMSPR",14, 0) | ||||
2751 | DQ ; queu e starts h ere | ||||
2752 | "RTN","RCX FMSPR",15, 0) | ||||
2753 | N %,%I,BI NARY,COL2D ESC,COL3DE SC,COLUMN1 ,COLUMN2,C OLUMN3,COL UMN4 | ||||
2754 | "RTN","RCX FMSPR",16, 0) | ||||
2755 | N DECIMAL ,DESCRIP,N OW,PAGE,RC STFLAG,SCR EEN,X,Y | ||||
2756 | "RTN","RCX FMSPR",17, 0) | ||||
2757 | D NOW^%DT C S Y=% D DD^%DT S N OW=Y | ||||
2758 | "RTN","RCX FMSPR",18, 0) | ||||
2759 | S PAGE=1, SCREEN=0 I '$D(ZTQUE UED),IO=IO (0),$E(IOS T)="C" S S CREEN=1 | ||||
2760 | "RTN","RCX FMSPR",19, 0) | ||||
2761 | U IO D H | ||||
2762 | "RTN","RCX FMSPR",20, 0) | ||||
2763 | ; | ||||
2764 | "RTN","RCX FMSPR",21, 0) | ||||
2765 | S COLUMN1 ="A",COLUM N2="R",COL UMN3="R",C OLUMN4="V" ,DESCRIP=" Miscellane ous" | ||||
2766 | "RTN","RCX FMSPR",22, 0) | ||||
2767 | D WRITEIT | ||||
2768 | "RTN","RCX FMSPR",23, 0) | ||||
2769 | ; | ||||
2770 | "RTN","RCX FMSPR",24, 0) | ||||
2771 | ; for no w, column 1 is alway s 8 and co lumn 4 is always Z | ||||
2772 | "RTN","RCX FMSPR",25, 0) | ||||
2773 | S COLUMN1 =8,COLUMN4 ="Z" | ||||
2774 | "RTN","RCX FMSPR",26, 0) | ||||
2775 | F COLUMN2 =1:1:9,"A" ,"B","C"," D","E","F" ,"G","H"," I","J","K" ,"L","M"," Q","R","S" ,"T" D Q: $G(RCSTFLA G) | ||||
2776 | "RTN","RCX FMSPR",27, 0) | ||||
2777 | . S COL 2DESC=$P($ T(@("A"_CO LUMN2)),"; ",3) | ||||
2778 | "RTN","RCX FMSPR",28, 0) | ||||
2779 | . ; | ||||
2780 | "RTN","RCX FMSPR",29, 0) | ||||
2781 | . S COL UMN3=$S(CO LUMN2=5:"* ",1:"Z") | ||||
2782 | "RTN","RCX FMSPR",30, 0) | ||||
2783 | . S DES CRIP=COL2D ESC D WRIT EIT | ||||
2784 | "RTN","RCX FMSPR",31, 0) | ||||
2785 | . ; | ||||
2786 | "RTN","RCX FMSPR",32, 0) | ||||
2787 | . I $G( RCSTFLAG) Q | ||||
2788 | "RTN","RCX FMSPR",33, 0) | ||||
2789 | . ; | ||||
2790 | "RTN","RCX FMSPR",34, 0) | ||||
2791 | . ; sh ow hsif - disabled b y patch 20 3 | ||||
2792 | "RTN","RCX FMSPR",35, 0) | ||||
2793 | . ;I CO LUMN2="B"! (COLUMN2=" C") S DESC RIP=DESCRI P_" HSIF", COLUMN3=1 D WRITEIT | ||||
2794 | "RTN","RCX FMSPR",36, 0) | ||||
2795 | ; | ||||
2796 | "RTN","RCX FMSPR",37, 0) | ||||
2797 | I $G(RCST FLAG) D Q Q | ||||
2798 | "RTN","RCX FMSPR",38, 0) | ||||
2799 | ; | ||||
2800 | "RTN","RCX FMSPR",39, 0) | ||||
2801 | ; print reimbursab le health insurance rsc's | ||||
2802 | "RTN","RCX FMSPR",40, 0) | ||||
2803 | S COLUMN2 =5 | ||||
2804 | "RTN","RCX FMSPR",41, 0) | ||||
2805 | W !!?6,"F or REIMBUR SABLE HEAL TH INSURAN CE [85*Z]: " | ||||
2806 | "RTN","RCX FMSPR",42, 0) | ||||
2807 | F DECIMAL =0:1:31 D Q:$G(RCST FLAG) | ||||
2808 | "RTN","RCX FMSPR",43, 0) | ||||
2809 | . I DEC IMAL<10 S COLUMN3=DE CIMAL | ||||
2810 | "RTN","RCX FMSPR",44, 0) | ||||
2811 | . E S COLUMN3=$C (65+DECIMA L-10) | ||||
2812 | "RTN","RCX FMSPR",45, 0) | ||||
2813 | . ; | ||||
2814 | "RTN","RCX FMSPR",46, 0) | ||||
2815 | . ; co nvert deci mal to bin ary (ex: 1 0011) so i t can be | ||||
2816 | "RTN","RCX FMSPR",47, 0) | ||||
2817 | . ; pa rsed in rs c to get t he descrip tion | ||||
2818 | "RTN","RCX FMSPR",48, 0) | ||||
2819 | . S BIN ARY=$$CONV ERT(DECIMA L) | ||||
2820 | "RTN","RCX FMSPR",49, 0) | ||||
2821 | . S COL 3DESC=$P($ T(@("B"_$E (BINARY,1, 2))),";",3 ) | ||||
2822 | "RTN","RCX FMSPR",50, 0) | ||||
2823 | . S COL 3DESC=COL3 DESC_", "_ $P($T(@("C "_$E(BINAR Y,3))),";" ,3) | ||||
2824 | "RTN","RCX FMSPR",51, 0) | ||||
2825 | . S COL 3DESC=COL3 DESC_", "_ $P($T(@("D "_$E(BINAR Y,4))),";" ,3) | ||||
2826 | "RTN","RCX FMSPR",52, 0) | ||||
2827 | . S COL 3DESC=COL3 DESC_", "_ $P($T(@("E "_$E(BINAR Y,5))),";" ,3) | ||||
2828 | "RTN","RCX FMSPR",53, 0) | ||||
2829 | . S DES CRIP=COL3D ESC | ||||
2830 | "RTN","RCX FMSPR",54, 0) | ||||
2831 | . D WRI TEIT | ||||
2832 | "RTN","RCX FMSPR",55, 0) | ||||
2833 | ; | ||||
2834 | "RTN","RCX FMSPR",56, 0) | ||||
2835 | ; print fee basis reimbursab le health insurance rsc's (PRC A*4.5*310/ DRF) | ||||
2836 | "RTN","RCX FMSPR",57, 0) | ||||
2837 | S COLUMN2 ="F" | ||||
2838 | "RTN","RCX FMSPR",58, 0) | ||||
2839 | W !!?6,"F or FEE REI MBURSABLE HEALTH INS URANCE [8F *Z]:" | ||||
2840 | "RTN","RCX FMSPR",59, 0) | ||||
2841 | F DECIMAL =1:1:2 D Q:$G(RCSTF LAG) | ||||
2842 | "RTN","RCX FMSPR",60, 0) | ||||
2843 | . S DES CRIP="FEE BASIS, NSC VET, MT C AT A, "_$S (DECIMAL=1 :"INPATIEN T",DECIMAL =2:"OUTPAT IENT",1:"" ) | ||||
2844 | "RTN","RCX FMSPR",61, 0) | ||||
2845 | . S COL UMN3=DECIM AL | ||||
2846 | "RTN","RCX FMSPR",62, 0) | ||||
2847 | . D WRI TEIT | ||||
2848 | "RTN","RCX FMSPR",63, 0) | ||||
2849 | Q D ^%ZISC | ||||
2850 | "RTN","RCX FMSPR",64, 0) | ||||
2851 | Q | ||||
2852 | "RTN","RCX FMSPR",65, 0) | ||||
2853 | ; | ||||
2854 | "RTN","RCX FMSPR",66, 0) | ||||
2855 | ; | ||||
2856 | "RTN","RCX FMSPR",67, 0) | ||||
2857 | GETDESC(RS C) ; retu rn the des cription f or the rev enue sourc e code | ||||
2858 | "RTN","RCX FMSPR",68, 0) | ||||
2859 | N BINARY, COL3DESC,C OLUMN2,COL UMN3,DESC | ||||
2860 | "RTN","RCX FMSPR",69, 0) | ||||
2861 | I RSC="AR RV" Q "Mis cellaneous " | ||||
2862 | "RTN","RCX FMSPR",70, 0) | ||||
2863 | I RSC=804 6 Q "Admin istrative" | ||||
2864 | "RTN","RCX FMSPR",71, 0) | ||||
2865 | I RSC=804 7 Q "Inter est" | ||||
2866 | "RTN","RCX FMSPR",72, 0) | ||||
2867 | I RSC=804 8 Q "Marsh al Fee and Court Cos t" | ||||
2868 | "RTN","RCX FMSPR",73, 0) | ||||
2869 | S DESC="U NKNOWN" | ||||
2870 | "RTN","RCX FMSPR",74, 0) | ||||
2871 | S COLUMN2 =$E(RSC,2) | ||||
2872 | "RTN","RCX FMSPR",75, 0) | ||||
2873 | I "123456 789ABCDEFG HIJKLMQRST "[COLUMN2 S DESC=$P( $T(@("A"_C OLUMN2))," ;",3) | ||||
2874 | "RTN","RCX FMSPR",76, 0) | ||||
2875 | ; HSIF re ference di sabled by patch 203 | ||||
2876 | "RTN","RCX FMSPR",77, 0) | ||||
2877 | ; I RSC=" 8B1Z"!(RSC ="8C1Z") S DESC=DESC _" (HSIF)" | ||||
2878 | "RTN","RCX FMSPR",78, 0) | ||||
2879 | I COLUMN2 '=5 Q DESC | ||||
2880 | "RTN","RCX FMSPR",79, 0) | ||||
2881 | ; | ||||
2882 | "RTN","RCX FMSPR",80, 0) | ||||
2883 | S COLUMN3 =$E(RSC,3) | ||||
2884 | "RTN","RCX FMSPR",81, 0) | ||||
2885 | ; conver t alpha le tters to d ecimal | ||||
2886 | "RTN","RCX FMSPR",82, 0) | ||||
2887 | I "012345 6789"'[COL UMN3 S COL UMN3=$A(CO LUMN3)-55 | ||||
2888 | "RTN","RCX FMSPR",83, 0) | ||||
2889 | S BINARY= $$CONVERT( COLUMN3) | ||||
2890 | "RTN","RCX FMSPR",84, 0) | ||||
2891 | S COL3DES C=$P($T(@( "B"_$E(BIN ARY,1,2))) ,";",3) | ||||
2892 | "RTN","RCX FMSPR",85, 0) | ||||
2893 | S COL3DES C=COL3DESC _", "_$P($ T(@("C"_$E (BINARY,3) )),";",3) | ||||
2894 | "RTN","RCX FMSPR",86, 0) | ||||
2895 | S COL3DES C=COL3DESC _", "_$P($ T(@("D"_$E (BINARY,4) )),";",3) | ||||
2896 | "RTN","RCX FMSPR",87, 0) | ||||
2897 | S COL3DES C=COL3DESC _", "_$P($ T(@("E"_$E (BINARY,5) )),";",3) | ||||
2898 | "RTN","RCX FMSPR",88, 0) | ||||
2899 | Q "RHI, " _COL3DESC | ||||
2900 | "RTN","RCX FMSPR",89, 0) | ||||
2901 | ; | ||||
2902 | "RTN","RCX FMSPR",90, 0) | ||||
2903 | ; | ||||
2904 | "RTN","RCX FMSPR",91, 0) | ||||
2905 | CONVERT(DE CIMAL) ; convert de cimal numb er to bina ry (5 digi ts) | ||||
2906 | "RTN","RCX FMSPR",92, 0) | ||||
2907 | N Y | ||||
2908 | "RTN","RCX FMSPR",93, 0) | ||||
2909 | S Y="" | ||||
2910 | "RTN","RCX FMSPR",94, 0) | ||||
2911 | F S Y=$E ("01234567 89ABCDEF", DECIMAL#2+ 1)_Y,DECIM AL=DECIMAL \2 Q:DECIM AL<1 | ||||
2912 | "RTN","RCX FMSPR",95, 0) | ||||
2913 | S Y=$E("0 0000",0,5- $L(Y))_Y | ||||
2914 | "RTN","RCX FMSPR",96, 0) | ||||
2915 | Q Y | ||||
2916 | "RTN","RCX FMSPR",97, 0) | ||||
2917 | ; | ||||
2918 | "RTN","RCX FMSPR",98, 0) | ||||
2919 | ; | ||||
2920 | "RTN","RCX FMSPR",99, 0) | ||||
2921 | WRITEIT ; display t he rsc | ||||
2922 | "RTN","RCX FMSPR",100 ,0) | ||||
2923 | W !,COLUM N1,COLUMN2 ,COLUMN3,C OLUMN4,?6, DESCRIP | ||||
2924 | "RTN","RCX FMSPR",101 ,0) | ||||
2925 | I $Y>(IOS L-5) D:SCR EEN PAUSE Q:$G(RCSTF LAG) D H | ||||
2926 | "RTN","RCX FMSPR",102 ,0) | ||||
2927 | Q | ||||
2928 | "RTN","RCX FMSPR",103 ,0) | ||||
2929 | ; | ||||
2930 | "RTN","RCX FMSPR",104 ,0) | ||||
2931 | ; | ||||
2932 | "RTN","RCX FMSPR",105 ,0) | ||||
2933 | PAUSE ; p ause at en d of page | ||||
2934 | "RTN","RCX FMSPR",106 ,0) | ||||
2935 | N X U IO( 0) W !,"Pr ess RETURN to contin ue, '^' to exit:" R X:DTIME S: '$T X="^" S:X["^" RC STFLAG=1 U IO | ||||
2936 | "RTN","RCX FMSPR",107 ,0) | ||||
2937 | Q | ||||
2938 | "RTN","RCX FMSPR",108 ,0) | ||||
2939 | ; | ||||
2940 | "RTN","RCX FMSPR",109 ,0) | ||||
2941 | ; | ||||
2942 | "RTN","RCX FMSPR",110 ,0) | ||||
2943 | H ; heade r | ||||
2944 | "RTN","RCX FMSPR",111 ,0) | ||||
2945 | S %=NOW_" PAGE "_P AGE,PAGE=P AGE+1 I PA GE'=2!(SCR EEN) W @IO F | ||||
2946 | "RTN","RCX FMSPR",112 ,0) | ||||
2947 | W $C(13), "REVENUE S OURCE CODE REPORT (V ISTA TO FM S)",?(80-$ L(%)),% | ||||
2948 | "RTN","RCX FMSPR",113 ,0) | ||||
2949 | W !,"RSC" ,?6,"Descr iption" | ||||
2950 | "RTN","RCX FMSPR",114 ,0) | ||||
2951 | S %="",$P (%,"-",81) ="" | ||||
2952 | "RTN","RCX FMSPR",115 ,0) | ||||
2953 | W !,% | ||||
2954 | "RTN","RCX FMSPR",116 ,0) | ||||
2955 | Q | ||||
2956 | "RTN","RCX FMSPR",117 ,0) | ||||
2957 | ; | ||||
2958 | "RTN","RCX FMSPR",118 ,0) | ||||
2959 | ; | ||||
2960 | "RTN","RCX FMSPR",119 ,0) | ||||
2961 | ; this i s a listin g of all c olumn2 val ues with a descripti on | ||||
2962 | "RTN","RCX FMSPR",120 ,0) | ||||
2963 | A1 ;;Hospi tal Care ( NSC) | ||||
2964 | "RTN","RCX FMSPR",121 ,0) | ||||
2965 | A2 ;;Outpa tient Care (NSC) | ||||
2966 | "RTN","RCX FMSPR",122 ,0) | ||||
2967 | A3 ;;Nursi ng Home Ca re (NSC) | ||||
2968 | "RTN","RCX FMSPR",123 ,0) | ||||
2969 | A4 ;;Ineli gible Hosp italizatio n | ||||
2970 | "RTN","RCX FMSPR",124 ,0) | ||||
2971 | A5 ;;Reimb ursable He alth Insur ance | ||||
2972 | "RTN","RCX FMSPR",125 ,0) | ||||
2973 | A6 ;;Tort Feasor | ||||
2974 | "RTN","RCX FMSPR",126 ,0) | ||||
2975 | A7 ;;Workm ans Compen sation (No n-Federal) | ||||
2976 | "RTN","RCX FMSPR",127 ,0) | ||||
2977 | A8 ;;C (Me ans Test) | ||||
2978 | "RTN","RCX FMSPR",128 ,0) | ||||
2979 | A9 ;;Emerg ency/Human itarian | ||||
2980 | "RTN","RCX FMSPR",129 ,0) | ||||
2981 | AA ;;No Fa ult Auto A ccident | ||||
2982 | "RTN","RCX FMSPR",130 ,0) | ||||
2983 | AB ;;Pharm acy Co-Pay (SC Vet) | ||||
2984 | "RTN","RCX FMSPR",131 ,0) | ||||
2985 | AC ;;Pharm acy Co-Pay (NSC Vet) | ||||
2986 | "RTN","RCX FMSPR",132 ,0) | ||||
2987 | AD ;;Nursi ng Home Ca re Per Die m | ||||
2988 | "RTN","RCX FMSPR",133 ,0) | ||||
2989 | AE ;;Hospi tal Care P er Diem | ||||
2990 | "RTN","RCX FMSPR",134 ,0) | ||||
2991 | AF ;;Medic are | ||||
2992 | "RTN","RCX FMSPR",135 ,0) | ||||
2993 | AG ;;Adult Day Healt h Care (LT C) | ||||
2994 | "RTN","RCX FMSPR",136 ,0) | ||||
2995 | AH ;;Domic iliary (LT C) | ||||
2996 | "RTN","RCX FMSPR",137 ,0) | ||||
2997 | AI ;;Respi te Care-In stitutiona l (LTC) | ||||
2998 | "RTN","RCX FMSPR",138 ,0) | ||||
2999 | AJ ;;Respi te Care-No n-Institut ional (LTC ) | ||||
3000 | "RTN","RCX FMSPR",139 ,0) | ||||
3001 | AK ;;Geria tric Eval- Institutio nal (LTC) | ||||
3002 | "RTN","RCX FMSPR",140 ,0) | ||||
3003 | AL ;;Geria tric Eval- Non-Instit utional (L TC) | ||||
3004 | "RTN","RCX FMSPR",141 ,0) | ||||
3005 | AM ;;Nursi ng Home Ca re-Long Te rm Care (L TC) | ||||
3006 | "RTN","RCX FMSPR",142 ,0) | ||||
3007 | AQ ;;Pharm acy No Fau lt Auto Ac c | ||||
3008 | "RTN","RCX FMSPR",143 ,0) | ||||
3009 | AR ;;Pharm acy Reimbu rs Health Ins | ||||
3010 | "RTN","RCX FMSPR",144 ,0) | ||||
3011 | AS ;;Pharm acy Tort F easor | ||||
3012 | "RTN","RCX FMSPR",145 ,0) | ||||
3013 | AT ;;Pharm acy Workma n's Comp | ||||
3014 | "RTN","RCX FMSPR",146 ,0) | ||||
3015 | ; | ||||
3016 | "RTN","RCX FMSPR",147 ,0) | ||||
3017 | ; | ||||
3018 | "RTN","RCX FMSPR",148 ,0) | ||||
3019 | ; this i s a listin g for the type of ca re, first 2 binary d igits | ||||
3020 | "RTN","RCX FMSPR",149 ,0) | ||||
3021 | ; if col umn2 is re imbursable health in surance | ||||
3022 | "RTN","RCX FMSPR",150 ,0) | ||||
3023 | B00 ;;Inpa tient (Hos p) | ||||
3024 | "RTN","RCX FMSPR",151 ,0) | ||||
3025 | B01 ;;Outp atient | ||||
3026 | "RTN","RCX FMSPR",152 ,0) | ||||
3027 | B10 ;;Nurs ing Home | ||||
3028 | "RTN","RCX FMSPR",153 ,0) | ||||
3029 | B11 ;;Othe r | ||||
3030 | "RTN","RCX FMSPR",154 ,0) | ||||
3031 | ; | ||||
3032 | "RTN","RCX FMSPR",155 ,0) | ||||
3033 | ; | ||||
3034 | "RTN","RCX FMSPR",156 ,0) | ||||
3035 | ; this i s a listin g for the service co nnected, b inary digi t 3 | ||||
3036 | "RTN","RCX FMSPR",157 ,0) | ||||
3037 | C0 ;;SC fo r NSC | ||||
3038 | "RTN","RCX FMSPR",158 ,0) | ||||
3039 | C1 ;;NSC V et | ||||
3040 | "RTN","RCX FMSPR",159 ,0) | ||||
3041 | ; | ||||
3042 | "RTN","RCX FMSPR",160 ,0) | ||||
3043 | ; | ||||
3044 | "RTN","RCX FMSPR",161 ,0) | ||||
3045 | ; this i s a listin g for mean s test, bi nary digit 4 | ||||
3046 | "RTN","RCX FMSPR",162 ,0) | ||||
3047 | D0 ;;MT Ca t A | ||||
3048 | "RTN","RCX FMSPR",163 ,0) | ||||
3049 | D1 ;;MT Ca t C | ||||
3050 | "RTN","RCX FMSPR",164 ,0) | ||||
3051 | ; | ||||
3052 | "RTN","RCX FMSPR",165 ,0) | ||||
3053 | ; | ||||
3054 | "RTN","RCX FMSPR",166 ,0) | ||||
3055 | ; this i s a listin g for age group, bin ary digit 5 | ||||
3056 | "RTN","RCX FMSPR",167 ,0) | ||||
3057 | E0 ;;Age < 65 | ||||
3058 | "RTN","RCX FMSPR",168 ,0) | ||||
3059 | E1 ;;Age 6 5+ | ||||
3060 | "RTN","RCX FMSUF") | ||||
3061 | 0^5^B37450 700^B36597 164 | ||||
3062 | "RTN","RCX FMSUF",1,0 ) | ||||
3063 | RCXFMSUF ; WISC/RFJ-c alculate f ms fund co de for a b ill ;10/20 /10 10:37a m | ||||
3064 | "RTN","RCX FMSUF",2,0 ) | ||||
3065 | ;;4.5;Acc ounts Rece ivable;**9 0,101,135, 157,160,16 5,170,203, 207,173,21 1,192,220, 235,273,31 0**;Mar 20 , 1995;Bui ld 14 | ||||
3066 | "RTN","RCX FMSUF",3,0 ) | ||||
3067 | ;Per VA D irective 6 402, this routine sh ould not b e modified . | ||||
3068 | "RTN","RCX FMSUF",4,0 ) | ||||
3069 | Q | ||||
3070 | "RTN","RCX FMSUF",5,0 ) | ||||
3071 | ; | ||||
3072 | "RTN","RCX FMSUF",6,0 ) | ||||
3073 | ; | ||||
3074 | "RTN","RCX FMSUF",7,0 ) | ||||
3075 | GETFUNDO(T YPE) ; re turn the f und for ot her type a ssociated collection s | ||||
3076 | "RTN","RCX FMSUF",8,0 ) | ||||
3077 | ; type c an equal: | ||||
3078 | "RTN","RCX FMSUF",9,0 ) | ||||
3079 | ; I for interest A f or admin | ||||
3080 | "RTN","RCX FMSUF",10, 0) | ||||
3081 | ; M for marshall f ee C f or court c ost | ||||
3082 | "RTN","RCX FMSUF",11, 0) | ||||
3083 | I TYPE="I " Q "1435" | ||||
3084 | "RTN","RCX FMSUF",12, 0) | ||||
3085 | I TYPE="A " Q "3220" | ||||
3086 | "RTN","RCX FMSUF",13, 0) | ||||
3087 | I TYPE="M " Q "0869" | ||||
3088 | "RTN","RCX FMSUF",14, 0) | ||||
3089 | I TYPE="C " Q "0869" | ||||
3090 | "RTN","RCX FMSUF",15, 0) | ||||
3091 | Q "" | ||||
3092 | "RTN","RCX FMSUF",16, 0) | ||||
3093 | ; | ||||
3094 | "RTN","RCX FMSUF",17, 0) | ||||
3095 | ; | ||||
3096 | "RTN","RCX FMSUF",18, 0) | ||||
3097 | GETFUNDB(B ILLDA,DONT STOR,RCEFT ) ; retur n a bills fms fund c ode | ||||
3098 | "RTN","RCX FMSUF",19, 0) | ||||
3099 | ; pass D ONTSTOR eq ual 1 to p revent sto ring the f und code | ||||
3100 | "RTN","RCX FMSUF",20, 0) | ||||
3101 | ; cannot rely on d ata in the fund fiel d since it may refer ence the | ||||
3102 | "RTN","RCX FMSUF",21, 0) | ||||
3103 | ; old fu nds S FUND =$P($G(^PR CA(430,BIL LDA,11))," ^",17). s ince there | ||||
3104 | "RTN","RCX FMSUF",22, 0) | ||||
3105 | ; are re ports whic h use 11;1 7, set it for a bill once its computed | ||||
3106 | "RTN","RCX FMSUF",23, 0) | ||||
3107 | ; until all refere nces to th e fund are eliminate d. | ||||
3108 | "RTN","RCX FMSUF",24, 0) | ||||
3109 | ; rceft = 1 if pro cessing an EFT depos it | ||||
3110 | "RTN","RCX FMSUF",25, 0) | ||||
3111 | ; | ||||
3112 | "RTN","RCX FMSUF",26, 0) | ||||
3113 | N ACTDATE ,CATEGDA,F UND,NEWFUN D | ||||
3114 | "RTN","RCX FMSUF",27, 0) | ||||
3115 | ; | ||||
3116 | "RTN","RCX FMSUF",28, 0) | ||||
3117 | ; calcul ate a bill s fund | ||||
3118 | "RTN","RCX FMSUF",29, 0) | ||||
3119 | I $G(RCEF T)=1 S FUN D="5287"_$ S(DT<30309 26:"",DT'< 3030926&(D T<$$ADDPTE DT^PRCAACC ()):".4",1 :"04") Q F UND | ||||
3120 | "RTN","RCX FMSUF",30, 0) | ||||
3121 | S CATEGDA =+$P($G(^P RCA(430,BI LLDA,0))," ^",2) | ||||
3122 | "RTN","RCX FMSUF",31, 0) | ||||
3123 | I CATEGDA >45 Q "" | ||||
3124 | "RTN","RCX FMSUF",32, 0) | ||||
3125 | ; | ||||
3126 | "RTN","RCX FMSUF",33, 0) | ||||
3127 | ; piece 5 is new f und, remov e spaces | ||||
3128 | "RTN","RCX FMSUF",34, 0) | ||||
3129 | S FUND=$P ($TR($T(@C ATEGDA)," "),";",5) | ||||
3130 | "RTN","RCX FMSUF",35, 0) | ||||
3131 | ; | ||||
3132 | "RTN","RCX FMSUF",36, 0) | ||||
3133 | ; set fu nd 528711 for 3rd pa rty RX bil ls after 4 /27/2011 | ||||
3134 | "RTN","RCX FMSUF",37, 0) | ||||
3135 | I $$TYP^I BRFN(BILLD A)="PH" D | ||||
3136 | "RTN","RCX FMSUF",38, 0) | ||||
3137 | . I (CATE GDA=6)!(CA TEGDA=7)!( CATEGDA=9) !(CATEGDA= 10),$$CHEC KRXS(BILLD A) S FUND= 528711 | ||||
3138 | "RTN","RCX FMSUF",39, 0) | ||||
3139 | ; | ||||
3140 | "RTN","RCX FMSUF",40, 0) | ||||
3141 | ; if cat egory is v endor(17), ex-employ ee(15), cu rrent empl oyee(16) | ||||
3142 | "RTN","RCX FMSUF",41, 0) | ||||
3143 | ; federa l agency r efund(13), federal a gency reim b(14), mil itary(12) | ||||
3144 | "RTN","RCX FMSUF",42, 0) | ||||
3145 | ; set th e fund to what is st ored in th e file. T his was en tered | ||||
3146 | "RTN","RCX FMSUF",43, 0) | ||||
3147 | ; by the user duri ng the aud it process . If fund is in the file | ||||
3148 | "RTN","RCX FMSUF",44, 0) | ||||
3149 | ; alread y, do not need to st ore it aga in. | ||||
3150 | "RTN","RCX FMSUF",45, 0) | ||||
3151 | ; if cat egory is n ursing hom e proceeds (40), par king fees (41), | ||||
3152 | "RTN","RCX FMSUF",46, 0) | ||||
3153 | ; cwt pr oceeds (42 ), comp & pen procee ds (43), e nhanced us e lease | ||||
3154 | "RTN","RCX FMSUF",47, 0) | ||||
3155 | ; procee ds (44), s et the fun d to what is stored in the fil e. | ||||
3156 | "RTN","RCX FMSUF",48, 0) | ||||
3157 | ; This w as generat ed by the software a t the time of bill e nter. | ||||
3158 | "RTN","RCX FMSUF",49, 0) | ||||
3159 | I CATEGDA =17!(CATEG DA=15)!(CA TEGDA=16)! (CATEGDA=1 3)!(CATEGD A=14)!(CAT EGDA=12)!( CATEGDA=40 )!(CATEGDA =41)!(CATE GDA=42)!(C ATEGDA=43) !(CATEGDA= 44) D | ||||
3160 | "RTN","RCX FMSUF",50, 0) | ||||
3161 | . I $P( $G(^PRCA(4 30,BILLDA, 11)),"^",1 7)'="" S F UND=$P(^(1 1),"^",17) ,DONTSTOR= 1 | ||||
3162 | "RTN","RCX FMSUF",51, 0) | ||||
3163 | ; | ||||
3164 | "RTN","RCX FMSUF",52, 0) | ||||
3165 | ; public law state s that bil ls in the category i neligible (1), | ||||
3166 | "RTN","RCX FMSUF",53, 0) | ||||
3167 | ; emerg/ human (2), torts (10 ), or medi care (21) which are older | ||||
3168 | "RTN","RCX FMSUF",54, 0) | ||||
3169 | ; than o ct 1, 1992 should be reported under fund 3220. | ||||
3170 | "RTN","RCX FMSUF",55, 0) | ||||
3171 | I CATEGDA =1!(CATEGD A=2)!(CATE GDA=10)!(C ATEGDA=21) D | ||||
3172 | "RTN","RCX FMSUF",56, 0) | ||||
3173 | . S ACT DATE=$P($G (^PRCA(430 ,BILLDA,6) ),"^",21) | ||||
3174 | "RTN","RCX FMSUF",57, 0) | ||||
3175 | . I ACT DATE,ACTDA TE<2921001 S FUND=32 20 Q | ||||
3176 | "RTN","RCX FMSUF",58, 0) | ||||
3177 | . ; | ||||
3178 | "RTN","RCX FMSUF",59, 0) | ||||
3179 | . ; pa tch157 cha nges ineli gibles. a n ineligib le activat ed before | ||||
3180 | "RTN","RCX FMSUF",60, 0) | ||||
3181 | . ; oc t 1, 1992 or after s ep 30, 200 0 will be recorded i n fund 016 0A1. | ||||
3182 | "RTN","RCX FMSUF",61, 0) | ||||
3183 | . ; ot herwise it will be r ecorded in fund 5287 .3 if befo re 3040928 | ||||
3184 | "RTN","RCX FMSUF",62, 0) | ||||
3185 | . ; if 3040928 or after, f und should be 528703 | ||||
3186 | "RTN","RCX FMSUF",63, 0) | ||||
3187 | . I CAT EGDA=1,ACT DATE,ACTDA TE<3001001 S FUND=$S (DT<$$ADDP TEDT^PRCAA CC():"5287 .3",1:5287 03) | ||||
3188 | "RTN","RCX FMSUF",64, 0) | ||||
3189 | ; | ||||
3190 | "RTN","RCX FMSUF",65, 0) | ||||
3191 | ; set th e fund for the bill | ||||
3192 | "RTN","RCX FMSUF",66, 0) | ||||
3193 | ; PRCA*4. 5*310/DRF Add Non-VA fund 5287 13 | ||||
3194 | "RTN","RCX FMSUF",67, 0) | ||||
3195 | I $G(DONT STOR)'=1 D STORE^RCX FMSUR(BILL DA,"",FUND ) | ||||
3196 | "RTN","RCX FMSUF",68, 0) | ||||
3197 | ; | ||||
3198 | "RTN","RCX FMSUF",69, 0) | ||||
3199 | I FUND>52 8704,FUND< 528709!(FU ND=528710) !(FUND=528 711) Q FUN D | ||||
3200 | "RTN","RCX FMSUF",70, 0) | ||||
3201 | I FUND=52 8713 Q FUN D | ||||
3202 | "RTN","RCX FMSUF",71, 0) | ||||
3203 | ; | ||||
3204 | "RTN","RCX FMSUF",72, 0) | ||||
3205 | I $G(REPR ODT),REPRO DT<3030926 ,$E(FUND,1 ,4)=5287 Q 5287 | ||||
3206 | "RTN","RCX FMSUF",73, 0) | ||||
3207 | I $G(REPR ODT),REPRO DT<3031001 ,$E(FUND,1 ,4)=5287,$ G(REFMS) Q 5287 | ||||
3208 | "RTN","RCX FMSUF",74, 0) | ||||
3209 | I DT<3030 926,$E(FUN D,1,4)=528 7 Q 5287 ; Effective date | ||||
3210 | "RTN","RCX FMSUF",75, 0) | ||||
3211 | I $G(REPR ODT),REPRO DT<$$ADDPT EDT^PRCAAC C(),FUND=5 28709 Q 40 32 ;Effect ive date-5 28709 | ||||
3212 | "RTN","RCX FMSUF",76, 0) | ||||
3213 | I $G(REPR ODT),REPRO DT<3041001 ,FUND=5287 09,$G(REFM S) Q 4032 ;Resubmitt ed documen ts not hel d | ||||
3214 | "RTN","RCX FMSUF",77, 0) | ||||
3215 | I $G(DATE END),$E(DA TEEND,2,5) <"0410",FU ND=528709 Q 4032 | ||||
3216 | "RTN","RCX FMSUF",78, 0) | ||||
3217 | I DT<$$AD DPTEDT^PRC AACC(),FUN D=528709 Q 4032 | ||||
3218 | "RTN","RCX FMSUF",79, 0) | ||||
3219 | I $G(REPR ODT),REPRO DT<$$ADDPT EDT^PRCAAC C(),FUND=5 28701 Q 52 87.1 ;Effe ctive date -528701 | ||||
3220 | "RTN","RCX FMSUF",80, 0) | ||||
3221 | I $G(REPR ODT),REPRO DT<3041001 ,FUND=5287 01,$G(REFM S) Q 5287. 1 ;Resubmi tted docum ents not h eld | ||||
3222 | "RTN","RCX FMSUF",81, 0) | ||||
3223 | I $G(DATE END),$E(DA TEEND,2,5) <"0410",FU ND=528701 Q 5287.1 | ||||
3224 | "RTN","RCX FMSUF",82, 0) | ||||
3225 | I DT<$$AD DPTEDT^PRC AACC(),FUN D=528701 Q 5287.1 | ||||
3226 | "RTN","RCX FMSUF",83, 0) | ||||
3227 | I $G(REPR ODT),REPRO DT<$$ADDPT EDT^PRCAAC C(),FUND=5 28703 Q 52 87.3 ;Effe ctive date -528703 | ||||
3228 | "RTN","RCX FMSUF",84, 0) | ||||
3229 | I $G(REPR ODT),REPRO DT<3041001 ,FUND=5287 03,$G(REFM S) Q 5287. 3 ;Resubmi tted docum ents not h eld | ||||
3230 | "RTN","RCX FMSUF",85, 0) | ||||
3231 | I $G(DATE END),$E(DA TEEND,2,5) <"0410",FU ND=528703 Q 5287.3 | ||||
3232 | "RTN","RCX FMSUF",86, 0) | ||||
3233 | I DT<$$AD DPTEDT^PRC AACC(),FUN D=528703 Q 5287.3 | ||||
3234 | "RTN","RCX FMSUF",87, 0) | ||||
3235 | I $G(REPR ODT),REPRO DT<$$ADDPT EDT^PRCAAC C(),FUND=5 28704 Q 52 87.4 ;Effe ctive date -528704 | ||||
3236 | "RTN","RCX FMSUF",88, 0) | ||||
3237 | I $G(REPR ODT),REPRO DT<3041001 ,FUND=5287 04,$G(REFM S) Q 5287. 4 ;Resubmi tted docum ents not h eld | ||||
3238 | "RTN","RCX FMSUF",89, 0) | ||||
3239 | I $G(DATE END),$E(DA TEEND,2,5) <"0410",FU ND=528704 Q 5287.4 | ||||
3240 | "RTN","RCX FMSUF",90, 0) | ||||
3241 | I DT<$$AD DPTEDT^PRC AACC(),FUN D=528704 Q 5287.4 | ||||
3242 | "RTN","RCX FMSUF",91, 0) | ||||
3243 | Q FUND | ||||
3244 | "RTN","RCX FMSUF",92, 0) | ||||
3245 | ; | ||||
3246 | "RTN","RCX FMSUF",93, 0) | ||||
3247 | CHECKRXS(B ILLDA) ; r eturns tru e (1) if b ill has an y scripts on or afte r 4/27/11 | ||||
3248 | "RTN","RCX FMSUF",94, 0) | ||||
3249 | N RXNUM,N EWFUND,FIL LDT,ARRXS | ||||
3250 | "RTN","RCX FMSUF",95, 0) | ||||
3251 | S NEWFUND =0 | ||||
3252 | "RTN","RCX FMSUF",96, 0) | ||||
3253 | D SET^IBC SC5A(BILLD A,.ARRXS,) | ||||
3254 | "RTN","RCX FMSUF",97, 0) | ||||
3255 | S RXNUM=0 ,FILLDT="" | ||||
3256 | "RTN","RCX FMSUF",98, 0) | ||||
3257 | F S RXNU M=$O(ARRXS (RXNUM)) Q :RXNUM'>0! (NEWFUND) D | ||||
3258 | "RTN","RCX FMSUF",99, 0) | ||||
3259 | . S FILL DT=$O(ARRX S(RXNUM,0) ) | ||||
3260 | "RTN","RCX FMSUF",100 ,0) | ||||
3261 | . I FILL DT'<311042 7 S NEWFUN D=1 | ||||
3262 | "RTN","RCX FMSUF",101 ,0) | ||||
3263 | Q NEWFUND | ||||
3264 | "RTN","RCX FMSUF",102 ,0) | ||||
3265 | ; | ||||
3266 | "RTN","RCX FMSUF",103 ,0) | ||||
3267 | ; this i s a listin g of all c ategories and associ ated funds | ||||
3268 | "RTN","RCX FMSUF",104 ,0) | ||||
3269 | ; the la bel is fro m the inte rnal entry number in the categ ory | ||||
3270 | "RTN","RCX FMSUF",105 ,0) | ||||
3271 | ; file 4 30.2. pie ce 3 is a descriptio n, piece 4 is the ol d fund, | ||||
3272 | "RTN","RCX FMSUF",106 ,0) | ||||
3273 | ; piece 5 is the n ew fund | ||||
3274 | "RTN","RCX FMSUF",107 ,0) | ||||
3275 | ; PRCA*4 .5*310/DRF Added 45 - FEE REIM B INS to r outine. | ||||
3276 | "RTN","RCX FMSUF",108 ,0) | ||||
3277 | 0 ;;no fun d ; ; | ||||
3278 | "RTN","RCX FMSUF",109 ,0) | ||||
3279 | 1 ;;INELIG IBLE HOSP. ;3220 ;0160A1 | ||||
3280 | "RTN","RCX FMSUF",110 ,0) | ||||
3281 | 2 ;;EMERGE NCY/HUMANI TARIAN ;0160A 1 ;528703 | ||||
3282 | "RTN","RCX FMSUF",111 ,0) | ||||
3283 | 3 ;;NURSIN G HOME CAR E(NSC) ;2431 ;528703 | ||||
3284 | "RTN","RCX FMSUF",112 ,0) | ||||
3285 | 4 ;;OUTPAT IENT CARE( NSC) ;2431 ;528703 | ||||
3286 | "RTN","RCX FMSUF",113 ,0) | ||||
3287 | 5 ;;HOSPIT AL CARE (N SC) ;2431 ;528703 | ||||
3288 | "RTN","RCX FMSUF",114 ,0) | ||||
3289 | 6 ;;WORKMA N'S COMP. ;5014 ;528704 | ||||
3290 | "RTN","RCX FMSUF",115 ,0) | ||||
3291 | 7 ;;NO-FAU LT AUTO AC C. ;5014 ;528704 | ||||
3292 | "RTN","RCX FMSUF",116 ,0) | ||||
3293 | 8 ;;CRIME OF PER.VIO . ;5014 ;528704 | ||||
3294 | "RTN","RCX FMSUF",117 ,0) | ||||
3295 | 9 ;;REIMBU RS.HEALTH INS. ;5014 ;528704 | ||||
3296 | "RTN","RCX FMSUF",118 ,0) | ||||
3297 | 10 ;;TORT FEASOR ;0160 A1 ;528704 | ||||
3298 | "RTN","RCX FMSUF",119 ,0) | ||||
3299 | 11 ;;no en try ; ; | ||||
3300 | "RTN","RCX FMSUF",120 ,0) | ||||
3301 | 12 ;;MILIT ARY ;0160 A1 ;0160A1 | ||||
3302 | "RTN","RCX FMSUF",121 ,0) | ||||
3303 | 13 ;;FEDER AL AGENCIE S-REFUND ;0160 A1 ;0160A1 | ||||
3304 | "RTN","RCX FMSUF",122 ,0) | ||||
3305 | 14 ;;FEDER AL AGENCIE S-REIMB. ;0160 A1 ;0160A1 | ||||
3306 | "RTN","RCX FMSUF",123 ,0) | ||||
3307 | 15 ;;EX-EM PLOYEE ;0160 A1 ;0160A1 | ||||
3308 | "RTN","RCX FMSUF",124 ,0) | ||||
3309 | 16 ;;CURRE NT EMP. ;0160 A1 ;0160A1 | ||||
3310 | "RTN","RCX FMSUF",125 ,0) | ||||
3311 | 17 ;;VENDO R ;0160 A1 ;0160A1 | ||||
3312 | "RTN","RCX FMSUF",126 ,0) | ||||
3313 | 18 ;;C (ME ANS TEST) ;2431 ;528703 | ||||
3314 | "RTN","RCX FMSUF",127 ,0) | ||||
3315 | 19 ;;SHARI NG AGREEME NTS ;0160 A1 ;0160A1 | ||||
3316 | "RTN","RCX FMSUF",128 ,0) | ||||
3317 | 20 ;;INTER AGENCY ;0160 A1 ;0160A1 | ||||
3318 | "RTN","RCX FMSUF",129 ,0) | ||||
3319 | 21 ;;MEDIC ARE ;5014 ;528704 | ||||
3320 | "RTN","RCX FMSUF",130 ,0) | ||||
3321 | 22 ;;RX CO -PAYMENT/S C VET ;5014 ;528701 | ||||
3322 | "RTN","RCX FMSUF",131 ,0) | ||||
3323 | 23 ;;RX CO -PAYMENT/N SC VET ;5014 ;528701 | ||||
3324 | "RTN","RCX FMSUF",132 ,0) | ||||
3325 | 24 ;;NURSI NG HOME CA RE PER DIE M ;2431 ;528703 | ||||
3326 | "RTN","RCX FMSUF",133 ,0) | ||||
3327 | 25 ;;HOSPI TAL CARE P ER DIEM ;2431 ;528703 | ||||
3328 | "RTN","RCX FMSUF",134 ,0) | ||||
3329 | 26 ;;PREPA YMENT ;5014 ;528703 | ||||
3330 | "RTN","RCX FMSUF",135 ,0) | ||||
3331 | 27 ;;CHAMP VA SUBSIST ENCE ;3220 ;3220 | ||||
3332 | "RTN","RCX FMSUF",136 ,0) | ||||
3333 | 28 ;;CHAMP VA THIRD P ARTY ;3220 ;0160A1 | ||||
3334 | "RTN","RCX FMSUF",137 ,0) | ||||
3335 | 29 ;;CHAMP VA ;0160 A1 ;0160A1 | ||||
3336 | "RTN","RCX FMSUF",138 ,0) | ||||
3337 | 30 ;;TRICA RE ;0160 A1 ;0160A1 | ||||
3338 | "RTN","RCX FMSUF",139 ,0) | ||||
3339 | 31 ;;TRICA RE PATIENT ;0160 A1 ;0160A1 | ||||
3340 | "RTN","RCX FMSUF",140 ,0) | ||||
3341 | 32 ;;TRICA RE THIRD P ARTY ;0160 A1 ;0160A1 | ||||
3342 | "RTN","RCX FMSUF",141 ,0) | ||||
3343 | 33 ;;ADULT DAY HEALT H CARE ;4032 ;528709 | ||||
3344 | "RTN","RCX FMSUF",142 ,0) | ||||
3345 | 34 ;;DOMIC ILIARY ;4032 ;528709 | ||||
3346 | "RTN","RCX FMSUF",143 ,0) | ||||
3347 | 35 ;;RESPI TE CARE-IN STITUTIONA L ;4032 ;528709 | ||||
3348 | "RTN","RCX FMSUF",144 ,0) | ||||
3349 | 36 ;;RESPI TE CARE-NO N-INSTITUT IONAL;4032 ;528709 | ||||
3350 | "RTN","RCX FMSUF",145 ,0) | ||||
3351 | 37 ;;GERIA TRIC EVAL- INSTITUTIO NAL ;4032 ;528709 | ||||
3352 | "RTN","RCX FMSUF",146 ,0) | ||||
3353 | 38 ;;GERIA TRIC EVAL- NON-INSTIT UTION;4032 ;528709 | ||||
3354 | "RTN","RCX FMSUF",147 ,0) | ||||
3355 | 39 ;;NURSI NG HOME CA RE-LTC ;4032 ;528709 | ||||
3356 | "RTN","RCX FMSUF",148 ,0) | ||||
3357 | 40 ;;NURSI NG HOME PR OCEEDS ; ;528705 | ||||
3358 | "RTN","RCX FMSUF",149 ,0) | ||||
3359 | 41 ;;PARKI NG FEES ; ;528706 | ||||
3360 | "RTN","RCX FMSUF",150 ,0) | ||||
3361 | 42 ;;CWT P ROCEEDS ; ;528707 | ||||
3362 | "RTN","RCX FMSUF",151 ,0) | ||||
3363 | 43 ;;COMP & PEN PROC EEDS ; ;528708 | ||||
3364 | "RTN","RCX FMSUF",152 ,0) | ||||
3365 | 44 ;;ENHAN CED USE LE ASE PROCEE DS ;5358 .3 ;528710 | ||||
3366 | "RTN","RCX FMSUF",153 ,0) | ||||
3367 | 45 ;;FEE R EIMB INS ; ;528713 | ||||
3368 | "RTN","RCX FMSUF",154 ,0) | ||||
3369 | ; | ||||
3370 | "RTN","RCX FMSUF",155 ,0) | ||||
3371 | ; | ||||
3372 | "RTN","RCX FMSUR") | ||||
3373 | 0^6^B60950 863^B58588 015 | ||||
3374 | "RTN","RCX FMSUR",1,0 ) | ||||
3375 | RCXFMSUR ; WISC/RFJ-r evenue sou rce codes ;10/19/10 1:47pm | ||||
3376 | "RTN","RCX FMSUR",2,0 ) | ||||
3377 | ;;4.5;Acc ounts Rece ivable;**9 0,101,170, 203,173,22 0,231,273, 310**;Mar 20, 1995;B uild 14 | ||||
3378 | "RTN","RCX FMSUR",3,0 ) | ||||
3379 | ;Per VA D irective 6 402,this r outine sho uld not be modified. | ||||
3380 | "RTN","RCX FMSUR",4,0 ) | ||||
3381 | Q | ||||
3382 | "RTN","RCX FMSUR",5,0 ) | ||||
3383 | ; | ||||
3384 | "RTN","RCX FMSUR",6,0 ) | ||||
3385 | ; | ||||
3386 | "RTN","RCX FMSUR",7,0 ) | ||||
3387 | CALCRSC(BI LLDA,RCEFT ) ; calcu late the r evenue sou rce code f or a bill | ||||
3388 | "RTN","RCX FMSUR",8,0 ) | ||||
3389 | ; rceft = 1 if pro cessing an EFT depos it | ||||
3390 | "RTN","RCX FMSUR",9,0 ) | ||||
3391 | ; return s the 4 co lumn (char acter) rsc | ||||
3392 | "RTN","RCX FMSUR",10, 0) | ||||
3393 | N CATEGDA ,COLUMN1,C OLUMN2,COL UMN3,COLUM N4,RSC | ||||
3394 | "RTN","RCX FMSUR",11, 0) | ||||
3395 | ; if rsc already c alculated, return it | ||||
3396 | "RTN","RCX FMSUR",12, 0) | ||||
3397 | I $G(RCEF T)=1 S RSC ="8NZZ" Q RSC | ||||
3398 | "RTN","RCX FMSUR",13, 0) | ||||
3399 | S RSC=$P( $G(^PRCA(4 30,BILLDA, 11)),"^",2 3) | ||||
3400 | "RTN","RCX FMSUR",14, 0) | ||||
3401 | I $L(RSC) =4,RSC'="A RRV" Q RSC | ||||
3402 | "RTN","RCX FMSUR",15, 0) | ||||
3403 | ; | ||||
3404 | "RTN","RCX FMSUR",16, 0) | ||||
3405 | ; calcul ate it and store it | ||||
3406 | "RTN","RCX FMSUR",17, 0) | ||||
3407 | S CATEGDA =+$P($G(^P RCA(430,BI LLDA,0))," ^",2) | ||||
3408 | "RTN","RCX FMSUR",18, 0) | ||||
3409 | ; | ||||
3410 | "RTN","RCX FMSUR",19, 0) | ||||
3411 | ; if pre payment, s end ARRV | ||||
3412 | "RTN","RCX FMSUR",20, 0) | ||||
3413 | I CATEGDA =26 D STOR E(BILLDA," ARRV") Q " ARRV" | ||||
3414 | "RTN","RCX FMSUR",21, 0) | ||||
3415 | ; | ||||
3416 | "RTN","RCX FMSUR",22, 0) | ||||
3417 | S COLUMN1 =$$COLUMN1 | ||||
3418 | "RTN","RCX FMSUR",23, 0) | ||||
3419 | ; | ||||
3420 | "RTN","RCX FMSUR",24, 0) | ||||
3421 | ; check f or 3rd par ty RX bill s after 4/ 27/2011 fo r col 2 | ||||
3422 | "RTN","RCX FMSUR",25, 0) | ||||
3423 | N RX3P S RX3P=0 | ||||
3424 | "RTN","RCX FMSUR",26, 0) | ||||
3425 | I ("PH"=$ $TYP^IBRFN (BILLDA)) D | ||||
3426 | "RTN","RCX FMSUR",27, 0) | ||||
3427 | . S RX3P =$$CHECKRX S^RCXFMSUF (BILLDA) | ||||
3428 | "RTN","RCX FMSUR",28, 0) | ||||
3429 | ; | ||||
3430 | "RTN","RCX FMSUR",29, 0) | ||||
3431 | S COLUMN2 =$$COLUMN2 | ||||
3432 | "RTN","RCX FMSUR",30, 0) | ||||
3433 | ; | ||||
3434 | "RTN","RCX FMSUR",31, 0) | ||||
3435 | ; if col umn2 canno t be deter mined, ret urn the rs c of ARRV | ||||
3436 | "RTN","RCX FMSUR",32, 0) | ||||
3437 | I COLUMN2 ="" D STOR E(BILLDA," ARRV") Q " ARRV" | ||||
3438 | "RTN","RCX FMSUR",33, 0) | ||||
3439 | ; | ||||
3440 | "RTN","RCX FMSUR",34, 0) | ||||
3441 | ; if col umn2 is no t a 5 for reimbursab le health insurance, or catego ry not 45 (FEE REIMB INS) | ||||
3442 | "RTN","RCX FMSUR",35, 0) | ||||
3443 | ; return ZZ in col umns 3 and 4 | ||||
3444 | "RTN","RCX FMSUR",36, 0) | ||||
3445 | I COLUMN2 '=5,CATEGD A'=45 D ST ORE(BILLDA ,COLUMN1_C OLUMN2_"ZZ ") Q COLUM N1_COLUMN2 _"ZZ" | ||||
3446 | "RTN","RCX FMSUR",37, 0) | ||||
3447 | ; | ||||
3448 | "RTN","RCX FMSUR",38, 0) | ||||
3449 | ; for re imbursable health in surance, c ompute col umns 3 and 4 | ||||
3450 | "RTN","RCX FMSUR",39, 0) | ||||
3451 | S COLUMN3 =$$COLUMN3 | ||||
3452 | "RTN","RCX FMSUR",40, 0) | ||||
3453 | S COLUMN4 =$$COLUMN4 | ||||
3454 | "RTN","RCX FMSUR",41, 0) | ||||
3455 | ; | ||||
3456 | "RTN","RCX FMSUR",42, 0) | ||||
3457 | D STORE(B ILLDA,COLU MN1_COLUMN 2_COLUMN3_ COLUMN4) | ||||
3458 | "RTN","RCX FMSUR",43, 0) | ||||
3459 | Q COLUMN1 _COLUMN2_C OLUMN3_COL UMN4 | ||||
3460 | "RTN","RCX FMSUR",44, 0) | ||||
3461 | ; | ||||
3462 | "RTN","RCX FMSUR",45, 0) | ||||
3463 | ; | ||||
3464 | "RTN","RCX FMSUR",46, 0) | ||||
3465 | STORE(DA,R SC,FUND) ; store th e revenue source cod e or fund in the fi le | ||||
3466 | "RTN","RCX FMSUR",47, 0) | ||||
3467 | I $G(^PRC A(430,DA,0 ))="" Q | ||||
3468 | "RTN","RCX FMSUR",48, 0) | ||||
3469 | N D,D0,DI ,DIC,DIE,D Q,DR,X,Y | ||||
3470 | "RTN","RCX FMSUR",49, 0) | ||||
3471 | S DR="" | ||||
3472 | "RTN","RCX FMSUR",50, 0) | ||||
3473 | I $G(RSC) '="" S DR= "255.1//// "_RSC_";" | ||||
3474 | "RTN","RCX FMSUR",51, 0) | ||||
3475 | I $G(FUND )'="" S DR =DR_"203// //"_FUND_" ;" | ||||
3476 | "RTN","RCX FMSUR",52, 0) | ||||
3477 | S (DIC,DI E)="^PRCA( 430," | ||||
3478 | "RTN","RCX FMSUR",53, 0) | ||||
3479 | D ^DIE | ||||
3480 | "RTN","RCX FMSUR",54, 0) | ||||
3481 | Q | ||||
3482 | "RTN","RCX FMSUR",55, 0) | ||||
3483 | ; | ||||
3484 | "RTN","RCX FMSUR",56, 0) | ||||
3485 | ; | ||||
3486 | "RTN","RCX FMSUR",57, 0) | ||||
3487 | COLUMN1() ; return column 1 n umber | ||||
3488 | "RTN","RCX FMSUR",58, 0) | ||||
3489 | Q 8 | ||||
3490 | "RTN","RCX FMSUR",59, 0) | ||||
3491 | ; | ||||
3492 | "RTN","RCX FMSUR",60, 0) | ||||
3493 | ; | ||||
3494 | "RTN","RCX FMSUR",61, 0) | ||||
3495 | COLUMN2() ; return column 2 n umber | ||||
3496 | "RTN","RCX FMSUR",62, 0) | ||||
3497 | I CATEGDA =5 Q 1 ; hospita l care (ns c) | ||||
3498 | "RTN","RCX FMSUR",63, 0) | ||||
3499 | I CATEGDA =4 Q 2 ; outpati ent care ( nsc) | ||||
3500 | "RTN","RCX FMSUR",64, 0) | ||||
3501 | I CATEGDA =3 Q 3 ; nursing home care (nsc) | ||||
3502 | "RTN","RCX FMSUR",65, 0) | ||||
3503 | I CATEGDA =1 Q 4 ; ineligi ble hospit al | ||||
3504 | "RTN","RCX FMSUR",66, 0) | ||||
3505 | I CATEGDA =9&$G(RX3P ) Q "R" ; pharmac y reimburs able healt h insuranc e | ||||
3506 | "RTN","RCX FMSUR",67, 0) | ||||
3507 | I CATEGDA =9 Q 5 ; reimbur sable heal th insuran ce | ||||
3508 | "RTN","RCX FMSUR",68, 0) | ||||
3509 | I CATEGDA =10&$G(RX3 P) Q "S" ; pharm acy tort f easor | ||||
3510 | "RTN","RCX FMSUR",69, 0) | ||||
3511 | I CATEGDA =10 Q 6 ; tort fe asor | ||||
3512 | "RTN","RCX FMSUR",70, 0) | ||||
3513 | I CATEGDA =6&$G(RX3P ) Q "T" ;pharmac y workman' s comp | ||||
3514 | "RTN","RCX FMSUR",71, 0) | ||||
3515 | I CATEGDA =6 Q 7 ; workman s comp | ||||
3516 | "RTN","RCX FMSUR",72, 0) | ||||
3517 | I CATEGDA =18 Q 8 ; c (mean s test) | ||||
3518 | "RTN","RCX FMSUR",73, 0) | ||||
3519 | I CATEGDA =2 Q 9 ; emergen cy/humanit arian | ||||
3520 | "RTN","RCX FMSUR",74, 0) | ||||
3521 | I CATEGDA =7&$G(RX3P ) Q "Q" ;pharmac y no fault auto acc | ||||
3522 | "RTN","RCX FMSUR",75, 0) | ||||
3523 | I CATEGDA =7 Q "A" ; no faul t auto acc ident | ||||
3524 | "RTN","RCX FMSUR",76, 0) | ||||
3525 | I CATEGDA =22 Q "B" ; rx copa y/sc vet | ||||
3526 | "RTN","RCX FMSUR",77, 0) | ||||
3527 | I CATEGDA =23 Q "C" ; rx copa y/nsc vet | ||||
3528 | "RTN","RCX FMSUR",78, 0) | ||||
3529 | I CATEGDA =24 Q "D" ; nursing home care per diem | ||||
3530 | "RTN","RCX FMSUR",79, 0) | ||||
3531 | I CATEGDA =25 Q "E" ; hospita l care per diem | ||||
3532 | "RTN","RCX FMSUR",80, 0) | ||||
3533 | I CATEGDA =21 Q "F" ; medicar e | ||||
3534 | "RTN","RCX FMSUR",81, 0) | ||||
3535 | I CATEGDA =33 Q "G" ; adult d ay health care | ||||
3536 | "RTN","RCX FMSUR",82, 0) | ||||
3537 | I CATEGDA =34 Q "H" ; domicil iary | ||||
3538 | "RTN","RCX FMSUR",83, 0) | ||||
3539 | I CATEGDA =35 Q "I" ; respite care - in stitutiona l | ||||
3540 | "RTN","RCX FMSUR",84, 0) | ||||
3541 | I CATEGDA =36 Q "J" ; respite care - no n-institut ional | ||||
3542 | "RTN","RCX FMSUR",85, 0) | ||||
3543 | I CATEGDA =37 Q "K" ; geriatr ic evaluat ion - inst itutional | ||||
3544 | "RTN","RCX FMSUR",86, 0) | ||||
3545 | I CATEGDA =38 Q "L" ; geriatr ic evaluat ion - non- institutio nal | ||||
3546 | "RTN","RCX FMSUR",87, 0) | ||||
3547 | I CATEGDA =39 Q "M" ; nursing home care - ltc | ||||
3548 | "RTN","RCX FMSUR",88, 0) | ||||
3549 | I CATEGDA =45 Q "F" ; Fee Bas is | ||||
3550 | "RTN","RCX FMSUR",89, 0) | ||||
3551 | Q "" | ||||
3552 | "RTN","RCX FMSUR",90, 0) | ||||
3553 | ; | ||||
3554 | "RTN","RCX FMSUR",91, 0) | ||||
3555 | ; | ||||
3556 | "RTN","RCX FMSUR",92, 0) | ||||
3557 | COLUMN3() ; return the column 3 number | ||||
3558 | "RTN","RCX FMSUR",93, 0) | ||||
3559 | N AGE,DEC IMAL,DFN,I BCNDATA,TY PEAGE,TYPE CARE,TYPEM EAN,TYPESE RV,VA,VADM ,VAERR | ||||
3560 | "RTN","RCX FMSUR",94, 0) | ||||
3561 | D DIQ399( BILLDA) | ||||
3562 | "RTN","RCX FMSUR",95, 0) | ||||
3563 | ; | ||||
3564 | "RTN","RCX FMSUR",96, 0) | ||||
3565 | ; PRCA*4 .5*310/DRF | ||||
3566 | "RTN","RCX FMSUR",97, 0) | ||||
3567 | ; for Fe e Basis, c olumn3 = 1 (inpatien t) or 2 (o utpatient) | ||||
3568 | "RTN","RCX FMSUR",98, 0) | ||||
3569 | I CATEGDA =45 S COLU MN3=$S($G( IBCNDATA(3 99,BILLDA, .05,"I"))= 1:1,$G(IBC NDATA(399, BILLDA,.05 ,"I"))=2:2 ,1:2) Q CO LUMN3 | ||||
3570 | "RTN","RCX FMSUR",99, 0) | ||||
3571 | ; | ||||
3572 | "RTN","RCX FMSUR",100 ,0) | ||||
3573 | D TYPECAR E | ||||
3574 | "RTN","RCX FMSUR",101 ,0) | ||||
3575 | ; | ||||
3576 | "RTN","RCX FMSUR",102 ,0) | ||||
3577 | ; comput e service connected at time of care (1 d igit binar y) | ||||
3578 | "RTN","RCX FMSUR",103 ,0) | ||||
3579 | ; type o f service connected is set as follows: | ||||
3580 | "RTN","RCX FMSUR",104 ,0) | ||||
3581 | ; 0 = SC Vet 1 = NSC Vet | ||||
3582 | "RTN","RCX FMSUR",105 ,0) | ||||
3583 | S TYPESER V=1 | ||||
3584 | "RTN","RCX FMSUR",106 ,0) | ||||
3585 | ; servic e connecte d at time of care (. 18) = yes (1) | ||||
3586 | "RTN","RCX FMSUR",107 ,0) | ||||
3587 | I $G(IBCN DATA(399,B ILLDA,.18, "I"))=1 S TYPESERV=0 | ||||
3588 | "RTN","RCX FMSUR",108 ,0) | ||||
3589 | ; | ||||
3590 | "RTN","RCX FMSUR",109 ,0) | ||||
3591 | S DFN=$P( $G(^PRCA(4 30,BILLDA, 0)),"^",7) | ||||
3592 | "RTN","RCX FMSUR",110 ,0) | ||||
3593 | D DEM^VAD PT | ||||
3594 | "RTN","RCX FMSUR",111 ,0) | ||||
3595 | ; | ||||
3596 | "RTN","RCX FMSUR",112 ,0) | ||||
3597 | ; comput e means te st at time of care ( 1 digit bi nary) | ||||
3598 | "RTN","RCX FMSUR",113 ,0) | ||||
3599 | ; type o f means te st is set as follows : | ||||
3600 | "RTN","RCX FMSUR",114 ,0) | ||||
3601 | ; 0 = Cat A 1 = Cat C | ||||
3602 | "RTN","RCX FMSUR",115 ,0) | ||||
3603 | S TYPEMEA N=0 | ||||
3604 | "RTN","RCX FMSUR",116 ,0) | ||||
3605 | I $$BIL^D GMTUB(DFN, $G(IBCNDAT A(399,BILL DA,151,"I" )))=1 S TY PEMEAN=1 | ||||
3606 | "RTN","RCX FMSUR",117 ,0) | ||||
3607 | ; | ||||
3608 | "RTN","RCX FMSUR",118 ,0) | ||||
3609 | ; comput e patient age at tim e of care (1 digit b inary) | ||||
3610 | "RTN","RCX FMSUR",119 ,0) | ||||
3611 | ; type o f age is s et as foll ows: | ||||
3612 | "RTN","RCX FMSUR",120 ,0) | ||||
3613 | ; 0 = under 65 1 = 65 and older | ||||
3614 | "RTN","RCX FMSUR",121 ,0) | ||||
3615 | S AGE=$$F MDIFF^XLFD T($G(IBCND ATA(399,BI LLDA,151," I")),$P($G (VADM(3)), "^"))\365. 25 | ||||
3616 | "RTN","RCX FMSUR",122 ,0) | ||||
3617 | S TYPEAGE =1 | ||||
3618 | "RTN","RCX FMSUR",123 ,0) | ||||
3619 | I AGE<65 S TYPEAGE= 0 | ||||
3620 | "RTN","RCX FMSUR",124 ,0) | ||||
3621 | ; | ||||
3622 | "RTN","RCX FMSUR",125 ,0) | ||||
3623 | ; conver t to decim al typeca re typese rv typeme an typeag e | ||||
3624 | "RTN","RCX FMSUR",126 ,0) | ||||
3625 | ; binar y= 1 1 1 1 1 | ||||
3626 | "RTN","RCX FMSUR",127 ,0) | ||||
3627 | ; decima l= 16 + 8 + 4 + 2 + 1 | ||||
3628 | "RTN","RCX FMSUR",128 ,0) | ||||
3629 | S DECIMAL =$S(TYPECA RE="11":24 ,TYPECARE= "10":16,TY PECARE="01 ":8,1:0) | ||||
3630 | "RTN","RCX FMSUR",129 ,0) | ||||
3631 | I TYPESER V S DECIMA L=DECIMAL+ 4 | ||||
3632 | "RTN","RCX FMSUR",130 ,0) | ||||
3633 | I TYPEMEA N S DECIMA L=DECIMAL+ 2 | ||||
3634 | "RTN","RCX FMSUR",131 ,0) | ||||
3635 | I TYPEAGE S DECIMAL =DECIMAL+1 | ||||
3636 | "RTN","RCX FMSUR",132 ,0) | ||||
3637 | I DECIMAL <10 Q DECI MAL | ||||
3638 | "RTN","RCX FMSUR",133 ,0) | ||||
3639 | Q $C(65+D ECIMAL-10) | ||||
3640 | "RTN","RCX FMSUR",134 ,0) | ||||
3641 | ; | ||||
3642 | "RTN","RCX FMSUR",135 ,0) | ||||
3643 | ; | ||||
3644 | "RTN","RCX FMSUR",136 ,0) | ||||
3645 | COLUMN4() ; return the column 4 number (reserved for future expansion ) | ||||
3646 | "RTN","RCX FMSUR",137 ,0) | ||||
3647 | Q "Z" | ||||
3648 | "RTN","RCX FMSUR",138 ,0) | ||||
3649 | ; | ||||
3650 | "RTN","RCX FMSUR",139 ,0) | ||||
3651 | ; | ||||
3652 | "RTN","RCX FMSUR",140 ,0) | ||||
3653 | DIQ399(DA) ; get d ata from f ile 399 | ||||
3654 | "RTN","RCX FMSUR",141 ,0) | ||||
3655 | N D0,DIC, DIQ,DIQ2,D R | ||||
3656 | "RTN","RCX FMSUR",142 ,0) | ||||
3657 | K IBCNDAT A | ||||
3658 | "RTN","RCX FMSUR",143 ,0) | ||||
3659 | S DIQ(0)= "IE",DIC=" ^DGCR(399, ",DIQ="IBC NDATA",DR= ".04;.05;. 18;151;" D EN^DIQ1 | ||||
3660 | "RTN","RCX FMSUR",144 ,0) | ||||
3661 | Q | ||||
3662 | "RTN","RCX FMSUR",145 ,0) | ||||
3663 | ; | ||||
3664 | "RTN","RCX FMSUR",146 ,0) | ||||
3665 | ; | ||||
3666 | "RTN","RCX FMSUR",147 ,0) | ||||
3667 | TYPECARE ; compute type of ca re (2 digi t binary) | ||||
3668 | "RTN","RCX FMSUR",148 ,0) | ||||
3669 | ; type o f care is set as fol lows: | ||||
3670 | "RTN","RCX FMSUR",149 ,0) | ||||
3671 | ; 00 = inpatie nt (hospit al) 01 = outpatie nt | ||||
3672 | "RTN","RCX FMSUR",150 ,0) | ||||
3673 | ; 10 = nursing home 11 = other | ||||
3674 | "RTN","RCX FMSUR",151 ,0) | ||||
3675 | ; defaul t is other if it can not be com puted | ||||
3676 | "RTN","RCX FMSUR",152 ,0) | ||||
3677 | S TYPECAR E="11" | ||||
3678 | "RTN","RCX FMSUR",153 ,0) | ||||
3679 | ; bill c lassificat ion (.05) = outpatie nt (3) or human.emer g(opt) (4) | ||||
3680 | "RTN","RCX FMSUR",154 ,0) | ||||
3681 | I $G(IBCN DATA(399,B ILLDA,.05, "I"))=3!($ G(IBCNDATA (399,BILLD A,.05,"I") )=4) S TYP ECARE="01" Q | ||||
3682 | "RTN","RCX FMSUR",155 ,0) | ||||
3683 | ; locati on of care (.04) = h ospital in pt or outp t (1) | ||||
3684 | "RTN","RCX FMSUR",156 ,0) | ||||
3685 | I $G(IBCN DATA(399,B ILLDA,.04, "I"))=1 S TYPECARE=" 00" Q | ||||
3686 | "RTN","RCX FMSUR",157 ,0) | ||||
3687 | ; locati on of care (.04) = s killed nur sing (nhcu ) (2) | ||||
3688 | "RTN","RCX FMSUR",158 ,0) | ||||
3689 | I $G(IBCN DATA(399,B ILLDA,.04, "I"))=2 S TYPECARE=" 10" | ||||
3690 | "RTN","RCX FMSUR",159 ,0) | ||||
3691 | Q | ||||
3692 | "RTN","RCX FMSUR",160 ,0) | ||||
3693 | ; | ||||
3694 | "RTN","RCX FMSUR",161 ,0) | ||||
3695 | ; | ||||
3696 | "RTN","RCX FMSUR",162 ,0) | ||||
3697 | ADDEDIT ; enter/edi t revenue source cod es for fun d 0160A1 b ills. The se | ||||
3698 | "RTN","RCX FMSUR",163 ,0) | ||||
3699 | ; bills have the r sc entered by the us er. The u ser can se lect | ||||
3700 | "RTN","RCX FMSUR",164 ,0) | ||||
3701 | ; from r scs in fil e 347.3 | ||||
3702 | "RTN","RCX FMSUR",165 ,0) | ||||
3703 | W !!,"Thi s option s hould be u sed with C AUTION. T his option will allo w the" | ||||
3704 | "RTN","RCX FMSUR",166 ,0) | ||||
3705 | W !,"user owning th e PRCASVC supervisor security key, to ad d or edit the" | ||||
3706 | "RTN","RCX FMSUR",167 ,0) | ||||
3707 | W !,"Reve nue Source Codes sel ectable fo r non MCCF bills. I f an inval id" | ||||
3708 | "RTN","RCX FMSUR",168 ,0) | ||||
3709 | W !,"Reve nue Source Code is e ntered or changed, a ll code sh eets sent to" | ||||
3710 | "RTN","RCX FMSUR",169 ,0) | ||||
3711 | W !,"FMS referencin g the inva lid Revenu e Source C ode will r eject. Be " | ||||
3712 | "RTN","RCX FMSUR",170 ,0) | ||||
3713 | W !,"caut ious when entering n ew Revenue Source Co des or edi ting exist ing" | ||||
3714 | "RTN","RCX FMSUR",171 ,0) | ||||
3715 | W !,"Reve nue Source Codes. N ew Revenue Source Co des should only be a dded" | ||||
3716 | "RTN","RCX FMSUR",172 ,0) | ||||
3717 | W !,"afte r they hav e been add ed in FMS. " | ||||
3718 | "RTN","RCX FMSUR",173 ,0) | ||||
3719 | ; | ||||
3720 | "RTN","RCX FMSUR",174 ,0) | ||||
3721 | I '$D(^XU SEC("PRCAS VC",DUZ)) W !!,"You are not an owner of the PRCASV C security key." Q | ||||
3722 | "RTN","RCX FMSUR",175 ,0) | ||||
3723 | ; | ||||
3724 | "RTN","RCX FMSUR",176 ,0) | ||||
3725 | N %,%Y,C, D,D0,DA,DI ,DIC,DIE,D LAYGO,DQ,D R,RCRJFLAG ,X,X1,X2,X 3,Y | ||||
3726 | "RTN","RCX FMSUR",177 ,0) | ||||
3727 | ; | ||||
3728 | "RTN","RCX FMSUR",178 ,0) | ||||
3729 | F D Q:$ G(RCRJFLAG ) | ||||
3730 | "RTN","RCX FMSUR",179 ,0) | ||||
3731 | . S (DIC, DIE)="^RC( 347.3,",DI C(0)="QEL" ,DLAYGO=34 7.3 | ||||
3732 | "RTN","RCX FMSUR",180 ,0) | ||||
3733 | . R !!,"S elect REVE NUE SOURCE CODE: ",X :DTIME | ||||
3734 | "RTN","RCX FMSUR",181 ,0) | ||||
3735 | . S X1=X, X=$$UPPER^ VALM1(X) | ||||
3736 | "RTN","RCX FMSUR",182 ,0) | ||||
3737 | . I $E(X) ="?",X?."? " D ^DIC Q :Y<1 | ||||
3738 | "RTN","RCX FMSUR",183 ,0) | ||||
3739 | . I X=""! ($E(X)=U) S RCRJFLAG =1 Q | ||||
3740 | "RTN","RCX FMSUR",184 ,0) | ||||
3741 | . I $D(^R C(347.3,"B ",X)) S Y= +$O(^(X,0) ) W " ", X," ",$P( $G(^RC(347 .3,Y,0)),U ,2) W:$P(^ (0),U,3) " INACTIVE " D UPD Q | ||||
3742 | "RTN","RCX FMSUR",185 ,0) | ||||
3743 | . S X2=$L (X1),X3=$C ($A($E(X1, X2))-1),X3 =$E(X1,1,X 2-1)_X3,X3 =$O(^RC(34 7.3,"C",X3 )) I $E(X3 ,1,X2)=X1 S X=X1 | ||||
3744 | "RTN","RCX FMSUR",186 ,0) | ||||
3745 | . S D="C" D IX^DIC Q:Y<1 D U PD Q | ||||
3746 | "RTN","RCX FMSUR",187 ,0) | ||||
3747 | Q | ||||
3748 | "RTN","RCX FMSUR",188 ,0) | ||||
3749 | UPD S DIE= "^RC(347.3 ,",DA=+Y,D R=".02;.03 " D ^DIE | ||||
3750 | "RTN","RCX FMSUR",189 ,0) | ||||
3751 | Q | ||||
3752 | "RTN","RCX FMSUR",190 ,0) | ||||
3753 | ; | ||||
3754 | "RTN","RCX FMSUR",191 ,0) | ||||
3755 | ; | ||||
3756 | "RTN","RCX FMSUR",192 ,0) | ||||
3757 | RSC ;reven ue code (# 430/255) | ||||
3758 | "RTN","RCX FMSUR",193 ,0) | ||||
3759 | I $P($G(^ RC(347.3,X ,0)),"^",3 ) D EN^DDI OL("THIS R EVENUE SOU RCE CODE I S INACTIVE .") K X Q | ||||
3760 | "RTN","RCX FMSUR",194 ,0) | ||||
3761 | S X=$P(^R C(347.3,X, 0),"^") | ||||
3762 | "RTN","RCX FMSUR",195 ,0) | ||||
3763 | Q | ||||
3764 | "RTN","RCX FMSUR",196 ,0) | ||||
3765 | ; | ||||
3766 | "RTN","RCX FMSUR",197 ,0) | ||||
3767 | SHOW ; sh ow/calcula te revenue source co de for a s elected bi ll | ||||
3768 | "RTN","RCX FMSUR",198 ,0) | ||||
3769 | W !!,"Thi s option w ill show t he calcula ted Revenu e Source C ode for a selected" | ||||
3770 | "RTN","RCX FMSUR",199 ,0) | ||||
3771 | W !,"bill . The Rev enue Sourc e Code is only calcu lated for accrued bi lls in" | ||||
3772 | "RTN","RCX FMSUR",200 ,0) | ||||
3773 | I DT'<$$A DDPTEDT^PR CAACC() W !,"funds 5 28701,5287 03,528704, 528709/403 2,528711,5 28713" | ||||
3774 | "RTN","RCX FMSUR",201 ,0) | ||||
3775 | I DT<$$AD DPTEDT^PRC AACC() W ! ,"funds 52 87.1,5287. 3,5287.4,4 032" | ||||
3776 | "RTN","RCX FMSUR",202 ,0) | ||||
3777 | ; | ||||
3778 | "RTN","RCX FMSUR",203 ,0) | ||||
3779 | N %,%Y,BI LLDA,C,DIC ,FUND,I,RC RJFLAG,RSC ,X,Y | ||||
3780 | "RTN","RCX FMSUR",204 ,0) | ||||
3781 | ; | ||||
3782 | "RTN","RCX FMSUR",205 ,0) | ||||
3783 | F D Q:$ G(RCRJFLAG ) | ||||
3784 | "RTN","RCX FMSUR",206 ,0) | ||||
3785 | . S DIC ="^PRCA(43 0,",DIC(0) ="QEAM" | ||||
3786 | "RTN","RCX FMSUR",207 ,0) | ||||
3787 | . W ! D ^DIC | ||||
3788 | "RTN","RCX FMSUR",208 ,0) | ||||
3789 | . I Y<1 S RCRJFLA G=1 Q | ||||
3790 | "RTN","RCX FMSUR",209 ,0) | ||||
3791 | . S BIL LDA=+Y | ||||
3792 | "RTN","RCX FMSUR",210 ,0) | ||||
3793 | . S FUN D=$$GETFUN DB^RCXFMSU F(BILLDA,1 ) | ||||
3794 | "RTN","RCX FMSUR",211 ,0) | ||||
3795 | . W !!, " B ill Number : ",$P($G( ^PRCA(430, BILLDA,0)) ,"^") | ||||
3796 | "RTN","RCX FMSUR",212 ,0) | ||||
3797 | . W !," Fund: ",FUND | ||||
3798 | "RTN","RCX FMSUR",213 ,0) | ||||
3799 | . I '$$ PTACCT^PRC AACC(FUND) ,FUND'=403 2 D Q | ||||
3800 | "RTN","RCX FMSUR",214 ,0) | ||||
3801 | . . W !," The Revenue So urce Code cannot be calculated for non-a ccrued bil ls." | ||||
3802 | "RTN","RCX FMSUR",215 ,0) | ||||
3803 | . . W !," The Revenue So urce Code for non-ac crued bill s are inpu t by the u ser." | ||||
3804 | "RTN","RCX FMSUR",216 ,0) | ||||
3805 | . . W !," The Revenue So urce Code is current ly entered as: " | ||||
3806 | "RTN","RCX FMSUR",217 ,0) | ||||
3807 | . . S RSC=$P($G (^PRCA(430 ,BILLDA,11 )),"^",6) | ||||
3808 | "RTN","RCX FMSUR",218 ,0) | ||||
3809 | . . W $S(RSC="" :"<not ent ered>",1:R SC) | ||||
3810 | "RTN","RCX FMSUR",219 ,0) | ||||
3811 | . ; | ||||
3812 | "RTN","RCX FMSUR",220 ,0) | ||||
3813 | . S RSC =$$CALCRSC (BILLDA) | ||||
3814 | "RTN","RCX FMSUR",221 ,0) | ||||
3815 | . W !," Revenue So urce Code: ",RSC | ||||
3816 | "RTN","RCX FMSUR",222 ,0) | ||||
3817 | Q | ||||
3818 | "VER") | ||||
3819 | 8.0^22.0 | ||||
3820 | "BLD",9717 ,6) | ||||
3821 | 14^ | ||||
3822 | **END** | ||||
3823 | **END** | ||||
3824 | |||||
3825 |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.