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