Cobol Standards

Sample Cobol Program



 IDENTIFICATION DIVISION.

 PROGRAM-ID.      COBEX.
 AUTHOR.          RALPH RALPH.
 DATE-WRITTEN.    12/15/94.

*REMARKS.         MERGE TWO FILES.
*

*                      MAINTENANCE LOG
*
*   DATE   INIT  REASON FOR CHANGE
* 12/16/94  RR   TRANSACTION FILE COUNT ADDED
* ##/##/##  ##   ###########################################


 ENVIRONMENT DIVISION.

 CONFIGURATION SECTION.

 SPECIAL-NAMES.
     C01 IS TOP-OF-PAGE.

 INPUT-OUTPUT SECTION.


 FILE-CONTROL.
     SELECT PARM-FILE      ASSIGN TO UT-S-PARMFILE.
     SELECT OLD-FILE       ASSIGN TO UT-S-OLDFILE.
     SELECT TRN-FILE       ASSIGN TO UT-S-TRNFILE.
     SELECT OUT-FILE       ASSIGN TO UT-S-OUTFILE.
     SELECT PRINT-FILE     ASSIGN TO UT-S-PRTFL01.
     SELECT ERROR-FILE     ASSIGN TO UT-S-PRTFL02.


 DATA DIVISION.

 FILE SECTION.


 FD  PARM-FILE
     RECORDING MODE F
     LABEL RECORDS ARE OMITTED
     RECORD CONTAINS 80 CHARACTERS.

 01  PARM-REC.
     03  RPT-DATE          PIC X(008).                            001-008
     03  FILLER            PIC X(072).                            009-080

 FD  OLD-FILE
     RECORDING MODE F
     LABEL RECORDS ARE STANDARD
     RECORD CONTAINS 100 CHARACTERS
     BLOCK CONTAINS 0 RECORDS.
 01  OLD-REC               PIC X(100).                            001-100

 FD  TRN-FILE
     RECORDING MODE F
     LABEL RECORDS ARE STANDARD
     RECORD CONTAINS 100 CHARACTERS
     BLOCK CONTAINS 0 RECORDS.
 01  TRN-REC               PIC X(100).                            001-100

 FD  OUT-FILE
     RECORDING MODE F
     LABEL RECORDS ARE STANDARD
     RECORD CONTAINS 100 CHARACTERS
     BLOCK CONTAINS 0 RECORDS.
 01  OUT-REC               PIC X(100).                            001-100

 FD  PRINT-FILE
     RECORDING MODE F
     LABEL RECORDS ARE OMITTED
     RECORD CONTAINS 133 CHARACTERS.
 01  PRINT-REC             PIC X(133).                            001-133

 FD  ERROR-FILE
     RECORDING MODE F
     LABEL RECORDS ARE OMITTED
     RECORD CONTAINS 133 CHARACTERS.
 01  ERR-REC               PIC X(133).                            001-133


 WORKING-STORAGE SECTION.




 01  OLD-RECORD.                                                  001-100
 ++INCLUDE OLDRECRD

 01  TRN-RECORD.                                                  001-100
 ++INCLUDE TRNRECRD

 01  OUT-RECORD.                                                  001-100
 ++INCLUDE OUTRECRD

 01  ACCUMULATORS.
     03  OLD-CNT           PIC 9(005) VALUE ZEROES.

     03  TRN-CNT           PIC 9(005) VALUE ZEROES.               RR1294
     03  OUT-CNT           PIC 9(005) VALUE ZEROES.


 01  DETAIL-LINES.
     03  DTL1.
         05  FILLER        PIC X(001) VALUE SPACES.
         05  DTL1-DESC     PIC X(030).
         05  DTL1-CNT      PIC ZZ,ZZ9.
         05  FILLER        PIC X(096) VALUE SPACES.
     03  DTL2.
         05  FILLER        PIC X(001) VALUE SPACES.
         05  FILLER        PIC X(020) VALUE
             'CONTROL PARAMETER:  '.
         05  DTL2-PARM     PIC X(080).
         05  FILLER        PIC X(032) VALUE SPACES.
     03  ERR1.
         05  FILLER        PIC X(001) VALUE SPACES.
         05  ERR1-MSG      PIC X(132).

 01  HEADERS.

     03  HDR1.
         05  FILLER        PIC X(001) VALUE SPACES.
         05  HDR1-DATE     PIC X(008).
             07  HDR1-MM   PIC X(002).
             07  FILLER    PIC X(001) VALUE '/'.
             07  HDR1-DD   PIC X(002).
             07  FILLER    PIC X(001) VALUE '/'.
             07  HDR1-YY   PIC X(002).
         05  FILLER        PIC X(041) VALUE SPACES.
         05  FILLER        PIC X(034) VALUE
             'AUBURN UNIVERSITY STANDARD PROGRAM'.
         05  FILLER        PIC X(027) VALUE SPACES.
         05  FILLER        PIC X(014) VALUE
             'REPORT DATE:  '.
         05  HDR1-RPT-DATE PIC X(008).
     03  HDR2.
         05  FILLER        PIC X(001) VALUE SPACES.
         05  HDR2-TIME     PIC X(008).
             07  HDR2-HR   PIC X(002).
             07  FILLER    PIC X(001) VALUE ':'.
             07  HDR2-MIN  PIC X(002).
             07  FILLER    PIC X(001) VALUE ':'.
             07  HDR2-SEC  PIC X(002).
         05  FILLER        PIC X(050) VALUE SPACES.
         05  FILLER        PIC X(016) VALUE
             'MERGE STATISTICS'.
         05  FILLER        PIC X(049) VALUE SPACES.
         05  FILLER        PIC X(009) VALUE
             'PGM=COBEX'.
     03  ERR-HDR1.
         05  FILLER        PIC X(062) VALUE SPACES.
         05  FILLER        PIC X(009) VALUE
             'ERROR LOG'.
         05  FILLER        PIC X(053) VALUE SPACES.
         05  FILLER        PIC X(009) VALUE
             'PGM=MERGE'.

 01  WORK-DATE.
     03  WORK-YY           PIC X(002).
     03  WORK-MM           PIC X(002).
     03  WORK-DD           PIC X(002).

 01  WORK-TIME.
     03  WORK-HR           PIC X(002).
     03  WORK-MIN          PIC X(002).
     03  WORK-SEC          PIC X(002).
     03  FILLER            PIC X(002).


 PROCEDURE DIVISION.



 A010-OPEN-FILES.
     OPEN INPUT  PARM-FILE
                 OLD-FILE
                 TRN-FILE
          OUTPUT OUT-FILE
                 PRINT-FILE
                 ERROR-FILE.

 A020-ERR-HDR.
     ACCEPT WORK-DATE FROM DATE.
     MOVE WORK-MM TO HDR1-MM.
     MOVE WORK-DD TO HDR1-DD.
     MOVE WORK-YY TO HDR1-YY.
     ACCEPT WORK-TIME FROM TIME.
     MOVE WORK-HR TO HDR2-HR.
     MOVE WORK-MIN TO HDR2-MIN.
     MOVE WORK-SEC TO HDR2-SEC.
     WRITE ERR-REC FROM HDR1 AFTER ADVANCING TOP-OF-PAGE.
     WRITE ERR-REC FROM ERR-HDR1 AFTER ADVANCING 1 LINES.

 A030-READ-PARM-FILE.
     READ PARM-FILE AT END
         MOVE 'MISSING CONTROL PARAMETER' TO ERR1-MSG
         WRITE ERR-REC FROM ERR1 AFTER ADVANCING 2 LINES
         GO TO A900-STATS.
     MOVE RPT-DATE TO HDR1-RPT-DATE.
     PERFORM C010-HEADER.
     MOVE PARM-REC TO DTL2-PARM.
     WRITE PRINT-REC FROM DTL2 AFTER ADVANCING 2 LINES.


 A040-SETUP.
     PERFORM B010-READ-OLD.
     PERFORM B020-READ-TRN.

 A050-MERGE.
     IF OLD-KEY = HIGH-VALUES
        AND TRN-KEY = HIGH-VALUES
            GO TO A900-STATS.
     ADD 1 TO OUT-CNT.

     IF TRN-KEY < OLD-KEY
        MOVE TRN-RECORD TO OUT-RECORD
        WRITE OUT-REC FROM OUT-RECORD
        PERFORM B020-READ-TRN
        GO TO A050-MERGE.
     MOVE OLD-RECORD TO OUT-RECORD.
     WRITE OUT-REC FROM OUT-RECORD.
     PERFORM B010-READ-OLD.
     GO TO A050-MERGE.



 A900-STATS.
     PERFORM C010-HEADER THRU C030-EXIT.


 A998-CLOSE-FILES.
     CLOSE PARM-FILE
           OLD-FILE
           TRN-FILE
           OUT-FILE
           PRINT-FILE
           ERROR-FILE.


 A999-STOP-RUN.
     STOP RUN.

 B010-READ-OLD.
     READ OLD-FILE AT END
         MOVE HIGH-VALUES TO OLD-KEY.
     IF OLD-KEY NOT = HIGH-VALUES
        ADD 1 TO OLD-CNT
        MOVE OLD-REC TO OLD-RECORD.

 B020-READ-TRN.
     READ TRN-FILE AT END
         MOVE HIGH-VALUES TO TRN-KEY.
     IF TRN-KEY NOT = HIGH-VALUES
        ADD 1 TO TRN-CNT                                         RR1294
        MOVE TRN-REC TO TRN-RECORD.

 C010-HEADER.
     WRITE PRINT-REC FROM HDR1 AFTER ADVANCING TOP-OF-PAGE.
     WRITE PRINT-REC FROM HDR2 AFTER ADVANCING 1 LINES.

 C020-PRINT-STATS.
     MOVE 'OLD FILE CNT:' TO DTL1-DESC.
     MOVE OLD-CNT TO DTL1-CNT.
     WRITE PRINT-REC FROM DTL1 AFTER ADVANCING 2 LINES.
     MOVE 'TRN FILE CNT:' TO DTL1-DESC.                           RR1294
     MOVE TRN-CNT TO DTL1-CNT.                                    RR1294
     WRITE PRINT-REC FROM DTL1 AFTER ADVANCING 1 LINES.           RR1294
     MOVE 'NEW FILE CNT:' TO DTL1-DESC.
     MOVE OUT-CNT TO DTL1-CNT.
     WRITE PRINT-REC FROM DTL1 AFTER ADVANCING 1 LINES.

 C030-EXIT.
     EXIT.
*************************** END OF COBEX **************************


Last Modified:

©1999 All Rights Reserved