Quelle  loan.cob   Sprache: Cobol

       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.