Skip to content

Instantly share code, notes, and snippets.

@MikeWills

MikeWills/AMORT.RPGLE

Created January 21, 2014 22:25
Show Gist options
  • Save MikeWills/8549738 to your computer and use it in GitHub Desktop.
Save MikeWills/8549738 to your computer and use it in GitHub Desktop.
Download ZIP
A test program to create an amortization schedule in RPG.
Raw
README.markdown

A test program to create an amortization schedule in RPG.

Raw
AMORT.RPGLE
H ActGrp(*caller) BndDir('MODULES') DftActGrp(*no)
//*************************************************************************
// Program . . . . . AMORT
//
// Created on . . .
// by . . .
//
// Description . . .
//
// CHANGE LOG:
// Date | Name | Description
// -----------------------------------------------------------------------
// | |
// | |
// | |
//*************************************************************************
// Printer/Display Files
FAMORTDF CF E WORKSTN sfile(SFL01:rrn01)
//*************************************************************************
// Named Constants
D
/copy modules/qcopysrc,statuscopy
// Named Indicators
D indicatorPtr S * Inz(%Addr(*IN))
D DS Based(IndicatorPtr)
/copy modules/qcopysrc,scrncopy
// Subfile Fields
D rrn01 S 4P 0 inz(0)
//*************************************************************************
// Misc Fields
D m S 12P 2 Monthly Payment
D p S 12P 2 Principal
D i S 5P 3 Interest
D l S 3P 0 Length (in Years)
D j S 10P10 Monthly Interest
D n S 5P 0 # of Months
D h S 12P 2 Current Monthly Int.
D c S 12P 2 Current Principal
D q S 12P 2 New Balance
//*************************************************************************
// External Program Procedures
// Internal Subprocedures
D Init PR
D Main PR
D SubfileFilled PR N
D ClearScreen PR
D IsValidData PR N
D LoanPayment PR 12P 2
D principal 12P 2
D interest 5P 3
D loanPeriod 3P 0
D paymentsYear 3P 0
// External Subprocedures
///copy modules/qsrvsrc,p.string
//*************************************************************************
// Entry Parms
D AMORT PR extpgm('AMORT')
D AMORT PI
//*************************************************************************
/free
Init();
Main();
*inlr = *on;
/end-free
P*--------------------------------------------------
P* Procedure name: Init
P* Purpose:
P* Returns:
P*--------------------------------------------------
P Init B
D Init PI
/free
pgm = 'AMORT';
sflDsp = *off;
return;
/end-free
P Init E
P*--------------------------------------------------
P* Procedure name: Main
P* Purpose:
P* Returns:
P*--------------------------------------------------
P Main B
D Main PI
/free
dow (not F3) and (not F12);
write OVR01;
exfmt CTL01;
ClearScreen();
if (IsValidData()) and (not F3) and (not F12);
// Fill the header information
dPayment = LoanPayment(dLoanAmt:dIntRate:dLoanPrd:dPayYear);
dNumPaymnt = dLoanPrd * dPayYear;
m = dPayment + dExtraPay;
p = dLoanAmt;
q = p;
// Fill the table
if (SubfileFilled());
sflDsp = *on;
endif;
endif;
enddo;
return;
/end-free
P Main E
P*--------------------------------------------------
P* Procedure name: SubfileFilled
P* Purpose: Fill the subfile
P* Returns:
P*--------------------------------------------------
P SubfileFilled B
D SubfileFilled PI N
D isFilled S N
D x S 4P 0
D intCume S 12P 2
D extraPayCume S 12P 2
D payDate S D
D payment S 12P 2
D extraPayment S 12P 2
/free
isFilled = *on;
sflClear = *on;
write CTL01;
sflClear = *off;
rrn01 = 0;
x = 0;
// Setup the work fields
payment = dPayment;
extraPayment = dExtraPay;
payDate = dStartDate;
// Create records until there is a zero balance
dow (q > 0);
x += 1;
eval(h) h = p * j; // Monthly Interest
// Adjust for final payment
if (p < m);
m = p + h;
payment = p;
extraPayment = h;
endif;
// Calulate Principal
c = m - h;
// Calulate the new balance
q = p - c;
// Accumulate the interest and extra payments
intCume += h;
extraPayCume += extraPayment;
// Determine the next pay date
select;
when dTerms = '1'; //Yearly
payDate += %years(1);
when dTerms = '2'; //Semi-Annual
payDate += %months(6);
when dTerms = '3'; //Quarterly
payDate += %months(3);
when dTerms = '4'; //Monthly
payDate += %months(1);
when dTerms = '5'; //Bi-Weekly
payDate += %days(14);
endsl;
// Fill the subfile
sPayNum = x;
sPayDate = payDate;
sBegBal = p;
sSchedPay = payment;
sExtraPay = extraPayment;
sTotPay = m;
sInterest = h;
sPrincipal = c;
sEndBal = q;
sCumeInt = intCume;
// Move the End balance to the beginning balance
p = q;
rrn01 += 1;
write SFL01;
enddo;
// Return the calculated information to the header
dActPaymnt = x;
dTotInt = intCume;
dTotEPay = extraPayCume;
if (rrn01 < 1);
isFilled = *off;
endif;
return isFilled;
/end-free
P SubfileFilled E
P*--------------------------------------------------
P* Procedure name: ClearScreen
P* Purpose:
P* Returns:
P*--------------------------------------------------
P ClearScreen B
D ClearScreen PI
/free
c = 0;
h = 0;
i = 0;
j = 0;
l = 0;
m = 0;
n = 0;
p = 0;
q = 0;
dPayment = 0;
dNumPaymnt = 0;
dActPaymnt = 0;
dTotEPay = 0;
dTotInt = 0;
return;
/end-free
P ClearScreen E
P*--------------------------------------------------
P* Procedure name: IsValidData
P* Purpose: Validate the data on the screen
P* Returns: True or False
P*--------------------------------------------------
P IsValidData B
D IsValidData PI N
D isValid S N
/free
if (dLoanAmt <> 0) and (dIntRate <> 0) and (dLoanPrd <> 0) and
(dPayYear <> 0) and (dStartDate <> %date('0001-01-01'));
isValid = *on;
else;
isValid = *off;
endif;
return isValid;
/end-free
P IsValidData E
P*--------------------------------------------------
P* Procedure name: LoanPayment
P* Purpose: Calculates the payment
P* Returns:
P*--------------------------------------------------
P LoanPayment B
D LoanPayment PI 12P 2
D principal 12P 2
D interest 5P 3
D loanPeriod 3P 0
D paymentsYear 3P 0
D retMonthlyPayment...
D S 12P 2
/free
eval(h) n = loanPeriod * paymentsYear;
eval(h) j = interest / (paymentsYear * 100);
eval(h) m = principal * (j / (1 - (1 + j) ** -n));
return m;
/end-free
P LoanPayment E
P*--------------------------------------------------
P* Procedure name: Template
P* Purpose:
P* Returns:
P*--------------------------------------------------
P*Template B
D*Template PI
*
*/free
*
*
*
* return;
*
*/end-free
P*Template E
Raw
AMORTDF.DSPF
A*%%TS DD 20081215 141615 ispa2 REL-V5.0.1 WDSc
A**************************************************************************
A* * Compiler Options:
A* COMPILE OPTIONS HERE
A*
A* File . . . . . . TEMPLATEP
A*
A* Created on . . .
A* by . . .
A*
A* Description . . .
A*
A* CHANGE LOG:
A* Date | Name | Description
A* ------------------------------------------------------------------------
A* | |
A* | |
A* | |
A**************************************************************************
A*%%FD Subfile Display File Template
A*%%EC
A DSPSIZ(27 132 *DS4)
A CA03(03 'Exit')
A CA12(12 'Cancel')
A PRINT
A R OVR01
A*%%TS DD 20081212 150713 ispa2 REL-V5.0.1 WDSc
A OVERLAY
A 26 2'F3=Exit'
A COLOR(BLU)
A*%%GP SCREEN1 03
A R SFL01
A*%%TS DD 20081212 154153 ispa2 REL-V5.0.1 WDSc
A SFL
A SPAYNUM 4Y 0O 13 2EDTCDE(3)
A SPAYDATE L O 13 7DATFMT(*USA)
A SBEGBAL 10Y 2O 13 19EDTCDE(1)
A SSCHEDPAY 10Y 2O 13 33EDTCDE(1)
A SEXTRAPAY 10Y 2O 13 47EDTCDE(1)
A STOTPAY 10Y 2O 13 61EDTCDE(1)
A SPRINCIPAL 10Y 2O 13 75EDTCDE(1)
A SINTEREST 10Y 2O 13 89EDTCDE(1)
A SENDBAL 10Y 2O 13103EDTCDE(1)
A SCUMEINT 10Y 2O 13117EDTCDE(1)
A*%%GP SCREEN1 01
A R CTL01
A*%%TS DD 20081215 141615 ispa2 REL-V5.0.1 WDSc
A SFLCTL(SFL01)
A SFLDSPCTL
A 30 SFLDSP
A SFLPAG(12)
A SFLSIZ(13)
A 30 SFLEND(*MORE)
A 31 SFLCLR
A OVERLAY
A PGM 10 O 1 2
A 1 54'Loan Amortization Schedule'
A DSPATR(HI)
A 1124DATE
A EDTCDE(Y)
A 2124TIME
A 3 3'----------- Enter Values ----------
A --'
A COLOR(PNK)
A 3 61'--------------- Loan Summary ------
A ----------'
A COLOR(PNK)
A 4 15'Loan Amount:'
A COLOR(WHT)
A DLOANAMT 12Y 2B 4 28EDTCDE(4)
A CHECK(RB)
A 4 72'Scheduled Payment:'
A COLOR(WHT)
A DPAYMENT 10Y 2O 4 91EDTCDE(2 $)
A 5 6'Annual Interest Rate:'
A COLOR(WHT)
A DINTRATE 5Y 3B 5 28EDTCDE(4)
A CHECK(RB)
A 5 35'%'
A 5 61'Scheduled Number of Payments:'
A COLOR(WHT)
A DNUMPAYMNT 4Y 0O 5101EDTCDE(4)
A 6 6'Loan Period in Years:'
A COLOR(WHT)
A DLOANPRD 3Y 0B 6 28EDTCDE(4)
A CHECK(RB)
A 6 64'Actual Number of Payments:'
A COLOR(WHT)
A DACTPAYMNT 4Y 0O 6101EDTCDE(4)
A 7 4'# of Payments Per Year:'
A COLOR(WHT)
A DPAYYEAR 3Y 0B 7 28EDTCDE(4)
A CHECK(RB)
A DTERMS 1 B 7 34
A 7 36'(1Y/2SY/3Q/4M/5BW)'
A COLOR(WHT)
A 7 69'Total Early Payments:'
A COLOR(WHT)
A DTOTEPAY 10Y 2O 7 91EDTCDE(2 $)
A 8 8'Start Date of Loan:'
A COLOR(WHT)
A DSTARTDATE L B 8 28DATFMT(*USA)
A 8 75'Total Interest:'
A COLOR(WHT)
A DTOTINT 10Y 2O 8 91EDTCDE(2 $)
A 9 3'Optional Extra Payments:'
A COLOR(WHT)
A DEXTRAPAY 10Y 2B 9 28EDTCDE(4)
A CHECK(RB)
A 11 2'--- Payment ---'
A COLOR(WHT)
A 11 20'Beginning'
A COLOR(WHT)
A 11 34'Scheduled'
A COLOR(WHT)
A 11 52'Extra'
A COLOR(WHT)
A 11 66'Total'
A COLOR(WHT)
A 11107'Ending'
A COLOR(WHT)
A 11117'Cululative'
A COLOR(WHT)
A 12 3'#'
A COLOR(WHT)
A 12 10'Date'
A COLOR(WHT)
A 12 22'Balance'
A COLOR(WHT)
A 12 36'Payment'
A COLOR(WHT)
A 12 50'Payment'
A COLOR(WHT)
A 12 64'Payment'
A COLOR(WHT)
A 12 76'Principal'
A COLOR(WHT)
A 12 91'Interest'
A COLOR(WHT)
A 12106'Balance'
A COLOR(WHT)
A 12119'Interest'
A COLOR(WHT)
A*%%GP SCREEN1 02
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment