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

RCRPTLR.m

Go to the documentation of this file. 
  1. RCRPTLR ;EDE/YMG - REPAYMENT PLAN TERM LENGTH EXCEEDED REPORT; 11/23/2020
  1.  ;;4.5;Accounts Receivable;**378,423**;Mar 20, 1995;Build 8
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  Q
  1.  ;
  1. EN ; entry point
  1.  N EXCEL,POP,SORT,ZTDESC,ZTRTN,ZTSAVE,ZTSK,%ZIS
  1.  K ^TMP("RCRPTLR",$J)
  1.  W !!,"Repayment Plan Term Length Exceeded Report",!
  1.  ; sort by?
  1.  S SORT=$$ASKSORT() I SORT=-1 Q
  1.  ; export to Excel?
  1.  S EXCEL=$$ASKEXCEL^RCRPRPU() I EXCEL<0 Q
  1.  I EXCEL D EXCMSG^RCTCSJR    ; Display Excel display message I EXCEL
  1.  I 'EXCEL W !!,"This report requires 132 characters",!
  1.  ; ask for device
  1.  K IOP,IO("Q")
  1.  S %ZIS="MQ",%ZIS("B")="",POP=0 D ^%ZIS Q:POP
  1.  I $D(IO("Q")) D  Q  ; queued report
  1.  .S ZTDESC="Repayment Plan Term Length Exceeded Report",ZTRTN="COMPILE^RCRPTLR"
  1.  .S ZTSAVE("EXCEL")="",ZTSAVE("ZTREQ")="@"
  1.  .D ^%ZTLOAD,HOME^%ZIS
  1.  .I $G(ZTSK) W !!,"Report compilation has started with task# ",ZTSK,".",! D PAUSE^RCRPRPU
  1.  .Q
  1.  D COMPILE
  1.  ;
  1.  Q
  1.  ;
  1. COMPILE ; compile report
  1.  N CNT,DEBTOR,N0,NAME,RPIEN,RPPID,SSN,TEDT,Z
  1.  S (CNT,TEDT)=0 F  S TEDT=$O(^RCRP(340.5,"C",TEDT)) Q:'TEDT  D
  1.  .S RPIEN=0 F  S RPIEN=$O(^RCRP(340.5,"C",TEDT,RPIEN)) Q:'RPIEN  D
  1.  ..S N0=^RCRP(340.5,RPIEN,0)              ; 0-node in file 340.5
  1.  ..I "^6^7^8^"[(U_$P(N0,U,7)_U) Q         ; skip plans in Closed, Paid in Full, or Terminated status
  1.  ..S DEBTOR=$P(N0,U,2)                    ; pointer to file 340
  1.  ..S NAME=$$NAM^RCFN01(DEBTOR) Q:NAME=""  ; debtor name
  1.  ..S SSN=$$SSN^RCFN01(DEBTOR) Q:SSN'>0    ; debtor SSN
  1.  ..S RPPID=$P(N0,U)                       ; RPP ID
  1.  ..; each entry is: ^TMP("RCRPTLR",$J,n) = RPP ID ^ name ^ ssn ^ term length (remaining # of payments) ^ term limit exceeded date
  1.  ..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
  1.  ..S Z=$S(SORT="N":NAME,SORT="S":SSN,1:RPPID) Q:Z=""
  1.  ..S Z=" "_Z    ;Add space to force correct sort order
  1.  ..S ^TMP("RCRPTLR",$J,"IDX",Z,CNT)=""
  1.  ..Q
  1.  .Q
  1.  D PRINT
  1.  K ^TMP("RCRPTLR",$J)
  1.  Q
  1.  ;
  1. PRINT ; print report
  1.  N CNT,DATA,EXTDT,LN,PAGE,Z
  1.  U IO
  1.  S PAGE=0
  1.  S EXTDT=$$FMTE^XLFDT(DT)
  1.  I EXCEL D
  1.  .W !,"Repayment Plan Term Length Exceeded Report^",EXTDT
  1.  .W !,"Name^SSN^RPP ID^Term Length^Term Limit Exceeded Date"
  1.  .Q
  1.  I 'EXCEL D
  1.  .I $E(IOST,1,2)["C-",'$D(ZTQUEUED) W @IOF
  1.  .D HDR
  1.  .Q
  1.  I '$D(^TMP("RCRPTLR",$J)) D  Q
  1.  .I EXCEL W !!,"No records found." Q
  1.  .W !!,$$CJ^XLFSTR("No records found.",80)
  1.  .Q
  1.  S Z="" F  S Z=$O(^TMP("RCRPTLR",$J,"IDX",Z)) Q:Z=""  D
  1.  .S CNT=0 F  S CNT=$O(^TMP("RCRPTLR",$J,"IDX",Z,CNT)) Q:'CNT  D
  1.  ..S DATA=^TMP("RCRPTLR",$J,CNT)
  1.  ..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
  1.  ..S LN=LN+1
  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")
  1.  ..I LN>(IOSL-3) D HDR
  1.  ..Q
  1.  .Q
  1.  Q
  1.  ;
  1. HDR ; print header
  1.  I PAGE>0,'$D(ZTQUEUED) D PAUSE^RCRPRPU
  1.  W @IOF
  1.  S PAGE=PAGE+1,LN=4
  1.  W !,"Repayment Plan Term Length Exceeded Report",?50,EXTDT,?68,"Page: ",PAGE
  1.  W !!,"                                                               Term   Term Limit"
  1.  W !,"         Name                  SSN           RPP ID           Length   Exc. Date"
  1.  W ! D DASH^RCRPRPU(80)
  1.  Q
  1.  ;
  1. ASKSORT() ; display "sort by" prompt
  1.  ;
  1.  ; returns N for debtor name, S for status, A for account balance, -1 for user exit / timeout
  1.  ;
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1.  S DIR(0)="SA^N:Name;S:SSN;R:Repayment Plan ID",DIR("B")="N"
  1.  S DIR("A")="Sort By (N)ame, (S)SN or (R)epayment Plan ID: "
  1.  D ^DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q -1
  1.  Q Y