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

RCRPINQ.m

Go to the documentation of this file.
  1. RCRPINQ ;EDE/YMG - REPAYMENT PLAN INQUIRY; 12/10/2020
  1. ;;4.5;Accounts Receivable;**377,381,388,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 RPIEN
  1. F S RPIEN=$$SELRPP^RCRPU1() D:RPIEN>0 EN1(RPIEN) Q:RPIEN<0 ; PRCA*4.5*389
  1. Q
  1. ;
  1. EN1(RPIEN) ; entry point from repayment plan worklist, skips RPP selection PRCA*4.5*389
  1. ;
  1. ; RPIEN - file 340.5 ien
  1. ;
  1. N POP,ZTDESC,ZTRTN,ZTSAVE,ZTSK,%ZIS
  1. N IOBOFF,IOBON,IORVON,IORVOFF,X
  1. I "^6^7^8^"[(U_$P($G(^RCRP(340.5,RPIEN,0)),U,7)_U) D
  1. .S X="IOBON;IORVON;IOBOFF;IORVOFF" D ENDR^%ZISS
  1. .W !!,IOBON,IORVON,$$CJ^XLFSTR("*** WARNING: YOU HAVE SELECTED A CLOSED REPAYMENT PLAN ***",80),IORVOFF,IOBOFF,!!
  1. .Q
  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 output
  1. .S ZTDESC="Repayment Plan Inquiry",ZTRTN="PRINT^RCRPINQ"
  1. .S ZTSAVE("RPIEN")="",ZTSAVE("ZTREQ")="@"
  1. .D ^%ZTLOAD,HOME^%ZIS
  1. .I $G(ZTSK) W !!,"Inquiry output has started with task# ",ZTSK,".",! D PAUSE^RCRPRPU
  1. .Q
  1. D PRINT
  1. Q
  1. ;
  1. PRINT ; display repayment plan data
  1. ;
  1. ; RPIEN - ien in file 340.5
  1. ;
  1. N LN
  1. S LN=0
  1. S LN=$$PRTHDR(RPIEN,LN) Q:'LN ; print header
  1. S LN=$$PRTBILLS(RPIEN,LN) Q:'LN ; print the list of bills in the plan
  1. S LN=$$PRTSCHED(RPIEN,LN) Q:'LN ; print the payment schedule
  1. S LN=$$PRTFORB(RPIEN,LN) Q:'LN ; print forbearances
  1. S LN=$$PRTPMTS(RPIEN,LN) Q:'LN ; print payments
  1. S LN=$$PRTAUDT(RPIEN,LN) Q:'LN ; print audit log
  1. ;
  1. S LN=$$WRTLN("",LN) Q:'LN
  1. S LN=$$WRTLN($$CJ^XLFSTR("End of Inquiry",80),LN) Q:'LN
  1. I $E(IOST,1,2)["C-",'$D(ZTQUEUED) W ! D PAUSE^RCRPRPU
  1. Q
  1. ;
  1. GETDOB(DEBTOR) ; get date of birth
  1. ;
  1. ; DEBTOR - file 340 ien
  1. ;
  1. ; returns DOB (external format) from either file 2 or file 200, or "" if DOB can't be found
  1. ;
  1. N DFN,RES,VADM,Z,Z1,Z2
  1. S RES=""
  1. I $G(DEBTOR)'>0 Q RES
  1. S Z=$P($G(^RCD(340,DEBTOR,0)),U),Z1=$P(Z,";"),Z2=$P(Z,";",2)
  1. I Z2["DPT" S DFN=Z1 D DEM^VADPT S RES=$P(VADM(3),U,2)
  1. I Z2["VA(200" S RES=$$GET1^DIQ(200,Z1_",",5)
  1. Q RES
  1. ;
  1. FMTPHONE(PHONE) ; format phone number for display
  1. ;
  1. ; PHONE - phone # to format (numeric)
  1. ;
  1. ; returns formatted phone #
  1. ;
  1. N RES
  1. S RES=PHONE
  1. I $L(PHONE)=7 S RES=$E(PHONE,1,3)_"-"_$E(PHONE,4,7)
  1. I $L(PHONE)=10 S RES="("_$E(PHONE,1,3)_")"_$E(PHONE,4,6)_"-"_$E(PHONE,7,10)
  1. I $L(PHONE)=11 S RES=$E(PHONE)_"-"_"("_$E(PHONE,1,3)_")"_$E(PHONE,4,6)_"-"_$E(PHONE,7,10)
  1. Q RES
  1. ;
  1. WRTLN(STR,LN) ; write line
  1. ;
  1. ; STR - line to write
  1. ; LN - current line #
  1. ;
  1. ; returns next line # or 0 for user exit
  1. ;
  1. W !,STR S LN=LN+1
  1. I $E(IOST,1,2)["C-",'$D(ZTQUEUED),LN>(IOSL-3) S LN=$$NEWPG()
  1. Q LN
  1. ;
  1. NEWPG() ; print new page
  1. ;
  1. ; returns next line # or 0 for user exit
  1. ;
  1. I '$$ASKCONT^RCRPU2() Q 0
  1. W @IOF
  1. Q 1
  1. ;
  1. PRTHDR(RPIEN,LN) ; display header
  1. ;
  1. ; RPIEN is defined in tag EN
  1. ;
  1. ; returns next line # or 0 for user exit
  1. ;
  1. N ADDRSTR,CBAL,DEBDOB,DEBPHN,DEBSSN,DEBTOR,N0,RAMNT
  1. S N0=$G(^RCRP(340.5,RPIEN,0)) ; 0-node in file 340.5
  1. S DEBTOR=$P(N0,U,2)
  1. S ADDRSTR=$$DADD^RCAMADD(DEBTOR,1) ; ADDRSTR = Str1^Str2^Str3^City^State^ZIP^Telephone^Forein Country Code
  1. U IO
  1. I $E(IOST,1,2)["C-" W @IOF
  1. S DEBSSN=$$SSN^RCFN01(DEBTOR),DEBDOB=$$GETDOB^RCRPINQ(DEBTOR),DEBPHN=+$P(ADDRSTR,U,7)
  1. W !!,"Debtor: ",$$NAM^RCFN01(DEBTOR)
  1. W ?40,"SSN/TIN: ",$S(DEBSSN>0:$E(DEBSSN,1,3)_"-"_$E(DEBSSN,4,5)_"-"_$E(DEBSSN,6,9),1:"N/A")
  1. W ?64,"DOB: ",$S(DEBDOB="":"N/A",1:DEBDOB)
  1. W !,"Address: ",$P(ADDRSTR,U)," ",$P(ADDRSTR,U,2)," ",$P(ADDRSTR,U,3),", ",$P(ADDRSTR,U,4),", ",$P(ADDRSTR,U,5)," ",$P(ADDRSTR,U,6)
  1. W !,"Phone: ",$S(DEBPHN>0:$$FMTPHONE^RCRPINQ(DEBPHN),1:"N/A"),!
  1. W !,"Plan #: ",$P(N0,U),?28,"Status: ",$$EXTERNAL^DILFD(340.5,.07,"",$P(N0,U,7)),?49,"Last status date: ",$$FMTE^XLFDT($P(N0,U,8),"5DZ"),!
  1. S CBAL=$$CBAL^RCRPU3(RPIEN,$P(N0,U,11)),RAMNT=$P(N0,U,6)
  1. W !,?2,"Current balance: $",$FN(CBAL,"",2),?37,"Number of payments remaining: ",$$REMPMNTS^RCRPU3(RPIEN,RAMNT)
  1. W !,?1,"Orig amount owed: $",$FN($P(N0,U,13),"",2),?38,"Original number of payments: ",$P(N0,U,14)
  1. W !,"Total amount owed: $",$FN($P(N0,U,11),"",2),?41,"Total number of payments: ",$P(N0,U,5)
  1. W !,?1,"Repayment amount: $",$FN(RAMNT,"",2),?47,"Auto-add New Bills: ",$$GET1^DIQ(340.5,RPIEN_",",.12,"E"),!
  1. W !,?8,"Plan date: ",$$FMTE^XLFDT($P(N0,U,3),"5DZ"),?43,"First Payment Due Date: ",$$FMTE^XLFDT($P(N0,U,4),"5DZ"),!
  1. ;
  1. S LN=14
  1. Q LN
  1. ;
  1. PRTSCHED(RPIEN,LN) ; Print the schedule
  1. ;
  1. ; LN - current line #
  1. ;
  1. ; RPIEN is defined in tag EN
  1. ;
  1. ; returns next line # or 0 for user exit
  1. ;
  1. N CNT,TMP,TMPDT,TMPIEN
  1. S LN=$$WRTLN($$CJ^XLFSTR("Plan Schedule",80),LN) Q:'LN 0
  1. S LN=$$WRTLN($$LJ^XLFSTR("",80,"-"),LN) Q:'LN 0
  1. S LN=$$WRTLN(" Due Date Paid? Due Date Paid? Due Date Paid?",LN) Q:'LN 0
  1. S LN=$$WRTLN($$LJ^XLFSTR("",80,"-"),LN) Q:'LN 0
  1. S CNT=0,TMPDT=0 F S TMPDT=$O(^RCRP(340.5,RPIEN,2,"B",TMPDT)) Q:'TMPDT D Q:'LN
  1. .S TMPIEN="" F S TMPIEN=+$O(^RCRP(340.5,RPIEN,2,"B",TMPDT,TMPIEN)) Q:'TMPIEN D Q:'LN
  1. ..S TMP=$G(^RCRP(340.5,RPIEN,2,TMPIEN,0)) Q:TMP=""
  1. ..I CNT#3=0 S LN=$$WRTLN("",LN) Q:'LN
  1. ..W:CNT#3=0 ?2 W:CNT#3=1 ?22 W:CNT#3=2 ?42 W $$FMTE^XLFDT($P(TMP,U),"5DZ")
  1. ..W:CNT#3=0 ?17 W:CNT#3=1 ?37 W:CNT#3=2 ?57 W $S($P(TMP,U,3):"F",$P(TMP,U,2):"Y",1:"N")
  1. ..S CNT=CNT+1
  1. ..Q
  1. .Q
  1. Q:'LN 0
  1. I $E(IOST,1,2)["C-",'$D(ZTQUEUED) D Q:'LN 0
  1. .I LN>(IOSL-6) S LN=$$NEWPG() Q
  1. .S LN=$$WRTLN("",LN)
  1. .Q
  1. Q LN
  1. ;
  1. PRTFORB(RPIEN,LN) ; Print the forbearances previously granted
  1. ;
  1. ; LN - current line #
  1. ;
  1. ; RPIEN is defined in tag EN
  1. ;
  1. ; returns next line # or 0 for user exit
  1. ;
  1. N TMP,TMPDT,TMPIEN,RCUSER
  1. S LN=$$WRTLN($$CJ^XLFSTR("Forbearances",80),LN) Q:'LN 0
  1. S LN=$$WRTLN($$LJ^XLFSTR("",80,"-"),LN) Q:'LN 0
  1. S LN=$$WRTLN(" Date User Month/Year Forborne Month/Year Added",LN) Q:'LN 0
  1. S LN=$$WRTLN($$LJ^XLFSTR("",80,"-"),LN) Q:'LN 0
  1. S TMPDT=0 F S TMPDT=$O(^RCRP(340.5,RPIEN,5,"B",TMPDT)) Q:'TMPDT D Q:'LN
  1. .S TMPIEN="" F S TMPIEN=+$O(^RCRP(340.5,RPIEN,5,"B",TMPDT,TMPIEN)) Q:'TMPIEN D Q:'LN
  1. ..S TMP=$G(^RCRP(340.5,RPIEN,5,TMPIEN,0)) Q:TMP=""
  1. ..S RCUSER=$$GET1^DIQ(340.55,TMPIEN_","_RPIEN_",","3","E")
  1. ..S LN=$$WRTLN($$LJ^XLFSTR($$FMTE^XLFDT($P(TMP,U),"5DZ"),13)_$$LJ^XLFSTR($E(RCUSER,1,20),22)_$$LJ^XLFSTR($$FMTE^XLFDT($P(TMP,U,2),"1DZ"),29)_$$FMTE^XLFDT($P(TMP,U,3),"1DZ"),LN)
  1. ..Q
  1. .Q
  1. Q:'LN 0
  1. I $E(IOST,1,2)["C-",'$D(ZTQUEUED) D Q:'LN 0
  1. .I LN>(IOSL-6) S LN=$$NEWPG() Q
  1. .S LN=$$WRTLN("",LN)
  1. .Q
  1. Q LN
  1. ;
  1. PRTBILLS(RPIEN,LN) ; print list of bills
  1. ;
  1. ; LN - current line #
  1. ;
  1. ; returns next line # or 0 for user exit
  1. S:+$G(LN)=0 LN=1
  1. ;
  1. N BILL,BSTAT,BCAT,BAMNT
  1. S LN=$$WRTLN($$CJ^XLFSTR("List of Bills in Plan",80),LN) Q:'LN 0
  1. S LN=$$WRTLN($$LJ^XLFSTR("",80,"-"),LN) Q:'LN 0
  1. S LN=$$WRTLN("Bill No. Bill Status Category Current Balance",LN) Q:'LN 0
  1. S LN=$$WRTLN($$LJ^XLFSTR("",80,"-"),LN) Q:'LN 0
  1. S LN=$$WRTLN("",LN) Q:'LN 0
  1. ;
  1. S BILL=0 F S BILL=$O(^RCRP(340.5,RPIEN,6,"B",BILL)) Q:'BILL D Q:'LN
  1. .S BSTAT=$$GET1^DIQ(430,BILL_",",8)
  1. .S BCAT=$$GET1^DIQ(430,BILL_",",2)
  1. .S BAMNT=$S(BSTAT="ACTIVE":"$"_$FN($$BALANCE^RCRPRPU(BILL),"",2),1:"")
  1. .S LN=$$WRTLN($$LJ^XLFSTR($P(^PRCA(430,BILL,0),U),23)_$$LJ^XLFSTR($E(BSTAT,1,16),18)_$$LJ^XLFSTR($E(BCAT,1,14),22)_BAMNT,LN)
  1. .Q
  1. Q:'LN 0
  1. I $E(IOST,1,2)["C-",'$D(ZTQUEUED) D Q:'LN 0
  1. .I LN>(IOSL-6) S LN=$$NEWPG() Q
  1. .S LN=$$WRTLN("",LN)
  1. .Q
  1. Q LN
  1. ;
  1. PRTPMTS(RPIEN,LN) ; print payments
  1. ;
  1. ; LN - current line #
  1. ;
  1. ; RPIEN is defined in tag EN
  1. ;
  1. ; returns next line # or 0 for user exit
  1. ;
  1. N CNT,TMP,TMPDT,TMPIEN
  1. S LN=$$WRTLN($$CJ^XLFSTR("Payments Applied to Plan",80),LN) Q:'LN 0
  1. S LN=$$WRTLN($$LJ^XLFSTR("",80,"-"),LN) Q:'LN 0
  1. S LN=$$WRTLN(" Date Amount Date Amount",LN) Q:'LN 0
  1. S LN=$$WRTLN($$LJ^XLFSTR("",80,"-"),LN) Q:'LN 0
  1. S CNT=0,TMPDT=0 F S TMPDT=$O(^RCRP(340.5,RPIEN,3,"B",TMPDT)) Q:'TMPDT D Q:'LN
  1. .S TMPIEN="" F S TMPIEN=+$O(^RCRP(340.5,RPIEN,3,"B",TMPDT,TMPIEN)) Q:'TMPIEN D Q:'LN
  1. ..S TMP=$G(^RCRP(340.5,RPIEN,3,TMPIEN,0)) Q:TMP=""
  1. ..I CNT#2=0 S LN=$$WRTLN("",LN) Q:'LN
  1. ..W:CNT#2=1 ?32 W $$FMTE^XLFDT($P(TMP,U),"5DZ")
  1. ..W:CNT#2=0 ?14 W:CNT#2=1 ?46 W $$CJ^XLFSTR("$"_$FN($P(TMP,U,2),"",2),10)
  1. ..S CNT=CNT+1
  1. ..Q
  1. .Q
  1. Q:'LN 0
  1. I $E(IOST,1,2)["C-",'$D(ZTQUEUED) D Q:'LN 0
  1. .I LN>(IOSL-6) S LN=$$NEWPG() Q
  1. .S LN=$$WRTLN("",LN)
  1. .Q
  1. Q LN
  1. ;
  1. PRTAUDT(RPIEN,LN) ; print audit log
  1. ;
  1. ; LN - current line #
  1. ;
  1. ; RPIEN is defined in tag EN
  1. ;
  1. ; returns next line # or 0 for user exit
  1. ;
  1. N TMP,TMPDT,TMPIEN,RCRSN,RCRSNCD,RCRSNTX
  1. S LN=$$WRTLN($$CJ^XLFSTR("Audit Log",80),LN) Q:'LN 0
  1. S LN=$$WRTLN($$LJ^XLFSTR("",80,"-"),LN) Q:'LN 0
  1. S LN=$$WRTLN(" Date User Type Comment",LN) Q:'LN 0
  1. S LN=$$WRTLN($$LJ^XLFSTR("",80,"-"),LN) Q:'LN 0
  1. S TMPDT=0 F S TMPDT=$O(^RCRP(340.5,RPIEN,4,"B",TMPDT)) Q:'TMPDT D Q:'LN
  1. .S TMPIEN="" F S TMPIEN=+$O(^RCRP(340.5,RPIEN,4,"B",TMPDT,TMPIEN)) Q:'TMPIEN D Q:'LN
  1. ..S TMP=$G(^RCRP(340.5,RPIEN,4,TMPIEN,0)) Q:TMP=""
  1. ..S RCRSNCD=$P(TMP,U,6),RCRSNTX=$P(TMP,U,5) ; PRCA*4.5*389
  1. ..S RCRSN="N/A" S:RCRSNCD>0 RCRSN=$P(^RCRP(340.501,RCRSNCD,0),U,2) ; PRCA*4.5*389
  1. ..I RCRSNCD'>0,RCRSNTX'="" S RCRSN=RCRSNTX ; PRCA*4.5*389
  1. ..S LN=$$WRTLN($$LJ^XLFSTR($$FMTE^XLFDT($P(TMP,U),"5DZ"),12)_$$LJ^XLFSTR($E($$EXTERNAL^DILFD(340.54,2,"",$P(TMP,U,3)),1,30),28)_$$LJ^XLFSTR($$EXTERNAL^DILFD(340.54,1,"",$P(TMP,U,2)),13)_RCRSN,LN)
  1. ..Q
  1. .Q
  1. I $E(IOST,1,2)["C-",'$D(ZTQUEUED),LN>(IOSL-3) S LN=$$NEWPG()
  1. Q LN