Quellcode-Bibliothek

^© Kompilation durch diese Firma

[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]

Datei: loan.cob Sprache: Cobol

Original von: verschiedene^©

       IDENTIFICATION DIVISION.
      *
       PROGRAM-ID.    LOANT.
      *
       DATE-WRITTEN.  04/16/84.
      *
      *    MODIFIED   10/18/97.
      *
      *        *******************************
      *        *                             *
      *        *     Judson D. McClendon     *
      *        *     Sun Valley Systems      *
      *        *     329 37th Court N.E.     *
      *        *     Birmingham, AL 35215    *
      *        *        205-853-8440         *
      *        *                             *
      *        *******************************
      *
       ENVIRONMENT DIVISION.
      *
       CONFIGURATION SECTION.
      *
       INPUT-OUTPUT SECTION.
      *
       FILE-CONTROL.
      *
       I-O-CONTROL.
      *
       DATA DIVISION.
      *
       FILE SECTION.
      *
       WORKING-STORAGE SECTION.
      *
      *                     ALPHA 77'S
      *
       77  WS-ANSWER                   PIC  X(01) VALUE SPACE.
       77  WS-COMMAND                  PIC  X(01) VALUE SPACE.
       77  WS-ERR-MSG                  PIC  X(40) VALUE SPACES.
      *
      *                    NUMERIC 77'S
      *
       77  WS-ESCAPE-FLAG              PIC  9(01)       VALUE ZERO.
      *
      ******************************************************************
      *                                                                *
      *                  L O A N   W O R K   A R E A                   *
      *                                                                *
      ******************************************************************
      *
       01  LOAN-WORK-AREA.
           03  LW-LOAN-ERROR-FLAG      PIC  9(01)       COMP.
           03  LW-LOAN-AMT             PIC  9(06)V9(02) COMP.
           03  LW-INT-RATE             PIC  9(02)V9(02) COMP.
           03  LW-NBR-PMTS             PIC  9(03)       COMP.
           03  LW-PMT-AMT              PIC  9(06)V9(02) COMP.
           03  LW-INT-PMT              PIC  9(01)V9(12) COMP.
           03  LW-TOTAL-PMTS           PIC  9(06)V9(02) COMP.
           03  LW-TOTAL-INT            PIC  9(06)V9(02) COMP.
      *
       SCREEN SECTION.
      *
      *
      *             C O M M A N D   S C R E E N
      *
       01  COMMAND-SCREEN.
           03  BLANK SCREEN.
           03  LINE 01  COLUMN 20  VALUE
               "L O A N C O M P U T A T I O N".
           03  LINE 03  COLUMN 01  VALUE
               "Press: P=Compute Payment Amount,".
           03  LINE 04  COLUMN 08  VALUE
               "L=Compute Loan Amount,".
           03  LINE 05  COLUMN 05  VALUE
               "or ESCape to exit: ".
           03  PIC  X              TO WS-COMMAND  AUTO.
      *
      *
      *                L O A N   S C R E E N
      *
       01  LOAN-SCREEN.
           03  LINE 03  COLUMN 01  ERASE EOS.
           03  LINE 03  COLUMN 01  VALUE "Payment Amt: ".
           03  PIC  ZZZZZ9.99      USING LW-PMT-AMT.
           03  LINE 04  COLUMN 01  VALUE "Interest Rate: ".
           03  PIC  Z9.99          USING LW-INT-RATE.
           03  LINE 05  COLUMN 01  VALUE "Number Payments: ".
           03  PIC  ZZ9            USING LW-NBR-PMTS.
      *
      *
      *            L O A N   A N S W E R   S C R E E N
      *
       01  LOAN-ANSWER-SCREEN.
           03  LINE 07  COLUMN 01  VALUE "Loan Amount: ".
           03  PIC  ZZZ,ZZ9.99     FROM LW-LOAN-AMT.
           03  LINE 08  COLUMN 01  VALUE "Total Inter: ".
           03  PIC  ZZZ,ZZ9.99     FROM LW-TOTAL-INT.
           03  LINE 09  COLUMN 01  VALUE "Total Pmts: ".
           03  PIC  ZZZ,ZZ9.99     FROM LW-TOTAL-PMTS.
      *
      *
      *             P A Y M E N T   S C R E E N
      *
       01  PAYMENT-SCREEN.
           03  LINE 03  COLUMN 01  ERASE EOS.
           03  LINE 03  COLUMN 01  VALUE "Loan Amount: ".
           03  PIC  ZZZZZ9.99      USING LW-LOAN-AMT.
           03  LINE 04  COLUMN 01  VALUE "Interest Rate: ".
           03  PIC  Z9.99          USING LW-INT-RATE.
           03  LINE 05  COLUMN 01  VALUE "Number Payments: ".
           03  PIC  ZZ9            USING LW-NBR-PMTS.
      *
      *
      *        P A Y M E N T   A N S W E R   S C R E E N
      *
       01  PAYMENT-ANSWER-SCREEN.
           03  LINE 07  COLUMN 01  VALUE "Payment Amt: ".
           03  PIC  ZZZ,ZZ9.99     FROM LW-PMT-AMT.
           03  LINE 08  COLUMN 01  VALUE "Total Inter: ".
           03  PIC  ZZZ,ZZ9.99     FROM LW-TOTAL-INT.
           03  LINE 09  COLUMN 01  VALUE "Total Pmts: ".
           03  PIC  ZZZ,ZZ9.99     FROM LW-TOTAL-PMTS.
      *
      *
      *            E R R O R   S C R E E N
      *
       01  ERROR-SCREEN.
           03  LINE 24  COLUMN 20  HIGHLIGHT  BLANK LINE
               PIC  X(40)          FROM WS-ERR-MSG.
           03           COLUMN 70
               PIC  X              TO WS-ANSWER  AUTO.
      /
       PROCEDURE DIVISION.
      *
      *
      *                        C O N T R O L
      *
       000000-CONTROL.
      *
           INITIALIZE LOAN-WORK-AREA.
           IF (LW-LOAN-AMT ZERO)
               OR
              (LW-INT-RATE ZERO)
               OR
              (LW-NBR-PMTS ZERO)
               MOVE 1 TO LW-LOAN-ERROR-FLAG
               GO TO 004000-EXIT.
      *
           DISPLAY COMMAND-SCREEN.
      *
           PERFORM 000100-GET-COMMAND
              THRU 000100-EXIT
               UNTIL (WS-ESCAPE-FLAG = 1).
      *
       000000-EXIT.
           STOP RUN.
      *
      *
      *               G E T   C O M M A N D
      *
       000100-GET-COMMAND.
      *
           MOVE SPACE TO WS-COMMAND.
           ACCEPT COMMAND-SCREEN
               ON ESCAPE
                   MOVE 1 TO WS-ESCAPE-FLAG
                   GO TO 000100-EXIT.
           INSPECT WS-COMMAND
               CONVERTING "abcdefghijklmnopqrstuvwxyz"
                       TO "ABCDEFGHIJKLMNOPQRSTUVWXYZ".
      *
           IF (WS-COMMAND = "P")
               DISPLAY PAYMENT-SCREEN
               PERFORM 000500-FIND-PAYMENT
                  THRU 000500-EXIT
           ELSE
           IF (WS-COMMAND = "L")
               DISPLAY LOAN-SCREEN
               PERFORM 000600-FIND-LOAN
                  THRU 000600-EXIT.
      *
           DISPLAY COMMAND-SCREEN.
      *
       000100-EXIT.
           EXIT.
      *
      *
      *                   F I N D   P A Y M E N T
      *
       000500-FIND-PAYMENT.
      *
           ACCEPT PAYMENT-SCREEN
               ON ESCAPE
                   GO TO 000500-EXIT.
      *
           PERFORM 004000-COMPUTE-PAYMENT
              THRU 004000-EXIT.
      *
           IF (LW-LOAN-ERROR-FLAG = 1)
               MOVE "PARAMETER ERROR" TO WS-ERR-MSG
               DISPLAY ERROR-SCREEN
               GO TO 000500-FIND-PAYMENT.
      *
           DISPLAY PAYMENT-ANSWER-SCREEN.
      *
           MOVE "PRESS A KEY TO CONTINUE" TO WS-ERR-MSG..
           DISPLAY ERROR-SCREEN.
           ACCEPT ERROR-SCREEN.
      *
       000500-EXIT.
           EXIT.
      *
      *
      *                   F I N D   L O A N
      *
       000600-FIND-LOAN.
      *
           ACCEPT LOAN-SCREEN
               ON ESCAPE
                   GO TO 000600-EXIT.
      *
           PERFORM 004100-COMPUTE-LOAN
              THRU 004100-EXIT.
      *
           IF (LW-LOAN-ERROR-FLAG = 1)
               MOVE "PARAMETER ERROR" TO WS-ERR-MSG
               DISPLAY ERROR-SCREEN
               GO TO 000600-FIND-LOAN.
      *
           DISPLAY LOAN-ANSWER-SCREEN.
      *
           MOVE "PRESS A KEY TO CONTINUE" TO WS-ERR-MSG..
           DISPLAY ERROR-SCREEN.
           ACCEPT ERROR-SCREEN.
      *
       000600-EXIT.
           EXIT.
      ******************************************************************
      *                                                                *
      *            C O M P U T E   L O A N   P A Y M E N T             *
      *                                                                *
      *                      Judson D. McClendon                       *
      *                      Sun Valley Systems                        *
      *                      329 37th Court NE                         *
      *                      Birmingham, AL 35215                      *
      *                         205/853-8440                           *
      *                                                                *
      *    USAGE:  MOVE <LOAN AMOUNT>     TO LW-LOAN-AMT.              *
      *            MOVE <ANNUAL INT %>    TO LW-INT-RATE.              *
      *            MOVE <NUMBER PAYMENTS> TO LW-NBR-PMTS.              *
      *            PERFORM 004000-COMPUTE-PAYMENT                      *
      *               THRU 004000-EXIT.                                *
      *                                                                *
      *    RESULT: LW-LOAN-ERROR-FLAG = 0 IF CALC SUCCESSFUL           *
      *            LW-LOAN-ERROR-FLAG = 1 IF CALC NOT SUCCESSFUL       *
      *                                                                *
      *       IF LW-LOAN-ERROR-FLAG = 0                                *
      *                                                                *
      *            LW-PMT-AMT    = AMOUNT OF MONTHLY PAYMENT           *
      *            LW-TOTAL-PMTS = TOTAL AMOUNT OF PAYMENTS            *
      *            LW-TOTAL-INT  = TOTAL AMOUNT OF INTEREST            *
      *                                                                *
      ******************************************************************
      *
       004000-COMPUTE-PAYMENT.
      *
           MOVE 0 TO LW-LOAN-ERROR-FLAG.
      *
           IF (LW-LOAN-AMT ZERO)
               OR
              (LW-INT-RATE ZERO)
               OR
              (LW-NBR-PMTS ZERO)
               MOVE 1 TO LW-LOAN-ERROR-FLAG
               GO TO 004000-EXIT.
      *
           COMPUTE LW-INT-PMT = LW-INT-RATE / 1200
               ON SIZE ERROR
                   MOVE 1 TO LW-LOAN-ERROR-FLAG
                   GO TO 004000-EXIT.
      *
           COMPUTE LW-PMT-AMT ROUNDED =
               (LW-LOAN-AMT * LW-INT-PMT) /
               (1 - 1.00000000 / ( (1 + LW-INT-PMT) ** LW-NBR-PMTS) )
               ON SIZE ERROR
                   MOVE 1 TO LW-LOAN-ERROR-FLAG
                   GO TO 004000-EXIT.
      *
           COMPUTE LW-TOTAL-PMTS = LW-PMT-AMT * LW-NBR-PMTS
               ON SIZE ERROR
                   MOVE 1 TO LW-LOAN-ERROR-FLAG
                   GO TO 004000-EXIT.
      *
           COMPUTE LW-TOTAL-INT = LW-TOTAL-PMTS - LW-LOAN-AMT.
      *
       004000-EXIT.
           EXIT.
      *
      *
      *
      ******************************************************************
      *                                                                *
      *             C O M P U T E   L O A N   A M O U N T              *
      *                                                                *
      *                      Judson D. McClendon                       *
      *                      Sun Valley Systems                        *
      *                      329 37th Court NE                         *
      *                      Birmingham, AL 35215                      *
      *                         205/853-8440                           *
      *                                                                *
      *    USAGE:  MOVE <MONTHLY PAYMENT> TO LW-LOAN-AMT.              *
      *            MOVE <ANNUAL INT %>    TO LW-INT-RATE.              *
      *            MOVE <NUMBER PAYMENTS> TO LW-NBR-PMTS.              *
      *            PERFORM 004100-COMPUTE-LOAN                         *
      *               THRU 004100-EXIT.                                *
      *                                                                *
      *    RESULT: LW-LOAN-ERROR-FLAG = 0 IF CALC SUCCESSFUL           *
      *            LW-LOAN-ERROR-FLAG = 1 IF CALC NOT SUCCESSFUL       *
      *                                                                *
      *       IF LW-LOAN-ERROR-FLAG = 0                                *
      *                                                                *
      *            LW-LOAN-AMT   = AMOUNT OF LOAN                      *
      *            LW-TOTAL-PMTS = TOTAL AMOUNT OF PAYMENTS            *
      *            LW-TOTAL-INT  = TOTAL AMOUNT OF INTEREST            *
      *                                                                *
      ******************************************************************
      *
       004100-COMPUTE-LOAN.
      *
           MOVE 0 TO LW-LOAN-ERROR-FLAG.
      *
           IF (LW-PMT-AMT ZERO)
               OR
              (LW-INT-RATE ZERO)
               OR
              (LW-NBR-PMTS ZERO)
               MOVE 1 TO LW-LOAN-ERROR-FLAG
               GO TO 004100-EXIT.
      *
           COMPUTE LW-INT-PMT = LW-INT-RATE / 1200
               ON SIZE ERROR
                   MOVE 1 TO LW-LOAN-ERROR-FLAG
                   GO TO 004100-EXIT.
      *
           COMPUTE LW-LOAN-AMT = LW-PMT-AMT *
               ( (1 - 1.00000000 / ( (1 + LW-INT-PMT) ** LW-NBR-PMTS) )
                       / LW-INT-PMT)
               ON SIZE ERROR
                   MOVE 1 TO LW-LOAN-ERROR-FLAG
                   GO TO 004100-EXIT.
           COMPUTE LW-TOTAL-PMTS = LW-PMT-AMT * LW-NBR-PMTS
               ON SIZE ERROR
                   MOVE 1 TO LW-LOAN-ERROR-FLAG
                   GO TO 004100-EXIT.
           COMPUTE LW-TOTAL-INT = LW-TOTAL-PMTS - LW-LOAN-AMT.
      *
           COMPUTE LW-TOTAL-PMTS = LW-PMT-AMT * LW-NBR-PMTS
               ON SIZE ERROR
                   MOVE 1 TO LW-LOAN-ERROR-FLAG
                   GO TO 004100-EXIT.
      *
           COMPUTE LW-TOTAL-INT = LW-TOTAL-PMTS - LW-LOAN-AMT.
      *
       004100-EXIT.
           EXIT.

¤ Dauer der Verarbeitung: 0.4 Sekunden (vorverarbeitet) ¤

Download des Quellennavigators
Download des sprechenden Kalenders
in der Quellcodebibliothek suchen

Haftungshinweis

Die Informationen auf dieser Webseite wurden nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit, noch Qualität der bereit gestellten Informationen zugesichert.

Bemerkung:

Die farbliche Syntaxdarstellung ist noch experimentell.