source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCAI164.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: 7.5 KB
Line 
1PRCAI164 ;ALB/LDB-post init patch 164 ;19 Nov 00
2 ;;4.5;Accounts Receivable;**164**;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 an duplicate receipt that has
6 ; been posted to first party bills. it was used to back out a
7 ; lockbox deposit ticket 269296 which was sent twice from Austin
8 ; on november 10 and november 13, 2000.
9 Q
10 ;
11 ;
12START ; start post init
13 D BMES^XPDUTL(" >> Removing payments for duplicate deposit 269296 ...")
14 ;
15 N %,RCBILLDA,RCDATA0,RCDPDT,RCFTEST,RCMESSAG,RCRCPT,RCTRAN1,RCTRANDA,X
16 K ^TMP("PRCAI164",$J)
17 ;
18 ;S RCFTEST=0 ; NO, do not make updates to the database
19 S RCFTEST=1 ; YES, make changes to the database
20 ;
21 ; set default message to send to user
22 S RCMESSAG="Duplicate receipt not found for deposit 269296. Patch 164 is installed."
23 ;
24 ; find deposit which was posted erroneously
25 S RCDPDT=$O(^RCY(344.1,"B",269296,0)) I 'RCDPDT D MAIL^PRCAI16M Q
26 ;
27 ; find receipts for deposit
28 S RCRCPT=0 F S RCRCPT=$O(^RCY(344,"AD",RCDPDT,RCRCPT)) Q:'RCRCPT D
29 . S RCDATA0=$G(^RCY(344,RCRCPT,0))
30 . I $P(RCDATA0,"^",3)'=3001113 Q
31 . ;
32 . ; patch already installed
33 . I $P(RCDATA0,"^",10) S RCMESSAG="Patch 164 has already been previously installed." Q
34 . ;
35 . ; found deposit/receipt and it needs to be backed out
36 . S RCMESSAG="Patch 164 has been completely installed."
37 . ;
38 . ; loop payments made in transaction 433 file
39 . S RCTRANDA=0 F S RCTRANDA=$O(^PRCA(433,"AF",$P(RCDATA0,"^"),RCTRANDA)) Q:'RCTRANDA D
40 . . ; transaction is already marked incomplete
41 . . I $P(^PRCA(433,RCTRANDA,0),"^",4)=1 Q
42 . . ;
43 . . ; lock the transaction
44 . . L +^PRCA(433,RCTRANDA)
45 . . ;
46 . . ; get transaction data
47 . . S RCTRAN1=$G(^PRCA(433,RCTRANDA,1))
48 . . S RCBILLDA=$P(^PRCA(433,RCTRANDA,0),"^",2)
49 . . ;
50 . . ; lock the bill
51 . . L +^PRCA(430,RCBILLDA)
52 . . ;
53 . . ;
54 . . ; transaction type = payment in part (2) or
55 . . ; transaction type = payment in full (34)
56 . . I $P(RCTRAN1,"^",2)=2!($P(RCTRAN1,"^",2)=34) D PAYMENT(RCTRANDA,1)
57 . . ;
58 . . ;
59 . . ; transaction type = prepayment [increase adjustment (1)]
60 . . I $P(RCTRAN1,"^",2)=1 D PREPAY
61 . . ;
62 . . ; unlock the bill and transaction
63 . . L -^PRCA(430,RCBILLDA)
64 . . L -^PRCA(433,RCTRANDA)
65 . ;
66 . ; add comment on payments in receipt
67 . D ADDCOMM(RCRCPT)
68 . ;
69 . ; set piece 10 in receipt to show patch as being installed
70 . I RCFTEST D NOW^%DTC S $P(^RCY(344,RCRCPT,0),"^",10)=%
71 ;
72 D MAIL^PRCAI16M
73 K ^TMP("PRCAI164",$J)
74 Q
75 ;
76 ;
77PAYMENT(RCTRANDA,RCFREPRT) ; mark payment transaction as incomplete and adjust bill
78 ; pass rcfrept equal to 1 to build mailman report. since prepayment
79 ; payments to other bills are already printed on report, pass a zero
80 ; to stop the setting of the tmp global
81 ;
82 N %,DATA0,FYDA,PIECE,RCBILLDA,RCBILL7,RCCOMMNT,RCREPDA,RCTRAN3
83 ; amount paid
84 S RCTRAN3=$G(^PRCA(433,RCTRANDA,3))
85 ; get the bill
86 S RCBILLDA=$P($G(^PRCA(433,RCTRANDA,0)),"^",2)
87 ;
88 ; reset the 7 node on the bill
89 S RCBILL7=$G(^PRCA(430,RCBILLDA,7))
90 F PIECE=1:1:5 D
91 . ; add the payment back to the bills balance
92 . S $P(RCBILL7,"^",PIECE)=$P(RCBILL7,"^",PIECE)+$P(RCTRAN3,"^",PIECE)
93 . ; subtract the payment made for the bill
94 . S $P(RCBILL7,"^",PIECE+6)=$P(RCBILL7,"^",PIECE+6)-$P(RCTRAN3,"^",PIECE)
95 . I RCFTEST S ^PRCA(430,RCBILLDA,7)=RCBILL7
96 ;
97 ; make sure the bill is active (16) if collected/closed (22)
98 I $P(^PRCA(430,RCBILLDA,0),"^",8)=22 I RCFTEST S %=$$EDIT430^RCBEUBIL(RCBILLDA,"8////16;")
99 ;
100 ; reset the fiscal year multiple
101 S FYDA=$O(^PRCA(430,RCBILLDA,2,999),-1)
102 I $G(^PRCA(430,RCBILLDA,2,+FYDA,0))'="" I RCFTEST S $P(^PRCA(430,RCBILLDA,2,FYDA,0),"^",2)=$P(RCBILL7,"^")
103 ;
104 ; remove repayment plans
105 S RCREPDA=0 F S RCREPDA=$O(^PRCA(430,RCBILLDA,5,RCREPDA)) Q:'RCREPDA D
106 . S DATA0=$G(^PRCA(430,RCBILLDA,5,RCREPDA,0))
107 . I $P(DATA0,"^",4)'=RCTRANDA Q
108 . ; found one, remove it
109 . I RCFTEST S ^PRCA(430,RCBILLDA,5,RCREPDA,0)=$P(DATA0,"^")_"^0"
110 ;
111 ; set the payment transaction to incomplete
112 I RCFTEST S $P(^PRCA(433,RCTRANDA,0),"^",4)=1
113 ;
114 ; add comment to transaction
115 S RCCOMMNT(1)="Incomplete by patch 164 due to duplicate payment processed on deposit 269296"
116 I RCFTEST D ADDCOMM^RCBEUTRA(RCTRANDA,.RCCOMMNT)
117 ;
118 ; build mailman message
119 I RCFREPRT S ^TMP("PRCAI164",$J,RCBILLDA,RCTRANDA)=""
120 Q
121 ;
122 ;
123PREPAY ; fix a prepayment
124 ; at entry point, rctranda is the increase adjustment to rcbillda
125 ;
126 N RCBILL7,RCDECADJ,RCPAYAMT,PAYTRAN
127 S RCBILL7=$G(^PRCA(430,RCBILLDA,7))
128 ;
129 ; simple, prepayment has not been used against another bill:
130 ; get rid of the increase adjustment
131 I $P(RCBILL7,"^")'<$P($G(^PRCA(433,RCTRANDA,1)),"^",5) D PREPAYAD(RCTRANDA) Q
132 ;
133 ; prepayment has been used against other bills:
134 ; get rid of the payments to other bills
135 ; get rid of the decrease adjustments to prepayment bill
136 ; get rid of the increase adjustment to prepayment bill
137 S RCPAYAMT=$P($G(^PRCA(433,RCTRANDA,1)),"^",5)
138 S RCDECADJ=RCTRANDA F S RCDECADJ=$O(^PRCA(433,"C",RCBILLDA,RCDECADJ)) Q:'RCDECADJ D I 'RCPAYAMT Q
139 . ; not a decrease adjustment
140 . I $P($G(^PRCA(433,RCDECADJ,1)),"^",2)'=35 Q
141 . ;
142 . ; lock the decrease adjustment
143 . L +^PRCA(433,RCDECADJ)
144 . ;
145 . ; get the payment transaction (433) that goes with decrease
146 . ; to prepayment bill
147 . S PAYTRAN=$P($G(^PRCA(433,RCDECADJ,5)),"^",1)
148 . ;
149 . ; lock the payment transaction
150 . L +^PRCA(433,PAYTRAN)
151 . ;
152 . ; get rid of the payment transaction, activate bill
153 . ; pass a zero so it does not show on mailman report twice
154 . I PAYTRAN D PAYMENT(PAYTRAN,0)
155 . ;
156 . ; get rid of decrease adjustment
157 . D PREPAYAD(RCDECADJ)
158 . ;
159 . ; subtract the decrease adjustment from the payment amount
160 . ; do this till it reaches zero
161 . S RCPAYAMT=RCPAYAMT-$P($G(^PRCA(433,RCDECADJ,1)),"^",5)
162 . ;
163 . ; unlock
164 . L -^PRCA(433,PAYTRAN)
165 . L -^PRCA(433,RCDECADJ)
166 ;
167 ; get rid of the increase adjustment to the prepayment bill
168 D PREPAYAD(RCTRANDA)
169 Q
170 ;
171 ;
172PREPAYAD(RCTRANDA) ; get rid of a transaction on a prepayment bill
173 N FYDA,RCBILL7,RCTRAN1
174 S RCTRAN1=$G(^PRCA(433,RCTRANDA,1))
175 S RCBILL7=$G(^PRCA(430,RCBILLDA,7))
176 ;
177 ; reset the 7 node on the bill
178 ; increase: subtract the payment from the bills principal balance
179 I $P(RCTRAN1,"^",2)=1 S $P(RCBILL7,"^")=$P(RCBILL7,"^")-$P(RCTRAN1,"^",5)
180 ; decrease: add the payment from the bills principal balance
181 I $P(RCTRAN1,"^",2)=35 S $P(RCBILL7,"^")=$P(RCBILL7,"^")+$P(RCTRAN1,"^",5)
182 I RCFTEST S ^PRCA(430,RCBILLDA,7)=RCBILL7
183 ;
184 ; reset the fiscal year multiple
185 S FYDA=$O(^PRCA(430,RCBILLDA,2,999),-1)
186 I $G(^PRCA(430,RCBILLDA,2,+FYDA,0))'="" I RCFTEST S $P(^PRCA(430,RCBILLDA,2,FYDA,0),"^",2)=$P(RCBILL7,"^")
187 ;
188 ; if the bills balance is zero, cancel it
189 I '$P(RCBILL7,"^") I RCFTEST S %=$$EDIT430^RCBEUBIL(RCBILLDA,"8////39;")
190 ;
191 ; set the payment transaction to incomplete
192 I RCFTEST S $P(^PRCA(433,RCTRANDA,0),"^",4)=1
193 ;
194 ; add comment to transaction
195 S RCCOMMNT(1)="Incomplete by patch 164 due to duplicate payment processed on deposit 269296"
196 I RCFTEST D ADDCOMM^RCBEUTRA(RCTRANDA,.RCCOMMNT)
197 ;
198 ; build for mailman report
199 S ^TMP("PRCAI164",$J,RCBILLDA,RCTRANDA)=""
200 Q
201 ;
202 ;
203ADDCOMM(RCRCPT) ; add comment on payments on receipt to show they have been removed
204 N RCPAYDA
205 S RCPAYDA=0 F S RCPAYDA=$O(^RCY(344,RCRCPT,1,RCPAYDA)) Q:'RCPAYDA D
206 . I RCFTEST S $P(^RCY(344,RCRCPT,1,RCPAYDA,1),"^",2)="Payment removed by patch 164 as a duplicate."
207 Q
Note: See TracBrowser for help on using the repository browser.