       IDENTIFICATION DIVISION.
       PROGRAM-ID.  EDML-SI1.
       DATE-WRITTEN.     FEB 15, 1979.
       DATE-COMPILED.
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       SOURCE-COMPUTER.   XEROX-SIGMA-6.
       OBJECT-COMPUTER.   XEROX-SIGMA-6.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT DATACARDS            ASSIGN TO CARD-READER.
           SELECT INFILE               ASSIGN TO DISC.
           SELECT OUTFILE              ASSIGN TO DISC.
           SELECT XREFFILE             ASSIGN TO DISC.
           SELECT SORTFILE             ASSIGN TO DISC.
           SELECT PARGFILE             ASSIGN TO DISC.
           SELECT PRNTFILE             ASSIGN TO PRINTER.
       DATA DIVISION.
       FILE SECTION.
       FD  DATACARDS                   LABEL RECORDS OMITTED.
       01  CARD-IN                     PIC X(80).
       FD  INFILE                      LABEL RECORDS STANDARD.
       01  COBOL-CARD.
           02  COL1-6                  PIC X(6).
           02  COL7-72.
               03  COL7                PIC X.
               03  COL8-72.
                   04  COL8-11         PIC X(4).
                   04  COL12-72        PIC X(61).
           02  COL73-80                PIC X(8).
       FD  OUTFILE                     LABEL RECORDS STANDARD.
       01  RECORD-OUT.
           02  COL1-7.
               03  FILLER              PIC X(6).
               03  COL7                PIC X.
           02  COBOL-TEXT.
               03  COL8-11             PIC X(4).
               03  FILLER              PIC X(61).
           02  COL73-80                PIC X(8).
       FD  XREFFILE                    LABEL RECORDS STANDARD.
           02  XREF-WORD               PIC X(20).
           02  XREF-LINE               COMP.
       SD  SORTFILE.
       01  SORT-REC.
           02  XREF-WORD               PIC X(20).
           02  XREF-LINE               COMP.
       FD  PARGFILE                    LABEL RECORDS STANDARD.
       01  PARG-REC.
           02  PARG-NAME               PIC X(30).
           02  BEGIN-LINE              COMP.
           02  END-LINE                COMP.
       FD  PRNTFILE                    LABEL RECORDS OMITTED
           REPORTS ARE SRCELIST, XREFLIST.
      /WORKING-STORAGE SECTION.
       01  WORK-BUFFER.
           02  BUFFER                  PIC X(80).
           02  BYTE REDEFINES BUFFER OCCURS 80 TIMES
                                       PIC X.
       01  FLAGS.
           02  EOF-FLAG                PIC X           VALUE ' '.
               88  EOF                                 VALUE 'Y'.
           02  DONE-FLAG               PIC X           VALUE ' '.
               88  DONE                                VALUE 'Y'.
           02  COBOL-FLAG              PIC X           VALUE ' '.
               88  COBOL-FOUND                         VALUE 'Y'.
           02  DATACARDS-FLAGS         PIC XXX         VALUE '   '.
               88  ALL-THERE                           VALUE 'YYY'.
           02  CARD-FLAGS REDEFINES DATACARDS-FLAGS.
               03  SCHEMA-FLAG         PIC X.
                   88  SCHEMA-MISSING                  VALUE ' '.
               03  SUBSCHEMA-FLAG      PIC X.
                   88  SUBSCHEMA-MISSING               VALUE ' '.
               03  CCB-FLAG            PIC X.
                   88  CCB-MISSING                     VALUE ' '.
               88  PERIOD-FOUND                        VALUE 'Y'.
           02  DATA-DIV-FLAG           PIC X           VALUE 'Y'.
               88  FIRST-DATA-VERB                     VALUE 'Y'.
           02  WS-FLAG                 PIC X           VALUE 'Y'.
               88  PRE-WORKING-STORAGE                 VALUE 'Y'.
           02  CCB-FOUND-FLAG          PIC X           VALUE ' '.
               88  NO-CCB-FOUND                        VALUE ' '.
               88  CCB-WORD-FOUND                      VALUE 'Y'.
           02  STRING-FLAG             PIC X           VALUE ' '.
               88  STRING-DONE                         VALUE 'Y'.
           02  HIT-FLAG                PIC X           VALUE ' '.
               88  EQUAL-CONDITION                     VALUE 'Y'.
           02  VALUE-FLAG              PIC X           VALUE ' '.
               88  VALUE-FOUND                         VALUE 'Y'.
               88  VALUE-MISSING                       VALUE ' '.
           02  GRP-FLAG                PIC X           VALUE ' '.
               88  INDEX-GRP                           VALUE 'I'.
               88  VIA-GRP-SET                         VALUE 'S'.
               88  VIA-GRP-KEY                         VALUE 'K'.
           02  OWNR-FLAG               PIC X           VALUE ' '.
               88  OWNR                                VALUE 'Y'.
           02  CURR-FLAG               PIC X           VALUE ' '.
               88  CURR                                VALUE 'Y'.
           02  NOT-FLAG                PIC X           VALUE ' '.
               88  POSITIVE-CONDITION                  VALUE ' '.
           02  DECL-FLAG               PIC X           VALUE ' '.
               88  NEW-DECL                            VALUE 'Y'.
           02  SKIP-FLAG               PIC X           VALUE ' '.
               88  OK                                  VALUE ' '.
           02  PARG-FLAG               PIC X           VALUE ' '.
               88  PARG-NEEDED                         VALUE 'Y'.
           02  SETERR-FLAG             PIC X           VALUE ' '.
               88  SETERR-OCCURRED                     VALUE 'Y'.
       01  SSCH-SECTION-LINES.
           02  SSCH-LINE1              PIC X(65)       VALUE
               'SUB-SCHEMA SECTION.'.
           02  SSCH-DATA.
               03  SSCH-NAME           PIC X(30).
           02  SCHE-DATA.
               03  FILLER              PIC X(7)        VALUE
                   'WITHIN'.
               03  SCHE-NAME           PIC X(30).
       01  WS-LINES.
           02  IDS-SS-LINE1            PIC X(53)       VALUE
               '77  IDS-SS-DATA-NAME            PIC X(30)       VALUE'.
           02  IDS-SS-LINE2.
               03  FILLER              PIC X(5)        VALUE '"'
                   JUST RIGHT.
               03  SSCH-NAME           PIC X(32).
               03  SSCH-TEXT REDEFINES SSCH-NAME IN IDS-SS-LINE2
                       OCCURS 32 TIMES PIC X.
       01  SET-DBKEY-TEXT.
           02  FILLER                  PIC X(32)       VALUE
               'SET REF-CODE TO DIRECT-REFERENCE'.
       01  DECLARATIVES-TEXT.
           02  DECL-HDR                PIC X(13)       VALUE
               'DECLARATIVES.'.
           02  DECL-SECT.
               03  FILLER              PIC XX          VALUE ' X'.
               03  SECT-NAME           PIC X(31).
           02  DECL-TEXT.
                   'SECTION.  USE FOR DB-EXCEPTION ON '.
               03  USE-CODE            PIC X(9).
           02  DECL-END                PIC X(17)       VALUE
               'END DECLARATIVES.'.
       01  DMSRETRN-TEXT.
           02  FILLER                  PIC X(6)        VALUE
               'GO TO '.
           02  GOTO-TEXT               PIC X(10)       VALUE SPACES.
       01  DMSRETRN-EXIT.
           02  RETRN-PARG.
               03  FILLER              PIC X(8)        VALUE
                   'DMSRETRN'.
               03  RTN-NO              PIC 99          VALUE 0.
           02  FILLER                  PIC X(8)        VALUE
               '.  EXIT.'.
       01  ERRCODE-TEXT.
           02  FILLER                  PIC X           VALUE '"'.
           02  ERRCODE-FORMAT          PIC X(7).
           02  FILLER                  PIC X           VALUE '"'.
       01  FIND-TEXT.
           02  FIND-VERB               PIC X(5)        VALUE
               'FIND '.
           02  USING-TEXT              PIC X(6)        VALUE
               'USING'.
           02  WITHIN-TEXT             PIC X(7)        VALUE
               'WITHIN'.
           02  FIND-DIRECT             PIC X(18)       VALUE
               'DB-KEY IS REF-CODE'.
           02  FIND-CALC               PIC X(9)        VALUE
               'FIND ANY'.
           02  FIND-NEXT-GRP.
               03  PART-1              PIC X(10)       VALUE
                   'FIND NEXT'.
               03  PART-2.
                   04  FILLER          PIC X(29)       VALUE
                       'IF DB-STATUS IS = "0502100", '.
                   04  FILLER          PIC X(6)        VALUE
           02  FIND-NEXT-SET           PIC X(18)       VALUE
               'FIND NEXT; WITHIN'.
           02  FIND-FIRST              PIC X(11)       VALUE
               'FIND FIRST'.
           02  FIND-PRIOR-SET          PIC X(19)       VALUE
               'FIND PRIOR; WITHIN'.
           02  SET-TEST-POSITIVE       PIC X(24)       VALUE
               'IF DB-STATUS = "0502100"'.
           02  SET-TEST-NEGATIVE       PIC X(28)       VALUE
               'IF DB-STATUS NOT = "0502100"'.
       01  OPEN-CALL-01.
           02  OPEN-CALL-02.
               03  FILLER              PIC X(50)       VALUE
                   '"IDSNOSHARE" READY'.
               03  FILLER              PIC X(50)       VALUE
                                       '; USAGE-MODE IS RETRIEVAL'.
               03  FILLER              PIC X(50)       VALUE
                   '"IDSSHARE" READY'.
               03  FILLER              PIC X(50)       VALUE
                                       '; USAGE-MODE IS RETRIEVAL'.
               03  FILLER              PIC X(50)       VALUE
                   '"IDSNOSHARE" READY'.
               03  FILLER              PIC X(50)       VALUE
                                       '; USAGE-MODE IS UPDATE'.
               03  FILLER              PIC X(50)       VALUE
                   '"IDSSHARE" READY'.
               03  FILLER              PIC X(50)       VALUE
                                       '; USAGE-MODE IS UPDATE'.
               03  FILLER              PIC X(50)       VALUE
                   '"IDSNOSHARE" READY'.
               03  FILLER              PIC X(50)       VALUE
                                       '; USAGE-MODE IS LOAD'.
           02  OPEN-CALL REDEFINES OPEN-CALL-02 OCCURS 5 TIMES.
               03  PART-2              PIC X(50).
       01  DELETE-CALL-01.
           02  DELETE-CALL-02.
               03  FILLER              PIC X(50)       VALUE
                                       'FIND CURRENT'.
               03  FILLER              PIC X(50)       VALUE
                   'ERASE'.
               03  FILLER              PIC X(50)       VALUE
                                       'ALL MEMBERS'.
               03  FILLER              PIC X(50)       VALUE
                                       'FIND CURRENT'.
               03  FILLER              PIC X(50)       VALUE
                   'ERASE'.
               03  FILLER              PIC X(50)       VALUE
                                       'ALL MEMBERS'.
               03  FILLER              PIC X(50)       VALUE
                                       'FIND CURRENT'.
               03  FILLER              PIC X(50)       VALUE
                   'ERASE'.
               03  FILLER              PIC X(50)       VALUE SPACES.
               03  FILLER              PIC X(50)       VALUE
                                       'FIND CURRENT'.
               03  FILLER              PIC X(50)       VALUE
                   'ERASE'.
               03  FILLER              PIC X(50)       VALUE SPACES.
           02 DELETE-CALL REDEFINES DELETE-CALL-02 OCCURS 4 TIMES.
               03  PART-1              PIC X(50).
               03  PART-2              PIC X(50).
               03  PART-3              PIC X(50).
       01  LINK-CALL-01.
           02  LINK-CALL-02.
               03  FILLER              PIC X(12)  VALUE 'FIND CURRENT'.
               03  FILLER              PIC X(12)  VALUE 'MODIFY'.
               03  FILLER              PIC X(12)  VALUE 'MEMBERSHIP'.
               03  FILLER              PIC X(12)  VALUE 'FIND CURRENT'.
               03  FILLER              PIC X(12)  VALUE 'CONNECT'.
               03  FILLER              PIC X(12)  VALUE 'TO'.
               03  FILLER              PIC X(12)  VALUE SPACES.
               03  FILLER              PIC X(12)  VALUE 'FIND CURRENT'.
               03  FILLER              PIC X(12)  VALUE 'DISCONNECT'.
               03  FILLER              PIC X(12)  VALUE 'FROM'.
               03  FILLER              PIC X(12)  VALUE SPACES.
           02  LINK-CALL REDEFINES LINK-CALL-02 OCCURS 3 TIMES.
               03  PART-1              PIC X(12).
               03  PART-2              PIC X(12).
               03  PART-3              PIC X(12).
               03  PART-4              PIC X(12).
       01  DMS-CALLS-01.
           02  DMS-CALLS-02.
               03  FILLER              PIC X(40)       VALUE
                   '"IDSCHECK"'.
               03  FILLER              PIC X(40)       VALUE
                   '"IDSROLL"'.
               03  FILLER              PIC X(40)       VALUE
                   '"IDSSTATSON"'.
               03  FILLER              PIC X(40)       VALUE
                   '"IDSSTATSOFF"'.
               03  FILLER              PIC X(40)       VALUE
                   '"IDSRPTSTATS"'.
               03  FILLER              PIC X(40)       VALUE
                   '"IDSTRACEON"'.
               03  FILLER              PIC X(40)       VALUE
                   '"IDSTRACEOFF"'.
           02  DMS-CALLS REDEFINES DMS-CALLS-02 OCCURS 7 TIMES
                                       PIC X(40).
           02  RECORD-NAME-SAVE        PIC X(30)       VALUE SPACES.
           02  RECORD-NAME-DLIM-SAVE   PIC X           VALUE SPACES.
           02  SET-NAME-SAVE           PIC X(30)       VALUE SPACES.
           02  SET-NAME-DLIM-SAVE      PIC X           VALUE SPACES.
       01  KEYWORD-GRPX.
           02 KEYWORD-GRP              PIC X(3).
           02 KEYWORD-GRP-CHAR REDEFINES KEYWORD-GRP OCCURS 3 TIMES
                                       PIC X.
       01  COUNTERS.
           02  RECORDS-READ            COMP            VALUE 0.
       01  CONSTANTS.
           02  C01                     COMP            VALUE  1.
           02  C02                     COMP            VALUE  2.
           02  C03                     COMP            VALUE  3.
           02  C04                     COMP            VALUE  4.
           02  C05                     COMP            VALUE  5.
           02  C06                     COMP            VALUE  6.
           02  C07                     COMP            VALUE  7.
           02  C08                     COMP            VALUE  8.
           02  C09                     COMP            VALUE  9.
           02  C10                     COMP            VALUE  10.
       01  VARIABLES.
           02  CCB-NAME                PIC X(30)       VALUE SPACES.
           02  START-PROCNO            COMP            VALUE 0.
           02  LAST-EDMS-CALL.
               03  LAST-CALL           PIC X           VALUE SPACES.
               03  TYPE-FIND           PIC X           VALUE SPACES.
           02  OWNER-NO                COMP            VALUE 0.
           02  ERR-IT                  COMP            VALUE 0.
           02  BRANCH-INDX             COMP            VALUE 0.
           02  START-SUB               COMP            VALUE 0.
           02  SUB                     COMP.
           02  MATCH-CTR               COMP            VALUE 0.
           02  SUB-X                   COMP            VALUE 0.
           02  SUB-Y                   COMP            VALUE 0.
           02  SKIP-SUB                COMP            VALUE 0.
           02  SKIP-MAX                COMP            VALUE 0.
           02  XREF-NO                 COMP            VALUE 0.
           02  RECORD-KEY              COMP            VALUE 0.
           02  COL-SAVE                COMP            VALUE 0.
           02  DIGITS-SAVE             PIC 9(10).
           02  DIGIT REDEFINES DIGITS-SAVE OCCURS 10 TIMES PIC X.
           02  NUMBER-SAVE REDEFINES DIGITS-SAVE.
               03  DIGITS-3            PIC XXX.
               03  FILLER              PIC X(7).
           02  EDMS-ERRCODE.
               03  EDMS-VALUE          PIC 999.
               03  TYPE-CALL           PIC X.
           02  DLIM-HOLD               PIC X           VALUE SPACES.
           02  COL-NO-SAVE             PIC 99          VALUE ZERO.
           02  WORD-DLIM-SAVE          PIC X           VALUE SPACES.
       01  UNSTRING-VARIABLES.
           02  TABLE-MAX               COMP            VALUE 100.
           02  BUFFER-SIZE             COMP            VALUE 66.
           02  CARD-COL                COMP            VALUE 0.
           02  ISIC                    COMP            VALUE 0.
           02  WORD-INDX               COMP            VALUE 0.
           02  TABLE-START             COMP            VALUE 1.
           02  TABLE-END               COMP            VALUE 0.
           02  SUB-J                   COMP            VALUE 0.
           02  TABLE-INDX              COMP            VALUE 0.
           02  SUB-K                   COMP            VALUE 0.
           02  SUB-L                   COMP            VALUE 0.
           02  INSERT-AFTER            COMP            VALUE 0.
           02  SUPPRESS-DLIM           COMP            VALUE 0.
           02  INSERT-AFTER-END        COMP            VALUE 0.
           02  CALL-INDX               COMP            VALUE 0.
           02  TABLE-INDX-SAVE         COMP            VALUE 0.
           02  COL-FLAG                COMP            VALUE 0.
           02  CLEAR-BEGIN             COMP            VALUE 0.
           02  CLEAR-END               COMP            VALUE 0.
           02  COL-NO-INDX             COMP            VALUE 0.
           02  QUOTE-MARK              PIC X           VALUE '"'.
           02  DLIMTR-01.
               03  DLIMTR-02           PIC X(6)        VALUE ' .;,()'.
               03  DLIMTR-TABLE REDEFINES DLIMTR-02 OCCURS 6 TIMES.
                   04  DLIMTR          PIC X.
           02  SIC-01.
               03  SIC-FILL.
                   04  SIC-FIL-1       COMP            VALUE 2.
                   04  SIC-FIL-2       COMP            VALUE 1.
               03  SIC-02 REDEFINES SIC-FILL OCCURS 2 TIMES.
                   04  SIC             COMP.
       01  UNSTRING-TABLE.
           02  WORD-TABLE OCCURS 100 TIMES.
               03  WORD                PIC X(30).
               03  WORD-CHAR REDEFINES WORD OCCURS 30 TIMES PIC X.
               03  WORD-LENGTH         COMP.
               03  WORD-DLIM           PIC X.
               03  VERB-FLAG           PIC X.
               03  COL-NO              PIC 99.
               03  MC-ERR              PIC 99.
       01  STRING-VARIABLES.
           02  MAX-SIZE                COMP            VALUE 66.
           02  STRING-PTR              COMP            VALUE 0.
           02  SPACE-AVAIL             COMP            VALUE 0.
           02  WORD-SIZE               COMP            VALUE 0.
           02  STRING-START            COMP            VALUE 0.
       01  STRING-BUFFER.
           02  COL1-6                  PIC X(6).
           02  OUTLINE                 PIC X(66).
           02  OUTBYTE REDEFINES OUTLINE OCCURS 66 TIMES PIC X.
           02  COL7-72 REDEFINES OUTLINE.
               03  COL7                PIC X.
               03  COL8-11             PIC X(4).
               03  COL12-72            PIC X(61).
           02  COL73-80                PIC X(8).
       01  SEQ-NUMBERS.
           02  SEQ-PTR                 COMP            VALUE 0.
           02  SEQ-INDX                COMP            VALUE 0.
           02  SEQ-MAX                 COMP            VALUE 10.
           02  SEQ-TABLE.
               03  SEQ-ENTRY OCCURS 10 TIMES.
                   04  SEQ-NO          PIC X(6).
                   04  IDENT           PIC X(8).
       01  LIT-VARIABLES.
           02  LIT-PTR                 COMP            VALUE 0.
           02  LIT-START               COMP            VALUE 0.
           02  LIT-FLAG                PIC X           VALUE ' '.
               88  LIT-END                             VALUE 'Y'.
           02  LIT-TEXT                PIC X(256).
           02  LIT-BYTE REDEFINES LIT-TEXT OCCURS 256 TIMES
                                       PIC X.
       01  DECL-TABLE.
               03  DECL-VERB           PIC X(8).
               03  PARG-NAME           PIC X(30).
               03  DECL-ERRS   OCCURS 20 TIMES     PIC X(30).
       01  DECL-MAX                    COMP            VALUE 20.
       01  SETERR-TABLE.
           02  SETERR-ITEMS OCCURS 20 TIMES.
               03  SETERR-NAME         PIC X(30).
               03  SETERR-VALUE        PIC XXX.
       01  LINE-SKIP-TABLE.
           02  SKIP-LINES OCCURS 20 TIMES.
               03  SKIP-BEGIN          COMP.
               03  SKIP-END            COMP.
       01  XREF-INFO.
           02  SAVE-XREF               PIC X(20).
           02  XREF-DATA               PIC X(20).
           02  XREF-NUMB OCCURS 9 TIMES PIC 9(5).
       01  VERB-FIL.
           02 VERB-FIL-1.
               03  FILLER              PIC X(9)  VALUE 'ACCEPT'.
               03  FILLER              PIC X(9)  VALUE 'ADD'.
               03  FILLER              PIC X(9)  VALUE 'ALTER'.
               03  FILLER              PIC X(9)  VALUE 'CALL'.
               03  FILLER              PIC X(9)  VALUE 'CANCEL'.
               03  FILLER              PIC X(9)  VALUE 'CLOSE'.
               03  FILLER              PIC X(9)  VALUE 'COMPUTE'.
               03  FILLER              PIC X(9)  VALUE 'COPY'.
               03  FILLER              PIC X(9)  VALUE 'DISPLAY'.
               03  FILLER              PIC X(9)  VALUE 'DIVIDE'.
               03  FILLER              PIC X(9)  VALUE 'ENTER'.
               03  FILLER              PIC X(9)  VALUE 'EXAMINE'.
               03  FILLER              PIC X(9)  VALUE 'EXHIBIT'.
               03  FILLER              PIC X(9)  VALUE 'EXIT'.
               03  FILLER              PIC X(9)  VALUE 'GO'.
               03  FILLER              PIC X(9)  VALUE 'IF'.
               03  FILLER              PIC X(9)  VALUE 'INCLUDE'.
               03  FILLER              PIC X(9)  VALUE 'INITIATE'.
               03  FILLER              PIC X(9)  VALUE 'INSPECT'.
               03  FILLER              PIC X(9)  VALUE 'MOVE'.
               03  FILLER              PIC X(9)  VALUE 'MULTIPLY'.
               03  FILLER              PIC X(9)  VALUE 'NOTE'.
               03  FILLER              PIC X(9)  VALUE 'OPEN'.
               03  FILLER              PIC X(9)  VALUE 'PERFORM'.
               03  FILLER              PIC X(9)  VALUE 'READ'.
               03  FILLER              PIC X(9)  VALUE 'READY'.
               03  FILLER              PIC X(9)  VALUE 'RELEASE'.
               03  FILLER              PIC X(9)  VALUE 'RESET'.
               03  FILLER              PIC X(9)  VALUE 'RETURN'.
               03  FILLER              PIC X(9)  VALUE 'SEARCH'.
               03  FILLER              PIC X(9)  VALUE 'SEEK'.
               03  FILLER              PIC X(9)  VALUE 'SET'.
               03  FILLER              PIC X(9)  VALUE 'SORT'.
               03  FILLER              PIC X(9)  VALUE 'STOP'.
               03  FILLER              PIC X(9)  VALUE 'STRING'.
               03  FILLER              PIC X(9)  VALUE 'SUBTRACT'.
               03  FILLER              PIC X(9)  VALUE 'TERMINATE'.
               03  FILLER              PIC X(9)  VALUE 'TRACE'.
               03  FILLER              PIC X(9)  VALUE 'UNSTRING'.
               03  FILLER              PIC X(9)  VALUE 'USE'.
               03  FILLER              PIC X(9)  VALUE 'WRITE'.
                                       ASCENDING KEY VERB-TABLE
                                       INDEXED BY VERB-TABLE-INDX
                                       PIC X(9).
      /
       01  EDMS-VERB-TABLE.
           02  EDMS-ENTRIES.
               03  FILLER      PIC X(12)   VALUE  '0 13CLOSAREA'.
               03  FILLER      PIC X(12)   VALUE  '0 12CLOSEDB '.
               03  FILLER      PIC X(12)   VALUE  '5R01CREATE '.
               03  FILLER      PIC X(12)   VALUE  '0E15DELETAUT'.
               03  FILLER      PIC X(12)   VALUE  '1E03DELETE '.
               03  FILLER      PIC X(12)   VALUE  '3E03DELETSEL'.
               03  FILLER      PIC X(12)   VALUE  '3D05DELINK '.
               03  FILLER      PIC X(12)   VALUE  '0 20DMSABORT'.
               03  FILLER      PIC X(12)   VALUE  '1 14DMSCHKPT'.
               03  FILLER      PIC X(12)   VALUE  '0 20DMSLOCK '.
               03  FILLER      PIC X(12)   VALUE  '0 22DMSRETRN'.
               03  FILLER      PIC X(12)   VALUE  '2 14DMSRLSE '.
               03  FILLER      PIC X(12)   VALUE  '3 14DMSSTATS'.
               03  FILLER      PIC X(12)   VALUE  '6 14DMSTRACE'.
               03  FILLER      PIC X(12)   VALUE  '4 14ENDSTATS'.
               03  FILLER      PIC X(12)   VALUE  '7 14ENDTRACE'.
               03  FILLER      PIC X(12)   VALUE  '0F06FINDC  '.
               03  FILLER      PIC X(12)   VALUE  '0F09FINDD  '.
               03  FILLER      PIC X(12)   VALUE  '0F10FINDDUP '.
               03  FILLER      PIC X(12)   VALUE  '0F16FINDFRST'.
               03  FILLER      PIC X(12)   VALUE  '0F17FINDG  '.
               03  FILLER      PIC X(12)   VALUE  '0F15FINDLAST'.
               03  FILLER      PIC X(12)   VALUE  '0F18FINDN  '.
               03  FILLER      PIC X(12)   VALUE  '0F19FINDP  '.
               03  FILLER      PIC X(12)   VALUE  '0F15FINDS  '.
               03  FILLER      PIC X(12)   VALUE  '0F15FINDSEQ '.
               03  FILLER      PIC X(12)   VALUE  '0F15FINDSI '.
               03  FILLER      PIC X(12)   VALUE  '0F15FINDX  '.
               03  FILLER      PIC X(12)   VALUE  '0G11GET    '.
               03  FILLER      PIC X(12)   VALUE  '0F08HEAD   '.
               03  FILLER      PIC X(12)   VALUE  '2C05LINK   '.
               03  FILLER      PIC X(12)   VALUE  '0M04MODIFY '.
               03  FILLER      PIC X(12)   VALUE  '1R01OPENRET '.
               03  FILLER      PIC X(12)   VALUE  '3R01OPENUPD '.
               03  FILLER      PIC X(12)   VALUE  '2R01OPRETSHD'.
               03  FILLER      PIC X(12)   VALUE  '4R01OPUPDSHD'.
               03  FILLER      PIC X(12)   VALUE  '1 05RELINK '.
               03  FILLER      PIC X(12)   VALUE  '2E03REMOVE '.
               03  FILLER      PIC X(12)   VALUE  '4E03REMOVSEL'.
               03  FILLER      PIC X(12)   VALUE  '1 15RESETERR'.
               03  FILLER      PIC X(12)   VALUE  '5 14RPTSTATS'.
               03  FILLER      PIC X(12)   VALUE  '0 21SETERR '.
               03  FILLER      PIC X(12)   VALUE  '0S02STORE  '.
           02  EDMS-CALLS REDEFINES EDMS-ENTRIES  OCCURS 44 TIMES
                               ASCENDING KEY EDMS-VERB
                               INDEXED BY EDMS-INDX.
               03  NUM-CALL            PIC 9.
               03  TYPE-CALL           PIC X.
               03  TRANSFER            PIC 99.
               03  EDMS-VERB           PIC X(8).
       01  CCB-TABLE1.
               03  FILLER      PIC X(10)   VALUE 'AREA-NO   '.
               03  FILLER      PIC X(10)   VALUE 'ERR-CODE  '.
               03  FILLER      PIC X(10)   VALUE 'ERR-NO    '.
               03  FILLER      PIC X(10)   VALUE 'ERR-REF   '.
               03  FILLER      PIC X(10)   VALUE 'FRST-REF  '.
               03  FILLER      PIC X(10)   VALUE 'GRP-NO    '.
               03  FILLER      PIC X(10)   VALUE 'LAST-REF  '.
               03  FILLER      PIC X(10)   VALUE 'LINE-NO   '.
               03  FILLER      PIC X(10)   VALUE 'PAGE-NO   '.
               03  FILLER      PIC X(10)   VALUE 'PASSWORD  '.
               03  FILLER      PIC X(10)   VALUE 'SET-CURR  '.
               03  FILLER      PIC X(10)   VALUE 'SET-GRP   '.
               03  FILLER      PIC X(10)   VALUE 'SET-NEXT  '.
               03  FILLER      PIC X(10)   VALUE 'SET-OWNR  '.
               03  FILLER      PIC X(10)   VALUE 'SET-PRIR  '.
               03  FILLER      PIC X(10)   VALUE 'STAT-ACC  '.
               03  FILLER      PIC X(10)   VALUE 'STAT-CTRL '.
               03  FILLER      PIC X(10)   VALUE 'STAT-DEL  '.
               03  FILLER      PIC X(10)   VALUE 'STAT-HEAD '.
               03  FILLER      PIC X(10)   VALUE 'STAT-INS  '.
               03  FILLER      PIC X(10)   VALUE 'STAT-NEXT '.
               03  FILLER      PIC X(10)   VALUE 'STAT-PRIR '.
           02  CCB-KEYWORD REDEFINES CCB-ENTRIES1  OCCURS 22 TIMES
                                       ASCENDING KEY CCB-KEYWORD
                                       INDEXED BY CCB-INDX
                                       PIC X(10).
       01  CCB-TABLE2.
           02  CCB-ENTRIES2.
               03  FILLER      PIC X(12)   VALUE 'CURR-     '.
               03  FILLER      PIC X(12)   VALUE 'GRP-STATS-'.
               03  FILLER      COMP        VALUE 10.
               03  FILLER      PIC X(12)   VALUE 'SET-STATS-'.
               03  FILLER      COMP        VALUE 10.
               03  FILLER      PIC X(12)   VALUE 'STAT-     '.
               03  FILLER      COMP        VALUE 5.
           02  CCB-VARIABLE REDEFINES CCB-ENTRIES2  OCCURS 4 TIMES.
               03  CCB-WORD    PIC X(12).
               03  CCB-CHAR REDEFINES CCB-WORD  OCCURS 12 TIMES
                               PIC X.
               03  CCB-WORD-LENGTH     COMP.
       01  CCB-DATA.
           02  CCB-TABLE2-MAX          COMP            VALUE 4.
       01  SPECIAL-ERRCODES.
           02  DMSABORT-ERRCODE        PIC X(7)        VALUE
               '4000000'.
           02  DMSLOCK-ERRCODE         PIC X(7)        VALUE
               '4000001'.
      /
       01  ERRCODE-TABLE.
           02  ERRCODE-ENTRIES.
               03  FILLER      PIC X(12)   VALUE '001        6'.
               03  FILLER      PIC X(12)   VALUE '002        6'.
               03  FILLER      PIC X(12)   VALUE '003 0502400 '.
               03  FILLER      PIC X(12)   VALUE '004 0502400 '.
               03  FILLER      PIC X(12)   VALUE '005 0503900 '.
               03  FILLER      PIC X(12)   VALUE '006 0507100 '.
               03  FILLER      PIC X(12)   VALUE '007 0580210 '.
               03  FILLER      PIC X(12)   VALUE '008 0580210 '.
               03  FILLER      PIC X(12)   VALUE '009 0503900 '.
               03  FILLER      PIC X(12)   VALUE '010 0502200 '.
               03  FILLER      PIC X(12)   VALUE '011 0502200 '.
               03  FILLER      PIC X(12)   VALUE '012 0503100 '.
               03  FILLER      PIC X(12)   VALUE '013 0407200 '.
               03  FILLER      PIC X(12)   VALUE '014 0208100 '.
               03  FILLER      PIC X(12)   VALUE '015 0308300 '.
               03  FILLER      PIC X(12)   VALUE '016 1580230 '.
               03  FILLER      PIC X(12)   VALUE '017M1105200 '.
               03  FILLER      PIC X(12)   VALUE '017S1505200 '.
               03  FILLER      PIC X(12)   VALUE '018 0502400 '.
               03  FILLER      PIC X(12)   VALUE '019 1390100 '.
               03  FILLER      PIC X(12)   VALUE '020        5'.
               03  FILLER      PIC X(12)   VALUE '030        6'.
               03  FILLER      PIC X(12)   VALUE '031G0803100 '.
               03  FILLER      PIC X(12)   VALUE '031S1503100 '.
               03  FILLER      PIC X(12)   VALUE '032C0203100 '.
               03  FILLER      PIC X(12)   VALUE '032D0303100 '.
               03  FILLER      PIC X(12)   VALUE '032E0403100 '.
               03  FILLER      PIC X(12)   VALUE '032F0503100 '.
               03  FILLER      PIC X(12)   VALUE '032G0803100 '.
               03  FILLER      PIC X(12)   VALUE '032M1103100 '.
               03  FILLER      PIC X(12)   VALUE '033 0503100 '.
               03  FILLER      PIC X(12)   VALUE '034 0503100 '.
               03  FILLER      PIC X(12)   VALUE '035 0503100 '.
               03  FILLER      PIC X(12)   VALUE '036 0502400 '.
               03  FILLER      PIC X(12)   VALUE '037        6'.
               03  FILLER      PIC X(12)   VALUE '038 1105200 '.
               03  FILLER      PIC X(12)   VALUE '039M1109200 '.
               03  FILLER      PIC X(12)   VALUE '039S1509200 '.
               03  FILLER      PIC X(12)   VALUE '040 0000040 '.
               03  FILLER      PIC X(12)   VALUE '041C0270200 '.
               03  FILLER      PIC X(12)   VALUE '041M1170200 '.
               03  FILLER      PIC X(12)   VALUE '041S1570200 '.
               03  FILLER      PIC X(12)   VALUE '042C0270200 '.
               03  FILLER      PIC X(12)   VALUE '042F0509100 '.
               03  FILLER      PIC X(12)   VALUE '042M1170200 '.
               03  FILLER      PIC X(12)   VALUE '042S1570200 '.
               03  FILLER      PIC X(12)   VALUE '043        6'.
               03  FILLER      PIC X(12)   VALUE '044        6'.
               03  FILLER      PIC X(12)   VALUE '045        6'.
               03  FILLER      PIC X(12)   VALUE '046        5'.
               03  FILLER      PIC X(12)   VALUE '047C0270200 '.
               03  FILLER      PIC X(12)   VALUE '047F0570200 '.
               03  FILLER      PIC X(12)   VALUE '047M1170200 '.
               03  FILLER      PIC X(12)   VALUE '047S1570200 '.
               03  FILLER      PIC X(12)   VALUE '048 1390100 '.
               03  FILLER      PIC X(12)   VALUE '049 0504200 '.
               03  FILLER      PIC X(12)   VALUE '050        6'.
               03  FILLER      PIC X(12)   VALUE '051        6'.
               03  FILLER      PIC X(12)   VALUE '052        6'.
               03  FILLER      PIC X(12)   VALUE '053        6'.
               03  FILLER      PIC X(12)   VALUE '061        6'.
               03  FILLER      PIC X(12)   VALUE '062        6'.
               03  FILLER      PIC X(12)   VALUE '063C0208200 '.
               03  FILLER      PIC X(12)   VALUE '063G0308200 '.
               03  FILLER      PIC X(12)   VALUE '064        6'.
               03  FILLER      PIC X(12)   VALUE '065        6'.
               03  FILLER      PIC X(12)   VALUE '066        6'.
               03  FILLER      PIC X(12)   VALUE '068        6'.
               03  FILLER      PIC X(12)   VALUE '069        6'.
               03  FILLER      PIC X(12)   VALUE '070        6'.
               03  FILLER      PIC X(12)   VALUE '071        6'.
               03  FILLER      PIC X(12)   VALUE '072        6'.
               03  FILLER      PIC X(12)   VALUE '073        6'.
               03  FILLER      PIC X(12)   VALUE '080        6'.
               03  FILLER      PIC X(12)   VALUE '081        6'.
               03  FILLER      PIC X(12)   VALUE '082        6'.
               03  FILLER      PIC X(12)   VALUE '083        6'.
               03  FILLER      PIC X(12)   VALUE '084        6'.
               03  FILLER      PIC X(12)   VALUE '085        6'.
               03  FILLER      PIC X(12)   VALUE '086        6'.
               03  FILLER      PIC X(12)   VALUE '091        6'.
               03  FILLER      PIC X(12)   VALUE '092        6'.
               03  FILLER      PIC X(12)   VALUE '093        6'.
               03  FILLER      PIC X(12)   VALUE '094        6'.
               03  FILLER      PIC X(12)   VALUE '095        6'.
               03  FILLER      PIC X(12)   VALUE '096        6'.
               03  FILLER      PIC X(12)   VALUE '097E0480300 '.
               03  FILLER      PIC X(12)   VALUE '097F0580300 '.
               03  FILLER      PIC X(12)   VALUE '097M1180300 '.
               03  FILLER      PIC X(12)   VALUE '097R1380300 '.
               03  FILLER      PIC X(12)   VALUE '097S1580300 '.
               03  FILLER      PIC X(12)   VALUE '098        6'.
               03  FILLER      PIC X(12)   VALUE '099E0480300 '.
               03  FILLER      PIC X(12)   VALUE '099F0580300 '.
               03  FILLER      PIC X(12)   VALUE '099R1380300 '.
               03  FILLER      PIC X(12)   VALUE '099S1580300 '.
               03  FILLER      PIC X(12)   VALUE '100E0480300 '.
               03  FILLER      PIC X(12)   VALUE '100F0580300 '.
               03  FILLER      PIC X(12)   VALUE '100M1180300 '.
               03  FILLER      PIC X(12)   VALUE '100R1380300 '.
               03  FILLER      PIC X(12)   VALUE '100S1580300 '.
               03  FILLER      PIC X(12)   VALUE '101E0480300 '.
               03  FILLER      PIC X(12)   VALUE '101F0580300 '.
               03  FILLER      PIC X(12)   VALUE '101M1180300 '.
               03  FILLER      PIC X(12)   VALUE '101R1380300 '.
               03  FILLER      PIC X(12)   VALUE '101S1580300 '.
               03  FILLER      PIC X(12)   VALUE '121        6'.
               03  FILLER      PIC X(12)   VALUE '122        6'.
               03  FILLER      PIC X(12)   VALUE '123 0308300 '.
               03  FILLER      PIC X(12)   VALUE '124 0202300 '.
               03  FILLER      PIC X(12)   VALUE '125 0502400 '.
               03  FILLER      PIC X(12)   VALUE '126        6'.
               03  FILLER      PIC X(12)   VALUE '127 0502400 '.
               03  FILLER      PIC X(12)   VALUE '128 0502400 '.
               03  FILLER      PIC X(12)   VALUE '129        6'.
               03  FILLER      PIC X(12)   VALUE '131        6'.
               03  FILLER      PIC X(12)   VALUE '133        6'.
               03  FILLER      PIC X(12)   VALUE '134        6'.
               03  FILLER      PIC X(12)   VALUE '135        6'.
               03  FILLER      PIC X(12)   VALUE '136        6'.
               03  FILLER      PIC X(12)   VALUE '137        6'.
           02  ERRCODES REDEFINES ERRCODE-ENTRIES
                               ASCENDING KEY ERRCODE-KEY
                               INDEXED BY ERR-INDX.
               03  ERRCODE-KEY.
                   04  EDMS-ERR            PIC XXX.
                   04  CALL-CODE           PIC X.
               03  IDS-ERRCODE             PIC X(7).
               03  IDS-MSG                 PIC 9.
       01  OPENRET-X.
           02  PART-1                  PIC X(18)     VALUE
                   '"IDSNOSHARE" READY'.
           02  PART-2                  PIC X(25)     VALUE
                                       '; USAGE-MODE IS RETRIEVAL'.
      /
       01  MSG-TABLE.
           02  MSG-ENTRIES.
1              03  FILLER              PIC X(32)     VALUE   SPACES.
2              03  FILLER              PIC X(32)     VALUE
                   '* INSERTED'.
3              03  FILLER              PIC X(32)     VALUE
                   '* CHANGED'.
4              03  FILLER              PIC X(32)     VALUE
                   '* MANUAL CHECK REQUIRED'.
5              03  FILLER              PIC X(32)       VALUE
                   '* MANUAL CONVERSION REQUIRED'.
6              03  FILLER              PIC X(32)       VALUE
                   '* NO I-D-S/II EQUIVALENT'.
7              03  FILLER              PIC X(32)       VALUE
                   '* DMSLOCK/DMSABORT DELETED'.
8              03  FILLER              PIC X(32)       VALUE
                   '* SETERR DELETED'.
9              03  FILLER              PIC X(32)       VALUE
                   '* CCB COPY STATEMENT DELETED'.
           02  MSG REDEFINES MSG-ENTRIES OCCURS 9 TIMES.
               03  MSG-PART1           PIC X(20).
               03  MSG-PART2           PIC X(12).
           02  MC-INDX                 COMP            VALUE 0.
           02  MC-ERR-ENTRIES.
               03  FILLER      PIC X(12)   VALUE 'REF TO 4.2.1'.
               03  FILLER      PIC X(12)   VALUE 'REF TO 4.2.2'.
               03  FILLER      PIC X(12)   VALUE 'REF TO 4.2.3'.
               03  FILLER      PIC X(12)   VALUE 'REF TO 4.2.4'.
               03  FILLER      PIC X(12)   VALUE 'REF TO 4.2.5'.
               03  FILLER      PIC X(12)   VALUE 'REF TO 4.2.6'.
               03  FILLER      PIC X(12)   VALUE 'REF TO 4.2.7'.
               03  FILLER      PIC X(12)   VALUE 'REF TO 4.2.8'.
               03  FILLER      PIC X(12)   VALUE 'REF TO 4.2.9'.
               03  FILLER      PIC X(12)   VALUE 'SEE 4.2.10'.
           02  MC-ERR-TABLE REDEFINES MC-ERR-ENTRIES OCCURS 10 TIMES
                               PIC X(12).
       01  MSG-PTR-TABLE.
           02  MSG-SUB                 COMP            VALUE 0.
           02  MSG-CTR                 COMP            VALUE 0.
           02  MSG-PTR                 COMP            VALUE 1.
           02  MSG-PTR-SAVE OCCURS 10 TIMES PIC 99.
00000  01  DATE-AREA.                                                   DATEAREA
00001      02  SS-1                    PICTURE X.                       DATEAREA
00002      02  SS-2                    PICTURE X.                       DATEAREA
00003      02  SS-3                    PICTURE X.                       DATEAREA
00004      02  SS-4                    PICTURE X.                       DATEAREA
00005      02  SS-5                    PICTURE X.                       DATEAREA
00006      02  SS-6                    PICTURE X.                       DATEAREA
00007      02  FILLER                  PICTURE XX.                      DATEAREA
00009          03  HOURS               PICTURE XX.                      DATEAREA
00010          03  FILLER              PICTURE X.                       DATEAREA
00011          03  MINUTES             PICTURE XX.                      DATEAREA
00012      02  FILLER                  PICTURE X.                       DATEAREA
00013      02  TODAY.                                                   DATEAREA
00014          03  MONTH               PICTURE XXXX.                    DATEAREA
00015          03  DAY                 PICTURE XX.                      DATEAREA
00016          03  FILLER              PICTURE XX.                      DATEAREA
00017          03  YEAR                PICTURE XX.                      DATEAREA
00018      02  PRINT-LINES             PICTURE XX.                      DATEAREA
       01  CHAR2 PIC 99.
      /
       01 IDSIIRESWORDS.
         02 IDS-II-RESWORDS-TABLE.
          03 FILLER PIC X(16) VALUE IS  'ACTUAL'.
          03 FILLER PIC X(16) VALUE IS  'AFTER'.
          03 FILLER PIC X(16) VALUE IS  'ALLOCATE'.
          03 FILLER PIC X(16) VALUE IS  'ALLOWED'.
          03 FILLER PIC X(16) VALUE IS  'ALTER'.
          03 FILLER PIC X(16) VALUE IS  'ALWAYS'.
          03 FILLER PIC X(16) VALUE IS  'AND'.
          03 FILLER PIC X(16) VALUE IS  'ANY'.
          03 FILLER PIC X(16) VALUE IS  'APPLICATION'.
          03 FILLER PIC X(16) VALUE IS  'ARRAY'.
          03 FILLER PIC X(16) VALUE IS  'ASC'.
          03 FILLER PIC X(16) VALUE IS  'ASCENDING'.
          03 FILLER PIC X(16) VALUE IS  'AT'.
          03 FILLER PIC X(16) VALUE IS  'AUTHOR'.
          03 FILLER PIC X(16) VALUE IS  'AUTOMATIC'.
          03 FILLER PIC X(16) VALUE IS  'BASE_DBKEY'.
          03 FILLER PIC X(16) VALUE IS  'BEFORE'.
          03 FILLER PIC X(16) VALUE IS  'BINARY'.
          03 FILLER PIC X(16) VALUE IS  'BIT'.
          03 FILLER PIC X(16) VALUE IS  'BY'.
          03 FILLER PIC X(16) VALUE IS  'BYTES'.
          03 FILLER PIC X(16) VALUE IS  'CALC'.
          03 FILLER PIC X(16) VALUE IS  'CALC_INTERVAL'.
          03 FILLER PIC X(16) VALUE IS  'CALC_KEY'.
          03 FILLER PIC X(16) VALUE IS  'CALL'.
          03 FILLER PIC X(16) VALUE IS  'CBL74'.
          03 FILLER PIC X(16) VALUE IS  'CHAIN'.
          03 FILLER PIC X(16) VALUE IS  'CHAR'.
          03 FILLER PIC X(16) VALUE IS  'CHAR'.
          03 FILLER PIC X(16) VALUE IS  'CHARACTER'.
          03 FILLER PIC X(16) VALUE IS  'CHECK'.
          03 FILLER PIC X(16) VALUE IS  'CLAUSE_TYPE'.
          03 FILLER PIC X(16) VALUE IS  'CLOSE'.
          03 FILLER PIC X(16) VALUE IS  'COMMENT'.
          03 FILLER PIC X(16) VALUE IS  'COMPLEX'.
          03 FILLER PIC X(16) VALUE IS  'CURRENT'.
          03 FILLER PIC X(16) VALUE IS  'DATA_BASE_KEY'.
          03 FILLER PIC X(16) VALUE IS  'DATA_BASE_KEYS'.
          03 FILLER PIC X(16) VALUE IS  'DBKEY'.
          03 FILLER PIC X(16) VALUE IS  'DBKEYS'.
          03 FILLER PIC X(16) VALUE IS  'DB_DATA_NAME'.
          03 FILLER PIC X(16) VALUE IS  'DB_RECORD_NAME'.
          03 FILLER PIC X(16) VALUE IS  'DEC'.
          03 FILLER PIC X(16) VALUE IS  'DECIMAL'.
          03 FILLER PIC X(16) VALUE IS  'DECLARATIVE_TYPE'.
          03 FILLER PIC X(16) VALUE IS  'DECODING'.
          03 FILLER PIC X(16) VALUE IS  'DEFINED'.
          03 FILLER PIC X(16) VALUE IS  'DELETE'.
          03 FILLER PIC X(16) VALUE IS  'DESC'.
          03 FILLER PIC X(16) VALUE IS  'DESCENDING'.
          03 FILLER PIC X(16) VALUE IS  'DISPLAY'.
          03 FILLER PIC X(16) VALUE IS  'DUPS'.
          03 FILLER PIC X(16) VALUE IS  'DURING'.
          03 FILLER PIC X(16) VALUE IS  'DYNAMIC'.
          03 FILLER PIC X(16) VALUE IS  'ENCODING'.
          03 FILLER PIC X(16) VALUE IS  'EQUAL'.
          03 FILLER PIC X(16) VALUE IS  'ERROR'.
          03 FILLER PIC X(16) VALUE IS  'EXCEPT'.
          03 FILLER PIC X(16) VALUE IS  'EXCL'.
          03 FILLER PIC X(16) VALUE IS  'EXCLUSIVE'.
          03 FILLER PIC X(16) VALUE IS  'FILE_CODE'.
          03 FILLER PIC X(16) VALUE IS  'FIND'.
          03 FILLER PIC X(16) VALUE IS  'FIRST'.
          03 FILLER PIC X(16) VALUE IS  'FIXED'.
          03 FILLER PIC X(16) VALUE IS  'FLOAT'.
          03 FILLER PIC X(16) VALUE IS  'FORTRAN'.
          03 FILLER PIC X(16) VALUE IS  'FORTY'.
          03 FILLER PIC X(16) VALUE IS  'FUNCTION_TYPE'.
          03 FILLER PIC X(16) VALUE IS  'GET'.
          03 FILLER PIC X(16) VALUE IS  'GIVING'.
          03 FILLER PIC X(16) VALUE IS  'GMAP'.
          03 FILLER PIC X(16) VALUE IS  'IDENTIFIED'.
          03 FILLER PIC X(16) VALUE IS  'IN'.
          03 FILLER PIC X(16) VALUE IS  'INDEX'.
          03 FILLER PIC X(16) VALUE IS  'INDEXED'.
          03 FILLER PIC X(16) VALUE IS  'INPUT_VALUE'.
          03 FILLER PIC X(16) VALUE IS  'INSERT'.
          03 FILLER PIC X(16) VALUE IS  'INSERTION'.
          03 FILLER PIC X(16) VALUE IS  'INTEGRATED'.
          03 FILLER PIC X(16) VALUE IS  'INVENTORY'.
          03 FILLER PIC X(16) VALUE IS  'KEYS'.
          03 FILLER PIC X(16) VALUE IS  'LAST'.
          03 FILLER PIC X(16) VALUE IS  'LANGUAGE'.
          03 FILLER PIC X(16) VALUE IS  'LENGTH'.
          03 FILLER PIC X(16) VALUE IS  'LINKED'.
          03 FILLER PIC X(16) VALUE IS  'LOAD_LIMIT'.
          03 FILLER PIC X(16) VALUE IS  'LOC'.
          03 FILLER PIC X(16) VALUE IS  'LOCATION'.
          03 FILLER PIC X(16) VALUE IS  'LOCK'.
          03 FILLER PIC X(16) VALUE IS  'LOCKS'.
          03 FILLER PIC X(16) VALUE IS  'MAND'.
          03 FILLER PIC X(16) VALUE IS  'MANDATORY'.
          03 FILLER PIC X(16) VALUE IS  'MANUAL'.
          03 FILLER PIC X(16) VALUE IS  'MEMBERS'.
          03 FILLER PIC X(16) VALUE IS  'MODE'.
          03 FILLER PIC X(16) VALUE IS  'MODIFY'.
          03 FILLER PIC X(16) VALUE IS  'NEXT'.
          03 FILLER PIC X(16) VALUE IS  'NEXCL'.
          03 FILLER PIC X(16) VALUE IS  'NONEXCLUSIVE'.
          03 FILLER PIC X(16) VALUE IS  'NONNULL'.
          03 FILLER PIC X(16) VALUE IS  'NOT'.
          03 FILLER PIC X(16) VALUE IS  'NULL'.
          03 FILLER PIC X(16) VALUE IS  'OCCURS'.
          03 FILLER PIC X(16) VALUE IS  'OF'.
          03 FILLER PIC X(16) VALUE IS  'OPEN'.
          03 FILLER PIC X(16) VALUE IS  'OPT'.
          03 FILLER PIC X(16) VALUE IS  'OPTIONAL'.
          03 FILLER PIC X(16) VALUE IS  'OR'.
          03 FILLER PIC X(16) VALUE IS  'ORDER'.
          03 FILLER PIC X(16) VALUE IS  'ORGANIZATION'.
          03 FILLER PIC X(16) VALUE IS  'OUTPUT_VALUE'.
          03 FILLER PIC X(16) VALUE IS  'OWNER'.
          03 FILLER PIC X(16) VALUE IS  'PAGE_INTERVAL'.
          03 FILLER PIC X(16) VALUE IS  'PAGE_SIZE'.
          03 FILLER PIC X(16) VALUE IS  'PERCENT'.
          03 FILLER PIC X(16) VALUE IS  'PER_CENT'.
          03 FILLER PIC X(16) VALUE IS  'PERM'.
          03 FILLER PIC X(16) VALUE IS  'PERMANENT'.
          03 FILLER PIC X(16) VALUE IS  'PICTURE'.
          03 FILLER PIC X(16) VALUE IS  'PL1'.
          03 FILLER PIC X(16) VALUE IS  'POINTER'.
          03 FILLER PIC X(16) VALUE IS  'POINTER_SEQ'.
          03 FILLER PIC X(16) VALUE IS  'PRIOR'.
          03 FILLER PIC X(16) VALUE IS  'PROC'.
          03 FILLER PIC X(16) VALUE IS  'PROCEDURE'.
          03 FILLER PIC X(16) VALUE IS  'PROCESSABLE'.
          03 FILLER PIC X(16) VALUE IS  'PROGRAM_NAME'.
          03 FILLER PIC X(16) VALUE IS  'PROT'.
          03 FILLER PIC X(16) VALUE IS  'PROTECTED'.
          03 FILLER PIC X(16) VALUE IS  'RANGE'.
          03 FILLER PIC X(16) VALUE IS  'REAL'.
          03 FILLER PIC X(16) VALUE IS  'RECORD'.
          03 FILLER PIC X(16) VALUE IS  'RECORD_NAME'.
          03 FILLER PIC X(16) VALUE IS  'RELATIVE'.
          03 FILLER PIC X(16) VALUE IS  'REMOVE'.
          03 FILLER PIC X(16) VALUE IS  'RESULT'.
          03 FILLER PIC X(16) VALUE IS  'RETENTION'.
          03 FILLER PIC X(16) VALUE IS  'RETR'.
          03 FILLER PIC X(16) VALUE IS  'RETRIEVAL'.
          03 FILLER PIC X(16) VALUE IS  'SCALE'.
          03 FILLER PIC X(16) VALUE IS  'SEARCH'.
          03 FILLER PIC X(16) VALUE IS  'SELECTION'.
          03 FILLER PIC X(16) VALUE IS  'SEQUENTIAL'.
          03 FILLER PIC X(16) VALUE IS  'SIGNED'.
          03 FILLER PIC X(16) VALUE IS  'SORTED'.
          03 FILLER PIC X(16) VALUE IS  'SOURCE'.
          03 FILLER PIC X(16) VALUE IS  'SS_DATA_NAME'.
          03 FILLER PIC X(16) VALUE IS  'SS_RECORD_NAME'.
          03 FILLER PIC X(16) VALUE IS  'STATUS_RETURN'.
          03 FILLER PIC X(16) VALUE IS  'STORE'.
          03 FILLER PIC X(16) VALUE IS  'SYSTEM_DEFAULT'.
          03 FILLER PIC X(16) VALUE IS  'TEMPORARY'.
          03 FILLER PIC X(16) VALUE IS  'THEN'.
          03 FILLER PIC X(16) VALUE IS  'THIS'.
          03 FILLER PIC X(16) VALUE IS  'TIMES'.
          03 FILLER PIC X(16) VALUE IS  'TO'.
          03 FILLER PIC X(16) VALUE IS  'TYPE'.
          03 FILLER PIC X(16) VALUE IS  'UNSPEC'.
          03 FILLER PIC X(16) VALUE IS  'UNSPECIFIED'.
          03 FILLER PIC X(16) VALUE IS  'UPDATE'.
          03 FILLER PIC X(16) VALUE IS  'VALUE'.
          03 FILLER PIC X(16) VALUE IS  'VARYING'.
          03 FILLER PIC X(16) VALUE IS  'VIA'.
          03 FILLER PIC X(16) VALUE IS  'VIRTUAL'.
          03 FILLER PIC X(16) VALUE IS  'WHERE'.
         02 RES-WORD-TABLE REDEFINES IDS-II-RESWORDS-TABLE
                OCCURS 169 TIMES PICTURE X(16).
      /
       01 TEMP-STORAGE.
         02 TEMP-NAME PIC X(31) VALUE SPACES.
         02 TEMP-NAME2 REDEFINES TEMP-NAME OCCURS 31 TIMES PIC X.
         02 TEMP-NAME3 PIC X(16) VALUE SPACES.
         02 TEMP-NAME4 REDEFINES TEMP-NAME3 OCCURS 16 TIMES PIC X.
       01 CHAR-COUNT PIC 999.
       01 CHANGE-RESERVED-WORD-LINE.
          02 FILLER PIC X(6) VALUE ' **** '.
          02 CHANGE-RESERVED-NAME PIC X(16).
          02 FILLER PIC X(44) VALUE
             ' IS A RESERVED WORD AND CHANGED ON NEXT LINE'.
      /
       01  CCB COPY EDML-COPY.
      /REPORT SECTION.
       RD  SRCELIST
           PAGE 32 LINES.
       01  TYPE PH     NEXT GROUP PLUS 2.
           02  LINE 1  COLUMN 31       PIC X(15)       VALUE
               'HONEYWELL, INC.'.
           02  COLUMN 69               PIC X(5)        SOURCE TIME.
           02  COLUMN 77               PIC X(10)       SOURCE TODAY.
           02  COLUMN 117              PIC X(4)        VALUE 'PAGE'.
           02  COLUMN 122              PIC ZZZZ9       SOURCE
               PAGE-COUNTER IN SRCELIST.
           02  LINE 3  COLUMN 24       PIC X(28)       VALUE
               'CONVERTED EDMS-COBOL PROGRAM'.
       01  PRNTLINE    TYPE DE.
           02  LINE PLUS 1  COLUMN 3   PIC 9(5)        SOURCE
               RECORD-KEY.
           02  COLUMN 16               PIC X(80)       SOURCE
               RECORD-OUT.
           02  COLUMN 96               PIC X           VALUE '/'.
           02  COLUMN 99               PIC X(34)       SOURCE
               MSG (MSG-PTR).
       01  INFOLINE    TYPE DE.
           02  LINE PLUS 1  COLUMN 96  PIC X           VALUE '/'.
           02  COLUMN 99               PIC X(34)       SOURCE
               MSG (MSG-PTR).
       01  EOFLINE     TYPE DE  NEXT GROUP NEXT PAGE.
           02  LINE PLUS 1  COLUMN 2   PIC X(15)       VALUE
               'EOF ENCOUNTERED'.
       RD  XREFLIST
           PAGE 32 LINES.
       01  TYPE PH     NEXT GROUP PLUS 2.
           02  LINE 1  COLUMN 31       PIC X(15)       VALUE
               'HONEYWELL, INC.'.
           02  COLUMN 69               PIC X(5)        SOURCE TIME.
           02  COLUMN 77               PIC X(10)       SOURCE TODAY.
           02  COLUMN 117              PIC X(4)        VALUE 'PAGE'.
           02  COLUMN 122              PIC ZZZZ9       SOURCE
               PAGE-COUNTER IN XREFLIST.
           02  LINE 3  COLUMN 20       PIC X(36)       VALUE
               'CONVERTED EDMS-COBOL CROSS REFERENCE'.
       01  XREFLINE    TYPE DE.
           02  LINE PLUS 1  COLUMN 3   PIC X(20)       SOURCE
               XREF-DATA.
               XREF-NUMB (1).
           02  COLUMN 38               PIC ZZZZZ       SOURCE
               XREF-NUMB (2).
           02  COLUMN 49               PIC ZZZZZ       SOURCE
               XREF-NUMB (3).
           02  COLUMN 60               PIC ZZZZZ       SOURCE
               XREF-NUMB (4).
           02  COLUMN 71               PIC ZZZZZ       SOURCE
               XREF-NUMB (5).
           02  COLUMN 82               PIC ZZZZZ       SOURCE
               XREF-NUMB (6).
           02  COLUMN 93               PIC ZZZZZ       SOURCE
               XREF-NUMB (7).
           02  COLUMN 104              PIC ZZZZZ       SOURCE
               XREF-NUMB (8).
           02  COLUMN 115              PIC ZZZZZ       SOURCE
               XREF-NUMB (9).
      /PROCEDURE DIVISION.
       000-MAIN SECTION.
       001-CONTROL.
           DISPLAY ' EDML A01 HERE' UPON PRINTER.
           PERFORM 100-INITIALIZATION.
           PERFORM 150-PASS1.
           PERFORM 200-PRE-PROCEDURE UNTIL DONE OR EOF.
           MOVE SPACES TO DONE-FLAG.
           PERFORM 250-DECLARATIVES UNTIL DONE OR EOF.
           PERFORM 300-PROCEDURE UNTIL EOF.
           PERFORM 700-CLOSE.
           STOP RUN.
      /
      *        THIS PROCEDURE INITIALIZES TABLES, CHECKS FOR THE
      *        PROPER DATA CARDS, SETS UP THE SUBSCHEMA TO READ
      *        THE USER'S SCHEMA AND OPENS THE SCHEMA DATA BASE
      *
      *
       100-INITIALIZATION.
           ENTER GETCOM, DATE-AREA.
           MOVE 1 TO TABLE-START.
           MOVE 2 TO ISIC.
           PERFORM 110-INIT-WORD-TABLE VARYING SUB   FROM
           PERFORM 115-ZERO-SKIP-TABLE VARYING SKIP-SUB FROM
               1 BY 1 UNTIL SKIP-SUB > DECL-MAX.
           MOVE ZEROS TO SKIP-SUB.
           MOVE SPACES TO SEQ-TABLE.
           ENTER FIXIT, BUFFER, ERR-IT.
           IF ERR-IT NOT ZERO
               DISPLAY '*** FIXIT ERROR' UPON PRINTER
               STOP RUN.
           MOVE 3 TO REF-CODE IN CCB.
           ENTER OPENRET, REF-CODE IN CCB, SCHEBASE.
           MOVE 16777473 TO REF-CODE IN CCB.
           ENTER FINDD.
           IF ERR-CODE NOT ZERO
               DISPLAY '*** ERROR FINDING SCHEMAHD' UPON PRINTER
               STOP RUN.
           ENTER GET, SCHEMAHD.
           ENTER FIXSCHMA, SCHESIZE.
           OPEN INPUT DATACARDS.
           PERFORM 120-DATACARDS UNTIL EOF.
           IF NOT ALL-THERE
               PERFORM 130-GEN-ERRORS
               ENTER CLOSEDB
               STOP RUN.
       110-INIT-WORD-TABLE.
           MOVE SPACES TO WORD (SUB), WORD-DLIM (SUB)
               VERB-FLAG (SUB).
           MOVE ZEROS TO WORD-LENGTH (SUB), ERR (SUB)
               COL-NO (SUB).
       115-ZERO-SKIP-TABLE.
           MOVE ZEROS TO SKIP-BEGIN (SKIP-SUB), SKIP-END (SKIP-SUB).
       120-DATACARDS.
           MOVE SPACES TO CARD-IN.
           READ DATACARDS AT END
               MOVE 'Y' TO EOF-FLAG.
           IF NOT EOF
               MOVE CARD-IN TO BUFFER
               MOVE 1 TO SUPPRESS-DLIM
               MOVE 1 TO TABLE-START
               PERFORM 800-UNSTRING THRU 800-UNSTRING-EXIT
               IF WORD (2) NOT = SPACES
                   IF WORD (1) = 'SCHEMA'
                       MOVE WORD (2) TO SCHE-NAME
                   ELSE
                   IF WORD (1) = 'SUBSCHEMA'
                       MOVE WORD (2) TO SSCH-NAME IN
                           SSCH-DATA
                       MOVE 'Y' TO SUBSCHEMA-FLAG
                   ELSE
                   IF WORD (1) = 'CCB'
                       MOVE WORD (2) TO CCB-NAME
                       MOVE 'Y' TO CCB-FLAG.
       130-GEN-ERRORS.
           IF SCHEMA-MISSING
               DISPLAY '*** SCHEMA NAME MISSING' UPON PRINTER.
           IF SUBSCHEMA-MISSING
               DISPLAY '*** SUBSCHEMA NAME MISSING' UPON PRINTER.
           IF CCB-MISSING
               DISPLAY '*** CCB NAME MISSING' UPON PRINTER.
      /
      *        THIS PROCEDURE READS THROUGH THE ENTIRE SOURCE
      *        PROGRAM CREATING THE PARGFILE AND CHECKING FOR
      *        OCCURRENCES OF DMSLOCK, DMSABORT AND SETERR.
      *        IF PRESENT, DECL-TABLE AND SETERR-TABLE ARE
      *        UPDATED.
      *
      *
       150-PASS1.
           MOVE SPACES TO EOF-FLAG, PARG-NAME IN PARG-REC
               DECL-TABLE, SETERR-TABLE.
           MOVE ZEROS TO BEGIN-LINE IN PARG-REC, END-LINE IN
               PARG-REC.
           OPEN INPUT INFILE, OUTPUT PARGFILE.
           PERFORM 2050-READ.
           PERFORM 155-FIND-PROCEDURE UNTIL DONE OR EOF.
           MOVE SPACES TO COBOL-FLAG.
           PERFORM 2000-DECL-READ UNTIL COBOL-FOUND OR EOF.
           PERFORM 160-FIND-DECL-VERBS UNTIL EOF.
           MOVE RECORDS-READ TO END-LINE IN PARG-REC.
           WRITE PARG-REC.
           IF SETERR-OCCURRED
               PERFORM 185-SAVE-ERRNAMES VARYING SUB FROM
                   1 BY 1 UNTIL SUB > DECL-MAX.
           CLOSE INFILE, PARGFILE.
           OPEN INPUT INFILE
               OUTPUT PRNTFILE, XREFFILE, OUTFILE.
           MOVE SPACES TO DONE-FLAG, EOF-FLAG, COBOL-FLAG.
           MOVE ZEROS TO RECORDS-READ.
           INITIATE SRCELIST.
           PERFORM 900-READ UNTIL COBOL-FOUND OR EOF.
       155-FIND-PROCEDURE.
           IF NOT EOF
               IF COL7 IN COBOL-CARD NOT = '*'
                   IF COL8-11 IN COBOL-CARD NOT = SPACES
                       MOVE COL7-72 IN COBOL-CARD TO BUFFER
                       MOVE 0 TO SUPPRESS-DLIM
                       MOVE 1 TO TABLE-START
                       MOVE 1 TO COL-FLAG
                       PERFORM 800-UNSTRING THRU 800-UNSTRING-EXIT
                       MOVE 0 TO TABLE-INDX
                       PERFORM 2030-ANOTHER-WORD
                       IF WORD IN WORD-TABLE (TABLE-INDX) =
                           'PROCEDURE'
                           MOVE 'Y' TO DONE-FLAG.
           IF NOT DONE
               PERFORM 2050-READ.
       160-FIND-DECL-VERBS.
           PERFORM 165-SEARCH VARYING TABLE-INDX FROM TABLE-INDX
               BY 1 UNTIL TABLE-INDX > TABLE-END.
           MOVE SPACES TO COBOL-FLAG.
           PERFORM 2000-DECL-READ UNTIL COBOL-FOUND OR EOF.
       165-SEARCH.
           IF WORD IN WORD-TABLE (TABLE-INDX) = 'DMSABORT' OR
               'DMSLOCK'
               PERFORM 170-SAVE-IT
           ELSE
           IF WORD IN WORD-TABLE (TABLE-INDX) = 'SETERR'
               PERFORM 175-SAVE-DUP
               IF WORD-DLIM IN WORD-TABLE (TABLE-INDX) NOT = '.'
                   PERFORM 2030-ANOTHER-WORD
                   IF VERB-FLAG IN WORD-TABLE (TABLE-INDX) NOT
                       = 'Y'
                       MOVE SPACES TO DONE-FLAG
                       MOVE 1 TO SUB-X
                       PERFORM 180-SAVE-ERRS UNTIL DONE.
       170-SAVE-IT.
           PERFORM 1000-LOOK VARYING SUB FROM 1 BY 1 UNTIL
               SUB > DECL-MAX OR WORD IN WORD-TABLE (TABLE-INDX)
               = DECL-VERB (SUB) OR DECL-VERB (SUB) = SPACES.
           IF SUB > DECL-MAX
               DISPLAY '*** DECL-TABLE OVERFLOW' UPON PRINTER
           ELSE
               MOVE WORD IN WORD-TABLE (TABLE-INDX) TO DECL-VERB (SUB)
               PERFORM 2030-ANOTHER-WORD
               MOVE WORD IN WORD-TABLE (TABLE-INDX) TO PARG-NAME
                   IN DECL-ITEMS (SUB).
       175-SAVE-DUP.
           PERFORM 1000-LOOK VARYING SUB FROM 1 BY 1 UNTIL
               SUB > DECL-MAX OR DECL-VERB (SUB) = SPACES.
           IF SUB > DECL-MAX
               DISPLAY '*** DECL-TABLE OVERFLOW' UPON PRINTER
           ELSE
               MOVE WORD IN WORD-TABLE (TABLE-INDX) TO DECL-VERB (SUB)
               PERFORM 2030-ANOTHER-WORD
               MOVE WORD IN WORD-TABLE (TABLE-INDX) TO PARG-NAME
                   IN DECL-ITEMS (SUB).
       180-SAVE-ERRS.
           MOVE 'Y' TO SETERR-FLAG.
           MOVE WORD IN WORD-TABLE (TABLE-INDX) TO DECL-ERRS IN
               DECL-ITEMS (SUB, SUB-X).
           ADD 1 TO SUB-X.
           IF WORD-DLIM IN WORD-TABLE (TABLE-INDX) = '.'
               MOVE 'Y' TO DONE-FLAG
           ELSE
           IF SUB-X > DECL-MAX
               DISPLAY '*** DECL-TABLE DECL-ERRS OVERFLOW'
                   UPON PRINTER
               MOVE 'Y' TO DONE-FLAG
           ELSE
               PERFORM 2030-ANOTHER-WORD
               IF VERB-FLAG IN WORD-TABLE (TABLE-INDX) = 'Y'
       185-SAVE-ERRNAMES.
           IF DECL-VERB (SUB) = 'SETERR'
               MOVE 1 TO SUB-Y
               PERFORM 190-SAVE VARYING SUB-X FROM 1 BY 1
                   UNTIL SUB-X > DECL-MAX OR DECL-ERRS (SUB, SUB-X)
                   = SPACES.
       190-SAVE.
           IF SUB-Y > DECL-MAX
               DISPLAY '*** SETERR-TABLE OVERFLOW' UPON PRINTER
           ELSE
           IF SETERR-NAME (SUB-Y) = DECL-ERRS (SUB, SUB-X)
               NEXT SENTENCE
           ELSE
           IF SETERR-NAME (SUB-Y) = SPACES
               MOVE DECL-ERRS (SUB, SUB-X) TO SETERR-NAME (SUB-Y)
           ELSE
               ADD 1 TO SUB-Y
               GO TO 190-SAVE.
           MOVE 1 TO SUB-Y.
      /
      *        THIS PROCEDURE TRANSLATES THE DATA DIVISION OF
      *        THE SOURCE PROGRAM
      *
      *
       200-PRE-PROCEDURE.
           MOVE COL7-72 IN COBOL-CARD TO BUFFER.
           MOVE 1 TO TABLE-START.
           MOVE 0 TO SUPPRESS-DLIM.
           PERFORM 800-UNSTRING THRU 800-UNSTRING-EXIT.
           MOVE 0 TO TABLE-INDX.
           PERFORM 1010-NEXT-WORD.
           IF PRE-WORKING-STORAGE
               IF WORD (TABLE-INDX) = 'DATA' AND FIRST-DATA-VERB
                   MOVE 1 TO SEQ-INDX
                   PERFORM DUMP-WORDS UNTIL SEQ-INDX > WORD-INDX
                   PERFORM 210-FORMAT-SSCH-SECT
               ELSE
               IF WORD (TABLE-INDX) = 'WORKING-STORAGE'
                   PERFORM 220-FORMAT-WS
               ELSE
                   MOVE COBOL-CARD TO RECORD-OUT
                   PERFORM 910-WRITE
           ELSE
                   PERFORM 230-FIND-CCB THRU 235-CCB-EXIT
               ELSE
               IF WORD (TABLE-INDX) = 'PROCEDURE'
                   MOVE COBOL-CARD TO RECORD-OUT
                   PERFORM 910-WRITE
                   MOVE 'Y' TO DONE-FLAG
               ELSE
               IF SETERR-OCCURRED
                   PERFORM 240-CK-SETERRS
               ELSE
                   MOVE COBOL-CARD TO RECORD-OUT
                   PERFORM 910-WRITE.
           MOVE 0 TO SEQ-INDX.
           MOVE SPACES TO COBOL-FLAG.
           PERFORM 900-READ UNTIL COBOL-FOUND OR EOF.
       210-FORMAT-SSCH-SECT.
           MOVE ' ' TO DATA-DIV-FLAG.
           MOVE COBOL-CARD TO RECORD-OUT.
           PERFORM 910-WRITE.
           MOVE SPACES TO COL1-7 IN RECORD-OUT.
           MOVE SSCH-LINE1 TO COBOL-TEXT IN RECORD-OUT.
           MOVE C01 TO MSG-CTR.
           MOVE C02 TO MSG-PTR-SAVE (MSG-CTR).
           PERFORM 910-WRITE.
           MOVE ' DB  ;' TO BUFFER.
           MOVE 0 TO SUPPRESS-DLIM.
           MOVE 1 TO TABLE-START.
           MOVE 1 TO COL-FLAG.
           PERFORM 800-UNSTRING THRU 800-UNSTRING-EXIT.
           MOVE SSCH-DATA TO BUFFER.
           MOVE TABLE-END TO TABLE-START.
           MOVE 0 TO SUPPRESS-DLIM.
           PERFORM 800-UNSTRING THRU 800-UNSTRING-EXIT.
           MOVE SCHE-DATA TO BUFFER.
           COMPUTE TABLE-START = TABLE-END + 1.
           MOVE 0 TO SUPPRESS-DLIM.
           PERFORM 800-UNSTRING THRU 800-UNSTRING-EXIT.
           MOVE '.' TO WORD-DLIM (TABLE-END).
           MOVE C02 TO ERR IN WORD-TABLE (TABLE-START).
           MOVE 0 TO SEQ-INDX.
           PERFORM 850-STRING.
       220-FORMAT-WS.
           MOVE COBOL-CARD TO RECORD-OUT.
           PERFORM 910-WRITE.
           MOVE SPACES TO COL1-7 IN RECORD-OUT.
           MOVE IDS-SS-LINE1 TO COBOL-TEXT IN RECORD-OUT.
           MOVE C01 TO MSG-CTR.
           MOVE C02 TO MSG-PTR-SAVE (MSG-CTR).
           PERFORM 910-WRITE.
           MOVE SSCH-NAME IN SSCH-DATA TO SSCH-NAME
               IN IDS-SS-LINE2.
           PERFORM 1000-LOOK VARYING SUB FROM 1 BY 1 UNTIL
               SSCH-TEXT (SUB) = SPACES.
           MOVE '"' TO SSCH-TEXT (SUB).
           ADD 1 TO SUB.
           MOVE '.' TO SSCH-TEXT (SUB).
           MOVE IDS-SS-LINE2 TO COBOL-TEXT IN RECORD-OUT.
           MOVE C01 TO MSG-CTR.
           MOVE C02 TO MSG-PTR-SAVE (MSG-CTR).
           PERFORM 910-WRITE.
           MOVE SPACES TO WS-FLAG.
       230-FIND-CCB.
           MOVE TABLE-INDX TO TABLE-INDX-SAVE.
           PERFORM 1010-NEXT-WORD.
           IF WORD-DLIM IN WORD-TABLE (TABLE-INDX) = '.'
               PERFORM 850-STRING
               GO TO 235-CCB-EXIT.
           PERFORM 1010-NEXT-WORD.
           IF WORD IN WORD-TABLE (TABLE-INDX) = 'REDEFINES'
               PERFORM 1010-NEXT-WORD 2 TIMES.
           IF WORD IN WORD-TABLE (TABLE-INDX) = 'COPY'
               PERFORM 1010-NEXT-WORD
               IF WORD IN WORD-TABLE (TABLE-INDX) = CCB-NAME
                   MOVE 'Y' TO CCB-FOUND-FLAG
                   MOVE SPACES TO PERIOD-FLAG
                   PERFORM 248-FIND-PERIOD UNTIL PERIOD-FOUND
                   MOVE C01 TO MSG-CTR
                   MOVE C09 TO MSG-PTR-SAVE (MSG-CTR)
               ELSE
                   PERFORM 850-STRING
           ELSE
               MOVE TABLE-INDX-SAVE TO TABLE-INDX
       235-CCB-EXIT.  EXIT.
       240-CK-SETERRS.
           IF SETERR-OCCURRED
               IF WORD-DLIM IN WORD-TABLE (TABLE-INDX) NOT = '.'
                   PERFORM 1010-NEXT-WORD
                   IF WORD IN WORD-TABLE (TABLE-INDX) NOT = '.'
                       PERFORM 242-FIND-MATCH.
           PERFORM 850-STRING.
       242-FIND-MATCH.
           PERFORM 1000-LOOK VARYING SUB FROM 1 BY 1
               UNTIL SUB > DECL-MAX OR WORD IN WORD-TABLE
               (TABLE-INDX) = SETERR-NAME (SUB) OR
               SETERR-NAME (SUB) = SPACES.
           IF SUB > DECL-MAX OR SETERR-NAME (SUB) = SPACES
               NEXT SENTENCE
           ELSE
           IF WORD IN WORD-TABLE (TABLE-INDX) =
               SETERR-NAME (SUB)
               PERFORM 244-TRANSLATE.
       244-TRANSLATE.
           ADD 1 TO TABLE-INDX.
           MOVE TABLE-INDX TO START-SUB.
           MOVE SPACES TO PERIOD-FLAG.
           PERFORM 248-FIND-PERIOD UNTIL PERIOD-FOUND.
           MOVE TABLE-INDX TO TABLE-INDX-SAVE.
           MOVE START-SUB TO TABLE-INDX.
           PERFORM 1000-LOOK VARYING TABLE-INDX FROM TABLE-INDX
               BY 1 UNTIL TABLE-INDX > TABLE-INDX-SAVE OR
               WORD IN WORD-TABLE (TABLE-INDX) = 'VALUE'.
           IF TABLE-INDX < TABLE-INDX-SAVE
               PERFORM 1010-NEXT-WORD
               PERFORM 660-FIND-VALUE
               IF VALUE-FOUND
                   MOVE DIGITS-SAVE TO EDMS-VALUE IN EDMS-ERRCODE
                   MOVE EDMS-ERRCODE TO SETERR-VALUE (SUB).
       248-FIND-PERIOD.
           PERFORM 1000-LOOK VARYING TABLE-INDX FROM TABLE-INDX
               BY 1 UNTIL TABLE-INDX > TABLE-END OR
           IF TABLE-INDX > TABLE-END
               MOVE 1 TO COL-FLAG
               MOVE 0 TO TABLE-END
               PERFORM 1020-READ-AGAIN
               MOVE 1 TO TABLE-INDX
           ELSE
               MOVE 'Y' TO PERIOD-FLAG.
      /
      *        IF DMSABORT, DMSLOCK OR SETERR ARE PRESENT, THIS
      *        PROCEDURE READS THROUGH THE PROCEDURE DIVISION
      *        TO FIND THE APPROPRIATE PROCEDURES AND MOVES
      *        THEM TO THE DECLARATIVES SECTION.  LINE-SKIP-TABLE
      *        IS CREATED WITH THE LINE NUMBERS OF THE PROCEDURES
      *        MOVED TO BE DELETED LATER IN THE PROCEDURE DIVISION.
      *        THE SOURCE PROGRAM IS REPOSITIONED TO THE START OF
      *        THE PROCEDURE DIVISION.
      *
      *
       250-DECLARATIVES.
           MOVE ZEROS TO SKIP-SUB, SKIP-MAX.
           IF DECL-TABLE NOT = SPACES
               OPEN INPUT PARGFILE
               MOVE RECORDS-READ TO START-PROCNO
               PERFORM 260-FORMAT-DECL UNTIL EOF
               CLOSE PARGFILE, INFILE
               OPEN INPUT INFILE
               MOVE 0 TO RECORDS-READ
               MOVE SPACES TO EOF-FLAG
               PERFORM 2050-READ UNTIL RECORDS-READ = START-PROCNO
               MOVE SPACES TO SEQ-TABLE
               MOVE 0 TO SEQ-INDX
               PERFORM 920-READ-FLAGS.
           MOVE 'Y' TO DONE-FLAG.
           MOVE SKIP-SUB TO SKIP-MAX.
           MOVE 1 TO SKIP-SUB.
           MOVE 1 TO COL-FLAG.
       260-FORMAT-DECL.
           MOVE COL7-72 IN COBOL-CARD TO BUFFER.
           MOVE 0 TO SUPPRESS-DLIM.
           MOVE 1 TO TABLE-START.
           MOVE 1 TO COL-FLAG.
           PERFORM 800-UNSTRING THRU 800-UNSTRING-EXIT.
           MOVE 0 TO TABLE-INDX.
           PERFORM 1010-NEXT-WORD.
           IF WORD IN WORD-TABLE (TABLE-INDX) = 'DECLARATIVES'
               ADD 1 TO START-PROCNO
               MOVE COBOL-CARD TO RECORD-OUT
               PERFORM 910-WRITE
           ELSE
               MOVE SPACES TO RECORD-OUT
               MOVE DECL-HDR TO COBOL-TEXT IN RECORD-OUT
               MOVE 'Y' TO DECL-FLAG
               MOVE C01 TO MSG-CTR
               MOVE C02 TO MSG-PTR-SAVE (MSG-CTR)
               PERFORM 910-WRITE.
           PERFORM 2070-READ-PARG.
           PERFORM 270-MOVE-PARGS UNTIL EOF.
           IF NEW-DECL
               MOVE SPACES TO RECORD-OUT
               MOVE DECL-END TO COBOL-TEXT IN RECORD-OUT
               MOVE C01 TO MSG-CTR
               MOVE C02 TO MSG-PTR-SAVE (MSG-CTR)
               PERFORM 910-WRITE.
       270-MOVE-PARGS.
           PERFORM 1000-LOOK VARYING SUB FROM 1 BY 1 UNTIL SUB
               > DECL-MAX OR PARG-NAME IN PARG-REC = PARG-NAME
               IN DECL-TABLE (SUB).
           IF SUB > DECL-MAX
               NEXT SENTENCE
           ELSE
               PERFORM 280-FORMAT-SECT
               PERFORM 2050-READ UNTIL RECORDS-READ = BEGIN-LINE
               MOVE SPACES TO SEQ-TABLE
               MOVE 0 TO SEQ-INDX
               PERFORM 920-READ-FLAGS
               MOVE 1 TO COL-FLAG
               PERFORM 300-PROCEDURE UNTIL RECORDS-READ > END-LINE
                   OR EOF
               PERFORM 295-CK-SETERR
               ADD 1 TO SKIP-SUB
               MOVE BEGIN-LINE TO SKIP-BEGIN (SKIP-SUB)
               MOVE END-LINE TO SKIP-END (SKIP-SUB).
       280-FORMAT-SECT.
           MOVE PARG-NAME IN DECL-ITEMS (SUB) TO SECT-NAME
               IN DECL-SECT.
           MOVE DECL-SECT TO BUFFER.
           MOVE 0 TO SUPPRESS-DLIM.
           MOVE 1 TO TABLE-START.
           MOVE 1 TO COL-FLAG.
           PERFORM 800-UNSTRING THRU 800-UNSTRING-EXIT.
           MOVE C02 TO ERR IN WORD-TABLE (TABLE-END).
           PERFORM 290-FORMAT-USE.
           MOVE DECL-TEXT TO BUFFER.
           COMPUTE  TABLE-START = TABLE-END + 1.
           PERFORM 800-UNSTRING THRU 800-UNSTRING-EXIT.
           IF USE-CODE IN DECL-TEXT = SPACES
               PERFORM 297-STRING-ERRS THRU 298-ERR-EXIT
                   VARYING SUB-X FROM 1 BY 1 UNTIL SUB-X >
                   DECL-MAX OR DECL-ERRS (SUB, SUB-X) = SPACES.
           MOVE '.' TO WORD-DLIM (TABLE-END).
           MOVE 0 TO SEQ-INDX.
           PERFORM 850-STRING.
       290-FORMAT-USE.
           IF DECL-VERB (SUB) = 'DMSABORT'
               MOVE DMSABORT-ERRCODE TO ERRCODE-FORMAT
               MOVE ERRCODE-TEXT TO USE-CODE IN DECL-TEXT
           ELSE
           IF DECL-VERB (SUB) = 'DMSLOCK'
               MOVE DMSLOCK-ERRCODE TO ERRCODE-FORMAT
               MOVE ERRCODE-TEXT TO USE-CODE IN DECL-TEXT
           ELSE
           IF DECL-ERRS (SUB, 1) = SPACES
               MOVE 'OTHER' TO USE-CODE IN DECL-TEXT
           ELSE
               MOVE SPACES TO USE-CODE.
       295-CK-SETERR.
           IF PARG-NEEDED
               MOVE SPACES TO COL1-7 IN RECORD-OUT
               MOVE DMSRETRN-EXIT TO COBOL-TEXT IN RECORD-OUT
               MOVE C01 TO MSG-CTR
               MOVE C02 TO MSG-PTR-SAVE (MSG-CTR)
               PERFORM 910-WRITE
       297-STRING-ERRS.
           PERFORM 1000-LOOK VARYING SUB-Y FROM 1 BY 1
               UNTIL SUB-Y > DECL-MAX OR SETERR-NAME (SUB-Y)
               = DECL-ERRS (SUB, SUB-X).
           COMPUTE TABLE-START = TABLE-END + 1.
           IF SUB-Y > DECL-MAX
               MOVE DECL-ERRS (SUB, SUB-X) TO BUFFER
               PERFORM 800-UNSTRING THRU 800-UNSTRING-EXIT
               MOVE C05 TO ERR IN WORD-TABLE (TABLE-END)
               GO TO 298-ERR-EXIT.
           MOVE SPACES TO VALUE-FLAG.
           SET ERR-INDX TO 1.
           SEARCH ERRCODES
               AT END MOVE SETERR-NAME (SUB-Y) TO BUFFER
                   PERFORM 800-UNSTRING THRU 800-UNSTRING-EXIT
                   MOVE C05 TO ERR IN WORD-TABLE (TABLE-END)
                   MOVE C10 TO MC-ERR (TABLE-END)
               WHEN SETERR-VALUE (SUB-Y) = EDMS-ERR (ERR-INDX)
                   MOVE 'Y' TO VALUE-FLAG.
           IF VALUE-FOUND
               IF IDS-MSG (ERR-INDX) = SPACES
                   MOVE IDS-ERRCODE (ERR-INDX) TO ERRCODE-FORMAT
                       IN ERRCODE-TEXT
                   MOVE ERRCODE-TEXT TO BUFFER
                   PERFORM 800-UNSTRING THRU 800-UNSTRING-EXIT
               ELSE
                   MOVE SETERR-NAME (SUB-Y) TO BUFFER
                   PERFORM 800-UNSTRING THRU 800-UNSTRING-EXIT
                   MOVE IDS-MSG (ERR-INDX) TO ERR IN WORD-TABLE
                       (TABLE-END).
       298-ERR-EXIT.  EXIT.
      /
      *        THIS PROCEDURE CONTROLS THE TRANSLATION OF
      *        PROCEDURE DIVISION STATEMENTS.
      *
      *
       300-PROCEDURE.
           MOVE COL7-72 IN COBOL-CARD TO BUFFER.
           MOVE 1 TO TABLE-START.
           PERFORM 800-UNSTRING THRU 800-UNSTRING-EXIT.
           MOVE 1 TO TABLE-INDX.
           PERFORM 310-EXAMINE THRU 315-EXAMINE-EXIT.
           PERFORM 850-STRING.
           MOVE SPACES TO COBOL-FLAG, SEQ-TABLE.
           MOVE 0 TO SEQ-INDX.
           PERFORM 900-READ UNTIL COBOL-FOUND OR EOF.
      /
      *
      *
      *        THIS PROCEDURE UNSTRINGS A SOURCE LINE, EXAMINES
      *        EACH WORD AND BRANCHES TO THE APPROPRIATE ROUTINE
      *        FOR TRANSLATION IF NECESSARY.
      *
      *
       310-EXAMINE.
           IF TABLE-INDX > TABLE-END
               GO TO 315-EXAMINE-EXIT.
           IF WORD IN WORD-TABLE (TABLE-INDX) = SPACES
               ADD 1 TO TABLE-INDX
               GO TO 310-EXAMINE.
           MOVE SPACE TO CCB-FOUND-FLAG.
           IF WORD IN WORD-TABLE (TABLE-INDX) = 'ENTER' OR 'CALL'
               PERFORM 400-EDMS-CALL THRU 410-CALL-EXIT
           ELSE
           IF WORD IN WORD-TABLE (TABLE-INDX) = 'MOVE'
               PERFORM 600-CK-REFCODE
           ELSE
           IF WORD IN WORD-TABLE (TABLE-INDX) = 'IF'
               PERFORM 610-CK-IF
           ELSE
               IF WORD IN WORD-TABLE (TABLE-INDX) = 'PERFORM'
                   MOVE SPACES TO LAST-EDMS-CALL
           ELSE
               SEARCH ALL CCB-KEYWORD
                   AT END PERFORM 320-VARIABLE-KEYWORD VARYING
                   SUB FROM 1 BY 1 UNTIL SUB > CCB-TABLE2-MAX OR
                   CCB-WORD-FOUND
               WHEN CCB-KEYWORD (CCB-INDX) =
                   WORD IN WORD-TABLE (TABLE-INDX)
                   MOVE 'Y' TO CCB-FOUND-FLAG.
               IF WORD IN WORD-TABLE (TABLE-INDX) = 'ERR-CODE'
                   PERFORM 690-ERRCODE
               ELSE MOVE C06 TO ERR IN WORD-TABLE (TABLE-INDX)
                   MOVE WORD IN WORD-TABLE (TABLE-INDX) TO XREF-WORD
                       IN XREF-REC
                   PERFORM 3000-WRT-XREF.
           ADD 1 TO TABLE-INDX.
           GO TO 310-EXAMINE.
       315-EXAMINE-EXIT. EXIT.
      *
      *        PERHAPS IT IS A VARIABLE LENGTH KEYWORD OF THE FORM
      *        KEYWORD-999 WHERE 999 IS A GROUP NUMBER
      *
       320-VARIABLE-KEYWORD.
           MOVE ZERO TO MATCH-CTR.
           PERFORM 330-MATCH-CCB VARYING SUB-X FROM 1 BY 1 UNTIL
               SUB-X > CCB-WORD-LENGTH (SUB).
           IF MATCH-CTR = CCB-WORD-LENGTH (SUB)
               PERFORM 340-MOVE-REST VARYING SUB-Y FROM 1 BY 1
                   UNTIL SUB-Y > 3
               IF DIGITS-3 IS NUMERIC AND SUB-X > WORD-LENGTH IN
                   WORD-TABLE (TABLE-INDX)
                   MOVE 'Y' TO CCB-FOUND-FLAG.
       330-MATCH-CCB.
           IF WORD-CHAR (TABLE-INDX, SUB-X) = CCB-CHAR (SUB, SUB-X)
               ADD 1 TO MATCH-CTR.
       340-MOVE-REST.
           MOVE WORD-CHAR (TABLE-INDX, SUB-X) TO DIGIT (SUB-Y).
           ADD 1 TO SUB-X.
      /
      *
      *
      *        THIS PROCEDURE HANDLES TRANSLATION OF EDMS CALL
      *        STATEMENTS.
      *
      *
       400-EDMS-CALL.
           MOVE TABLE-INDX TO START-SUB.
           MOVE 0 TO BRANCH-INDX.
           PERFORM 1010-NEXT-WORD.
           IF EOF
               GO TO 410-CALL-EXIT.
           SEARCH ALL EDMS-CALLS
               AT END GO TO 410-CALL-EXIT
               WHEN WORD (TABLE-INDX) = EDMS-VERB (EDMS-INDX)
                   PERFORM 417-TYPE-CALL
                   MOVE NUM-CALL IN EDMS-CALLS (EDMS-INDX) TO
                       CALL-INDX
                   MOVE TRANSFER (EDMS-INDX) TO BRANCH-INDX
                   PERFORM 415-XREF.
           GO TO 422-OPENRET
               430-STORE
               432-DELETE
               437-MODIFY
               439-LINK
               440-FINDC
               441-FINDM
               442-HEAD
               443-FINDD
               444-FINDDUP
               446-GET
               447-CLOSEDB
               448-CLOSEAREA
               449-DMS
               456-MANUAL-CONVERT
               460-FINDFRST
               465-FINDG
               490-FINDN
               500-FINDP
               540-DMSABORT
               550-SETERR
               560-DMSRETRN
               DEPENDING ON BRANCH-INDX.
           DISPLAY 'BRANCH TABLE ERROR ' WORD (TABLE-INDX)
               UPON PRINTER.
       410-CALL-EXIT.  EXIT.
       415-XREF.
           IF BRANCH-INDX < 20
               MOVE EDMS-VERB (EDMS-INDX) TO XREF-WORD IN XREF-REC
               PERFORM 3000-WRT-XREF.
       417-TYPE-CALL.
           IF LAST-EDMS-CALL = 'FN' AND TYPE-CALL IN EDMS-CALLS
               (EDMS-INDX) = 'G'
               MOVE TYPE-CALL IN EDMS-CALLS (EDMS-INDX) TO
                   LAST-CALL IN LAST-EDMS-CALL
           ELSE
               MOVE TYPE-CALL IN EDMS-CALLS (EDMS-INDX) TO
                   LAST-EDMS-CALL.
      /
      *
      *
      *        OPENRET  OPRETSHD  OPENUPD  OPUPDSHD  CREATE
      *
      *
           PERFORM 1010-NEXT-WORD.
           IF EOF GO TO 410-CALL-EXIT.
           IF WORD (TABLE-INDX) NOT = 'REF-CODE'
               GO TO 422-OPENRET
           ELSE
               PERFORM 1010-NEXT-WORD
               PERFORM 1030-CK-IT
               ADD 1 TO START-SUB
               ADD -1 TO TABLE-INDX
               PERFORM 1040-DELETE.
           MOVE TABLE-INDX TO CLEAR-BEGIN.
           MOVE TABLE-INDX TO INSERT-AFTER.
           ADD -1 TO INSERT-AFTER.
           MOVE PART-1 IN OPEN-CALL (CALL-INDX) TO BUFFER.
           MOVE 0 TO SUPPRESS-DLIM.
           PERFORM 830-INSERT-AFTER THRU 830-INSERT-AFTER-EXIT.
           PERFORM 810-FIND-VERB.
           MOVE INSERT-AFTER-END TO TABLE-INDX.
           MOVE C03 TO ERR IN WORD-TABLE (TABLE-INDX).
       423-OPENRET.
           PERFORM 1010-NEXT-WORD.
           IF EOF GO TO 410-CALL-EXIT.
           IF VERB-FLAG (TABLE-INDX) = 'Y'
               PERFORM 425-OPENRET
               GO TO 410-CALL-EXIT.
           IF WORD-DLIM (TABLE-INDX) = '.'
               MOVE SPACES TO WORD-DLIM (TABLE-INDX)
               ADD 1 TO TABLE-INDX
               PERFORM 425-OPENRET
               MOVE '.' TO WORD-DLIM (INSERT-AFTER-END)
               GO TO 410-CALL-EXIT.
           GO TO 423-OPENRET.
       425-OPENRET.
           ADD -1 TO TABLE-INDX.
           MOVE SPACES TO BUFFER.
           MOVE PART-2 IN OPEN-CALL (CALL-INDX) TO BUFFER.
           MOVE TABLE-INDX TO INSERT-AFTER.
           MOVE 0 TO SUPPRESS-DLIM.
           PERFORM 830-INSERT-AFTER THRU 830-INSERT-AFTER-EXIT.
           PERFORM 810-FIND-VERB.
           MOVE INSERT-AFTER-END TO TABLE-INDX.
           PERFORM 840-CLEAR-COL-NO.
      /

      *
      *
      *        STORE
      *
      *
       430-STORE.
           ADD -1 TO TABLE-INDX.
           PERFORM 1040-DELETE.
           MOVE C03 TO ERR IN WORD-TABLE (TABLE-INDX).
           GO TO 410-CALL-EXIT.
      /

      *
      *
      *        DELETE  REMOVE  DELETSEL  REMOVSEL
      *
      *
       432-DELETE.
           PERFORM 1010-NEXT-WORD.
           IF EOF GO TO 410-CALL-EXIT.
           ADD -1 TO TABLE-INDX.
           PERFORM 1040-DELETE.
           COMPUTE CLEAR-BEGIN = TABLE-INDX + 1.
           MOVE PART-1 IN DELETE-CALL (CALL-INDX)     TO BUFFER.
           MOVE 0 TO SUPPRESS-DLIM.
           MOVE TABLE-INDX TO INSERT-AFTER.
           ADD -1 TO INSERT-AFTER.
           PERFORM 830-INSERT-AFTER THRU 830-INSERT-AFTER-EXIT.
           PERFORM 810-FIND-VERB.
           MOVE INSERT-AFTER-END TO TABLE-INDX.
           MOVE C03 TO ERR IN WORD-TABLE (TABLE-INDX).
           PERFORM 1010-NEXT-WORD.
           IF EOF GO TO 410-CALL-EXIT.
           MOVE WORD (TABLE-INDX) TO RECORD-NAME-SAVE.
           MOVE WORD-DLIM (TABLE-INDX) TO RECORD-NAME-DLIM-SAVE.
           MOVE SPACES TO WORD-DLIM (TABLE-INDX).
           MOVE TABLE-INDX TO INSERT-AFTER.
           MOVE PART-2 IN DELETE-CALL (CALL-INDX)     TO BUFFER.
           PERFORM 830-INSERT-AFTER THRU 830-INSERT-AFTER-EXIT.
           PERFORM 810-FIND-VERB.
           MOVE INSERT-AFTER-END TO INSERT-AFTER.
           MOVE RECORD-NAME-SAVE TO BUFFER.
           PERFORM 830-INSERT-AFTER THRU 830-INSERT-AFTER-EXIT.
           PERFORM 810-FIND-VERB.
               MOVE RECORD-NAME-DLIM-SAVE TO
                   WORD-DLIM (INSERT-AFTER-END)
               MOVE INSERT-AFTER-END TO TABLE-INDX
               MOVE TABLE-INDX TO CLEAR-END
               PERFORM 840-CLEAR-COL-NO
               GO TO 410-CALL-EXIT.
           MOVE INSERT-AFTER-END TO INSERT-AFTER.
           MOVE PART-3 IN DELETE-CALL (CALL-INDX)     TO BUFFER.
           PERFORM 830-INSERT-AFTER THRU 830-INSERT-AFTER-EXIT.
           PERFORM 810-FIND-VERB.
           MOVE RECORD-NAME-DLIM-SAVE TO WORD-DLIM (INSERT-AFTER-END).
           MOVE INSERT-AFTER-END TO TABLE-INDX.
           MOVE INSERT-AFTER-END TO CLEAR-END.
           PERFORM 840-CLEAR-COL-NO.
           GO TO 410-CALL-EXIT.
      /

      *
      *
      *        MODIFY
      *
      *
       437-MODIFY.
           PERFORM 1010-NEXT-WORD.
           IF EOF GO TO 410-CALL-EXIT.
           ADD -1 TO TABLE-INDX.
           PERFORM 1040-DELETE.
           COMPUTE CLEAR-BEGIN = TABLE-INDX + 1.
           MOVE 'FIND CURRENT' TO BUFFER.
           MOVE 0 TO SUPPRESS-DLIM.
           MOVE TABLE-INDX TO INSERT-AFTER.
           ADD -1 TO INSERT-AFTER.
           PERFORM 830-INSERT-AFTER THRU 830-INSERT-AFTER-EXIT.
           MOVE INSERT-AFTER-END TO TABLE-INDX.
           MOVE C03 TO ERR IN WORD-TABLE (TABLE-INDX).
           PERFORM 1010-NEXT-WORD.
           IF EOF GO TO 410-CALL-EXIT.
           MOVE WORD (TABLE-INDX) TO RECORD-NAME-SAVE.
           MOVE WORD-DLIM (TABLE-INDX) TO RECORD-NAME-DLIM-SAVE.
           MOVE SPACES TO WORD-DLIM (TABLE-INDX).
           MOVE TABLE-INDX TO INSERT-AFTER.
           MOVE 'MODIFY' TO BUFFER.
           PERFORM 810-FIND-VERB.
           MOVE INSERT-AFTER-END TO TABLE-INDX.
           PERFORM 1010-NEXT-WORD.
               IF EOF
                   GO TO 410-CALL-EXIT.
           IF RECORD-NAME-DLIM-SAVE = '.' OR VERB-FLAG (TABLE-INDX)
               = 'Y'
               MOVE TABLE-INDX TO INSERT-AFTER
               ADD -1 TO INSERT-AFTER
               MOVE RECORD-NAME-SAVE TO BUFFER
               PERFORM 830-INSERT-AFTER THRU 830-INSERT-AFTER-EXIT
               PERFORM 810-FIND-VERB.
           MOVE INSERT-AFTER-END TO TABLE-INDX.
           MOVE RECORD-NAME-DLIM-SAVE TO WORD-DLIM (TABLE-INDX).
           MOVE INSERT-AFTER-END TO CLEAR-END.
           PERFORM 840-CLEAR-COL-NO.
           GO TO 410-CALL-EXIT.
      /

      *
      *
      *        LINK  RELINK  DELINK
      *
      *
       439-LINK.
           PERFORM 1010-NEXT-WORD.
           IF EOF GO TO 410-CALL-EXIT.
           ADD -1 TO TABLE-INDX.
           PERFORM 1040-DELETE.
           COMPUTE CLEAR-BEGIN = TABLE-INDX + 1.
           MOVE PART-1 IN LINK-CALL (CALL-INDX)     TO BUFFER.
           MOVE 0 TO SUPPRESS-DLIM.
           MOVE TABLE-INDX TO INSERT-AFTER.
           ADD -1 TO INSERT-AFTER.
           PERFORM 830-INSERT-AFTER THRU 830-INSERT-AFTER-EXIT.
           PERFORM 810-FIND-VERB.
           MOVE INSERT-AFTER-END TO TABLE-INDX.
           MOVE C03 TO ERR IN WORD-TABLE (TABLE-INDX).
           PERFORM 1010-NEXT-WORD.
           IF EOF GO TO 410-CALL-EXIT.
           MOVE WORD (TABLE-INDX) TO RECORD-NAME-SAVE.
           MOVE TABLE-INDX TO INSERT-AFTER.
           PERFORM 830-INSERT-AFTER THRU 830-INSERT-AFTER-EXIT.
           MOVE INSERT-AFTER-END TO INSERT-AFTER.
           MOVE RECORD-NAME-SAVE TO BUFFER.
           PERFORM 830-INSERT-AFTER THRU 830-INSERT-AFTER-EXIT.
           PERFORM 810-FIND-VERB.
           MOVE INSERT-AFTER-END TO INSERT-AFTER.
           MOVE PART-3 IN LINK-CALL (CALL-INDX)     TO BUFFER.
           PERFORM 830-INSERT-AFTER THRU 830-INSERT-AFTER-EXIT.
           MOVE INSERT-AFTER-END TO TABLE-INDX.
           PERFORM 1010-NEXT-WORD.
           IF EOF GO TO 410-CALL-EXIT.
           MOVE WORD (TABLE-INDX) TO SET-NAME-SAVE.
           MOVE WORD-DLIM (TABLE-INDX) TO SET-NAME-DLIM-SAVE.
           MOVE SPACES TO WORD-DLIM (TABLE-INDX).
           IF PART-4 IN LINK-CALL (CALL-INDX)     = SPACES
               MOVE SET-NAME-DLIM-SAVE TO WORD-DLIM (TABLE-INDX)
               MOVE TABLE-INDX TO CLEAR-END
               PERFORM 840-CLEAR-COL-NO
               GO TO 410-CALL-EXIT.
           MOVE TABLE-INDX       TO INSERT-AFTER.
           MOVE PART-4 IN LINK-CALL (CALL-INDX)     TO BUFFER.
           PERFORM 830-INSERT-AFTER THRU 830-INSERT-AFTER-EXIT.
           PERFORM 810-FIND-VERB.
           MOVE SET-NAME-DLIM-SAVE TO WORD-DLIM (INSERT-AFTER-END).
           MOVE INSERT-AFTER-END TO TABLE-INDX.
           MOVE INSERT-AFTER-END TO CLEAR-END.
           PERFORM 840-CLEAR-COL-NO.
           GO TO 410-CALL-EXIT.
      /

      *
      *
      *        FINDC
      *
      *
       440-FINDC.
           PERFORM 845-SAVE-COL.
           PERFORM 1010-NEXT-WORD.
           IF EOF GO TO 410-CALL-EXIT.
           ADD -1 TO TABLE-INDX.
           PERFORM 1040-DELETE.
           COMPUTE CLEAR-BEGIN = TABLE-INDX + 1.
           MOVE 'FIND CURRENT' TO BUFFER.
           MOVE 0 TO SUPPRESS-DLIM.
           MOVE TABLE-INDX TO INSERT-AFTER.
           ADD -1 TO INSERT-AFTER.
           PERFORM 830-INSERT-AFTER THRU 830-INSERT-AFTER-EXIT.
           PERFORM 810-FIND-VERB.
           MOVE INSERT-AFTER-END TO TABLE-INDX.
           MOVE C03 TO ERR IN WORD-TABLE (TABLE-INDX).
           MOVE INSERT-AFTER-END TO CLEAR-END.
           PERFORM 840-CLEAR-COL-NO.
           PERFORM 848-REST-COL.
           GO TO 410-CALL-EXIT.
      /

      *
      *
      *        FINDM
      *
      *
       441-FINDM.
           PERFORM 1010-NEXT-WORD.
           IF EOF GO TO 410-CALL-EXIT.
           ADD -1 TO TABLE-INDX.
           PERFORM 1040-DELETE.
           COMPUTE CLEAR-BEGIN = TABLE-INDX + 1.
           MOVE 'FIND OWNER; WITHIN' TO BUFFER.
           MOVE 0 TO SUPPRESS-DLIM.
           MOVE TABLE-INDX TO INSERT-AFTER.
           ADD -1 TO INSERT-AFTER.
           PERFORM 830-INSERT-AFTER THRU 830-INSERT-AFTER-EXIT.
           PERFORM 810-FIND-VERB.
           MOVE INSERT-AFTER-END TO TABLE-INDX.
           MOVE C03 TO ERR IN WORD-TABLE (TABLE-INDX).
           COMPUTE CLEAR-END = TABLE-INDX + 1.
           PERFORM 840-CLEAR-COL-NO.
           GO TO 410-CALL-EXIT.
      /

      *
      *
      *        HEAD
      *
      *
       442-HEAD.
           PERFORM 1010-NEXT-WORD.
           IF EOF GO TO 410-CALL-EXIT.
           ADD -1 TO TABLE-INDX.
           PERFORM 1040-DELETE.
           COMPUTE CLEAR-BEGIN = TABLE-INDX + 1.
           MOVE 'FIND OWNER; WITHIN' TO BUFFER.
           MOVE 0 TO SUPPRESS-DLIM.
           MOVE TABLE-INDX TO INSERT-AFTER.
           ADD -1 TO INSERT-AFTER.
           PERFORM 830-INSERT-AFTER THRU 830-INSERT-AFTER-EXIT.
           PERFORM 810-FIND-VERB.
           MOVE INSERT-AFTER-END TO TABLE-INDX.
           MOVE C03 TO ERR IN WORD-TABLE (TABLE-INDX).
           PERFORM 1010-NEXT-WORD.
           IF EOF GO TO 410-CALL-EXIT.
           MOVE WORD (TABLE-INDX) TO SET-NAME-SAVE.
           MOVE WORD-DLIM (TABLE-INDX) TO SET-NAME-DLIM-SAVE.
           MOVE SPACES TO WORD-DLIM (TABLE-INDX).
           MOVE TABLE-INDX TO INSERT-AFTER.
           MOVE 'RETAINING CURRENCY FOR SETS GET' TO BUFFER.
           PERFORM 830-INSERT-AFTER THRU 830-INSERT-AFTER-EXIT.
           PERFORM 810-FIND-VERB.
           MOVE INSERT-AFTER-END TO TABLE-INDX.
           MOVE SET-NAME-DLIM-SAVE TO WORD-DLIM (TABLE-INDX).
           MOVE INSERT-AFTER-END TO CLEAR-END.
           PERFORM 840-CLEAR-COL-NO.
           GO TO 410-CALL-EXIT.
      /

      *
      *
      *        FINDD
      *
      *
       443-FINDD.
           MOVE WORD-DLIM (TABLE-INDX) TO RECORD-NAME-DLIM-SAVE.
           PERFORM 845-SAVE-COL.
           PERFORM 1040-DELETE.
           COMPUTE CLEAR-BEGIN = TABLE-INDX + 1.
           MOVE 'FIND; DB-KEY IS REF-CODE' TO BUFFER.
           MOVE 0 TO SUPPRESS-DLIM.
           MOVE TABLE-INDX TO INSERT-AFTER.
           ADD -1 TO INSERT-AFTER.
           PERFORM 830-INSERT-AFTER THRU 830-INSERT-AFTER-EXIT.
           PERFORM 810-FIND-VERB.
           MOVE INSERT-AFTER-END TO TABLE-INDX.
           MOVE C03 TO ERR IN WORD-TABLE (TABLE-INDX).
           MOVE RECORD-NAME-DLIM-SAVE TO WORD-DLIM (TABLE-INDX).
           MOVE INSERT-AFTER-END TO CLEAR-END.
           PERFORM 840-CLEAR-COL-NO.
           GO TO 410-CALL-EXIT.
      /
      *
      *
      *        FINDDUP
      *
      *
       444-FINDDUP.
           PERFORM 1010-NEXT-WORD.
           IF EOF GO TO 410-CALL-EXIT.
           ADD -1 TO TABLE-INDX.
           PERFORM 1040-DELETE.
           COMPUTE CLEAR-BEGIN = TABLE-INDX + 1.
           MOVE 'FIND DUPLICATE' TO BUFFER.
           MOVE 0 TO SUPPRESS-DLIM.
           MOVE TABLE-INDX TO INSERT-AFTER.
           ADD -1 TO INSERT-AFTER.
           PERFORM 830-INSERT-AFTER THRU 830-INSERT-AFTER-EXIT.
           PERFORM 810-FIND-VERB.
           MOVE INSERT-AFTER-END TO TABLE-INDX.
           MOVE C03 TO ERR IN WORD-TABLE (TABLE-INDX).
           MOVE INSERT-AFTER-END TO CLEAR-END.
           PERFORM 840-CLEAR-COL-NO.
           GO TO 410-CALL-EXIT.
      /
      *
      *
      *        GET
      *
      *
       446-GET.
           PERFORM 1010-NEXT-WORD.
           IF EOF GO TO 410-CALL-EXIT.
           ADD -1 TO TABLE-INDX.
           PERFORM 1040-DELETE.
           COMPUTE CLEAR-BEGIN = TABLE-INDX + 1.
           MOVE 'FIND CURRENT' TO BUFFER.
           MOVE 0 TO SUPPRESS-DLIM.
           MOVE TABLE-INDX TO INSERT-AFTER.
           ADD -1 TO INSERT-AFTER.
           PERFORM 830-INSERT-AFTER THRU 830-INSERT-AFTER-EXIT.
           MOVE INSERT-AFTER-END TO TABLE-INDX.
           MOVE C03 TO ERR IN WORD-TABLE (TABLE-INDX).
           PERFORM 840-CLEAR-COL-NO.
           PERFORM 1010-NEXT-WORD.
           IF EOF GO TO 410-CALL-EXIT.
           MOVE WORD-DLIM (TABLE-INDX) TO RECORD-NAME-DLIM-SAVE.
           MOVE SPACES TO WORD-DLIM (TABLE-INDX).
           MOVE TABLE-INDX TO INSERT-AFTER.
           MOVE 'GET' TO BUFFER.
           PERFORM 830-INSERT-AFTER THRU 830-INSERT-AFTER-EXIT.
           PERFORM 810-FIND-VERB.
           MOVE INSERT-AFTER-END TO TABLE-INDX.
           PERFORM 1010-NEXT-WORD.
           IF EOF GO TO 410-CALL-EXIT.
           IF RECORD-NAME-DLIM-SAVE = '.' OR VERB-FLAG (TABLE-INDX)
               = 'Y'
               MOVE TABLE-INDX TO INSERT-AFTER
               ADD -1 TO INSERT-AFTER
               MOVE RECORD-NAME-SAVE TO BUFFER
               PERFORM 830-INSERT-AFTER THRU 830-INSERT-AFTER-EXIT
               PERFORM 810-FIND-VERB.
           MOVE INSERT-AFTER-END TO TABLE-INDX CLEAR-END.
           MOVE RECORD-NAME-DLIM-SAVE TO WORD-DLIM (TABLE-INDX).
           PERFORM 840-CLEAR-COL-NO.
           GO TO 410-CALL-EXIT.
      /
      *
      *
      *        CLOSEDB
      *
      *
       447-CLOSEDB.
           MOVE WORD-DLIM (TABLE-INDX) TO RECORD-NAME-DLIM-SAVE.
           PERFORM 1040-DELETE.
           COMPUTE CLEAR-BEGIN = TABLE-INDX + 1.
           MOVE 'FINISH' TO BUFFER.
           MOVE 0 TO SUPPRESS-DLIM.
           MOVE TABLE-INDX TO INSERT-AFTER.
           ADD -1 TO INSERT-AFTER.
           PERFORM 830-INSERT-AFTER THRU 830-INSERT-AFTER-EXIT.
           PERFORM 810-FIND-VERB.
           MOVE C03 TO ERR IN WORD-TABLE (INSERT-AFTER-END).
           MOVE INSERT-AFTER-END TO TABLE-INDX.
           MOVE RECORD-NAME-DLIM-SAVE TO WORD-DLIM (TABLE-INDX).
           MOVE INSERT-AFTER-END TO CLEAR-END.
           PERFORM 840-CLEAR-COL-NO.
      /
      *
      *
      *        CLOSAREA
      *
      *
       448-CLOSEAREA.
           PERFORM 1010-NEXT-WORD.
           IF EOF GO TO 410-CALL-EXIT.
           ADD -1 TO TABLE-INDX.
           PERFORM 1040-DELETE.
           COMPUTE CLEAR-BEGIN = TABLE-INDX + 1.
           MOVE 'FINISH' TO BUFFER.
           MOVE 0 TO SUPPRESS-DLIM.
           MOVE TABLE-INDX TO INSERT-AFTER.
           ADD -1 TO INSERT-AFTER.
           PERFORM 830-INSERT-AFTER THRU 830-INSERT-AFTER-EXIT.
           PERFORM 810-FIND-VERB.
           MOVE INSERT-AFTER-END TO TABLE-INDX.
           MOVE C03 TO ERR IN WORD-TABLE (TABLE-INDX).
           MOVE INSERT-AFTER-END TO CLEAR-END.
           PERFORM 840-CLEAR-COL-NO.
           GO TO 410-CALL-EXIT.
      /
      *
      *
      *        DMSRLSE DMSCHKPT DMSSTATS ENDSTATS RPTSTATS DMSTRACE ENDTRACE
      *
      *
       449-DMS.
           ADD 1 TO START-SUB.
           MOVE WORD-DLIM (TABLE-INDX) TO RECORD-NAME-DLIM-SAVE.
           MOVE 0 TO COL-NO-INDX.
           IF CALL-INDX     = 2
               PERFORM 450-WHICH-DMSRLSE THRU 452-WHICH-DMSRLSE-EXIT.
           PERFORM 1040-DELETE.
           COMPUTE CLEAR-BEGIN = TABLE-INDX + 1.
           IF TABLE-END < 1
               MOVE 1 TO TABLE-INDX
               MOVE 0 TO TABLE-END.
           MOVE DMS-CALLS (CALL-INDX)     TO BUFFER.
           MOVE 0 TO SUPPRESS-DLIM.
           MOVE TABLE-INDX TO INSERT-AFTER.
           ADD -1 TO INSERT-AFTER.
           PERFORM 830-INSERT-AFTER THRU 830-INSERT-AFTER-EXIT.
           PERFORM 810-FIND-VERB.
           MOVE INSERT-AFTER-END TO TABLE-INDX.
           MOVE RECORD-NAME-DLIM-SAVE TO WORD-DLIM (TABLE-INDX).
           IF COL-NO-INDX NOT = 0
               COMPUTE SUB-J = TABLE-INDX + 1
               MOVE COL-SAVE TO COL-NO IN WORD-TABLE (SUB-J).
           GO TO 410-CALL-EXIT.
      /
      *
       450-WHICH-DMSRLSE.
           IF WORD-DLIM (TABLE-INDX) = '.'
               MOVE 1 TO CALL-INDX
               GO TO 452-WHICH-DMSRLSE-EXIT.
       451-WHICH-DMSRLSE.
           PERFORM 1010-NEXT-WORD.
           IF EOF
               MOVE TABLE-INDX-SAVE TO TABLE-INDX
               GO TO 452-WHICH-DMSRLSE-EXIT.
           IF VERB-FLAG (TABLE-INDX) = 'Y'
               MOVE 1 TO CALL-INDX
               MOVE TABLE-INDX TO COL-NO-INDX
               MOVE COL-NO IN WORD-TABLE (TABLE-INDX) TO COL-SAVE
               ADD -1 TO TABLE-INDX
           ELSE
               MOVE WORD-DLIM (TABLE-INDX) TO RECORD-NAME-DLIM-SAVE.
       452-WHICH-DMSRLSE-EXIT.
      /
      *
      *
      *        FINDS FINDSI FINDSEQ FINDLAST DELETAUT RESETERR FINDX
      *
      *
       456-MANUAL-CONVERT.
               IF CALL-INDX = 0
                   MOVE C05 TO ERR IN WORD-TABLE (TABLE-INDX)
               ELSE
                   IF CALL-INDX = 1
                       MOVE C06 TO ERR IN WORD-TABLE
                               (TABLE-INDX).
           IF WORD (TABLE-INDX) = 'FINDS'
               MOVE C01 TO MC-ERR (TABLE-INDX)
           ELSE
               IF WORD (TABLE-INDX) = 'FINDSI'
                   MOVE C02 TO MC-ERR (TABLE-INDX)
               ELSE
                   IF WORD (TABLE-INDX) = 'FINDSEQ'
                   ELSE
                       IF WORD (TABLE-INDX) = 'FINDLAST'
                           MOVE C04 TO MC-ERR (TABLE-INDX)
                       ELSE
                           IF WORD (TABLE-INDX) = 'DELEAUT'
                               MOVE C05 TO MC-ERR (TABLE-INDX)
                           ELSE
                               IF WORD (TABLE-INDX) = 'FINDX'
                                   MOVE C06 TO MC-ERR (TABLE-INDX).
           GO TO 410-CALL-EXIT.
      /
      *
      *
      *       FINDFRST
      *
      *
       460-FINDFRST.
           MOVE TABLE-INDX TO CLEAR-BEGIN.
           PERFORM 1010-NEXT-WORD.
           PERFORM 505-NAMEGP.
           IF ERR-CODE ZERO AND NAMETYPE IN NAMEGP = 2
               MOVE WORD-DLIM IN WORD-TABLE (TABLE-INDX) TO
                   DLIM-HOLD
               SUBTRACT 1 FROM TABLE-INDX
               PERFORM 1040-DELETE
               MOVE FIND-FIRST TO BUFFER
               SUBTRACT 1 FROM TABLE-INDX GIVING INSERT-AFTER
               PERFORM 1050-INSERT
               PERFORM 1010-NEXT-WORD
               MOVE SPACES TO WORD-DLIM IN WORD-TABLE (TABLE-INDX)
               MOVE USING-TEXT TO BUFFER
               MOVE TABLE-INDX TO INSERT-AFTER
               PERFORM 1050-INSERT
               MOVE 'I' TO GRP-FLAG
               PERFORM 510-UNITT
               PERFORM 515-GROUPRET
               MOVE TABLE-INDX TO CLEAR-END
               PERFORM 840-CLEAR-COL-NO
               MOVE DLIM-HOLD TO WORD-DLIM IN WORD-TABLE (TABLE-INDX)
               MOVE C03 TO ERR IN WORD-TABLE (TABLE-INDX)
           ELSE
               MOVE C10 TO MC-ERR (TABLE-INDX)
           GO TO 410-CALL-EXIT.
      /
      *
      *
      *       FINDG
      *
      *
       465-FINDG.
           COMPUTE CLEAR-BEGIN = START-SUB + 1.
           PERFORM 1010-NEXT-WORD.
           PERFORM 505-NAMEGP.
           IF ERR-CODE ZERO AND NAMETYPE IN NAMEGP = 2
               MOVE WORD-DLIM (TABLE-INDX) TO DLIM-HOLD
               PERFORM 510-UNITT
               IF LOCATMOD IN UNITT = 1
                   PERFORM 470-DIRECT
               ELSE
               IF LOCATMOD IN UNITT = 2
                   PERFORM 475-INDEXED
               ELSE
               IF LOCATMOD IN UNITT = 3
                   PERFORM 480-CALC
               ELSE
               IF LOCATMOD IN UNITT = 5
                   PERFORM 485-VIA
               ELSE
                   MOVE C10 TO MC-ERR (TABLE-INDX)
                   MOVE C05 TO ERR IN WORD-TABLE (TABLE-INDX)
           ELSE
               MOVE C10 TO MC-ERR (TABLE-INDX)
               MOVE C05 TO ERR IN WORD-TABLE (TABLE-INDX).
           GO TO 410-CALL-EXIT.
      /
       470-DIRECT.
           SUBTRACT 1 FROM TABLE-INDX.
           PERFORM 1040-DELETE
           MOVE FIND-VERB TO BUFFER.
           SUBTRACT 1 FROM TABLE-INDX GIVING INSERT-AFTER.
           PERFORM 1050-INSERT.
           PERFORM 1010-NEXT-WORD.
           MOVE SPACES TO WORD-DLIM IN WORD-TABLE (TABLE-INDX).
           MOVE FIND-DIRECT TO BUFFER.
           MOVE TABLE-INDX TO INSERT-AFTER.
           PERFORM 1050-INSERT.
           MOVE TABLE-INDX TO CLEAR-END.
           PERFORM 840-CLEAR-COL-NO.
           MOVE DLIM-HOLD TO WORD-DLIM IN WORD-TABLE (TABLE-INDX).
       475-INDEXED.
           SUBTRACT 1 FROM TABLE-INDX.
           PERFORM 1040-DELETE
           MOVE FIND-VERB TO BUFFER.
           SUBTRACT 1 FROM TABLE-INDX GIVING INSERT-AFTER.
           PERFORM 1050-INSERT.
           PERFORM 1010-NEXT-WORD.
           MOVE SPACES TO WORD-DLIM IN WORD-TABLE (TABLE-INDX).
           MOVE USING-TEXT TO BUFFER.
           MOVE TABLE-INDX TO INSERT-AFTER.
           PERFORM 1050-INSERT.
           MOVE 'I' TO GRP-FLAG.
           PERFORM 515-GROUPRET.
           MOVE TABLE-INDX TO CLEAR-END.
           PERFORM 840-CLEAR-COL-NO.
           MOVE C03 TO ERR IN WORD-TABLE (TABLE-INDX).
           MOVE DLIM-HOLD TO WORD-DLIM IN WORD-TABLE (TABLE-INDX).
       480-CALC.
           SUBTRACT 1 FROM TABLE-INDX.
           PERFORM 1040-DELETE.
           MOVE FIND-CALC TO BUFFER.
           SUBTRACT 1 FROM TABLE-INDX GIVING INSERT-AFTER.
           PERFORM 1050-INSERT.
           PERFORM 1010-NEXT-WORD.
           MOVE 0 TO COL-NO IN WORD-TABLE (TABLE-INDX).
           MOVE C03 TO ERR IN WORD-TABLE (TABLE-INDX).
       485-VIA.
           SUBTRACT 1 FROM TABLE-INDX.
           PERFORM 1040-DELETE
           MOVE FIND-VERB TO BUFFER.
           SUBTRACT 1 FROM TABLE-INDX GIVING INSERT-AFTER.
           PERFORM 1050-INSERT.
           PERFORM 1010-NEXT-WORD.
           MOVE SPACES TO WORD-DLIM IN WORD-TABLE (TABLE-INDX).
           MOVE WITHIN-TEXT TO BUFFER.
           MOVE TABLE-INDX TO INSERT-AFTER.
           PERFORM 1050-INSERT.
           MOVE 'S' TO GRP-FLAG.
           PERFORM 515-GROUPRET.
           MOVE USING-TEXT TO BUFFER.
           PERFORM 1050-INSERT.
           MOVE 'K' TO GRP-FLAG.
           PERFORM 515-GROUPRET.
           MOVE TABLE-INDX TO CLEAR-END.
           PERFORM 840-CLEAR-COL-NO.
           MOVE C03 TO ERR IN WORD-TABLE (TABLE-INDX).
           MOVE DLIM-HOLD TO WORD-DLIM IN WORD-TABLE (TABLE-INDX).
      *
      *
      *     FINDN
      *
      *
       490-FINDN.
           MOVE TABLE-INDX TO CLEAR-BEGIN.
           PERFORM 1010-NEXT-WORD.
           PERFORM 505-NAMEGP.
           IF ERR-CODE ZERO
               IF NAMETYPE IN NAMEGP = 1
                   PERFORM 520-OWNER
                   SUBTRACT 1 FROM TABLE-INDX
                   PERFORM 1040-DELETE
                   MOVE FIND-NEXT-SET  TO BUFFER
                   SUBTRACT 1 FROM TABLE-INDX GIVING INSERT-AFTER
                   PERFORM 1050-INSERT
                   PERFORM 1010-NEXT-WORD
                   MOVE 0 TO COL-NO IN WORD-TABLE (TABLE-INDX)
                   MOVE C03 TO ERR IN WORD-TABLE (TABLE-INDX)
                   MOVE 'N' TO TYPE-FIND IN LAST-EDMS-CALL
               ELSE
               IF NAMETYPE IN NAMEGP = 2
                   SUBTRACT 1 FROM TABLE-INDX
                   PERFORM 1040-DELETE
                   MOVE PART-1 IN FIND-NEXT-GRP TO BUFFER
                   SUBTRACT 1 FROM TABLE-INDX GIVING INSERT-AFTER
                   PERFORM 1050-INSERT
                   PERFORM 1010-NEXT-WORD
                   MOVE SPACES TO WORD-DLIM IN WORD-TABLE
                       (TABLE-INDX)
                   MOVE USING-TEXT TO BUFFER
                   MOVE TABLE-INDX TO INSERT-AFTER
                   PERFORM 1050-INSERT
                   MOVE 'I' TO GRP-FLAG
                   PERFORM 510-UNITT
                   PERFORM 515-GROUPRET
                   MOVE PART-2 IN FIND-NEXT-GRP TO BUFFER
                   MOVE TABLE-INDX TO INSERT-AFTER
                   PERFORM 1050-INSERT
                   MOVE TABLE-INDX TO CLEAR-END
                   PERFORM 840-CLEAR-COL-NO
               ELSE
                   MOVE C10 TO MC-ERR (TABLE-INDX)
                   MOVE C05 TO ERR IN WORD-TABLE (TABLE-INDX)
           ELSE
               MOVE C10 TO MC-ERR (TABLE-INDX)
               MOVE C05 TO ERR IN WORD-TABLE (TABLE-INDX).
           GO TO 410-CALL-EXIT.
      /
      *
      *
      *      FINDP
      *
      *
       500-FINDP.
           PERFORM 1010-NEXT-WORD.
           PERFORM 505-NAMEGP.
           IF ERR-CODE ZERO
               IF NAMETYPE IN NAMEGP = 1
                   PERFORM 520-OWNER
                   SUBTRACT 1 FROM TABLE-INDX
                   PERFORM 1040-DELETE
                   MOVE FIND-PRIOR-SET TO BUFFER
                   SUBTRACT 1 FROM TABLE-INDX GIVING INSERT-AFTER
                   PERFORM 1050-INSERT
                   PERFORM 1010-NEXT-WORD
                   MOVE 0 TO COL-NO IN WORD-TABLE (TABLE-INDX)
                   MOVE C03 TO ERR IN WORD-TABLE (TABLE-INDX)
                   MOVE 'N' TO TYPE-FIND IN LAST-EDMS-CALL
               ELSE
                   MOVE C05 TO ERR IN WORD-TABLE (TABLE-INDX)
                   MOVE C08 TO MC-ERR (TABLE-INDX)
           ELSE
               MOVE C10 TO MC-ERR (TABLE-INDX)
               MOVE C05 TO ERR IN WORD-TABLE (TABLE-INDX).
       505-NAMEGP.
           MOVE WORD IN WORD-TABLE (TABLE-INDX) TO NAMEVALU IN NAMEGP.
           ENTER FINDG, NAMEGP.
           IF ERR-CODE ZERO
               ENTER GET, NAMEGP
           ELSE
               DISPLAY 'NAMEGP ERROR ' NAMEVALU UPON PRINTER.
       510-UNITT.
           ENTER FINDN, NAMESET.
           PERFORM 525-NAMESET UNTIL GRP-NO = 18.
           ENTER FINDM, GNAMESET.
           ENTER GET, UNITT.
       515-GROUPRET.
           ENTER FINDN, GRPRET.
           PERFORM 530-KEYS UNTIL GRP-NO = 2.
       520-OWNER.
           ENTER FINDN, NAMESET.
           PERFORM 525-NAMESET UNTIL GRP-NO = 19.
           ENTER HEAD, SNAMESET.
           ENTER HEAD, OWNERSET.
           MOVE GROUPNO IN UNITT TO OWNER-NO.
       525-NAMESET.
           ENTER FINDN, NAMESET.
       530-KEYS.
           ENTER GET, GROUPRET.
           IF INDEX-GRP
               IF RTVLTYPE IN GROUPRET = 1
                   MOVE DATNAME TO BUFFER
                   MOVE TABLE-INDX TO INSERT-AFTER
                   PERFORM 1050-INSERT.
           IF VIA-GRP-SET
               IF RTVLTYPE IN GROUPRET = 3
                   MOVE DATNAME TO BUFFER
                   MOVE TABLE-INDX TO INSERT-AFTER
                   PERFORM 1050-INSERT.
           IF VIA-GRP-KEY
               IF RTVLTYPE IN GROUPRET = 5
                   MOVE DATNAME TO BUFFER
                   MOVE TABLE-INDX TO INSERT-AFTER
                   PERFORM 1050-INSERT.
           ENTER FINDN, GRPRET.
       540-DMSABORT.
           PERFORM 1010-NEXT-WORD.
           PERFORM 1040-DELETE.
           MOVE SPACES TO SEQ-TABLE.
           MOVE 0 TO SEQ-INDX.
           SUBTRACT 1 FROM TABLE-INDX.
           PERFORM 1010-NEXT-WORD.
           SUBTRACT 1 FROM TABLE-INDX.
           MOVE C07 TO MSG-PTR.
           GENERATE INFOLINE.
           MOVE C01 TO MSG-PTR.
           GO TO 410-CALL-EXIT.
       550-SETERR.
           PERFORM 1010-NEXT-WORD UNTIL VERB-FLAG IN WORD-TABLE
               (TABLE-INDX) = 'Y' OR WORD-DLIM IN WORD-TABLE
               (TABLE-INDX) = '.'.
           IF VERB-FLAG IN WORD-TABLE (TABLE-INDX) = 'Y'
               SUBTRACT 1 FROM TABLE-INDX.
           PERFORM 1040-DELETE.
           MOVE SPACES TO SEQ-TABLE.
           MOVE 0 TO SEQ-INDX.
           SUBTRACT 1 FROM TABLE-INDX.
           PERFORM 1010-NEXT-WORD.
           SUBTRACT 1 FROM TABLE-INDX.
           MOVE C08 TO MSG-PTR.
           GENERATE INFOLINE.
           MOVE C01 TO MSG-PTR.
           GO TO 410-CALL-EXIT.
       560-DMSRETRN.
           MOVE WORD-DLIM (TABLE-INDX) TO DLIM-HOLD.
           PERFORM 1040-DELETE.
           IF RECORDS-READ NOT = END-LINE IN PARG-REC
               SUBTRACT 1 FROM TABLE-INDX GIVING INSERT-AFTER
               ADD 1 TO RTN-NO IN RETRN-PARG
               MOVE RETRN-PARG    TO GOTO-TEXT
               MOVE DMSRETRN-TEXT TO BUFFER
               PERFORM 1050-INSERT
               MOVE DLIM-HOLD TO WORD-DLIM (TABLE-INDX)
               MOVE 'Y' TO PARG-FLAG
               PERFORM 1010-NEXT-WORD
               SUBTRACT 1 FROM TABLE-INDX
           ELSE
               MOVE 1 TO TABLE-INDX
               MOVE 0 TO TABLE-END.
           GO TO 410-CALL-EXIT.
      /
      *
      *
      *        THIS PROCEDURE TRANSLATES 'MOVE VALUE TO REF-CODE'.
      *
      *
       600-CK-REFCODE.
           MOVE TABLE-INDX TO START-SUB.
           PERFORM 1010-NEXT-WORD.
           MOVE TABLE-INDX TO CLEAR-BEGIN.
           PERFORM 660-FIND-VALUE.
           PERFORM 1010-NEXT-WORD.
           PERFORM 1030-CK-IT.
           IF WORD (TABLE-INDX) = 'TO'
               PERFORM 1010-NEXT-WORD
               IF WORD (TABLE-INDX) = 'REF-CODE'
                   MOVE WORD IN WORD-TABLE (TABLE-INDX) TO XREF-WORD
                       IN XREF-REC
                   PERFORM 3000-WRT-XREF
                   IF VALUE-MISSING
                       MOVE C04 TO ERR IN WORD-TABLE (TABLE-INDX)
                   ELSE
                   MOVE 'DIRECT-REFERENCE' TO WORD IN
                       WORD-TABLE(TABLE-INDX)
                   MOVE 16 TO WORD-LENGTH IN
                       WORD-TABLE(TABLE-INDX)
                   PERFORM 675-CK-PERIOD
                   MOVE WORD-DLIM(TABLE-INDX) TO DLIM-HOLD
                   MOVE SPACES TO WORD-DLIM(TABLE-INDX)
                   MOVE SET-DBKEY-TEXT TO BUFFER
                   MOVE TABLE-INDX TO INSERT-AFTER
                   PERFORM 1050-INSERT
                   MOVE TABLE-INDX TO CLEAR-END
                   PERFORM 840-CLEAR-COL-NO
                   MOVE DLIM-HOLD TO WORD-DLIM IN WORD-TABLE
                           (TABLE-INDX)
                   MOVE C03 TO ERR IN WORD-TABLE (TABLE-INDX)
               ELSE
                   MOVE START-SUB TO TABLE-INDX
           ELSE
               MOVE START-SUB TO TABLE-INDX.
      /
      *
      *
      *        THIS PROCEDURE TRANSLATES 'IF ERR-CODE', 'IF
      *        GRP-NO', 'IF SET-CURR', AND 'IF SET-OWNR'.
      *
      *
           MOVE TABLE-INDX TO START-SUB.
           PERFORM 1010-NEXT-WORD.
           IF WORD IN WORD-TABLE (TABLE-INDX) = 'ERR-CODE'
               PERFORM 620-CK-ERRCODE
           ELSE
           IF WORD IN WORD-TABLE (TABLE-INDX) = 'GRP-NO'
               PERFORM 630-CK-GRPNO
           ELSE
           IF WORD IN WORD-TABLE (TABLE-INDX) = 'SET-CURR' OR
               'SET-OWNR'
               PERFORM 640-CK-OWNER
           ELSE
               MOVE START-SUB TO TABLE-INDX.
       620-CK-ERRCODE.
           PERFORM 690-ERRCODE.
           MOVE SPACES TO HIT-FLAG, STRING-FLAG.
           PERFORM 680-CK-WORDS UNTIL STRING-DONE.
           IF EQUAL-CONDITION
               MOVE TABLE-INDX-SAVE TO TABLE-INDX
               PERFORM 650-CK-WORD
               PERFORM 660-FIND-VALUE
               IF VALUE-FOUND AND DIGITS-SAVE NOT ZERO
                   PERFORM 670-CONVERT THRU 674-CONVERT-EXIT
                   MOVE TABLE-INDX TO START-SUB.
           MOVE START-SUB TO TABLE-INDX.
       630-CK-GRPNO.
           IF LAST-EDMS-CALL = 'FN' OR 'GN'
               MOVE WORD IN WORD-TABLE (TABLE-INDX) TO XREF-WORD
                   IN XREF-REC
               MOVE SPACES TO HIT-FLAG, STRING-FLAG, NOT-FLAG
               PERFORM 680-CK-WORDS UNTIL STRING-DONE
               IF EQUAL-CONDITION
                   MOVE COL-NO IN WORD-TABLE (TABLE-INDX) TO
                       COL-SAVE
                   MOVE TABLE-INDX-SAVE TO TABLE-INDX
                   PERFORM 650-CK-WORD
                   PERFORM 660-FIND-VALUE
                   IF VALUE-FOUND AND DIGITS-SAVE = OWNER-NO
                       PERFORM 1040-DELETE
                       PERFORM 695-SET-TEXT
                       SUBTRACT 1 FROM TABLE-INDX GIVING
                           INSERT-AFTER
                       PERFORM 1050-INSERT
                       MOVE C03 TO ERR IN WORD-TABLE (TABLE-INDX)
                       MOVE TABLE-INDX TO TABLE-INDX-SAVE
                       PERFORM 1010-NEXT-WORD
                       COMPUTE CLEAR-END = TABLE-END - 1
                       COMPUTE CLEAR-BEGIN = START-SUB + 1
                       PERFORM 840-CLEAR-COL-NO
                       MOVE COL-SAVE TO COL-NO IN WORD-TABLE
                           (TABLE-INDX)
                       MOVE TABLE-INDX-SAVE TO START-SUB
                       PERFORM 3000-WRT-XREF.
           MOVE START-SUB TO TABLE-INDX.
       640-CK-OWNER.
           IF LAST-EDMS-CALL = 'FN' OR 'GN'
               MOVE SPACES TO CURR-FLAG, OWNR-FLAG
               PERFORM 685-SET-FLAGS
               MOVE SPACES TO HIT-FLAG, STRING-FLAG, NOT-FLAG
               PERFORM 680-CK-WORDS UNTIL STRING-DONE
               IF EQUAL-CONDITION
                   MOVE COL-NO IN WORD-TABLE (TABLE-INDX) TO
                       COL-SAVE
                   SUBTRACT 1 FROM TABLE-INDX
                   PERFORM 1000-LOOK VARYING TABLE-INDX FROM
                       TABLE-INDX BY -1 UNTIL WORD IN WORD-TABLE
                       (TABLE-INDX) NOT = SPACES
                   IF CURR AND OWNR
                       PERFORM 1040-DELETE
                       PERFORM 695-SET-TEXT
                       SUBTRACT 1 FROM TABLE-INDX GIVING
                           INSERT-AFTER
                       PERFORM 1050-INSERT
                       MOVE C03 TO ERR IN WORD-TABLE (TABLE-INDX)
                       MOVE TABLE-INDX TO TABLE-INDX-SAVE
                       COMPUTE CLEAR-END = TABLE-END - 1
                       COMPUTE CLEAR-BEGIN = START-SUB + 1
                       PERFORM 840-CLEAR-COL-NO
                       MOVE COL-SAVE TO COL-NO IN WORD-TABLE
                           (TABLE-INDX)
                       MOVE TABLE-INDX-SAVE TO START-SUB
                       MOVE 'SET-OWNR' TO XREF-WORD IN XREF-REC
                       PERFORM 3000-WRT-XREF
                       MOVE 'SET-CURR' TO XREF-WORD IN XREF-REC
                       PERFORM 3000-WRT-XREF.
           MOVE START-SUB TO TABLE-INDX.
       650-CK-WORD.
           PERFORM 1010-NEXT-WORD.
           IF WORD IN WORD-TABLE (TABLE-INDX) = 'TO'
               PERFORM 1010-NEXT-WORD.
       660-FIND-VALUE.
           MOVE SPACES TO VALUE-FLAG.
           MOVE ZERO TO DIGITS-SAVE.
           MOVE 10 TO SUB-Y.
           IF WORD-LENGTH (TABLE-INDX) > 10
               MOVE 10 TO SUB-I
           ELSE
               MOVE WORD-LENGTH (TABLE-INDX) TO SUB-I.
           PERFORM 665-MOVE VARYING SUB-X FROM SUB-I
                            BY -1 UNTIL SUB-X < 1.
           ADD 1 TO SUB-Y.
           IF DIGIT (SUB-Y) = '+' OR '-'
               MOVE '0' TO DIGIT (SUB-Y).
           IF NUMBER-SAVE IS NUMERIC
               MOVE 'Y' TO VALUE-FLAG.
       665-MOVE.
           MOVE WORD-CHAR (TABLE-INDX, SUB-X) TO DIGIT (SUB-Y).
           SUBTRACT 1 FROM SUB-Y.
       670-CONVERT.
           MOVE DIGITS-SAVE TO EDMS-VALUE IN EDMS-ERRCODE.
           MOVE LAST-CALL IN LAST-EDMS-CALL TO TYPE-CALL IN
               EDMS-ERRCODE.
       672-SEARCH.
           SEARCH ALL ERRCODES
               AT END
               WHEN EDMS-ERRCODE = ERRCODE-KEY IN ERRCODES (ERR-INDX)
                   NEXT SENTENCE.
           IF VALUE-FOUND
               IF IDS-MSG (ERR-INDX) = SPACES
                   MOVE IDS-ERRCODE (ERR-INDX) TO ERRCODE-FORMAT
                       IN ERRCODE-TEXT
                   MOVE ERRCODE-TEXT TO WORD IN WORD-TABLE
                       (TABLE-INDX)
                   MOVE 9 TO WORD-LENGTH IN WORD-TABLE (TABLE-INDX)
               ELSE
                   MOVE IDS-MSG (ERR-INDX) TO ERR IN WORD-TABLE
                       (TABLE-INDX).
           IF VALUE-MISSING
               IF TYPE-CALL IN EDMS-ERRCODE NOT = SPACES
                   MOVE SPACES TO TYPE-CALL IN EDMS-ERRCODE
                   MOVE 'Y' TO VALUE-FLAG
                   GO TO 672-SEARCH
               ELSE
                   MOVE C10 TO MC-ERR (TABLE-INDX)
                   MOVE C05 TO ERR IN WORD-TABLE (TABLE-INDX).
       674-CONVERT-EXIT.  EXIT.
      /
       675-CK-PERIOD.
           IF WORD-DLIM (TABLE-INDX) NOT = '.'
               MOVE TABLE-INDX TO TABLE-INDX-SAVE
               PERFORM 1010-NEXT-WORD
               IF WORD IN WORD-TABLE (TABLE-INDX) = 'OF' OR 'IN'
                   PERFORM 1060-DELETE THRU 1065-DELETE-EXIT
                      2 TIMES
               ELSE
                   MOVE TABLE-INDX-SAVE TO TABLE-INDX.
       680-CK-WORDS.
           PERFORM 1010-NEXT-WORD.
           IF VERB-FLAG IN WORD-TABLE (TABLE-INDX) = 'Y'
               MOVE 'Y' TO STRING-FLAG
           ELSE
           IF WORD IN WORD-TABLE (TABLE-INDX) = 'NEXT' OR
               'AND' OR 'OR'
               MOVE 'Y' TO STRING-FLAG
           ELSE
               MOVE 'Y' TO HIT-FLAG
               MOVE TABLE-INDX TO TABLE-INDX-SAVE
           ELSE
           IF WORD IN WORD-TABLE (TABLE-INDX) = 'NOT'
               MOVE 'Y' TO NOT-FLAG.
           PERFORM 685-SET-FLAGS.
       685-SET-FLAGS.
           IF WORD IN WORD-TABLE (TABLE-INDX) = 'SET-CURR'
               MOVE 'Y' TO CURR-FLAG
           ELSE
           IF WORD IN WORD-TABLE (TABLE-INDX) = 'SET-OWNR'
               MOVE 'Y' TO OWNR-FLAG.
       690-ERRCODE.
           MOVE WORD IN WORD-TABLE (TABLE-INDX) TO XREF-WORD
                IN XREF-REC.
           PERFORM 3000-WRT-XREF.
           MOVE 'DB-STATUS' TO WORD IN WORD-TABLE (TABLE-INDX).
           MOVE 9 TO WORD-LENGTH IN WORD-TABLE (TABLE-INDX).
           MOVE C03 TO ERR IN WORD-TABLE (TABLE-INDX).
       695-SET-TEXT.
           IF POSITIVE-CONDITION
               MOVE SET-TEST-POSITIVE TO BUFFER
           ELSE
               MOVE SET-TEST-NEGATIVE TO BUFFER.
      /
      *
      *
      *        THIS PROCEDURE GENERATES THE CROSS REFERENCE
      *        LIST AND CLOSES THE FILES.
      *
      *
       700-CLOSE SECTION.
       701-FINISH.
           GENERATE EOFLINE.
           TERMINATE SRCELIST.
           CLOSE INFILE, OUTFILE, DATACARDS, XREFFILE.
           ENTER CLOSEDB.
           SORT SORTFILE ASCENDING XREF-WORD IN SORT-REC
               USING XREFFILE
               OUTPUT PROCEDURE 720-XREF-PRT THRU 750-PRT-EXIT.
           CLOSE PRNTFILE.
       720-XREF-PRT SECTION.
       721-PRT.
           MOVE SPACES TO EOF-FLAG.
           RETURN SORTFILE AT END GO TO 750-PRT-EXIT.
           MOVE XREF-WORD IN SORT-REC TO SAVE-XREF, XREF-DATA.
           PERFORM 740-ZERO VARYING SUB FROM 1 BY 1 UNTIL
               SUB > 9.
           MOVE 0 TO SUB.
           PERFORM 730-GENERATE UNTIL EOF.
           GENERATE XREFLINE.
           TERMINATE XREFLIST.
           GO TO 750-PRT-EXIT.
       730-GENERATE.
           IF XREF-WORD IN SORT-REC NOT = SAVE-XREF
               GENERATE XREFLINE
               MOVE XREF-WORD IN SORT-REC TO SAVE-XREF, XREF-DATA
               PERFORM 740-ZERO VARYING SUB FROM 1 BY 1 UNTIL
                   SUB > 9
               MOVE 0 TO SUB.
           ADD 1 TO SUB.
           IF SUB > 9
               GENERATE XREFLINE
               MOVE SPACES TO XREF-DATA
               PERFORM 740-ZERO VARYING SUB FROM 1 BY 1 UNTIL
                   SUB > 9
               MOVE 1 TO SUB.
           MOVE XREF-LINE IN SORT-REC TO XREF-NUMB (SUB).
           RETURN SORTFILE AT END MOVE 'Y' TO EOF-FLAG.
       740-ZERO.
           MOVE ZEROS TO XREF-NUMB (SUB).
       750-PRT-EXIT SECTION.
       751-RETURN.  EXIT.
      /
       800-PERFORMED SECTION.
      ********************************************************************
      *
      *        THIS ROUTINE UNSTRINGS A BYTE  IMAGE INTO AN INTERNAL
      *        TABLE FOR USE BY OTHER PARTS OF THE PROGRAM.
      *        DESCRIBED BELOW ARE THE DATA ITEMS USED BY THIS ROUTINE
      *        AND THEIR MEANING.
      *
      *        BYTE              - THE BUFFER HOLDING THE BYTES IMAGE
      *        CARD-COL          - THE CURRENT POSITION IN THE BYTE BUFFER
      *        WORD-TABLE        - OCCURS TABLE-MAX TIMES
      *            WORD-LENGTH   - CONTAINS THE LENGTH OF THE ABOVE ENTRY
      *            WORD-DLIM     - CONTAINS THE DELIMITER AFTER THE ENTRY
      *        ISIC              - A VARIABLE USED TO CONTROL DELIMITERS
      *                           WITHIN QUOTE-MARKS
      *        SIC               - AN ARRAY USED WITH ISIC FOR THE SAME  REASON
      *        WORD-INDX         - THE BYTE LOCATION INTO WORD     WHEN
      *                            UNSTRINGING
      *        TABLE-START       - THE INDEX TO THE FIRST ENTRY IN WORD-TABLE
      *        TABLE-END         - THE INDEX OF THE LAST ENTRY IN WORD-TABLE
      *        SUB-I, SUB-J      - SUBSCRIPTS USED IN THE UNSTRING
      *                            PROCESS
      *        BEGIN-DATA        - THE COLUMN NUMBER OF THE BEGINNING
      *                            OF THE DATA IN THE BYTE  BUFFER. THIS
      *                            IS USED PRIMARILY FOR INDENTATION
      *        SUPPRESS-DLIM     - A FLAG USED TO SUPPRESS ALL CONTIGUOUS
      *                            DELIMITERS (0-DONT SUPPRESS, 1-DO SUPPRESS).
      *
      *
      *        NOTE THAT THE BYTE  BUFFER IS 1-BUFFER-SIZE BYTES LONG. THE
      *        WORD-TABLE IS A MAXIMUM OF TABLE-MAX ENTRIES.
      *        TABLE-START MUST BE SET ON ENTRY TO THIS ROUTINE.
      *
       800-UNSTRING.
           MOVE 1  TO CARD-COL.
           MOVE 0 TO WORD-INDX.
           IF COL-FLAG = 1
               PERFORM 838-CHK-COL-7.
           MOVE TABLE-START TO TABLE-END.
           ADD -1 TO TABLE-END.
           ADD -1 TO CARD-COL.
       800-UNSTRING-05.
           ADD 1 TO TABLE-END.
               DISPLAY '*** WORD TABLE OVERFLOW' UPON PRINTER
               GO TO 800-UNSTRING-102.
           MOVE SPACES TO WORD IN WORD-TABLE (TABLE-END)
                   VERB-FLAG IN WORD-TABLE (TABLE-END)
                   WORD-DLIM IN WORD-TABLE (TABLE-END).
           MOVE ZERO TO ERR IN WORD-TABLE (TABLE-END)
               MC-ERR IN WORD-TABLE (TABLE-END).
           MOVE 0 TO WORD-LENGTH IN WORD-TABLE (TABLE-END).
           IF TABLE-END > TABLE-START
               MOVE 0 TO COL-NO IN WORD-TABLE (TABLE-END).
       800-UNSTRING-10.
           ADD 1 TO CARD-COL.
           IF CARD-COL > BUFFER-SIZE GO TO 800-UNSTRING-101.
           IF ISIC = 1 GO TO 800-UNSTRING-22.
           MOVE 1 TO SUB-I.
       800-UNSTRING-20.
           IF BYTE  (CARD-COL) = DLIMTR (SUB-I)
              IF SUB-I = 2
                 MOVE CARD-COL TO SUB-L  ADD 1 TO SUB-L
                 IF BYTE (SUB-L) IS NUMERIC
                    GO TO 800-UNSTRING-21
                 ELSE
                    GO TO 800-UNSTRING-30
              ELSE
                 GO TO 800-UNSTRING-30.
       800-UNSTRING-21.
           ADD 1 TO SUB-I.
           IF SUB-I < 7 GO TO 800-UNSTRING-20.
      *  CHAR IS NOT A DELIMITER ' .;,()'
       800-UNSTRING-22.
           ADD 1 TO WORD-INDX.
           IF WORD-INDX > 30 MOVE 1 TO WORD-INDX
               MOVE 30 TO WORD-LENGTH     IN WORD-TABLE (TABLE-END)
               ADD 1 TO TABLE-END.
           MOVE BYTE  (CARD-COL) TO WORD-CHAR IN WORD-TABLE
                   (TABLE-END,WORD-INDX).
           MOVE WORD-INDX TO WORD-LENGTH IN WORD-TABLE (TABLE-END).
           IF BYTE (CARD-COL) = QUOTE-MARK
               MOVE SIC (ISIC) TO ISIC.
       800-UNSTRING-30.
           IF SUPPRESS-DLIM > 0 AND WORD-INDX = 0
               ADD -1 TO TABLE-END
           ELSE
               MOVE WORD-INDX TO WORD-LENGTH IN WORD-TABLE (TABLE-END)
               MOVE BYTE (CARD-COL) TO WORD-DLIM IN WORD-TABLE
                   (TABLE-END).
           MOVE 0 TO WORD-INDX.
           MOVE CARD-COL TO SUB-I.
           ADD 1 TO SUB-I.
       800-UNSTRING-35.
           IF SUB-I > BUFFER-SIZE GO TO 800-UNSTRING-102.
           IF BYTE  (SUB-I) NOT EQUAL TO SPACES GO TO 800-UNSTRING-05.
           ADD 1 TO SUB-I.
           GO TO 800-UNSTRING-35.
       800-UNSTRING-101.
       800-UNSTRING-102.
           MOVE 2 TO ISIC.
           PERFORM 802-SWITCH-PERIOD THRU 805-SWITCH-PERIOD-EXIT.
           PERFORM 810-FIND-VERB.
       800-UNSTRING-EXIT. EXIT.
      /
      *
      *        THIS PARAGRAPH MOVES ALL PERIODS UP WITH THE WORD ENTRIES
      *
       802-SWITCH-PERIOD.
           MOVE 0 TO SUB-J.
       803-SWITCH-PERIOD.
           ADD 1 TO SUB-J.
           IF SUB-J > TABLE-END GO TO 805-SWITCH-PERIOD-EXIT.
           IF WORD (SUB-J) = SPACES GO TO 803-SWITCH-PERIOD.
           IF WORD-DLIM (SUB-J) NOT = SPACES GO TO 803-SWITCH-PERIOD.
           MOVE SUB-J TO SUB-I.
       804-SWITCH-PERIOD.
           ADD 1 TO SUB-I.
           IF SUB-I > TABLE-END GO TO 805-SWITCH-PERIOD-EXIT.
           IF WORD (SUB-I) NOT = SPACES
               MOVE SUB-I TO SUB-J
               ADD -1 TO SUB-J
               GO TO 803-SWITCH-PERIOD.
           IF WORD-DLIM (SUB-I) = SPACES GO TO 804-SWITCH-PERIOD.
           IF WORD-DLIM (SUB-I) = '.'
               MOVE SPACES TO WORD-DLIM (SUB-I)
               GO TO 802-SWITCH-PERIOD.
       805-SWITCH-PERIOD-EXIT. EXIT.
      /
      *
      *
      *         THIS ROUTINE FLAGS THE WORDS IN THE WORD TABLE
      *        AND FINDS THE LAST OCCURENCE OF A VERB IN
      *        THE WORD-TABLE
      *
      *
       810-FIND-VERB.
           PERFORM 812-FIND-VERB VARYING SUB-J FROM 1 BY 1
               UNTIL SUB-J > TABLE-END.
       812-FIND-VERB.
           MOVE SPACES TO VERB-FLAG (SUB-J).
           SEARCH ALL VERB-TABLE
               WHEN VERB-TABLE (VERB-TABLE-INDX) = WORD (SUB-J)
                   MOVE 'Y' TO VERB-FLAG IN WORD-TABLE (SUB-J).
      /
      /
      *****************************************************************************(*******
      *
      *        THIS ROUTINE ALLOW A BUFFER TO BE UNSTRUNG IN THE WORD-TABLE
      *        AT A POINT SOMEWHERE IN THE MIDDLE OF THE TABLE.
      *        DATA FROM THAT POINT TO THE END OF THE TABLE IS SHIFTED DOWN
      *        TO MAKE ROOM FOR THE NEW DATA. UPON COMPLETION THE SHIFTED DATA
      *        IS MOVED BACK TO A POINT CONTIGUOUS WITH THE END OF THE DATA
      *        JUST UNSTRUNG.
      *
      *
      *        INSERT-AFTER      - THE VARIABLE TO INDICATE AFTER WHERE TO START
      *                            INSERTING DATA
      *        SUB-K             - AN INTERNAL FLAG USED FOR MOVING THE DATA TO THE
      *                            END OF THE TABLE
      *        INSERT-AFTER-END  - A VARIABLE TO INDICATE THE END OF THE
      *                            DATA JUST INSERTED
      *
       830-INSERT-AFTER.
           IF INSERT-AFTER = TABLE-END
               GO TO 830-INSERT-AFTER-EXIT.
           MOVE TABLE-END TO SUB-I.
           MOVE TABLE-MAX TO SUB-J.
       830-INSERT-AFTER-01.
           MOVE WORD-TABLE (SUB-I) TO WORD-TABLE (SUB-J).
           ADD -1 TO SUB-I SUB-J.
           IF SUB-I > INSERT-AFTER GO TO 830-INSERT-AFTER-01.
           MOVE INSERT-AFTER TO TABLE-START.
           ADD 1 TO TABLE-START SUB-J.
           MOVE SUB-J TO SUB-K.
           PERFORM 800-UNSTRING THRU 800-UNSTRING-EXIT.
           MOVE TABLE-END TO INSERT-AFTER-END.
       830-INSERT-AFTER-02.
           IF SUB-K > TABLE-MAX
               GO TO 830-INSERT-AFTER-EXIT.
           ADD 1 TO TABLE-END.
           MOVE WORD-TABLE (SUB-K) TO WORD-TABLE (TABLE-END).
           ADD 1 TO SUB-K.
           GO TO 830-INSERT-AFTER-02.
       830-INSERT-AFTER-EXIT.
       832-INSERT-AFTER.
           MOVE TABLE-END TO TABLE-START.
           ADD 1 TO TABLE-START.
           PERFORM 800-UNSTRING THRU 800-UNSTRING-EXIT.
           MOVE TABLE-END TO INSERT-AFTER-END.
       835-CLEAR-TO-END.
           MOVE TABLE-END TO SUB-J.
           ADD 1 TO SUB-J.
           IF SUB-J NOT > TABLE-MAX
               PERFORM 836-CLEAR VARYING SUB-I FROM SUB-J
                   BY 1 UNTIL SUB-I > TABLE-MAX.
       836-CLEAR.
           MOVE SPACES TO WORD IN WORD-TABLE (SUB-I),
               WORD-DLIM IN WORD-TABLE (SUB-I),
               VERB-FLAG IN WORD-TABLE (SUB-I).
           MOVE ZERO TO ERR IN WORD-TABLE (SUB-I).
           MOVE 0 TO WORD-LENGTH IN WORD-TABLE (SUB-I)
               MC-ERR IN WORD-TABLE (SUB-I).
           MOVE ZERO TO COL-NO IN WORD-TABLE (SUB-I).
       838-CHK-COL-7.
           IF BYTE (CARD-COL) = '-' OR '/'
               MOVE SPACES TO WORD IN WORD-TABLE (TABLE-START)
                   VERB-FLAG IN WORD-TABLE (TABLE-START)
               MOVE 0 TO ERR IN WORD-TABLE (TABLE-START)
                   MC-ERR IN WORD-TABLE (TABLE-START)
                   WORD-LENGTH IN WORD-TABLE (TABLE-START)
               MOVE BYTE (CARD-COL) TO WORD-DLIM IN WORD-TABLE
                   (TABLE-START)
               MOVE 1 TO COL-NO IN WORD-TABLE (TABLE-START)
               ADD 1 TO CARD-COL TABLE-START
           ELSE
           PERFORM 1000-LOOK VARYING SUB-I FROM CARD-COL BY 1
               UNTIL SUB-I > TABLE-MAX OR BYTE (SUB-I) NOT = SPACES
           MOVE SUB-I TO COL-NO IN WORD-TABLE (TABLE-START)
           MOVE SUB-I TO CARD-COL.
       840-CLEAR-COL-NO.
           PERFORM 841-CLEAR-COL-NO VARYING SUB-J FROM CLEAR-BEGIN
               BY 1 UNTIL SUB-J > CLEAR-END.
       841-CLEAR-COL-NO.
           MOVE 0 TO COL-NO IN WORD-TABLE (SUB-J).
           IF WORD-DLIM IN WORD-TABLE (SUB-J) = '/' OR '-'
               MOVE SPACES TO WORD-DLIM IN WORD-TABLE (SUB-J).
       845-SAVE-COL.
           MOVE COL-NO IN WORD-TABLE (START-SUB) TO COL-SAVE.
           MOVE 0 TO COL-NO IN WORD-TABLE (START-SUB).
       848-REST-COL.
           MOVE COL-SAVE TO COL-NO IN WORD-TABLE (START-SUB).
      /
      *
      *
      *        THIS PROCEDURE STRINGS THE SOURCE LINE AND
      *        WRITES IT OUT.
      *
      *
       850-STRING.
           MOVE SPACES TO STRING-BUFFER.
           MOVE MAX-SIZE TO SPACE-AVAIL.
           MOVE 0 TO MSG-CTR.
           MOVE 1 TO SEQ-PTR.
           PERFORM 860-MOVE-WORD THRU 865-WORD-EXIT VARYING
               TABLE-INDX FROM 1 BY 1 UNTIL
               TABLE-INDX > TABLE-END OR
               TABLE-INDX > TABLE-MAX.
           IF STRING-BUFFER NOT = SPACES
               MOVE STRING-BUFFER TO RECORD-OUT
               PERFORM 910-WRITE
               MOVE SPACES TO SEQ-TABLE
               MOVE 0 TO SEQ-INDX.
       860-MOVE-WORD.
           IF WORD-CHAR IN WORD-TABLE (TABLE-INDX, 1) = QUOTE-MARK
               PERFORM 885-STRING-LIT THRU 887-LIT-EXIT.
           IF TABLE-INDX > TABLE-END
               GO TO 865-WORD-EXIT.
           COMPUTE WORD-SIZE = WORD-LENGTH IN WORD-TABLE (TABLE-INDX)
               + 1.
           IF WORD-SIZE > SPACE-AVAIL OR
               COL-NO IN WORD-TABLE (TABLE-INDX) > 0
               PERFORM 870-WRITE-OUT.
           PERFORM 880-MOVE-CHAR VARYING SUB FROM 1 BY 1 UNTIL
               SUB > WORD-LENGTH IN WORD-TABLE (TABLE-INDX).
           MOVE WORD-DLIM IN WORD-TABLE (TABLE-INDX) TO
               OUTBYTE (STRING-PTR).
           IF ERR IN WORD-TABLE (TABLE-INDX) > 0
               ADD 1 TO MSG-CTR
               MOVE ERR IN WORD-TABLE (TABLE-INDX) TO
                   MSG-PTR-SAVE (MSG-CTR)
               IF ERR IN WORD-TABLE (TABLE-INDX) = C05
                   MOVE MC-ERR (TABLE-INDX) TO MC-INDX
                   MOVE MC-ERR-TABLE (MC-INDX) TO MSG-PART2 (C05).
           ADD 1 TO STRING-PTR.
           COMPUTE SPACE-AVAIL = MAX-SIZE - STRING-PTR + 1.
       865-WORD-EXIT.  EXIT.
      /
       870-WRITE-OUT.
           IF STRING-BUFFER NOT = SPACES
               MOVE STRING-BUFFER TO RECORD-OUT
               PERFORM 910-WRITE
               MOVE SPACES TO STRING-BUFFER.
           IF SEQ-INDX > 0
               MOVE IDENT  (SEQ-PTR)  TO COL73-80 IN STRING-BUFFER
               MOVE SPACES TO SEQ-ENTRY (SEQ-PTR)
               ADD 1 TO SEQ-PTR
               SUBTRACT 1 FROM SEQ-INDX.
           IF COL-NO IN WORD-TABLE (TABLE-INDX) > 0
               MOVE COL-NO IN WORD-TABLE (TABLE-INDX) TO
                   STRING-PTR, STRING-START
           ELSE
               COMPUTE STRING-PTR = STRING-START + 4.
           COMPUTE SPACE-AVAIL = MAX-SIZE - STRING-PTR + 1.
           IF SPACE-AVAIL < 1 OR WORD-SIZE > SPACE-AVAIL
               MOVE 16 TO STRING-PTR
               MOVE 16 TO STRING-START
               MOVE 56 TO SPACE-AVAIL.
       880-MOVE-CHAR.
           MOVE WORD-CHAR (TABLE-INDX, SUB) TO OUTBYTE (STRING-PTR).
           ADD 1 TO STRING-PTR.
       885-STRING-LIT.
           MOVE WORD-LENGTH (TABLE-INDX) TO SUB.
           IF WORD-CHAR (TABLE-INDX, SUB) = QUOTE-MARK
               GO TO 887-LIT-EXIT.
           MOVE SPACES TO LIT-TEXT, LIT-FLAG.
           MOVE ZEROS TO LIT-PTR.
           MOVE COL-NO IN WORD-TABLE (TABLE-INDX) TO LIT-START.
           MOVE ZEROS TO COL-NO IN WORD-TABLE (TABLE-INDX).
           PERFORM 890-CK-LIT VARYING TABLE-INDX FROM TABLE-INDX
               BY 1 UNTIL LIT-END OR TABLE-INDX > TABLE-END OR
               COL-NO IN WORD-TABLE (TABLE-INDX) > 0.
           IF LIT-PTR > SPACE-AVAIL
               MOVE STRING-BUFFER TO RECORD-OUT
               PERFORM 910-WRITE
               MOVE SPACES TO STRING-BUFFER
               IF LIT-END
                   SUBTRACT 1 FROM TABLE-INDX
                   COMPUTE STRING-PTR = STRING-START + 4
               ELSE
                   COMPUTE STRING-PTR = MAX-SIZE - LIT-PTR + 1
               IF LIT-END
                   PERFORM 896-CK-STRING-PTR
                   SUBTRACT 1 FROM TABLE-INDX
               ELSE
                   COMPUTE STRING-PTR = MAX-SIZE - LIT-PTR + 1.
           PERFORM 894-MOVE-STRING VARYING SUB-X FROM 1 BY 1
               UNTIL SUB-X > LIT-PTR.
           COMPUTE SPACE-AVAIL = MAX-SIZE - STRING-PTR + 1.
       887-LIT-EXIT.  EXIT.
      /
       890-CK-LIT.
           PERFORM 892-MOVE-LIT VARYING SUB-X FROM 1 BY 1 UNTIL
               SUB-X > WORD-LENGTH (TABLE-INDX).
           IF LIT-BYTE (LIT-PTR) = QUOTE-MARK
               ADD 1 TO LIT-PTR
               MOVE WORD-DLIM IN WORD-TABLE (TABLE-INDX) TO
                   LIT-BYTE (LIT-PTR)
               MOVE 'Y' TO LIT-FLAG
               ADD 1 TO TABLE-INDX.
       892-MOVE-LIT.
           ADD 1 TO LIT-PTR.
           MOVE WORD-CHAR (TABLE-INDX, SUB-X) TO LIT-BYTE (LIT-PTR).
       894-MOVE-STRING.
           MOVE LIT-BYTE (SUB-X) TO OUTBYTE (STRING-PTR).
           ADD 1 TO STRING-PTR.
       896-CK-STRING-PTR.
           IF LIT-START > 0
               COMPUTE SPACE-AVAIL = MAX-SIZE - LIT-START + 1
               IF LIT-PTR > SPACE-AVAIL
                   COMPUTE STRING-PTR = STRING-START + 4
               ELSE
                   MOVE LIT-START TO STRING-PTR.
       900-READ.
           MOVE SPACES TO COBOL-CARD, COBOL-FLAG.
           READ INFILE AT END
               MOVE 'Y' TO EOF-FLAG.
           IF NOT EOF
               ADD 1 TO RECORDS-READ
               PERFORM 940-CK-SKIP
               IF OK
                   IF COL7 IN COBOL-CARD = '*' OR
                       COL8-72  IN COBOL-CARD = SPACES
                       PERFORM 910-WRITE
                       MOVE SPACES TO SEQ-TABLE
                       MOVE 0 TO SEQ-INDX
                   ELSE
                       MOVE 'Y' TO COBOL-FLAG
                       MOVE 1 TO COL-FLAG
                       PERFORM 920-READ-FLAGS.
       910-WRITE.
           ADD 1 TO RECORD-KEY.
           MOVE 1 TO MSG-SUB.
           IF MSG-CTR > 0
               MOVE MSG-PTR-SAVE (MSG-SUB) TO MSG-PTR
               ADD 1 TO MSG-SUB.
           WRITE RECORD-OUT.
           GENERATE PRNTLINE.
           COMPUTE XREF-NO = RECORD-KEY + 1.
           IF MSG-CTR > 0
               PERFORM 930-GEN-INFO VARYING MSG-SUB FROM MSG-SUB
                   BY 1 UNTIL MSG-SUB > MSG-CTR.
           MOVE 0 TO MSG-CTR.
           MOVE C01 TO MSG-PTR.
       920-READ-FLAGS.
           IF COL8-11 IN COBOL-CARD NOT = SPACES
               MOVE SPACES TO LAST-EDMS-CALL.
           ADD 1 TO SEQ-INDX.
           IF SEQ-INDX > SEQ-MAX
               MOVE SPACES TO SEQ-TABLE
               MOVE 1 TO SEQ-INDX.
           MOVE COL1-6 IN COBOL-CARD TO SEQ-NO (SEQ-INDX).
           MOVE COL73-80 IN COBOL-CARD TO IDENT (SEQ-INDX).
       930-GEN-INFO.
           MOVE MSG-PTR-SAVE (MSG-SUB) TO MSG-PTR.
           GENERATE INFOLINE.
       940-CK-SKIP.
           MOVE SPACES TO SKIP-FLAG.
           IF SKIP-SUB > SKIP-MAX OR SKIP-MAX = 0
               NEXT SENTENCE
           ELSE
           IF RECORDS-READ = SKIP-BEGIN (SKIP-SUB)
               MOVE 'Y' TO SKIP-FLAG
           ELSE
           IF RECORDS-READ > SKIP-BEGIN (SKIP-SUB) AND
               < SKIP-END (SKIP-SUB)
           ELSE
           IF RECORDS-READ = SKIP-END (SKIP-SUB)
               MOVE 'Y' TO SKIP-FLAG
               ADD 1 TO SKIP-SUB.
       1000-LOOK.
           EXIT.
      /
       1010-NEXT-WORD.
           ADD 1 TO TABLE-INDX.
           PERFORM 1000-LOOK VARYING TABLE-INDX FROM TABLE-INDX BY 1
               UNTIL WORD IN WORD-TABLE (TABLE-INDX) NOT = SPACES OR
               TABLE-INDX > TABLE-END.
           IF TABLE-INDX > TABLE-END
               PERFORM 1020-READ-AGAIN.
       1020-READ-AGAIN.
           MOVE SPACES TO COBOL-FLAG.
           PERFORM 900-READ UNTIL COBOL-FOUND OR EOF.
           IF NOT EOF
               MOVE COL7-72 IN COBOL-CARD TO BUFFER
               MOVE 0 TO SUPPRESS-DLIM
               MOVE TABLE-END TO TABLE-START
               ADD 1 TO TABLE-START
               PERFORM 800-UNSTRING THRU 800-UNSTRING-EXIT.
       1030-CK-IT.
           IF WORD (TABLE-INDX) = 'OF' OR 'IN'
               PERFORM 1010-NEXT-WORD
               PERFORM 1010-NEXT-WORD.
       1040-DELETE.
           COMPUTE DELETE-IT = TABLE-INDX - START-SUB + 1.
           MOVE START-SUB TO TABLE-INDX.
           PERFORM 1060-DELETE THRU 1065-DELETE-EXIT DELETE-IT TIMES.
       1050-INSERT.
           PERFORM 830-INSERT-AFTER THRU 830-INSERT-AFTER-EXIT.
           MOVE SPACES TO WORD-DLIM IN WORD-TABLE (INSERT-AFTER-END).
           PERFORM 810-FIND-VERB.
           MOVE INSERT-AFTER-END TO TABLE-INDX.
      /
      ************************************************************
      *
      *   THIS PROCEDURE DELETES AN ENTRY FROM THE WORD TABLE AT
      *   LOCATION TABLE-INDX AND SHIFTS THE TABLE UP 1
       1060-DELETE.
           MOVE TABLE-INDX TO SUB-I.
           MOVE WORD-DLIM IN WORD-TABLE (TABLE-INDX) TO WORD-DLIM-SAVE.
           MOVE COL-NO IN WORD-TABLE (TABLE-INDX) TO COL-NO-SAVE.
       1062-DELETE.
           ADD 1 TO SUB-I.
           IF SUB-I NOT > TABLE-END
               MOVE WORD-TABLE (SUB-I) TO WORD-TABLE (SUB-J)
               ADD 1 TO SUB-J
               GO TO 1062-DELETE.
           ADD -1 TO TABLE-END.
           MOVE COL-NO-SAVE TO COL-NO IN WORD-TABLE (TABLE-INDX).
           IF WORD-DLIM-SAVE = '-' OR '/' MOVE WORD-DLIM-SAVE
               TO WORD-DLIM IN WORD-TABLE (TABLE-INDX).
           PERFORM 810-FIND-VERB.
       1065-DELETE-EXIT. EXIT.
      /
       2000-DECL-READ.
           MOVE RECORDS-READ TO END-LINE IN PARG-REC.
           PERFORM 2050-READ.
           IF NOT EOF
               IF COL7 IN COBOL-CARD NOT = '*'
                   IF COL8-72 IN COBOL-CARD NOT = SPACES
                       MOVE 'Y' TO COBOL-FLAG
                       PERFORM 2010-DECL-UNSTRING.
       2010-DECL-UNSTRING.
           MOVE COL7-72 IN COBOL-CARD TO BUFFER.
           MOVE 0 TO SUPPRESS-DLIM.
           MOVE 1 TO TABLE-START.
           MOVE 1 TO COL-FLAG.
           PERFORM 800-UNSTRING THRU 800-UNSTRING-EXIT.
           IF COL8-11 IN COBOL-CARD NOT = SPACES
               PERFORM 2020-PARG-REC
           ELSE
               MOVE 1 TO TABLE-INDX.
       2020-PARG-REC.
           IF PARG-NAME IN PARG-REC NOT = SPACES
               WRITE PARG-REC.
           MOVE SPACES TO PARG-NAME IN PARG-REC.
           MOVE 0 TO TABLE-INDX.
           PERFORM 2030-ANOTHER-WORD.
               PARG-REC.
           MOVE RECORDS-READ TO BEGIN-LINE IN PARG-REC.
           ADD 1 TO TABLE-INDX.
       2030-ANOTHER-WORD.
           ADD 1 TO TABLE-INDX.
           PERFORM 1000-LOOK VARYING TABLE-INDX FROM TABLE-INDX
               BY 1 UNTIL WORD IN WORD-TABLE (TABLE-INDX) NOT
               = SPACES OR TABLE-INDX > TABLE-END.
           IF TABLE-INDX > TABLE-END
               MOVE SPACES TO COBOL-FLAG
               PERFORM 2000-DECL-READ UNTIL COBOL-FOUND OR EOF.
       2050-READ.
           MOVE SPACES TO COBOL-CARD, COBOL-FLAG.
           READ INFILE AT END MOVE 'Y' TO EOF-FLAG.
           IF NOT EOF
               ADD 1 TO RECORDS-READ.
       2070-READ-PARG.
           READ PARGFILE AT END MOVE 'Y' TO EOF-FLAG.
       3000-WRT-XREF.
           MOVE XREF-NO TO XREF-LINE IN XREF-REC.
           WRITE XREF-REC.
      /
      *
      *        THIS PROCEDURE IS TO PRINT THE TABLE FOR DEBUG PURPOSES
      *
       9999-DISPLAY-TABLE.
           DISPLAY 'TABLE-END=', TABLE-END              'TABLE-INDX'
               TABLE-INDX 'I-A' INSERT-AFTER 'I-A-E' INSERT-AFTER-END
               UPON PRINTER.
           PERFORM 9999-PRINT VARYING SUB-I FROM 1 BY 1 UNTIL
               SUB-I > TABLE-END.
       9999-PRINT.
           DISPLAY '*', COL-NO IN WORD-TABLE (SUB-I),
               '*', ERR IN WORD-TABLE (SUB-I),
               '*', VERB-FLAG IN WORD-TABLE (SUB-I)
               '*', WORD-DLIM IN WORD-TABLE (SUB-I),
               '*', WORD-LENGTH IN WORD-TABLE (SUB-I),
               '*', WORD IN WORD-TABLE (SUB-I) UPON PRINTER.
       DUMP-WORDS.
           DISPLAY 'WORD=' WORD (SEQ-INDX) UPON PRINTER.
      /
       CHANGE-NAMES.
            PERFORM CHECK-HYPHENS THRU END-HYPHENS VARYING CHAR-COUNT
            FROM 2 BY 1 UNTIL TEMP-NAME2(CHAR-COUNT) = ' '.
            IF TEMP-NAME2(1) IS NOT ALPHABETIC
            PERFORM APPEND-YZ THRU END-APPEND-YZ VARYING CHAR-COUNT
              FROM 30 BY -1 UNTIL CHAR-COUNT < 2
            MOVE 'Z' TO TEMP-NAME2(1)
            GO TO END-CHANGE-NAMES.
            PERFORM CHECK-RESWORDS THRU END-RESWORDS
            VARYING CHAR-COUNT FROM 1 BY 1 UNTIL CHAR-COUNT > 169.
            GO TO END-CHANGE-NAMES.
       CHECK-HYPHENS.
            IF TEMP-NAME2(CHAR-COUNT) = '-'
            MOVE '_' TO TEMP-NAME2(CHAR-COUNT).
       END-HYPHENS. EXIT.
       CHECK-RESWORDS.
            MOVE RES-WORD-TABLE(CHAR-COUNT) TO TEMP-NAME3.
            IF TEMP-NAME2(1) < TEMP-NAME4(1) GO TO END-CHANGE-NAMES.
            IF TEMP-NAME = RES-WORD-TABLE(CHAR-COUNT)
            PERFORM APPEND-YZ THRU END-APPEND-YZ VARYING CHAR-COUNT
              FROM 17 BY -1 UNTIL CHAR-COUNT < 2
            MOVE 'Z' TO TEMP-NAME2(1)
            MOVE TEMP-NAME TO CHANGE-RESERVED-NAME
            GO TO END-CHANGE-NAMES.
       END-RESWORDS. EXIT.
       APPEND-YZ.
            COMPUTE CHAR2 = CHAR-COUNT - 1.
            MOVE TEMP-NAME2(CHAR2) TO TEMP-NAME2(CHAR-COUNT).
       END-APPEND-YZ. EXIT.
       END-CHANGE-NAMES. EXIT.
