       IDENTIFICATION DIVISION.
       PROGRAM-ID.              PRFILE.
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       SPECIAL-NAMES.
               SYMBOLIC CHARACTERS ZEERO ONE TWO THREE FOUR SIX THIRTEEN
                   FIFTEEN TWENTY-ONE TWENTY-SIX SIXTY-EIGHT SEVENTY-SIX
                                  EIGHTY TWO-FIFTY-FOUR
                   ARE               1    2   3    4     5   7     14
                      16       22         27         69          77
                                    81        255.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
               SELECT INFILE ASSIGN TO INFILE.
               SELECT PR_DISPLAY ASSIGN TO PRT1.
               SELECT PR_PRINT ASSIGN TO PRT2.
       DATA DIVISION.
       FILE SECTION.
       FD  INFILE
               RECORD IS VARYING IN SIZE FROM 1 TO 5600 CHARACTERS
                                        DEPENDING ON WS_RAB_RSZ
               LABEL RECORDS ARE STANDARD.
       01  INFILE-RECORD.
           02  INFILE_CHAR             PIC X(01) OCCURS 5600 TIMES.
       FD  PR_DISPLAY
               LABEL RECORDS ARE OMITTED.
       01  DISPLAY-LINE                PIC X(132).
       FD  PR_PRINT
               LABEL RECORDS ARE OMITTED.
       01  PRINT-LINE                  PIC X(132).
       WORKING-STORAGE SECTION.
           COPY EDCOMAND.
       01  WS_FAB.
           05  WS_FAB_BID              PIC X(01) VALUE THREE.
           05  WS_FAB_BLN              PIC X(01) VALUE EIGHTY.
           05  WS_FAB_IFI              PIC 9(04) COMP VALUE ZERO.
           05  WS_FAB_FOP              PIC 9(09) COMP VALUE ZERO.
           05  WS_FAB_STS              PIC 9(09) COMP VALUE ZERO.
           05  WS_FAB_STV              PIC 9(09) COMP VALUE ZERO.
           05  WS_FAB_ALQ              PIC 9(09) COMP VALUE ZERO.
           05  WS_FAB_DEQ              PIC 9(04) COMP VALUE ZERO.
           05  WS_FAB_FAC              PIC X(01) VALUE TWO.
           05  WS_FAB_SHR              PIC X(01).
           05  WS_FAB_CTX              PIC 9(09) COMP VALUE ZERO.
           05  WS_FAB_RTY              PIC X(01).
           05  WS_FAB_ORG              PIC X(01).
           05  WS_FAB_RAT              PIC X(01).
           05  WS_FAB_RFM              PIC X(01).
           05  WS_FAB_JNL              PIC 9(09) COMP.
           05  WS_FAB_XAB         POINTER VALUE REFERENCE WS_XAB.
           05  WS_FAB_NAM              PIC 9(09) COMP VALUE ZERO.
           05  WS_FAB_FNA         POINTER VALUE REFERENCE WS_FILE_SPEC.
           05  WS_FAB_DNA              PIC 9(09) COMP VALUE ZERO.
           05  WS_FAB_FNS              PIC X(01).
           05  WS_FAB_DNS              PIC X(01).
           05  WS_FAB_MRS              PIC 9(04).
           05  WS_FAB_MRN              PIC 9(09) COMP.
           05  WS_FAB_BLS              PIC 9(04) COMP.
           05  WS_FAB_BKS              PIC X(01).
           05  WS_FAB_FSZ              PIC X(01).
           05  WS_FAB_DEV              PIC 9(09) COMP.
           05  WS_FAB_SDC              PIC 9(09) COMP.
           05  WS_FAB_GBC              PIC 9(04) COMP.
           05  WS_FAB_DSOMSK           PIC X(01).
           05  WS_FAB_FILLER           PIC X(05).

       01  WS_RAB.
           05  WS_RAB_BID              PIC X(01) VALUE ONE.
           05  WS_RAB_BLN              PIC X(01) VALUE SIXTY-EIGHT.
           05  WS_RAB_ISI              PIC 9(04) COMP VALUE ZERO.
           05  WS_RAB_ROP              PIC 9(09) COMP.
           05  WS_RAB_STS              PIC 9(09) COMP.
           05  WS_RAB_STV              PIC 9(09) COMP.
           05  WS_RAB_RFA.
               10  WS_RAB_RFA_BLOCK_NUMBER
                                       PIC 9(09) COMP.
               10  WS_RAB_RFA_OFFSET_IN_BLOCK
                                       PIC 9(04) COMP.
           05  FILLER                  PIC 9(02).
           05  WS_RAB_CTX              PIC 9(09) COMP.
           05  FILLER                  PIC X(02).
           05  WS_RAB_RAC              PIC X(01).
           05  WS_RAB_TMO              PIC X(01).
           05  WS_RAB_USZ              PIC 9(04) COMP.
           05  WS_RAB_RSZ              PIC 9(04) COMP.
           05  WS_RAB_UBF              PIC 9(09) COMP.
           05  WS_RAB_RBF              PIC 9(09) COMP.
           05  WS_RAB_RHB              PIC 9(09) COMP.
           05  WS_RAB_K.
               10  WS_RAB_KBF     POINTER VALUE REFERENCE WS_KEY_BUFFER.
               10  WS_RAB_KSZ          PIC X(01).
           05  WS_RAB_P REDEFINES WS_RAB_K.
               10  WS_RAB_PBF          PIC 9(09) COMP.
               10  WS_RAB_PSZ          PIC X(01).
           05  WS_RAB_KRF              PIC X(01).
           05  WS_RAB_MBF              PIC X(01).
           05  WS_RAB_MBC              PIC X(01).
           05  WS_RAB_B.
               10  WS_RAB_BKT          PIC 9(09) COMP.
           05  WS_RAB_D REDEFINES WS_RAB_B.
               10  WS_RAB_DCT          PIC 9(09) COMP.
           05  WS_RAB_FAB         POINTER VALUE REFERENCE WS_FAB.
           05  WS_RAB_XAB              PIC 9(09) COMP VALUE 0.

       01  WS_XAB.
           02  WS_XAB_COD              PIC X(01) VALUE TWENTY-ONE.
           02  WS_XAB_BLN              PIC X(01) VALUE SEVENTY-SIX.
           02  FILLER                  PIC X(02).
           02  WS_XAB_NXT              PIC S9(09) COMP VALUE ZERO.
           02  WS_XAB_IAN              PIC X(01).
           02  WS_XAB_LAN              PIC X(01).
           02  WS_XAB_DAN              PIC X(01).
           02  FILLER                  PIC X(07).
           02  WS_XAB_FLG              PIC X(01).
           02  WS_XAB_DTP              PIC X(01).
           02  FILLER                  PIC X(01).
           02  WS_XAB_NUL              PIC X(01).
           02  FILLER                  PIC X(01).
           02  WS_XAB_REF              PIC X(01).
           02  FILLER                  PIC X(02).
           02  WS_XAB_IFL              PIC 9(04) COMP.
           02  WS_XAB_DFL              PIC 9(04) COMP.
           02  WS_XAB_POS0             PIC 9(04) COMP.
           02  WS_XAB_POS1             PIC 9(04) COMP.
           02  WS_XAB_POS2             PIC 9(04) COMP.
           02  WS_XAB_POS3             PIC 9(04) COMP.
           02  WS_XAB_POS4             PIC 9(04) COMP.
           02  WS_XAB_POS5             PIC 9(04) COMP.
           02  WS_XAB_POS6             PIC 9(04) COMP.
           02  WS_XAB_POS7             PIC 9(04) COMP.
           02  WS_XAB_SIZ0             PIC X(01).
           02  WS_XAB_SIZ1             PIC X(01).
           02  WS_XAB_SIZ2             PIC X(01).
           02  WS_XAB_SIZ3             PIC X(01).
           02  WS_XAB_SIZ4             PIC X(01).
           02  WS_XAB_SIZ5             PIC X(01).
           02  WS_XAB_SIZ6             PIC X(01).
           02  WS_XAB_SIZ7             PIC X(01).
           02  FILLER                  PIC X(02).
           02  WS_XAB_KNM         POINTER VALUE REFERENCE WS_KEY_NAME.
           02  FILLER                  PIC X(12).
           02  WS_XAB_PROLOG           PIC X(01).
           02  WS_XAB_FILLER           PIC X(03).

       01  WS_KEY_NAME                 PIC X(32).
       01  WS_KEY_BUFFER               PIC X(255).
       01  FILLER REDEFINES WS_KEY_BUFFER.
           02  WS_REL_REC_NUMBER       PIC 9(09)  COMP.
           02  FILLER                  PIC X(251).
       01  WS_FILE_SPEC                PIC X(255).
       01  WS_FILE_SPEC_LENGTH         PIC S9(09) COMP.
       01  WS_STATUS                   PIC S9(09) COMP.
       01  WS_DISPLAY_STATUS           PIC 9(09).
       01  WS_GET_BUFFER.
           02  GET_BUFFER_CHAR         PIC X(01) OCCURS 5600 TIMES.
       01  WS_UBF_POINTER         POINTER VALUE REFERENCE WS_GET_BUFFER.
       01  STAT                        PIC S9(09) COMP.
       01  FILLER.
           02  FAB$C_IDX               PIC S9(04) COMP VALUE 32.
           02  FAB$C_REL               PIC S9(04) COMP VALUE 16.
           02  FAB$C_SEQ               PIC S9(04) COMP VALUE 0.
           02  LIB$_NOSUCHSYM          PIC S9(09) COMP VALUE 001409892.
           02  FILE-COUNT              PIC 9(01)  VALUE 0.
           02  GET_FILE                PIC X(01)  VALUE "N".
           02  FILE-TYPE               PIC X(01).
               88  INDX                    VALUE "I".
               88  SEQ                     VALUE "S".
               88  REL                     VALUE "R".
           02  FAB$V_SHRPUT            PIC S9(04) COMP VALUE 1.
           02  FAB$V_SHRGET            PIC S9(04) COMP VALUE 2.
           02  FAB$V_SHRDEL            PIC S9(04) COMP VALUE 4.
           02  FAB$V_SHRUPD            PIC S9(04) COMP VALUE 8.
           02  FAB$V_UPI               PIC S9(04) COMP VALUE 64.
           02  FAB$C_FIX               PIC S9(04) COMP VALUE 1.
           02  RECORD_FORMAT           PIC 9(04).
               88  FIX                     VALUE 1.
               88  VAR                     VALUE 2.
           02  RAB$V_KGE               PIC S9(09) COMP VALUE 2097152.
           02  RAB$V_NLK               PIC S9(09) COMP VALUE 1048576.
           02  RAB$V_RRL               PIC S9(09) COMP VALUE 8.
           02  BINARY-WORD             PIC S9(04) COMP.
           02  FILLER REDEFINES BINARY-WORD.
               03  BINARY-VALUE        PIC X(01).
               03  BINARY-FILLER       PIC X(01).
           02  ITMLST.
               03  FILLER              PIC S9(04) COMP VALUE 255.
               03  FILLER              PIC S9(04) COMP VALUE 2.
               03  FILLER         POINTER VALUE REFERENCE WS_FILE_SPEC.
               03  FILLER         POINTER VALUE REFERENCE
                                                    WS_FILE_SPEC_LENGTH.
               03  FILLER              PIC S9(09) COMP VALUE 0.
           02  FILELST.
               03  FILLER              PIC S9(04) COMP VALUE 255.
               03  FILLER              PIC S9(04) COMP VALUE 2.
               03  FILLER         POINTER VALUE REFERENCE FILE-NAME.
               03  FILLER         POINTER VALUE REFERENCE
                                                    FILE-NAME-LENGTH.
               03  FILLER              PIC S9(09) COMP VALUE 0.
           02  USERLST.
               03  FILLER               PIC S9(04) COMP VALUE 12.
               03  FILLER               PIC S9(04) COMP VALUE EXTERNAL
                                                          JPI$_USERNAME.
               03  FILLER               POINTER VALUE REFERENCE
                                                              WUSERNAME.
               03  FILLER               POINTER VALUE REFERENCE
                                                        USERNAME-LENGTH.
               03  FILLER               PIC S9(09) COMP VALUE 0.
           02  USERNAME-LENGTH          PIC S9(04) COMP.
           02  WUSERNAME.
               03  USER-CHAR            PIC X(01) OCCURS 12 TIMES.
           02  WS_KEY_OF_REF            PIC X(02).
           02  KEY-OF-REFERENCE        PIC 9(02).
           02  WS_MAX_KEY              PIC X(255).
           02  WS_FIRST_X              PIC X(08).
           02  WS_FIRST_RECORD         PIC 9(08).
           02  WS_MAX_X                PIC X(08).
           02  WS_MAX_RECORD           PIC 9(08).
           02  KEY-POSITION            PIC 9(04).
           02  KEY-LENGTH              PIC 9(04).
           02  HEX-LINE.
               03  INFILE-RECNUM       PIC 9(08).
               03  FILLER              PIC X(04).
               03  HEX-DCHAR           PIC X(02) OCCURS 50 TIMES.
           02  ALPHA-LINE.
               03  FILLER              PIC X(12).
               03  FILLER OCCURS 50 TIMES.
                   04  FILLER          PIC X(01).
                   04  ALPHA-DCHAR     PIC X(01).
           02  IN-CHAR                 PIC X(01).
           02  SUBX                    PIC 9(05).
           02  HEX-CHAR                PIC X(02).
           02  OUTPUT-COUNT            PIC 9(03).
           02  INFILE-REC-COUNT        PIC 9(08).
           02  LOG-NAME                PIC X(04) VALUE "PRT2".
           02  LOGNAME-ITMLST.
               03  EQUIVNAME-BUFFER-LENGTH
                                       PIC S9(04) COMP VALUE 80.
               03  FILLER              PIC S9(04) COMP VALUE 2.
               03  FILLER         POINTER VALUE REFERENCE FILE-NAME.
               03  FILLER         POINTER VALUE REFERENCE 
                                                       FILE-NAME-LENGTH.
               03  FILLER              PIC S9(09) COMP VALUE 0.
           02  PRINT-FLD.
               03  FILLER              PIC X(19)
                                     VALUE "PRINT/DELETE/FORMS=".
               03  WIDE_FORM           PIC X(20).
               03  FILE-NAME           PIC X(80).
           02  OTHER-QUEUE-PRINT-FLD.
               03  FILLER              PIC X(19)
                                            VALUE "PRINT/DELETE/FORMS=".
               03  NARROW_FORM         PIC X(20).
               03  FILLER              PIC X(07) VALUE "/QUEUE=".
               03  WHAT_QUE            PIC X(31).
               03  FILLER              PIC X(01) VALUE " ".
               03  OQPF-FILE-NAME      PIC X(80).
           02  FILE-NAME-LENGTH        PIC S9(09) COMP VALUE 0.
           02  DELETE-FLD.
               03  FILLER              PIC X(07)
                                     VALUE "DELETE ".
               03  DELETE-FILE.
                   04  DELETE-CHAR     PIC X(01) OCCURS 80 TIMES.
           02  DELETE-NAME-LENGTH      PIC S9(09) COMP VALUE 0.
           02  REPLY                   PIC X(31).
               88  YEA                     VALUE "Y"
                                                 "y"
                                                 "YES"
                                                 "yes".
               88  NEA                     VALUE " "
                                                 "N"
                                                 "n"
                                                 "NO"
                                                 "no".

       01  DISPLAY_QUEUE               PIC S9(09) COMP VALUE 6.
       01  IOSB.
           02  FILLER                            OCCURS 2 TIMES.
               03  IOSB-LONGWORD       PIC 9(09) COMP.
       01  JBC$_NOMOREQUE              PIC S9(09) COMP VALUE 295338.
       01  QUE_ITMLST.
           02  FILLER                  PIC S9(04) COMP VALUE 31.
           02  FILLER                  PIC S9(04) COMP VALUE 77.
           02  FILLER                  POINTER VALUE REFERENCE
                                                            SEARCH_NAME.
           02  FILLER                  POINTER VALUE REFERENCE
                                                     SEARCH_NAME_LENGTH.

           02  FILLER                  PIC S9(04) COMP VALUE 4.
           02  FILLER                  PIC S9(04) COMP VALUE 76.
           02  FILLER                  POINTER VALUE REFERENCE
                                                           SEARCH_FLAGS.
           02  FILLER                  POINTER VALUE REFERENCE
                                                    SEARCH_FLAGS_LENGTH.

           02  FILLER                  PIC S9(04) COMP VALUE 31.
           02  FILLER                  PIC S9(04) COMP VALUE 31.
           02  FILLER                  POINTER VALUE REFERENCE
                                                              FORM_NAME.
           02  FILLER                  POINTER VALUE REFERENCE
                                                       FORM_NAME_LENGTH.

           02  FILLER                  PIC S9(04) COMP VALUE 31.
           02  FILLER                  PIC S9(04) COMP VALUE 70.
           02  FILLER                  POINTER VALUE REFERENCE
                                                             QUEUE_NAME.
           02  FILLER                  POINTER VALUE REFERENCE
                                                      QUEUE_NAME_LENGTH.

           02  FILLER                  PIC S9(04) COMP VALUE 4.
           02  FILLER                  PIC S9(04) COMP VALUE 71.
           02  FILLER                  POINTER VALUE REFERENCE
                                                           QUEUE_STATUS.
           02  FILLER                  POINTER VALUE REFERENCE
                                                    QUEUE_STATUS_LENGTH.

           02  FILLER                  PIC S9(09) COMP VALUE 0.
       01  SEARCH_NAME                 PIC X(31).
       01  SEARCH_NAME_LENGTH          PIC S9(09)    COMP VALUE 0.
       01  SEARCH_FLAGS                PIC 9(09)     COMP VALUE 0.
       01  SEARCH_FLAGS_LENGTH         PIC S9(09)    COMP VALUE 0.
       01  FORM_NAME                   PIC X(31).
       01  FORM_NAME_LENGTH            PIC S9(09)    COMP.
       01  QUEUE_NAME                  PIC X(31).
       01  QUEUE_NAME_LENGTH           PIC S9(09)    COMP.
       01  QUEUE_STATUS                PIC 9(09)     COMP.
       01  QUEUE_STATUS_LENGTH         PIC S9(09)    COMP.
       01  QTYPE                       PIC X(05)     VALUE " ".
       01  QUEUE_OK                    PIC X(03)     VALUE " ".

       01  TIMBUF                      PIC X(13).
       01  TBL-IND                     PIC S9(09)          COMP
                                   VALUE EXTERNAL LIB$K_CLI_GLOBAL_SYM.
       01  SPECIAL-EFFECTS.
           02  DWIDE.
               03  FILLER                PIC S9(04) COMP VALUE 27.
               03  FILLER                PIC S9(04) COMP VALUE 35.
               03  FILLER                PIC S9(04) COMP VALUE 54.
           02  CLR.
               03  FILLER                PIC S9(04) COMP VALUE 27.
               03  FILLER                PIC S9(04) COMP VALUE 91.
               03  FILLER                PIC S9(04) COMP VALUE 50.
               03  FILLER                PIC S9(04) COMP VALUE 74.
           02  HOME.
               03  FILLER                PIC S9(04) COMP VALUE 27.
               03  FILLER                PIC S9(04) COMP VALUE 91.
               03  FILLER                PIC S9(04) COMP VALUE 48.
               03  FILLER                PIC S9(04) COMP VALUE 59.
               03  FILLER                PIC S9(04) COMP VALUE 48.
               03  FILLER                PIC S9(04) COMP VALUE 72.
           02  WBOLD.
               03  FILLER                PIC S9(04) COMP VALUE 27.
               03  FILLER                PIC S9(04) COMP VALUE 91.
               03  FILLER                PIC S9(04) COMP VALUE 49.
               03  FILLER                PIC S9(04) COMP VALUE 109.
           02  SINGLE-WIDTH.
               03  FILLER                PIC S9(04) COMP VALUE 27.
               03  FILLER                PIC S9(04) COMP VALUE 35.
               03  FILLER                PIC S9(04) COMP VALUE 53.
           02  DOUBLE-WIDTH.
               03  FILLER                PIC S9(04) COMP VALUE 27.
               03  FILLER                PIC S9(04) COMP VALUE 35.
               03  FILLER                PIC S9(04) COMP VALUE 54.
           02  REVERSE.
               03  FILLER                PIC S9(04) COMP VALUE 27.
               03  FILLER                PIC S9(04) COMP VALUE 91.
               03  FILLER                PIC S9(04) COMP VALUE 55.
               03  FILLER                PIC S9(04) COMP VALUE 109.
           02  132-WIDE.
               03  FILLER                PIC S9(04) COMP VALUE 27.
               03  FILLER                PIC S9(04) COMP VALUE 91.
               03  FILLER                PIC S9(04) COMP VALUE 63.
               03  FILLER                PIC S9(04) COMP VALUE 51.
               03  FILLER                PIC S9(04) COMP VALUE 104.
           02  80-WIDE.
               03  FILLER                PIC S9(04) COMP VALUE 27.
               03  FILLER                PIC S9(04) COMP VALUE 91.
               03  FILLER                PIC S9(04) COMP VALUE 63.
               03  FILLER                PIC S9(04) COMP VALUE 51.
               03  FILLER                PIC S9(04) COMP VALUE 108.
           02  CLR-ATT.
               03  FILLER                PIC S9(04) COMP VALUE 27.
               03  FILLER                PIC S9(04) COMP VALUE 91.
               03  FILLER                PIC S9(04) COMP VALUE 48.
               03  FILLER                PIC S9(04) COMP VALUE 109.
           02  WHOLE-SCROLL.
               03  FILLER                PIC S9(04) COMP VALUE 27.
               03  FILLER                PIC S9(04) COMP VALUE 91.
               03  FILLER                PIC S9(04) COMP VALUE 48.
               03  FILLER                PIC S9(04) COMP VALUE 59.
               03  FILLER                PIC S9(04) COMP VALUE 50.
               03  FILLER                PIC S9(04) COMP VALUE 52.
               03  FILLER                PIC S9(04) COMP VALUE 114.
               03  FILLER                PIC S9(04) COMP VALUE 27.
               03  FILLER                PIC S9(04) COMP VALUE 91.
               03  FILLER                PIC S9(04) COMP VALUE 51.
               03  FILLER                PIC S9(04) COMP VALUE 59.
               03  FILLER                PIC S9(04) COMP VALUE 48.
               03  FILLER                PIC S9(04) COMP VALUE 72.
           02  BOTTOM-SCROLL.
               03  FILLER                PIC S9(04) COMP VALUE 27.
               03  FILLER                PIC S9(04) COMP VALUE 91.
               03  FILLER                PIC S9(04) COMP VALUE 52.
               03  FILLER                PIC S9(04) COMP VALUE 59.
               03  FILLER                PIC S9(04) COMP VALUE 50.
               03  FILLER                PIC S9(04) COMP VALUE 52.
               03  FILLER                PIC S9(04) COMP VALUE 114.
               03  FILLER                PIC S9(04) COMP VALUE 27.
               03  FILLER                PIC S9(04) COMP VALUE 91.
               03  FILLER                PIC S9(04) COMP VALUE 51.
               03  FILLER                PIC S9(04) COMP VALUE 59.
               03  FILLER                PIC S9(04) COMP VALUE 48.
               03  FILLER                PIC S9(04) COMP VALUE 72.
           02  BOTTOM-SCROLL3.
               03  FILLER                PIC S9(04) COMP VALUE 27.
               03  FILLER                PIC S9(04) COMP VALUE 91.
               03  FILLER                PIC S9(04) COMP VALUE 51.
               03  FILLER                PIC S9(04) COMP VALUE 59.
               03  FILLER                PIC S9(04) COMP VALUE 50.
               03  FILLER                PIC S9(04) COMP VALUE 52.
               03  FILLER                PIC S9(04) COMP VALUE 114.
               03  FILLER                PIC S9(04) COMP VALUE 27.
               03  FILLER                PIC S9(04) COMP VALUE 91.
               03  FILLER                PIC S9(04) COMP VALUE 51.
               03  FILLER                PIC S9(04) COMP VALUE 59.
               03  FILLER                PIC S9(04) COMP VALUE 48.
               03  FILLER                PIC S9(04) COMP VALUE 72.
       PROCEDURE DIVISION.
       BEGIN.
           OPEN OUTPUT PR_DISPLAY.
           MOVE " " TO FILE-TYPE.
           MOVE " " TO WUSERNAME.
           CALL "SYS$GETJPI" USING BY VALUE 0
                                   BY VALUE 0
                                   BY VALUE 0
                                   BY REFERENCE USERLST
                                   BY VALUE 0
                                   BY VALUE 0
                                   BY VALUE 0
                             GIVING STAT.
           MOVE 12 TO USERNAME-LENGTH.
           PERFORM UNTIL USER-CHAR (USERNAME-LENGTH) NOT = " "
               SUBTRACT 1 FROM USERNAME-LENGTH
           END-PERFORM.
           CALL "LIB$GET_SYMBOL" USING BY DESCRIPTOR "FILETYPE"
                                       BY DESCRIPTOR FILE-TYPE
                                       BY VALUE 0
                                       BY REFERENCE TBL-IND
                          GIVING STAT.
           CALL "LIB$GET_SYMBOL" USING BY DESCRIPTOR "PRF_COUNT"
                                       BY DESCRIPTOR FILE-COUNT
                                       BY VALUE 0
                                       BY REFERENCE TBL-IND
                          GIVING STAT.
           CALL "LIB$GET_SYMBOL" USING BY DESCRIPTOR "WIDE_FORM"
                                       BY DESCRIPTOR WIDE_FORM
                                       BY VALUE 0
                                       BY REFERENCE TBL-IND
                          GIVING STAT.
           CALL "LIB$GET_SYMBOL" USING BY DESCRIPTOR "NARROW_FORM"
                                       BY DESCRIPTOR NARROW_FORM
                                       BY VALUE 0
                                       BY REFERENCE TBL-IND
                          GIVING STAT.
           CALL "SYS$TRNLNM" USING BY VALUE 0
                                   BY DESCRIPTOR "LNM$PROCESS_TABLE"
                                   BY DESCRIPTOR "INFILE"
                                   BY VALUE 0
                                   BY REFERENCE ITMLST
                             GIVING STAT.
           IF STAT IS FAILURE
               CALL "LIB$STOP" USING BY VALUE STAT.
           MOVE WS_FILE_SPEC_LENGTH TO BINARY-WORD.
           MOVE BINARY-VALUE TO WS_FAB_FNS.
           MOVE " " TO WS_KEY_OF_REF.
           IF NOT INDX
               GO TO OPEN-FILE.
           CALL "LIB$GET_SYMBOL" USING BY DESCRIPTOR "KEY_OF_REF"
                                       BY DESCRIPTOR KEY-OF-REFERENCE
                                       BY VALUE 0
                                       BY REFERENCE TBL-IND
                          GIVING STAT.
           IF STAT = LIB$_NOSUCHSYM
               NEXT SENTENCE
           ELSE
               GO TO OPEN-FILE.
       GET-KEY-OF-REFERENCE.
           MOVE 0 TO KEY-OF-REFERENCE.
           DISPLAY " ".
           DISPLAY "Enter key of reference: [key 0] "
                                                      WITH NO ADVANCING.
           ACCEPT WS_KEY_OF_REF.
           IF WS_KEY_OF_REF = "."
               GO TO E-O-J.
           IF WS_KEY_OF_REF = " "
               NEXT SENTENCE
           ELSE
               MOVE WS_KEY_OF_REF TO ENTERED-NUMBER
               MOVE 00 TO EDIT-COMMAND
               PERFORM EDIT-RTN THRU EDIT-RTN-EXIT
               IF GOOD-BAD = "B"
                   DISPLAY " "
                   DISPLAY WBOLD
                           "**** INVALID KEY OF REFERENCE ENTRY ****"
                           CLR-ATT
                   GO TO GET-KEY-OF-REFERENCE
               ELSE
                   MOVE GOOD-NUMBER TO KEY-OF-REFERENCE.
           CALL "LIB$SET_SYMBOL" USING BY DESCRIPTOR "KEY_OF_REF"
                                       BY DESCRIPTOR KEY-OF-REFERENCE
                                       BY REFERENCE TBL-IND
                                 GIVING STAT.
       OPEN-FILE.
           IF SEQ
               MOVE FAB$V_SHRGET TO BINARY-WORD
               MOVE BINARY-VALUE TO WS_FAB_SHR
           ELSE
               ADD FAB$V_SHRDEL
                   FAB$V_SHRGET
                   FAB$V_SHRPUT
                   FAB$V_SHRUPD GIVING BINARY-WORD
               MOVE BINARY-VALUE TO WS_FAB_SHR.
           MOVE KEY-OF-REFERENCE TO BINARY-WORD.
           MOVE BINARY-VALUE TO WS_XAB_REF.
*******************     O P E N I N G    F I L E     *******************
           CALL "SYS$OPEN" USING BY REFERENCE WS_FAB
                           GIVING WS_STATUS.
           IF WS_STATUS IS FAILURE
               MOVE WS_STATUS TO WS_DISPLAY_STATUS
               IF WS_DISPLAY_STATUS = 100188
                   DISPLAY " "
                   DISPLAY WBOLD
                           "**** INVALID KEY OF REFERENCE ENTRY ****"
                           CLR-ATT
                   GO TO GET-KEY-OF-REFERENCE
               ELSE
                   IF WS_DISPLAY_STATUS = 98954
                       DISPLAY " "
                       DISPLAY WBOLD
                               "***** FILE CURRENTLY LOCKED BY ANOTHER
      -                                                    " USER *****"
                               CLR-ATT
                       DISPLAY " "
                       MOVE "Y" TO GET_FILE
                       CALL "LIB$SET_SYMBOL" USING 
                                                BY DESCRIPTOR "GET_FILE"
                                                BY DESCRIPTOR GET_FILE
                                                BY REFERENCE TBL-IND
                                             GIVING STAT
                       GO TO E-O-J
                   END-IF
                   IF WS_DISPLAY_STATUS = 98962
                       DISPLAY " "
                       DISPLAY WBOLD
                               "***** FILE NOT FOUND *****"
                               CLR-ATT
                       DISPLAY " "
                       MOVE "Y" TO GET_FILE
                       CALL "LIB$SET_SYMBOL" USING 
                                                BY DESCRIPTOR "GET_FILE"
                                                BY DESCRIPTOR GET_FILE
                                                BY REFERENCE TBL-IND
                                             GIVING STAT
                       GO TO E-O-J
                   END-IF
                   IF WS_DISPLAY_STATUS = 100052
                       DISPLAY " "
                       DISPLAY WBOLD
                               "***** FILENAME SYNTAX ERROR *****"
                               CLR-ATT
                       DISPLAY " "
                       MOVE "Y" TO GET_FILE
                       CALL "LIB$SET_SYMBOL" USING 
                                                BY DESCRIPTOR "GET_FILE"
                                                BY DESCRIPTOR GET_FILE
                                                BY REFERENCE TBL-IND
                                             GIVING STAT
                       GO TO E-O-J
                   END-IF
                   DISPLAY " OPEN STATUS = " WS_DISPLAY_STATUS
                   CALL "LIB$STOP" USING BY VALUE WS_STATUS.
*******************     C O N N E C T    R A B     *******************
           IF REL OR SEQ
               MOVE FOUR TO WS_RAB_KSZ.
           IF INDX
               MOVE WS_XAB_SIZ0 TO WS_RAB_KSZ
               MOVE KEY-OF-REFERENCE TO BINARY-WORD
               MOVE BINARY-VALUE TO WS_RAB_KRF
               ADD RAB$V_KGE RAB$V_NLK RAB$V_RRL GIVING WS_RAB_ROP.
           CALL "SYS$CONNECT" USING BY REFERENCE WS_RAB
                              GIVING WS_STATUS.
           IF WS_STATUS IS FAILURE
               MOVE WS_STATUS TO WS_DISPLAY_STATUS
               IF WS_DISPLAY_STATUS = 100188
                   DISPLAY " "
                   DISPLAY WBOLD
                           "**** INVALID KEY OF REFERENCE ENTRY ****"
                           CLR-ATT
                   GO TO GET-KEY-OF-REFERENCE
               ELSE
                   DISPLAY " OPEN STATUS = " WS_DISPLAY_STATUS
                   CALL "LIB$STOP" USING BY VALUE WS_STATUS.
           IF REL OR SEQ
               GO TO GET-RECORD-NUMBERS.
           ADD 1 WS_XAB_POS0 GIVING KEY-POSITION.
           MOVE 00 TO BINARY-WORD.
           MOVE WS_XAB_SIZ0 TO BINARY-VALUE.
           MOVE BINARY-WORD TO KEY-LENGTH.
           DISPLAY " ".
           DISPLAY " Key " KEY-OF-REFERENCE " has a maximum length of "
                                                             KEY-LENGTH.
       GET-KEY-VALUES.
           MOVE " " TO WS_KEY_BUFFER
                       WS_MAX_KEY.
           DISPLAY " ".
           DISPLAY "Enter starting key value: [begin] "
                                                      WITH NO ADVANCING.
           ACCEPT WS_KEY_BUFFER.
           IF WS_KEY_BUFFER = "."
               CALL "SYS$CLOSE" USING BY REFERENCE WS_FAB
                                GIVING WS_STATUS
               IF WS_STATUS IS FAILURE
                   CALL "LIB$STOP" USING BY VALUE WS_STATUS
               END-IF
               GO TO GET-KEY-OF-REFERENCE.
           DISPLAY " ".
           DISPLAY "Enter maximum value: [one record] "
                                                      WITH NO ADVANCING.
           ACCEPT WS_MAX_KEY.
           IF WS_MAX_KEY = "."
               CALL "SYS$CLOSE" USING BY REFERENCE WS_FAB
                                GIVING WS_STATUS
               IF WS_STATUS IS FAILURE
                   CALL "LIB$STOP" USING BY VALUE WS_STATUS
               END-IF
               GO TO GET-KEY-OF-REFERENCE.
           IF WS_MAX_KEY = " "
               MOVE WS_KEY_BUFFER TO WS_MAX_KEY.
           IF WS_KEY_BUFFER = " "
                   AND WS_MAX_KEY = " "
               CALL "SYS$CLOSE" USING BY REFERENCE WS_FAB
                                GIVING WS_STATUS
               IF WS_STATUS IS FAILURE
                   CALL "LIB$STOP" USING BY VALUE WS_STATUS
               END-IF
               GO TO GET-KEY-OF-REFERENCE.
           ADD RAB$V_KGE RAB$V_NLK RAB$V_RRL GIVING WS_RAB_ROP.
           GO TO FILE-READ.
       GET-RECORD-NUMBERS.
           MOVE " " TO WS_FIRST_X
                       WS_MAX_X.
           MOVE 0 TO WS_FIRST_RECORD
                     WS_MAX_RECORD.
           DISPLAY " ".
           DISPLAY "Enter starting record number: [begin] "
                                                      WITH NO ADVANCING.
           ACCEPT WS_FIRST_X.
           IF WS_FIRST_X = "."
               GO TO E-O-J.
           IF WS_FIRST_X = " "
               MOVE 1 TO WS_FIRST_RECORD
           ELSE
               MOVE WS_FIRST_X TO ENTERED_NUMBER
               MOVE 00 TO EDIT-COMMAND
               PERFORM EDIT-RTN THRU EDIT-RTN-EXIT
               IF GOOD-BAD = "B"
                   DISPLAY " "
                   DISPLAY WBOLD
                           "**** BAD STARTING RECORD NUMBER ENTRY ****"
                           CLR-ATT
                   GO TO GET-RECORD-NUMBERS
               ELSE
                   MOVE GOOD-NUMBER TO WS_FIRST_RECORD.
           MOVE WS_FIRST_RECORD TO WS_REL_REC_NUMBER.
         GET-LAST-RECORD.
           DISPLAY " ".
           DISPLAY "Enter maximum value: [one record] "
                                                      WITH NO ADVANCING.
           ACCEPT WS_MAX_X.
           IF WS_MAX_X = "."
               GO TO E-O-J.
           IF WS_MAX_X = " "
               MOVE WS_FIRST_RECORD TO WS_MAX_RECORD
           ELSE
               MOVE WS_MAX_X TO ENTERED-NUMBER
               MOVE 00 TO EDIT-COMMAND
               PERFORM EDIT-RTN THRU EDIT-RTN-EXIT
               IF GOOD-BAD = "B"
                   DISPLAY " "
                   DISPLAY WBOLD
                           "**** BAD MAXIMUM RECORD NUMBER ENTRY ****"
                           CLR-ATT
                   GO TO GET-LAST-RECORD
               ELSE
                   MOVE GOOD-NUMBER TO WS_MAX_RECORD.
           IF WS_FIRST_RECORD = 0
                   AND WS_MAX_RECORD = 0
               GO TO E-O-J.
           GO TO FILE-READ.
       E-O-J.
           CLOSE PR_DISPLAY.
           STOP RUN.
       FILE-READ.
           ADD 1 TO FILE-COUNT
           CALL "LIB$SET_SYMBOL" USING BY DESCRIPTOR "PRF_COUNT"
                                       BY DESCRIPTOR FILE-COUNT
                                       BY REFERENCE TBL-IND
                          GIVING STAT.
           MOVE " " TO FILE-NAME.
           STRING "SYS$LOGIN:"
                  WUSERNAME (1:USERNAME-LENGTH)
                  "_PRF_"
                  FILE-COUNT
                  ".LIS" DELIMITED BY SIZE INTO FILE-NAME.
           CALL "SYS$CRELNM" USING BY VALUE 0
                                   BY DESCRIPTOR "LNM$JOB"
                                   BY DESCRIPTOR LOG-NAME
                                   BY VALUE 0
                                   BY REFERENCE LOGNAME-ITMLST
                             GIVING STAT.
           IF STAT IS FAILURE
               CALL "LIB$STOP" USING BY VALUE STAT.
           DISPLAY CLR.
           DISPLAY 132-WIDE.
           DISPLAY HOME.
           MOVE WS_UBF_POINTER TO WS_RAB_UBF.
           MOVE 5600 TO WS_RAB_USZ.
           MOVE ZEERO TO WS_RAB_RAC.
           MOVE 00 TO BINARY-WORD.
           MOVE WS_FAB_RFM TO BINARY-VALUE.
           MOVE BINARY-WORD TO RECORD_FORMAT.
           MOVE 1 TO INFILE-REC-COUNT.
           IF INDX OR REL OR FIX
               MOVE ONE TO WS_RAB_RAC.
           IF NOT INDX
               MOVE WS_FIRST_RECORD TO INFILE-REC-COUNT.
           OPEN OUTPUT PR_PRINT.
*******************      R E A D    R E C O R D      *******************
       READ-REC.
           CALL "SYS$GET" USING BY REFERENCE WS_RAB
                          GIVING WS_STATUS.
           MOVE WS_STATUS TO WS_DISPLAY_STATUS.
           IF WS_DISPLAY_STATUS = 98938
                   OR WS_DISPLAY_STATUS = 98994
               GO TO READ-REC-EXIT.
           IF WS_STATUS IS FAILURE
               DISPLAY "GET STATUS = " WS_DISPLAY_STATUS
               CALL "LIB$STOP" USING BY VALUE WS_STATUS.
           IF INDX
               IF WS_GET_BUFFER (KEY-POSITION:KEY-LENGTH) >
                                               WS_MAX_KEY (1:KEY-LENGTH)
                   GO TO READ-REC-EXIT.
           IF REL OR SEQ
               IF INFILE-REC-COUNT < WS_FIRST_RECORD
                   GO TO READ_REC
               END-IF
               IF INFILE-REC-COUNT > WS_MAX_RECORD
                   GO TO READ-REC-EXIT.
           MOVE " " TO HEX-LINE.
           MOVE " " TO ALPHA-LINE.
           MOVE 0 TO OUTPUT-COUNT.
           MOVE INFILE-REC-COUNT TO INFILE-RECNUM.
           PERFORM CONVERT-RTN THRU CONVERT-RTN-EXIT
                  VARYING SUBX FROM 1 BY 1 UNTIL SUBX > WS_RAB_RSZ.
           IF OUTPUT-COUNT NOT = 0
               PERFORM PRINT-RTN THRU PRINT-RTN-EXIT.
           MOVE ZEERO TO WS_RAB_RAC.
           ADD 1 TO INFILE-REC-COUNT.      
           GO TO READ-REC.
       READ-REC-EXIT.
           CLOSE PR_PRINT.
           CALL "SYS$DELLNM" USING BY DESCRIPTOR "LNM$JOB"
                                   BY DESCRIPTOR LOG-NAME
                                   BY VALUE 0
                             GIVING STAT.
           IF INFILE-REC-COUNT = 0
               DISPLAY " "
               IF INDX
                   DISPLAY "    NO RECORDS FOUND FOR KEY VALUES GIVEN. "
               ELSE
                   DISPLAY "    NO RECORDS FOUND FOR RECORD NUMBER RANGE
      -                                                      " GIVEN. "
               END-IF
               MOVE "0 00:00:03.00" TO TIMBUF
               CALL "WASTE_TIME" USING TIMBUF
               PERFORM DELETE-FILE-RTN THRU DELETE-FILE-EXIT
               GO TO CLOSE-FILE.
       ASK-FOR-PRINT-REPLY.
           MOVE " " TO REPLY.
           DISPLAY DOUBLE-WIDTH WITH NO ADVANCING.
           DISPLAY "DO YOU WANT TO PRINT THESE RECORDS? "
                                                      WITH NO ADVANCING.
           ACCEPT REPLY.
      *     CALL "SYS$TRNLNM" USING BY VALUE 0
      *                             BY DESCRIPTOR "LNM$PROCESS_TABLE"
      *                             BY DESCRIPTOR "PRT2"
      *                             BY VALUE 0
      *                             BY REFERENCE FILELST
      *                       GIVING STAT.
           IF YEA
               CALL "LIB$SPAWN" USING BY DESCRIPTOR PRINT-FLD
                                      BY VALUE 0 0 0 0 0 0 0
                                GIVING STAT
               IF STAT IS FAILURE
                   CALL "LIB$STOP" USING BY VALUE STAT.
           IF NEA
               PERFORM DELETE-FILE-RTN THRU DELETE-FILE-EXIT.
           IF NOT YEA AND NOT NEA
               MOVE REPLY TO WHAT_QUE
               PERFORM QUEUE-CHECK-RTN THRU QUEUE-CHECK-RTN-EXIT
               IF QUEUE_OK = "NO"
                   DISPLAY " " 
                   GO TO ASK-FOR-PRINT-REPLY.
       CLOSE-FILE.
           DISPLAY CLR.
           DISPLAY 80-WIDE.
           DISPLAY HOME.
           CALL "SYS$CLOSE" USING BY REFERENCE WS_FAB
                            GIVING WS_STATUS.
           IF WS_STATUS IS FAILURE
               CALL "LIB$STOP" USING BY VALUE WS_STATUS.
           DISPLAY DWIDE "  " WBOLD "***** PRINT OF FILE UTILITY *****"
                                                               CLR-ATT.
           GO TO OPEN-FILE.

       CONVERT-RTN.
           MOVE GET_BUFFER_CHAR (SUBX) TO IN-CHAR.
           CALL "OTS$CVT_L_TZ" USING BY REFERENCE IN-CHAR
                                     BY DESCRIPTOR HEX-CHAR
                                     BY VALUE 2
                                     BY VALUE 1
                               GIVING STAT.
           IF STAT IS FAILURE
               CALL "LIB$STOP" USING BY VALUE STAT.
           ADD 1 TO OUTPUT-COUNT.
           MOVE HEX-CHAR TO HEX-DCHAR (OUTPUT-COUNT).
           IF HEX-CHAR < 20 OR HEX-CHAR > "7F"
               NEXT SENTENCE
           ELSE
               MOVE IN-CHAR TO ALPHA-DCHAR (OUTPUT-COUNT).
           IF OUTPUT-COUNT = 50
               PERFORM PRINT-RTN THRU PRINT-RTN-EXIT.
       CONVERT-RTN-EXIT.
           EXIT.
       PRINT-RTN.
           WRITE PRINT-LINE FROM HEX-LINE AFTER 2.
           WRITE PRINT-LINE FROM ALPHA-LINE AFTER 1.
           WRITE DISPLAY-LINE FROM HEX-LINE AFTER 2.
           WRITE DISPLAY-LINE FROM ALPHA-LINE AFTER 1.
           MOVE " " TO HEX-LINE.
           MOVE " " TO ALPHA-LINE.
           MOVE 0 TO OUTPUT-COUNT.
       PRINT-RTN-EXIT.
           EXIT.
       DELETE-FILE-RTN.
           MOVE FILE-NAME TO DELETE-FILE.
           MOVE 80 TO DELETE-NAME-LENGTH.
           PERFORM UNTIL DELETE-CHAR (DELETE-NAME-LENGTH) NOT = " "
               SUBTRACT 1 FROM DELETE-NAME-LENGTH
           END-PERFORM.
           ADD 1 TO DELETE-NAME-LENGTH.
           MOVE ";" TO DELETE-CHAR (DELETE-NAME-LENGTH).
           CALL "LIB$SPAWN" USING BY DESCRIPTOR DELETE-FLD
                                  BY VALUE 0 0 0 0 0 0 0
                            GIVING STAT.
           IF STAT IS FAILURE
               CALL "LIB$STOP" USING BY VALUE STAT.
       DELETE-FILE-EXIT.
           EXIT.
       QUEUE-CHECK-RTN.
           MOVE "NO" TO QUEUE_OK.
           MOVE 8 TO SEARCH_FLAGS.
           MOVE "*" TO SEARCH_NAME.
         START-SEARCHING.
           CALL "SYS$GETQUIW" USING BY VALUE 0
                                   BY VALUE DISPLAY_QUEUE
                                   BY VALUE 0
                                   BY REFERENCE QUE_ITMLST
                                   BY REFERENCE IOSB
                                   BY VALUE 0 0
                             GIVING STAT.
           IF STAT IS FAILURE
               CALL "LIB$STOP" USING BY VALUE STAT.
           IF IOSB-LONGWORD (1) = JBC$_NOMOREQUE
               GO TO QUEUE-CHECK-RTN-EXIT.
           IF QUEUE_NAME (1:QUEUE_NAME_LENGTH) NOT = WHAT_QUE
               GO TO START-SEARCHING.
           MOVE "YES" TO QUEUE_OK.
           MOVE FILE-NAME TO OQPF-FILE-NAME.
           CALL "LIB$SPAWN" USING BY DESCRIPTOR OTHER-QUEUE-PRINT-FLD
                                  BY VALUE 0 0 0 0 0 0 0
                            GIVING STAT.
           IF STAT IS FAILURE
               CALL "LIB$STOP" USING BY VALUE STAT.
           GO TO START-SEARCHING.
       QUEUE-CHECK-RTN-EXIT.
           EXIT.
           COPY EDRUTINE.
