tinycobol/test.code/t08/test08u.cob

87 lines
2.1 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 ARQ1 ASSIGN TO "Raw1.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".
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 ARQ1
LABEL RECORD IS STANDARD.
01 REG-ARQ1.
03 P-IND1 PIC 9(03).
03 DESCRIPTION1 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
USING ARQ1 ARQ
OUTPUT PROCEDURE OUT-RECORD.
DISPLAY "SORT-RETURN: " SORT-RETURN
STOP RUN.
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.