IDENTIFICATION DIVISION.
       PROGRAM-ID.  RANALTRD.
       AUTHOR.  GROCER.
       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       SELECT MASTER-FILE
           ASSIGN TO "C:\PCOBWIN\VSAM\VSAMALT.DAT"
           ORGANIZATION IS INDEXED
           ACCESS IS RANDOM
           RECORD KEY IS MID
           ALTERNATE RECORD KEY IS MITEM-NAME WITH DUPLICATES.
       SELECT PRINT-FILE ASSIGN TO PRINTER.
      *COMMENTS:
      *This program puts out a menu that lets the user select whether
      *retrieval is to be done by id # or by name.  Depending on the
      *selection another screen comes up asking for the id or name to
      *be used to establish the key and then randomly read the file
      *using the prime MID key or the alternate MITEM-NAME key.
      *Notice the READ statement.  If the prime key is being used,
      *there is no need for a key clause in the read.  If the alternate
      *key is being used then the KEY IS MITEM-NAME clause is included
      *in the READ.
      *The INVALID KEY clause and the NOT INVALID KEY clause are used
      *to determine the processing that needs to be done depending on
      *whether or not the read was successful.
      *Notice that for each read, the key is established prior to the
      *read by moving the id or name that the user typed in to the
      *field designated as RECORD KEY or ALTERNATE RECORD KEY.
       DATA DIVISION.
       FILE SECTION.
       FD  MASTER-FILE
           LABEL RECORDS ARE STANDARD
           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.
           05  RETR-NAME        PIC X(20)        VALUE SPACES.
       01  RESPONSES.
           05  MENU-ANS         PIC X            VALUE SPACES.
           05  ID-ANS           PIC X            VALUE SPACES.
           05  NAME-ANS         PIC X            VALUE SPACES.
       SCREEN SECTION.
       01  MENU-SCREEN.
           05  VALUE "MENU SCREEN"                BLANK SCREEN
                                                  LINE 01 COL 30.
           05  VALUE "I - RETRIEVE BY ID"         LINE 05 COL 10.
           05  VALUE "N - RETRIEVE BY NAME"       LINE 06 COL 10.
           05  VLUAE "T - TERMINATE PROCESSING"   LINE 08 COL 10.
           05  VALUE "ENTER RESPONSE"             LINE 14 COL 15.
           05  ANS-MENU                           LINE 14 COL 42
                   PIC X TO MENU-ANS.
       01  GET-ID-SCREEN.
           05  VALUE "RETRIEVAL SCREEN"           BLANK SCREEN
                                                  LINE 01 COL 30.
           05  VALUE "ENTER ID # TO RETRIEVE:  "  LINE 05 COL 05.
           05  ID-SCR                             LINE 07 COL 20
                    PIC 999    TO RETR-ID.
           05  VALUE "PRESS P TO PROCESS"         LINE 15 COL 20.
           05  VALUE "PRESS C TO CANCEL"          LINE 16 COL 20.
           05  VALUE "ENTER RESPONSE:"            LINE 18 COL 20.
           05  IANS-SCR                           LINE 18 COL 42
                  PIC X  TO ID-ANS.
       01  GET-NAME-SCREEN.
           05  VALUE "RETRIEVAL SCREEN"           BLANK SCREEN
                                                  LINE 01 COL 30.
           05  VALUE "ENTER NAME TO RETRIEVE:  "  LINE 05 COL 05.
           05  NAME-SCR                           LINE 07 COL 20
                   PIC X(20) TO RETR-NAME.
           05  VALUE "PRESS P TO PROCESS"         LINE 15 COL 20.
           05  VALUE "PRESS C TO CANCEL"          LINE 16 COL 20.
           05  VALUE "ENTER RESPONSE:"            LINE 18 COL 20.
           05  NANS-SCR                           LINE 18 COL 42
                   PIC X     TO NAME-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-MENU-SCREEN.
           PERFORM B-200-LOOP
               UNTIL MENU-ANS = "T".
       B-200-LOOP.
           IF MENU-ANS = "I"
               PERFORM B-300-ID-RETRIEVAL
           ELSE
               IF MENU-ANS = "N"
                   PERFORM B-310-NAME-RETRIEVAL.
           PERFORM U-000-GET-MENU-SCREEN.
       B-300-ID-RETRIEVAL.
           PERFORM U-010-GET-ID-SCREEN.
           IF ID-ANS = "P"
               MOVE RETR-ID TO MID
               READ MASTER-FILE
                   INVALID KEY
                       PERFORM B-410-INVALID
                   NOT INVALID KEY
                       PERFORM B-400-PROCESS
               END-READ.
       B-310-NAME-RETRIEVAL.
           PERFORM U-020-GET-NAME-SCREEN.
           IF NAME-ANS = "P"
               MOVE RETR-NAME TO MITEM-NAME
               READ MASTER-FILE
                   KEY IS MITEM-NAME
                   INVALID KEY
                       PERFORM B-410-INVALID
                   NOT INVALID KEY
                       PERFORM B-400-PROCESS
               END-READ.
       B-400-PROCESS.
           MOVE SPACES TO PRINTZ.
           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-410-INVALID.
           MOVE SPACES TO PRINTZ.
           IF MENU-ANS = "I"
               MOVE RETR-ID TO PID
           ELSE
               MOVE RETR-NAME TO PITEM-NAME.
           MOVE "RECORD MISSING " TO PMSG.
           WRITE PRINTZ
               AFTER ADVANCING 1 LINES.
       U-000-GET-MENU-SCREEN.
           DISPLAY MENU-SCREEN.
           ACCEPT MENU-SCREEN.
       U-010-GET-ID-SCREEN.
           DISPLAY GET-ID-SCREEN.
           ACCEPT GET-ID-SCREEN.
       U-020-GET-NAME-SCREEN.
           DISPLAY GET-NAME-SCREEN.
           ACCEPT GET-NAME-SCREEN.
       C-100-TERMINATE.
           CLOSE MASTER-FILE
                 PRINT-FILE.