       IDENTIFICATION DIVISION.
       PROGRAM-ID.              DISK_FRAG.
       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 TWO-FIFTY-FIVE
                   ARE               1    2   3    4     5   7     14
                      16       22         27         69          77
                             81        255            256.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT PR ASSIGN TO PRT1.
       DATA DIVISION.
       FILE SECTION.
000100 FD  PR 
               LABEL RECORDS ARE OMITTED
               RECORD CONTAINS 72 CHARACTERS.
       01  DATALINE.
           02  PLINE                    PIC X(72).
           02  FILLER REDEFINES PLINE.
               03  FILLER               PIC X(05).
               03  DFILES               PIC ZZZ,ZZZ,ZZ9.
               03  DDASHES              PIC X(20).
               03  DCOMMENTS            PIC X(36).
       WORKING-STORAGE SECTION.
       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  HB-HOME-BLOCK-LBN        PIC S9(09) COMP.
           02  HB-ALT-HOM-BLOCK-LBN     PIC S9(09) COMP.
           02  HB-ALT-INDEXF-HEADER-LBN PIC S9(09) COMP.
           02  HB-STRUCT-1              PIC X(01).
           02  HB-STRUCT-2              PIC X(01).
           02  HB-CLUSTER               PIC S9(04) COMP.
           02  HB-HOME-BLOCK-VBN        PIC S9(04) COMP.
           02  HB-ALT-HOME-BLOCK-VBN    PIC S9(04) COMP.
           02  HB-ALT-INDEXF-HEADER-VBN PIC S9(04) COMP.
           02  HB-BITMAP-VBN            PIC S9(04) COMP.
           02  HB-BITMAP-LBN            PIC S9(09) COMP.
           02  HB-MAX-FILES             PIC S9(09) COMP.
           02  HB-INDEXF-BITMAP-SIZE    PIC S9(04) COMP.
           02  HB-NO-RESERVED-FILES     PIC S9(04) COMP.
           02  HB-DEVICE-TYPE           PIC S9(04) COMP.
           02  HB-RVN                   PIC S9(04) COMP.
           02  HB-NO-VOLS-IN-SET        PIC S9(04) COMP.
           02  HB-VOLUME-CHARS          PIC S9(04) COMP.
           02  HB-UIC-MEMBER            PIC S9(04) COMP.
           02  HB-UIC-GROUP             PIC S9(04) COMP.
           02  FILLER                   PIC X(412).
           02  HB-VOL-SET-NAME          PIC X(12).
           02  HB-VOLUME-NAME           PIC X(12).
           02  HB-OWNER-NAME            PIC X(12).
           02  HB-FORMAT                PIC X(12).
           02  FILLER                   PIC X(5092).
000500 01  INDEXF-RECORD REDEFINES WS_GET_BUFFER.
000600     02  IDXF-FIRST-WORD		PIC S9(04)    COMP.
000600     02  FILLER   		PIC X(12).
000600     02  IDXF-EXTENT   		PIC S9(04)    COMP.
000600     02  FILLER   		PIC X(64).
000700     02  IDXF-FILE-NAME-PART1     PIC X(20).
000600     02  FILLER   		PIC X(34).
000700     02  IDXF-FILE-NAME-PART2     PIC X(66).
           02  FILLER                   PIC X(310).
           02  IDXF-LAST-WORD           PIC S9(04)    COMP.
           02  FILLER                   PIC X(5088).
       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  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  REAL-BINARY-WORD        PIC 9(04) COMP.
************************************************************************
*********** I KNOW THIS ISN'T REALLY A WORD, BUT I'M CHEATING **********
************************************************************************
           02  BINARY-WRD              PIC 9(09) COMP.
           02  FILLER REDEFINES BINARY-WRD.
               03  BINARY-W-BYTE1      PIC X(01).
               03  BINARY-W-BYTE2      PIC X(01).
               03  FILLER              PIC X(02).
           02  FILLER REDEFINES BINARY-WRD.
               03  BINARY-W-LOW-WORD   PIC 9(04) COMP.
               03  BINARY-W-HIGH-WORD  PIC 9(04) COMP.
************************************************************************
           02  BINARY-LONGWORD         PIC 9(09) COMP.
           02  FILLER REDEFINES BINARY-LONGWORD.
               03  BINARY-LW-LOW-WORD  PIC 9(04) COMP.
               03  FILLER REDEFINES BINARY-LW-LOW-WORD.
                   04  BINARY-LW-BYTE1 PIC X(01).
                   04  BINARY-LW-BYTE2 PIC X(01).
               03  BINARY-LW-HIGH-WORD PIC 9(04) COMP.
               03  FILLER REDEFINES BINARY-LW-HIGH-WORD.
                   04  BINARY-LW-BYTE3 PIC X(01).
                   04  BINARY-LW-BYTE4 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  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  REPLY                   PIC X(31).
               88  YEA                     VALUE "Y"
                                                 "y".
               88  NEA                     VALUE " "
                                                 "N"
                                                 "n".

       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  IDXF-RETRIEVAL-POINTERS.
           02  IDXF-RP-WORD            PIC 9(04)    COMP
                                            OCCURS 206 TIMES.
       01  FILLER.
           02  DISPLAY-EXTENT          PIC ZZZZZ9.
           02  DISPLAY-REL-REC-NUMBER  PIC ZZZZZZZZ9.
           02  MSD-STATUS              PIC X(02).
           02  DISPLAY-FILE-NAME       PIC X(86).
           02  RECORD-COUNT            PIC 9(06).
           02  SAVED-RECORD            PIC 9(06).
           02  EXTENT-RECORD           PIC 9(09).
           02  EXTENSION-FLAG          PIC X(01).
           02  PRINT-PASS              PIC X(01).
           02  SUB                     PIC 9(03).
           02  SUBX                    PIC 9(03).
           02  SUBZ                    PIC 9(03).
           02  CHECKSUM-SUB            PIC 9(03).
           02  DLBN                    PIC ZZZZZZZZ9.
           02  FORMAT-TYPE             PIC 9(04).
               88 NO-FORMAT                VALUE 0000.
               88 FORMAT-IS-TWO            VALUE 0010.
               88 FORMAT-IS-FOUR           VALUE 0100.
               88 FORMAT-IS-EIGHT          VALUE 1000.
               88 FORMAT-IS-TWELVE         VALUE 1100.
           02  FILLER REDEFINES FORMAT-TYPE.
               03  FORMAT-CHAR         PIC 9(01) OCCURS 4 TIMES.
           02  VALUE-CHECK             PIC 9(09).
           02  NUMBER-OF-BLOCKS        PIC 9(09).
           02  LOW-LBN                 PIC 9(09).
           02  HIGH-LBN                PIC 9(09).
           02  BINARY-CHECKSUM         PIC S9(09) COMP.
           02  CHECKSUM                PIC S9(09).
           02  POS                     PIC 9(09)  COMP.
           02  SRC                     PIC 9(09) COMP VALUE 0.
           02  EFN_FLAG_VALUE          PIC 9(09)  COMP.
           02  DISPLAY-FLAGS.
               03  DISPLAY_FLAG_VALUE  PIC 9(01) OCCURS 32 TIMES.
           02  REPLY                   PIC X(01).
           02  NUMBER-OF-BITS-TO-SET   PIC 9(04)  COMP.
           02  NUMBER-OF-BITS-TO-GET   PIC 9(04)  COMP VALUE 1.
           02  DISK-DEVICE             PIC X(26).
           02  VOLUME-FLAG             PIC X(01).
               88  VOLUME-SET              VALUE "Y".
               88  SINGLE-DISK             VALUE "N".
           02  PREV-NAME               PIC X(20).
           02  DISPLAY-NAME            PIC X(20).
           02  VOLUME-SET-NAME         PIC X(12).
           02  VOLUME-NAME             PIC X(12).
           02  MAX-FILES               PIC 9(09).
           02  RECORDS-TO-SKIP         PIC 9(03).
           02  FRAGMENTS               PIC 9(05).
           02  UNRECOGNIZED-RECORDS    PIC 9(06).
           02  TOTAL-FILES             PIC 9(09).
           02  ONLY-ONE                PIC 9(04).
           02  LESS-THAN-10            PIC 9(04).
           02  LESS-THAN-20            PIC 9(04).
           02  LESS-THAN-30            PIC 9(04).
           02  LESS-THAN-40            PIC 9(04).
           02  LESS-THAN-50            PIC 9(04).
           02  LESS-THAN-60            PIC 9(04).
           02  LESS-THAN-70            PIC 9(04).
           02  LESS-THAN-80            PIC 9(04).
           02  LESS-THAN-90            PIC 9(04).
           02  LESS-THAN-100           PIC 9(04).
           02  100-OR-MORE             PIC 9(04).
       PROCEDURE DIVISION.
       BEGIN.
           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.
       OPEN-FILE.
           MOVE FAB$V_SHRGET TO 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 "**** INVALID KEY OF REFERENCE ENTRY ****"
                   GO TO E-O-J
               ELSE
                   IF WS_DISPLAY_STATUS = 98954
                       DISPLAY " "
                       DISPLAY "***** FILE CURRENTLY LOCKED BY ANOTHER
      -                                                    " USER *****"
                       GO TO E-O-J
                   END-IF
                   IF WS_DISPLAY_STATUS = 98962
                       DISPLAY " "
                       DISPLAY "***** FILE NOT FOUND *****"
                       GO TO E-O-J
                   END-IF
                   IF WS_DISPLAY_STATUS = 100052
                       DISPLAY " "
                       DISPLAY "***** FILENAME SYNTAX ERROR *****"
                       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     *******************
           MOVE FOUR TO WS_RAB_KSZ.
           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 "**** INVALID KEY OF REFERENCE ENTRY ****"
                   GO TO E-O-J
               ELSE
                   DISPLAY " OPEN STATUS = " WS_DISPLAY_STATUS
                   CALL "LIB$STOP" USING BY VALUE WS_STATUS.
           OPEN OUTPUT PR.
           MOVE 0 TO MAX-FILES
                     FRAGMENTS
                     TOTAL-FILES
                     RECORD-COUNT
                     UNRECOGNIZED-RECORDS.
           MOVE 0 TO ONLY-ONE
                     LESS-THAN-10
                     LESS-THAN-20
                     LESS-THAN-30
                     LESS-THAN-40
                     LESS-THAN-50
                     LESS-THAN-60
                     LESS-THAN-70
                     LESS-THAN-80
                     LESS-THAN-90
                     LESS-THAN-100
                     100-OR-MORE.
           MOVE " " TO PREV-NAME.
       START-INDEXF.
           MOVE WS_UBF_POINTER TO WS_RAB_UBF.
           MOVE 5600 TO WS_RAB_USZ.
           MOVE 00 TO BINARY-WORD.
           MOVE WS_FAB_RFM TO BINARY-VALUE.
           MOVE BINARY-WORD TO RECORD_FORMAT.
           MOVE ONE TO WS_RAB_RAC.
           PERFORM HOME-BLOCK-RTN THRU HOME-BLOCK-RTN-EXIT.
           ADD 1 RECORDS-TO-SKIP GIVING SAVED-RECORD.
      *     DISPLAY SAVED-RECORD.
           MOVE "N" TO EXTENSION-FLAG.
           MOVE SAVED-RECORD TO WS_REL_REC_NUMBER.
       READ-REC.
      *     MOVE WS_REL_REC_NUMBER TO DISPLAY-REL-REC-NUMBER.
      *     DISPLAY " RELATIVE RECORD KEY = " DISPLAY-REL-REC-NUMBER.
           MOVE " " TO WS_GET_BUFFER.
           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
               IF FRAGMENTS NOT = 0
                   PERFORM FRAGMENT-RTN THRU FRAGMENT-RTN-EXIT
               END-IF
               GO TO SUMMARY-SECTION.
           IF WS_STATUS IS FAILURE
               DISPLAY "GET STATUS = " WS_DISPLAY_STATUS
               CALL "LIB$STOP" USING BY VALUE WS_STATUS.
           IF IDXF-LAST-WORD = 0
               ADD 1 TO SAVED-RECORD
               MOVE SAVED-RECORD TO WS_REL_REC_NUMBER
               GO TO READ-REC.
           IF IDXF-FIRST-WORD = 25640
               NEXT SENTENCE
           ELSE
               IF IDXF-FIRST-WORD = 12840
                   IF EXTENSION-FLAG = "N"
                       ADD 1 TO SAVED-RECORD
                       MOVE SAVED-RECORD TO WS_REL_REC_NUMBER
                       GO TO READ-REC
                   END-IF
               ELSE
                   ADD 1 TO UNRECOGNIZED-RECORDS
                   DISPLAY " "
                   DISPLAY "***** UNKNOWN FIRST WORD *****" 
                   DISPLAY "***** RELATIVE RECORD COUNT = "
                                                  SAVED-RECORD " *****"
                   ADD 1 TO SAVED-RECORD
                   MOVE SAVED-RECORD TO WS_REL_REC_NUMBER
                   GO TO READ-REC.
      *     DISPLAY IDXF-FILE-NAME-PART1.
           IF IDXF-FIRST-WORD = 25640
               IF IDXF-FILE-NAME-PART1 = PREV-NAME
                   MOVE IDXF-FILE-NAME-PART1 TO PREV-NAME
               ELSE
                   MOVE PREV-NAME TO DISPLAY-NAME
                   MOVE IDXF-FILE-NAME-PART1 TO PREV-NAME
                   IF FRAGMENTS NOT = 0
                       PERFORM FRAGMENT-RTN THRU FRAGMENT-RTN-EXIT
                       MOVE 0 TO FRAGMENTS
                   END-IF
               MOVE 156 TO CHECKSUM-SUB
               MOVE INDEXF-RECORD (201:310) TO IDXF-RETRIEVAL-POINTERS
           ELSE
               IF IDXF-FIRST-WORD = 12840
                   MOVE 206 TO CHECKSUM-SUB
                   MOVE INDEXF-RECORD (101:410) TO
                                                IDXF-RETRIEVAL-POINTERS.
           IF IDXF-RP-WORD (1) = 0
                   OR IDXF-RETRIEVAL-POINTERS (1:2) = TWO-FIFTY-FIVE
               ADD 1 TO SAVED-RECORD
               MOVE SAVED-RECORD TO WS_REL_REC_NUMBER
               GO TO READ-REC.
           MOVE 0 TO SUB.
           PERFORM RETRIEVE-POINTER-RTN THRU RETRIEVE-POINTER-RTN-EXIT.
           IF IDXF-EXTENT = 0
               ADD 1 TO SAVED-RECORD
      *         DISPLAY "GOING TO READ " SAVED-RECORD
               MOVE SAVED-RECORD TO WS_REL_REC_NUMBER
               MOVE "N" TO EXTENSION-FLAG
               GO TO READ-REC
           ELSE
               MOVE "Y" TO EXTENSION-FLAG
               MOVE IDXF-EXTENT TO EXTENT-RECORD
               ADD RECORDS-TO-SKIP EXTENT-RECORD GIVING EXTENT-RECORD
               MOVE EXTENT-RECORD TO WS_REL_REC_NUMBER
      *         MOVE WS_REL_REC_NUMBER TO DISPLAY-EXTENT
      *         DISPLAY "DISPLAY-EXTENT = " DISPLAY-EXTENT
               GO TO READ-REC.
       SUMMARY-SECTION.
           MOVE " " TO DATALINE.
           IF VOLUME-SET-NAME = " "
               MOVE VOLUME-NAME TO DATALINE (31:12)
           ELSE
               MOVE VOLUME-SET-NAME TO DATALINE (24:12)
               MOVE VOLUME-NAME TO DATALINE (37:12).
           WRITE DATALINE AFTER PAGE.
           MOVE " " TO DATALINE.
           MOVE MAX-FILES TO DFILES.
           MOVE " = MAXIMUM NUMBER OF FILES ON THIS DISK."
                                                    TO DATALINE (17:40).
           WRITE DATALINE AFTER 2.
           MOVE " " TO DATALINE.
           WRITE DATALINE AFTER 1.
           MOVE ONLY-ONE TO DFILES.
           MOVE " - - - - - - - - - -" TO DDASHES.
           MOVE " CONTIGUIOUS FILES" TO DCOMMENTS.
           WRITE DATALINE AFTER 1.
           ADD ONLY-ONE TO TOTAL-FILES.
           MOVE " " TO DATALINE.
           MOVE LESS-THAN-10 TO DFILES.
           MOVE " - - - - - - - - - -" TO DDASHES.
           MOVE " FILES WITH   2 THRU  9 EXTENTS" TO DCOMMENTS.
           WRITE DATALINE AFTER 1.
           ADD LESS-THAN-10 TO TOTAL-FILES.
           MOVE " " TO DATALINE.
           MOVE LESS-THAN-20 TO DFILES.
           MOVE " - - - - - - - - - -" TO DDASHES.
           MOVE " FILES WITH  10 THRU 19 EXTENTS" TO DCOMMENTS.
           WRITE DATALINE AFTER 1.
           ADD LESS-THAN-20 TO TOTAL-FILES.
           MOVE " " TO DATALINE.
           MOVE LESS-THAN-30 TO DFILES.
           MOVE " - - - - - - - - - -" TO DDASHES.
           MOVE " FILES WITH  20 THRU 29 EXTENTS" TO DCOMMENTS.
           WRITE DATALINE AFTER 1.
           ADD LESS-THAN-30 TO TOTAL-FILES.
           MOVE " " TO DATALINE.
           MOVE LESS-THAN-40 TO DFILES.
           MOVE " - - - - - - - - - -" TO DDASHES.
           MOVE " FILES WITH  30 THRU 39 EXTENTS" TO DCOMMENTS.
           WRITE DATALINE AFTER 1.
           ADD LESS-THAN-40 TO TOTAL-FILES.
           MOVE " " TO DATALINE.
           MOVE LESS-THAN-50 TO DFILES.
           MOVE " - - - - - - - - - -" TO DDASHES.
           MOVE " FILES WITH  40 THRU 49 EXTENTS" TO DCOMMENTS.
           WRITE DATALINE AFTER 1.
           ADD LESS-THAN-50 TO TOTAL-FILES.
           MOVE " " TO DATALINE.
           MOVE LESS-THAN-60 TO DFILES.
           MOVE " - - - - - - - - - -" TO DDASHES.
           MOVE " FILES WITH  50 THRU 59 EXTENTS" TO DCOMMENTS.
           WRITE DATALINE AFTER 1.
           ADD LESS-THAN-60 TO TOTAL-FILES.
           MOVE " " TO DATALINE.
           MOVE LESS-THAN-70 TO DFILES.
           MOVE " - - - - - - - - - -" TO DDASHES.
           MOVE " FILES WITH  60 THRU 69 EXTENTS" TO DCOMMENTS.
           WRITE DATALINE AFTER 1.
           ADD LESS-THAN-70 TO TOTAL-FILES.
           MOVE " " TO DATALINE.
           MOVE LESS-THAN-80 TO DFILES.
           MOVE " - - - - - - - - - -" TO DDASHES.
           MOVE " FILES WITH  70 THRU 79 EXTENTS" TO DCOMMENTS.
           WRITE DATALINE AFTER 1.
           ADD LESS-THAN-80 TO TOTAL-FILES.
           MOVE " " TO DATALINE.
           MOVE LESS-THAN-90 TO DFILES.
           MOVE " - - - - - - - - - -" TO DDASHES.
           MOVE " FILES WITH  80 THRU 89 EXTENTS" TO DCOMMENTS.
           WRITE DATALINE AFTER 1.
           ADD LESS-THAN-90 TO TOTAL-FILES.
           MOVE " " TO DATALINE.
           MOVE LESS-THAN-100 TO DFILES.
           MOVE " - - - - - - - - - -" TO DDASHES.
           MOVE " FILES WITH  90 THRU 99 EXTENTS" TO DCOMMENTS.
           WRITE DATALINE AFTER 1.
           ADD LESS-THAN-100 TO TOTAL-FILES.
           MOVE " " TO DATALINE.
           MOVE 100-OR-MORE TO DFILES.
           MOVE " - - - - - - - - - -" TO DDASHES.
           MOVE " FILES WITH 100 OR MORE EXTENTS" TO DCOMMENTS.
           WRITE DATALINE AFTER 1.
           ADD 100-OR-MORE TO TOTAL-FILES.
           MOVE " " TO DATALINE.
           WRITE DATALINE AFTER 1.
           MOVE TOTAL-FILES TO DFILES.
           MOVE " - - - - - - - - - -" TO DDASHES.
           MOVE " TOTAL FILES ON THIS DISK" TO DCOMMENTS.
           WRITE DATALINE AFTER 1.
           IF UNRECOGNIZED-RECORDS = 0
               GO TO E-O-J.
           MOVE " " TO DATALINE.
           WRITE DATALINE AFTER 1.
           MOVE UNRECOGNIZED-RECORDS TO DFILES.
           MOVE " - - - - - - - - - -" TO DDASHES.
           MOVE " UNRECOGNIZED RECORDS " TO DCOMMENTS.
           WRITE DATALINE AFTER 1.
       E-O-J.
           CALL "SYS$CLOSE" USING BY REFERENCE WS_FAB
                            GIVING WS_STATUS.
           IF WS_STATUS IS FAILURE
               CALL "LIB$STOP" USING BY VALUE WS_STATUS.
           CLOSE PR.
           STOP RUN.
       HOME-BLOCK-RTN.
           MOVE 2 TO WS_REL_REC_NUMBER.
           MOVE " " TO WS_GET_BUFFER.
           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
               DISPLAY "**** AT END ON HOME BLOCK READ ****"
               GO TO E-O-J.
           IF WS_STATUS IS FAILURE
               DISPLAY "GET STATUS = " WS_DISPLAY_STATUS
               CALL "LIB$STOP" USING BY VALUE WS_STATUS.
           MOVE HB-MAX-FILES TO MAX-FILES
           MOVE HB-VOL-SET-NAME TO VOLUME-SET-NAME
           MOVE HB-VOLUME-NAME TO VOLUME-NAME.
           MOVE 0 TO RECORDS-TO-SKIP.
           ADD HB-BITMAP-VBN HB-INDEXF-BITMAP-SIZE
                                                 GIVING RECORDS-TO-SKIP.
           SUBTRACT 1 FROM RECORDS-TO-SKIP.
      *     DISPLAY " ".
      *     DISPLAY "RECORDS TO SKIP = " RECORDS-TO-SKIP.
      *     DISPLAY " ".
       HOME-BLOCK-RTN-EXIT.
           EXIT.
       RETRIEVE-POINTER-RTN.
           ADD 1 TO SUB.
           IF SUB > (CHECKSUM-SUB - 1)
               GO TO RETRIEVE-POINTER-RTN-EXIT.
           MOVE 0 TO FORMAT-TYPE.
           MOVE 0 TO BINARY-WRD.
           IF IDXF-RP-WORD (SUB) = 0
               GO TO RETRIEVE-POINTER-RTN-EXIT.
           MOVE IDXF-RP-WORD (SUB) TO BINARY-W-LOW-WORD.
           MOVE 4 TO SUBX.
           PERFORM VARYING POS FROM 12 BY 1 UNTIL POS > 15
               CALL "LIB$EXTZV" USING BY REFERENCE POS
                                                   NUMBER-OF-BITS-TO-GET
                                                   BINARY-WRD
                                GIVING EFN_FLAG_VALUE
               MOVE EFN_FLAG_VALUE TO FORMAT-CHAR (SUBX)
               SUBTRACT 1 FROM SUBX
           END-PERFORM.
      *     IF NO-FORMAT
      *         GO TO RETRIEVE-POINTER-RTN-EXIT.
           IF FORMAT-IS-TWELVE OR FORMAT-IS-TWO
               MOVE BINARY-WRD TO VALUE-CHECK
               IF VALUE-CHECK = 49152 OR VALUE-CHECK = 8192
                   GO TO RETRIEVE-POINTER-RTN.
           IF FORMAT-IS-FOUR
               MOVE 12 TO POS
               MOVE 4 TO NUMBER-OF-BITS-TO-SET
           ELSE
               MOVE 15 TO POS
               MOVE 1 TO NUMBER-OF-BITS-TO-SET.
           CALL "LIB$INSV" USING BY REFERENCE SRC
                                              POS
                                              NUMBER-OF-BITS-TO-SET
                                              BINARY-WRD.
       ANY-FORMAT.
           ADD 1 TO SUB.
           MOVE 0 TO BINARY-LONGWORD.
           MOVE IDXF-RP-WORD (SUB) TO BINARY-LW-LOW-WORD.
           IF FORMAT-IS-FOUR
               MOVE BINARY-W-BYTE2 TO BINARY-LW-BYTE3
               MOVE 8 TO POS
               MOVE 4 TO NUMBER-OF-BITS-TO-SET
               CALL "LIB$INSV" USING BY REFERENCE SRC
                                                  POS
                                                  NUMBER-OF-BITS-TO-SET
                                                  BINARY-WRD
           ELSE
               ADD 1 TO SUB
               MOVE IDXF-RP-WORD (SUB) TO BINARY-LW-HIGH-WORD.
           MOVE 0 TO LOW-LBN
                     HIGH-LBN
                     NUMBER-OF-BLOCKS.
           MOVE BINARY-WRD TO REAL-BINARY-WORD.
           MOVE REAL-BINARY-WORD TO NUMBER-OF-BLOCKS.
           ADD 1 TO NUMBER-OF-BLOCKS.
           MOVE BINARY-LONGWORD TO LOW-LBN.
           ADD LOW-LBN NUMBER-OF-BLOCKS GIVING HIGH-LBN.
           ADD 1 TO FRAGMENTS.
           GO TO RETRIEVE-POINTER-RTN.
       RETRIEVE-POINTER-RTN-EXIT.
           EXIT.
       FRAGMENT-RTN.
           IF FRAGMENTS = 1
               ADD 1 TO ONLY-ONE.
           IF FRAGMENTS > 1 AND FRAGMENTS < 10
      *         DISPLAY DISPLAY-NAME " HAS 1 TO 9 FRAGMENTS."
               ADD 1 TO LESS-THAN-10.
           IF FRAGMENTS > 9 AND FRAGMENTS < 20
               DISPLAY DISPLAY-NAME " HAS 10 TO 19 FRAGMENTS."
               ADD 1 TO LESS-THAN-20.
           IF FRAGMENTS > 19 AND FRAGMENTS < 30
               DISPLAY DISPLAY-NAME " HAS 20 TO 29 FRAGMENTS."
               ADD 1 TO LESS-THAN-30.
           IF FRAGMENTS > 29 AND FRAGMENTS < 40
               DISPLAY DISPLAY-NAME " HAS 30 TO 39 FRAGMENTS."
               ADD 1 TO LESS-THAN-40.
           IF FRAGMENTS > 39 AND FRAGMENTS < 50
               DISPLAY DISPLAY-NAME " HAS 40 TO 49 FRAGMENTS."
               ADD 1 TO LESS-THAN-50.
           IF FRAGMENTS > 49 AND FRAGMENTS < 60
               DISPLAY DISPLAY-NAME " HAS 50 TO 59 FRAGMENTS."
               ADD 1 TO LESS-THAN-60.
           IF FRAGMENTS > 59 AND FRAGMENTS < 70
               DISPLAY DISPLAY-NAME " HAS 60 TO 69 FRAGMENTS."
               ADD 1 TO LESS-THAN-70.
           IF FRAGMENTS > 69 AND FRAGMENTS < 80
               DISPLAY DISPLAY-NAME " HAS 70 TO 79 FRAGMENTS."
               ADD 1 TO LESS-THAN-80.
           IF FRAGMENTS > 79 AND FRAGMENTS < 90
               DISPLAY DISPLAY-NAME " HAS 80 TO 89 FRAGMENTS."
               ADD 1 TO LESS-THAN-90.
           IF FRAGMENTS > 89 AND FRAGMENTS < 100
               DISPLAY DISPLAY-NAME " HAS 90 TO 99 FRAGMENTS"
               ADD 1 TO LESS-THAN-100.
           IF FRAGMENTS > 99
               DISPLAY DISPLAY-NAME " HAS 100 OR MORE FRAGMENTS."
               ADD 1 TO 100-OR-MORE.
       FRAGMENT-RTN-EXIT.
           EXIT.
