source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCAI162.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 9.5 KB
Line 
1PRCAI162 ;WISC/RFJ-post init patch 162 ;4 Oct 00
2 ;;4.5;Accounts Receivable;**162**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7START ; start post init
8 D BMES^XPDUTL(" >> Adding a time to exempted interest/admin transactions ...")
9 ;
10 N %,DATA1,RCDATE,RCDAY,RCTRANDA,RCTRDATE
11 ;
12 ; get the sites statement day
13 S RCDAY=+$P($G(^RC(342,1,0)),"^",11) I 'RCDAY Q
14 I $L(RCDAY)=1 S RCDAY="0"_RCDAY
15 ;
16 ; start with june 2000 and loop each date to make sure
17 ; the time is entered on exempt transactions. this date
18 ; is the same as the date interest and admin charges are
19 ; added (statement date minus 3 days). if a charge is
20 ; exempted on the same day, make sure there is a time.
21 F RCDATE=30006:1:30012 D
22 . S RCTRDATE=$$FMADD^XLFDT(RCDATE_RCDAY,-3)
23 . ;
24 . ; loop transaction on the date
25 . S RCTRANDA=0 F S RCTRANDA=$O(^PRCA(433,"AT",14,RCTRDATE,RCTRANDA)) Q:'RCTRANDA D
26 . . S DATA1=$G(^PRCA(433,RCTRANDA,1))
27 . . I $P($P(DATA1,"^",9),".",2)="" S %=$$EDIT433^RCBEUTRA(RCTRANDA,"19////"_RCTRDATE_".2359;")
28 ;
29 D BMES^XPDUTL(" >> Fixing RC DOJ CODE field on payment transactions ...")
30 ;
31 ; loop payment transactions and fix RC DOJ CODE field 7, file 433
32 N PAYTYPE,RCDATE,RCRECTDA,RCTRAN,RCTRANDA,RCTYPE
33 F RCTRAN=2,34 S RCDATE=0 F S RCDATE=$O(^PRCA(433,"AT",RCTRAN,RCDATE)) Q:'RCDATE D
34 . S RCTRANDA=0 F S RCTRANDA=$O(^PRCA(433,"AT",RCTRAN,RCDATE,RCTRANDA)) Q:'RCTRANDA D
35 . . ; get the type of payment
36 . . S RCTYPE=$P($G(^PRCA(433,RCTRANDA,0)),"^",7)
37 . . ; type of payment does not exist or is correct
38 . . I RCTYPE="" Q
39 . . I RCTYPE="DC"!(RCTYPE="DOJ")!(RCTYPE="IRS")!(RCTYPE="RC")!(RCTYPE="TOP") Q
40 . . ; check to see if it is set as the receipt number, if not quit
41 . . S RCRECTDA=$O(^RCY(344,"B",RCTYPE,0)) I 'RCRECTDA Q
42 . . ; get the type of payment on the receipt
43 . . S PAYTYPE=$P($G(^RCY(344,RCRECTDA,0)),"^",4)
44 . . ; set the transaction type of payment
45 . . S RCTYPE=""
46 . . I PAYTYPE=3 S RCTYPE="RC"
47 . . I PAYTYPE=5 S RCTYPE="DOJ"
48 . . I PAYTYPE=11 S RCTYPE="IRS"
49 . . I PAYTYPE=13 S RCTYPE="TOP"
50 . . S $P(^PRCA(433,RCTRANDA,0),"^",7)=RCTYPE
51 ;
52 D REPAY
53 Q
54 ;
55 ;
56REPAY ; fix repayment plans
57 D BMES^XPDUTL(" >> Fixing Repayment Plans ...")
58 ;
59 N COUNT,DATA,DATA0,DATA2,DATA3,DATA4,DATE,INTADM,LINE,PAYAMT,RCAMT,RCDATE,RCBILLDA,RCPAY,RCPAYAMT,RCREPDA,RCSTOP,RCSTOP1,RCTRAN,RCTRANDA,RCTRANDB,REPAYAMT,REPAYDAT,RSC,TYPE,XMDUN,XMY,XMZ
60 K ^TMP("PRCAI162",$J)
61 ;
62 D MES^XPDUTL(" ...looping payment transactions.")
63 ; loop all payment transactions and build a list of repayments by bill
64 ; and by date paid
65 F RCTRAN=2,34 S RCDATE=0 F S RCDATE=$O(^PRCA(433,"AT",RCTRAN,RCDATE)) Q:'RCDATE D
66 . S RCTRANDA=0 F S RCTRANDA=$O(^PRCA(433,"AT",RCTRAN,RCDATE,RCTRANDA)) Q:'RCTRANDA D
67 . . ; get the bill for the payment
68 . . S RCBILLDA=+$P($G(^PRCA(433,RCTRANDA,0)),"^",2) I 'RCBILLDA Q
69 . . ;
70 . . ; get the repayment data
71 . . I '$O(^PRCA(430,RCBILLDA,5,0)) Q
72 . . S DATA4=$G(^PRCA(430,RCBILLDA,4))
73 . . S REPAYAMT=+$P(DATA4,"^",3) I 'REPAYAMT Q
74 . . S REPAYDAT=+$P($P(DATA4,"^"),".") I 'REPAYDAT Q
75 . . ; verify the payment date after repayment plan established
76 . . I RCDATE<REPAYDAT Q
77 . . ; verify the paid amount is less than the repayment amount
78 . . S RCAMT=+$P($G(^PRCA(433,RCTRANDA,1)),"^",5) I RCAMT<REPAYAMT Q
79 . . ;
80 . . S ^TMP("PRCAI162",$J,RCBILLDA,RCDATE,RCTRANDA)=RCAMT
81 ;
82 ; this is used to store data to generate the mailman message
83 K ^TMP("PRCAI162REPAY")
84 ;
85 D MES^XPDUTL(" ...fixing repayment plan payment errors.")
86 ;
87 ; loop the payments stored by bill and date paid and build an array
88 ; of repayments in rcpay(count)
89 S RCBILLDA=0 F S RCBILLDA=$O(^TMP("PRCAI162",$J,RCBILLDA)) Q:'RCBILLDA D
90 . S REPAYAMT=+$P($G(^PRCA(430,RCBILLDA,4)),"^",3)
91 . K RCPAY
92 . S COUNT=0
93 . S RCDATE=0 F S RCDATE=$O(^TMP("PRCAI162",$J,RCBILLDA,RCDATE)) Q:'RCDATE D
94 . . S RCTRANDA=0 F S RCTRANDA=$O(^TMP("PRCAI162",$J,RCBILLDA,RCDATE,RCTRANDA)) Q:'RCTRANDA D
95 . . . S RCPAYAMT=^TMP("PRCAI162",$J,RCBILLDA,RCDATE,RCTRANDA)
96 . . . F D Q:RCPAYAMT<REPAYAMT
97 . . . . S COUNT=COUNT+1,RCPAY(COUNT)=RCTRANDA
98 . . . . S RCPAYAMT=RCPAYAMT-REPAYAMT
99 . ;
100 . ; now loop the repayments and make sure they match the rcpay(count)
101 . ; array of repayments against the bill
102 . S RCREPDA=0 F COUNT=1:1 S RCREPDA=$O(^PRCA(430,RCBILLDA,5,RCREPDA)) Q:'RCREPDA D
103 . . S DATA0=$G(^PRCA(430,RCBILLDA,5,RCREPDA,0)) I DATA0="" Q
104 . . ; if no payments left, the repayment plan should no longer
105 . . ; show payments being received
106 . . I '$D(RCPAY(COUNT)) D Q
107 . . . I $P(DATA0,"^",2)'=0!($P(DATA0,"^",4)'="") S $P(DATA0,"^",2)=0,$P(DATA0,"^",4)="" D SET(DATA0)
108 . . ;
109 . . ; payment recorded on wrong transaction
110 . . I $P(DATA0,"^",2)=1,$P(DATA0,"^",4)'=RCPAY(COUNT) D Q
111 . . . S $P(DATA0,"^",4)=RCPAY(COUNT) D SET(DATA0)
112 . . ;
113 . . ; payment not shown as being made
114 . . I $P(DATA0,"^",2)=0,$P(DATA0,"^",4)'=RCPAY(COUNT) D Q
115 . . . S $P(DATA0,"^",2)=1,$P(DATA0,"^",4)=RCPAY(COUNT) D SET(DATA0)
116 . . . ;
117 . . . ;
118 . . . ; check for int/admin charges applied after the payment transaction received
119 . . . ; this is used to build the mailman message showing potential problems
120 . . . S RCSTOP=0
121 . . . S RCTRANDA=RCPAY(COUNT) F S RCTRANDA=$O(^PRCA(433,"C",RCBILLDA,RCTRANDA)) Q:'RCTRANDA D I RCSTOP Q
122 . . . . ; only look at the int/admin charges after 8/1/2000
123 . . . . I $P($G(^PRCA(433,RCTRANDA,1)),"^",9)<3000801 Q
124 . . . . ; found an interest/admin charge
125 . . . . I $P($G(^PRCA(433,RCTRANDA,1)),"^",2)=13 D
126 . . . . . S DATA2=$G(^PRCA(433,RCTRANDA,2))
127 . . . . . S ^TMP("PRCAI162REPAY",RCBILLDA,RCTRANDA,"IA")=$P(DATA2,"^",7)_"^"_$P(DATA2,"^",8)
128 . . . . . S RCSTOP=1
129 . . . . . ;
130 . . . . . ; get the next payment transaction
131 . . . . . S RCSTOP1=0
132 . . . . . S RCTRANDB=RCTRANDA F S RCTRANDB=$O(^PRCA(433,"C",RCBILLDA,RCTRANDB)) Q:'RCTRANDB D I RCSTOP1 Q
133 . . . . . . S TYPE=$P($G(^PRCA(433,RCTRANDB,1)),"^",2)
134 . . . . . . I TYPE=2!(TYPE=34) D
135 . . . . . . . S DATA3=$G(^PRCA(433,RCTRANDB,3))
136 . . . . . . . S ^TMP("PRCAI162REPAY",RCBILLDA,RCTRANDA,"PA")=$P(DATA3,"^",2)_"^"_$P(DATA3,"^",3)_"^"_RCTRANDB
137 . . . . . . . S RCSTOP1=1
138 ;
139 D MES^XPDUTL(" ...generating mailman message to G.RCDP PAYMENTS.")
140 ;
141 ; generate mailman message to user
142 K ^TMP($J,"RCRJRCORMM")
143 S ^TMP($J,"RCRJRCORMM",1)="The following bills need to be reviewed. The interest and"
144 S ^TMP($J,"RCRJRCORMM",2)="admin charges shown below may need to be exempted. The"
145 S ^TMP($J,"RCRJRCORMM",3)="payments shown below may require a decrease to the principal"
146 S ^TMP($J,"RCRJRCORMM",4)="on the bill and a modification to FMS. Interest is reported"
147 S ^TMP($J,"RCRJRCORMM",5)="to FMS in fund 1435 and admin in fund 3220. The Revenue"
148 S ^TMP($J,"RCRJRCORMM",6)="Source Code has been included for the bill to help in creating"
149 S ^TMP($J,"RCRJRCORMM",7)="a transfer from 1435 or 3220 to fund 5287."
150 S ^TMP($J,"RCRJRCORMM",8)=" "
151 ;
152 S ^TMP($J,"RCRJRCORMM",9)="BILL# RSC TRANS# DATE TYPE "_$J("INTEREST",8)_$J("ADMIN",8)
153 S ^TMP($J,"RCRJRCORMM",10)="-----------------------------------------------------------------------------"
154 S LINE=10
155 ;
156 S RCBILLDA=0 F S RCBILLDA=$O(^TMP("PRCAI162REPAY",RCBILLDA)) Q:'RCBILLDA D
157 . ; get the revenue source code
158 . S RSC=$$CALCRSC^RCXFMSUR(RCBILLDA)
159 . S LINE=LINE+1,^TMP($J,"RCRJRCORMM",LINE)=" "
160 . S COUNT=0
161 . S RCTRANDA=0 F S RCTRANDA=$O(^TMP("PRCAI162REPAY",RCBILLDA,RCTRANDA)) Q:'RCTRANDA D
162 . . S INTADM=$G(^TMP("PRCAI162REPAY",RCBILLDA,RCTRANDA,"IA"))
163 . . S PAYAMT=$G(^TMP("PRCAI162REPAY",RCBILLDA,RCTRANDA,"PA"))
164 . . ;
165 . . ; first time bill is displayed
166 . . I COUNT=0 S DATA=$E($P(^PRCA(430,RCBILLDA,0),"^")_" ",1,12)_$E(RSC_" ",1,6)
167 . . E S DATA=" "_" "
168 . . S COUNT=1
169 . . ;
170 . . S DATA=DATA_$E(RCTRANDA_" ",1,12)
171 . . S DATE=$P($G(^PRCA(433,RCTRANDA,1)),"^",9) I DATE="" S DATE=" "
172 . . S DATA=DATA_$E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3)_" "
173 . . S DATA=DATA_"Interest/Admin Charge"
174 . . S DATA=DATA_$J($P(INTADM,"^"),8,2)_$J($P(INTADM,"^",2),8,2)
175 . . S LINE=LINE+1,^TMP($J,"RCRJRCORMM",LINE)=DATA
176 . . ; if payment, show it also
177 . . I PAYAMT'="" D
178 . . . S DATA=" "_" "
179 . . . S DATA=DATA_$E($P(PAYAMT,"^",3)_" ",1,12)
180 . . . S DATE=$P($G(^PRCA(433,$P(PAYAMT,"^",3),1)),"^",9) I DATE="" S DATE=" "
181 . . . S DATA=DATA_$E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3)_" "
182 . . . S DATA=DATA_"Payment "
183 . . . S DATA=DATA_$J($P(PAYAMT,"^"),8,2)_$J($P(PAYAMT,"^",2),8,2)
184 . . . S LINE=LINE+1,^TMP($J,"RCRJRCORMM",LINE)=DATA
185 ;
186 I LINE=10 S ^TMP($J,"RCRJRCORMM",11)="<<No Bills Or Transactions Found For You to Review>>"
187 ;
188 ; send mail message
189 N DIFROM ; need to be newed or mailman will not deliver the message
190 S XMY("G.RCDP PAYMENTS")=""
191 S XMY(.5)=""
192 S XMY(DUZ)=""
193 S XMZ=$$SENDMSG^RCRJRCOR("AR Patch 162 Interest/Admin Transactions",.XMY)
194 K ^TMP($J,"RCRJRCORMM")
195 K ^TMP("PRCAI162",$J),^TMP("PRCAI162REPAY",$J)
196 Q
197 ;
198 ;
199SET(DATA0) ; set the repayment plan data node
200 S ^PRCA(430,RCBILLDA,5,RCREPDA,0)=DATA0
201 Q
Note: See TracBrowser for help on using the repository browser.