tinycobol/test.code/t08/test08.cob

98 lines
2.3 KiB
COBOL

IDENTIFICATION DIVISION.
PROGRAM-ID. TEST08.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SPECIAL-NAMES.
DECIMAL-POINT IS COMMA.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT ARQ ASSIGN TO "Raw.dat"
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS FS.
SELECT OUT-REC ASSIGN TO "Sorted.dat"
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS FS.
SELECT SORT-REC ASSIGN TO "Sort.dat".
* I-O-CONTROL.
DATA DIVISION.
FILE SECTION.
FD ARQ
LABEL RECORD IS STANDARD.
01 REG-ARQ.
03 P-IND PIC 9(03).
03 DESCRIPTION PIC X(60).
FD OUT-REC.
01 MAIN-RECORD PIC X(63).
SD SORT-REC.
01 MAIN-REC.
03 INDICATOR PIC 9(03).
03 DESC PIC X(60).
WORKING-STORAGE SECTION.
01 FS PIC X(02).
01 W-COUNTER PIC 9(15).
01 REM PIC 9(5).
01 W01-SWITCHES PIC X(03).
88 W01-END VALUE "YES".
88 W01-MORE VALUE "NO".
PROCEDURE DIVISION.
MAIN SECTION.
MOVE 0 TO W-COUNTER REM.
SORT SORT-REC ASCENDING KEY INDICATOR
DESCENDING KEY DESC
INPUT PROCEDURE IN-ARQ
OUTPUT PROCEDURE OUT-RECORD.
STOP RUN.
IN-ARQ SECTION.
MOVE "NO" TO W01-SWITCHES.
OPEN INPUT ARQ.
PERFORM READ-INPUT
UNTIL W01-END.
CLOSE ARQ.
READ-INPUT.
READ ARQ
AT END MOVE "YES" TO W01-SWITCHES
DISPLAY "EOF".
IF (FS NOT = "00") AND W01-MORE
DISPLAY "Error on Reading Input File " FS W01-SWITCHES
STOP RUN.
IF NOT W01-END
MOVE REG-ARQ TO MAIN-REC
RELEASE MAIN-REC
ADD 1 TO W-COUNTER
ADD 1 TO REM
IF REM = 1000
MOVE ZEROS TO REM
DISPLAY W-COUNTER .
OUT-RECORD SECTION.
DISPLAY "WRITING FINAL FILE".
OPEN OUTPUT OUT-REC.
IF FS NOT = "00"
DISPLAY "Error on Opening output File " FS
STOP RUN.
MOVE "NO" TO W01-SWITCHES.
PERFORM WRITE-OUTPUT
UNTIL W01-END.
WRITE-OUTPUT.
RETURN SORT-REC INTO MAIN-RECORD
AT END MOVE "YES" TO W01-SWITCHES.
IF NOT W01-END
WRITE MAIN-RECORD.
IF (FS NOT = "00") AND W01-MORE
DISPLAY "Error on Writing Output File " FS
STOP RUN.