Please note that JavaScript and style sheet are used in this website,
Due to unadaptability of the style sheet with the browser used in your computer, pages may not look as original.
Even in such a case, however, the contents can be used safely.

Empowered by Innovation NEC

SORTKIT COBOL サンプルプログラム

**************************************************************
*  ソート命令 サンプルプログラム
**************************************************************
IDENTIFICATION      DIVISION.
**************************************************************
PROGRAM-ID.         COBSORT1.
AUTHOR.             NEC.
INSTALLATION.       NEC.
DATE-WRITTEN.       99-01-01.
DATE-COMPILED.
*
ENVIRONMENT         DIVISION.
CONFIGURATION       SECTION.
SOURCE-COMPUTER.    PCAT.   ← UNIXの場合は「NX7700」等
OBJECT-COMPUTER.    PCAT.
*
INPUT-OUTPUT        SECTION.
 FILE-CONTROL.	
   SELECT  INFILE1  ASSIGN      TO INFILE1-MSD
                                   ORGANIZATION   SEQUENTIAL
                                   ACCESS MODE IS SEQUENTIAL
                                   FILE STATUS IS FI1-STATUS.
*
   SELECT  OTFILE1  ASSIGN      TO OTFILE1-MSD
                                   ORGANIZATION   SEQUENTIAL
                                   ACCESS MODE IS SEQUENTIAL
                                   FILE STATUS IS FO1-STATUS.
*
   SELECT  SDFILE   ASSIGN      TO SDFILE-MSD.
*
/
**************************************************************
DATA                DIVISION.
**************************************************************
FILE                SECTION.
FD  INFILE1 LABEL RECORD IS STANDARD
                   VALUE OF IDENTIFICATION IS "SORTIN"
                   BLOCK CONTAINS 20 CHARACTERS.
01  INREC1.
 03  I11             PIC  X(05).
 03  I12             PIC  X(05).
 03  I13             PIC  X(10).
*
FD  OTFILE1 LABEL RECORD IS STANDARD
                   VALUE OF IDENTIFICATION IS "SORTOT"
                   BLOCK CONTAINS 20 CHARACTERS.
01  OTREC1.
 03  O11             PIC  X(05).
 03  O12             PIC  X(05).
 03  O13             PIC  X(10).
*
SD  SDFILE.
01  SDREC.
 03  SD1             PIC  X(05).
 03  SD2             PIC  X(05).
 03  SD3             PIC  X(10).
*
**************************************************************
WORKING-STORAGE SECTION.
*
77  PG-ID             PIC  X(08)  VALUE "COBSORT1".
*
01  FLAG-AREA.
 03  END-FLG         PIC  9(01)  VALUE ZERO.
 03  BEFORE-FLG      PIC  9(01)  VALUE ZERO.
 03  AFTER-FLG       PIC  9(01)  VALUE ZERO.
*
01  FILE-STATUS.
 03  FI1-STATUS      PIC  X(02).
 03  FO1-STATUS      PIC  X(02).
*
/
**************************************************************
PROCEDURE             DIVISION.
**************************************************************
CTRL-PROC             SECTION.
CTRL-START.
*
   PERFORM START-PROC.
*
   SORT    SDFILE
                   ON   ASCENDING      KEY SD1
                   ON   DESCENDING     KEY SD2
                   INPUT     PROCEDURE IS  SORT-BEFORE-PROC
                   OUTPUT    PROCEDURE IS  SORT-AFTER-PROC.
*
   PERFORM FINAL-PROC.
*
CTRL-FINAL.
   STOP RUN.
*
**************************************************************
*START PROC
**************************************************************
START-PROC            SECTION.
START-PROC-START.
*
   DISPLAY PG-ID " START" UPON CONSOLE.
*
   INITIALIZE  FLAG-AREA.
*
START-PROC-FINAL.
   EXIT.
*
**************************************************************
*SORT-BEFORE PROC
**************************************************************
SORT-BEFORE-PROC            SECTION.
SORT-BEFORE-PROC-START.
*
   OPEN    INPUT     INFILE1.
   IF  FI1-STATUS NOT = "00"
        DISPLAY "OPEN INFILE1 ERROR STATUS = " FI1-STATUS
      GO  TO SORT-BEFORE-PROC-FINAL
   END-IF.
*
   PERFORM WITH TEST AFTER UNTIL BEFORE-FLG = 1
          READ INFILE1
              AT END
                      MOVE 1    TO   BEFORE-FLG
          END-READ
          IF   FI1-STATUS  NOT = "00"
              DISPLAY "READ ERROR STATUS = " FI1-STATUS
              GO  TO SORT-BEFORE-PROC-FINAL
          END-IF
          IF   BEFORE-FLG     =    ZERO
              RELEASE   SDREC  FROM  INREC1
          END-IF
   END-PERFORM.
*
   CLOSE        INFILE1.
   IF  FI1-STATUS NOT = "00"
      DISPLAY "CLOSE INFILE1 ERROR STATUS = " FI1-STATUS
   END-IF.
*
SORT-BEFORE-PROC-FINAL.
   EXIT.
*
**************************************************************
*SORT-AFTER PROC
**************************************************************
SORT-AFTER-PROC            SECTION.
SORT-AFTER-PROC-START.
*
   OPEN    OUTPUT    OTFILE1.
   IF  FO1-STATUS NOT = "00"
      DISPLAY "OPEN OTFILE1 ERROR STATUS = "  FO1-STATUS
      GO  TO SORT-AFTER-PROC-FINAL
   END-IF.
*
   PERFORM WITH TEST AFTER UNTIL AFTER-FLG = 1
          RETURN    SDFILE
              AT END
                      MOVE 1    TO   AFTER-FLG
          END-RETURN
          IF   AFTER-FLG      =    ZERO
              WRITE     OTREC1 FROM  SDREC
              IF  FO1-STATUS NOT = "00"
                DISPLAY "WRITE ERROR STATUS = "  FO1-STATUS
                GO  TO SORT-AFTER-PROC-FINAL
              END-IF
          END-IF
   END-PERFORM.
*
   CLOSE        OTFILE1.
   IF  FO1-STATUS NOT = "00"
      DISPLAY "CLOSE OTFILE1 ERROR STATUS = "  FO1-STATUS
      GO  TO SORT-AFTER-PROC-FINAL
   END-IF.
*
SORT-AFTER-PROC-FINAL.
   EXIT.
*
**************************************************************
*FINAL PROC
**************************************************************
FINAL-PROC            SECTION.
FINAL-PROC-START.
*
   DISPLAY PG-ID " E N D" UPON CONSOLE.
*
FINAL-PROC-FINAL.
   EXIT.
*