source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPXFIX.m@ 738

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

initial load of WorldVistAEHR
File size: 9.3 KB
RevLine 
[613]1RCDPXFIX ;WISC/RFJ -fix duplicate deposits (! be careful using this !) ;22 Mar 02
2 ;;4.5;Accounts Receivable;**177**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; this routine is used to back out a duplicate deposit that has
6 ; been posted to first party bills. do not use this routine
7 ; unless instructed to by software design and development or
8 ; national verification and support.
9 Q
10 ;
11 ;
12REVERSE(RCDPOSIT,RCTRANDT) ; back out deposit RCDPOSIT
13 ; RCDPOSIT is the deposit number, example 269296
14 ; RCTRANDT is the transmission date, example 3001113
15 ;
16 ;
17 N %,RCBILLDA,RCDATA0,RCDPDT,RCFTEST,RCMESSAG,RCRCPT,RCTRAN1,RCTRANDA,X
18 K ^TMP("RCDPXFIX",$J)
19 ;
20 ; this is used for internal testing
21 ;S RCFTEST=0 ; NO, do not make updates to the database
22 S RCFTEST=1 ; YES, make changes to the database
23 ;
24 ; set default message to send to user
25 S RCMESSAG="Duplicate deposit "_RCDPOSIT_" with a transmission date of "_$E(RCTRANDT,4,5)_"/"_$E(RCTRANDT,6,7)_"/"_$E(RCTRANDT,2,3)_" was not found."
26 ;
27 ; find deposit which was posted erroneously, if no date then it is not found
28 S RCDPDT=$O(^RCY(344.1,"B",RCDPOSIT,0)) I 'RCDPDT D MAIL^RCDPXFIM(RCDPOSIT,RCTRANDT,RCMESSAG) Q
29 ;
30 ; find receipts for deposit
31 S RCRCPT=0 F S RCRCPT=$O(^RCY(344,"AD",RCDPDT,RCRCPT)) Q:'RCRCPT D
32 . S RCDATA0=$G(^RCY(344,RCRCPT,0))
33 . ; check to see if the date opened is equal to the transmission date
34 . I $P(RCDATA0,"^",3)'=RCTRANDT Q
35 . ;
36 . ; deposit already backed out (the *end date is set once backed out)
37 . I $P(RCDATA0,"^",10) S RCMESSAG="Duplicate Deposit "_RCDPOSIT_" was previously backed out on "_$E($P(RCDATA0,"^",10),4,5)_"/"_$E($P(RCDATA0,"^",10),6,7)_"/"_$E($P(RCDATA0,"^",10),2,3)_"." Q
38 . ;
39 . ; found deposit/receipt and it needs to be backed out
40 . S RCMESSAG="Duplicate deposit "_RCDPOSIT_" with a transmission date of "_$E(RCTRANDT,4,5)_"/"_$E(RCTRANDT,6,7)_"/"_$E(RCTRANDT,2,3)_" has been removed."
41 . ;
42 . ; loop payments made in transaction 433 file
43 . S RCTRANDA=0 F S RCTRANDA=$O(^PRCA(433,"AF",$P(RCDATA0,"^"),RCTRANDA)) Q:'RCTRANDA D
44 . . ; transaction is already marked incomplete
45 . . I $P(^PRCA(433,RCTRANDA,0),"^",4)=1 Q
46 . . ;
47 . . ; lock the transaction
48 . . L +^PRCA(433,RCTRANDA)
49 . . ;
50 . . ; get transaction data
51 . . S RCTRAN1=$G(^PRCA(433,RCTRANDA,1))
52 . . S RCBILLDA=$P(^PRCA(433,RCTRANDA,0),"^",2)
53 . . ;
54 . . ; lock the bill
55 . . L +^PRCA(430,RCBILLDA)
56 . . ;
57 . . ;
58 . . ; transaction type = payment in part (2) or
59 . . ; transaction type = payment in full (34)
60 . . I $P(RCTRAN1,"^",2)=2!($P(RCTRAN1,"^",2)=34) D PAYMENT(RCTRANDA,1)
61 . . ;
62 . . ;
63 . . ; transaction type = prepayment [increase adjustment (1)]
64 . . I $P(RCTRAN1,"^",2)=1 D PREPAY
65 . . ;
66 . . ; unlock the bill and transaction
67 . . L -^PRCA(430,RCBILLDA)
68 . . L -^PRCA(433,RCTRANDA)
69 . ;
70 . ; make changes to the payments on the receipt
71 . D RECEIPT(RCDPOSIT,RCTRANDT,RCRCPT)
72 . ;
73 . ; set piece 10 in receipt to show patch as being installed
74 . I RCFTEST D NOW^%DTC S $P(^RCY(344,RCRCPT,0),"^",10)=%
75 ;
76 D MAIL^RCDPXFIM(RCDPOSIT,RCTRANDT,RCMESSAG)
77 ;
78 K ^TMP("RCDPXFIX",$J)
79 Q
80 ;
81 ;
82PAYMENT(RCTRANDA,RCFREPRT) ; mark payment transaction as incomplete and adjust bill
83 ; pass rcfrept equal to 1 to build mailman report. since prepayment
84 ; payments to other bills are already printed on report, pass a zero
85 ; to stop the setting of the tmp global
86 ;
87 N %,DATA0,FYDA,PIECE,RCBILLDA,RCBILL7,RCCOMMNT,RCREPDA,RCTRAN3
88 ; amount paid
89 S RCTRAN3=$G(^PRCA(433,RCTRANDA,3))
90 ; get the bill
91 S RCBILLDA=$P($G(^PRCA(433,RCTRANDA,0)),"^",2)
92 ;
93 ; reset the 7 node on the bill
94 S RCBILL7=$G(^PRCA(430,RCBILLDA,7))
95 F PIECE=1:1:5 D
96 . ; add the payment back to the bills balance
97 . S $P(RCBILL7,"^",PIECE)=$P(RCBILL7,"^",PIECE)+$P(RCTRAN3,"^",PIECE)
98 . ; subtract the payment made for the bill
99 . S $P(RCBILL7,"^",PIECE+6)=$P(RCBILL7,"^",PIECE+6)-$P(RCTRAN3,"^",PIECE)
100 . I RCFTEST S ^PRCA(430,RCBILLDA,7)=RCBILL7
101 ;
102 ; make sure the bill is active (16) if collected/closed (22)
103 I $P(^PRCA(430,RCBILLDA,0),"^",8)=22 I RCFTEST S %=$$EDIT430^RCBEUBIL(RCBILLDA,"8////16;")
104 ;
105 ; reset the fiscal year multiple
106 S FYDA=$O(^PRCA(430,RCBILLDA,2,999),-1)
107 I $G(^PRCA(430,RCBILLDA,2,+FYDA,0))'="" I RCFTEST S $P(^PRCA(430,RCBILLDA,2,FYDA,0),"^",2)=$P(RCBILL7,"^")
108 ;
109 ; remove repayment plans
110 S RCREPDA=0 F S RCREPDA=$O(^PRCA(430,RCBILLDA,5,RCREPDA)) Q:'RCREPDA D
111 . S DATA0=$G(^PRCA(430,RCBILLDA,5,RCREPDA,0))
112 . I $P(DATA0,"^",4)'=RCTRANDA Q
113 . ; found one, remove it
114 . I RCFTEST S ^PRCA(430,RCBILLDA,5,RCREPDA,0)=$P(DATA0,"^")_"^0"
115 ;
116 ; set the payment transaction to incomplete
117 I RCFTEST S $P(^PRCA(433,RCTRANDA,0),"^",4)=1
118 ;
119 ; add comment to transaction
120 S RCCOMMNT(1)="Duplicate deposit "_RCDPOSIT_" with transmission date "_$E(RCTRANDT,4,5)_"/"_$E(RCTRANDT,6,7)_"/"_$E(RCTRANDT,2,3)_" removed."
121 I RCFTEST D ADDCOMM^RCBEUTRA(RCTRANDA,.RCCOMMNT)
122 ;
123 ; build mailman message
124 I RCFREPRT S ^TMP("RCDPXFIX",$J,RCBILLDA,RCTRANDA)=""
125 Q
126 ;
127 ;
128PREPAY ; fix a prepayment
129 ; at entry point, rctranda is the increase adjustment to rcbillda
130 ;
131 N RCBILL7,RCDECADJ,RCPAYAMT,PAYTRAN
132 S RCBILL7=$G(^PRCA(430,RCBILLDA,7))
133 ;
134 ; simple, prepayment has not been used against another bill:
135 ; get rid of the increase adjustment
136 I $P(RCBILL7,"^")'<$P($G(^PRCA(433,RCTRANDA,1)),"^",5) D PREPAYAD(RCTRANDA) Q
137 ;
138 ; prepayment has been used against other bills:
139 ; get rid of the payments to other bills
140 ; get rid of the decrease adjustments to prepayment bill
141 ; get rid of the increase adjustment to prepayment bill
142 S RCPAYAMT=$P($G(^PRCA(433,RCTRANDA,1)),"^",5)
143 S RCDECADJ=RCTRANDA F S RCDECADJ=$O(^PRCA(433,"C",RCBILLDA,RCDECADJ)) Q:'RCDECADJ D I 'RCPAYAMT Q
144 . ; not a decrease adjustment
145 . I $P($G(^PRCA(433,RCDECADJ,1)),"^",2)'=35 Q
146 . ;
147 . ; lock the decrease adjustment
148 . L +^PRCA(433,RCDECADJ)
149 . ;
150 . ; get the payment transaction (433) that goes with decrease
151 . ; to prepayment bill
152 . S PAYTRAN=$P($G(^PRCA(433,RCDECADJ,5)),"^",1)
153 . ;
154 . ; lock the payment transaction
155 . L +^PRCA(433,PAYTRAN)
156 . ;
157 . ; get rid of the payment transaction, activate bill
158 . ; pass a zero so it does not show on mailman report twice
159 . I PAYTRAN D PAYMENT(PAYTRAN,0)
160 . ;
161 . ; get rid of decrease adjustment
162 . D PREPAYAD(RCDECADJ)
163 . ;
164 . ; subtract the decrease adjustment from the payment amount
165 . ; do this till it reaches zero
166 . S RCPAYAMT=RCPAYAMT-$P($G(^PRCA(433,RCDECADJ,1)),"^",5)
167 . ;
168 . ; unlock
169 . L -^PRCA(433,PAYTRAN)
170 . L -^PRCA(433,RCDECADJ)
171 ;
172 ; get rid of the increase adjustment to the prepayment bill
173 D PREPAYAD(RCTRANDA)
174 Q
175 ;
176 ;
177PREPAYAD(RCTRANDA) ; get rid of a transaction on a prepayment bill
178 N FYDA,RCBILL7,RCCOMMNT,RCTRAN1
179 S RCTRAN1=$G(^PRCA(433,RCTRANDA,1))
180 S RCBILL7=$G(^PRCA(430,RCBILLDA,7))
181 ;
182 ; reset the 7 node on the bill
183 ; increase: subtract the payment from the bills principal balance
184 I $P(RCTRAN1,"^",2)=1 S $P(RCBILL7,"^")=$P(RCBILL7,"^")-$P(RCTRAN1,"^",5)
185 ; decrease: add the payment from the bills principal balance
186 I $P(RCTRAN1,"^",2)=35 S $P(RCBILL7,"^")=$P(RCBILL7,"^")+$P(RCTRAN1,"^",5)
187 I RCFTEST S ^PRCA(430,RCBILLDA,7)=RCBILL7
188 ;
189 ; reset the fiscal year multiple
190 S FYDA=$O(^PRCA(430,RCBILLDA,2,999),-1)
191 I $G(^PRCA(430,RCBILLDA,2,+FYDA,0))'="" I RCFTEST S $P(^PRCA(430,RCBILLDA,2,FYDA,0),"^",2)=$P(RCBILL7,"^")
192 ;
193 ; if the bills balance is zero, cancel it
194 I '$P(RCBILL7,"^") I RCFTEST S %=$$EDIT430^RCBEUBIL(RCBILLDA,"8////39;")
195 ;
196 ; set the payment transaction to incomplete
197 I RCFTEST S $P(^PRCA(433,RCTRANDA,0),"^",4)=1
198 ;
199 ; add comment to transaction
200 S RCCOMMNT(1)="Duplicate deposit "_RCDPOSIT_" with transmission date "_$E(RCTRANDT,4,5)_"/"_$E(RCTRANDT,6,7)_"/"_$E(RCTRANDT,2,3)_" removed."
201 I RCFTEST D ADDCOMM^RCBEUTRA(RCTRANDA,.RCCOMMNT)
202 ;
203 ; build for mailman report
204 S ^TMP("RCDPXFIX",$J,RCBILLDA,RCTRANDA)=""
205 Q
206 ;
207 ;
208RECEIPT(RCDPOSIT,RCTRANDT,RCRCPT) ; make changes to receipt file
209 N RCACCT,RCBILLDA,RCDEBTDA,RCPAYDA
210 S RCPAYDA=0 F S RCPAYDA=$O(^RCY(344,RCRCPT,1,RCPAYDA)) Q:'RCPAYDA D
211 . ; add comment to payment in receipt file
212 . I RCFTEST S $P(^RCY(344,RCRCPT,1,RCPAYDA,1),"^",2)="Duplicate deposit "_RCDPOSIT_" with transmission date "_$E(RCTRANDT,4,5)_"/"_$E(RCTRANDT,6,7)_"/"_$E(RCTRANDT,2,3)_" removed."
213 . ;
214 . ; if the account is missing on the payment, then zero out the dollar amount
215 . ; to prevent it from showing as an unlinked payment
216 . S RCACCT=$P(^RCY(344,RCRCPT,1,RCPAYDA,0),"^",3)
217 . I 'RCACCT S:RCFTEST $P(^RCY(344,RCRCPT,1,RCPAYDA,0),"^",4)=0 Q
218 . ;
219 . ; check acct to see if it has prepayments open with active bills. if so,
220 . ; apply the prepayment to the active bill
221 . S RCDEBTDA=$O(^RCD(340,"B",RCACCT,0)) I 'RCDEBTDA Q
222 . ;
223 . ; no prepayments for account
224 . I '$O(^PRCA(430,"AS",RCDEBTDA,42,0)) Q
225 . ;
226 . ; no active bills for account
227 . I '$O(^PRCA(430,"AS",RCDEBTDA,16,0)) Q
228 . ;
229 . ; loop active (16) bills for debtor and apply prepayment
230 . S RCBILLDA=0 F S RCBILLDA=$O(^PRCA(430,"AS",RCDEBTDA,16,RCBILLDA)) Q:'RCBILLDA D
231 . . ; no prepayments left, stop loop
232 . . I '$O(^PRCA(430,"AS",RCDEBTDA,42,0)) S RCBILLDA="A" Q
233 . . ;
234 . . ; this line is for testing
235 . . I 'RCFTEST W !,"Prepayment being applied to bill ",RCBILLDA Q
236 . . D PREPAY^RCBEPAYP(RCBILLDA,0)
237 Q
Note: See TracBrowser for help on using the repository browser.