IDENTIFICATION DIVISION.
       PROGRAM-ID.  RANKEYRD.
       AUTHOR.  GROCER.
       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       SELECT MASTER-FILE
           ASSIGN TO "C:\PCOBWIN\VSAM\VSAM1.DAT"
           ORGANIZATION IS INDEXED
           ACCESS IS RANDOM
           RECORD KEY IS MID
           FILE STATUS IS WS-FILE-STATUS.
       SELECT PRINT-FILE ASSIGN TO PRINTER.
      * COMMENTS:
      * This program retrieves records by the prime key which is
      * defined in the master record as MID.
      * The program displays a screen asking the user to enter the key
      * of the record they want to see.  This key is then moved to the
      * MID to establish the key (note it could have been taken in
      * directly to MID, but I wanted to emphasize the need of
      * establishing the key.
      * The move of the id to retrieve to MID (the prime key) is done
      * prior to reading the record since the read will attempt to
      * randomly retrieve the record whose id is in the MID.
      * If the read is unsuccessful the invalid key clause will be
      * triggered and an indicator will be set.  After the read, the
      * indicator will be check to determine the appropriate processing
      * to be done.
       DATA DIVISION.
       FILE SECTION.
       FD  MASTER-FILE
           DATA RECORD IS MASTER-REC.
       01  MASTER-REC.
           05  MID              PIC 9(3).
           05  MITEM-NAME       PIC X(20).
           05  MNUM-HAND        PIC 999.
           05  MNUM-ORDER       PIC 999.
           05  MREORD-PT        PIC 999.
           05  MCOST            PIC 999V99.
           05  MPRICE           PIC 999V99.
       FD  PRINT-FILE
           LABEL RECORDS ARE OMITTED
           DATA RECORD IS PRINTZ.
       01  PRINTZ.
           05  FILLER           PIC X.
           05  PID              PIC X(3).
           05  FILLER           PIC X(2).
           05  PITEM-NAME       PIC X(20).
           05  FILLER           PIC X(2).
           05  PNUM-HAND        PIC ZZ9.
           05  FILLER           PIC X(2).
           05  PNUM-ORDER       PIC ZZ9.
           05  FILLER           PIC X(2).
           05  PREORD-PT        PIC ZZ9.
           05  FILLER           PIC X(2).
           05  PCOST            PIC ZZ9.99.
           05  FILLER           PIC X(2).
           05  PPRICE           PIC ZZ9.99.
           05  FILLER           PIC X(2).
           05  PMSG             PIC X(20).
           05  FILLER           PIC X.
       WORKING-STORAGE SECTION.
       01  KEY-HOLD-AREAS.
           05  RETR-ID          PIC 999          VALUE 0.
       01 RESPONSES.
          05  TERMINATE-ANS     PIC X            VALUE SPACES.
       01 WS-FILE-STATUS        PIC XX           VALUE SPACES.
       SCREEN SECTION.
       01  GET-ID-SCREEN.
           05  VALUE "RETRIEVAL SCREEN"           BLANK SCREEN
                                                  LINE 01 COL 30.
           05  VALUE "ENTER ID RETRIEVE:  "       LINE 05 COL 05.
           05  ID-SCR                             LINE 07 COL 20
                   PIC 999 TO RETR-ID.
           05  VALUE "PRESS C TO CONTINUE"        LINE 15 COL 20.
           05  VALUE "PRESS Q TO QUIT"            LINE 16 COL 20.
           05  VALUE "ENTER RESPONSE:"            LINE 18 COL 20.
           05  ANS-SCR                            LINE 18 COL 42
                   PIC X     TO TERMINATE-ANS.
       PROCEDURE DIVISION.
       MAINLINE.
           PERFORM A-100-INITIALIZE.
           PERFORM B-100-PROCESS.
           PERFORM C-100-TERMINATE.
           STOP RUN.
       A-100-INITIALIZE.
           OPEN INPUT MASTER-FILE
                OUTPUT PRINT-FILE.
       B-100-PROCESS.
           PERFORM U-000-GET-ID-SCREEN.
           PERFORM B-200-LOOP
               UNTIL TERMINATE-ANS = "Q".
       B-200-LOOP.
           MOVE SPACES TO PRINTZ.
           MOVE RETR-ID TO MID.
           READ MASTER-FILE
               INVALID KEY
                   PERFORM B-310-INVALID.
           IF WS-FILE-STATUS = "00"
               PERFORM B-300-PROCESS.
           PERFORM U-000-GET-ID-SCREEN.
       B-300-PROCESS.
           MOVE MID TO PID.
           MOVE MITEM-NAME TO PITEM-NAME.
           MOVE MNUM-HAND TO PNUM-HAND.
           MOVE MNUM-ORDER TO PNUM-ORDER.
           MOVE MREORD-PT TO PREORD-PT.
           MOVE MCOST TO PCOST.
           MOVE MPRICE TO PPRICE.
           WRITE PRINTZ
               AFTER ADVANCING 1 LINES.
       B-310-INVALID.
           MOVE RETR-ID TO PID.
           IF WS-FILE-STATUS = "23"
               MOVE "RECORD MISSING" TO PMSG
           ELSE
               MOVE "OTHER PROBLEM" TO PMSG.
           WRITE PRINTZ
               AFTER ADVANCING 1 LINES.
       U-000-GET-ID-SCREEN.
           DISPLAY GET-ID-SCREEN.
           ACCEPT GET-ID-SCREEN.
       C-100-TERMINATE.
           CLOSE MASTER-FILE
                 PRINT-FILE.