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

RCRPSTR.m

Go to the documentation of this file. 
  1. RCRPSTR ;EDE/YMG - REPAYMENT PLAN STATUS REPORT; 11/30/2020
  1.  ;;4.5;Accounts Receivable;**381,390,396,378,389**;Mar 20, 1995;Build 36
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  Q
  1.  ;
  1. EN ; entry point
  1.  N EXCEL,FILTER,POP,SORT,ZTDESC,ZTRTN,ZTSAVE,ZTSK,%ZIS
  1.  K ^TMP("RCRPSTR",$J)
  1.  W !!,"Repayment Plan Status Report",!
  1.  ; sort by?
  1.  S SORT=$$ASKSORT() I SORT=-1 Q
  1.  ; filter by?
  1.  S FILTER=$$ASKFLTR() I FILTER=-1 Q
  1.  ; export to Excel?
  1.  S EXCEL=$$ASKEXCEL^RCRPRPU() I EXCEL<0 Q
  1.  ;Device settings printout
  1.  I EXCEL D EXCMSG^RCTCSJR    ; Display Excel display message
  1.  I 'EXCEL W !!,"This report requires 132 column display.",!
  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 Status Report",ZTRTN="COMPILE^RCRPSTR"
  1.  .S ZTSAVE("FILTER")="",ZTSAVE("SORT")="",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. 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:Status;A:Account Balance",DIR("B")="N"
  1.  S DIR("A")="Sort By Debtor (N)ame, (S)tatus or (A)ccount Balance: "
  1.  D ^DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q -1
  1.  Q Y
  1.  ;
  1. ASKFLTR() ; display "filter by" prompt
  1.  ;
  1.  ; returns "N ^ start name ^ end name" for debtor name,
  1.  ;         "S ^ selected statuses ^ min days in status ^ max days in status" for status,
  1.  ;         "U" for no filter,
  1.  ;         -1 for user exit / timeout
  1.  ;
  1.  N RES,STOP,Z,RCANS
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1.  S DIR(0)="SA^N:Name;S:Status;U:Unfiltered",DIR("B")="S"
  1.  S DIR("A")="Filter By Debtor (N)ame, (S)tatus or (U)nfiltered: "
  1.  S STOP=0 F  D  Q:STOP
  1.  .D ^DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) S RES=-1,STOP=1 Q
  1.  .S RES=Y
  1.  .I RES="N" D  Q
  1.  ..S Z=$$INTV   ; Ask for the First and last name
  1.  ..I Z=-1 S RES=-1,STOP=1 Q
  1.  ..S $P(RES,U,2)=$P(Z,U),$P(RES,U,3)=$P(Z,U,2),STOP=1
  1.  ..Q
  1.  .I RES="S" D
  1.  ..S Z=$$ASKSTAT() I (Z=-1)!(Z="Q") S RES=-1,STOP=1 Q
  1.  ..S $P(RES,U,2)=Z
  1.  ..S Z=$$ASKDAYS() I Z=-1 S RES=-1,STOP=1 Q
  1.  ..S $P(RES,U,3)=Z
  1.  ..S Z=$$ASKDAYS1($P(RES,U,3)) I Z=-1 S RES=-1,STOP=1 Q  ; PRCA*4.5*389
  1.  ..S $P(RES,U,4)=Z,STOP=1
  1.  ..Q
  1.  .S STOP=1
  1.  .Q
  1.  Q RES
  1.  ;
  1. ASKNM(SNAME) ; display "start with name" / "end with name" prompts
  1.  ;
  1.  ; SNAME - starting name (selected at "start with name" prompt), used in screen, optional
  1.  ;
  1.  ; returns selected debtor name or -1 for no selection / user exit / timeout
  1.  ;
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1.  S SNAME=$G(SNAME,"")
  1.  S DIR(0)="PAO^340:EBS"
  1.  S DIR("A")=$S(SNAME="":"Start",1:"End")_" with name: "
  1.  I SNAME'="" S DIR("S")="I $$NAM^RCFN01(Y)]"""_SNAME_""""
  1.  D ^DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q -1
  1.  Q $$NAM^RCFN01($P(Y,U))
  1.  ;
  1. ASKSTAT() ; display "which statuses" prompt
  1.  ;
  1.  ; returns selected statuses (comma separated list of internal codes from 340.5/.07) or -1 for no selection / user exit / timeout
  1.  ;
  1.  N RES,SEL,STOP,STSTR
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1.  S STSTR="NCLDFTSP"
  1.  S DIR(0)="SAO^A:All;N:New;C:Current;L:Late;D:Delinquent;P:Paid in Full;S:Closed;F:Defaulted;T:Terminated;U:Continue;Q:Quit"
  1.  S DIR("A",1)=""
  1.  S DIR("A",2)="Statuses available:"
  1.  S DIR("A",3)="  (A)ll, (N)ew, (C)urrent, (L)ate, (D)elinquent, (P)aid in Full, Clo(S)ed,"
  1.  S DIR("A",4)="         De(F)aulted, (T)erminated,"
  1.  S DIR("A",5)=""
  1.  S DIR("A",6)=""
  1.  S DIR("A",7)=""
  1.  S DIR("A")="Select Status to add, Enter to continue or (Q)uit? "
  1.  S (RES,SEL)="",STOP=0 F  D  Q:STOP
  1.  .I SEL'="" S DIR("A",6)="Statuses currently selected: "_SEL
  1.  .D ^DIR
  1.  .I Y="" S STOP=1 Q    ;User is ready to enter the days.
  1.  .I $D(DUOUT)!$D(DIROUT) S RES=-1,STOP=1 Q   ;User issued exit command, leave utilitystandard time out or ^ escape
  1.  .I $D(DIRUT)!$D(DTOUT) S STOP=1 Q   ;standard time out or ^ escape
  1.  .I Y="A" D  Q     ;User selected all available statuses for report
  1.  ..S RES="1,2,3,4,7,8,5,6"
  1.  ..S SEL="New,Current,Late,Delinquent,Paid in Full,Closed,Defaulted,Terminated"
  1.  ..S STOP=1
  1.  .I Y="Q" S RES=-1,STOP=1 Q
  1.  .I Y="U" S STOP=1 Q
  1.  .I SEL'[Y(0) D
  1.  ..S RES=RES_$S(RES'="":","_($F(STSTR,Y)-1),1:$F(STSTR,Y)-1)
  1.  ..S SEL=SEL_$S(SEL'="":", "_Y(0),1:Y(0))
  1.  ..Q
  1.  .I $L(RES,",")=8 S STOP=1  ; all statuses selected - we're done
  1.  .Q
  1.  Q $S(RES="":-1,1:RES)
  1.  ;
  1. ASKDAYS() ; display "min. days in status" prompt
  1.  ;
  1.  ; returns min. # of days in status or -1 for no selection / user exit / timeout
  1.  ;
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1.  W !
  1.  S DIR(0)="NA^0:999:0"
  1.  S DIR("A")="Enter the Minimum # of Days in Status or ^ to quit: "
  1.  D ^DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q -1
  1.  Q Y
  1.  ;
  1. ASKDAYS1(MINDAYS) ; display "max. days in status" prompt  PRCA*4.5*389
  1.  ;
  1.  ; returns max. # of days in status or -1 for no selection / user exit / timeout
  1.  ;
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1.  W !
  1.  S DIR(0)="NAO^"_MINDAYS_":999:0"
  1.  S DIR("A")="Enter the Maximum # of Days in Status or ^ to quit: "
  1.  D ^DIR I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q -1
  1.  Q Y
  1.  ;
  1. COMPILE ; compile report
  1.  N BEGDT,CNT,ENDDT,NAME,RPIEN,STATDT,STATUS,STLIST,Z
  1.  ;
  1.  S CNT=0
  1.  I $P(FILTER,U)="S" D
  1.  .; filtering by statuses
  1.  .S BEGDT=$$FMADD^XLFDT(DT,-$P(FILTER,U,3),,1) ; date to begin the search with
  1.  .S Z=$P(FILTER,U,4),ENDDT="" I Z>0 S ENDDT=$$FMADD^XLFDT(DT,-$P(FILTER,U,4),,-1) ; date to end the search with  PRCA*4.5*389
  1.  .S STLIST=$P(FILTER,U,2) F Z=1:1:$L(STLIST,",") S STATUS=$P(STLIST,",",Z) D
  1.  ..S STATDT=BEGDT F  S STATDT=$O(^RCRP(340.5,"D",STATUS,STATDT),-1) Q:'STATDT!(ENDDT'=""&(STATDT<ENDDT))  D  ; PRCA*4.5*389
  1.  ...S RPIEN="" F  S RPIEN=$O(^RCRP(340.5,"D",STATUS,STATDT,RPIEN)) Q:'RPIEN  S CNT=CNT+1 D GETDATA(RPIEN,CNT)
  1.  ...Q
  1.  ..Q
  1.  .Q
  1.  I $P(FILTER,U)="N"!($P(FILTER,U)="U") D
  1.  .; filtering by name or no filter
  1.  .S Z="" F  S Z=$O(^RCRP(340.5,"B",Z)) Q:'Z  D
  1.  ..S RPIEN=$O(^RCRP(340.5,"B",Z,"")) Q:'RPIEN
  1.  ..I $P(FILTER,U)="N" S NAME=$$NAM^RCFN01($P(^RCRP(340.5,RPIEN,0),U,2)) Q:$P(FILTER,U,2)]NAME  Q:NAME]$P(FILTER,U,3)
  1.  ..S CNT=CNT+1 D GETDATA(RPIEN,CNT)
  1.  ..Q
  1.  .Q
  1.  D PRINT
  1.  K ^TMP("RCRPSTR",$J)
  1.  Q
  1.  ;
  1. GETDATA(RPIEN,CNT) ; fetch data and put it into ^TMP global
  1.  ;
  1.  ; RPIEN - file 340.5 ien
  1.  ; CNT   - sequential # of ^TMP entry to create
  1.  ;
  1.  N AMNT,DAYS,DEBTOR,N0,MED,SSN,TMPSTR,Z,ORPLNDT,RMNOPY
  1.  I RPIEN'>0!(CNT'>0) Q
  1.  S N0=^RCRP(340.5,RPIEN,0)                    ; 0-node in file 340.5
  1.  S DEBTOR=$P(N0,U,2)                          ; pointer to file 340
  1.  S ORPLNDT=$P(N0,U,3)                         ; Original Plan Date (Creation Date)
  1.  S NAME=$$NAM^RCFN01(DEBTOR) Q:NAME=""        ; debtor name
  1.  S MED=1 I DEBTOR>0,$P($P(^RCD(340,DEBTOR,0),U),";",2)'="DPT(" S MED=0  ; non-medical debt  PRCA*4.5*389
  1.  S SSN=$$SSN^RCFN01(DEBTOR)                   ; debtor SSN
  1.  S AMNT=$$CBAL^RCRPU3(RPIEN,+$P(N0,U,11))     ; amount owed
  1.  S DAYS=$$FMDIFF^XLFDT(DT,$P(N0,U,8))         ; days in status
  1.  S RMNOPY=$$REMPMNTS^RCRPU3(RPIEN,$P(N0,U,6)) ; remaining # payments
  1.  ; each entry is: debtor name ^ ssn ^ repayment plan ID ^ Original Plan Date ^ status (internal) ^ status date ^ days in status ^ last payment date ^ # of payments ^
  1.  ;                remaining balance ^ at CS? ^ # of forbearances ^ medical debt (1/0)
  1.  S TMPSTR=NAME_U_SSN_U_$P(N0,U)_U_ORPLNDT_U_$P(N0,U,7)_U_$P(N0,U,8)_U_DAYS
  1.  S TMPSTR=TMPSTR_U_$O(^RCRP(340.5,RPIEN,3,"B",""),-1) ; last payment date
  1.  S TMPSTR=TMPSTR_U_RMNOPY_U_AMNT_U_$P($G(^RCRP(340.5,RPIEN,1)),U,4)_U_$P(N0,U,9)_U_MED
  1.  ; add a new entry to ^TMP global
  1.  S ^TMP("RCRPSTR",$J,CNT)=TMPSTR
  1.  S Z=$S(SORT="N":NAME,SORT="S":$$EXTERNAL^DILFD(340.5,.07,,$P(N0,U,7)),1:AMNT) Q:Z=""
  1.  S ^TMP("RCRPSTR",$J,"IDX",Z,DAYS,CNT)=""
  1.  Q
  1.  ;
  1. PRINT ; print report
  1.  N ATCS,BAL,CNT,DATA,DAYS,EXTDT,LN,NAME,PAGE,SSN,STATUS,Z,Z1,QUIT
  1.  U IO
  1.  S PAGE=0
  1.  S EXTDT=$$FMTE^XLFDT(DT)
  1.  S QUIT=0
  1.  I EXCEL D
  1.  .W !,"Repayment Plan Status Report^",EXTDT,U,$$FLTRSTR(),U,$$SORTSTR()  ; PRCA*4.5*389
  1.  .W !,"Name^SSN^RPP ID^Orig Plan date^Status^Status date^Days in status^Last payment^Current plan length^Remaining balance^CS^Forbearances"  ; PRCA*4.5*389
  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("RCRPSTR",$J)) D  Q
  1.  .I EXCEL W !!,"No records found." Q
  1.  .W !!,$$CJ^XLFSTR("No records found.",132)
  1.  .Q
  1.  S Z="" F  S Z=$O(^TMP("RCRPSTR",$J,"IDX",Z)) Q:Z=""  D  Q:$G(QUIT)
  1.  .S DAYS="" F  S DAYS=$O(^TMP("RCRPSTR",$J,"IDX",Z,DAYS),-1) Q:DAYS=""  D  Q:$G(QUIT)
  1.  ..S CNT=0 F  S CNT=$O(^TMP("RCRPSTR",$J,"IDX",Z,DAYS,CNT)) Q:'CNT  D  Q:$G(QUIT)
  1.  ...S DATA=^TMP("RCRPSTR",$J,CNT),NAME=$S($P(DATA,U,13):"",1:"*")_$P(DATA,U)  ; PRCA*4.5*389
  1.  ...; convert status code
  1.  ...S Z1=$P(DATA,U,5),STATUS=$S(Z1=1:"NEW",Z1=2:"CURR",Z1=3:"LATE",Z1=4:"DELQ",Z1=5:"DEF",Z1=6:"TERM",Z1=7:"CLOS",Z1=8:"PAID",1:"")
  1.  ...; format remaining balance
  1.  ...S BAL=$FN($P(DATA,U,10),"",2)
  1.  ...; convert "at CS" value
  1.  ...S ATCS=$S($P(DATA,U,11):"Y",1:"N")
  1.  ...; format SSN to last 4 digits
  1.  ...S Z1=$P(DATA,U,2),SSN=$E(Z1,$L(Z1)-3,$L(Z1)) I SSN'>0 S SSN="N/A"
  1.  ...I EXCEL D  Q
  1.  ....W !,NAME,U,SSN,U,$P(DATA,U,3),U,$$FMTE^XLFDT($P(DATA,U,4),"2DZ"),U,STATUS,U,$$FMTE^XLFDT($P(DATA,U,6),"2DZ"),U,$P(DATA,U,7),U  ; PRCA*4.5*389
  1.  ....W $$FMTE^XLFDT($P(DATA,U,8),"2DZ"),U,$P(DATA,U,9),U,BAL,U,ATCS,U,$P(DATA,U,12)  ; 
  1.  ....Q
  1.  ...S LN=LN+1
  1.  ...W !,$E(NAME,1,30),?31,SSN,?37,$P(DATA,U,3),?57,$$FMTE^XLFDT($P(DATA,U,4),"2DZ"),?67,STATUS,?73,$$FMTE^XLFDT($P(DATA,U,6),"2DZ"),?83,$P(DATA,U,7),?92  ; PRCA*4.5*389
  1.  ...W $$FMTE^XLFDT($P(DATA,U,8),"2DZ"),?102,$P(DATA,U,9),?112,$$CJ^XLFSTR("$"_BAL,13),?123,ATCS,?127,$P(DATA,U,12)  ; PRCA*4.5*389
  1.  ...I LN>(IOSL-3) D HDR I $G(QUIT) Q
  1.  ...Q
  1.  ..Q
  1.  .Q
  1.  I PAGE>0,'$D(ZTQUEUED) D PAUSE^RCRPRPU W @IOF
  1.  Q
  1.  ;
  1. HDR ; print header
  1.  I PAGE>0,'$D(ZTQUEUED) D PAUSE^RCRPU W @IOF I $G(QUIT) Q
  1.  S PAGE=PAGE+1,LN=9  ; PRCA*4.5*389
  1.  W !,"Repayment Plan Status Report",?66,EXTDT,?120,"Page: ",PAGE
  1.  W !,$$FLTRSTR()
  1.  W !,$$SORTSTR()
  1.  W !!,"* Indicates a non-medical debt repayment plan"  ; PRCA*4.5*389
  1.  W !!,"                                                                                                                               For-"
  1.  W !,"                                                         Original        Status    Days in   Last     Cur plan  Remaining      bear-"
  1.  W !,"Name                           SSN        RPP ID         Plan Dt   Stat   date     status   payment    length    balance   CS  ances"
  1.  W ! D DASH^RCRPRPU(132)
  1.  Q
  1.  ;
  1. FLTRSTR() ; returns "Filtered by" string to print
  1.  N STR,Z
  1.  S STR="Filtered by: "
  1.  I $P(FILTER,U)="U" S STR=STR_"No filter"
  1.  I $P(FILTER,U)="N" S STR=STR_"Debtor name (from "_$P(FILTER,U,2)_" to "_$P(FILTER,U,3)_")"
  1.  I $P(FILTER,U)="S" D
  1.  .S STR=STR_"Status ("
  1.  .F Z=1:1:$L($P(FILTER,U,2),",") S STR=STR_$S(Z>1:", ",1:"")_$$EXTERNAL^DILFD(340.5,.07,,$P($P(FILTER,U,2),",",Z))  ; PRCA*4.5*378
  1.  .S STR=STR_"), "_$S(+$P(FILTER,U,4)>0:"from "_$P(FILTER,U,3)_" to "_$P(FILTER,U,4),1:"at least "_$P(FILTER,U,3))  ; PRCA*4.5*389
  1.  .S STR=STR_" days in status"  ; PRCA*4.5*389
  1.  .Q 
  1.  Q STR
  1.  ;
  1. SORTSTR() ; returns "Sorted by" string to print
  1.  N STR
  1.  S STR="Sorted by: "_$S(SORT="N":"Debtor name",SORT="S":"Status",1:"Account balance")
  1.  Q STR
  1.  ;
  1.  ; Select name range
  1. INTV() ; Selects the range of names
  1.  ; Output: First value ^ Last Value OR -1 
  1.  ;
  1.  N RCFRST,RCLAST,X
  1.  ;
  1.  S (RCFRST,RCLAST)=""
  1. FRST W !!?3,"START WITH NAME: FIRST// " R X:DTIME I '$T!(X["^") Q -1
  1.  I $E(X)="?" D HFST(1) G FRST
  1.  S RCFRST=X
  1. LAST W !?8,"GO TO NAME: LAST// " R X:DTIME I '$T!(X["^") Q -1
  1.  I $E(X)="?" D HFST(2) G LAST
  1.  I X="" S RCLAST="zzzzz" G QINT
  1.  I RCFRST]X D  G LAST
  1.  .W *7,!!?7,"The LAST value must follow the FIRST.",!
  1.  S RCLAST=X
  1.  ;
  1. QINT Q (RCFRST_"^"_RCLAST)
  1.  ;
  1. HFST(RCVAL) ; - 'START WITH PATIENT/DEBTOR...' prompt 
  1.  N RCPRMPT
  1.  S RCPRMPT="First" S:RCVAL=2 RCPRMPT="Last"
  1.  ;
  1.  W !!,"      Enter a valid field value, or"
  1.  W !,"        '<CR>' -  To start from the '"_RCPRMPT_"' value for this field"
  1.  W !,"        '^'    -  To quit this option"
  1.  Q