[613] | 1 | RCBECHGA ;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 | ;
|
---|
| 7 | ADMIN ; 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 | ;
|
---|
| 114 | REPAYDEF(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 | ;
|
---|
| 132 | REPDATA(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 | ;
|
---|
| 179 | FORMATDT(DATE) ; format the date to return
|
---|
| 180 | Q $E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3)
|
---|