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

RCRPU3.m

Go to the documentation of this file.
  1. RCRPU3 ;EDE/YMG - REPAYMENT PLAN UTILITIES;11/01/2022 8:40 AM
  1. ;;4.5;Accounts Receivable;**389,422**;Mar 20, 1995;Build 13
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. Q
  1. ;
  1. PMNTS(RPIEN) ; calculate the sum of payments made for a given RPP
  1. ;
  1. ; RPIEN - file 340.5 ien
  1. ;
  1. ; returns sum of payments in sub-file 340.53
  1. ;
  1. N PMDT,PMIEN,RES
  1. S RES=0
  1. S PMDT=0 F S PMDT=$O(^RCRP(340.5,RPIEN,3,"B",PMDT)) Q:'PMDT D
  1. .S PMIEN="" F S PMIEN=+$O(^RCRP(340.5,RPIEN,3,"B",PMDT,PMIEN)) Q:'PMIEN S RES=RES+$P($G(^RCRP(340.5,RPIEN,3,PMIEN,0)),U,2)
  1. .Q
  1. Q RES
  1. ;
  1. CBAL(RPIEN,TOTAMNT) ; calculate current balance for a given RPP
  1. ;
  1. ; RPIEN - file 340.5 ien
  1. ; TOTAMNT - plan amount owed (340.5/.11), optional
  1. ;
  1. ; returns plan amount owed - sum of all payments
  1. ;
  1. N RES
  1. S RES=0
  1. I +$G(RPIEN)>0 D
  1. .S TOTAMNT=$G(TOTAMNT,$P($G(^RCRP(340.5,RPIEN,0)),U,11))
  1. .S RES=TOTAMNT-$$PMNTS(RPIEN)
  1. .Q
  1. Q RES
  1. ;
  1. REMPMNTS(RPIEN,MNAMNT) ; calculate remaining payments for a given RPP
  1. ;
  1. ; RPIEN - file 340.5 ien
  1. ; MNAMNT - amount per month (340.5/.06), optional
  1. ;
  1. ; returns # of remaining payments
  1. ;
  1. N CBAL,RES
  1. S RES=0
  1. I +$G(RPIEN)>0 D
  1. .S MNAMNT=$G(MNAMNT,$P($G(^RCRP(340.5,RPIEN,0)),U,6))
  1. .S CBAL=$$CBAL(RPIEN)
  1. .S RES=CBAL\MNAMNT+$S(CBAL#MNAMNT:1,1:0)
  1. .Q
  1. Q RES
  1. ;
  1. CLSPLAN(RCIEN,RCREASON) ; close repayment plan (non-interactive) PRCA*4.5*422
  1. ;
  1. ; RCIEN - plan to close (ien in file 340.5)
  1. ; RCREASON - audit log comment (340.501/.01)
  1. ;
  1. N RCCURST,RCFIELD
  1. ;
  1. S RCCURST=$$GET1^DIQ(340.5,RCIEN_",",.07,"I") ; get current plan status
  1. D BLDSTARY^RCRPNP ; set up the field # array for the metrics file
  1. D UPDSTAT^RCRPU1(RCIEN,7) ; update plan status to CLOSED
  1. S RCFIELD=$G(^TMP($J,"RPPFLDNO",RCCURST,7)) D UPDMET^RCSTATU(RCFIELD,1) ; update the correct Status Movement Metric
  1. ; update the Close Reason Metric (Default reason updates field 1.28, otherwise, update 1.27 in the AR Metrics file (340.7)
  1. S RCFIELD=$S(RCREASON="D":1.28,1:1.27) D UPDMET^RCSTATU(RCFIELD,1)
  1. D UPDAUDIT^RCRPU2(RCIEN,$$DT^XLFDT,"C",RCREASON) ; update the audit log with the reason
  1. ; update the bills on the plan to remove the REPAYMENT PLAN DATE and AR REPAYMENT PLAN ID
  1. ; also, file a transaction indicating that the plan was closed.
  1. D RMBILL^RCRPU1(RCIEN)
  1. K ^TMP($J,"RPPFLDNO") ; kill temporary global created by BLDSTARY^RCRPNP
  1. Q
  1. ;
  1. CPYPLAN(RCIEN,RCPLN) ; copy existing repayment plan into a new repayment plan (non-interactive) PRCA*4.5*422
  1. ;
  1. ; RCIEN - existing plan to copy (ien in file 340.5)
  1. ; RCPLN - new plan monthly amount ^ new plan # of payments
  1. ;
  1. ; returns 1 on success
  1. ;
  1. N N0,RCAUTO,RCBILL,RCBLCH,RCCTS,RCDBTR,RCSVFLG,Z
  1. ;
  1. K ^TMP("RCRPP",$J)
  1. S N0=^RCRP(340.5,RCIEN,0)
  1. S RCDBTR=$P(N0,U,2),RCAUTO=$P(N0,U,12)
  1. S RCCTS=$$GETACTS^RCRPU(+RCDBTR),RCBLCH=""
  1. S Z=0 F S Z=$O(^RCRP(340.5,RCIEN,6,Z)) Q:'Z D
  1. .S RCBILL=$P(^RCRP(340.5,RCIEN,6,Z,0),U)
  1. .S RCBLCH=RCBLCH_$S(RCBLCH="":"",1:",")_RCBILL
  1. .S ^TMP("RCRPP",$J,"BILLS",RCBILL)=""
  1. .Q
  1. S RCSVFLG=$$GETDET^RCRPU(RCBLCH,RCTOT,RCDBTR,RCAUTO,"T",RCPLN) ; create new plan
  1. K ^TMP("RCRPP",$J)
  1. Q RCSVFLG