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

RCRPENTR.m

Go to the documentation of this file. 
  1. RCRPENTR ;EDE/SAB - CREATE NEW REPAYMENT PLAN;11/16/2020  7:40 AM
  1.  ;;4.5;Accounts Receivable;**377,381,378,389,422**;Mar 20, 1995;Build 13
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  Q
  1. ENTER ; Main Entry Point
  1.  ;
  1.  N RCAUTO,RCDBTR,RCCTS,RCACPL,RCTOT,RCBLCH,RCALLFLG,RCDONE,RCSVFLG,Z
  1.  ;
  1.  F  D  Q:+RCDBTR=0
  1.  . ;
  1.  . S RCDONE=0
  1.  . W @IOF
  1.  . ;Ask user for Debtor to build the plan for
  1.  . S RCDBTR=$$GETDBTR^RCRPU
  1.  . Q:+RCDBTR=0
  1.  . ;
  1.  . ;clear working array
  1.  . K ^TMP("RCRPP",$J)
  1.  . ;
  1.  . ;Check for an active Repayment Plan
  1.  . S RCACPL=$$CHKACT^RCRPU(+RCDBTR)
  1.  . ;If an active repayment plan print warning message to user and exit.
  1.  . I +RCACPL D  Q
  1.  . . W !,"This Debtor already has a Repayment Plan that is active."
  1.  . . W !,"A new plan was not created.",!
  1.  . . D PAUSE^RCRPU ;Any key to continue prompt
  1.  . ;Otherwise, print the list of Active Bills
  1.  . W !,"This Debtor does not have a Repayment Plan",!!,"List of Active Bills:",!!
  1.  . S RCCTS=$$GETACTS^RCRPU(+RCDBTR)
  1.  . W @IOF
  1.  . D PRTACTS^RCRPU(+RCCTS)
  1.  . ;Ask user which Active bills to add to new plan (single, range, or all)
  1.  . S RCBLCH=$$GETBILLS^RCRPU(+RCCTS)
  1.  . S RCALLFLG=+RCBLCH,RCBLCH=$P(RCBLCH,U,2)
  1.  . ;If no bills selected, exit.
  1.  . I RCBLCH="" D  Q
  1.  . . W !,"No Bills selected",!
  1.  . . D PAUSE^RCRPU
  1.  . . W @IOF
  1.  . ;Display Bills selected if All Bills not selected
  1.  . I 'RCALLFLG D  Q:'RCDONE
  1.  . . S RCDONE=$$ECHOBL^RCRPADD($P(RCBLCH,U,2))
  1.  . ;Display total sum of bills chosen and confirm with user, exit if no.
  1.  . S RCTOT=$$TOT^RCRPU(RCBLCH)
  1.  . I '+RCTOT D  Q
  1.  . . D PAUSE^RCRPU    ;Any key to continue prompt
  1.  . S RCAUTO=$$AUTOADD^RCRPU1(0) Q:RCAUTO<0  ; prompt for auto-adding bills to the RPP PRCA*4.5*378
  1.  . ;Strip confirm flag to get total.
  1.  . S RCTOT=$P(RCTOT,U,2)
  1.  . ;Get the repayment plan details and save
  1.  . S RCSVFLG=$$GETDET^RCRPU(RCBLCH,RCTOT,RCDBTR,RCAUTO,"N",0)  ; PRCA*4.5*422
  1.  . Q:RCSVFLG<1
  1.  . ;Display bills at CS and recall them if necessary
  1.  . D ASKRCL^RCRPU2  ; PRCA*4.5*389
  1.  . ;Display bills at TOP/DMC
  1.  . S Z=$$DISPREF^RCRPU2(1)  ; PRCA*4.5*389
  1.  ;
  1.  ;Clear working array when exiting.
  1.  K ^TMP("RCRPP",$J)
  1.  ;
  1.  Q
  1.  ;
  1. EDIT ;Edit A Repayment Plan
  1.  ;
  1.  N RCEND
  1.  ;
  1.  F  D  Q:+RCEND<1
  1.  . ;Ask user for Debtor to build the plan for
  1.  . S RCEND=$$GETPLAN
  1.  Q
  1.  ;
  1. GETPLAN() ;Get the Plan IEN using Debtor or Repayment Plan ID.
  1.  N RCDATA,RCIEN,RCERROR,RCDBTR,RCDBTRN,RCRPID,RCMNAMT,RCLNG,RCSTAT,RCLP,RCEDTYPE
  1.  N RCAUTO,RCIENC,RCMSCT,RCPYMD,RCSTDT,RCEXIT,RCEXIT1,RCAFLG,RCPYFB
  1.  ;
  1.  ;Ask user if they wish to perform the lookup by ID or by Debtor
  1.  ;
  1.  S RCEXIT=0
  1.  F  D  Q:RCEXIT<0
  1.  .W @IOF
  1.  .S RCIEN=$$SELRPP^RCRPU1()
  1.  .I +RCIEN<1 S RCEXIT=-1 Q
  1.  .D EDITPLAN(RCIEN)  ; PRCA*4.5*389
  1.  .Q
  1.  ;
  1.  Q RCEXIT
  1.  ;
  1. EDITPLAN(RCIEN) ; edit selected plan, entry point from repayment plan worklist  PRCA*4.5*389
  1.  ;
  1.  ; RCIEN - file 340.5 ien
  1.  ;
  1.  N RCAFLG,RCDBTR,RCDBTRN,RCERROR,RCEXIT1,RCIENC,RCLNG,RCLP,RCMNAMT,RCMSCT,RCPYMD,RCRPID,RCSTAT,RCSTDT
  1.  ; don't allow editing of plans in "closed", "paid in full", and "terminated" status
  1.  I "^6^7^8^"[$$GET1^DIQ(340.5,RCIEN_",",.07,"I")_U W !!,"Can't edit a closed repayment plan.",! D PAUSE^RCRPRPU Q
  1.  F  D  Q:RCEXIT1<1
  1.  .S (RCDATA,RCERROR)="",RCIENC=RCIEN_","
  1.  .; Get the Plan information
  1.  .K RCDATA N RCDATA ; Clear and redefine RCDATA before reprinting screen
  1.  .D GETS^DIQ(340.5,RCIENC,"**","EI","RCDATA","RCERROR")
  1.  .; Get the Base info
  1.  .S RCRPID=RCDATA(340.5,RCIENC,.01,"E")
  1.  .S RCDBTRN=RCDATA(340.5,RCIENC,.02,"E")
  1.  .S RCDBTR=RCDATA(340.5,RCIENC,.02,"I")
  1.  .S RCSTDT=RCDATA(340.5,RCIENC,.04,"I")
  1.  .S RCMNAMT=RCDATA(340.5,RCIENC,.06,"E")
  1.  .S RCLNG=RCDATA(340.5,RCIENC,.05,"E")
  1.  .S RCSTAT=RCDATA(340.5,RCIENC,.07,"E")
  1.  .S RCAFLG=RCDATA(340.5,RCIENC,.12,"E")
  1.  .; Calculate the # payments remaining
  1.  .S RCLP="",RCMSCT=0
  1.  .F  S RCLP=$O(RCDATA(340.52,RCLP)) Q:'RCLP  D
  1.  ..S RCPYMD=RCDATA(340.52,RCLP,1,"I"),RCPYFB=RCDATA(340.52,RCLP,2,"I")
  1.  ..I 'RCPYMD,'RCPYFB S RCMSCT=RCMSCT+1
  1.  ..Q
  1.  .; Display the Plan summary information
  1.  .W @IOF,!,"--------------------------------------------------------------------------------"
  1.  .W !,"Repayment Plan Overview for AR Debtor: ",RCDBTRN,!
  1.  .W !,?23,"Repayment Plan ID: ",RCRPID,!
  1.  .W !,"Monthly Repayment Amount:",?32,"$",$J(RCMNAMT,0,2)
  1.  .W ?45,"Original # of Payments:",?70,RCLNG
  1.  .W !,"# of Remaining Payments:",?32,RCMSCT
  1.  .W ?45,"Current Status:",?70,RCSTAT
  1.  .W !,"Date First Payment Due:",?32,$$FMTE^XLFDT(RCSTDT,"5DZ")
  1.  .W ?45,"Auto Add New Bills:",?70,RCAFLG
  1.  .W !,"--------------------------------------------------------------------------------",!
  1.  .; Ask user what to edit (Close Plan, Edit Monthly Payment, or Allow Auto Adding of Bills
  1.  .S RCEXIT1=0
  1.  .S RCEDTYPE=$$GETTYPE
  1.  .I RCEDTYPE=-1 S RCEXIT1=0 Q   ; Time out or user "^" to exit option
  1.  .; PRCA*4.5*378 - Added 2 new user prompts
  1.  .I RCEDTYPE="Q" S RCEXIT1=0 Q     ;User requested Exit pla using prompt
  1.  .I RCEDTYPE="C" D CLOSE(RCIEN) K ^TMP($J,"RPPFLDNO") S RCEXIT1=0 Q
  1.  .I RCEDTYPE="E" D EDMN(RCDBTR,RCIEN,RCMSCT,.RCEXIT) Q  ; PRCA*4.5*422
  1.  .I RCEDTYPE="A" S RCAUTO=$$AUTOADD^RCRPU1 D:RCAUTO'<0 UPDAUTO^RCRPU1(RCIEN,RCAUTO) S RCEXIT1=1
  1.  .Q
  1.  Q 
  1.  ;
  1. GETTYPE() ;Get the user requested type of editing.
  1.  ;
  1.  N X,Y,DTOUT,DUOUT,DIR,DIROUT,DIRUT
  1.  ;
  1.  ; Prompt Summary or Detail version
  1.  ;S DIR("A")="(C)lose the Plan or (E)dit Monthly Payment?  "
  1.  S DIR("A")="(C)lose Plan, (E)dit Monthly Payment, (A)llow Bill Auto-Add, or (Q)uit?  "
  1.  S DIR("B")="Q"
  1.  S DIR(0)="SA^C:Close Plan;E:Edit Payment Amount;A:Allow Auto-add;Q:Quit"
  1.  S DIR("?")="Select whether to Close the plan, Change the amount of the Monthly Payment, Turn on or off the Auto-add of bills ability, or Quit."
  1.  ;
  1.  D ^DIR K DIR
  1.  ;
  1.  I $D(DTOUT)!$D(DUOUT)!($G(Y)="") Q -1
  1.  ;
  1.  Q Y
  1.  ;
  1. EDMN(RCDBTR,RCIEN,RCORLN,RCEXIT) ;Edit the monthly payment
  1.  ;INPUT - RCIEN - IEN of the Repayment Plan being edited.
  1.  ;        RCORLN - Original # remaining Payments.
  1.  ;        RCEXIT - exit flag for EDITPLAN tag (1/0)
  1.  ;
  1.  N N0,RCTOT,RCPLN
  1.  ;
  1.  S RCEXIT=1  ; PRCA*4.5*422
  1.  ;Determine actual amount remaining
  1.  S RCTOT=$$CALCTOT^RCRPU2(RCIEN)
  1.  ;
  1.  ;Ask for the new amount and plan length
  1.  S RCPLN=$$GETPLN^RCRPU(RCDBTR,RCTOT,1)
  1.  Q:'RCPLN
  1.  S N0=^RCRP(340.5,RCIEN,0)  ; PRCA*4.5*422
  1.  W !!,"You are changing the monthly payment for this repayment plan ",$P(N0,U),", this plan will be administratively closed. A new plan will be generated.",!  ; PRCA*4.5*422
  1.  ;
  1.  ;Confirm that this is correct
  1.  Q:'$$CORRECT^RCRPU
  1.  ; close the plan and create a new one  PRCA*4.5*422
  1.  D CLSPLAN^RCRPU3(RCIEN,"T")
  1.  W !,"Repayment plan ",$P(N0,U)," has been closed.",!
  1.  I '$$CPYPLAN^RCRPU3(RCIEN,RCPLN) Q
  1.  S RCEXIT=0
  1.  D PAUSE^RCRPU
  1.  ;
  1.  Q
  1.  ;
  1. CLOSE(RCIEN) ; Close the plan  PRCA*4.5*422
  1.  ;
  1.  N RCREASON
  1.  ;
  1.  ; Confirm that the user wishes to close the plan 
  1.  Q:'$$CORRECT^RCRPU(3) -1
  1.  ; Enter the reason for closing the plan (defaulting for non-payment or administrative)
  1.  S RCREASON=$$GETRSN^RCRPU1
  1.  Q:RCREASON=-1 -1
  1.  ; Confirm that the reason and closure is correct
  1.  Q:'$$CORRECT^RCRPU -1
  1.  ; Close the plan
  1.  D CLSPLAN^RCRPU3(RCIEN,RCREASON)
  1.  ;
  1.  W !,"Plan Closed.  " D PAUSE^RCRPU
  1.  ;
  1.  Q 1
  1.  ;
  1. ADJSCHED(RCIEN,RCORLN,RCNEWLN) ; Add or subtract payments from a plan's Schedule.
  1.  ;INPUT - RCIEN - IEN of the Repayment Plan being adjusted
  1.  ;        RCORLN - Original Term Length of the payments
  1.  ;        RCNEWLN - New Term Length
  1.  ;
  1.  N RCFBFLG,RCLP,RCLP1,RCPD,RCSTDT,RCSUB,RCFB,RCFBCT,RCORIEN
  1.  ;
  1.  ;Clear RPP Temp array
  1.  K ^TMP("RCRPP",$J)
  1.  ;
  1.  I RCORLN>RCNEWLN D  Q
  1.  .  ;Count the # of payments forborne
  1.  .  S RCFBCT=0,RCLP=0
  1.  .  F  S RCLP=$O(^RCRP(340.5,RCIEN,2,RCLP)) Q:'RCLP  D
  1.  .  .  S RCFB=$P($G(^RCRP(340.5,RCIEN,2,RCLP,0)),U,3)
  1.  .  .  I RCFB S RCFBCT=RCFBCT+1
  1.  .  ;
  1.  .  ;find all of the payments paid, stop on the first unpaid.
  1.  .  S RCLP=0 F  S RCLP=$O(^RCRP(340.5,RCIEN,2,RCLP)) Q:'RCLP  S RCPD=$P($G(^RCRP(340.5,RCIEN,2,RCLP,0)),U,2) Q:'RCPD 
  1.  .  ;
  1.  .  ; Count the new remaining payment out.
  1.  .  S RCLP1=RCLP+RCFBCT+RCNEWLN-1   ;first missing payment + # Forborne months + new length of payment - 1 for the first missing payment)
  1.  .  ;
  1.  .  ; remove the remaining payments from schedule
  1.  .  F  S RCLP1=$O(^RCRP(340.5,RCIEN,2,RCLP1)) Q:'RCLP1  D
  1.  .  .  ;Do not remove payments forborne
  1.  .  .  S RCFBFLG=+$P($G(^RCRP(340.5,RCIEN,2,RCLP1,0)),U,3)
  1.  .  .  Q:RCFBFLG
  1.  .  .  ;
  1.  .  .  ; Remove the month from the schedule.
  1.  .  .  S DA(1)=RCIEN,DA=RCLP1,DIK="^RCRP(340.5,"_DA(1)_",2,"
  1.  .  .  D ^DIK
  1.  .  .  K DA,DIK
  1.  ;
  1.  ;Otherwise, add new payments to schedule.
  1.  ;Find the last date by looking for the last entry and grabbing the first piece.
  1.  S RCORIEN=$O(^RCRP(340.5,RCIEN,2,"A"),-1)
  1.  S RCSTDT=$P($G(^RCRP(340.5,RCIEN,2,RCORIEN,0)),U,1)
  1.  D BLDPLN^RCRPU2(RCSTDT,(RCNEWLN-RCORLN),1,RCIEN)
  1.  ;
  1.  ; Add the new months to the Schedule
  1.  ; Update the Schedule Node
  1.  S RCSUB=0
  1.  F  S RCSUB=$O(^TMP("RCRPP",$J,"PLAN",RCSUB)) Q:'RCSUB  D UPDSCHED^RCRPU(RCIEN,RCSUB)
  1.  ;
  1.  ;Clear temp array
  1.  K ^TMP("RCRPP",$J)
  1.  ;
  1.  Q
  1.  ;