source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCBECHGA.m@ 1556

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

initial load of WorldVistAEHR
File size: 8.8 KB
Line 
1RCBECHGA ;WISC/RFJ-add admin charges to account (called by rcbechgs) ;1 Jun 00
2 ;;4.5;Accounts Receivable;**153,167**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7ADMIN ; this is called by rcbechgs and is a continuation of that routine
8 ; variables passed to this entry point:
9 ; rcdebtda = the ien of the debtor entry in file 340
10 ; rcdata0 = the 0th node for the debtor in rcd(340,rcdebtda,0)
11 ; rcupdate = the fm date that charges are being added
12 ; the rcupdate variable is the statement date for non-benefit
13 ; debts or (statement date minus 3 days) for benefit (first
14 ; party debts)
15 ;
16 N RCADDATE,RCBILLDA,RCDATA6,RCDATE,RCFADMIN,RCFQUIT,RCLASTDT,RCXDAYS,REPAYDAT,X
17 ;
18 ; get the last date admin was charged to this account
19 S RCADDATE=$P($G(^RCD(340,+RCDEBTDA,.1)),"^",2)
20 ; take the current statement date in variable rcupdate
21 ; (this is actually 3 days before the statement date for
22 ; benefit first party debts and is when admin charges
23 ; get added) and subtract 1 month (this date will be the
24 ; last statement date). If the last admin charge date
25 ; is greater than the last statement date, do not add
26 ; admin a second time for the same month.
27 I RCADDATE>$$FPS^RCAMFN01(RCUPDATE,-1) Q
28 ;
29 S RCDATE=0 F S RCDATE=$O(^TMP("RCBECHGS",$J,"LIST",RCDATE)) Q:'RCDATE D I $G(RCFQUIT) Q
30 . S RCBILLDA=0 F S RCBILLDA=$O(^TMP("RCBECHGS",$J,"LIST",RCDATE,RCBILLDA)) Q:'RCBILLDA D I $G(RCFQUIT) Q
31 . . ; bill category is set up to not charge admin, get next bill
32 . . I '$P($G(^PRCA(430.2,+$P(^PRCA(430,RCBILLDA,0),"^",2),0)),"^",11) Q
33 . . S RCDATA6=$G(^PRCA(430,RCBILLDA,6))
34 . . ;
35 . . ; --- block begin ------------------------------------------
36 . . ; --- once sites begin populating the new field .12 ---
37 . . ; --- in file 340, the following block of code can ---
38 . . ; --- be removed: ---
39 . . ; get the last date admin was charged to this bill.
40 . . ; rcaddate is the last date for the account. since
41 . . ; this may not be populated, check the following:
42 . . ; use field .12 in file 430, or use field 67
43 . . S RCLASTDT=RCADDATE
44 . . I 'RCLASTDT S RCLASTDT=$P($G(^PRCA(430,RCBILLDA,.1)),"^",2) I 'RCLASTDT S RCLASTDT=$P(RCDATA6,"^",7)
45 . . ; take the current statement date in variable rcupdate
46 . . ; (this is actually 3 days before the statement date for
47 . . ; benefit first party debts and is when admin charges
48 . . ; get added) and subtract 1 month (this date will be the
49 . . ; last statement date). If the last admin charge date
50 . . ; is greater than the last statement date, do not add
51 . . ; admin a second time for the same month.
52 . . I RCLASTDT>$$FPS^RCAMFN01(RCUPDATE,-1) S RCFQUIT=1 Q
53 . . ; --- block end ---------------------------------------------
54 . . ;
55 . . ; *** the account has RCXDAYS from the initial ***
56 . . ; *** notification (in letter1 date) to pay the account ***
57 . . ; *** in full or setup a repayment plan. RCXDAYS is 30 ***
58 . . ; *** for non-benefit debts and 57 for benefit (first ***
59 . . ; *** party debts) ***
60 . . ; *** letter 1 = initial notification ***
61 . . ; *** letter 2 = 30 days from initial notification ***
62 . . ; *** letter 3 = 60 days from initial notification ***
63 . . ;
64 . . ; non-benefit debt, no letter1 date so not been 30 days
65 . . I $P(RCDATA0,"^")'["DPT(" D I RCXDAYS=0 Q
66 . . . S RCXDAYS=30
67 . . . I '$P(RCDATA6,"^",1) S RCXDAYS=0 Q
68 . . . ; rcupdate is the statement date for non-benefit debts
69 . . . ; check to see if it has been 1 month (30 days) by
70 . . . ; adding a month to the letter1 date. if this date is
71 . . . ; greater than the current statement date (in rcupdate)
72 . . . ; then it has not been 30 days from initial notification
73 . . . I RCUPDATE<$$FPS^RCAMFN01($P(RCDATA6,"^",1),1) S RCXDAYS=0
74 . . ;
75 . . ; benefit debt, no letter2 date so not been 57 days
76 . . I $P(RCDATA0,"^")["DPT(" D I RCXDAYS=0 Q
77 . . . S RCXDAYS=57
78 . . . I '$P(RCDATA6,"^",2) S RCXDAYS=0 Q
79 . . . ; since the update happens 3 days before the statement
80 . . . ; date, you must add 3 days to the update before checking
81 . . . ; to see if it is less than the letter3 date (letter2
82 . . . ; date plus 1 month)
83 . . . I $$FMADD^XLFDT(RCUPDATE,3)<$$FPS^RCAMFN01($P(RCDATA6,"^",2),1) S RCXDAYS=0
84 . . ;
85 . . ; this variable is used to indicate the reason why admin is
86 . . ; being charged
87 . . S RCFADMIN=""
88 . . ; get the repayment plan date
89 . . S REPAYDAT=$P($G(^PRCA(430,RCBILLDA,4)),"^")
90 . . ; if there is repayment plan established, test for the date
91 . . ; it was established and if the account defaulted on it.
92 . . ; return rcfadmin equal null if admin should not be charged
93 . . I REPAYDAT D I RCFADMIN="" Q
94 . . . ; check to see if a repayment plan was set up within
95 . . . ; RCXDAYS of the initial notification and if not, charge
96 . . . ; admin on the account. letter1 date is the initial
97 . . . ; notification. set rcfadmin to reason to charge admin
98 . . . I REPAYDAT>$$FMADD^XLFDT($P(RCDATA6,"^"),RCXDAYS) S RCFADMIN="Repayment plan not established in "_RCXDAYS_" days from initial notification." Q
99 . . . ; check to see if the account defaulted on the repayment
100 . . . ; plan up to the date the admin is being charged, if so
101 . . . ; charge admin on the account
102 . . . S X=$$REPAYDEF(RCBILLDA,RCUPDATE) I X S RCFADMIN=$P(X,"^",3)
103 . . ;
104 . . ; charge admin
105 . . I RCFADMIN="" S RCFADMIN="Full payment or repayment plan not established in "_RCXDAYS_" days from initial notification."
106 . . S X=+$P($$ADM^RCMSFN01(),"^") I 'X Q
107 . . S $P(^TMP("RCBECHGS",$J,"ADDCHG",RCBILLDA),"^",2)=X
108 . . S $P(^TMP("RCBECHGS",$J,"ADDCHG",RCBILLDA),"^",4)=RCFADMIN
109 . . ; set this variable to exit loop for rest of bills for account
110 . . S RCFQUIT=1
111 Q
112 ;
113 ;
114REPAYDEF(RCBILLDA,RCUPDATE) ; check to see if bill is in default of the
115 ; repayment plan up to a specified date (rcupdate)
116 ; return piece 1 is 1 if in default, 0 if not in default
117 ; piece 2 is the date of default
118 ; piece 3 is the reason why bill found in default
119 ;
120 N DATA,REPAYDAT
121 ; get the last payment date
122 S REPAYDAT=$O(^PRCA(430,RCBILLDA,5,"B",RCUPDATE),-1)
123 I 'REPAYDAT Q 0
124 S DATA=$G(^PRCA(430,RCBILLDA,5,+$O(^PRCA(430,RCBILLDA,5,REPAYDAT,0)),0))
125 ; in some cases, the repayment date is in the form YYYMM (no day)
126 I $L(REPAYDAT)=5 S REPAYDAT=REPAYDAT_"01"
127 ; payment not received for date prior to repayment date
128 I '$P(DATA,"^",2) Q "1^"_REPAYDAT_"^Payment Not Received before due date "_$$FORMATDT(REPAYDAT)
129 Q 0
130 ;
131 ;
132REPDATA(RCBILLDA,DAYS) ; - Return Repayment Plan information
133 ; Input: RCBILLDA=Pointer to the AR file #430
134 ; DAYS=Number of days over the due date for a payment not
135 ; received to be considered defaulted.
136 ; Output: String with the following "^" (up-arrow) pieces:
137 ; 1. Repayment Plan Start Date (FM Format)
138 ; 2. Balance (Repayment Plan)
139 ; 3. Monthly Payment Amount
140 ; 4. Due Date (day of the month)
141 ; 5. Last Payment Date (from file #433)
142 ; 6. Last Payment Amount (from file #433)
143 ; 7. Number of Payments Due
144 ; 8. Number of Payments Defaulted
145 ; or NULL if no Repayment Plan were found for the Bill
146 ;
147 N RCPMT,RCDEF,RCDUE,RCELM,RCLDAM,RCLTR,RCRP,RCTRA,Y
148 ;
149 S (RCDUE,RCDEF,RCLTR)=0,RCPMT="A"
150 F S RCPMT=$O(^PRCA(430,RCBILLDA,5,RCPMT),-1) Q:'RCPMT D Q:RCLTR
151 . S RCELM=$G(^PRCA(430,RCBILLDA,5,RCPMT,0)) Q:RCELM=""
152 . ;
153 . ; - Payment received. Assume it's the last payment made on the Plan
154 . I $P(RCELM,"^",2) S RCLTR=$P(RCELM,"^",4) Q
155 . ;
156 . ; - A payment will be considered defaulted if a payment had not
157 . ; been received on an installment where the due date is at
158 . ; least DAYS days the past.
159 . I $$FMDIFF^XLFDT(DT,$P(RCELM,"^"))'<DAYS D
160 . . S RCDEF=RCDEF+1
161 . ;
162 . S RCDUE=RCDUE+1
163 ;
164 ; - If there are no DUE Payments, the Repayment Plan is paid in full
165 ; In this case, no information is returned
166 I 'RCDUE Q ""
167 ;
168 ; - Gets the Date & Amount of the last payment on the Repayment Plan.
169 ; Retrieves it from file #433 (AR Transaction)
170 S RCLDAM="^"
171 I RCLTR S RCTRA=$G(^PRCA(433,RCLTR,1)) D
172 . S RCLDAM=($P(RCTRA,"^",9)\1)_"^"_$P(RCTRA,"^",5)
173 ;
174 S RCRP=$G(^PRCA(430,RCBILLDA,4))
175 S Y=$P(RCRP,"^")_"^"_($P(RCRP,"^",3)*RCDUE)_"^"_$P(RCRP,"^",3)
176 S Y=Y_"^"_$P(RCRP,"^",2)_"^"_RCLDAM_"^"_RCDUE_"^"_RCDEF
177 Q Y
178 ;
179FORMATDT(DATE) ; format the date to return
180 Q $E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3)
Note: See TracBrowser for help on using the repository browser.