tinycobol/test.code/t04/test04.cob

78 lines
1.9 KiB
COBOL

IDENTIFICATION DIVISION.
PROGRAM-ID. TEST04.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SPECIAL-NAMES.
DECIMAL-POINT IS COMMA.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT ARQ ASSIGN TO "Testing.dat"
ORGANIZATION IS INDEXED
ACCESS MODE IS DYNAMIC
RECORD KEY IS X-IND
ALTERNATE RECORD KEY IS DESCRIPTION
ALTERNATE RECORD KEY MANUFACTURER
WITH DUPLICATES
FILE STATUS IS FS.
DATA DIVISION.
FILE SECTION.
FD ARQ
LABEL RECORD IS STANDARD.
01 REG-ARQ.
03 X-IND PIC 9(03).
03 DESCRIPTION PIC X(60).
03 MANUFACTURER PIC X(45).
WORKING-STORAGE SECTION.
01 FS PIC 9(02).
01 ARQ-KEY PIC 9(03).
01 ARQ-MANUFACTURER PIC X(45) value spaces.
PROCEDURE DIVISION.
OPEN OUTPUT ARQ.
05-NEXT.
DISPLAY "Enter key:" NO ADVANCING.
ACCEPT ARQ-KEY.
IF ARQ-KEY = ZEROS
GO TO 10-CLOSE.
* save our key into the file also (just to test)
MOVE ARQ-KEY TO X-IND.
DISPLAY "Description:" NO ADVANCING.
ACCEPT DESCRIPTION.
DISPLAY "Manufacturer:" NO ADVANCING.
ACCEPT MANUFACTURER.
WRITE REG-ARQ.
GO TO 05-NEXT.
10-CLOSE.
CLOSE ARQ.
20-REOPEN.
OPEN I-O ARQ.
DISPLAY "---------------------".
25-LOOP.
DISPLAY "Start Manufacturer:" NO ADVANCING.
ACCEPT ARQ-MANUFACTURER.
DISPLAY "Key entered:" ARQ-MANUFACTURER.
IF ARQ-MANUFACTURER = SPACES OR
ARQ-MANUFACTURER = ZEROES
GO TO 30-CLOSE.
MOVE SPACES TO REG-ARQ.
MOVE ARQ-MANUFACTURER TO MANUFACTURER.
READ ARQ KEY IS MANUFACTURER.
DISPLAY "Status:" FS " Data:" REG-ARQ.
IF FS LESS THAN "03"
PERFORM 26-READ-UNTIL-END.
GO TO 25-LOOP.
26-READ-UNTIL-END.
DELETE ARQ .
DISPLAY "Status:" FS " Data:" REG-ARQ.
GO TO 25-LOOP.
30-CLOSE.
CLOSE ARQ.
99-END.
STOP RUN.