Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCBECHGA

RCBECHGA.m

Go to the documentation of this file.
  1. RCBECHGA ;WISC/RFJ-add admin charges to account (called by rcbechgs) ;1 Jun 00
  1. ;;4.5;Accounts Receivable;**153,167**;Mar 20, 1995
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. Q
  1. ;
  1. ;
  1. ADMIN ; this is called by rcbechgs and is a continuation of that routine
  1. ; variables passed to this entry point:
  1. ; rcdebtda = the ien of the debtor entry in file 340
  1. ; rcdata0 = the 0th node for the debtor in rcd(340,rcdebtda,0)
  1. ; rcupdate = the fm date that charges are being added
  1. ; the rcupdate variable is the statement date for non-benefit
  1. ; debts or (statement date minus 3 days) for benefit (first
  1. ; party debts)
  1. ;
  1. N RCADDATE,RCBILLDA,RCDATA6,RCDATE,RCFADMIN,RCFQUIT,RCLASTDT,RCXDAYS,REPAYDAT,X
  1. ;
  1. ; get the last date admin was charged to this account
  1. S RCADDATE=$P($G(^RCD(340,+RCDEBTDA,.1)),"^",2)
  1. ; take the current statement date in variable rcupdate
  1. ; (this is actually 3 days before the statement date for
  1. ; benefit first party debts and is when admin charges
  1. ; get added) and subtract 1 month (this date will be the
  1. ; last statement date). If the last admin charge date
  1. ; is greater than the last statement date, do not add
  1. ; admin a second time for the same month.
  1. I RCADDATE>$$FPS^RCAMFN01(RCUPDATE,-1) Q
  1. ;
  1. S RCDATE=0 F S RCDATE=$O(^TMP("RCBECHGS",$J,"LIST",RCDATE)) Q:'RCDATE D I $G(RCFQUIT) Q
  1. . S RCBILLDA=0 F S RCBILLDA=$O(^TMP("RCBECHGS",$J,"LIST",RCDATE,RCBILLDA)) Q:'RCBILLDA D I $G(RCFQUIT) Q
  1. . . ; bill category is set up to not charge admin, get next bill
  1. . . I '$P($G(^PRCA(430.2,+$P(^PRCA(430,RCBILLDA,0),"^",2),0)),"^",11) Q
  1. . . S RCDATA6=$G(^PRCA(430,RCBILLDA,6))
  1. . . ;
  1. . . ; --- block begin ------------------------------------------
  1. . . ; --- once sites begin populating the new field .12 ---
  1. . . ; --- in file 340, the following block of code can ---
  1. . . ; --- be removed: ---
  1. . . ; get the last date admin was charged to this bill.
  1. . . ; rcaddate is the last date for the account. since
  1. . . ; this may not be populated, check the following:
  1. . . ; use field .12 in file 430, or use field 67
  1. . . S RCLASTDT=RCADDATE
  1. . . I 'RCLASTDT S RCLASTDT=$P($G(^PRCA(430,RCBILLDA,.1)),"^",2) I 'RCLASTDT S RCLASTDT=$P(RCDATA6,"^",7)
  1. . . ; take the current statement date in variable rcupdate
  1. . . ; (this is actually 3 days before the statement date for
  1. . . ; benefit first party debts and is when admin charges
  1. . . ; get added) and subtract 1 month (this date will be the
  1. . . ; last statement date). If the last admin charge date
  1. . . ; is greater than the last statement date, do not add
  1. . . ; admin a second time for the same month.
  1. . . I RCLASTDT>$$FPS^RCAMFN01(RCUPDATE,-1) S RCFQUIT=1 Q
  1. . . ; --- block end ---------------------------------------------
  1. . . ;
  1. . . ; *** the account has RCXDAYS from the initial ***
  1. . . ; *** notification (in letter1 date) to pay the account ***
  1. . . ; *** in full or setup a repayment plan. RCXDAYS is 30 ***
  1. . . ; *** for non-benefit debts and 57 for benefit (first ***
  1. . . ; *** party debts) ***
  1. . . ; *** letter 1 = initial notification ***
  1. . . ; *** letter 2 = 30 days from initial notification ***
  1. . . ; *** letter 3 = 60 days from initial notification ***
  1. . . ;
  1. . . ; non-benefit debt, no letter1 date so not been 30 days
  1. . . I $P(RCDATA0,"^")'["DPT(" D I RCXDAYS=0 Q
  1. . . . S RCXDAYS=30
  1. . . . I '$P(RCDATA6,"^",1) S RCXDAYS=0 Q
  1. . . . ; rcupdate is the statement date for non-benefit debts
  1. . . . ; check to see if it has been 1 month (30 days) by
  1. . . . ; adding a month to the letter1 date. if this date is
  1. . . . ; greater than the current statement date (in rcupdate)
  1. . . . ; then it has not been 30 days from initial notification
  1. . . . I RCUPDATE<$$FPS^RCAMFN01($P(RCDATA6,"^",1),1) S RCXDAYS=0
  1. . . ;
  1. . . ; benefit debt, no letter2 date so not been 57 days
  1. . . I $P(RCDATA0,"^")["DPT(" D I RCXDAYS=0 Q
  1. . . . S RCXDAYS=57
  1. . . . I '$P(RCDATA6,"^",2) S RCXDAYS=0 Q
  1. . . . ; since the update happens 3 days before the statement
  1. . . . ; date, you must add 3 days to the update before checking
  1. . . . ; to see if it is less than the letter3 date (letter2
  1. . . . ; date plus 1 month)
  1. . . . I $$FMADD^XLFDT(RCUPDATE,3)<$$FPS^RCAMFN01($P(RCDATA6,"^",2),1) S RCXDAYS=0
  1. . . ;
  1. . . ; this variable is used to indicate the reason why admin is
  1. . . ; being charged
  1. . . S RCFADMIN=""
  1. . . ; get the repayment plan date
  1. . . S REPAYDAT=$P($G(^PRCA(430,RCBILLDA,4)),"^")
  1. . . ; if there is repayment plan established, test for the date
  1. . . ; it was established and if the account defaulted on it.
  1. . . ; return rcfadmin equal null if admin should not be charged
  1. . . I REPAYDAT D I RCFADMIN="" Q
  1. . . . ; check to see if a repayment plan was set up within
  1. . . . ; RCXDAYS of the initial notification and if not, charge
  1. . . . ; admin on the account. letter1 date is the initial
  1. . . . ; notification. set rcfadmin to reason to charge admin
  1. . . . I REPAYDAT>$$FMADD^XLFDT($P(RCDATA6,"^"),RCXDAYS) S RCFADMIN="Repayment plan not established in "_RCXDAYS_" days from initial notification." Q
  1. . . . ; check to see if the account defaulted on the repayment
  1. . . . ; plan up to the date the admin is being charged, if so
  1. . . . ; charge admin on the account
  1. . . . S X=$$REPAYDEF(RCBILLDA,RCUPDATE) I X S RCFADMIN=$P(X,"^",3)
  1. . . ;
  1. . . ; charge admin
  1. . . I RCFADMIN="" S RCFADMIN="Full payment or repayment plan not established in "_RCXDAYS_" days from initial notification."
  1. . . S X=+$P($$ADM^RCMSFN01(),"^") I 'X Q
  1. . . S $P(^TMP("RCBECHGS",$J,"ADDCHG",RCBILLDA),"^",2)=X
  1. . . S $P(^TMP("RCBECHGS",$J,"ADDCHG",RCBILLDA),"^",4)=RCFADMIN
  1. . . ; set this variable to exit loop for rest of bills for account
  1. . . S RCFQUIT=1
  1. Q
  1. ;
  1. ;
  1. REPAYDEF(RCBILLDA,RCUPDATE) ; check to see if bill is in default of the
  1. ; repayment plan up to a specified date (rcupdate)
  1. ; return piece 1 is 1 if in default, 0 if not in default
  1. ; piece 2 is the date of default
  1. ; piece 3 is the reason why bill found in default
  1. ;
  1. N DATA,REPAYDAT
  1. ; get the last payment date
  1. S REPAYDAT=$O(^PRCA(430,RCBILLDA,5,"B",RCUPDATE),-1)
  1. I 'REPAYDAT Q 0
  1. S DATA=$G(^PRCA(430,RCBILLDA,5,+$O(^PRCA(430,RCBILLDA,5,REPAYDAT,0)),0))
  1. ; in some cases, the repayment date is in the form YYYMM (no day)
  1. I $L(REPAYDAT)=5 S REPAYDAT=REPAYDAT_"01"
  1. ; payment not received for date prior to repayment date
  1. I '$P(DATA,"^",2) Q "1^"_REPAYDAT_"^Payment Not Received before due date "_$$FORMATDT(REPAYDAT)
  1. Q 0
  1. ;
  1. ;
  1. REPDATA(RCBILLDA,DAYS) ; - Return Repayment Plan information
  1. ; Input: RCBILLDA=Pointer to the AR file #430
  1. ; DAYS=Number of days over the due date for a payment not
  1. ; received to be considered defaulted.
  1. ; Output: String with the following "^" (up-arrow) pieces:
  1. ; 1. Repayment Plan Start Date (FM Format)
  1. ; 2. Balance (Repayment Plan)
  1. ; 3. Monthly Payment Amount
  1. ; 4. Due Date (day of the month)
  1. ; 5. Last Payment Date (from file #433)
  1. ; 6. Last Payment Amount (from file #433)
  1. ; 7. Number of Payments Due
  1. ; 8. Number of Payments Defaulted
  1. ; or NULL if no Repayment Plan were found for the Bill
  1. ;
  1. N RCPMT,RCDEF,RCDUE,RCELM,RCLDAM,RCLTR,RCRP,RCTRA,Y
  1. ;
  1. S (RCDUE,RCDEF,RCLTR)=0,RCPMT="A"
  1. F S RCPMT=$O(^PRCA(430,RCBILLDA,5,RCPMT),-1) Q:'RCPMT D Q:RCLTR
  1. . S RCELM=$G(^PRCA(430,RCBILLDA,5,RCPMT,0)) Q:RCELM=""
  1. . ;
  1. . ; - Payment received. Assume it's the last payment made on the Plan
  1. . I $P(RCELM,"^",2) S RCLTR=$P(RCELM,"^",4) Q
  1. . ;
  1. . ; - A payment will be considered defaulted if a payment had not
  1. . ; been received on an installment where the due date is at
  1. . ; least DAYS days the past.
  1. . I $$FMDIFF^XLFDT(DT,$P(RCELM,"^"))'<DAYS D
  1. . . S RCDEF=RCDEF+1
  1. . ;
  1. . S RCDUE=RCDUE+1
  1. ;
  1. ; - If there are no DUE Payments, the Repayment Plan is paid in full
  1. ; In this case, no information is returned
  1. I 'RCDUE Q ""
  1. ;
  1. ; - Gets the Date & Amount of the last payment on the Repayment Plan.
  1. ; Retrieves it from file #433 (AR Transaction)
  1. S RCLDAM="^"
  1. I RCLTR S RCTRA=$G(^PRCA(433,RCLTR,1)) D
  1. . S RCLDAM=($P(RCTRA,"^",9)\1)_"^"_$P(RCTRA,"^",5)
  1. ;
  1. S RCRP=$G(^PRCA(430,RCBILLDA,4))
  1. S Y=$P(RCRP,"^")_"^"_($P(RCRP,"^",3)*RCDUE)_"^"_$P(RCRP,"^",3)
  1. S Y=Y_"^"_$P(RCRP,"^",2)_"^"_RCLDAM_"^"_RCDUE_"^"_RCDEF
  1. Q Y
  1. ;
  1. FORMATDT(DATE) ; format the date to return
  1. Q $E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3)