RCBECHGA ;WISC/RFJ-add admin charges to account (called by rcbechgs) ;1 Jun 00
;;4.5;Accounts Receivable;**153,167**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
ADMIN ; this is called by rcbechgs and is a continuation of that routine
; variables passed to this entry point:
; rcdebtda = the ien of the debtor entry in file 340
; rcdata0 = the 0th node for the debtor in rcd(340,rcdebtda,0)
; rcupdate = the fm date that charges are being added
; the rcupdate variable is the statement date for non-benefit
; debts or (statement date minus 3 days) for benefit (first
; party debts)
;
N RCADDATE,RCBILLDA,RCDATA6,RCDATE,RCFADMIN,RCFQUIT,RCLASTDT,RCXDAYS,REPAYDAT,X
;
; get the last date admin was charged to this account
S RCADDATE=$P($G(^RCD(340,+RCDEBTDA,.1)),"^",2)
; take the current statement date in variable rcupdate
; (this is actually 3 days before the statement date for
; benefit first party debts and is when admin charges
; get added) and subtract 1 month (this date will be the
; last statement date). If the last admin charge date
; is greater than the last statement date, do not add
; admin a second time for the same month.
I RCADDATE>$$FPS^RCAMFN01(RCUPDATE,-1) Q
;
S RCDATE=0 F S RCDATE=$O(^TMP("RCBECHGS",$J,"LIST",RCDATE)) Q:'RCDATE D I $G(RCFQUIT) Q
. S RCBILLDA=0 F S RCBILLDA=$O(^TMP("RCBECHGS",$J,"LIST",RCDATE,RCBILLDA)) Q:'RCBILLDA D I $G(RCFQUIT) Q
. . ; bill category is set up to not charge admin, get next bill
. . I '$P($G(^PRCA(430.2,+$P(^PRCA(430,RCBILLDA,0),"^",2),0)),"^",11) Q
. . S RCDATA6=$G(^PRCA(430,RCBILLDA,6))
. . ;
. . ; --- block begin ------------------------------------------
. . ; --- once sites begin populating the new field .12 ---
. . ; --- in file 340, the following block of code can ---
. . ; --- be removed: ---
. . ; get the last date admin was charged to this bill.
. . ; rcaddate is the last date for the account. since
. . ; this may not be populated, check the following:
. . ; use field .12 in file 430, or use field 67
. . S RCLASTDT=RCADDATE
. . I 'RCLASTDT S RCLASTDT=$P($G(^PRCA(430,RCBILLDA,.1)),"^",2) I 'RCLASTDT S RCLASTDT=$P(RCDATA6,"^",7)
. . ; take the current statement date in variable rcupdate
. . ; (this is actually 3 days before the statement date for
. . ; benefit first party debts and is when admin charges
. . ; get added) and subtract 1 month (this date will be the
. . ; last statement date). If the last admin charge date
. . ; is greater than the last statement date, do not add
. . ; admin a second time for the same month.
. . I RCLASTDT>$$FPS^RCAMFN01(RCUPDATE,-1) S RCFQUIT=1 Q
. . ; --- block end ---------------------------------------------
. . ;
. . ; *** the account has RCXDAYS from the initial ***
. . ; *** notification (in letter1 date) to pay the account ***
. . ; *** in full or setup a repayment plan. RCXDAYS is 30 ***
. . ; *** for non-benefit debts and 57 for benefit (first ***
. . ; *** party debts) ***
. . ; *** letter 1 = initial notification ***
. . ; *** letter 2 = 30 days from initial notification ***
. . ; *** letter 3 = 60 days from initial notification ***
. . ;
. . ; non-benefit debt, no letter1 date so not been 30 days
. . I $P(RCDATA0,"^")'["DPT(" D I RCXDAYS=0 Q
. . . S RCXDAYS=30
. . . I '$P(RCDATA6,"^",1) S RCXDAYS=0 Q
. . . ; rcupdate is the statement date for non-benefit debts
. . . ; check to see if it has been 1 month (30 days) by
. . . ; adding a month to the letter1 date. if this date is
. . . ; greater than the current statement date (in rcupdate)
. . . ; then it has not been 30 days from initial notification
. . . I RCUPDATE<$$FPS^RCAMFN01($P(RCDATA6,"^",1),1) S RCXDAYS=0
. . ;
. . ; benefit debt, no letter2 date so not been 57 days
. . I $P(RCDATA0,"^")["DPT(" D I RCXDAYS=0 Q
. . . S RCXDAYS=57
. . . I '$P(RCDATA6,"^",2) S RCXDAYS=0 Q
. . . ; since the update happens 3 days before the statement
. . . ; date, you must add 3 days to the update before checking
. . . ; to see if it is less than the letter3 date (letter2
. . . ; date plus 1 month)
. . . I $$FMADD^XLFDT(RCUPDATE,3)<$$FPS^RCAMFN01($P(RCDATA6,"^",2),1) S RCXDAYS=0
. . ;
. . ; this variable is used to indicate the reason why admin is
. . ; being charged
. . S RCFADMIN=""
. . ; get the repayment plan date
. . S REPAYDAT=$P($G(^PRCA(430,RCBILLDA,4)),"^")
. . ; if there is repayment plan established, test for the date
. . ; it was established and if the account defaulted on it.
. . ; return rcfadmin equal null if admin should not be charged
. . I REPAYDAT D I RCFADMIN="" Q
. . . ; check to see if a repayment plan was set up within
. . . ; RCXDAYS of the initial notification and if not, charge
. . . ; admin on the account. letter1 date is the initial
. . . ; notification. set rcfadmin to reason to charge admin
. . . I REPAYDAT>$$FMADD^XLFDT($P(RCDATA6,"^"),RCXDAYS) S RCFADMIN="Repayment plan not established in "_RCXDAYS_" days from initial notification." Q
. . . ; check to see if the account defaulted on the repayment
. . . ; plan up to the date the admin is being charged, if so
. . . ; charge admin on the account
. . . S X=$$REPAYDEF(RCBILLDA,RCUPDATE) I X S RCFADMIN=$P(X,"^",3)
. . ;
. . ; charge admin
. . I RCFADMIN="" S RCFADMIN="Full payment or repayment plan not established in "_RCXDAYS_" days from initial notification."
. . S X=+$P($$ADM^RCMSFN01(),"^") I 'X Q
. . S $P(^TMP("RCBECHGS",$J,"ADDCHG",RCBILLDA),"^",2)=X
. . S $P(^TMP("RCBECHGS",$J,"ADDCHG",RCBILLDA),"^",4)=RCFADMIN
. . ; set this variable to exit loop for rest of bills for account
. . S RCFQUIT=1
Q
;
;
REPAYDEF(RCBILLDA,RCUPDATE) ; check to see if bill is in default of the
; repayment plan up to a specified date (rcupdate)
; return piece 1 is 1 if in default, 0 if not in default
; piece 2 is the date of default
; piece 3 is the reason why bill found in default
;
N DATA,REPAYDAT
; get the last payment date
S REPAYDAT=$O(^PRCA(430,RCBILLDA,5,"B",RCUPDATE),-1)
I 'REPAYDAT Q 0
S DATA=$G(^PRCA(430,RCBILLDA,5,+$O(^PRCA(430,RCBILLDA,5,REPAYDAT,0)),0))
; in some cases, the repayment date is in the form YYYMM (no day)
I $L(REPAYDAT)=5 S REPAYDAT=REPAYDAT_"01"
; payment not received for date prior to repayment date
I '$P(DATA,"^",2) Q "1^"_REPAYDAT_"^Payment Not Received before due date "_$$FORMATDT(REPAYDAT)
Q 0
;
;
REPDATA(RCBILLDA,DAYS) ; - Return Repayment Plan information
; Input: RCBILLDA=Pointer to the AR file #430
; DAYS=Number of days over the due date for a payment not
; received to be considered defaulted.
; Output: String with the following "^" (up-arrow) pieces:
; 1. Repayment Plan Start Date (FM Format)
; 2. Balance (Repayment Plan)
; 3. Monthly Payment Amount
; 4. Due Date (day of the month)
; 5. Last Payment Date (from file #433)
; 6. Last Payment Amount (from file #433)
; 7. Number of Payments Due
; 8. Number of Payments Defaulted
; or NULL if no Repayment Plan were found for the Bill
;
N RCPMT,RCDEF,RCDUE,RCELM,RCLDAM,RCLTR,RCRP,RCTRA,Y
;
S (RCDUE,RCDEF,RCLTR)=0,RCPMT="A"
F S RCPMT=$O(^PRCA(430,RCBILLDA,5,RCPMT),-1) Q:'RCPMT D Q:RCLTR
. S RCELM=$G(^PRCA(430,RCBILLDA,5,RCPMT,0)) Q:RCELM=""
. ;
. ; - Payment received. Assume it's the last payment made on the Plan
. I $P(RCELM,"^",2) S RCLTR=$P(RCELM,"^",4) Q
. ;
. ; - A payment will be considered defaulted if a payment had not
. ; been received on an installment where the due date is at
. ; least DAYS days the past.
. I $$FMDIFF^XLFDT(DT,$P(RCELM,"^"))'<DAYS D
. . S RCDEF=RCDEF+1
. ;
. S RCDUE=RCDUE+1
;
; - If there are no DUE Payments, the Repayment Plan is paid in full
; In this case, no information is returned
I 'RCDUE Q ""
;
; - Gets the Date & Amount of the last payment on the Repayment Plan.
; Retrieves it from file #433 (AR Transaction)
S RCLDAM="^"
I RCLTR S RCTRA=$G(^PRCA(433,RCLTR,1)) D
. S RCLDAM=($P(RCTRA,"^",9)\1)_"^"_$P(RCTRA,"^",5)
;
S RCRP=$G(^PRCA(430,RCBILLDA,4))
S Y=$P(RCRP,"^")_"^"_($P(RCRP,"^",3)*RCDUE)_"^"_$P(RCRP,"^",3)
S Y=Y_"^"_$P(RCRP,"^",2)_"^"_RCLDAM_"^"_RCDUE_"^"_RCDEF
Q Y
;
FORMATDT(DATE) ; format the date to return
Q $E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCBECHGA 9223 printed Dec 13, 2024@01:42:39 Page 2
RCBECHGA ;WISC/RFJ-add admin charges to account (called by rcbechgs) ;1 Jun 00
+1 ;;4.5;Accounts Receivable;**153,167**;Mar 20, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
ADMIN ; this is called by rcbechgs and is a continuation of that routine
+1 ; variables passed to this entry point:
+2 ; rcdebtda = the ien of the debtor entry in file 340
+3 ; rcdata0 = the 0th node for the debtor in rcd(340,rcdebtda,0)
+4 ; rcupdate = the fm date that charges are being added
+5 ; the rcupdate variable is the statement date for non-benefit
+6 ; debts or (statement date minus 3 days) for benefit (first
+7 ; party debts)
+8 ;
+9 NEW RCADDATE,RCBILLDA,RCDATA6,RCDATE,RCFADMIN,RCFQUIT,RCLASTDT,RCXDAYS,REPAYDAT,X
+10 ;
+11 ; get the last date admin was charged to this account
+12 SET RCADDATE=$PIECE($GET(^RCD(340,+RCDEBTDA,.1)),"^",2)
+13 ; take the current statement date in variable rcupdate
+14 ; (this is actually 3 days before the statement date for
+15 ; benefit first party debts and is when admin charges
+16 ; get added) and subtract 1 month (this date will be the
+17 ; last statement date). If the last admin charge date
+18 ; is greater than the last statement date, do not add
+19 ; admin a second time for the same month.
+20 IF RCADDATE>$$FPS^RCAMFN01(RCUPDATE,-1)
QUIT
+21 ;
+22 SET RCDATE=0
FOR
SET RCDATE=$ORDER(^TMP("RCBECHGS",$JOB,"LIST",RCDATE))
if 'RCDATE
QUIT
Begin DoDot:1
+23 SET RCBILLDA=0
FOR
SET RCBILLDA=$ORDER(^TMP("RCBECHGS",$JOB,"LIST",RCDATE,RCBILLDA))
if 'RCBILLDA
QUIT
Begin DoDot:2
+24 ; bill category is set up to not charge admin, get next bill
+25 IF '$PIECE($GET(^PRCA(430.2,+$PIECE(^PRCA(430,RCBILLDA,0),"^",2),0)),"^",11)
QUIT
+26 SET RCDATA6=$GET(^PRCA(430,RCBILLDA,6))
+27 ;
+28 ; --- block begin ------------------------------------------
+29 ; --- once sites begin populating the new field .12 ---
+30 ; --- in file 340, the following block of code can ---
+31 ; --- be removed: ---
+32 ; get the last date admin was charged to this bill.
+33 ; rcaddate is the last date for the account. since
+34 ; this may not be populated, check the following:
+35 ; use field .12 in file 430, or use field 67
+36 SET RCLASTDT=RCADDATE
+37 IF 'RCLASTDT
SET RCLASTDT=$PIECE($GET(^PRCA(430,RCBILLDA,.1)),"^",2)
IF 'RCLASTDT
SET RCLASTDT=$PIECE(RCDATA6,"^",7)
+38 ; take the current statement date in variable rcupdate
+39 ; (this is actually 3 days before the statement date for
+40 ; benefit first party debts and is when admin charges
+41 ; get added) and subtract 1 month (this date will be the
+42 ; last statement date). If the last admin charge date
+43 ; is greater than the last statement date, do not add
+44 ; admin a second time for the same month.
+45 IF RCLASTDT>$$FPS^RCAMFN01(RCUPDATE,-1)
SET RCFQUIT=1
QUIT
+46 ; --- block end ---------------------------------------------
+47 ;
+48 ; *** the account has RCXDAYS from the initial ***
+49 ; *** notification (in letter1 date) to pay the account ***
+50 ; *** in full or setup a repayment plan. RCXDAYS is 30 ***
+51 ; *** for non-benefit debts and 57 for benefit (first ***
+52 ; *** party debts) ***
+53 ; *** letter 1 = initial notification ***
+54 ; *** letter 2 = 30 days from initial notification ***
+55 ; *** letter 3 = 60 days from initial notification ***
+56 ;
+57 ; non-benefit debt, no letter1 date so not been 30 days
+58 IF $PIECE(RCDATA0,"^")'["DPT("
Begin DoDot:3
+59 SET RCXDAYS=30
+60 IF '$PIECE(RCDATA6,"^",1)
SET RCXDAYS=0
QUIT
+61 ; rcupdate is the statement date for non-benefit debts
+62 ; check to see if it has been 1 month (30 days) by
+63 ; adding a month to the letter1 date. if this date is
+64 ; greater than the current statement date (in rcupdate)
+65 ; then it has not been 30 days from initial notification
+66 IF RCUPDATE<$$FPS^RCAMFN01($PIECE(RCDATA6,"^",1),1)
SET RCXDAYS=0
End DoDot:3
IF RCXDAYS=0
QUIT
+67 ;
+68 ; benefit debt, no letter2 date so not been 57 days
+69 IF $PIECE(RCDATA0,"^")["DPT("
Begin DoDot:3
+70 SET RCXDAYS=57
+71 IF '$PIECE(RCDATA6,"^",2)
SET RCXDAYS=0
QUIT
+72 ; since the update happens 3 days before the statement
+73 ; date, you must add 3 days to the update before checking
+74 ; to see if it is less than the letter3 date (letter2
+75 ; date plus 1 month)
+76 IF $$FMADD^XLFDT(RCUPDATE,3)<$$FPS^RCAMFN01($PIECE(RCDATA6,"^",2),1)
SET RCXDAYS=0
End DoDot:3
IF RCXDAYS=0
QUIT
+77 ;
+78 ; this variable is used to indicate the reason why admin is
+79 ; being charged
+80 SET RCFADMIN=""
+81 ; get the repayment plan date
+82 SET REPAYDAT=$PIECE($GET(^PRCA(430,RCBILLDA,4)),"^")
+83 ; if there is repayment plan established, test for the date
+84 ; it was established and if the account defaulted on it.
+85 ; return rcfadmin equal null if admin should not be charged
+86 IF REPAYDAT
Begin DoDot:3
+87 ; check to see if a repayment plan was set up within
+88 ; RCXDAYS of the initial notification and if not, charge
+89 ; admin on the account. letter1 date is the initial
+90 ; notification. set rcfadmin to reason to charge admin
+91 IF REPAYDAT>$$FMADD^XLFDT($PIECE(RCDATA6,"^"),RCXDAYS)
SET RCFADMIN="Repayment plan not established in "_RCXDAYS_" days from initial notification."
QUIT
+92 ; check to see if the account defaulted on the repayment
+93 ; plan up to the date the admin is being charged, if so
+94 ; charge admin on the account
+95 SET X=$$REPAYDEF(RCBILLDA,RCUPDATE)
IF X
SET RCFADMIN=$PIECE(X,"^",3)
End DoDot:3
IF RCFADMIN=""
QUIT
+96 ;
+97 ; charge admin
+98 IF RCFADMIN=""
SET RCFADMIN="Full payment or repayment plan not established in "_RCXDAYS_" days from initial notification."
+99 SET X=+$PIECE($$ADM^RCMSFN01(),"^")
IF 'X
QUIT
+100 SET $PIECE(^TMP("RCBECHGS",$JOB,"ADDCHG",RCBILLDA),"^",2)=X
+101 SET $PIECE(^TMP("RCBECHGS",$JOB,"ADDCHG",RCBILLDA),"^",4)=RCFADMIN
+102 ; set this variable to exit loop for rest of bills for account
+103 SET RCFQUIT=1
End DoDot:2
IF $GET(RCFQUIT)
QUIT
End DoDot:1
IF $GET(RCFQUIT)
QUIT
+104 QUIT
+105 ;
+106 ;
REPAYDEF(RCBILLDA,RCUPDATE) ; check to see if bill is in default of the
+1 ; repayment plan up to a specified date (rcupdate)
+2 ; return piece 1 is 1 if in default, 0 if not in default
+3 ; piece 2 is the date of default
+4 ; piece 3 is the reason why bill found in default
+5 ;
+6 NEW DATA,REPAYDAT
+7 ; get the last payment date
+8 SET REPAYDAT=$ORDER(^PRCA(430,RCBILLDA,5,"B",RCUPDATE),-1)
+9 IF 'REPAYDAT
QUIT 0
+10 SET DATA=$GET(^PRCA(430,RCBILLDA,5,+$ORDER(^PRCA(430,RCBILLDA,5,REPAYDAT,0)),0))
+11 ; in some cases, the repayment date is in the form YYYMM (no day)
+12 IF $LENGTH(REPAYDAT)=5
SET REPAYDAT=REPAYDAT_"01"
+13 ; payment not received for date prior to repayment date
+14 IF '$PIECE(DATA,"^",2)
QUIT "1^"_REPAYDAT_"^Payment Not Received before due date "_$$FORMATDT(REPAYDAT)
+15 QUIT 0
+16 ;
+17 ;
REPDATA(RCBILLDA,DAYS) ; - Return Repayment Plan information
+1 ; Input: RCBILLDA=Pointer to the AR file #430
+2 ; DAYS=Number of days over the due date for a payment not
+3 ; received to be considered defaulted.
+4 ; Output: String with the following "^" (up-arrow) pieces:
+5 ; 1. Repayment Plan Start Date (FM Format)
+6 ; 2. Balance (Repayment Plan)
+7 ; 3. Monthly Payment Amount
+8 ; 4. Due Date (day of the month)
+9 ; 5. Last Payment Date (from file #433)
+10 ; 6. Last Payment Amount (from file #433)
+11 ; 7. Number of Payments Due
+12 ; 8. Number of Payments Defaulted
+13 ; or NULL if no Repayment Plan were found for the Bill
+14 ;
+15 NEW RCPMT,RCDEF,RCDUE,RCELM,RCLDAM,RCLTR,RCRP,RCTRA,Y
+16 ;
+17 SET (RCDUE,RCDEF,RCLTR)=0
SET RCPMT="A"
+18 FOR
SET RCPMT=$ORDER(^PRCA(430,RCBILLDA,5,RCPMT),-1)
if 'RCPMT
QUIT
Begin DoDot:1
+19 SET RCELM=$GET(^PRCA(430,RCBILLDA,5,RCPMT,0))
if RCELM=""
QUIT
+20 ;
+21 ; - Payment received. Assume it's the last payment made on the Plan
+22 IF $PIECE(RCELM,"^",2)
SET RCLTR=$PIECE(RCELM,"^",4)
QUIT
+23 ;
+24 ; - A payment will be considered defaulted if a payment had not
+25 ; been received on an installment where the due date is at
+26 ; least DAYS days the past.
+27 IF $$FMDIFF^XLFDT(DT,$PIECE(RCELM,"^"))'<DAYS
Begin DoDot:2
+28 SET RCDEF=RCDEF+1
End DoDot:2
+29 ;
+30 SET RCDUE=RCDUE+1
End DoDot:1
if RCLTR
QUIT
+31 ;
+32 ; - If there are no DUE Payments, the Repayment Plan is paid in full
+33 ; In this case, no information is returned
+34 IF 'RCDUE
QUIT ""
+35 ;
+36 ; - Gets the Date & Amount of the last payment on the Repayment Plan.
+37 ; Retrieves it from file #433 (AR Transaction)
+38 SET RCLDAM="^"
+39 IF RCLTR
SET RCTRA=$GET(^PRCA(433,RCLTR,1))
Begin DoDot:1
+40 SET RCLDAM=($PIECE(RCTRA,"^",9)\1)_"^"_$PIECE(RCTRA,"^",5)
End DoDot:1
+41 ;
+42 SET RCRP=$GET(^PRCA(430,RCBILLDA,4))
+43 SET Y=$PIECE(RCRP,"^")_"^"_($PIECE(RCRP,"^",3)*RCDUE)_"^"_$PIECE(RCRP,"^",3)
+44 SET Y=Y_"^"_$PIECE(RCRP,"^",2)_"^"_RCLDAM_"^"_RCDUE_"^"_RCDEF
+45 QUIT Y
+46 ;
FORMATDT(DATE) ; format the date to return
+1 QUIT $EXTRACT(DATE,4,5)_"/"_$EXTRACT(DATE,6,7)_"/"_$EXTRACT(DATE,2,3)
