RCRPTLR ;EDE/YMG - REPAYMENT PLAN TERM LENGTH EXCEEDED REPORT; 11/23/2020
;;4.5;Accounts Receivable;**378,423**;Mar 20, 1995;Build 8
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
EN ; entry point
N EXCEL,POP,SORT,ZTDESC,ZTRTN,ZTSAVE,ZTSK,%ZIS
K ^TMP("RCRPTLR",$J)
W !!,"Repayment Plan Term Length Exceeded Report",!
; sort by?
S SORT=$$ASKSORT() I SORT=-1 Q
; export to Excel?
S EXCEL=$$ASKEXCEL^RCRPRPU() I EXCEL<0 Q
I EXCEL D EXCMSG^RCTCSJR ; Display Excel display message I EXCEL
I 'EXCEL W !!,"This report requires 132 characters",!
; ask for device
K IOP,IO("Q")
S %ZIS="MQ",%ZIS("B")="",POP=0 D ^%ZIS Q:POP
I $D(IO("Q")) D Q ; queued report
.S ZTDESC="Repayment Plan Term Length Exceeded Report",ZTRTN="COMPILE^RCRPTLR"
.S ZTSAVE("EXCEL")="",ZTSAVE("ZTREQ")="@"
.D ^%ZTLOAD,HOME^%ZIS
.I $G(ZTSK) W !!,"Report compilation has started with task# ",ZTSK,".",! D PAUSE^RCRPRPU
.Q
D COMPILE
;
Q
;
COMPILE ; compile report
N CNT,DEBTOR,N0,NAME,RPIEN,RPPID,SSN,TEDT,Z
S (CNT,TEDT)=0 F S TEDT=$O(^RCRP(340.5,"C",TEDT)) Q:'TEDT D
.S RPIEN=0 F S RPIEN=$O(^RCRP(340.5,"C",TEDT,RPIEN)) Q:'RPIEN D
..S N0=^RCRP(340.5,RPIEN,0) ; 0-node in file 340.5
..I "^6^7^8^"[(U_$P(N0,U,7)_U) Q ; skip plans in Closed, Paid in Full, or Terminated status
..S DEBTOR=$P(N0,U,2) ; pointer to file 340
..S NAME=$$NAM^RCFN01(DEBTOR) Q:NAME="" ; debtor name
..S SSN=$$SSN^RCFN01(DEBTOR) Q:SSN'>0 ; debtor SSN
..S RPPID=$P(N0,U) ; RPP ID
..; each entry is: ^TMP("RCRPTLR",$J,n) = RPP ID ^ name ^ ssn ^ term length (remaining # of payments) ^ term limit exceeded date
..S CNT=CNT+1,^TMP("RCRPTLR",$J,CNT)=RPPID_U_NAME_U_SSN_U_$$REMPMNTS^RCRPU3(RPIEN,+$P(N0,U,6))_U_TEDT ; PRCA*4.5*423
..S Z=$S(SORT="N":NAME,SORT="S":SSN,1:RPPID) Q:Z=""
..S Z=" "_Z ;Add space to force correct sort order
..S ^TMP("RCRPTLR",$J,"IDX",Z,CNT)=""
..Q
.Q
D PRINT
K ^TMP("RCRPTLR",$J)
Q
;
PRINT ; print report
N CNT,DATA,EXTDT,LN,PAGE,Z
U IO
S PAGE=0
S EXTDT=$$FMTE^XLFDT(DT)
I EXCEL D
.W !,"Repayment Plan Term Length Exceeded Report^",EXTDT
.W !,"Name^SSN^RPP ID^Term Length^Term Limit Exceeded Date"
.Q
I 'EXCEL D
.I $E(IOST,1,2)["C-",'$D(ZTQUEUED) W @IOF
.D HDR
.Q
I '$D(^TMP("RCRPTLR",$J)) D Q
.I EXCEL W !!,"No records found." Q
.W !!,$$CJ^XLFSTR("No records found.",80)
.Q
S Z="" F S Z=$O(^TMP("RCRPTLR",$J,"IDX",Z)) Q:Z="" D
.S CNT=0 F S CNT=$O(^TMP("RCRPTLR",$J,"IDX",Z,CNT)) Q:'CNT D
..S DATA=^TMP("RCRPTLR",$J,CNT)
..I EXCEL W !,$P(DATA,U,2),U,$P(DATA,U,3),U,$P(DATA,U),U,$P(DATA,U,4),U,$$FMTE^XLFDT($P(DATA,U,5),"5DZ") Q
..S LN=LN+1
..W !,$E($P(DATA,U,2),1,26),?28,$P(DATA,U,3),?40,$P(DATA,U),?65,$P(DATA,U,4),?70,$$FMTE^XLFDT($P(DATA,U,5),"5DZ")
..I LN>(IOSL-3) D HDR
..Q
.Q
Q
;
HDR ; print header
I PAGE>0,'$D(ZTQUEUED) D PAUSE^RCRPRPU
W @IOF
S PAGE=PAGE+1,LN=4
W !,"Repayment Plan Term Length Exceeded Report",?50,EXTDT,?68,"Page: ",PAGE
W !!," Term Term Limit"
W !," Name SSN RPP ID Length Exc. Date"
W ! D DASH^RCRPRPU(80)
Q
;
ASKSORT() ; display "sort by" prompt
;
; returns N for debtor name, S for status, A for account balance, -1 for user exit / timeout
;
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="SA^N:Name;S:SSN;R:Repayment Plan ID",DIR("B")="N"
S DIR("A")="Sort By (N)ame, (S)SN or (R)epayment Plan ID: "
D ^DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q -1
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCRPTLR 3646 printed Sep 23, 2025@19:24:36 Page 2
RCRPTLR ;EDE/YMG - REPAYMENT PLAN TERM LENGTH EXCEEDED REPORT; 11/23/2020
+1 ;;4.5;Accounts Receivable;**378,423**;Mar 20, 1995;Build 8
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
EN ; entry point
+1 NEW EXCEL,POP,SORT,ZTDESC,ZTRTN,ZTSAVE,ZTSK,%ZIS
+2 KILL ^TMP("RCRPTLR",$JOB)
+3 WRITE !!,"Repayment Plan Term Length Exceeded Report",!
+4 ; sort by?
+5 SET SORT=$$ASKSORT()
IF SORT=-1
QUIT
+6 ; export to Excel?
+7 SET EXCEL=$$ASKEXCEL^RCRPRPU()
IF EXCEL<0
QUIT
+8 ; Display Excel display message I EXCEL
IF EXCEL
DO EXCMSG^RCTCSJR
+9 IF 'EXCEL
WRITE !!,"This report requires 132 characters",!
+10 ; ask for device
+11 KILL IOP,IO("Q")
+12 SET %ZIS="MQ"
SET %ZIS("B")=""
SET POP=0
DO ^%ZIS
if POP
QUIT
+13 ; queued report
IF $DATA(IO("Q"))
Begin DoDot:1
+14 SET ZTDESC="Repayment Plan Term Length Exceeded Report"
SET ZTRTN="COMPILE^RCRPTLR"
+15 SET ZTSAVE("EXCEL")=""
SET ZTSAVE("ZTREQ")="@"
+16 DO ^%ZTLOAD
DO HOME^%ZIS
+17 IF $GET(ZTSK)
WRITE !!,"Report compilation has started with task# ",ZTSK,".",!
DO PAUSE^RCRPRPU
+18 QUIT
End DoDot:1
QUIT
+19 DO COMPILE
+20 ;
+21 QUIT
+22 ;
COMPILE ; compile report
+1 NEW CNT,DEBTOR,N0,NAME,RPIEN,RPPID,SSN,TEDT,Z
+2 SET (CNT,TEDT)=0
FOR
SET TEDT=$ORDER(^RCRP(340.5,"C",TEDT))
if 'TEDT
QUIT
Begin DoDot:1
+3 SET RPIEN=0
FOR
SET RPIEN=$ORDER(^RCRP(340.5,"C",TEDT,RPIEN))
if 'RPIEN
QUIT
Begin DoDot:2
+4 ; 0-node in file 340.5
SET N0=^RCRP(340.5,RPIEN,0)
+5 ; skip plans in Closed, Paid in Full, or Terminated status
IF "^6^7^8^"[(U_$PIECE(N0,U,7)_U)
QUIT
+6 ; pointer to file 340
SET DEBTOR=$PIECE(N0,U,2)
+7 ; debtor name
SET NAME=$$NAM^RCFN01(DEBTOR)
if NAME=""
QUIT
+8 ; debtor SSN
SET SSN=$$SSN^RCFN01(DEBTOR)
if SSN'>0
QUIT
+9 ; RPP ID
SET RPPID=$PIECE(N0,U)
+10 ; each entry is: ^TMP("RCRPTLR",$J,n) = RPP ID ^ name ^ ssn ^ term length (remaining # of payments) ^ term limit exceeded date
+11 ; PRCA*4.5*423
SET CNT=CNT+1
SET ^TMP("RCRPTLR",$JOB,CNT)=RPPID_U_NAME_U_SSN_U_$$REMPMNTS^RCRPU3(RPIEN,+$PIECE(N0,U,6))_U_TEDT
+12 SET Z=$SELECT(SORT="N":NAME,SORT="S":SSN,1:RPPID)
if Z=""
QUIT
+13 ;Add space to force correct sort order
SET Z=" "_Z
+14 SET ^TMP("RCRPTLR",$JOB,"IDX",Z,CNT)=""
+15 QUIT
End DoDot:2
+16 QUIT
End DoDot:1
+17 DO PRINT
+18 KILL ^TMP("RCRPTLR",$JOB)
+19 QUIT
+20 ;
PRINT ; print report
+1 NEW CNT,DATA,EXTDT,LN,PAGE,Z
+2 USE IO
+3 SET PAGE=0
+4 SET EXTDT=$$FMTE^XLFDT(DT)
+5 IF EXCEL
Begin DoDot:1
+6 WRITE !,"Repayment Plan Term Length Exceeded Report^",EXTDT
+7 WRITE !,"Name^SSN^RPP ID^Term Length^Term Limit Exceeded Date"
+8 QUIT
End DoDot:1
+9 IF 'EXCEL
Begin DoDot:1
+10 IF $EXTRACT(IOST,1,2)["C-"
IF '$DATA(ZTQUEUED)
WRITE @IOF
+11 DO HDR
+12 QUIT
End DoDot:1
+13 IF '$DATA(^TMP("RCRPTLR",$JOB))
Begin DoDot:1
+14 IF EXCEL
WRITE !!,"No records found."
QUIT
+15 WRITE !!,$$CJ^XLFSTR("No records found.",80)
+16 QUIT
End DoDot:1
QUIT
+17 SET Z=""
FOR
SET Z=$ORDER(^TMP("RCRPTLR",$JOB,"IDX",Z))
if Z=""
QUIT
Begin DoDot:1
+18 SET CNT=0
FOR
SET CNT=$ORDER(^TMP("RCRPTLR",$JOB,"IDX",Z,CNT))
if 'CNT
QUIT
Begin DoDot:2
+19 SET DATA=^TMP("RCRPTLR",$JOB,CNT)
+20 IF EXCEL
WRITE !,$PIECE(DATA,U,2),U,$PIECE(DATA,U,3),U,$PIECE(DATA,U),U,$PIECE(DATA,U,4),U,$$FMTE^XLFDT($PIECE(DATA,U,5),"5DZ")
QUIT
+21 SET LN=LN+1
+22 WRITE !,$EXTRACT($PIECE(DATA,U,2),1,26),?28,$PIECE(DATA,U,3),?40,$PIECE(DATA,U),?65,$PIECE(DATA,U,4),?70,$$FMTE^XLFDT($PIECE(DATA,U,5),"5DZ")
+23 IF LN>(IOSL-3)
DO HDR
+24 QUIT
End DoDot:2
+25 QUIT
End DoDot:1
+26 QUIT
+27 ;
HDR ; print header
+1 IF PAGE>0
IF '$DATA(ZTQUEUED)
DO PAUSE^RCRPRPU
+2 WRITE @IOF
+3 SET PAGE=PAGE+1
SET LN=4
+4 WRITE !,"Repayment Plan Term Length Exceeded Report",?50,EXTDT,?68,"Page: ",PAGE
+5 WRITE !!," Term Term Limit"
+6 WRITE !," Name SSN RPP ID Length Exc. Date"
+7 WRITE !
DO DASH^RCRPRPU(80)
+8 QUIT
+9 ;
ASKSORT() ; display "sort by" prompt
+1 ;
+2 ; returns N for debtor name, S for status, A for account balance, -1 for user exit / timeout
+3 ;
+4 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+5 SET DIR(0)="SA^N:Name;S:SSN;R:Repayment Plan ID"
SET DIR("B")="N"
+6 SET DIR("A")="Sort By (N)ame, (S)SN or (R)epayment Plan ID: "
+7 DO ^DIR
IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT -1
+8 QUIT Y
