source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCRJRCOC.m@ 1041

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

initial load of FOIAVistA 6/30/08 version
File size: 8.5 KB
Line 
1RCRJRCOC ;WISC/RFJ/BGJ-count current receivables ;1 Aug 00
2 ;;4.5;Accounts Receivable;**156,170,182,203,220,138,239**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ; IA 4385 for call to $$MRATYPE^IBCEMU2
5 Q
6 ;
7 ;
8CURRENT(RCBILLDA,RCVALUE) ; count current bills balance
9 ; rcvalue = prin ^ int ^ admin ^ mf ^ cc
10 ;
11 N %,RCFUND,RCRSC,RCTOHSIF,RCTOMCCF,SGL,TYPE,MRATYPE,ARACTDT,CATEGORY
12 ;
13 ; calculate the rsc for the bill. the rsc is only used for
14 ; mccf bills
15 S RCRSC=""
16 I $$ACCK^PRCAACC(RCBILLDA) S RCRSC=$$CALCRSC^RCXFMSUR(RCBILLDA)
17 ;
18 ; calculate the amount that goes to mccf and hsif
19 D MCCFHSIF(RCBILLDA,RCVALUE,RCRSC,DATEEND+1)
20 ;
21 ; store the data for the ndb, if a 0 is returned by the function,
22 ; then the bill has already been counted as a current receivable,quit
23 I '$$NDBSTORE(RCBILLDA,RCVALUE,1) Q
24 ;
25 ; store results for FMS SV document for accrued bills only
26 ; do not include prepayments (26)
27 I $$ACCK^PRCAACC(RCBILLDA),$P($G(^PRCA(430,RCBILLDA,0)),"^",2)'=26 D
28 . ; get the bills fund and category
29 . S RCFUND=$$GETFUNDB^RCXFMSUF(RCBILLDA)
30 . S RCFUND=$$ADJFUND^RCRJRCO(RCFUND) ; may remove the line after 10/1/03
31 . S CATEGORY=+$P($G(^PRCA(430,RCBILLDA,0)),"^",2)
32 . ;
33 . ; ----- this code is used to set up the SV code sheet -----
34 . S TYPE=21
35 . ; special type for tort feasor
36 . I $E(RCRSC,1,2)=86 S TYPE="2A"
37 . ;
38 . ; Get ARACTDT=AR Date Active for bill
39 . S ARACTDT=+$P($P($G(^PRCA(430,RCBILLDA,6)),"^",21),".")
40 . ; determine Receivable Type: 1=pre-MRA, 2=post-MRA Medicre, 3=post-MRA non-Medicare
41 . ; DBIA #4385 activated on 31-Mar-2004
42 . S MRATYPE=$$MRATYPE^IBCEMU2(RCBILLDA,ARACTDT)
43 . ; set TYPE to 2F for post-MRA Medicare bills or to 2L for
44 . ; post-MRA non-Medicare bills (for RHI receivables only)
45 . I $E(RCRSC,1,2)=85,MRATYPE>1 S TYPE=$S(MRATYPE=2:"2F",1:"2L")
46 . ;
47 . ; store dollars to mccf and hsif
48 . I RCTOMCCF S ^TMP($J,"RCRJRCOLSV",TYPE,RCFUND,RCRSC)=$G(^TMP($J,"RCRJRCOLSV",TYPE,RCFUND,RCRSC))+RCTOMCCF
49 . I RCTOHSIF S ^TMP($J,"RCRJRCOLSV",21,5358.1,$S(RCRSC="8BZZ":"8B1Z",1:"8C1Z"))=$G(^TMP($J,"RCRJRCOLSV",21,5358.1,$S(RCRSC="8BZZ":"8B1Z",1:"8C1Z")))+RCTOHSIF
50 . ;
51 . ; ----- this code is used to build the user report
52 . S %=+$P($P($G(^PRCA(430,RCBILLDA,6)),"^",21),".")
53 . S ^TMP($J,"RCRJRCOLREPORT",%,RCBILLDA)=$P(RCVALUE,"^")_"^"_($P(RCVALUE,"^",2)+$P(RCVALUE,"^",3)+$P(RCVALUE,"^",4)+$P(RCVALUE,"^",5))_"^SV"_TYPE
54 . ;
55 . ; ----- this code is used to build the OIG extract, piece 3 = GL acct
56 . S ^TMP($J,"RCRJROIG",RCBILLDA)=$P(RCVALUE,"^")_"^"_($P(RCVALUE,"^",2)+$P(RCVALUE,"^",3)+$P(RCVALUE,"^",4)+$P(RCVALUE,"^",5))_"^"_$S(TYPE=21:1315,1:1333)
57 . ;
58 . ; ----- this code is used to set up medicare supplemental SVs
59 . S %=$G(^PRCA(430,RCBILLDA,13))
60 . ; medicare contract adjustment field 131 for bills activated in AR during the month the ARDC is running
61 . I $P(%,"^",1),ARACTDT'<DATEBEG D ;
62 . . S ^TMP($J,"RCRJRCOLSV",17)=$G(^TMP($J,"RCRJRCOLSV",17))+$P(%,"^",1)
63 . . S ^TMP($J,"RCRJRCOLSV",17,RCFUND,RCRSC)=$G(^TMP($J,"RCRJRCOLSV",17,RCFUND,RCRSC))+$P(%,"^",1)
64 . ; medicare unreimbursable medicare expense field 132 for bills activated in AR during the month the ARDC is running
65 . I $P(%,"^",2),ARACTDT'<DATEBEG D ;
66 . . S ^TMP($J,"RCRJRCOLSV",18)=$G(^TMP($J,"RCRJRCOLSV",18))+$P(%,"^",2)
67 . . S ^TMP($J,"RCRJRCOLSV",18,RCFUND,RCRSC)=$G(^TMP($J,"RCRJRCOLSV",18,RCFUND,RCRSC))+$P(%,"^",2)
68 . ;
69 . ; ----- this code is used to set up the bad debt report -----
70 . S SGL=$$BDRSGL^RCRJRBD(CATEGORY,RCFUND,MRATYPE)
71 . ; store dollars to mccf and hsif. both are sgl 1319 so 1319.1 is
72 . ; used to put hsif in a subset of 1319
73 . I RCTOMCCF S ^TMP($J,"RCRJRBD",SGL)=$G(^TMP($J,"RCRJRBD",SGL))+RCTOMCCF
74 . I RCTOHSIF S ^TMP($J,"RCRJRBD",1319.1)=$G(^TMP($J,"RCRJRBD",1319.1))+RCTOHSIF
75 ;
76 ; store the interest, admin, mf, cc on the SV code sheet
77 ; interest (type P2; fund 1435; rsc 8047)
78 I $P(RCVALUE,"^",2) S ^TMP($J,"RCRJRCOLSV","P2",1435,8047)=$G(^TMP($J,"RCRJRCOLSV","P2",1435,8047))+$P(RCVALUE,"^",2)
79 ; admin (type P2; fund 3220; rsc 8046)
80 I $P(RCVALUE,"^",3) S ^TMP($J,"RCRJRCOLSV","P2",3220,8046)=$G(^TMP($J,"RCRJRCOLSV","P2",3220,8046))+$P(RCVALUE,"^",3)
81 ; mf + cc (type P2; fund 0869; rsc 8048)
82 S %=$P(RCVALUE,"^",4)+$P(RCVALUE,"^",5)
83 I % S ^TMP($J,"RCRJRCOLSV","P2","0869",8048)=$G(^TMP($J,"RCRJRCOLSV","P2","0869",8048))+%
84 Q
85 ;
86 ;
87WRITEOFF(RCBILLDA,RCVALUE,RCRITER2) ; count write offs
88 ; rcvalue = prin ^ int ^ admin ^ mf ^ cc
89 ; rcriter2 = write off criteria tracked in ndb
90 ;
91 N %,RCFUND,RCRSC,RCTOHSIF,RCTOMCCF,TYPE,MRATYPE,ARACTDT
92 ;
93 ; calculate the rsc for the bill. the rsc is only used for
94 ; mccf bills
95 S RCRSC=""
96 I $$ACCK^PRCAACC(RCBILLDA) S RCRSC=$$CALCRSC^RCXFMSUR(RCBILLDA)
97 ;
98 ; calculate the amount that goes to mccf and hsif
99 D MCCFHSIF(RCBILLDA,RCVALUE,RCRSC,DATEEND+1)
100 ;
101 ; store the data for the ndb, if a 0 is returned by the function,
102 ; then the bill has already been counted as a current receivable,quit
103 I '$$NDBSTORE(RCBILLDA,RCVALUE,RCRITER2) Q
104 ;
105 ; store results for FMS WR document
106 ; do not include prepayments (26)
107 I $$ACCK^PRCAACC(RCBILLDA),$P($G(^PRCA(430,RCBILLDA,0)),"^",2)'=26 D
108 . ; get the bills fund
109 . S RCFUND=$$GETFUNDB^RCXFMSUF(RCBILLDA)
110 . S RCFUND=$$ADJFUND^RCRJRCO(RCFUND) ; may remove the line after 10/1/03
111 . ;
112 . S TYPE=37
113 . ; special type for tort feasor
114 . I $E(RCRSC,1,2)=86 S TYPE=39
115 . S ARACTDT=+$P($P($G(^PRCA(430,RCBILLDA,6)),"^",21),".")
116 . ; DBIA #4385 activated on 31-Mar-2004
117 . S MRATYPE=$$MRATYPE^IBCEMU2(RCBILLDA,ARACTDT)
118 . ; for contract adjustments (criter2=20), the type is 38 for pre-
119 . ; MRA, 4N for post-MRA non-Medicare and 08 for post-MRA Medicare
120 . I RCRITER2=20 S TYPE=$S(MRATYPE=1:38,MRATYPE=2:"08",1:"4N")
121 . ; store dollars to mccf and hsif
122 . I RCTOMCCF S ^TMP($J,"RCRJRCOLWR",TYPE,RCFUND,RCRSC)=$G(^TMP($J,"RCRJRCOLWR",TYPE,RCFUND,RCRSC))+RCTOMCCF
123 . I RCTOHSIF S ^TMP($J,"RCRJRCOLWR",TYPE,5358.1,$S(RCRSC="8BZZ":"8B1Z",1:"8C1Z"))=$G(^TMP($J,"RCRJRCOLWR",TYPE,5358.1,$S(RCRSC="8BZZ":"8B1Z",1:"8C1Z")))+RCTOHSIF
124 ;
125 ; store the interest, admin, mf, cc on the WR code sheet
126 ; interest (type P4; fund 1435; rsc 8047)
127 I $P(RCVALUE,"^",2) S ^TMP($J,"RCRJRCOLWR","P4",1435,8047)=$G(^TMP($J,"RCRJRCOLWR","P4",1435,8047))+$P(RCVALUE,"^",2)
128 ; admin (type P4; fund 3220; rsc 8046)
129 I $P(RCVALUE,"^",3) S ^TMP($J,"RCRJRCOLWR","P4",3220,8046)=$G(^TMP($J,"RCRJRCOLWR","P4",3220,8046))+$P(RCVALUE,"^",3)
130 ; mf + cc (type P4; fund 0869; rsc 8048)
131 S %=$P(RCVALUE,"^",4)+$P(RCVALUE,"^",5)
132 I % S ^TMP($J,"RCRJRCOLWR","P4","0869",8048)=$G(^TMP($J,"RCRJRCOLWR","P4","0869",8048))+%
133 Q
134 ;
135 ;
136NDBSTORE(RCBILLDA,RCVALUE,RCRITER2) ; store the data for the NDB
137 ; returns a 1 if the bill has not been counted
138 ; returns a 0 if the bill has been counted
139 N %,CRITERIA
140 ;
141 ; this line of code will prevent duplicate counts if a sites cross
142 ; references in file 430 (actdt and asdt) are duplicated (incorrect)
143 I RCRITER2<13,$D(^TMP($J,"RCRJRCOL","COUNT",RCBILLDA,RCRITER2)) Q 0
144 ;
145 ; get a bills criteria 1,3,4,5
146 S CRITERIA=$G(^TMP($J,"RCRJRCOL","CRITERIA",RCBILLDA))
147 I CRITERIA="" S CRITERIA=$$CRITERIA^RCRJRCOL(RCBILLDA),^TMP($J,"RCRJRCOL","CRITERIA",RCBILLDA)=CRITERIA
148 S $P(CRITERIA,"-",2)=RCRITER2
149 ;
150 ; store results for ndb
151 S %=$G(@DATASTOR)
152 S $P(%,"^")=$P(%,"^")+1
153 S $P(%,"^",2)=$P(%,"^",2)+$P(RCVALUE,"^")
154 S $P(%,"^",3)=$P(%,"^",3)+$P(RCVALUE,"^",2)+$P(RCVALUE,"^",3)+$P(RCVALUE,"^",4)+$P(RCVALUE,"^",5)
155 S @DATASTOR=%
156 ;
157 ; keep a count of current receivables counted
158 S ^TMP($J,"RCRJRCOL","COUNT",RCBILLDA,RCRITER2)=""
159 S ^TMP($J,"RCRJRCOL","CRIT2",RCRITER2,RCBILLDA)=""
160 Q 1
161 ;
162 ;
163MCCFHSIF(RCBILLDA,RCVALUE,RCRSC,ASOFDATE) ; calculate the amount that goes
164 ;
165 ; to mccf and hsif
166 ;
167 ; returns RCTOMCCF and RCTOHSIF as the outstanding balance to mccf
168 ; and the outstanding balance to hsif
169 N MCCFHSIF
170 ;
171 S RCTOMCCF=$P(RCVALUE,"^"),RCTOHSIF=0
172 ;
173 I $$NOHSIF^RCRJRCO() Q ; disabled HSIF
174 ;
175 ; if revenue source code is not 8BZZ or 8CZZ then it all goes to mccf
176 I RCRSC="8BZZ"!(RCRSC="8CZZ") D
177 . ; get the amount for each fund mccf and hsif
178 . ; this call returns the total amount owed to mccf (piece 1),
179 . ; total amount owed to hsif (piece 2), total amount paid
180 . ; to mccf (piece 3), total amount paid to hsif (piece 4).
181 . ; for outstanding balance you must subtract the payment in
182 . ; pieces 3 and 4 which are returned as negative amounts.
183 . S MCCFHSIF=$$BILLFUND^RCBMILLC(RCBILLDA,ASOFDATE)
184 . S RCTOMCCF=$P(MCCFHSIF,"^",1)+$P(MCCFHSIF,"^",3)
185 . S RCTOHSIF=$P(MCCFHSIF,"^",2)+$P(MCCFHSIF,"^",4)
186 Q
Note: See TracBrowser for help on using the repository browser.