source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCRJRCO1.m@ 710

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

initial load of WorldVistAEHR
File size: 4.8 KB
Line 
1RCRJRCO1 ;WISC/RFJ/BGJ-continuation of ar data collector ;1 Mar 97
2 ;;4.5;Accounts Receivable;**68,96,101,120,103,153,156,170,182,203**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7START ; calculate ndb values from file 433 transactions
8 ; needs datebeg, dateend
9 ; total is total by category
10 ;
11 N ADMIN,BILLDA,DATE,INTEREST,PRINBAL,TRANDA,TRANTYPE,VALUE,RCNOHSIF
12 ;
13 S RCNOHSIF=$$NOHSIF^RCRJRCO() ; no HSIF (disabled)
14 ;
15 F TRANTYPE=1,2,3,8,9,10,11,12,13,14,34,35,41,43 D
16 . S DATE=DATEBEG-1
17 . F S DATE=$O(^PRCA(433,"AT",TRANTYPE,DATE)) Q:'DATE!(DATE>DATEEND) D
18 . . S TRANDA=0
19 . . F S TRANDA=$O(^PRCA(433,"AT",TRANTYPE,DATE,TRANDA)) Q:'TRANDA D
20 . . . S BILLDA=+$P($G(^PRCA(433,TRANDA,0)),"^",2) I 'BILLDA Q
21 . . . ; bill not linked to a site
22 . . . I '$P($G(^PRCA(430,BILLDA,0)),"^",12) Q
23 . . . ;
24 . . . ; get a transactions balance
25 . . . S VALUE=$$TRANBAL^RCRJRCOT(TRANDA) I VALUE="" Q
26 . . . S PRINBAL=$P(VALUE,"^"),INTEREST=$P(VALUE,"^",2),ADMIN=$P(VALUE,"^",3)+$P(VALUE,"^",4)+$P(VALUE,"^",5)
27 . . . ;
28 . . . D @TRANTYPE
29 Q
30 ;
31 ;
321 ; increase adjustments
33 D SETTOTAL(14,PRINBAL,0)
34 Q
35 ;
36 ;
372 ; payment in partial
38 N CATEGORY
39 ; prepayment transaction (field #20)
40 I $P($G(^PRCA(433,TRANDA,5)),"^") D Q
41 . D SETTOTAL(21,PRINBAL,0)
42 . I INTEREST D SETTOTAL(38,INTEREST,0)
43 . I ADMIN D SETTOTAL(39,ADMIN,0)
44 ;
45 ; check to see if payment is rx copay and is split between
46 ; mccf and hsif. if the bill has been run through the
47 ; calculator, do it now and report the mccf split to the ndb.
48 ; the amount owed to mccf is in piece 3 and is returned negative
49 S CATEGORY=$P(^PRCA(430,BILLDA,0),"^",2)
50 I 'RCNOHSIF,PRINBAL,(CATEGORY=22!(CATEGORY=23)),'$D(^TMP($J,"RCBMILLDATA",BILLDA,TRANDA)) D
51 . S %=$$BILLFUND^RCBMILLC(BILLDA)
52 ;
53 ; changed by patch PRCA*4.5*182 to no longer separate the mccf and
54 ; hsif components. the entire amount is now reported to the ndb.
55 ;
56 ;. S PRINBAL=-$P($G(^TMP($J,"RCBMILLDATA",BILLDA,TRANDA)),"^",3)
57 ;
58 ; partial payments (trantype=2), full payments (trantype=34)
59 D SETTOTAL($S(TRANTYPE=2:19,1:18),PRINBAL,0)
60 I INTEREST D SETTOTAL(38,INTEREST,0)
61 I ADMIN D SETTOTAL(39,ADMIN,0)
62 ;
63 ; irs, district counsel, dept of justice (#7)
64 S %=$P($G(^PRCA(433,TRANDA,0)),"^",7) I %="" Q
65 I %="IRS" D SETTOTAL(28,PRINBAL,0) Q
66 I %="DC" D SETTOTAL(31,PRINBAL,0) Q
67 I %="DOJ" D SETTOTAL(34,PRINBAL,0) Q
68 Q
69 ;
70 ;
713 ; refer to district counsel
72 D SETTOTAL(30,PRINBAL,0)
73 Q
74 ;
75 ;
768 ; terminate by fiscal officer
77 D WRITEOFF^RCRJRCOC(BILLDA,VALUE,$S(TRANTYPE=8:25,1:24))
78 ; decrease in number of debts
79 I '$D(^TMP($J,"RCRJRCOL","COUNT",BILLDA,17)) D SETTOTAL(17,0,0)
80 Q
81 ;
82 ;
839 ; terminate by compromise
84 D 8
85 Q
86 ;
87 ;
8810 ; payment waived in full
89 D WRITEOFF^RCRJRCOC(BILLDA,VALUE,22)
90 Q
91 ;
92 ;
9311 ; payment waived in partial
94 D WRITEOFF^RCRJRCOC(BILLDA,VALUE,23)
95 Q
96 ;
97 ;
9812 ; admin cost / charge
99 ; interest/admin added
100 I INTEREST>0 D SETTOTAL(40,INTEREST,0)
101 I ADMIN>0 D SETTOTAL(41,ADMIN,0)
102 ; interest/admin cost exempt
103 I INTEREST<0 D SETTOTAL(42,-INTEREST,0)
104 I ADMIN<0 D SETTOTAL(42,-ADMIN,0)
105 Q
106 ;
107 ;
10813 ; interest / admin charge
109 D 12
110 Q
111 ;
112 ;
11314 ; exempt interest / admin cost
114 D SETTOTAL(42,INTEREST,0)
115 Q
116 ;
117 ;
11834 ; payment in full
119 D 2
120 ; decrease in number of debts
121 I '$D(^TMP($J,"RCRJRCOL","COUNT",BILLDA,17)) D SETTOTAL(17,0,0)
122 Q
123 ;
124 ;
12535 ; decrease adjustment
126 N CONTRACT
127 ; contractual adjustment (field #88)
128 S CONTRACT=$P($G(^PRCA(433,TRANDA,8)),"^",8)
129 I CONTRACT D WRITEOFF^RCRJRCOC(BILLDA,VALUE,20) Q
130 D SETTOTAL(16,PRINBAL,0)
131 Q
132 ;
133 ;
13441 ; refund
135 D SETTOTAL(43,PRINBAL,0)
136 Q
137 ;
138 ;
13943 ; re-establishment
140 D SETTOTAL(13,PRINBAL,INTEREST+ADMIN)
141 Q
142 ;
143 ;
144SETTOTAL(CRITER2,AMOUNT,INTEREST) ; store results
145 N RSC,TYPE
146 ;
147 ; this line of code will prevent duplicate counts if a sites cross
148 ; references in file 430 (actdt and asdt) are duplicated (incorrect)
149 I CRITER2<13,$D(^TMP($J,"RCRJRCOL","COUNT",BILLDA,CRITER2)) Q
150 ;
151 ; get a bills criteria 1,3,4,5
152 S CRITERIA=$G(^TMP($J,"RCRJRCOL","CRITERIA",BILLDA))
153 I CRITERIA="" S CRITERIA=$$CRITERIA^RCRJRCOL(BILLDA),^TMP($J,"RCRJRCOL","CRITERIA",BILLDA)=CRITERIA
154 ;
155 ; store for ndb
156 S $P(CRITERIA,"-",2)=CRITER2
157 ;
158 ; store results for ndb
159 S %=$G(@DATASTOR)
160 S $P(%,"^")=$P(%,"^")+1
161 S $P(%,"^",2)=$P(%,"^",2)+AMOUNT
162 S $P(%,"^",3)=$P(%,"^",3)+INTEREST
163 S @DATASTOR=%
164 ;
165 ; keep a count of which category (criter2) a bill is counted in
166 S ^TMP($J,"RCRJRCOL","COUNT",BILLDA,CRITER2)=""
167 S ^TMP($J,"RCRJRCOL","CRIT2",CRITER2,BILLDA)=""
168 ;
169 ; pick up bills with activity which may not have been picked up as
170 ; a current receivable because of the wrong status date
171 I CRITER2>13,CRITER2'=17,'$D(^TMP($J,"RCRJRCOL","COUNT",BILLDA,1)),'$D(^TMP($J,"RCRJRCOL","COUNT",BILLDA,17)) D CURRENT^RCRJRCOB(BILLDA,DATEEND,AYEAROLD)
172 Q
Note: See TracBrowser for help on using the repository browser.