- 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 Jan 18, 2025@02:43:53 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)