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