A test program to create an amortization schedule in RPG.
Created
January 21, 2014 22:25
-
-
Save MikeWills/8549738 to your computer and use it in GitHub Desktop.
A test program to create an amortization schedule in RPG.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| 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 | |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| 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