>>SOURCE FORMAT IS FREE *> cobol-indexed-file.cob — build an indexed parts *> master from a fixed-width file, then read it by key, rewrite *> a record, browse a key range with START, browse an alternate *> key, delete a record, and take a final sequential pass *> Dialect: GnuCOBOL 3.x, free format *> Status : desk-checked against the GnuCOBOL Programmer's Guide (5.2.1.4, *> 7.8.11, 7.8.30, 7.8.35, 7.8.41) and the IBM Enterprise COBOL 6.4 *> Language Reference; compiled and run with GnuCOBOL 3.2 on 2026-10-29 *> Inputs : datasets/cobol-indexed-file-start-read-key-rewrite.dat *> (LINE SEQUENTIAL, LF line endings, 48 bytes per record, *> 21 records of which one has a duplicate key) *> code/cobol-indexed-file-start-read-key-rewrite.cpy (the layout) *> Outputs: the indexed file "parts-master" (whatever files the build's *> indexed backend creates for that name) and DISPLAY lines *> Build : cobc -x -I code -o parts-master-demo code/cobol-indexed-file.cob *> (run from the folder that holds code/ and datasets/) *> Run : ./parts-master-demo (Windows: parts-master-demo.exe) IDENTIFICATION DIVISION. PROGRAM-ID. PARTS-MASTER-DEMO. ENVIRONMENT DIVISION. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT Load-File ASSIGN TO "datasets/cobol-indexed-file-start-read-key-rewrite.dat" ORGANIZATION IS LINE SEQUENTIAL FILE STATUS IS WS-Load-Status. *> The indexed file. DYNAMIC access allows both READ by key and READ NEXT *> in the same program; the START statement moves between the two. SELECT Parts-File ASSIGN TO "parts-master" ORGANIZATION IS INDEXED ACCESS MODE IS DYNAMIC RECORD KEY IS Part-No ALTERNATE RECORD KEY IS Part-Bin WITH DUPLICATES FILE STATUS IS WS-Parts-Status. DATA DIVISION. FILE SECTION. FD Load-File. 01 Load-Line PIC X(48). FD Parts-File. COPY "cobol-indexed-file-start-read-key-rewrite.cpy". WORKING-STORAGE SECTION. 77 WS-Load-Status PIC XX. 77 WS-Parts-Status PIC XX. 01 WS-Flags. 05 WS-EOF-Flag PIC X VALUE "N". 88 End-Of-File VALUE "Y". 05 WS-Browse-Flag PIC X VALUE "N". 88 Browse-Done VALUE "Y". 77 WS-Loaded PIC 9(5) VALUE 0. 77 WS-Rejected PIC 9(5) VALUE 0. 77 WS-Count PIC 9(5) VALUE 0. 77 WS-Before PIC 9(5) VALUE 0. 77 WS-Value PIC 9(9)V99 VALUE 0. 77 WS-Total PIC 9(9)V99 VALUE 0. 77 WS-Show-Count PIC ZZ,ZZ9. 77 WS-Show-Before PIC ZZ,ZZ9. 77 WS-Show-Money PIC Z,ZZZ,ZZ9.99. 77 WS-Search-Key PIC X(8). 77 WS-Search-Bin PIC X(4). *> Keys the demonstration uses. Change them and the DISPLAY lines change; *> the Python companion prints the expected lines for these values. 01 WS-Lookup-Keys. 05 FILLER PIC X(8) VALUE "FLT-0305". 05 FILLER PIC X(8) VALUE "GSK-0042". 05 FILLER PIC X(8) VALUE "BRK-9999". 01 WS-Lookup-Table REDEFINES WS-Lookup-Keys. 05 WS-Lookup-Key PIC X(8) OCCURS 3 TIMES. 77 WS-Lookup-Ix PIC 9 VALUE 0. 77 WS-Receive-Key PIC X(8) VALUE "BRK-0210". 77 WS-Receive-Qty PIC 9(5) VALUE 25. 77 WS-Ghost-Key PIC X(8) VALUE "ZZZ-0000". 77 WS-Browse-Prefix PIC X(4) VALUE "BRK-". 77 WS-Browse-Bin PIC X(4) VALUE "B-07". 77 WS-Delete-Key PIC X(8) VALUE "GSK-0042". PROCEDURE DIVISION. Main-Paragraph. PERFORM Load-Master OPEN I-O Parts-File IF WS-Parts-Status NOT = "00" DISPLAY "Cannot open parts master for I-O, status " WS-Parts-Status STOP RUN END-IF PERFORM Look-Up-Keys PERFORM Receive-Stock PERFORM Rewrite-Ghost PERFORM Browse-Prefix PERFORM Browse-Bin PERFORM Delete-Part PERFORM Final-Pass CLOSE Parts-File IF WS-Parts-Status NOT = "00" DISPLAY "Close failed, status " WS-Parts-Status END-IF STOP RUN. *> Step 1. OPEN OUTPUT creates the indexed file (replacing any earlier one) *> and every WRITE inserts a record under its Part-No. A second record with *> a key already in the file fails with status 22 in both dialects. Load-Master. OPEN INPUT Load-File IF WS-Load-Status NOT = "00" DISPLAY "Cannot open the load file, status " WS-Load-Status STOP RUN END-IF OPEN OUTPUT Parts-File IF WS-Parts-Status NOT = "00" DISPLAY "Cannot create the parts master, status " WS-Parts-Status STOP RUN END-IF PERFORM Read-Load-Line PERFORM UNTIL End-Of-File MOVE Load-Line TO Part-Record WRITE Part-Record INVALID KEY ADD 1 TO WS-Rejected DISPLAY "Load: duplicate key " Part-No " rejected, status " WS-Parts-Status NOT INVALID KEY ADD 1 TO WS-Loaded END-WRITE PERFORM Read-Load-Line END-PERFORM CLOSE Load-File Parts-File MOVE WS-Loaded TO WS-Show-Count MOVE WS-Rejected TO WS-Show-Before DISPLAY "Loaded " WS-Show-Count " parts, rejected " WS-Show-Before. Read-Load-Line. READ Load-File AT END SET End-Of-File TO TRUE END-READ IF WS-Load-Status NOT = "00" AND WS-Load-Status NOT = "10" DISPLAY "Load file read failed, status " WS-Load-Status STOP RUN END-IF. *> Step 2. A random READ: put the wanted value in the RECORD KEY field and *> READ with no NEXT. The record arrives in Part-Record or INVALID KEY *> fires with status 23. Look-Up-Keys. PERFORM VARYING WS-Lookup-Ix FROM 1 BY 1 UNTIL WS-Lookup-Ix > 3 MOVE WS-Lookup-Key(WS-Lookup-Ix) TO WS-Search-Key PERFORM Look-Up-One END-PERFORM. Look-Up-One. MOVE WS-Search-Key TO Part-No READ Parts-File INVALID KEY DISPLAY "Look-up " WS-Search-Key ": not found, status " WS-Parts-Status NOT INVALID KEY MOVE Part-On-Hand TO WS-Show-Count DISPLAY "Look-up " Part-No ": " Part-Desc " bin " Part-Bin " on hand " WS-Show-Count END-READ. *> Step 3. Read, change, rewrite. The prime key stays as it was; only the *> quantity changes. REWRITE needs the file open for I-O. Receive-Stock. MOVE WS-Receive-Key TO Part-No READ Parts-File INVALID KEY DISPLAY "Receive " WS-Receive-Key ": not found, status " WS-Parts-Status NOT INVALID KEY MOVE Part-On-Hand TO WS-Before ADD WS-Receive-Qty TO Part-On-Hand REWRITE Part-Record INVALID KEY DISPLAY "Receive " WS-Receive-Key ": rewrite failed, status " WS-Parts-Status NOT INVALID KEY MOVE WS-Before TO WS-Show-Before MOVE Part-On-Hand TO WS-Show-Count DISPLAY "Receive " Part-No ": on hand " WS-Show-Before " -> " WS-Show-Count ", rewrite status " WS-Parts-Status END-REWRITE END-READ. *> A REWRITE whose prime key matches nothing. Under DYNAMIC access no READ *> has to precede a REWRITE (Programmer's Guide 7.8.35), so the record is *> identified by the key field alone, and here that identifies nothing. Rewrite-Ghost. MOVE SPACES TO Part-Record MOVE WS-Ghost-Key TO Part-No MOVE "GHOST" TO Part-Desc MOVE "Z-99" TO Part-Bin MOVE 0 TO Part-On-Hand MOVE 0 TO Part-Unit-Cost REWRITE Part-Record INVALID KEY DISPLAY "Rewrite " WS-Ghost-Key ": no such record, status " WS-Parts-Status NOT INVALID KEY DISPLAY "Rewrite " WS-Ghost-Key ": unexpectedly succeeded" END-REWRITE. *> Step 4. A key-range browse. MOVE "BRK-" into the eight-byte key gives *> "BRK-" followed by four spaces, which sorts before every real BRK- part *> number, so START KEY >= positions at the first of them. READ NEXT then *> walks the file in key order until the prefix changes or the file ends. Browse-Prefix. MOVE 0 TO WS-Count WS-Total MOVE "N" TO WS-Browse-Flag MOVE WS-Browse-Prefix TO Part-No START Parts-File KEY IS GREATER THAN OR EQUAL TO Part-No INVALID KEY DISPLAY "Browse " WS-Browse-Prefix ": nothing at or after it, status " WS-Parts-Status SET Browse-Done TO TRUE END-START PERFORM UNTIL Browse-Done READ Parts-File NEXT RECORD AT END SET Browse-Done TO TRUE NOT AT END IF Part-No(1:4) = WS-Browse-Prefix ADD 1 TO WS-Count COMPUTE WS-Value = Part-On-Hand * Part-Unit-Cost ADD WS-Value TO WS-Total MOVE Part-On-Hand TO WS-Show-Count MOVE WS-Value TO WS-Show-Money DISPLAY " " Part-No " " Part-Desc " " WS-Show-Count " " WS-Show-Money ELSE SET Browse-Done TO TRUE END-IF END-READ END-PERFORM MOVE WS-Count TO WS-Show-Count MOVE WS-Total TO WS-Show-Money DISPLAY "Browse " WS-Browse-Prefix ": " WS-Show-Count " parts, stock value " WS-Show-Money. *> Step 5. The same shape on the alternate key. START names Part-Bin, so *> READ NEXT now travels in bin order; records that share a bin come back in *> the order they were written. Browse-Bin. MOVE 0 TO WS-Count MOVE "N" TO WS-Browse-Flag MOVE WS-Browse-Bin TO Part-Bin START Parts-File KEY IS GREATER THAN OR EQUAL TO Part-Bin INVALID KEY DISPLAY "Bin " WS-Browse-Bin ": nothing at or after it, status " WS-Parts-Status SET Browse-Done TO TRUE END-START PERFORM UNTIL Browse-Done READ Parts-File NEXT RECORD AT END SET Browse-Done TO TRUE NOT AT END IF Part-Bin = WS-Browse-Bin ADD 1 TO WS-Count MOVE Part-On-Hand TO WS-Show-Count DISPLAY " " Part-Bin " " Part-No " " Part-Desc " " WS-Show-Count ELSE SET Browse-Done TO TRUE END-IF END-READ END-PERFORM MOVE WS-Count TO WS-Show-Count DISPLAY "Bin " WS-Browse-Bin ": " WS-Show-Count " parts". *> Step 6. DELETE identifies the record by the prime key field under *> DYNAMIC access; a READ afterwards proves it is gone. Delete-Part. MOVE WS-Delete-Key TO Part-No DELETE Parts-File RECORD INVALID KEY DISPLAY "Delete " WS-Delete-Key ": not found, status " WS-Parts-Status NOT INVALID KEY DISPLAY "Delete " WS-Delete-Key ": status " WS-Parts-Status END-DELETE MOVE WS-Delete-Key TO WS-Search-Key PERFORM Look-Up-One. *> Step 7. A full pass in key order. LOW-VALUES sorts before every real *> key, so START KEY >= LOW-VALUES lands on the first record; this is the *> portable spelling of GnuCOBOL's START ... FIRST. Final-Pass. MOVE 0 TO WS-Count WS-Total MOVE "N" TO WS-Browse-Flag MOVE LOW-VALUES TO Part-No START Parts-File KEY IS GREATER THAN OR EQUAL TO Part-No INVALID KEY DISPLAY "Final pass: file is empty, status " WS-Parts-Status SET Browse-Done TO TRUE END-START PERFORM UNTIL Browse-Done READ Parts-File NEXT RECORD AT END SET Browse-Done TO TRUE NOT AT END ADD 1 TO WS-Count COMPUTE WS-Value = Part-On-Hand * Part-Unit-Cost ADD WS-Value TO WS-Total END-READ END-PERFORM MOVE WS-Count TO WS-Show-Count MOVE WS-Total TO WS-Show-Money DISPLAY "Final pass: " WS-Show-Count " parts, stock value " WS-Show-Money.