**************************************************************
* ソート命令 サンプルプログラム
**************************************************************
IDENTIFICATION DIVISION.
**************************************************************
PROGRAM-ID. COBSORT1.
AUTHOR. NEC.
INSTALLATION. NEC.
DATE-WRITTEN. 99-01-01.
DATE-COMPILED.
*
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. PCAT.
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.
*
