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

RCRPU2.m

Go to the documentation of this file.
  1. RCRPU2 ;EDE/YMG - REPAYMENT PLAN UTILITIES;02/03/2021 8:40 AM
  1. ;;4.5;Accounts Receivable;**381,378,389,429**;Mar 20, 1995;Build 7
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. Q
  1. ;
  1. RECALL(BILL,RSN) ; recall bill from cross-servicing
  1. ;
  1. ; BILL - bill to recall (file 430 ien)
  1. ; RSN - recall reason to use (code for field 430/154)
  1. ;
  1. ; returns 1 on success, 0^error on failure
  1. ;
  1. N DIERR,FDA,IENS
  1. I BILL'>0 Q "0^Invalid file 430 ien"
  1. I RSN="" Q "0^Invalid recall reason"
  1. L +^PRCA(430,BILL):5 I '$T Q "0^Unable to lock entry"
  1. S IENS=BILL_","
  1. S FDA(430,IENS,152)=1
  1. S FDA(430,IENS,154)=RSN
  1. D FILE^DIE("","FDA","DIERR")
  1. I $D(DIERR("DIERR")) Q "0^"_$G(DIERR("DIERR",1,"TEXT",1))
  1. L -^PRCA(430,BILL)
  1. D CSRCLPL^RCTCSPD5 ; CS Recall Placed comment tx in 433
  1. Q 1
  1. ;
  1. DISPREF(TYPE) ; display referred bills
  1. ;
  1. ; TYPE - type of bills to display: 0 = TSCP, 1 = TOP/DMC
  1. ;
  1. ; assumes that ^TMP("RCRPP",$J,"CS") is populated
  1. ;
  1. ; returns comma separated list of bills referred to TSCP if TYPE=0, "" otherwise
  1. ;
  1. N AMT,BILL,BILLNO,CAT,CATN,CNT,CS,DATA,DOS,HDRFLG,STAT,STATN,TSCP,Z
  1. S TSCP="",HDRFLG=0,CNT=0 ; PRCA*4.5*389
  1. S Z="" F S Z=$O(^TMP("RCRPP",$J,"CS",Z)) Q:'Z D
  1. .S DATA=$G(^TMP("RCRPP",$J,"CS",Z)) Q:DATA=""
  1. .S BILL=$P(DATA,U) ; file 430 ien
  1. .S CS=$P(DATA,U,7) ; CS type: 1 = TSCP, 2 = DMC, 3 = TOP
  1. .I 'TYPE,CS'=1 Q ; not at TSCP
  1. .I TYPE,CS'>1 Q ; not at TOP/DMC
  1. .S BILLNO=$P(DATA,U,2),AMT=$P(DATA,U,3),DOS=$P(DATA,U,4),STAT=$P(DATA,U,5),CAT=$P(DATA,U,6)
  1. .S CATN=$P($G(^PRCA(430.2,CAT,0)),U),STATN=$P($G(^PRCA(430.3,STAT,0)),U)
  1. .I 'HDRFLG D
  1. ..I 'TYPE W !!,"Bills at Treasury for Cross-Servicing Debt Collection:",!
  1. ..I TYPE W !!,"Bills in either the Treasury Offset Program or the Debt Management Collection:",!
  1. ..S HDRFLG=1
  1. ..Q
  1. .; add bill to the list of TSCP bills
  1. .I 'TYPE S TSCP=TSCP_$S(TSCP'="":",",1:"")_BILL,CNT=CNT+1 ; PRCA*4.5*389
  1. .; display bill info PRCA*4.5*389
  1. .W ! I 'TYPE W CNT
  1. .W ?5,BILLNO,?21,$E(CATN,1,24),?47,$TR($$FMTE^XLFDT(DOS,"2DZ"),"/","-"),?57,STATN,?67,"$",$J(AMT,8,2) W:TYPE ?77,$S(CS=2:"DMC",CS=3:"TOP",1:"")
  1. .;
  1. .Q
  1. I HDRFLG,TYPE W !!,"Review these bills to see if they should be included into the Repayment Plan.",! D PAUSE^RCRPU ; PRCA*4.5*389
  1. Q TSCP
  1. ;
  1. ASKRCL ; select CS bills to recall PRCA*4.5*389
  1. ;
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1. N BILL,DONE,LEN,LIMIT,LIST,RCERR,RCFIRST,RCLAST,RCLRES,RCI,RCJ,RCPC,TSCP
  1. ;
  1. S LIST="",DONE=0 F D Q:DONE
  1. .S TSCP=$$DISPREF(0) ; display TSCP bills
  1. .I TSCP="" S DONE=1 Q
  1. .S LIMIT=$L(TSCP,",")
  1. .W !!," Select bills using the following formats: (A)ll or (N)one or 1,2,3 and/or 1-3",!
  1. .S DIR(0)="FO^^"
  1. .S DIR("A")="Choose Bills to recall: "
  1. .S DIR("?")="Select bills using the following formats: (A)ll or (N)one or 1,2,3 and/or 1-3"
  1. .D ^DIR
  1. .I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) S DONE=1 Q
  1. .S X=$$UP^XLFSTR(X)
  1. .I $E("NONE",1,$L(X))=X W !,"No bills selected." S:$$ASKCONF()>0 DONE=1 Q
  1. .I $E("ALL",1,$L(X))=X D DISPSEL(TSCP) S:$$ASKCONF()>0 DONE=1,LIST=TSCP Q
  1. .S RCERR="" F RCI=1:1:$L(X,",") S RCPC=$P(X,",",RCI) D Q:RCERR'=""
  1. ..I RCPC'?1.N,RCPC'?1.N1"-"1.N S RCERR="Invalid response" Q
  1. ..I RCPC'>0!(RCPC>LIMIT) S RCERR="Number out of range" Q
  1. ..I RCPC?1.N S LIST=LIST_$S(LIST'="":",",1:"")_$P(TSCP,",",RCPC) Q
  1. ..I RCPC?1.N1"-"1.N D Q:RCERR'=""
  1. ...S RCFIRST=$P(RCPC,"-"),RCLAST=$P(RCPC,"-",2)
  1. ...I RCFIRST'>0!(RCFIRST>LIMIT)!(RCLAST'>0)!(RCLAST>LIMIT)!(RCLAST-RCFIRST<0) S RCERR="Number out of range" Q
  1. ...F RCJ=RCFIRST:1:RCLAST S LIST=LIST_$S(LIST'="":",",1:"")_$P(TSCP,",",RCJ)
  1. ...Q
  1. ..Q
  1. .I RCERR'="" W !," "_RCERR,! Q
  1. .D DISPSEL(LIST) S:$$ASKCONF()>0 DONE=1
  1. .Q
  1. I LIST'="" S LEN=$L(LIST,",") D
  1. .F RCI=1:1:LEN D
  1. ..; recall bill
  1. ..S BILL=$P(LIST,",",RCI),RCLRES=$$RECALL(BILL,"08")
  1. ..I +RCLRES<0 W !,"Recall failed for bill ",$$GET1^DIQ(430,BILL_",",.01)," - ",$P(RCLRES,U,2)
  1. ..Q
  1. .W !!,"Recalls have been placed for the above bills."
  1. .Q
  1. Q
  1. ;
  1. DISPSEL(TSCP) ; display bills selected for recall PRCA*4.5*389
  1. ;
  1. ; TSCP - comma delimited list of bills to display (file #430 iens)
  1. ;
  1. N Z
  1. W !,"You chose to recall the following bill(s):",!
  1. F Z=1:1:$L(TSCP,",") W !,$$GET1^DIQ(430,$P(TSCP,",",Z)_",",.01)
  1. W !
  1. Q
  1. ;
  1. ASKCONF() ; confirmation prompt PRCA*4.5*389
  1. ;
  1. ; returns 1 if user answers YES, 0 if they answer NO, -1 on user exit
  1. ;
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1. S DIR(0)="Y",DIR("A")="Is this correct? (Y/N)",DIR("B")="YES"
  1. D ^DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q -1
  1. Q Y
  1. ;
  1. ASKCONT() ; display "press return to continue or ^ to quit" prompt
  1. ;
  1. ; returns 1 if user pressed <enter>, 0 on user exit.
  1. ;
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1. W ! S DIR(0)="E" D ^DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q 0
  1. Q 1
  1. ;
  1. UPDRVW(RCIEN,RCFLG) ; Update the Review Flag
  1. ;INPUT - RCIEN: IEN of the Repayment Plan
  1. ; RCFLG: Value of the flag.
  1. ; 1 : To appear on the Term Length Exceeded Report
  1. ; 0 or NULL: Does not appear on the Term Length Exceeded Report
  1. ;
  1. N DA,DR,DIE,X,Y,RCDT
  1. ;
  1. S RCFLG=$G(RCFLG) ;Ensure the review flag is defined.
  1. ;
  1. S DA=RCIEN,DIE="^RCRP(340.5,"
  1. S DR="1.01///"_RCFLG
  1. S RCDT=$S(RCFLG:$$DT^XLFDT,1:"@")
  1. S DR=DR_";1.05///"_RCDT
  1. D ^DIE
  1. ;
  1. ;Update the AR Metrics File either field 1.03 if needs review or field 1.04 if the plan no longer needs review.
  1. D:+RCFLG UPDMET^RCSTATU(1.03,1)
  1. D:'RCFLG UPDMET^RCSTATU(1.04,1)
  1. ;
  1. Q
  1. ;
  1. UPDATCS(RCIEN,RCATCS,RCENTER) ; Update the AT CS Flag
  1. ;INPUT - RCIEN: IEN of the Repayment Plan
  1. ; RCATCS: The new value of the AT CS? (field 1.04) in the Repayment Plan
  1. ; RCENTER: (Optional) Flag to indicate if the update is due to a new plan being entered
  1. ;
  1. N DA,DR,DIE,X,Y,RCFIELD,RCAUTO
  1. ;
  1. S RCENTER=+$G(RCENTER)
  1. S RCATCS=+$G(RCATCS)
  1. S DA=RCIEN,DIE="^RCRP(340.5,"
  1. S DR="1.04///"_RCATCS
  1. D ^DIE
  1. ;
  1. ;Update the AR Metrics File.
  1. ; If the plan no longer has bills at CS, update field 1.08
  1. ; If the plan has bills at CS when created, update field 1.07
  1. ; If the plan has new bills going to CS and the AUTO-ADD flag is no, update field 1.06 and send a bulletin
  1. ; If the plan has new bills going to CS and the AUTO-ADD flag is Yes, update field 1.05 and send a bulletin
  1. I +RCATCS D Q
  1. . ;Determine which field in the Metrics file to update
  1. . S RCAUTO=$$GET1^DIQ(340.5,RCIEN_",",.12,"I")
  1. . S RCFIELD=$S(RCENTER:1.07,+RCAUTO:1.05,1:1.06)
  1. . ;
  1. . D UPDMET^RCSTATU(RCFIELD,1)
  1. . ;
  1. . ; Send the appropriate Bulletin
  1. ;
  1. ; Flag was changed to No.
  1. D UPDMET^RCSTATU(1.08,1)
  1. Q
  1. ;
  1. CALCTOT(RCIEN) ; Calculate the total amount due on a Repayment Plan.
  1. ;INPUT - RCIEN - IEN of the Repayment Plan
  1. ;Returns - RCTOT - Total amount due.
  1. N RCTOT,RCBLLP,RCBLNO,RCI,RCD7
  1. S RCTOT=0,RCBLLP=0
  1. F S RCBLLP=$O(^RCRP(340.5,RCIEN,6,RCBLLP)) Q:'RCBLLP D
  1. . S RCBLNO=$G(^RCRP(340.5,RCIEN,6,RCBLLP,0))
  1. . Q:'RCBLNO ; Bill number not stored correctly, get next bill.
  1. . S RCD7=$G(^PRCA(430,RCBLNO,7))
  1. . F RCI=1:1:5 S RCTOT=RCTOT+$P(RCD7,U,RCI) ;add fields 71-75 to running total
  1. Q RCTOT
  1. ;
  1. PRTTMP(RCIEN) ; Entry Point to print Plan ID and Status.
  1. ;
  1. ;INPUT - (Required) Repayment Plan IEN
  1. ;
  1. N RCID,RCSTAT
  1. ;
  1. Q:$G(RCIEN)=""
  1. S RCID=$$GET1^DIQ(340.5,RCIEN_",",.01,"E")
  1. S RCSTAT=$$GET1^DIQ(340.5,RCIEN_",",.07,"E")
  1. W !,"REPAYMENT PLAN ID: ",RCID,?39,"STATUS: ",RCSTAT,!
  1. ;
  1. Q
  1. ;
  1. UPDAUDIT(RCRPIEN,RCCHGDT,RCCTYPE,RCCMMNT,RCCMTXT) ; Update the Audit Log for the Plan
  1. ;
  1. ;INPUT - RCRPIEN - IEN of the repayment plan to update
  1. ; RCCHGDT - date of the change
  1. ; RCCTYPE - (N)ew, (E)dit, C)lose, OR (S)tatus Update
  1. ; RCCMMNT - Code for the reason
  1. ; NULL - No comment needed for Type
  1. ; N - New Plan
  1. ; T - Terms Adjustment
  1. ; F - Forbearance Granted
  1. ; S - System Termination
  1. ; D - Defaulted for Non Payment (manual Default)
  1. ; A - Administratively Closed (manual non default closing)
  1. ; RCCMTXT - Free Text Reason (currently coded to Status Only). Will not be defined if RCCMMNT is defined.
  1. ;
  1. ;Ensure that that RCCMMNT and RCCMTXT are defined.
  1. N CMPTR,RCAUDIT ; PRCA*4.5*389
  1. S RCCMMNT=$G(RCCMMNT)
  1. S RCCMTXT=$G(RCCMTXT)
  1. ;
  1. ;Retrieve Last Audit Log entry
  1. ;Check to see that the audit log entry is not a Repeat of last log entry. If it is, don't file it.
  1. S RCTYPE=$S($G(RCCMMNT)'="":"C",1:"T") ;Check for comment type
  1. S RCAUDIT=$$GETLSTAU(RCRPIEN,RCTYPE)
  1. I $P(RCAUDIT,U)=RCCTYPE,RCCMMNT=$P(RCAUDIT,U,2),DT=$P(RCAUDIT,U,3),"^C^T^"[(U_RCTYPE_U) Q ; PRCA*4.5*389
  1. N DLAYGO,DD,DO,DIC,DA,X,Y
  1. S DLAYGO=340.5,DA(1)=RCRPIEN,DIC(0)="L",DIC="^RCRP(340.5,"_DA(1)_",4,",X=RCCHGDT
  1. S DIC("DR")="1///"_RCCTYPE_";2///"_DUZ
  1. I RCCMMNT'="" S CMPTR=+$O(^RCRP(340.501,"B",RCCMMNT,"")) S:CMPTR>0 DIC("DR")=DIC("DR")_";5///"_CMPTR ; PRCA*4.5*389
  1. I RCCMMNT="",RCCMTXT'="" S DIC("DR")=DIC("DR")_";4///"_RCCMTXT
  1. D FILE^DICN
  1. Q
  1. ;
  1. GETLSTAU(RCRPIEN,RCTYPE) ; Get the last entry in the Audit Log.
  1. ;INPUT: RCRPIEN - Repayment Plan ID
  1. ; RCTYPE - retrieve (C)omment Code or (T)ext Comment
  1. ;OUTPUT: Audit Log Type (internal code) ^ Code or Comment ^ Date of entry
  1. ;
  1. N RCAUDDTA,RCCMTCD,RCLSTAUD ; PRCA*4.5*389
  1. ;Find the last Audit Log entry
  1. S RCLSTAUD=$O(^RCRP(340.5,RCRPIEN,4,"A"),-1)
  1. ;Quit if the first entry
  1. Q:RCLSTAUD="" ""
  1. ;Extract the entry
  1. S RCAUDDTA=$G(^RCRP(340.5,RCRPIEN,4,RCLSTAUD,0))
  1. ;Retrieve the specified comment
  1. S RCCMTCD=$S(RCTYPE="C":$P(RCAUDDTA,U,4),1:$P(RCAUDDTA,U,5))
  1. ; Return Log entry and comment
  1. Q $P(RCAUDDTA,U,2)_U_RCCMTCD_U_$P(RCAUDDTA,U) ; PRCA*4.5*389
  1. ;
  1. BLDPLN(RCSTDT,RCLEN,RCSTFLG,RCRPIEN) ; Build the Payment Schedule
  1. ;INPUT - RCSTDT - Initial proposed start date
  1. ; RCLEN - Total Number of months
  1. ; RCSTFLG - (Optional) Flag to indicate if Start Date should be included in payment schedule
  1. ; RCRPIEN - (Optional) Repayment Plan ID (if editing the plan amount)
  1. ;
  1. N RCMNARY,RCSTART,RCMONTH,RCYEAR,RCCOUNT,RCDATE
  1. ;
  1. S RCRPIEN=$G(RCRPIEN)
  1. ;If Start flag is set, then skip the adding the start date to the schedule
  1. S RCSTFLG=$G(RCSTFLG)
  1. S RCSTART=$E(RCSTDT,1,5),RCMONTH=$E(RCSTART,4,5),RCYEAR=$E(RCSTART,1,3)
  1. ;
  1. S:'RCSTFLG RCMNARY(RCSTDT)=""
  1. S:RCSTFLG RCLEN=RCLEN+1
  1. ;
  1. F RCCOUNT=2:1:RCLEN D
  1. . S RCMONTH=RCMONTH+1
  1. . S:RCMONTH=13 RCMONTH=1,RCYEAR=RCYEAR+1
  1. . I RCMONTH<10 S RCMONTH="0"_RCMONTH
  1. . S RCDATE=RCYEAR_RCMONTH_28
  1. . I RCRPIEN,$D(^RCRP(340.5,RCRPIEN,2,"B",RCDATE)) S RCLEN=RCLEN+1 ;Payment already scheduled for that month, don't reschedule
  1. . S RCMNARY(RCDATE)=""
  1. M ^TMP("RCRPP",$J,"PLAN")=RCMNARY
  1. Q
  1. ;