- 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 Jan 18, 2025@02:49:37 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