*DECK DCDMS324
       IDENTIFICATION DIVISION. 
       PROGRAM-ID.   DMS324.
  
      ******************************************************************
      * 
      * THIS MODULE PROCESSES THE GENERATION OF A CDCS (DMS-170)
      * SUBSCHEMA.  ALL INPUT/OUTPUT IS DONE THROUGH A TEMPORARY EXIT 
      * BACK TO "DMS300". 
      * 
      ******************************************************************
  
       ENVIRONMENT DIVISION.
  
       CONFIGURATION SECTION. 
       SOURCE-COMPUTER.   CYBER.
       OBJECT-COMPUTER.   CYBER.
  
      ******************************************************************
      * 
       DATA DIVISION. 
  
  
      ******************************************************************
      * 
*CALL GENCS 
  
  
      ******************************************************************
      * 
       WORKING-STORAGE SECTION. 
*CALL DATAGEN 
  
      ******************************************************************
      * 
      * ITEMS SPECIFIC TO SUBSCHEMA GENERATION. 
  
      ******************************************************************
      * 
      * VALUES RELATED TO INDENTATION OF SUBSCHEMA LINES. 
      * 
       01  INDENT-VALUES. 
           03  INDENT-INIT        PICTURE 99     VALUE 8. 
           03  INDENT-INC         PICTURE 99     VALUE 4. 
           03  INDENT-MAX         PICTURE 99     VALUE 40.
  
      ******************************************************************
      * 
      * THESE FIELDS ARE USED DURING GENERATION OF THE ALIAS DIVISION.
      * 
       01  DNAMES.
           03  ALIAS-DNAME        PICTURE X(30).
           03  ORIG-DNAME         PICTURE X(30).
           03  SCH-REC-DNAME      PICTURE X(30).
           03  QUAL-DNAME         PICTURE X(30)  OCCURS 5 TIMES.
           03  QUAL-CNT           PICTURE 9.
           03  QUAL-IDX           PICTURE 9.
  
      ******************************************************************
      * 
      * THESE FIELDS ARE USED DURING GENERATION OF DATA DESCRIPTIONS. 
      * 
       01  DATA-DESCR-FIELDS. 
           03  ALIAS-ATTRIBS. 
               05  ALIAS-JUST     PICTURE X.
               05  ALIAS-SYNC     PICTURE X.
               05  ALIAS-PIC      PICTURE X(25).
           03  ATT-IN-CON         PICTURE X.
           03  COLUMNS-LEFT       PICTURE 99. 
           03  SAVE-ALIAS         PICTURE X(4). 
           03  SAVE-INDENT        PICTURE 99. 
           03  SAVE-PIC           PICTURE X(25).
           03  SAVE-SYNC          PICTURE X.
  
      ******************************************************************
      * 
      * THESE FIELDS ARE USED DURING GENERATION OF RESTRICT ENTRIES.
      * 
       01  RESTR-SUBS.
           03  RESTR-SUB1         PICTURE X(4). 
           03  RESTR-SUB2         PICTURE X(4). 
           03  RESTR-SUB3         PICTURE X(4). 
  
      ******************************************************************
      * 
      * THESE FIELDS ARE USED DURING GENERATION OF RENAMES ENTRIES. 
      * 
       01  RENAME-FLDS. 
           03  DMS-RENAME         PICTURE X      VALUE "N". 
           03  OUT-RENAME         PICTURE X      VALUE "N". 
           03  LINK-POSN          PICTURE 9(10)  USAGE COMP-1.
           03  PREV-FWA           PICTURE 9(10)  USAGE COMP-1.
           03  RENAME-FWA         PICTURE 9(10)  USAGE COMP-1.
           03  RENAME-SIZE        PICTURE 9(10)  USAGE COMP-1  VALUE 9. 
  
      ******************************************************************
      * 
       01  MISCELLANEOUS. 
           03  PICK-IDX           PICTURE 99. 
  
      ******************************************************************
      * 
      * LIST OF KEYWORDS/PHRASES USED IN SUBSCHEMA GENERATION.
      * 
       01  KEYWORD-LIST.
           03  KW-AD-DATA         PICTURE X(7)   VALUE "AD DATA". 
           03  KW-AD-DATA-LEN     PICTURE 99     VALUE 7. 
           03  KW-AD-REC          PICTURE X(9)   VALUE "AD RECORD". 
           03  KW-AD-REC-LEN      PICTURE 99     VALUE 9. 
           03  KW-AD-RLM          PICTURE X(8)   VALUE "AD REALM".
           03  KW-AD-RLM-LEN      PICTURE 99     VALUE 8. 
           03  KW-ALIAS-DIV       PICTURE X(15)  VALUE
                                  "ALIAS DIVISION.".
           03  KW-ALIAS-DIV-LEN   PICTURE 99     VALUE 15.
           03  KW-AND             PICTURE X(3)   VALUE "AND". 
           03  KW-AND-LEN         PICTURE 99     VALUE 3. 
           03  KW-AND-NOT         PICTURE X(7)   VALUE "AND NOT". 
           03  KW-AND-NOT-LEN     PICTURE 99     VALUE 7. 
           03  KW-ASCEND          PICTURE X(11)  VALUE "  ASCENDING". 
           03  KW-ASCEND-LEN      PICTURE 99     VALUE 11.
           03  KW-BECOMES         PICTURE X(7)   VALUE "BECOMES". 
           03  KW-BECOMES-LEN     PICTURE 99     VALUE 7. 
           03  KW-COMP            PICTURE X(4)   VALUE "COMP".
           03  KW-COMP-LEN        PICTURE 99     VALUE 4. 
           03  KW-COMP-1          PICTURE X(6)   VALUE "COMP-1".
           03  KW-COMP-1-LEN      PICTURE 99     VALUE 6. 
           03  KW-COMP-2          PICTURE X(6)   VALUE "COMP-2".
           03  KW-COMP-2-LEN      PICTURE 99     VALUE 6. 
           03  KW-DEP-ON          PICTURE X(12)  VALUE "DEPENDING ON".
           03  KW-DEP-ON-LEN      PICTURE 99     VALUE 12.
           03  KW-DESCEND         PICTURE X(12)  VALUE "  DESCENDING".
           03  KW-DESCEND-LEN     PICTURE 99     VALUE 12.
           03  KW-DISPLAY         PICTURE X(7)   VALUE "DISPLAY". 
           03  KW-DISPLAY-LEN     PICTURE 99     VALUE 7. 
           03  KW-FILLER          PICTURE X(6)   VALUE "FILLER".
           03  KW-FILLER-LEN      PICTURE 99     VALUE 6. 
           03  KW-IDX-BY          PICTURE X(12)  VALUE "  INDEXED BY".
           03  KW-IDX-BY-LEN      PICTURE 99     VALUE 12.
           03  KW-INDEX           PICTURE X(5)   VALUE "INDEX". 
           03  KW-INDEX-LEN       PICTURE 99     VALUE 5. 
           03  KW-JUST-RT         PICTURE X(15)  VALUE
                                  "JUSTIFIED RIGHT".
           03  KW-JUST-RT-LEN     PICTURE 99     VALUE 15.
           03  KW-KEY-IS          PICTURE X(6)   VALUE "KEY IS".
           03  KW-KEY-IS-LEN      PICTURE 99     VALUE 6. 
           03  KW-LEFT            PICTURE X(4)   VALUE "LEFT".
           03  KW-LEFT-LEN        PICTURE 99     VALUE 4. 
           03  KW-NOT             PICTURE X(3)   VALUE "NOT". 
           03  KW-NOT-LEN         PICTURE 99     VALUE 3. 
           03  KW-OCCURS          PICTURE X(6)   VALUE "OCCURS".
           03  KW-OCCURS-LEN      PICTURE 99     VALUE 6. 
           03  KW-OF              PICTURE X(2)   VALUE "OF".
           03  KW-OF-LEN          PICTURE 99     VALUE 2. 
           03  KW-OR              PICTURE X(2)   VALUE "OR".
           03  KW-OR-LEN          PICTURE 99     VALUE 2. 
           03  KW-OR-NOT          PICTURE X(6)   VALUE "OR NOT".
           03  KW-OR-NOT-LEN      PICTURE 99     VALUE 6. 
           03  KW-PICTURE         PICTURE X(7)   VALUE "PICTURE". 
           03  KW-PICTURE-LEN     PICTURE 99     VALUE 7. 
           03  KW-RD              PICTURE X(2)   VALUE "RD".
           03  KW-RD-LEN          PICTURE 99     VALUE 2. 
           03  KW-REALM-DIV       PICTURE X(15)  VALUE
                                  "REALM DIVISION.".
           03  KW-REALM-DIV-LEN   PICTURE 99     VALUE 15.
           03  KW-REC-DIV         PICTURE X(16)  VALUE
                                  "RECORD DIVISION.". 
           03  KW-REC-DIV-LEN     PICTURE 99     VALUE 16.
           03  KW-REDEF           PICTURE X(9)   VALUE "REDEFINES". 
           03  KW-REDEF-LEN       PICTURE 99     VALUE 9. 
           03  KW-REL-DIV         PICTURE X(18)  VALUE
                                  "RELATION DIVISION.". 
           03  KW-REL-DIV-LEN     PICTURE 99     VALUE 18.
           03  KW-RENAMES         PICTURE X(7)   VALUE "RENAMES". 
           03  KW-RENAMES-LEN     PICTURE 99     VALUE 7. 
           03  KW-RESTRICT        PICTURE X(8)   VALUE "RESTRICT".
           03  KW-RESTRICT-LEN    PICTURE 99     VALUE 8. 
           03  KW-RIGHT           PICTURE X(5)   VALUE "RIGHT". 
           03  KW-RIGHT-LEN       PICTURE 99     VALUE 5. 
           03  KW-RN-IS           PICTURE X(5)   VALUE "RN IS". 
           03  KW-RN-IS-LEN       PICTURE 99     VALUE 5. 
           03  KW-SS              PICTURE X(2)   VALUE "SS".
           03  KW-SS-LEN          PICTURE 99     VALUE 2. 
           03  KW-SYNC            PICTURE X(12)  VALUE "SYNCHRONIZED".
           03  KW-SYNC-LEN        PICTURE 99     VALUE 12.
           03  KW-THRU            PICTURE X(4)   VALUE "THRU".
           03  KW-THRU-LEN        PICTURE 99     VALUE 4. 
           03  KW-TIMES           PICTURE X(5)   VALUE "TIMES". 
           03  KW-TIMES-LEN       PICTURE 99     VALUE 5. 
           03  KW-TITLE-DIV       PICTURE X(15)  VALUE
                                  "TITLE DIVISION.".
           03  KW-TITLE-DIV-LEN   PICTURE 99     VALUE 15.
           03  KW-TO              PICTURE X(2)   VALUE "TO".
           03  KW-TO-LEN          PICTURE 99     VALUE 2. 
           03  KW-USAGE           PICTURE X(8)   VALUE "USAGE IS".
           03  KW-USAGE-LEN       PICTURE 99     VALUE 8. 
           03  KW-WHERE           PICTURE X(5)   VALUE "WHERE". 
           03  KW-WHERE-LEN       PICTURE 99     VALUE 5. 
           03  KW-WITHIN          PICTURE X(6)   VALUE "WITHIN".
           03  KW-WITHIN-LEN      PICTURE 99     VALUE 6. 
           03  KW-XOR             PICTURE X(3)   VALUE "XOR". 
           03  KW-XOR-LEN         PICTURE 99     VALUE 3. 
           03  KW-XOR-NOT         PICTURE X(7)   VALUE "XOR NOT". 
           03  KW-XOR-NOT-LEN     PICTURE 99     VALUE 7. 
*CALL DATAIO
*CALL DATADD
*CALL DATSAV1 
*CALL DATSAVSUB 
*CALL DATSAV2 
*CALL DATSAV3 
*CALL DATSAV4 
*CALL DATSAV5 
           03  HOLD-GROUP         OCCURS 47 TIMES.
               05  GRP-CON-LINE   PICTURE X(141). 
               05  GRP-NAME       PICTURE X(32).
               05  GRP-NEXT-REC   PICTURE 9(4). 
               05  GRP-CAT        PICTURE X(3). 
               05  GRP-LINE-NO    PICTURE X(4). 
               05  GRP-LINETYPE   PICTURE X.
               05  GRP-DRCODE     PICTURE X.
               05  GRP-COL-IN     PICTURE 9(4). 
               05  GRP-DTL-LEN    PICTURE 9(3). 
               05  GRP-SKIP-COM   PICTURE X.
               05  GRP-LEV-NO     PICTURE 99. 
*CALL DATCON1 
*CALL DATCON2 
*CALL DATCONSUB 
  
*CALL MAST1WS 
  
*CALL TESTWACOM 
  
*CALL DCDPTRS 
  
*CALL DCDWA05 
  
*CALL DCDWA10 
  
*CALL DCDWA13 
  
*CALL DCDWA22 
  
*CALL DCDWA24 
  
*CALL DCDWA26 
      /*****************************************************************
      * 
       PROCEDURE DIVISION.
  
      ******************************************************************
      * 
      * INITIALIZATION. 
  
       000-INITIALIZE.
  
      * FIRST CHECK IF RETURNING TO MODULE FROM INPUT/OUTPUT REQUEST. 
           IF GTBL-REQ = REQ-INPUT
           THEN 
             GO TO READ-RETURN
           END-IF 
  
           IF GTBL-REQ = REQ-OUTPUT 
           THEN 
             GO TO OUTPUT-RETURN
           END-IF 
  
      * INITIAL ENTRY OF MODULE --- SO INITIALIZE.
           MOVE GTBL-SEL-CNAME TO SUBSCH-CATNAME. 
           MOVE INDENT-INIT TO INDENT.
           MOVE SPACES TO DMS-LINE. 
           PERFORM CLEAR-DATA-ENTRY THRU CLEAR-DATA-ENTRY-XIT.
           MOVE "N" TO DATANAME-OK. 
  
      * INITIALIZE CMM CONSTANT PARAMETERS. 
           MOVE RENAME-SIZE TO BLK-SIZE.
           MOVE RENAME-SIZE TO LINK-POSN. 
           MOVE ZERO TO SIZE-CODE.
           MOVE ZERO TO GRP-ID. 
           MOVE ZERO TO PREV-FWA. 
           MOVE ZERO TO RENAME-FWA. 
  
  
      ******************************************************************
      * THIS SECTION OF PROCEDURES ACCESSES PRIMARILY THE SCHEMA ENTITY 
      ******************************************************************
  
      * IF "ALL" OPTION SELECTED, GENERATE EVERY SUBSCHEMA BELONGING TO 
      * THE GIVEN SCHEMA. 
           IF GTBL-SEL-ALL NOT = "Y"
           THEN 
             GO TO 100-TITLE-DIV
           END-IF 
  
      * READ FIRST RECORD OF SCHEMA ENTRY INTO "DATA-RECORD". 
           MOVE SCHEMA-CATNAME TO DATA-ENTRY-NAME 
           PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT 
  
      * IF SCHEMA ENTRY MISSING, DIAGNOSE AND GIVE UP.
           IF DATA-RETURN-CODE NOT = ZERO 
           THEN 
             MOVE IDX-500 TO MSG-IDX
             PERFORM ERROR-TYPE1 THRU ERROR-TYPE1-XIT 
             GO TO 160-FINAL-TERMINATION
           END-IF 
  
      * MOVE SCHEMA'S FIRST STRUCTURE LINE INTO "CAT-WORK". 
           MOVE CAT-NO-STC TO DATA-ENTRY-CAT
           PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT 
           MOVE "Y" TO SKIP-COMMENTS
           PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT 
  
       050-ALL-SUBSCH.
  
      * LOOP THROUGH SCHEMA'S STRUCTURE LINES TO GENERATE DESCRIPTION 
      * ENTRIES.
           IF DATA-RETURN-CODE NOT = ZERO 
           THEN 
             GO TO 160-FINAL-TERMINATION
           END-IF 
  
      * CONSOLIDATE THE STRUCTURE LINE IF NEEDED. 
           PERFORM CON-SCH-STC THRU CON-SCH-STC-XIT 
  
      * IF LINE NOT FOR AN INCLUDED SUBSCH, LOOP BACK FOR THE NEXT ONE. 
           IF SCH-STC-CNAME = SPACES
             OR SCH-STC-INCL = "N"
             OR SCH-STC-CTYPE NOT = "S" 
           THEN 
             GO TO 050-ALL-SUBSCH 
  
      * IF FOUND INCLUDED SUBSCHEMA, GO ON AND PROCESS IT.
           ELSE 
             MOVE SCH-STC-CNAME TO SUBSCH-CATNAME 
             PERFORM SAVE-SCH-INFO THRU SAVE-SCH-INFO-XIT 
             PERFORM CLEAR-DATA-ENTRY THRU CLEAR-DATA-ENTRY-XIT 
           END-IF 
      /*****************************************************************
      * THIS SECTION OF PROCEDURES ACCESSES PRIMARILY THE SUBSCH ENTITY 
      ******************************************************************
  
  
      ******************************************************************
      * 
      * TITLE DIVISION. 
      * 
      * IDENTIFY THE SUBSCHEMA AND THE SCHEMA IT IS WITHIN. 
  
       100-TITLE-DIV. 
  
      * START TITLE DIVISION WITH ITS DIVISION TITLE. 
           MOVE KW-TITLE-DIV TO OUT-FIELD.
           MOVE KW-TITLE-DIV-LEN TO OUT-LEN.
           PERFORM START-STMT THRU STMT-XIT.
  
      * PUT TITLE CLAUSE INDENTED ON A NEW LINE.
           ADD INDENT-INC TO INDENT.
           MOVE KW-SS TO OUT-FIELD. 
           MOVE KW-SS-LEN TO OUT-LEN. 
           PERFORM START-STMT THRU STMT-XIT.
  
      * READ FIRST ENTRY OF SUBSCHEMA ENTRY INTO "DATA-RECORD". 
           MOVE SUBSCH-CATNAME TO DATA-ENTRY-NAME.
           PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT.
  
      * IF SUBSCHEMA ENTY MISSING, DIAGNOSE AND GIVE UP.
           IF DATA-RETURN-CODE NOT = ZERO 
           THEN 
             MOVE IDX-500 TO MSG-IDX
             PERFORM ERROR-TYPE1 THRU ERROR-TYPE1-XIT 
             GO TO 150-NORMAL-TERMINATION 
           END-IF 
  
      * MOVE NAMES CATEGORY OF SUBSCHEMA ENTRY INTO "CAT-WORK". 
           MOVE CAT-NO-NAMES TO DATA-ENTRY-CAT. 
           PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT.
           MOVE "N" TO SKIP-COMMENTS. 
           PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT.
  
      * IF NO DMSNAME GIVEN, ASSUME THE CATNAME.
           IF DATA-RETURN-CODE NOT = ZERO 
             OR NAME-SS-DMSNAME = SPACES
           THEN 
             MOVE SUBSCH-CATNAME (1 : 30) TO OUT-FIELD
           ELSE 
             MOVE NAME-SS-DMSNAME (1 : 30) TO OUT-FIELD 
           END-IF 
  
      * OUTPUT ANY REMAINING COMMENTS IN NAMES CATEGORY.
           PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT.
  
      * FIND LENGTH OF SUBSCHEMA-NAME AND MOVE IT TO STATEMENT. 
           PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT.
           PERFORM ADD-TO-STMT THRU STMT-XIT. 
  
      * ADD THE SCHEMA NAME TO THE LINE AND END IT WITH A PERIOD. 
           MOVE KW-WITHIN TO OUT-FIELD. 
           MOVE KW-WITHIN-LEN TO OUT-LEN. 
           PERFORM ADD-TO-STMT THRU STMT-XIT. 
  
           MOVE SCHEMA-CATNAME TO OUT-FIELD.
           PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT.
           PERFORM ADD-TO-STMT THRU STMT-XIT. 
  
           MOVE "." TO DMS-LINE (COLUMN-OUT - 1 : 1). 
           MOVE INDENT-INIT TO INDENT.
  
  
      ******************************************************************
      * 
      * ALIAS DIVISION. 
      * 
      * FOR EACH AREA, RECORD, GROUP, OR ELEMENT WHICH IS REFERENCED BY 
      * AN ALIAS OR WHICH IS AN EALIAS, GENERATE AN "AD" CLAUSE.
  
       110-ALIAS-DIV. 
  
      * START ALIAS DIVISION WITH A BLANK LINE FOLLOWED BY ITS DIVISION 
      * TITLE.
           MOVE ZERO TO OUT-LEN.
           PERFORM START-STMT THRU STMT-XIT.
  
           MOVE KW-ALIAS-DIV TO OUT-FIELD.
           MOVE KW-ALIAS-DIV-LEN TO OUT-LEN.
           PERFORM START-STMT THRU STMT-XIT.
  
           ADD INDENT-INC TO INDENT.
  
      * MOVE SUBSCHEMA'S FIRST STRUCTURE LINE INTO "CAT-WORK" AND 
      * CONSOLIDATE IF NECESSARY. 
           MOVE CAT-NO-STC TO DATA-ENTRY-CAT. 
           PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT.
           MOVE "Y" TO SKIP-COMMENTS. 
           PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT.
           PERFORM CON-SUB-STC THRU CON-SUB-STC-XIT.
           MOVE "N" TO FOUND-AREA.
  
      * LOOP THROUGH SUBSCHEMA'S STRUCTURE LOOKING FOR ALIASED AREAS. 
           PERFORM UNTIL SUB-STC-CNAME = SPACES 
             IF SUB-STC-INCL NOT = "N"
             THEN 
               MOVE "Y" TO FOUND-AREA 
               MOVE SUB-STC-CNAME TO AREA-CATNAME 
               MOVE SUB-STC-ALIAS TO AREA-ALIAS 
               MOVE SPACES TO SCH-REC-DNAME 
               MOVE ZERO TO QUAL-CNT
  
               PERFORM CHK-AREA-ALIAS THRU CHK-AREA-ALIAS-XIT 
             END-IF 
  
      * CONSOLIDATE SUBSCHEMA'S NEXT STRUCTURE LINE.
             PERFORM CON-SUB-STC THRU CON-SUB-STC-XIT 
           END-PERFORM
  
           MOVE INDENT-INIT TO INDENT.
  
      * IF NO AREAS EXIST FOR THE SUBSCHEMA, NO POINT IN CONTINUING.
           IF FOUND-AREA = "N"
           THEN 
             MOVE IDX-600 TO MSG-IDX
             PERFORM ERROR-TYPE1 THRU ERROR-TYPE1-XIT 
             GO TO 150-NORMAL-TERMINATION 
           END-IF 
  
  
      ******************************************************************
      * 
      * REALM DIVISION. 
      * 
      * FOR EACH AREA TO BE INCLUDED IN THE SUBSCHEMA, GENERATE AN ENTRY
      * IN THE "RD" CLAUSE. 
  
       120-REALM-DIV. 
  
      * START REALM DIVISION WITH A BLANK LINE FOLLOWED BY ITS DIVISION 
      * TITLE.
           MOVE ZERO TO OUT-LEN.
           PERFORM START-STMT THRU STMT-XIT.
  
           MOVE KW-REALM-DIV TO OUT-FIELD.
           MOVE KW-REALM-DIV-LEN TO OUT-LEN.
           PERFORM START-STMT THRU STMT-XIT.
  
           ADD INDENT-INC TO INDENT.
  
      * START THE "RD" CLAUSE ON A NEW LINE.
           MOVE KW-RD TO OUT-FIELD
           MOVE KW-RD-LEN TO OUT-LEN
           PERFORM START-STMT THRU STMT-XIT 
  
      * MOVE SUBSCHEMA'S FIRST STRUCTURE LINE INTO "CAT-WORK" AND 
      * CONSOLIDATE IF NECESSARY. 
           PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT.
           MOVE "N" TO SKIP-COMMENTS. 
           PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT.
           PERFORM CON-SUB-STC THRU CON-SUB-STC-XIT.
  
      * LOOP THROUGH THE SUBSCHEMA'S STRUCTURE LINES. 
           PERFORM UNTIL SUB-STC-CNAME = SPACES 
  
      * IF THE AREA IS TO BE INCLUDED, ADD IT TO THE "RD" CLAUSE. 
             IF SUB-STC-INCL NOT = "N"
             THEN 
               MOVE SUB-STC-CNAME TO AREA-CATNAME 
               MOVE SUB-STC-ALIAS TO AREA-ALIAS 
               PERFORM SAVE-SUB-INFO THRU SAVE-SUB-INFO-XIT 
               PERFORM ADD-AREA-NAME THRU ADD-AREA-NAME-XIT 
               PERFORM RESTORE-SUB-INFO THRU RESTORE-SUB-INFO-XIT 
             END-IF 
  
      * CONSOLIDATE SUBSCHEMA'S NEXT STRUCTURE LINE IF NECESSARY. 
             PERFORM CON-SUB-STC THRU CON-SUB-STC-XIT 
           END-PERFORM
  
      * END THE REALM DIVISION WITH A PERIOD. 
           MOVE "." TO DMS-LINE (COLUMN-OUT - 1 : 1). 
           MOVE INDENT-INIT TO INDENT.
  
  
      ******************************************************************
      * 
      * RECORD DIVISION.
      * 
      * FOR EACH RECORD INCLUDED IN THE SUBSCHEMA, GENERATE A RECORD
      * DESCRIPTION ENTRY.
  
       130-RECORD-DIV.
  
      * START THE RECORD DIVISION WITH A BLANK LINE FOLLOWED BY ITS 
      * DIVISION TITLE. 
           MOVE ZERO TO OUT-LEN.
           PERFORM START-STMT THRU STMT-XIT.
  
           MOVE KW-REC-DIV TO OUT-FIELD.
           MOVE KW-REC-DIV-LEN TO OUT-LEN.
           PERFORM START-STMT THRU STMT-XIT.
  
      * MOVE SUBSCHEMA'S FIRST STRUCTURE LINE INTO "CAT-WORK" AND 
      * CONSOLIDATE IT IF NECESSARY.
           PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT.
           MOVE "Y" TO SKIP-COMMENTS. 
           PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT 
           PERFORM CON-SUB-STC THRU CON-SUB-STC-XIT.
  
      * LOOP THROUGH SUBSCHEMA'S AREAS, GENERATING A RECORD DESCRIPTION 
      * ENTRY FOR EACH INCLUDED RECORD. 
           PERFORM UNTIL SUB-STC-CNAME = SPACES 
             IF SUB-STC-INCL NOT = "N"
             THEN 
               MOVE SUB-STC-CNAME TO AREA-CATNAME 
               PERFORM RECORD-DIVISION THRU RECORD-DIVISION-XIT 
             END-IF 
  
      * CONSOLIDATE SUBSCHEMA'S NEXT STRUCTURE LINE IF NECESSARY. 
             PERFORM CON-SUB-STC THRU CON-SUB-STC-XIT 
           END-PERFORM
  
  
      ******************************************************************
      * 
      * RELATION DIVISION.
      * 
      * FOR EACH SSREL ENTRY IN THE SUBSCHEMA, GENERATE A RELATION
      * DESCRIPTION ENTRY.
  
       140-RELATION-DIV.
  
      * START RELATION DIVISION WITH A BLANK LINE FOLLOWED BY ITS 
      * DIVISION TITLE. 
           MOVE ZERO TO OUT-LEN.
           PERFORM START-STMT THRU STMT-XIT.
  
           MOVE KW-REL-DIV TO OUT-FIELD.
           MOVE KW-REL-DIV-LEN TO OUT-LEN.
           PERFORM START-STMT THRU STMT-XIT.
  
           ADD INDENT-INC TO INDENT.
  
      * MOVE SUBSCHEMA'S FIRST SSREL LINE INTO "CAT-WORK".
           MOVE CAT-NO-SSREL TO DATA-ENTRY-CAT. 
           PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT.
           MOVE "N" TO SKIP-COMMENTS. 
           PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT.
           MOVE "N" TO FOUND-RELN.
  
      * LOOP THROUGH SSREL LINES. 
           PERFORM UNTIL DATA-RETURN-CODE NOT = ZERO
  
      * LINE MUST BE OF LINETYPE "R" -- CONSOLIDATE IT IF NECESSARY.
             IF CAT-LINE-TYPE = "R" 
             THEN 
               PERFORM CON-SUB-RSSREL THRU CON-SUB-RSSREL-XIT 
  
      * ADD RELATION NAME IN "RN" CLAUSE. 
               IF SUB-SSREL-RNAME NOT = SPACES
               THEN 
  
      * IF NOT FIRST RELATION, END PREVIOUS ONE WITH PERIOD.
                 IF FOUND-RELN = "Y"
                 THEN 
                   MOVE "." TO DMS-LINE (COLUMN-OUT - 1 : 1)
                 ELSE 
                   MOVE "Y" TO FOUND-RELN 
                 END-IF 
  
                 MOVE KW-RN-IS TO OUT-FIELD 
                 MOVE KW-RN-IS-LEN TO OUT-LEN 
                 PERFORM START-STMT THRU STMT-XIT 
  
                 MOVE SUB-SSREL-RNAME TO OUT-FIELD
                 PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT 
                 PERFORM ADD-TO-STMT THRU STMT-XIT
               END-IF 
  
      * ADD RESTRICT CLAUSE.
               IF SUB-SSREL-RESTRICT NOT = SPACES 
               THEN 
                 PERFORM RESTRICT-CLAUSE THRU RESTRICT-CLAUSE-XIT 
               END-IF 
  
      * ERROR IF LINETYPES OUT OF ORDER.
             ELSE 
               MOVE IDX-705 TO MSG-IDX
               MOVE "SUBSCH-SSREL" TO MSG-NAME
               PERFORM ERROR-TYPE2 THRU ERROR-TYPE2-XIT 
  
      * SKIP OVER ERRONEOUS LINETYPE. 
               PERFORM MOVE-NEXT-LINE THRU MOVE-NEXT-LINE-XIT 
               PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT 
             END-IF 
           END-PERFORM
  
      * IF NO RELATIONS, ERASE THE RELATION DIVISION TITLE.  OTHERWISE, 
      * END THE LAST ONE WITH A PERIOD. 
           IF FOUND-RELN = "N"
           THEN 
             MOVE SPACES TO DMS-LINE
           ELSE 
             MOVE "." TO DMS-LINE (COLUMN-OUT - 1 : 1)
           END-IF 
           MOVE INDENT-INIT TO INDENT.
  
  
      ******************************************************************
      * 
      * NORMAL TERMINATION. 
  
       150-NORMAL-TERMINATION.
  
      * MAKE SURE LAST LINE IS MOVED TO OUTPUT BUFFER.
           PERFORM OUTPUT-DMS THRU OUTPUT-DMS-XIT.
  
      * IF "ALL" OPTION SELECTED, GO BACK TO PROCESS NEXT SUBSCHEMA.
           IF GTBL-SEL-ALL = "Y"
           THEN 
             ADD 1 TO GTBL-COUNT
             MOVE DMS-LINE TO GTBL-CARD-IMAGE (GTBL-COUNT)
             PERFORM OUTPUT-CHECK THRU OUTPUT-CHECK-XIT 
  
             PERFORM RESTORE-SCH-INFO THRU RESTORE-SCH-INFO-XIT 
             GO TO 050-ALL-SUBSCH 
           END-IF 
  
       160-FINAL-TERMINATION. 
  
      * FINISHED WITH ALL SUBSCHEMAS. 
           MOVE REQ-TERMINATE TO GTBL-REQ.
           EXIT PROGRAM.
      /*****************************************************************
      ******************************************************************
      * 
      * THE CHK-XXX-ALIAS PROCEDURES GENERATE THE "AD" CLAUSES FOR THE
      * ENTIRE STRUCTURE CONTAINED WITHIN THE CURRENT SUBSCHEMA.
  
  
      ******************************************************************
      * 
      * CHECK AREA FOR ALIASES. 
      * 
      * CHECK EITHER THE ALIAS CATEGORY, IF SPECIFIED, OR THE EALIAS/ 
      * VERSION POINTER TO DETERMINE WHETHER THIS AREA IS KNOWN BY AN 
      * ALIAS IN THIS SUBSCHEMA.  IF SO, GENERATE AN "AD" CLAUSE FOR IT.
      * THEN SEARCH THE AREA'S STRUCTURE FOR FURTHER ALIASES. 
      * 
      * INPUT:   AREA-CATNAME     - CATNAME OF AREA TO BE CHECKED 
      *          AREA-ALIAS       - ALIAS NUMBER OF AREA IF GIVEN 
  
       CHK-AREA-ALIAS.
           PERFORM SAVE-SUB-INFO THRU SAVE-SUB-INFO-XIT.
           PERFORM CLEAR-DATA-ENTRY THRU CLEAR-DATA-ENTRY-XIT.
  
      * READ AREA'S FIRST RECORD INTO "DATA-RECORD".
           MOVE AREA-CATNAME TO DATA-ENTRY-NAME.
           PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT.
  
      * IF AREA ENTRY MISSING, DIAGNOSE AND RETURN. 
           IF DATA-RETURN-CODE NOT = ZERO 
           THEN 
             MOVE IDX-500 TO MSG-IDX
             PERFORM ERROR-TYPE1 THRU ERROR-TYPE1-XIT 
             GO TO END-CHK-AREA-ALIAS 
           END-IF 
  
      * IF ENTRY NOT FOR AREA ENTITY DIAGNOSE AND RETURN. 
           IF DATA-HDR-ENT-ID NOT = ENT-ID-AREA 
           THEN 
             MOVE IDX-535 TO MSG-IDX
             PERFORM ERROR-TYPE1 THRU ERROR-TYPE1-XIT 
             GO TO END-CHK-AREA-ALIAS 
           END-IF 
  
      * MOVE ITS NAMES CATEGORY INTO "CAT-WORK" TO FIND THE ORIGINAL
      * (SCHEMA) DATANAME.
           MOVE CAT-NO-NAMES TO DATA-ENTRY-CAT. 
           PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT.
           MOVE "Y" TO SKIP-COMMENTS. 
           PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT.
  
      * IF NO DMSNAME GIVEN, ASSUME THE CATNAME.
           IF DATA-RETURN-CODE NOT = ZERO 
             OR NAME-A-DMS = SPACES 
           THEN 
             MOVE AREA-CATNAME TO ORIG-DNAME
           ELSE 
             MOVE NAME-A-DMS TO ORIG-DNAME
           END-IF 
           MOVE SPACES TO ALIAS-DNAME.
  
      * IF AREA ALIASED, MOVE ITS GIVEN ALIAS LINE INTO "CAT-WORK". 
           IF AREA-ALIAS NOT = ZERO 
             AND NOT = SPACES 
           THEN 
             MOVE AREA-ALIAS TO DATA-ENTRY-LINE 
             MOVE CAT-NO-ALIAS TO DATA-ENTRY-CAT
             PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT 
             MOVE ZERO TO DATA-ENTRY-LINE 
  
      * ERROR IF ALIAS LINE MISSING OR A COMMENT. 
             IF DATA-RETURN-CODE NOT = ZERO 
               OR CAT-COMMENT = "*" 
             THEN 
               MOVE IDX-720 TO MSG-IDX
               MOVE "AREA" TO MSG-NAME
               PERFORM ERROR-TYPE2 THRU ERROR-TYPE2-XIT 
               GO TO END-CHK-AREA-ALIAS 
             END-IF 
  
      * IF ALIAS NAME GIVEN AND DIFFERENT FROM AREA'S ORIGINAL DATANAME,
      * GENERATE AN "AD" CLAUSE FOR IT. 
             IF ALY-A-DMS NOT = SPACES
               AND NOT = ORIG-DNAME 
             THEN 
               MOVE ALY-A-DMS TO ALIAS-DNAME
               MOVE KW-AD-RLM TO OUT-FIELD
               MOVE KW-AD-RLM-LEN TO OUT-LEN
               PERFORM AD-CLAUSE THRU AD-CLAUSE-XIT 
               MOVE SPACES TO AREA-ALIAS
             END-IF 
  
      * IF NO ALIAS GIVEN, CHECK CONTROL CATEGORY TO SEE IF IT'S AN 
      * EALIAS. 
           ELSE 
             MOVE ORIG-DNAME TO ALIAS-DNAME 
             MOVE CAT-NO-CTL TO DATA-ENTRY-CAT
             PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT 
             PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT 
  
      * IF EALIAS EXISTS, MOVE ITS NAMES CATEGORY TO "CAT-WORK".
             IF CTL-ALY-VER NOT = SPACES
             THEN 
               MOVE CTL-ALY-VER TO DATA-ENTRY-NAME
               MOVE CAT-NO-NAMES TO DATA-ENTRY-CAT
               PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT 
               PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT 
  
      * IF NO DMSNAME GIVEN, ASSUME THE CATNAME.
               IF DATA-RETURN-CODE NOT = ZERO 
                 OR NAME-A-DMS = SPACES 
               THEN 
                 MOVE DATA-ENTRY-NAME TO ORIG-DNAME 
               ELSE 
                 MOVE NAME-A-DMS TO ORIG-DNAME
               END-IF 
  
      * IF NAME IS DIFFERENT FROM AREA'S DATANAME, GENERATE AN "AD" 
      * CLAUSE FOR IT.
               IF ORIG-DNAME NOT = ALIAS-DNAME
               THEN 
                 MOVE KW-AD-RLM TO OUT-FIELD
                 MOVE KW-AD-RLM-LEN TO OUT-LEN
                 PERFORM AD-CLAUSE THRU AD-CLAUSE-XIT 
               END-IF 
             END-IF 
           END-IF 
  
      * MOVE AREA'S FIRST STRUCTURE LINE INTO "CAT-WORK" AND
      * CONSOLIDATE IF NECESSARY. 
           PERFORM CLEAR-DATA-ENTRY THRU CLEAR-DATA-ENTRY-XIT.
           MOVE AREA-CATNAME TO DATA-ENTRY-NAME.
           MOVE CAT-NO-STC TO DATA-ENTRY-CAT. 
           PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT.
           PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT.
           PERFORM CON-AREA-STC THRU CON-AREA-STC-XIT.
  
      * LOOP THROUGH THE AREA'S STRUCTURE LINES LOOKING FOR ALIASES OF
      * RECORDS AND DATA-ITEMS. 
           PERFORM UNTIL A-STC-CNAME = SPACES 
             IF A-STC-INCL NOT = "N"
             THEN 
               MOVE A-STC-CNAME TO RECORD-CATNAME 
               MOVE A-STC-ALIAS TO RECORD-ALIAS 
               MOVE SPACES TO SCH-REC-DNAME 
               MOVE ZERO TO QUAL-CNT
  
               PERFORM CHK-REC-ALIAS THRU CHK-REC-ALIAS-XIT 
             END-IF 
  
      * CONSOLIDATE AREA'S NEXT STRUCTURE LINE. 
             PERFORM CON-AREA-STC THRU CON-AREA-STC-XIT 
           END-PERFORM
  
       END-CHK-AREA-ALIAS.
           PERFORM RESTORE-SUB-INFO THRU RESTORE-SUB-INFO-XIT.
  
       CHK-AREA-ALIAS-XIT.
           EXIT.
  
  
      ******************************************************************
      * 
      * GENERATE "AD" CLAUSE. 
      * 
      * GENERATE AN "AD" CLAUSE FOR AN AREA, RECORD, GROUP, OR ELEMENT. 
      * 
      * INPUT:   ORIG-DNAME       - DATANAME OF ITEM IN SCHEMA
      *          ALIAS-DNAME      - DATANAME OF ITEM IN SUBSCHEMA 
      *          OUT-FIELD        - "AD" KEYWORD PHRASE FOR ITEM
      *          OUT-LEN          - LENGTH OF OUT-FIELD 
  
       AD-CLAUSE. 
  
      * OUTPUT THE KEYWORD PHRASE ALREADY IN "OUT-FIELD". 
           PERFORM START-STMT THRU STMT-XIT.
  
      * THE ORIGINAL DATANAME GOES FIRST ALONG WITH ITS QUALIFIER, IF 
      * GIVEN.
           MOVE ORIG-DNAME TO OUT-FIELD.
           PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT.
           PERFORM ADD-TO-STMT THRU STMT-XIT. 
  
           IF SCH-REC-DNAME NOT = SPACES
           THEN 
             MOVE KW-OF TO OUT-FIELD
             MOVE KW-OF-LEN TO OUT-LEN
             PERFORM ADD-TO-STMT THRU STMT-XIT
  
             MOVE SCH-REC-DNAME TO OUT-FIELD
             PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT 
             PERFORM ADD-TO-STMT THRU STMT-XIT
           END-IF 
  
           MOVE KW-BECOMES TO OUT-FIELD.
           MOVE KW-BECOMES-LEN TO OUT-LEN.
           PERFORM ADD-TO-STMT THRU STMT-XIT. 
  
      * FINALLY ADD THE ALIAS NAME AND ITS QUALIFIERS.
           MOVE ALIAS-DNAME TO OUT-FIELD. 
           PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT.
           PERFORM ADD-TO-STMT THRU STMT-XIT. 
  
           PERFORM VARYING QUAL-IDX FROM QUAL-CNT BY -1 
             UNTIL QUAL-IDX = ZERO
  
             MOVE KW-OF TO OUT-FIELD
             MOVE KW-OF-LEN TO OUT-LEN
             PERFORM ADD-TO-STMT THRU STMT-XIT
  
             MOVE QUAL-DNAME (QUAL-IDX) TO OUT-FIELD
             PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT 
             PERFORM ADD-TO-STMT THRU STMT-XIT
           END-PERFORM
  
      * END THE "AD" CLAUSE WITH A PERIOD.
           MOVE "." TO DMS-LINE (COLUMN-OUT - 1 : 1). 
  
       AD-CLAUSE-XIT. 
           EXIT.
      /*****************************************************************
      * 
      * CHECK RECORD FOR ALIASES. 
      * 
      * CHECK EITHER THE ALIAS CATEGORY, IF SPECIFIED, OR THE EALIAS/ 
      * VERSION POINTER TO DETERMINE WHETHER THIS RECORD IS KNOWN BY AN 
      * ALIAS IN THIS SUBSCHEMA.  IF SO, GENERATE AN "AD" CLAUSE FOR IT.
      * THEN SEARCH THE RECORD'S STRUCTURE FOR FURTHER ALIASES. 
      * 
      * INPUT:   RECORD-CATNAME   - CATNAME OF AREA TO BE CHECKED 
      *          RECORD-ALIAS     - ALIAS NUMBER OF RECORD IF GIVEN 
      *          CONSOLID-LINE    - AREA STRUCTURE
      *          CAT-WORK         - NEXT AREA STRUCTURE 
  
       CHK-REC-ALIAS. 
           PERFORM SAVE-AREA-INFO THRU SAVE-AREA-INFO-XIT.
           PERFORM CLEAR-DATA-ENTRY THRU CLEAR-DATA-ENTRY-XIT.
  
      * READ RECORD'S FIRST RECORD INTO "DATA-RECORD".
           MOVE RECORD-CATNAME TO DATA-ENTRY-NAME.
           PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT.
  
      * IF RECORD ENTRY MISSING, DIAGNOSE AND RETURN. 
           IF DATA-RETURN-CODE NOT = ZERO 
           THEN 
             MOVE IDX-500 TO MSG-IDX
             PERFORM ERROR-TYPE1 THRU ERROR-TYPE1-XIT 
             GO TO END-CHK-REC-ALIAS
           END-IF 
  
      * IF ENTRY NOT FOR RECORD ENTITY DIAGNOSE AND RETURN. 
           IF DATA-HDR-ENT-ID NOT = ENT-ID-REC
           THEN 
             MOVE IDX-530 TO MSG-IDX
             PERFORM ERROR-TYPE1 THRU ERROR-TYPE1-XIT 
             GO TO END-CHK-REC-ALIAS
           END-IF 
  
      * MOVE ITS NAMES CATEGORY INTO "CAT-WORK" TO FIND THE ORIGINAL
      * (SCHEMA) DATANAME.
           MOVE CAT-NO-NAMES TO DATA-ENTRY-CAT. 
           PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT.
           MOVE "Y" TO SKIP-COMMENTS. 
           PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT.
  
      * IF NO DMSNAME GIVEN, ASSUME THE CATNAME.
           IF DATA-RETURN-CODE NOT = ZERO 
             OR NAME-TOT-DMS = SPACES 
           THEN 
             MOVE RECORD-CATNAME TO ORIG-DNAME
           ELSE 
             MOVE NAME-TOT-DMS TO ORIG-DNAME
           END-IF 
           MOVE SPACES TO ALIAS-DNAME.
  
      * IF RECORD ALIASED, MOVE ITS GIVEN ALIAS LINE INTO "CAT-WORK". 
           IF RECORD-ALIAS NOT = ZERO 
             AND NOT = SPACES 
           THEN 
             MOVE RECORD-ALIAS TO DATA-ENTRY-LINE 
             MOVE CAT-NO-ALIAS TO DATA-ENTRY-CAT
             PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT 
             MOVE ZERO TO DATA-ENTRY-LINE 
  
      * ERROR IF ALIAS LINE MISSING OR A COMMENT. 
             IF DATA-RETURN-CODE NOT = ZERO 
               OR CAT-COMMENT = "*" 
             THEN 
               MOVE IDX-720 TO MSG-IDX
               MOVE "RECORD" TO MSG-NAME
               PERFORM ERROR-TYPE2 THRU ERROR-TYPE2-XIT 
               GO TO END-CHK-REC-ALIAS
             END-IF 
  
      * IF ALIAS NAME GIVEN AND DIFFERENT FROM RECORD'S ORIGINAL
      * DATANAME, GENERATE AN "AD" CLAUSE FOR IT. 
             IF ALY-SR-NAME NOT = SPACES
               AND NOT = ORIG-DNAME 
             THEN 
               MOVE ALY-SR-NAME TO ALIAS-DNAME
               MOVE KW-AD-REC TO OUT-FIELD
               MOVE KW-AD-REC-LEN TO OUT-LEN
               PERFORM AD-CLAUSE THRU AD-CLAUSE-XIT 
               MOVE SPACES TO RECORD-ALIAS
             END-IF 
  
      * IF NO ALIAS GIVEN, CHECK CONTROL CATEGORY TO SEE IF IT'S AN 
      * EALIAS. 
           ELSE 
             MOVE ORIG-DNAME TO ALIAS-DNAME 
             MOVE CAT-NO-CTL TO DATA-ENTRY-CAT
             PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT 
             PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT 
  
      * IF EALIAS EXISTS, MOVE ITS NAMES CATEGORY TO "CAT-WORK".
             IF CTL-ALY-VER NOT = SPACES
             THEN 
               MOVE CTL-ALY-VER TO DATA-ENTRY-NAME
               MOVE CAT-NO-NAMES TO DATA-ENTRY-CAT
               PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT 
               PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT 
  
      * IF NO DMSNAME GIVEN, ASSUME THE CATNAME.
               IF DATA-RETURN-CODE NOT = ZERO 
                 OR NAME-TOT-DMS = SPACES 
               THEN 
                 MOVE DATA-ENTRY-NAME TO ORIG-DNAME 
               ELSE 
                 MOVE NAME-TOT-DMS TO ORIG-DNAME
               END-IF 
  
      * IF NAME IS DIFFERENT FROM RECORD'S DATANAME, GENERATE AN "AD" 
      * CLAUSE FOR IT.
               IF ORIG-DNAME NOT = ALIAS-DNAME
               THEN 
                 MOVE KW-AD-REC TO OUT-FIELD
                 MOVE KW-AD-REC-LEN TO OUT-LEN
                 PERFORM AD-CLAUSE THRU AD-CLAUSE-XIT 
               END-IF 
             END-IF 
           END-IF 
  
      * STORE RECORD DATANAME AS FIRST LEVEL OF QUALIFICATION.
           MOVE 1 TO QUAL-CNT.
           MOVE ORIG-DNAME TO SCH-REC-DNAME.
           IF ALIAS-DNAME = SPACES
           THEN 
             MOVE ORIG-DNAME TO QUAL-DNAME (QUAL-CNT) 
           ELSE 
             MOVE ALIAS-DNAME TO QUAL-DNAME (QUAL-CNT)
           END-IF 
  
      * MOVE RECORD'S FIRST STRUCTURE LINE INTO "CAT-WORK". 
           PERFORM CLEAR-DATA-ENTRY THRU CLEAR-DATA-ENTRY-XIT.
           MOVE RECORD-CATNAME TO DATA-ENTRY-NAME.
           MOVE CAT-NO-STC TO DATA-ENTRY-CAT. 
           PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT.
           PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT.
  
      * LOOP THROUGH THE RECORD'S TYPE "A" STRUCTURE LINES LOOKING FOR
      * ALIASES OF DATA-ITEMS.
           PERFORM UNTIL DATA-RETURN-CODE NOT = ZERO
             IF CAT-LINE-TYPE = "A" 
             THEN 
               PERFORM CON-RG-ASTC THRU CON-RG-ASTC-XIT 
  
               IF RG-STC-CNAME NOT = SPACES 
                 AND RG-STC-INCL NOT = "N"
               THEN 
  
      * READ DATA ITEM'S FIRST RECORD INTO "DATA-RECORD". 
                 PERFORM SAVE-REC-INFO THRU SAVE-REC-INFO-XIT 
                 PERFORM CLEAR-DATA-ENTRY THRU CLEAR-DATA-ENTRY-XIT 
                 MOVE RG-STC-CNAME TO DATA-ENTRY-NAME 
                 PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT 
                 IF DATA-RETURN-CODE NOT = ZERO 
                 THEN 
                   MOVE IDX-500 TO MSG-IDX
                   PERFORM ERROR-TYPE1 THRU ERROR-TYPE1-XIT 
  
      * DETERMINE WHETHER DATA ITEM IS A GROUP OR ELEMENT AND PROCESS 
      * ACCORDINGLY.
                 ELSE 
                   MOVE 2 TO LEVEL-IDX
                   IF DATA-HDR-ENT-ID = ENT-ID-GROUP
                   THEN 
                     MOVE RG-STC-CNAME TO GROUP-CATNAME 
                     PERFORM CHK-GRP-ALIAS THRU CHK-GRP-ALIAS-XIT 
  
                   ELSE 
                     IF DATA-HDR-ENT-ID = ENT-ID-ELEM 
                     THEN 
                       MOVE RG-STC-CNAME TO ELEM-CATNAME
                       MOVE RG-STC-ALIAS TO ELEM-ALIAS
                       PERFORM CHK-ELEM-ALIAS THRU CHK-ELEM-ALIAS-XIT 
  
      * ERROR IF OTHER THAN GROUP OR ELEMENT. 
                     ELSE 
                       MOVE IDX-525 TO MSG-IDX
                       PERFORM ERROR-TYPE1 THRU ERROR-TYPE1-XIT 
                     END-IF 
                   END-IF 
                 END-IF 
  
                 PERFORM RESTORE-REC-INFO THRU RESTORE-REC-INFO-XIT 
               END-IF 
  
      * IF NOT TYPE "A", JUST MOVE NEXT STRUCTURE LINE INTO "CAT-WORK". 
             ELSE 
               PERFORM MOVE-NEXT-LINE THRU MOVE-NEXT-LINE-XIT 
               PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT 
             END-IF 
           END-PERFORM
  
       END-CHK-REC-ALIAS. 
           PERFORM RESTORE-AREA-INFO THRU RESTORE-AREA-INFO-XIT.
  
       CHK-REC-ALIAS-XIT. 
           EXIT.
      /*****************************************************************
      * 
      * CHECK GROUP FOR ALIASES.
      * 
      * CHECK THE EALIAS VERSION POINTER TO DETERMINE WHETHER THIS
      * GROUP IS KNOWN BY AN ALIAS IN THIS SUBSCHEMA.  IF SO, GENERATE
      * AN "AD" CLAUSE FOR IT.  THEN SEARCH THE GROUP'S STRUCTURE FOR 
      * FURTHER ALIASES.
      * 
      * INPUT:   GROUP-CATNAME    - CATNAME OF GROUP TO BE CHECKED
      *          CAT-WORK         - BLANK 
      *          DATA-RECORD      - GROUP 
  
       CHK-GRP-ALIAS. 
  
      * MOVE GROUP'S NAMES CATEGORY INTO "CAT-WORK" TO FIND THE CURRENT 
      * (SUBSCHEMA) DATANAME. 
           MOVE CAT-NO-NAMES TO DATA-ENTRY-CAT. 
           PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT.
           MOVE "Y" TO SKIP-COMMENTS. 
           PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT.
  
      * IF NO DMSNAME GIVEN, ASSUME THE CATNAME.
           IF DATA-RETURN-CODE NOT = ZERO 
             OR NAME-GRP-DMS = SPACES 
           THEN 
             MOVE GROUP-CATNAME TO ALIAS-DNAME
           ELSE 
             MOVE NAME-GRP-DMS TO ALIAS-DNAME 
           END-IF 
  
      * CHECK CONTROL CATEGORY TO SEE IF IT'S AN EALIAS.
           MOVE CAT-NO-CTL TO DATA-ENTRY-CAT. 
           PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT.
           PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT.
  
      * IF EALIAS EXISTS, MOVE ITS NAMES CATEGORY TO "CAT-WORK".
           IF CTL-ALY-VER NOT = SPACES
           THEN 
             MOVE CTL-ALY-VER TO DATA-ENTRY-NAME
             MOVE CAT-NO-NAMES TO DATA-ENTRY-CAT
             PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT 
             PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT 
  
      * IF NO DMSNAME GIVEN, ASSUME THE CATNAME.
             IF DATA-RETURN-CODE NOT = ZERO 
               OR NAME-GRP-DMS = SPACES 
             THEN 
               MOVE DATA-ENTRY-NAME TO ORIG-DNAME 
             ELSE 
               MOVE NAME-GRP-DMS TO ORIG-DNAME
             END-IF 
             MOVE GROUP-CATNAME TO DATA-ENTRY-NAME
  
      * IF NAME IS DIFFERENT FROM GROUP'S DATANAME, GENERATE AN "AD"
      * CLAUSE FOR IT.
             IF ORIG-DNAME NOT = ALIAS-DNAME
             THEN 
               MOVE KW-AD-DATA TO OUT-FIELD 
               MOVE KW-AD-DATA-LEN TO OUT-LEN 
               PERFORM AD-CLAUSE THRU AD-CLAUSE-XIT 
             END-IF 
           END-IF 
  
      * IF GROUP'S LEVEL HIGH ENOUGH, STORE ITS NAME AS A QUALIFIER.
           IF QUAL-CNT < 5
           THEN 
             ADD 1 TO QUAL-CNT
             MOVE ALIAS-DNAME TO QUAL-DNAME (QUAL-CNT)
           END-IF 
  
      * MOVE GROUP'S FIRST STRUCTURE LINE INTO "CAT-WORK".
           MOVE CAT-NO-STC TO DATA-ENTRY-CAT. 
           PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT.
           MOVE "N" TO SKIP-COMMENTS. 
           PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT.
  
       170-EXPAND-GRP-STC.
  
      * LOOP THROUGH GROUP'S TYPE "A" STRUCTURE LINES LOOKING FOR 
      * ALIASES OF DATA-ITEMS.
  
      * NO MORE STRUCTURE LINES MEANS FINISHED WITH CURRENT LEVEL.
           IF DATA-RETURN-CODE NOT = ZERO 
           THEN 
  
      * IF HIGHEST GROUP LEVEL, EXIT. 
             IF LEVEL-IDX = 2 
             THEN 
               SUBTRACT 1 FROM QUAL-CNT 
               GO TO CHK-GRP-ALIAS-XIT
  
      * IF SUBORDINATE LEVEL, BACK UP A LEVEL AND CONTINUE FROM THERE.
             ELSE 
               SUBTRACT 1 FROM LEVEL-IDX
               IF LEVEL-IDX < QUAL-CNT
               THEN 
                 SUBTRACT 1 FROM QUAL-CNT 
               END-IF 
               PERFORM RESTORE-GRP-INFO THRU RESTORE-GRP-INFO-XIT 
               GO TO 170-EXPAND-GRP-STC 
             END-IF 
           END-IF 
  
      * CHECK THAT LINE IS FOR AN INCLUDED ITEM.
           IF CAT-LINE-TYPE = "A" 
           THEN 
             PERFORM CON-RG-ASTC THRU CON-RG-ASTC-XIT 
  
             IF RG-STC-CNAME NOT = SPACES 
               AND RG-STC-INCL NOT = "N"
             THEN 
  
      * PREPARE TO MOVE DOWN A LEVEL. 
               PERFORM SAVE-GRP-INFO THRU SAVE-GRP-INFO-XIT 
               ADD 1 TO LEVEL-IDX 
  
      * READ DATA ITEM'S FIRST RECORD INTO "DATA-RECORD". 
               PERFORM CLEAR-DATA-ENTRY THRU CLEAR-DATA-ENTRY-XIT 
               MOVE RG-STC-CNAME TO DATA-ENTRY-NAME 
               PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT 
               IF DATA-RETURN-CODE NOT = ZERO 
               THEN 
                 MOVE IDX-500 TO MSG-IDX
                 PERFORM ERROR-TYPE1 THRU ERROR-TYPE1-XIT 
  
      * DETERMINE WHETHER ITEM IS A GROUP OR ELEMENT AND PROCESS
      * ACCORDINGLY.  DIAGNOSE IF LEVEL NUMBER TOO DEEP.
               ELSE 
                 IF DATA-HDR-ENT-ID = ENT-ID-GROUP
                 THEN 
                   IF LEVEL-IDX > 48
                   THEN 
                     MOVE IDX-550 TO MSG-IDX
                     PERFORM ERROR-TYPE0 THRU ERROR-TYPE0-XIT 
                   ELSE 
                     MOVE RG-STC-CNAME TO GROUP-CATNAME 
                     GO TO CHK-GRP-ALIAS
                   END-IF 
                 END-IF 
  
                 IF DATA-HDR-ENT-ID = ENT-ID-ELEM 
                 THEN 
                   IF LEVEL-IDX > 49
                   THEN 
                     MOVE IDX-550 TO MSG-IDX
                     PERFORM ERROR-TYPE0 THRU ERROR-TYPE0-XIT 
                   ELSE 
                     MOVE RG-STC-CNAME TO ELEM-CATNAME
                     MOVE RG-STC-ALIAS TO ELEM-ALIAS
                     PERFORM CHK-ELEM-ALIAS THRU CHK-ELEM-ALIAS-XIT 
                   END-IF 
  
      * ERROR IF OTHER THAN GROUP OR ELEMENT. 
                 ELSE 
                   MOVE IDX-525 TO MSG-IDX
                   PERFORM ERROR-TYPE1 THRU ERROR-TYPE1-XIT 
                 END-IF 
               END-IF 
  
      * MOVE BACK UP A LEVEL. 
               SUBTRACT 1 FROM LEVEL-IDX
               PERFORM RESTORE-GRP-INFO THRU RESTORE-GRP-INFO-XIT 
             END-IF 
  
      * IF NOT TYPE "A", JUST MOVE NEXT STRUCTURE LINE INTO "CAT-WORK". 
           ELSE 
             PERFORM MOVE-NEXT-LINE THRU MOVE-NEXT-LINE-XIT 
             PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT 
           END-IF 
  
      * LOOP BACK TO LOOK AT NEXT STRUCTURE LINE. 
           GO TO 170-EXPAND-GRP-STC.
  
       CHK-GRP-ALIAS-XIT. 
           EXIT.
      /*****************************************************************
      * 
      * CHECK ELEMENT FOR ALIASES.
      * 
      * CHECK EITHER THE ALIAS CATEGORY, IF SPECIFIED, OR THE EALIAS/ 
      * VERSION POINTER TO DETERMINE WHETHER THIS ELEMENT IS KNOWN BY AN
      * ALIAS IN THIS SUBSCHEMA.  IF SO, GENERATE AN "AD" CLAUSE FOR IT.
      * THEN SEARCH THE ELEMENT'S STRUCTURE FOR FURTHER ALIASES.
      * 
      * INPUT:   ELEM-CATNAME     - CATNAME OF ELEMENT TO BE CHECKED
      *          ELEM-ALIAS       - ALIAS NUMBER OF ELEMENT IF GIVEN
      *          CAT-WORK         - BLANK 
      *          DATA-RECORD      - ELEMENT 
  
       CHK-ELEM-ALIAS.
  
      * MOVE ELEMENT'S NAMES CATEGORY INTO "CAT-WORK" TO FIND THE 
      * ORIGINAL (SCHEMA) DATANAME. 
           MOVE CAT-NO-NAMES TO DATA-ENTRY-CAT. 
           PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT.
           MOVE "Y" TO SKIP-COMMENTS. 
           PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT.
  
      * IF NO DMSNAME GIVEN, ASSUME THE CATNAME.
           IF DATA-RETURN-CODE NOT = ZERO 
             OR NAME-DMS = SPACES 
           THEN 
             MOVE ELEM-CATNAME TO ORIG-DNAME
           ELSE 
             MOVE NAME-DMS TO ORIG-DNAME
           END-IF 
  
      * IF ELEMENT ALIASED, MOVE ITS GIVEN ALIAS LINE INTO "CAT-WORK".
           IF ELEM-ALIAS NOT = ZERO 
             AND NOT = SPACES 
           THEN 
             MOVE ELEM-ALIAS TO DATA-ENTRY-LINE 
             MOVE CAT-NO-ALIAS TO DATA-ENTRY-CAT
             PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT 
             MOVE ZERO TO DATA-ENTRY-LINE 
  
      * ERROR IF ALIAS LINE MISSING OR A COMMENT. 
             IF DATA-RETURN-CODE NOT = ZERO 
               OR CAT-COMMENT = "*" 
             THEN 
               MOVE IDX-720 TO MSG-IDX
               MOVE "ELEMENT" TO MSG-NAME 
               PERFORM ERROR-TYPE2 THRU ERROR-TYPE2-XIT 
               GO TO CHK-ELEM-ALIAS-XIT 
             END-IF 
  
      * IF ALIAS NAME GIVEN AND DIFFERENT FROM ELEMENT'S ORIGINAL 
      * DATANAME, GENERATE AN "AD" CLAUSE FOR IT. 
             IF ALY-DATA-NAME NOT = SPACES
               AND NOT = ORIG-DNAME 
             THEN 
               MOVE ALY-DATA-NAME TO ALIAS-DNAME
               MOVE KW-AD-DATA TO OUT-FIELD 
               MOVE KW-AD-DATA-LEN TO OUT-LEN 
               PERFORM AD-CLAUSE THRU AD-CLAUSE-XIT 
               MOVE SPACES TO ELEM-ALIAS
             END-IF 
  
      * IF NO ALIAS GIVEN, CHECK CONTROL CATEGORY TO SEE IF IT'S AN 
      * EALIAS. 
           ELSE 
             MOVE ORIG-DNAME TO ALIAS-DNAME 
             MOVE CAT-NO-CTL TO DATA-ENTRY-CAT
             PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT 
             PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT 
  
      * IF EALIAS EXISTS, MOVE ITS NAMES CATEGORY TO "CAT-WORK".
             IF CTL-ALY-VER NOT = SPACES
             THEN 
               MOVE CTL-ALY-VER TO DATA-ENTRY-NAME
               MOVE CAT-NO-NAMES TO DATA-ENTRY-CAT
               PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT 
               PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT 
  
      * IF NO DMSNAME GIVEN, ASSUME THE CATNAME.
               IF DATA-RETURN-CODE NOT = ZERO 
                 OR NAME-DMS = SPACES 
               THEN 
                 MOVE DATA-ENTRY-NAME TO ORIG-DNAME 
               ELSE 
                 MOVE NAME-DMS TO ORIG-DNAME
               END-IF 
  
      * IF NAME IS DIFFERENT FROM ELEMENT'S DATANAME, GENERATE AN "AD"
      * CLAUSE FOR IT.
               IF ORIG-DNAME NOT = ALIAS-DNAME
               THEN 
                 MOVE KW-AD-DATA TO OUT-FIELD 
                 MOVE KW-AD-DATA-LEN TO OUT-LEN 
                 PERFORM AD-CLAUSE THRU AD-CLAUSE-XIT 
               END-IF 
             END-IF 
           END-IF 
  
       CHK-ELEM-ALIAS-XIT.
           EXIT.
      /*****************************************************************
      ******************************************************************
      * 
      * RESTRICT CLAUSE.
      * 
      * INPUT:   CONSOLID-LINE    - SUBSCH SSREL, LINETYPE "R"
      *          CAT-WORK         - SUBSCH SSREL, LINE AFTER "R"
      * 
      * OUTPUT:  CAT-WORK         - SUBSCH SSREL, NEXT "R" LINE 
  
       RESTRICT-CLAUSE. 
  
      * START NEW RESTRICT CLAUSE CONTAINING RECORD NAME. 
           ADD INDENT-INC TO INDENT.
           MOVE KW-RESTRICT TO OUT-FIELD. 
           MOVE KW-RESTRICT-LEN TO OUT-LEN. 
           PERFORM START-STMT THRU STMT-XIT.
  
           MOVE SUB-SSREL-RESTRICT TO RECORD-CATNAME. 
           MOVE SUB-SSREL-ALIAS TO RECORD-ALIAS.
           PERFORM SAVE-SUB-INFO THRU SAVE-SUB-INFO-XIT.
           PERFORM ADD-REC-NAME THRU ADD-REC-NAME-XIT.
           PERFORM RESTORE-SUB-INFO THRU RESTORE-SUB-INFO-XIT.
  
      * START CONDITION ON NEW LINE.
           ADD INDENT-INC TO INDENT.
           MOVE KW-WHERE TO OUT-FIELD.
           MOVE KW-WHERE-LEN TO OUT-LEN.
           PERFORM START-STMT THRU STMT-XIT.
  
       180-LOGOP-LOOP.
  
      * ADD AS MANY CONDITIONS AS ARE GIVEN.
           IF CAT-LINE-TYPE = "I" 
           THEN 
             PERFORM CON-SUB-ISSREL THRU CON-SUB-ISSREL-XIT 
  
      * ERROR IF EITHER OF THE CONDITION ID'S MISSING -- HAS ALREADY
      * BEEN DIAGNOSED. 
             IF SUB-SSREL-ID1 = SPACES
               OR SUB-SSREL-ID2 = SPACES
             THEN 
               GO TO END-RESTRICT-CLAUSE
             END-IF 
  
      * ADD LEADING "NOT" IF GIVEN. 
             IF SUB-SSREL-PRELOP NOT = SPACES 
             THEN 
               MOVE KW-NOT TO OUT-FIELD 
               MOVE KW-NOT-LEN TO OUT-LEN 
               PERFORM ADD-TO-STMT THRU STMT-XIT
             END-IF 
  
      * ADD LEFT PAREN'S IN ONE CHUNK IF CALLED FOR, BEING CAREFUL NOT
      * TO LEAVE A TRAILING BLANK.
             MOVE ZERO TO OUT-LEN 
             PERFORM VARYING PICK-IDX FROM SUB-SSREL-LPAREN BY -1 
               UNTIL PICK-IDX = ZERO
  
               ADD 1 TO OUT-LEN 
               MOVE "(" TO OUT-FIELD (OUT-LEN : 1)
             END-PERFORM
  
             IF OUT-LEN > ZERO
             THEN 
               PERFORM ADD-TO-STMT THRU STMT-XIT
               SUBTRACT 1 FROM COLUMN-OUT 
             END-IF 
  
      * NOW MOVE THE SUBJECT ELEMENT TO THE CONDITION.
             MOVE SUB-SSREL-ID1 TO ELEM-CATNAME 
             MOVE SUB-SSREL-ALIAS1 TO ELEM-ALIAS
             PERFORM SAVE-SUB-INFO THRU SAVE-SUB-INFO-XIT 
             PERFORM ADD-ELEM-NAME THRU ADD-ELEM-NAME-XIT 
             PERFORM RESTORE-SUB-INFO THRU RESTORE-SUB-INFO-XIT 
  
      * THE ELEMENT MAY BE SUBSCRIPTED. 
             MOVE SUB-SSREL-SUB1 TO RESTR-SUBS
             PERFORM ADD-RESTR-SUBS THRU ADD-RESTR-SUBS-XIT 
  
      * IT MAY ALSO BE QUALIFIED. 
             IF SUB-SSREL-QCNT1 NOT = ZERO
             THEN 
               MOVE SUB-SSREL-QCNT1 TO QUAL-CNT 
               PERFORM ADD-RESTR-QUALS THRU ADD-RESTR-QUALS-XIT 
             END-IF 
  
      * ADD THE RELATIONAL OPERATOR NEXT. 
             MOVE SUB-SSREL-ROP TO OUT-FIELD
             MOVE 2 TO OUT-LEN
             PERFORM ADD-TO-STMT THRU STMT-XIT
  
      * THE CONDITION'S OBJECT MAY BE EITHER A CATNAME, DATANAME, OR
      * LITERAL.
             IF SUB-SSREL-TYPE2 = "C" 
             THEN 
  
      * TRY TO READ FIRST RECORD TO DETERMINE WHETHER CATNAME OR
      * DATANAME. 
               PERFORM SAVE-SUB-INFO THRU SAVE-SUB-INFO-XIT 
               PERFORM CLEAR-DATA-ENTRY THRU CLEAR-DATA-ENTRY-XIT 
               MOVE SUB-SSREL-ID2 TO DATA-ENTRY-NAME
               MOVE "Y" TO DATANAME-OK
               PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT 
  
      * IF A CATNAME, IT MUST BE AN ELEMENT.
               IF DATA-RETURN-CODE = ZERO 
               THEN 
                 MOVE SUB-SSREL-ID2 TO ELEM-CATNAME 
                 MOVE SUB-SSREL-ALIAS2 TO ELEM-ALIAS
                 PERFORM ADD-ELEM-NAME THRU ADD-ELEM-NAME-XIT 
                 PERFORM RESTORE-SUB-INFO THRU RESTORE-SUB-INFO-XIT 
  
      * IT MAY ALSO BE SUBSCRIPTED AND/OR QUALIFIED.
                 MOVE SUB-SSREL-SUB2 TO RESTR-SUBS
                 PERFORM ADD-RESTR-SUBS THRU ADD-RESTR-SUBS-XIT 
  
                 IF SUB-SSREL-QCNT2 NOT = ZERO
                 THEN 
                   MOVE SUB-SSREL-QCNT2 TO QUAL-CNT 
                   PERFORM ADD-RESTR-QUALS THRU ADD-RESTR-QUALS-XIT 
                 END-IF 
  
      * IF A DATANAME, JUST ADD IT TO LINE AS IS. 
               ELSE 
                 MOVE SUB-SSREL-ID2 TO OUT-FIELD
                 PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT 
                 PERFORM ADD-TO-STMT THRU STMT-XIT
                 PERFORM RESTORE-SUB-INFO THRU RESTORE-SUB-INFO-XIT 
               END-IF 
  
      * IF A LITERAL, IT MAY BE NUMERIC OR IN QUOTES. 
             ELSE 
               IF SUB-SSREL-TYPE2 = "L" 
               THEN 
                 MOVE "Y" TO OUT-QUOTE
               END-IF 
  
               MOVE SUB-SSREL-ID2 TO OUT-FIELD
               PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT 
               PERFORM ADD-TO-STMT THRU STMT-XIT
             END-IF 
  
      * ADD ANY RIGHT PAREN'S CALLED FOR AND JUST HOPE THEY FIT ON THIS 
      * LINE SO NO PRECEDING BLANKS GET INSERTED. 
             MOVE ZERO TO OUT-LEN 
             PERFORM VARYING PICK-IDX FROM SUB-SSREL-RPAREN BY -1 
               UNTIL PICK-IDX = ZERO
  
               ADD 1 TO OUT-LEN 
               MOVE ")" TO OUT-FIELD (OUT-LEN : 1)
             END-PERFORM
  
             IF OUT-LEN > ZERO
             THEN 
               SUBTRACT 1 FROM COLUMN-OUT 
               PERFORM ADD-TO-STMT THRU STMT-XIT
             END-IF 
  
      * IF A LOGICAL OPERATOR EXISTS, START A NEW LINE WITH IT AND LOOP 
      * BACK FOR THE NEXT CONDITION.
             IF SUB-SSREL-LOP NOT = SPACES
             THEN 
               PERFORM ADD-LOGOP THRU ADD-LOGOP-XIT 
               GO TO 180-LOGOP-LOOP 
             END-IF 
  
      * ERROR IF LINETYPES OUT OF ORDER.
           ELSE 
             MOVE IDX-705 TO MSG-IDX
             MOVE "SUBSCH-SSREL" TO MSG-NAME
             PERFORM ERROR-TYPE2 THRU ERROR-TYPE2-XIT 
           END-IF 
  
       END-RESTRICT-CLAUSE. 
           ADD INDENT-INIT, INDENT-INC GIVING INDENT. 
  
       RESTRICT-CLAUSE-XIT. 
           EXIT.
  
  
      ******************************************************************
      * 
      * ADD RESTRICT SUBSCRIPTS.
      * 
      * INPUT:   RESTR-SUBS       - THREE SUBSCRIPT FIELDS FROM THE 
      *                             SUBSCH-SSREL CATEGORY 
  
       ADD-RESTR-SUBS.
  
      * ADD SUBSCRIPT(S) IF GIVEN, ENCLOSED IN PAREN'S AND SEPARATED
      * BY COMMAS.
           IF RESTR-SUB1 NOT = SPACES 
             AND NOT = ZERO 
           THEN 
             MOVE "(" TO OUT-FIELD
             MOVE RESTR-SUB1 TO OUT-FIELD (2 : 4) 
             PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT 
             ADD 1 TO OUT-LEN 
  
      * EITHER END WITH RIGHT PAREN OR ADD SECOND SUBSCRIPT.
             IF RESTR-SUB2 = SPACES OR ZERO 
             THEN 
               MOVE ")" TO OUT-FIELD (OUT-LEN : 1)
             ELSE 
               MOVE "," TO OUT-FIELD (OUT-LEN : 1)
               MOVE RESTR-SUB2 TO OUT-FIELD (OUT-LEN + 1 : 4) 
               PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT 
               ADD 1 TO OUT-LEN 
  
      * EITHER END WITH RIGHT PAREN OR ADD THIRD SUBSCRIPT. 
               IF RESTR-SUB3 = SPACES OR ZERO 
               THEN 
                 MOVE ")" TO OUT-FIELD (OUT-LEN : 1)
               ELSE 
                 MOVE "," TO OUT-FIELD (OUT-LEN : 1)
                 MOVE RESTR-SUB3 TO OUT-FIELD (OUT-LEN + 1 : 4) 
                 PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT 
                 ADD 1 TO OUT-LEN 
                 MOVE ")" TO OUT-FIELD (OUT-LEN : 1)
               END-IF 
             END-IF 
  
      * ADD WHOLE SUBSCRIPT TO LINE.
             PERFORM ADD-TO-STMT THRU STMT-XIT
           END-IF 
  
       ADD-RESTR-SUBS-XIT.
           EXIT.
  
  
      ******************************************************************
      * 
      * ADD RESTRICT QUALIFIERS.
      * 
      * ADD EACH QUALIFIER GIVEN ALONG WITH ANY SUBSCRIPTS CALLED FOR.
      * 
      * INPUT:   CONSOLID-LINE    - SUBSCH SSREL, LINETYPE "R"
      *          SUB-CON-LINE     - SAME AS CONSOLID-LINE 
      *          CAT-WORK         - SUBSCH SSREL, LINETYPE "Q" OR "B" 
      *          QUAL-CNT         - NUMBER OF QUALIFIERS ORIGINALLY 
      *                             GIVEN -- SOME MAY BE BLANK DUE TO 
      *                             LATER DELETION
      * 
      * OUTPUT:  CONSOLID-LINE    - SAME AS UPON INPUT
      *          CAT-WORK         - SUBSCH SSREL, NEXT "R" OR "I" LINE
  
       ADD-RESTR-QUALS. 
  
      * NEXT LINE SHOULD BE TYPE "Q" OR "B" -- CONSOLIDATE IT IF NEEDED.
           IF CAT-LINE-TYPE = "Q" OR "B"
           THEN 
             PERFORM CON-SUB-QBSSREL THRU CON-SUB-QBSSREL-XIT 
  
      * AT LEAST ONE QUALIFIER IS EXPECTED. 
             IF SUB-SSREL-QUAL1 NOT = SPACES
             THEN 
               MOVE SUB-SSREL-QUAL1 TO QUAL-CATNAME 
               PERFORM ADD-QUAL-NAME THRU ADD-QUAL-NAME-XIT 
  
               MOVE SUB-SSREL-QSUB1 TO RESTR-SUBS 
               PERFORM ADD-RESTR-SUBS THRU ADD-RESTR-SUBS-XIT 
             END-IF 
  
             IF QUAL-CNT > 1
               AND SUB-SSREL-QUAL2 NOT = SPACES 
             THEN 
               MOVE SUB-SSREL-QUAL2 TO QUAL-CATNAME 
               PERFORM ADD-QUAL-NAME THRU ADD-QUAL-NAME-XIT 
  
               MOVE SUB-SSREL-QSUB2 TO RESTR-SUBS 
               PERFORM ADD-RESTR-SUBS THRU ADD-RESTR-SUBS-XIT 
             END-IF 
  
             IF QUAL-CNT > 2
               AND SUB-SSREL-QUAL3 NOT = SPACES 
             THEN 
               MOVE SUB-SSREL-QUAL3 TO QUAL-CATNAME 
               PERFORM ADD-QUAL-NAME THRU ADD-QUAL-NAME-XIT 
  
               MOVE SUB-SSREL-QSUB3 TO RESTR-SUBS 
               PERFORM ADD-RESTR-SUBS THRU ADD-RESTR-SUBS-XIT 
             END-IF 
           END-IF 
  
      * QUALIFIERS 4 AND 5 ARE ON THE NEXT LINE, TYPE "2" OR "3", IF
      * NOT DELETED.
           IF QUAL-CNT < 4
             OR ( CAT-LINE-TYPE NOT = "2" 
               AND NOT = "3" )
           THEN 
             GO TO END-ADD-RESTR-QUALS
           ELSE 
             PERFORM CON-SUB-23SSREL THRU CON-SUB-23SSREL-XIT 
           END-IF 
  
           IF SUB-SSREL-QUAL4 NOT = SPACES
           THEN 
             MOVE SUB-SSREL-QUAL4 TO QUAL-CATNAME 
             PERFORM ADD-QUAL-NAME THRU ADD-QUAL-NAME-XIT 
  
             MOVE SUB-SSREL-QSUB4 TO RESTR-SUBS 
             PERFORM ADD-RESTR-SUBS THRU ADD-RESTR-SUBS-XIT 
           END-IF 
  
           IF QUAL-CNT > 4
             AND SUB-SSREL-QUAL5 NOT = SPACES 
           THEN 
             MOVE SUB-SSREL-QUAL5 TO QUAL-CATNAME 
             PERFORM ADD-QUAL-NAME THRU ADD-QUAL-NAME-XIT 
  
             MOVE SUB-SSREL-QSUB5 TO RESTR-SUBS 
             PERFORM ADD-RESTR-SUBS THRU ADD-RESTR-SUBS-XIT 
           END-IF 
  
       END-ADD-RESTR-QUALS. 
  
      * RESTORE "CONSOLID-LINE" TO SUBSCH'S TYPE "I" LINE.
           MOVE SUB-CON-LINE TO CONSOLID-LINE.
  
       ADD-RESTR-QUALS-XIT. 
           EXIT.
  
  
      ******************************************************************
      * 
      * ADD LOGICAL OPERATOR. 
      * 
      * IDENTIFY THE LOGICAL OPERATOR AND ADD THE KEYWORDS ACCORDINGLY. 
      * 
      * INPUT:   CONSOLID-LINE    - SUBSCH SSREL, LINETYPE "R"
      *          CAT-WORK         - SUBSCH SSREL, LINETYPE "I"
  
       ADD-LOGOP. 
           IF SUB-SSREL-LOP = "AND" 
           THEN 
             MOVE KW-AND TO OUT-FIELD 
             MOVE KW-AND-LEN TO OUT-LEN 
             PERFORM START-STMT THRU STMT-XIT 
             GO TO ADD-LOGOP-XIT
           END-IF 
  
           IF SUB-SSREL-LOP = "OR"
           THEN 
             MOVE KW-OR TO OUT-FIELD
             MOVE KW-OR-LEN TO OUT-LEN
             PERFORM START-STMT THRU STMT-XIT 
             GO TO ADD-LOGOP-XIT
           END-IF 
  
           IF SUB-SSREL-LOP = "XOR" 
           THEN 
             MOVE KW-XOR TO OUT-FIELD 
             MOVE KW-XOR-LEN TO OUT-LEN 
             PERFORM START-STMT THRU STMT-XIT 
             GO TO ADD-LOGOP-XIT
           END-IF 
  
           IF SUB-SSREL-LOP = "NOT" 
           THEN 
             MOVE KW-NOT TO OUT-FIELD 
             MOVE KW-NOT-LEN TO OUT-LEN 
             PERFORM START-STMT THRU STMT-XIT 
             GO TO ADD-LOGOP-XIT
           END-IF 
  
           IF SUB-SSREL-LOP = "ANDNOT"
           THEN 
             MOVE KW-AND-NOT TO OUT-FIELD 
             MOVE KW-AND-NOT-LEN TO OUT-LEN 
             PERFORM START-STMT THRU STMT-XIT 
             GO TO ADD-LOGOP-XIT
           END-IF 
  
           IF SUB-SSREL-LOP = "ORNOT" 
           THEN 
             MOVE KW-OR-NOT TO OUT-FIELD
             MOVE KW-OR-NOT-LEN TO OUT-LEN
             PERFORM START-STMT THRU STMT-XIT 
             GO TO ADD-LOGOP-XIT
           END-IF 
  
           IF SUB-SSREL-LOP = "XORNOT"
           THEN 
             MOVE KW-XOR-NOT TO OUT-FIELD 
             MOVE KW-XOR-NOT-LEN TO OUT-LEN 
             PERFORM START-STMT THRU STMT-XIT 
           END-IF 
  
       ADD-LOGOP-XIT. 
           EXIT.
      /*****************************************************************
      * THIS SECTION OF PROCEDURES ACCESSES PRIMARILY THE AREA ENTITY.
      ******************************************************************
  
  
      ******************************************************************
      ******************************************************************
      * 
      * RECORD DIVISION ENTRY 
      * 
      * FOR EACH RECORD INCLUDED IN THE AREA, GENERATE A RECORD 
      * DESCRIPTION ENTRY.
      * 
      * INPUT:   AREA-CATNAME     - CATNAME OF GIVEN AREA 
  
       RECORD-DIVISION. 
           PERFORM SAVE-SUB-INFO THRU SAVE-SUB-INFO-XIT.
           PERFORM CLEAR-DATA-ENTRY THRU CLEAR-DATA-ENTRY-XIT.
  
      * MOVE AREA'S FIRST STRUCTURE LINE INTO "CAT-WORK". 
           MOVE AREA-CATNAME TO DATA-ENTRY-NAME 
           MOVE CAT-NO-STC TO DATA-ENTRY-CAT. 
           PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT.
           MOVE "N" TO SKIP-COMMENTS. 
           PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT.
           MOVE "N" TO FOUND-RECORD.
  
      * LOOP THROUGH AREA'S STRUCTURE LINES TO GENERATE DESCRIPTION 
      * ENTRIES.
           PERFORM UNTIL DATA-RETURN-CODE NOT = ZERO
             PERFORM CON-AREA-STC THRU CON-AREA-STC-XIT 
  
             IF A-STC-CNAME NOT = SPACES
               AND A-STC-INCL NOT = "N" 
             THEN 
               MOVE "Y" TO FOUND-RECORD 
               MOVE A-STC-CNAME TO RECORD-CATNAME 
               MOVE A-STC-ALIAS TO RECORD-ALIAS 
               PERFORM RECORD-DESCRIPTION THRU RECORD-DESCRIPTION-XIT 
             END-IF 
           END-PERFORM
  
      * CHECK THAT AT LEAST ONE RECORD EXISTS FOR THE AREA. 
           IF FOUND-RECORD = "N"
           THEN 
             MOVE IDX-600 TO MSG-IDX
             PERFORM ERROR-TYPE1 THRU ERROR-TYPE1-XIT 
           END-IF 
  
           PERFORM RESTORE-SUB-INFO THRU RESTORE-SUB-INFO-XIT.
  
       RECORD-DIVISION-XIT. 
           EXIT.
      /*****************************************************************
      * THIS SECTION OF PROCEDURES ACCESSES PRIMARILY THE RECORD ENTITY.
      ******************************************************************
  
  
      ******************************************************************
      ******************************************************************
      * 
      * RECORD DESCRIPTION GENERATION.
      * 
      * GENERATE A RECORD DESCRIPTION FOR THE GIVEN RECORD.  FOR EACH 
      * GROUP AND ELEMENT ASSOCIATED WITH THE RECORD, CREATE A DATA 
      * DESCRIPTION ENTRY.
      * 
      * INPUT:   RECORD-CATNAME   - CATNAME OF GIVEN RECORD 
      *          RECORD-ALIAS     - ALIAS NUMBER OF RECORD
  
       RECORD-DESCRIPTION.
           PERFORM SAVE-AREA-INFO THRU SAVE-AREA-INFO-XIT.
  
      * START RECORD DESCRIPTION WITH LEVEL NUMBER "01" ON A NEW LINE.
           MOVE 01 TO LEVEL-NO. 
           MOVE LEVEL-NO TO OUT-FIELD.
           MOVE 3 TO OUT-LEN. 
           PERFORM START-STMT THRU STMT-XIT.
  
      * ADD THE RECORD NAME TO OUTPUT LINE. IF ENTRY FOR RECORD MISSING,
      * IT HAS ALREADY BEEN DIAGNOSED, JUST RETURN. 
           MOVE "N" TO SKIP-COMMENTS. 
           PERFORM ADD-REC-NAME THRU ADD-REC-NAME-XIT.
           IF FOUND-ENTITY = "N"
           THEN 
             GO TO END-RECORD-DESCRIPTION 
           END-IF 
  
      * END RECORD ENTRY WITH A PERIOD. 
           MOVE "." TO DMS-LINE (COLUMN-OUT - 1 : 1). 
  
      ******************************************************************
      * 
      * DATA DESCRIPTION ENTRY. 
      * 
      * FOR EACH GROUP OR ELEMENT INCLUDED IN THE RECORD, GENERATE A
      * DATA DESCRIPTION ENTRY. 
  
      * MOVE RECORD'S FIRST STRUCTURE LINE INTO "CAT-WORK". 
           MOVE CAT-NO-STC TO DATA-ENTRY-CAT. 
           PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT.
           PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT.
           MOVE "N" TO FOUND-ITEM.
  
      * LOOP THROUGH RECORD'S STRUCTURE LINES, GENERATING A DATA
      * DESCRIPTION ENTRY FOR EACH INCLUDED GROUP OR ELEMENT. 
           PERFORM UNTIL DATA-RETURN-CODE NOT = ZERO
  
      * CHECK THAT LINE IS OF CORRECT LINETYPE. 
             IF CAT-LINE-TYPE = "A" 
             THEN 
               PERFORM CON-RG-ASTC THRU CON-RG-ASTC-XIT 
  
      * CHECK IF LINE CONTAINS A CATNAME INCLUDED IN THE SUBSCHEMA. 
               IF RG-STC-CNAME NOT = SPACES 
                 AND RG-STC-INCL NOT = "N"
               THEN 
                 MOVE "Y" TO FOUND-ITEM 
                 ADD GTBL-OPT-INCLEV TO LEVEL-NO
                 ADD INDENT-INC TO INDENT 
                 MOVE 2 TO LEVEL-IDX
  
      * FIRST CHECK IF THIS IS A "RENAMES" ENTRY -- IF SO, GENERATE IT
      * TO RENAME BUFFER TO BE OUTPUT AT END OF RECORD DESCRIPTION. 
                 IF CAT-LINE-TYPE = "R" 
                 THEN 
                   PERFORM RENAMES-ENTRY THRU RENAMES-ENTRY-XIT 
  
      * READ DATA ITEM'S FIRST RECORD INTO "DATA-RECORD". 
                 ELSE 
                   PERFORM SAVE-REC-INFO THRU SAVE-REC-INFO-XIT 
                   PERFORM CLEAR-DATA-ENTRY THRU CLEAR-DATA-ENTRY-XIT 
                   MOVE RG-STC-CNAME TO DATA-ENTRY-NAME 
                   PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT 
                   IF DATA-RETURN-CODE NOT = ZERO 
                   THEN 
                     MOVE IDX-500 TO MSG-IDX
                     PERFORM ERROR-TYPE1 THRU ERROR-TYPE1-XIT 
  
      * DETERMINE WHETHER DATA ITEM IS A GROUP OR ELEMENT AND PROCESS 
      * ACCORDINGLY.
                   ELSE 
                     IF DATA-HDR-ENT-ID = ENT-ID-GROUP
                     THEN 
                       MOVE RG-STC-CNAME TO GROUP-CATNAME 
                       PERFORM GRP-DATA-DESCR THRU GRP-DATA-DESCR-XIT 
  
                     ELSE 
                       IF DATA-HDR-ENT-ID = ENT-ID-ELEM 
                       THEN 
                         MOVE RG-STC-CNAME TO ELEM-CATNAME
                         MOVE RG-STC-ALIAS TO ELEM-ALIAS
                         PERFORM ELEM-DATA-DESCR
                           THRU ELEM-DATA-DESCR-XIT 
  
      * ERROR IF OTHER THAN GROUP OR ELEMENT. 
                       ELSE 
                         MOVE IDX-525 TO MSG-IDX
                         PERFORM ERROR-TYPE1 THRU ERROR-TYPE1-XIT 
                       END-IF 
                     END-IF 
                   END-IF 
                 END-IF 
  
                 SUBTRACT GTBL-OPT-INCLEV FROM LEVEL-NO 
                 SUBTRACT INDENT-INC FROM INDENT
                 PERFORM RESTORE-REC-INFO THRU RESTORE-REC-INFO-XIT 
  
      * IF NO CATNAME, LOOK FOR FILLER. 
               ELSE 
                 IF RG-STC-FILL NOT = SPACES
                   AND RG-STC-INCL NOT = "N"
                 THEN 
                   MOVE "Y" TO FOUND-ITEM 
                   ADD GTBL-OPT-INCLEV TO LEVEL-NO
                   ADD INDENT-INC TO INDENT 
  
                   PERFORM FILLER-ENTRY THRU FILLER-ENTRY-XIT 
  
                   SUBTRACT GTBL-OPT-INCLEV FROM LEVEL-NO 
                   SUBTRACT INDENT-INC FROM INDENT
                 END-IF 
               END-IF 
  
      * ERROR IF LINE-TYPES OUT OF ORDER. 
             ELSE 
               MOVE IDX-705 TO MSG-IDX
               MOVE "RECORD-STRUCTURE" TO MSG-NAME
               PERFORM ERROR-TYPE2 THRU ERROR-TYPE2-XIT 
  
      * SKIP THE ERRONEOUS LINE.
               PERFORM MOVE-NEXT-LINE THRU MOVE-NEXT-LINE-XIT 
               PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT 
             END-IF 
           END-PERFORM
  
      * CHECK THAT AT LEAST ONE ITEM EXISTS FOR THE RECORD. 
           IF FOUND-ITEM = "N"
           THEN 
             MOVE IDX-600 TO MSG-IDX
             PERFORM ERROR-TYPE1 THRU ERROR-TYPE1-XIT 
           END-IF 
  
      * IF ANY "RENAMES" ENTRIES HAVE BEEN GENERATED FOR THIS RECORD, 
      * COPY THEM TO OUTPUT BUFFER NOW. 
           PERFORM OUTPUT-RENAMES THRU OUTPUT-RENAMES-XIT.
  
       END-RECORD-DESCRIPTION.
           PERFORM RESTORE-AREA-INFO THRU RESTORE-AREA-INFO-XIT.
  
       RECORD-DESCRIPTION-XIT.
           EXIT.
      /*****************************************************************
      * THIS SECTION OF PROCEDURES ACCESSES PRIMARILY THE GROUP ENTITY. 
      ******************************************************************
  
  
      ******************************************************************
      ******************************************************************
      * 
      * GRP-DATA-DESCR. 
      * 
      * GENERATE A DATA DESCRIPTION ENTRY FOR THE GIVEN GROUP.
      * 
      * INPUT:   GRP-CATNAME      - CATNAME OF GROUP TO BE DESCRIBED
      *          LEVEL-IDX        - INDEX INTO THE "HOLD-GRP" AREA
      *          LEVEL-NO         - LEVEL NUMBER OF GROUP 
      *          CAT-WORK         - BLANK 
      *          DATA-RECORD      - GROUP 
      * 
      * OUTPUT:  CAT-WORK         - RECORD STRUCTURE, NEXT "A" LINE 
  
       GRP-DATA-DESCR.
  
      * START A NEW LINE WITH THE GROUP'S LEVEL NUMBER. 
           MOVE LEVEL-NO TO OUT-FIELD.
           MOVE 3 TO OUT-LEN. 
           PERFORM START-STMT THRU STMT-XIT.
  
      * ADD THE GROUP NAME TO THE OUTPUT LINE.  IF ENTRY FOR GROUP
      * MISSING, IT HAS ALREADY BEEN DIAGNOSED, SO JUST RETURN. 
           PERFORM ADD-GRP-NAME THRU ADD-GRP-NAME-XIT.
           IF FOUND-ENTITY = "N"
           THEN 
             GO TO 500-EXPAND-GRP-STC 
           END-IF 
  
      * MOVE THE PARENT REC/GRP'S INFO BACK IN TO LOOK FOR CLAUSES. 
           PERFORM SAVE-GRP-INFO THRU SAVE-GRP-INFO-XIT.
           IF LEVEL-IDX = 2 
           THEN 
             PERFORM RESTORE-REC-INFO THRU RESTORE-REC-INFO-XIT 
           ELSE 
             SUBTRACT 1 FROM LEVEL-IDX
             PERFORM RESTORE-GRP-INFO THRU RESTORE-GRP-INFO-XIT 
             ADD 1 TO LEVEL-IDX 
           END-IF 
  
           MOVE "Y" TO OUT-CLAUSE.
  
      * IF A "REDEFINES" NAME IS GIVEN, ADD THE REDEFINE CLAUSE.
           PERFORM REDEF-CLAUSE THRU REDEF-CLAUSE-XIT 
  
      * IF A "USAGE" CODE IS GIVEN, ADD THE USAGE CLAUSE. 
           PERFORM USAGE-CLAUSE THRU USAGE-CLAUSE-XIT 
  
      * IF AN "OCCURS-TO" NUMBER IS GIVEN, ADD THE OCCURS CLAUSE. 
           PERFORM OCCURS-CLAUSE THRU OCCURS-CLAUSE-XIT.
  
      * END THE DATA DESCRIPTION ENTRY WITH A PERIOD. 
           MOVE "." TO DMS-LINE (COLUMN-OUT - 1 : 1). 
           MOVE "N" TO OUT-CLAUSE.
  
      * RESTORE EVERYTHING TO THIS GROUP LEVEL. 
           PERFORM RESTORE-GRP-INFO THRU RESTORE-GRP-INFO-XIT.
  
      * MOVE GROUP'S FIRST STRUCTURE LINE INTO "CAT-WORK".
           MOVE CAT-NO-STC TO DATA-ENTRY-CAT. 
           PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT.
           MOVE "N" TO SKIP-COMMENTS. 
           PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT.
           MOVE "N" TO FOUND-GRP (LEVEL-IDX). 
  
  
      ******************************************************************
      * 
       500-EXPAND-GRP-STC.
  
      * LOOP THROUGH GROUP'S STRUCTURE LINES, GENERATING A DATA 
      * DESCRIPTION ENTRY FOR EACH INCLUDED GROUP OR ELEMENT. 
  
      * NO MORE STRUCTURE LINES MEANS FINISHED WITH CURRENT LEVEL.
           IF DATA-RETURN-CODE NOT = ZERO 
           THEN 
  
      * IF INITIAL GROUP LEVEL, EXIT. 
             IF LEVEL-IDX = 2 
             THEN 
               GO TO 510-END-GRP-STC
  
      * IF SUBORDINATE LEVEL, BACK UP A LEVEL AND CONTINUE FROM THERE.
             ELSE 
               IF FOUND-GRP (LEVEL-IDX) = "N" 
               THEN 
                 MOVE IDX-600 TO MSG-IDX
                 PERFORM ERROR-TYPE1 THRU ERROR-TYPE1-XIT 
               END-IF 
  
               SUBTRACT GTBL-OPT-INCLEV FROM LEVEL-NO 
               SUBTRACT 1 FROM LEVEL-IDX
               SUBTRACT INDENT-INC FROM INDENT
               PERFORM RESTORE-GRP-INFO THRU RESTORE-GRP-INFO-XIT 
               GO TO 500-EXPAND-GRP-STC 
             END-IF 
           END-IF 
  
      * CHECK THAT LINE IS FOR AN INCLUDED ITEM.
           IF CAT-LINE-TYPE = "A" 
           THEN 
             PERFORM CON-RG-ASTC THRU CON-RG-ASTC-XIT 
  
             IF RG-STC-CNAME NOT = SPACES 
               AND RG-STC-INCL NOT = "N"
             THEN 
               MOVE "Y" TO FOUND-GRP (LEVEL-IDX)
  
      * PREPARE TO MOVE DOWN A LEVEL. 
               PERFORM SAVE-GRP-INFO THRU SAVE-GRP-INFO-XIT 
               ADD GTBL-OPT-INCLEV TO LEVEL-NO
               ADD 1 TO LEVEL-IDX 
               ADD INDENT-INC TO INDENT 
  
      * FIRST CHECK IF THIS IS A "RENAMES" ENTRY -- IF SO, GENERATE IT
      * TO RENAME BUFFER TO BE OUTPUT AT END OF RECORD DESCRIPTION. 
               IF CAT-LINE-TYPE = "R" 
               THEN 
                 PERFORM RENAMES-ENTRY THRU RENAMES-ENTRY-XIT 
  
      * READ DATA ITEM'S FIRST RECORD INTO "DATA-RECORD". 
               ELSE 
                 PERFORM CLEAR-DATA-ENTRY THRU CLEAR-DATA-ENTRY-XIT 
                 MOVE RG-STC-CNAME TO DATA-ENTRY-NAME 
                 PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT 
                 IF DATA-RETURN-CODE NOT = ZERO 
                 THEN 
                   MOVE IDX-500 TO MSG-IDX
                   PERFORM ERROR-TYPE1 THRU ERROR-TYPE1-XIT 
  
      * DETERMINE WHETHER ITEM IS A GROUP OR ELEMENT AND PROCESS
      * ACCORDINGLY.  DIAGNOSE IF LEVEL NUMBER TOO DEEP.
                 ELSE 
                   IF DATA-HDR-ENT-ID = ENT-ID-GROUP
                   THEN 
                     IF LEVEL-NO > 48 
                     THEN 
                       MOVE IDX-550 TO MSG-IDX
                       PERFORM ERROR-TYPE0 THRU ERROR-TYPE0-XIT 
                     ELSE 
                       MOVE RG-STC-CNAME TO GROUP-CATNAME 
                       GO TO GRP-DATA-DESCR 
                     END-IF 
                   END-IF 
  
                   IF DATA-HDR-ENT-ID = ENT-ID-ELEM 
                   THEN 
                     IF LEVEL-NO > 49 
                     THEN 
                       MOVE IDX-550 TO MSG-IDX
                       PERFORM ERROR-TYPE0 THRU ERROR-TYPE0-XIT 
                     ELSE 
                       MOVE RG-STC-CNAME TO ELEM-CATNAME
                       MOVE RG-STC-ALIAS TO ELEM-ALIAS
                       PERFORM ELEM-DATA-DESCR THRU ELEM-DATA-DESCR-XIT 
                     END-IF 
  
      * ERROR IF OTHER THAN GROUP OR ELEMENT. 
                   ELSE 
                     MOVE IDX-525 TO MSG-IDX
                     PERFORM ERROR-TYPE1 THRU ERROR-TYPE1-XIT 
                   END-IF 
                 END-IF 
               END-IF 
  
      * MOVE BACK UP A LEVEL. 
               SUBTRACT GTBL-OPT-INCLEV FROM LEVEL-NO 
               SUBTRACT 1 FROM LEVEL-IDX
               SUBTRACT INDENT-INC FROM INDENT
               PERFORM RESTORE-GRP-INFO THRU RESTORE-GRP-INFO-XIT 
  
      * IF NO CATNAME, LOOK FOR FILLER. 
             ELSE 
               IF RG-STC-FILL NOT = SPACES
                 AND RG-STC-INCL NOT = "N"
               THEN 
                 MOVE "Y" TO FOUND-GRP (LEVEL-IDX)
                 ADD GTBL-OPT-INCLEV TO LEVEL-NO
                 ADD INDENT-INC TO INDENT 
  
                 PERFORM FILLER-ENTRY THRU FILLER-ENTRY-XIT 
  
                 SUBTRACT GTBL-OPT-INCLEV FROM LEVEL-NO 
                 SUBTRACT INDENT-INC FROM INDENT
               END-IF 
             END-IF 
  
      * ERROR IF LINE-TYPES OUT OF ORDER. 
           ELSE 
             MOVE IDX-705 TO MSG-IDX
             MOVE "GROUP-STRUCTURE" TO MSG-NAME 
             PERFORM ERROR-TYPE2 THRU ERROR-TYPE2-XIT 
  
      * SKIP OVER ERRONEOUS LINE. 
             PERFORM MOVE-NEXT-LINE THRU MOVE-NEXT-LINE-XIT 
             PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT 
           END-IF 
  
      * LOOP BACK TO LOOK AT NEXT STRUCTURE LINE. 
           GO TO 500-EXPAND-GRP-STC.
  
       510-END-GRP-STC. 
  
      * CHECK THAT AT LEAST ONE ITEM EXISTS FOR THE GROUP.
           IF FOUND-GRP (LEVEL-IDX) = "N" 
           THEN 
             MOVE IDX-600 TO MSG-IDX
             PERFORM ERROR-TYPE1 THRU ERROR-TYPE1-XIT 
           END-IF 
  
       GRP-DATA-DESCR-XIT.
           EXIT.
      /*****************************************************************
      * THIS SECTION OF PROCEDURES ACCESSES PRIMARILY THE ELEMENT ENTITY
      ******************************************************************
  
  
      ******************************************************************
      ******************************************************************
      * 
      * ELEM-DATA-DESCR.
      * 
      * GENERATE A DATA DESCRIPTION ENTRY FOR THE GIVEN ELEMENT -- MAY
      * BE CALLED FROM RECORD OR GROUP LEVEL. 
      * 
      * INPUT:   ELEM-CATNAME     - CATNAME OF ELEMENT TO BE DESCRIBED
      *          ELEM-ALIAS       - ALIAS NUMBER OF ELEMENT 
      *          LEVEL-IDX        - INDEX INTO "HOLD-GRP" AREA -- ALSO
      *                             USED TO DETERMINE WHETHER CALLED
      *                             FROM RECORD OR GROUP
      *          LEVEL-NO         - LEVEL NUMBER OF ELEMENT 
      *          CAT-WORK         - BLANK 
      *          DATA-RECORD      - ELEMENT 
      * 
      * OUTPUT:  CONSOLID-LINE    - REC/GRP STRUCTURE, LINETYPE "A"/"O" 
      *          CAT-WORK         - REC/GRP STRUCTURE, NEXT LINE
  
       ELEM-DATA-DESCR. 
  
      * START A NEW LINE WITH THE ELEMENT'S LEVEL NUMBER. 
           MOVE LEVEL-NO TO OUT-FIELD.
           MOVE 3 TO OUT-LEN. 
           PERFORM START-STMT THRU STMT-XIT.
  
      * ADD THE ELEMENT NAME TO THE OUTPUT LINE.  IF ENTRY FOR ELEMENT
      * MISSING, IT HAS ALREADY BEEN DIAGNOSED, SO JUST RETURN. 
           MOVE ELEM-ALIAS TO SAVE-ALIAS. 
           PERFORM ADD-ELEM-NAME THRU ADD-ELEM-NAME-XIT.
           IF FOUND-ENTITY = "N"
           THEN 
             GO TO ELEM-DATA-DESCR-XIT
           END-IF 
  
           PERFORM SAVE-ELEM-INFO THRU SAVE-ELEM-INFO-XIT.
  
      * MAKE SURE THAT ALL CLAUSES START IN THE MIDDLE OF THE LINE. 
           MOVE "Y" TO OUT-CLAUSE.
  
      * THE REDEFINES CLAUSE COMES FROM THE PARENT REC/GRP'S STRUCTURE
      * CATEGORY. 
           IF LEVEL-IDX = 2 
           THEN 
             PERFORM RESTORE-REC-INFO THRU RESTORE-REC-INFO-XIT 
           ELSE 
             SUBTRACT 1 FROM LEVEL-IDX
             PERFORM RESTORE-GRP-INFO THRU RESTORE-GRP-INFO-XIT 
             ADD 1 TO LEVEL-IDX 
           END-IF 
  
  
      ******************************************************************
      * 
      * REDEFINES CLAUSE. 
  
           PERFORM REDEF-CLAUSE THRU REDEF-CLAUSE-XIT.
  
  
      ******************************************************************
      * 
      * PICTURE CLAUSE. 
  
      * PREPARE TO ADD THE PICTURE CLAUSE.
           PERFORM RESTORE-ELEM-INFO THRU RESTORE-ELEM-INFO-XIT.
           MOVE "N" TO ATT-IN-CON.
  
      * IF USING ALIAS OF ELEMENT, PICK UP THE ALIAS PICTURE. 
           IF USE-ALIAS = "Y" 
           THEN 
  
      * MAKE SURE THE ALIAS LINE IS IN "CAT-WORK".
             MOVE SAVE-ALIAS TO DATA-ENTRY-LINE 
             MOVE CAT-NO-ALIAS TO DATA-ENTRY-CAT
             PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT 
             MOVE ZERO TO DATA-ENTRY-LINE 
             MOVE ALY-JUST (1 : 27) TO ALIAS-ATTRIBS
  
      * IF ALIAS PICTURE GIVEN, OUTPUT IT.
             IF ALIAS-PIC NOT = SPACES
             THEN 
               MOVE ALIAS-PIC TO SAVE-PIC 
               PERFORM ELEM-PIC THRU ELEM-PIC-XIT 
               GO TO 600-ELEM-JUST
             END-IF 
           END-IF 
  
      * IF NOT USING ALIAS OR IF NO ALIAS PICTURE GIVEN, MOVE 
      * ELEMENT'S ATTRIBUTE CATEGORY INTO "CAT-WORK". 
           MOVE CAT-NO-ATT TO DATA-ENTRY-CAT. 
           PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT.
           MOVE "Y" TO SKIP-COMMENTS. 
           PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT.
  
      * IF ELEMENT HAS ATTRIBUTES, CONSOLIDATE ATTRIBUTE LINE IF NEEDED.
           IF DATA-RETURN-CODE = ZERO 
           THEN 
             PERFORM CON-ELEM-ATT THRU CON-ELEM-ATT-XIT 
             MOVE "Y" TO ATT-IN-CON 
  
      * LOOK FOR PICTURE AND ADD IT IF GIVEN. 
             IF E-ATT-PIC NOT = SPACES
             THEN 
               MOVE E-ATT-PIC TO SAVE-PIC 
               PERFORM ELEM-PIC THRU ELEM-PIC-XIT 
             END-IF 
           END-IF 
  
  
      ******************************************************************
      * 
      * JUSTIFIED CLAUSE. 
  
       600-ELEM-JUST. 
  
      * IF ALIAS GIVEN FOR ELEMENT, CHECK ALIAS LINE FIRST FOR RIGHT
      * JUSTIFICATION FLAG. 
           IF USE-ALIAS = "Y" 
           THEN 
             IF ALIAS-JUST = "R"
             THEN 
               MOVE KW-JUST-RT TO OUT-FIELD 
               MOVE KW-JUST-RT-LEN TO OUT-LEN 
               PERFORM START-STMT THRU STMT-XIT 
  
               GO TO 610-ELEM-SYNC
             END-IF 
           END-IF 
  
      * IF NO ALIAS GIVEN OR ALIAS LINE DOESN'T INCLUDE "JUSTIFIED" 
      * FIELD, MOVE ELEMENT'S ATTRIBUTE CATEGORY INTO "CAT-WORK". 
           IF ATT-IN-CON = "N"
           THEN 
             MOVE CAT-NO-ATT TO DATA-ENTRY-CAT
             PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT 
             MOVE "Y" TO SKIP-COMMENTS
             PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT 
  
      * IF ELEMENT HAS ATTRIBUTES, CONSOLIDATE ATTRIBUTE LINE IF NEEDED.
             IF DATA-RETURN-CODE = ZERO 
             THEN 
               PERFORM CON-ELEM-ATT THRU CON-ELEM-ATT-XIT 
               MOVE "Y" TO ATT-IN-CON 
  
      * IF NO ATTRIBUTES, GO ON TO "SYNCHRONIZED" CLAUSE. 
             ELSE 
               GO TO 610-ELEM-SYNC
             END-IF 
           END-IF 
  
      * LOOK FOR RIGHT JUSTIFICATION AND ADD IT IF FOUND. 
           IF E-ATT-JUST = "R"
           THEN 
             MOVE KW-JUST-RT TO OUT-FIELD 
             MOVE KW-JUST-RT-LEN TO OUT-LEN 
             PERFORM START-STMT THRU STMT-XIT 
           END-IF 
  
  
      ******************************************************************
      * 
      * SYNCHRONIZED CLAUSE.
  
       610-ELEM-SYNC. 
  
      * IF ALIAS GIVEN FOR ELEMENT, CHECK ALIAS LINE FIRST FOR SYNC 
      * FLAG. 
           IF USE-ALIAS = "Y" 
           THEN 
             IF ALIAS-SYNC NOT = SPACES 
             THEN 
               MOVE ALIAS-SYNC TO SAVE-SYNC 
               PERFORM ELEM-SYNC THRU ELEM-SYNC-XIT 
               GO TO 620-ELEM-USAGE 
             END-IF 
           END-IF 
  
      * IF NO ALIAS GIVEN OR ALIAS LINE DOESN'T INCLUDE "SYNCHRONIZED"
      * FIELD, MOVE ELEMENT'S ATTRIBUTE CATEGORY INTO "CAT-WORK". 
           IF ATT-IN-CON = "N"
           THEN 
             MOVE CAT-NO-ATT TO DATA-ENTRY-CAT
             PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT 
             MOVE "Y" TO SKIP-COMMENTS
             PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT 
  
      * IF ELEMENT HAS ATTRIBUTES, CONSOLIDATE ATTRIBUTE LINE IF NEEDED.
             IF DATA-RETURN-CODE = ZERO 
             THEN 
               PERFORM CON-ELEM-ATT THRU CON-ELEM-ATT-XIT 
               MOVE "Y" TO ATT-IN-CON 
  
      * IF NO ATTRIBUTES, GO ON TO "USAGE" CLAUSE.
             ELSE 
               GO TO 620-ELEM-USAGE 
             END-IF 
           END-IF 
  
      * LOOK FOR SYNCHRONIZED FIELD AND ADD IT IF FOUND.
           IF E-ATT-SYNC NOT = SPACES 
           THEN 
             MOVE E-ATT-SYNC TO SAVE-SYNC 
             PERFORM ELEM-SYNC THRU ELEM-SYNC-XIT 
           END-IF 
  
       620-ELEM-USAGE.
  
      * THE REMAINING CLAUSES COME FROM THE PARENT REC/GRP'S STRUCTURE
      * CATEGORY. 
           IF LEVEL-IDX = 2 
           THEN 
             PERFORM RESTORE-REC-INFO THRU RESTORE-REC-INFO-XIT 
           ELSE 
             SUBTRACT 1 FROM LEVEL-IDX
             PERFORM RESTORE-GRP-INFO THRU RESTORE-GRP-INFO-XIT 
             ADD 1 TO LEVEL-IDX 
           END-IF 
  
  
      ******************************************************************
      * 
      * USAGE CLAUSE. 
  
           PERFORM USAGE-CLAUSE THRU USAGE-CLAUSE-XIT.
  
  
      ******************************************************************
      * 
      * OCCURS CLAUSE.
  
           PERFORM OCCURS-CLAUSE THRU OCCURS-CLAUSE-XIT.
  
      * END THE DATA DESCRIPTION ENTRY WITH A PERIOD. 
           MOVE "." TO DMS-LINE (COLUMN-OUT - 1 : 1). 
           MOVE "N" TO OUT-CLAUSE.
  
  
      ******************************************************************
      * 
      * LEVEL-88 ENTRY. 
  
       630-LEV88-ENTRY. 
  
      * IF ELEMENT HAS AN "OTHER" CATEGORY, USE IT TO CREATE LEVEL-88 
      * ENTRIES.
           PERFORM RESTORE-ELEM-INFO THRU RESTORE-ELEM-INFO-XIT.
           MOVE CAT-NO-OTHER TO DATA-ENTRY-CAT. 
           PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT.
           MOVE "Y" TO SKIP-COMMENTS. 
           PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT.
  
      * CHECK EACH LINE FOR A LEVEL-88 ENTRY AND GENERATE IT IF GIVEN.
           PERFORM UNTIL DATA-RETURN-CODE NOT = ZERO
             IF CAT-DETAIL (2 : 4) = "88L=" 
             THEN 
               MOVE 6 TO COMMENT-COL
               PERFORM LEVEL-88 THRU LEVEL-88-XIT 
             END-IF 
  
             IF CAT-DETAIL (2 : 8) = "88LEVEL=" 
             THEN 
               MOVE 10 TO COMMENT-COL 
               PERFORM LEVEL-88 THRU LEVEL-88-XIT 
             END-IF 
  
      * MOVE NEXT "OTHER" LINE INTO "CAT-WORK". 
             PERFORM MOVE-NEXT-LINE THRU MOVE-NEXT-LINE-XIT 
             PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT 
           END-PERFORM
  
      * RESTORE CORRECT RECORD/GROUP INFO BEFORE EXIT.
           IF LEVEL-IDX = 2 
           THEN 
             PERFORM RESTORE-REC-INFO THRU RESTORE-REC-INFO-XIT 
           ELSE 
             SUBTRACT 1 FROM LEVEL-IDX
             PERFORM RESTORE-GRP-INFO THRU RESTORE-GRP-INFO-XIT 
             ADD 1 TO LEVEL-IDX 
           END-IF 
  
  
      ******************************************************************
      * 
       ELEM-DATA-DESCR-XIT. 
           EXIT.
      /*****************************************************************
      * THE FOLLOWING SUBROUTINES GENERATE DATA DESCRIPTION CLAUSES.
      ******************************************************************
  
  
      ******************************************************************
      ******************************************************************
      * 
      * ADD FILLER ENTRY. 
      * 
      * CALLED FROM EITHER RECORD OR GROUP LEVEL TO ADD A DATA
      * DESCRIPTION ENTRY FOR A FILLER ITEM.
      * 
      * INPUT:   RG-STC-FILL      - LENGTH OF FILLER ITEM 
      *          LEVEL-NO         - LEVEL NUMBER OF FILLER ITEM 
  
       FILLER-ENTRY.
  
      * START THE FILLER ENTRY WITH ITS LEVEL NUMBER AND KEYWORD. 
           MOVE LEVEL-NO TO OUT-FIELD.
           MOVE 3 TO OUT-LEN. 
           PERFORM START-STMT THRU STMT-XIT.
  
           MOVE KW-FILLER TO OUT-FIELD. 
           MOVE KW-FILLER-LEN TO OUT-LEN. 
           PERFORM ADD-TO-STMT THRU STMT-XIT. 
  
      * ADD THE FILLER LENGTH IN A PICTURE CLAUSE.
           MOVE "Y" TO OUT-CLAUSE.
           MOVE KW-PICTURE TO OUT-FIELD.
           MOVE KW-PICTURE-LEN TO OUT-LEN.
           PERFORM START-STMT THRU STMT-XIT.
  
           MOVE "X(" TO OUT-FIELD.
           MOVE RG-STC-FILL TO OUT-FIELD (3 : 4). 
           PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT.
           ADD 1 TO OUT-LEN.
           MOVE ")" TO OUT-FIELD (OUT-LEN : 1). 
           PERFORM ADD-TO-STMT THRU STMT-XIT. 
  
      * END ENTRY WITH A PERIOD.
           MOVE "." TO DMS-LINE (COLUMN-OUT - 1 : 1). 
           MOVE "N" TO OUT-CLAUSE.
  
       FILLER-ENTRY-XIT.
           EXIT.
      /*****************************************************************
      ******************************************************************
      * 
      * RENAMES ENTRY.
      * 
      * ADD A LEVEL-66 "RENAMES" ENTRY FOR A GROUP OR ELEMENT TO A
      * RENAME BUFFER. ALL OF THE "RENAMES" ENTRIES FOR A RECORD WILL BE
      * COPIED TO OUTPUT AT THE END OF THAT RECORD. 
      * 
      * INPUT:   CAT-WORK         - REC/GRP STRUCTURE, LINETYPE "R" 
      *          CONSOLID-LINE    - REC/GRP STRUCTURE, LINETYPE "A" 
      * 
      * OUTPUT:  CAT-WORK         - REC/GRP STRUCTURE, NEXT "A" LINE
  
       RENAMES-ENTRY. 
           MOVE INDENT TO SAVE-INDENT.
           ADD INDENT-INIT, INDENT-INC GIVING INDENT. 
  
      * SAVE ITEM'S NAME AND CONSOLIDATE STRUCTURE LINE IF NEEDED.
           MOVE RG-STC-CNAME TO ITEM-CATNAME. 
           MOVE RG-STC-ALIAS TO ITEM-ALIAS. 
           PERFORM CON-RG-RTSTC THRU CON-RG-RTSTC-XIT.
  
      * IF RENAMES FIELD EMPTY, IT'S ALREADY BEEN DIAGNOSED, JUST EXIT. 
           IF RG-STC-RTNAME = SPACES
           THEN 
             GO TO END-RENAMES-ENTRY
           END-IF 
  
      * TELL THE OUTPUT ROUTINES TO PUT THIS ENTRY IN THE RENAME BUFFER.
           MOVE "Y" TO OUT-RENAME.
  
      * START THE ENTRY WITH THE LEVEL NUMBER.
           MOVE 66 TO OUT-FIELD.
           MOVE 3 TO OUT-LEN. 
           PERFORM START-STMT THRU STMT-XIT.
  
      * ADD THE RENAMING DATANAME TO THE ENTRY.  GIVE UP IF IT DOESN'T
      * EXIST.
           PERFORM ADD-ITEM-NAME THRU ADD-ITEM-NAME-XIT.
           IF FOUND-ENTITY = "N"
           THEN 
             MOVE SPACES TO DMS-LINE
             GO TO END-RENAMES-ENTRY
           END-IF 
  
      * NEXT COMES THE KEYWORD "RENAMES". 
           MOVE KW-RENAMES TO OUT-FIELD.
           MOVE KW-RENAMES-LEN TO OUT-LEN.
           PERFORM ADD-TO-STMT THRU STMT-XIT. 
  
      * ADD THE RENAMED DATANAME AND ALL QUALIFIERS, IF ANY.
           PERFORM ADD-RENAME-ITEM THRU ADD-RENAME-ITEM-XIT.
  
      * NOW ADD "THRU" PHRASE IF GIVEN. 
           IF CAT-LINE-TYPE = "T" 
           THEN 
             PERFORM CON-RG-RTSTC THRU CON-RG-RTSTC-XIT 
             IF RG-STC-RTNAME NOT = SPACES
             THEN 
               MOVE KW-THRU TO OUT-FIELD
               MOVE KW-THRU-LEN TO OUT-LEN
               PERFORM ADD-TO-STMT THRU STMT-XIT
  
               PERFORM ADD-RENAME-ITEM THRU ADD-RENAME-ITEM-XIT 
             END-IF 
           END-IF 
  
           MOVE "." TO DMS-LINE (COLUMN-OUT - 1 : 1). 
  
       END-RENAMES-ENTRY. 
           MOVE "N" TO OUT-RENAME.
           MOVE SAVE-INDENT TO INDENT.
  
      * SAVE REC/GRP INFO SINCE NEW LINES WERE MOVED INTO "CAT-WORK". 
           IF LEVEL-IDX = 2 
           THEN 
             PERFORM SAVE-REC-INFO THRU SAVE-REC-INFO-XIT 
           ELSE 
             SUBTRACT 1 FROM LEVEL-IDX
             PERFORM SAVE-GRP-INFO THRU SAVE-GRP-INFO-XIT 
             ADD 1 TO LEVEL-IDX 
           END-IF 
  
       RENAMES-ENTRY-XIT. 
           EXIT.
  
  
      ******************************************************************
      * 
      * ADD RENAME ITEM.
      * 
      * ADD A RENAME/THRU ITEM-NAME TO THE OUTPUT LINE FOLLOWED BY ALL
      * QUALIFIERS, IF ANY. 
      * 
      * INPUT:   CONSOLID-LINE    - REC/GRP STRUCTURE, LINE "R" 
      *          CAT-WORK         - REC/GRP STRUCTURE, LINE "Q"/"2" IF
      *                             ENOUGH QUALIFIERS, ELSE NEXT "A"
      * 
      * OUTPUT:  CAT-WORK         - REC/GRP STRUCTURE, NEXT "A" LINE
  
       ADD-RENAME-ITEM. 
           MOVE RG-STC-RTNAME TO ITEM-CATNAME.
           MOVE RG-STC-RTALIAS TO ITEM-ALIAS. 
           PERFORM ADD-ITEM-NAME THRU ADD-ITEM-NAME-XIT.
  
      * IF NO ENTITY FOUND OR NO QUALIFIERS, EXIT.
           IF FOUND-ENTITY = "N"
             OR RG-STC-RTQCNT = ZERO
           THEN 
             GO TO ADD-RENAME-ITEM-XIT
           END-IF 
  
      * SAVE THE NUMBER OF QUALIFIERS ORIGINALLY GIVEN -- SOME MAY BE 
      * BLANK DUE TO LATER DELETION.
           MOVE RG-STC-RTQCNT TO QUAL-CNT.
  
           IF RG-STC-RTQUAL1 NOT = SPACES 
           THEN 
             MOVE RG-STC-RTQUAL1 TO QUAL-CATNAME
             PERFORM ADD-QUAL-NAME THRU ADD-QUAL-NAME-XIT 
           END-IF 
  
           IF QUAL-CNT > 1
             AND RG-STC-RTQUAL2 NOT = SPACES
           THEN 
             MOVE RG-STC-RTQUAL2 TO QUAL-CATNAME
             PERFORM ADD-QUAL-NAME THRU ADD-QUAL-NAME-XIT 
           END-IF 
  
           IF QUAL-CNT > 2
             AND RG-STC-RTQUAL3 NOT = SPACES
           THEN 
             MOVE RG-STC-RTQUAL3 TO QUAL-CATNAME
             PERFORM ADD-QUAL-NAME THRU ADD-QUAL-NAME-XIT 
           END-IF 
  
      * QUALIFIERS 4 AND 5 ARE ON THE NEXT LINE, TYPE "Q" OR "2", IF
      * NOT DELETED.
           IF QUAL-CNT < 4
             OR ( CAT-LINE-TYPE NOT = "Q" 
               AND NOT = "2" )
           THEN 
             GO TO ADD-RENAME-ITEM-XIT
           ELSE 
             PERFORM CON-RG-Q2STC THRU CON-RG-Q2STC-XIT 
           END-IF 
  
           IF RG-STC-RTQUAL4 NOT = SPACES 
           THEN 
             MOVE RG-STC-RTQUAL4 TO QUAL-CATNAME
             PERFORM ADD-QUAL-NAME THRU ADD-QUAL-NAME-XIT 
           END-IF 
  
           IF QUAL-CNT > 4
             AND RG-STC-RTQUAL5 NOT = SPACES
           THEN 
             MOVE RG-STC-RTQUAL5 TO QUAL-CATNAME
             PERFORM ADD-QUAL-NAME THRU ADD-QUAL-NAME-XIT 
           END-IF 
  
       ADD-RENAME-ITEM-XIT. 
           EXIT.
  
  
      ******************************************************************
      * 
      * OUTPUT RENAMES ENTRIES. 
      * 
      * COPY THE "RENAMES" ENTRIES FOR THE CURRENT RECORD FROM THE
      * RENAME BUFFER TO THE OUTPUT BUFFER, INSERTING THE SEQUENCE
      * NUMBER IN THE PROCESS.
  
       OUTPUT-RENAMES.
  
      * MOVE CURRENT CONTENTS OF "DMS-LINE" TO OUTPUT/RENAME BUFFER.
           MOVE ZERO TO OUT-LEN.
           PERFORM START-STMT THRU STMT-XIT.
  
      * COPY EACH LINE OF RENAME BUFFER TO OUTPUT BUFFER AND OUTPUT IT. 
           MOVE RENAME-FWA TO BLK-FWA.
           PERFORM UNTIL BLK-FWA = ZERO 
             ENTER "C.CMMMV" USING BLK-FWA, DMS-LINE
             ENTER "CMMFRF" USING BLK-FWA 
             MOVE RENAME-LINK TO BLK-FWA
             PERFORM OUTPUT-DMS THRU OUTPUT-DMS-XIT 
           END-PERFORM
  
      * RE-INITIALIZE POINTER FIELDS WHERE NECESSARY. 
           MOVE ZERO TO PREV-FWA. 
           MOVE ZERO TO RENAME-FWA. 
  
       OUTPUT-RENAMES-XIT.
           EXIT.
      /*****************************************************************
      ******************************************************************
      * 
      * ELEMENT PICTURE CLAUSE. 
      * 
      * INPUT:   SAVE-PIC         - PICTURE FIELD FROM ELEMENT'S
      *                             ATTRIBUTE/ALIAS LINE
  
       ELEM-PIC.
  
      * START PICTURE CLAUSE. 
           MOVE KW-PICTURE TO OUT-FIELD.
           MOVE KW-PICTURE-LEN TO OUT-LEN.
           PERFORM START-STMT THRU STMT-XIT.
  
      * MOVE PICTURE TO LINE. 
           MOVE SAVE-PIC TO OUT-FIELD.
           PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT.
           PERFORM ADD-TO-STMT THRU STMT-XIT. 
  
       ELEM-PIC-XIT.
           EXIT.
      /*****************************************************************
      ******************************************************************
      * 
      * ELEMENT SYNCHRONIZED CLAUSE.
      * 
      * INPUT:   SAVE-SYNC        - SYNCHRONIZATION FIELD FROM ELEMENT'S
      *                             ATTRIBUTES/ALIAS LINE 
  
       ELEM-SYNC. 
  
      * CHECK IF SYNCHRONIZATION TURNED OFF.
           IF SAVE-SYNC = "N" 
           THEN 
             GO TO ELEM-SYNC-XIT
           END-IF 
  
      * START THE SYNCHRONIZED CLAUSE.
           MOVE KW-SYNC TO OUT-FIELD. 
           MOVE KW-SYNC-LEN TO OUT-LEN. 
           PERFORM START-STMT THRU STMT-XIT.
  
      * DETERMINE WHETHER RIGHT OR LEFT SYNC REQUESTED. 
           IF SAVE-SYNC = "R" 
           THEN 
             MOVE KW-RIGHT TO OUT-FIELD 
             MOVE KW-RIGHT-LEN TO OUT-LEN 
             PERFORM ADD-TO-STMT THRU STMT-XIT
           END-IF 
  
           IF SAVE-SYNC = "L" 
           THEN 
             MOVE KW-LEFT TO OUT-FIELD
             MOVE KW-LEFT-LEN TO OUT-LEN
             PERFORM ADD-TO-STMT THRU STMT-XIT
           END-IF 
  
       ELEM-SYNC-XIT. 
           EXIT.
      /*****************************************************************
      ******************************************************************
      * 
      * REDEFINES CLAUSE. 
      * 
      * ADD THE "REDEFINES" CLAUSE TO EITHER A GROUP OR ELEMENT DATA
      * DESCRIPTION IF GIVEN. 
      * 
      * INPUT:   CONSOLID-LINE    - REC/GRP STRUCTURE, LINETYPE "A" 
  
       REDEF-CLAUSE.
           IF RG-STC-REDEF NOT = SPACES 
           THEN 
  
      * START CLAUSE WITH ITS KEYWORD.
             MOVE KW-REDEF TO OUT-FIELD 
             MOVE KW-REDEF-LEN TO OUT-LEN 
             PERFORM START-STMT THRU STMT-XIT 
  
      * ADD THE REDEFINED NAME, EITHER GROUP OR ELEMENT, TO CLAUSE. 
             MOVE RG-STC-REDEF TO ITEM-CATNAME
             MOVE RG-STC-RALIAS TO ITEM-ALIAS 
             PERFORM ADD-ITEM-NAME THRU ADD-ITEM-NAME-XIT 
           END-IF 
  
       REDEF-CLAUSE-XIT.
           EXIT.
      /*****************************************************************
      ******************************************************************
      * 
      * USAGE CLAUSE. 
      * 
      * ADD THE "USAGE" CLAUSE FOR EITHER A GROUP OR ELEMENT DATA 
      * DESCRIPTION IF GIVEN. 
      * 
      * INPUT:   CONSOLID-LINE    - REC/GRP STRUCTURE, LINETYPE "A" 
  
       USAGE-CLAUSE.
           IF RG-STC-USAGE NOT = SPACES 
           THEN 
  
      * START THE CLAUSE WITH THE KEYWORDS "USAGE IS".
             MOVE KW-USAGE TO OUT-FIELD 
             MOVE KW-USAGE-LEN TO OUT-LEN 
             PERFORM START-STMT THRU STMT-XIT 
  
      * DETERMINE WHICH USAGE IS REQUESTED AND ADD IT.
             IF RG-STC-USAGE = "COMP" 
             THEN 
               MOVE KW-COMP TO OUT-FIELD
               MOVE KW-COMP-LEN TO OUT-LEN
               PERFORM ADD-TO-STMT THRU STMT-XIT
             END-IF 
  
             IF RG-STC-USAGE = "COMP1"
             THEN 
               MOVE KW-COMP-1 TO OUT-FIELD
               MOVE KW-COMP-1-LEN TO OUT-LEN
               PERFORM ADD-TO-STMT THRU STMT-XIT
             END-IF 
  
             IF RG-STC-USAGE = "COMP2"
             THEN 
               MOVE KW-COMP-2 TO OUT-FIELD
               MOVE KW-COMP-2-LEN TO OUT-LEN
               PERFORM ADD-TO-STMT THRU STMT-XIT
             END-IF 
  
             IF RG-STC-USAGE = "DISPLAY"
             THEN 
               MOVE KW-DISPLAY TO OUT-FIELD 
               MOVE KW-DISPLAY-LEN TO OUT-LEN 
               PERFORM ADD-TO-STMT THRU STMT-XIT
             END-IF 
  
             IF RG-STC-USAGE = "INDEX"
             THEN 
               MOVE KW-INDEX TO OUT-FIELD 
               MOVE KW-INDEX-LEN TO OUT-LEN 
               PERFORM ADD-TO-STMT THRU STMT-XIT
             END-IF 
           END-IF 
  
       USAGE-CLAUSE-XIT.
           EXIT.
      /*****************************************************************
      ******************************************************************
      * 
      * OCCURS CLAUSE.
      * 
      * ADD THE "OCCURS" CLAUSE TO EITHER A GROUP OR ELEMENT DATA 
      * DESCRIPTION.
      * 
      * INPUT:   CAT-WORK         - REC/GRP STRUCTURE, LINE AFTER "A" 
      * 
      * OUTPUT:  CAT-WORK         - REC/GRP STRUCTURE, NEXT "A" LINE
  
       OCCURS-CLAUSE. 
  
      * LOOK AT PARENT RECORD/GROUP'S NEXT STRUCTURE LINE IN "CAT-WORK" 
      * FOR OCCURS CLAUSE.
           IF CAT-LINE-TYPE NOT = "O" 
           THEN 
             GO TO OCCURS-CLAUSE-XIT
           END-IF 
  
      * CONSOLIDATE TYPE "O" STRUCTURE LINE IF NEEDED.
           PERFORM CON-RG-OSTC THRU CON-RG-OSTC-XIT 
  
      * MAKE SURE THAT "TO" FIELD EXISTS. 
           IF RG-STC-TO = SPACES
           THEN 
             GO TO END-OCCURS-CLAUSE
           END-IF 
  
      * START CLAUSE WITH ITS KEYWORD.
           MOVE KW-OCCURS TO OUT-FIELD. 
           MOVE KW-OCCURS-LEN TO OUT-LEN. 
           PERFORM START-STMT THRU STMT-XIT.
  
      * IF THE "FROM" FIELD EXISTS, ADD IT FIRST. 
           IF RG-STC-FROM NOT = SPACES
           THEN 
             MOVE RG-STC-FROM TO OUT-FIELD
             PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT 
             IF OUT-FIELD (1 : OUT-LEN) IS NUMERIC
             THEN 
               PERFORM ADD-TO-STMT THRU STMT-XIT
  
               MOVE KW-TO TO OUT-FIELD
               MOVE KW-TO-LEN TO OUT-LEN
               PERFORM ADD-TO-STMT THRU STMT-XIT
  
      * ERROR IF "FROM" NOT NUMERIC.
             ELSE 
               MOVE IDX-715 TO MSG-IDX
               MOVE "REC/GRP-STRUCTURE-FROM" TO MSG-NAME
               PERFORM ERROR-TYPE2 THRU ERROR-TYPE2-XIT 
             END-IF 
           END-IF 
  
      * NOW ADD THE "TO" FIELD. 
           MOVE RG-STC-TO TO OUT-FIELD
           PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT 
           IF OUT-FIELD (1 : OUT-LEN) IS NUMERIC
           THEN 
             PERFORM ADD-TO-STMT THRU STMT-XIT
  
             MOVE KW-TIMES TO OUT-FIELD 
             MOVE KW-TIMES-LEN TO OUT-LEN 
             PERFORM ADD-TO-STMT THRU STMT-XIT
  
      * ERROR IF "TO" NOT NUMERIC.
           ELSE 
             MOVE IDX-715 TO MSG-IDX
             MOVE "REC/GRP-STRUCTURE-TO" TO MSG-NAME
             PERFORM ERROR-TYPE2 THRU ERROR-TYPE2-XIT 
           END-IF 
  
      * CHECK FOR "DEPENDING ON" ITEM.  ADD IT AND ALL ITS QUALIFIERS.
           IF RG-STC-DEPEND NOT = SPACES
           THEN 
             MOVE KW-DEP-ON TO OUT-FIELD
             MOVE KW-DEP-ON-LEN TO OUT-LEN
             PERFORM ADD-TO-STMT THRU STMT-XIT
  
             MOVE RG-STC-DEPEND TO ELEM-CATNAME 
  
      * CHECK IF DEPENDS ITEM IS IN CATALOG.  IF NOT, JUST MOVE IT TO 
      * OUTPUT LINE.
             PERFORM SAVE-ALT-INFO THRU SAVE-ALT-INFO-XIT 
             PERFORM CLEAR-DATA-ENTRY THRU CLEAR-DATA-ENTRY-XIT 
             MOVE ELEM-CATNAME TO DATA-ENTRY-NAME 
             PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT 
  
             IF DATA-RETURN-CODE NOT = ZERO 
             THEN 
               MOVE ELEM-CATNAME (1 : 30) TO OUT-FIELD
               PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT 
               PERFORM ADD-TO-STMT THRU STMT-XIT
               GO TO 700-KEY-IS 
             END-IF 
  
      * IF IT'S IN CATALOG, ADD IT AND LOOK FOR QUALIFIERS. 
             MOVE RG-STC-DALIAS TO ELEM-ALIAS 
             PERFORM ADD-ELEM-NAME THRU ADD-ELEM-NAME-XIT 
             PERFORM RESTORE-ALT-INFO THRU RESTORE-ALT-INFO-XIT 
  
      * SAVE THE NUMBER OF QUALIFIERS ORIGINALLY GIVEN -- SOME MAY BE 
      * BLANK DUE TO LATER DELETION.
             MOVE RG-STC-QCNT TO QUAL-CNT 
             IF QUAL-CNT > 0
               AND RG-STC-QUAL1 NOT = SPACES
             THEN 
               MOVE RG-STC-QUAL1 TO QUAL-CATNAME
               PERFORM ADD-QUAL-NAME THRU ADD-QUAL-NAME-XIT 
             END-IF 
  
             IF QUAL-CNT > 1
               AND RG-STC-QUAL2 NOT = SPACES
             THEN 
               MOVE RG-STC-QUAL2 TO QUAL-CATNAME
               PERFORM ADD-QUAL-NAME THRU ADD-QUAL-NAME-XIT 
             END-IF 
  
      * QUALIFIERS 3 THRU 5 ARE ON THE NEXT LINE, TYPE "D", IF NOT
      * DELETED.
             IF QUAL-CNT < 3
               OR CAT-LINE-TYPE NOT = "D" 
             THEN 
               GO TO 700-KEY-IS 
             ELSE 
               PERFORM CON-RG-DSTC THRU CON-RG-DSTC-XIT 
             END-IF 
  
             IF RG-STC-QUAL3 NOT = SPACES 
             THEN 
               MOVE RG-STC-QUAL3 TO QUAL-CATNAME
               PERFORM ADD-QUAL-NAME THRU ADD-QUAL-NAME-XIT 
             END-IF 
  
             IF QUAL-CNT > 3
               AND RG-STC-QUAL4 NOT = SPACES
             THEN 
               MOVE RG-STC-QUAL4 TO QUAL-CATNAME
               PERFORM ADD-QUAL-NAME THRU ADD-QUAL-NAME-XIT 
             END-IF 
  
             IF QUAL-CNT > 4
               AND RG-STC-QUAL5 NOT = SPACES
             THEN 
               MOVE RG-STC-QUAL5 TO QUAL-CATNAME
               PERFORM ADD-QUAL-NAME THRU ADD-QUAL-NAME-XIT 
             END-IF 
           END-IF 
  
      ******************************************************************
      * 
      * OCCURS KEY PHRASE.
  
       700-KEY-IS.
  
      * IF NEXT LINE IS TYPE "K", GENERATE A "KEY IS" PHRASE. 
           PERFORM UNTIL DATA-RETURN-CODE NOT = ZERO
             OR CAT-LINE-TYPE NOT = "K" 
  
             PERFORM CON-RG-KSTC THRU CON-RG-KSTC-XIT 
  
      * FIRST ADD THE KEY ORDER IF GIVEN ON THIS LINE.
             IF RG-STC-KORDER = "A" 
             THEN 
               MOVE KW-ASCEND TO OUT-FIELD
               MOVE KW-ASCEND-LEN TO OUT-LEN
               PERFORM START-STMT THRU STMT-XIT 
  
               MOVE KW-KEY-IS TO OUT-FIELD
               MOVE KW-KEY-IS-LEN TO OUT-LEN
               PERFORM ADD-TO-STMT THRU STMT-XIT
             END-IF 
  
             IF RG-STC-KORDER = "D" 
             THEN 
               MOVE KW-DESCEND TO OUT-FIELD 
               MOVE KW-DESCEND-LEN TO OUT-LEN 
               PERFORM START-STMT THRU STMT-XIT 
  
               MOVE KW-KEY-IS TO OUT-FIELD
               MOVE KW-KEY-IS-LEN TO OUT-LEN
               PERFORM ADD-TO-STMT THRU STMT-XIT
             END-IF 
  
      * KEY MAY BE GROUP OR ELEMENT.  ADD IT TO LINE. 
             IF RG-STC-KNAME NOT = SPACES 
             THEN 
               MOVE RG-STC-KNAME TO ITEM-CATNAME
               MOVE RG-STC-KALIAS TO ITEM-ALIAS 
               PERFORM ADD-ITEM-NAME THRU ADD-ITEM-NAME-XIT 
             END-IF 
           END-PERFORM
  
      ******************************************************************
      * 
      * OCCURS INDEXED BY CLAUSE. 
  
       710-INDEXED-BY.
  
      * IF NEXT LINE IS TYPE "I", GENERATE AN "INDEXED BY" CLAUSE.
           IF CAT-LINE-TYPE = "I" 
           THEN 
             MOVE KW-IDX-BY TO OUT-FIELD
             MOVE KW-IDX-BY-LEN TO OUT-LEN
             PERFORM START-STMT THRU STMT-XIT 
  
      * ADD AS MANY INDEXES AS ARE GIVEN. 
             PERFORM UNTIL DATA-RETURN-CODE NOT = ZERO
               OR CAT-LINE-TYPE NOT = "I" 
  
      * INDEX IS A DATANAME, NOT A CATNAME.  JUST MOVE IT TO LINE.
               MOVE STC-INDEX (1 : 30) TO OUT-FIELD 
               PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT 
               PERFORM ADD-TO-STMT THRU STMT-XIT
  
      * MOVE NEXT STRUCTURE LINE INTO "CAT-WORK". 
               PERFORM MOVE-NEXT-LINE THRU MOVE-NEXT-LINE-XIT 
               PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT 
             END-PERFORM
           END-IF 
  
      * CHECK IF "K" LINE CAME AFTER "I" LINE.  IF SO, BACK UP AND
      * PROCESS IT. 
           IF CAT-LINE-TYPE = "K" 
           THEN 
             GO TO 700-KEY-IS 
           END-IF 
  
      ******************************************************************
      * 
       END-OCCURS-CLAUSE. 
  
      * SAVE REC/GRP INFO SINCE NEW LINES WERE MOVED INTO "CAT-WORK". 
           IF LEVEL-IDX = 2 
           THEN 
             PERFORM SAVE-REC-INFO THRU SAVE-REC-INFO-XIT 
           ELSE 
             SUBTRACT 1 FROM LEVEL-IDX
             PERFORM SAVE-GRP-INFO THRU SAVE-GRP-INFO-XIT 
             ADD 1 TO LEVEL-IDX 
           END-IF 
  
       OCCURS-CLAUSE-XIT. 
           EXIT.
  
  
      ******************************************************************
      * 
      * LEVEL-88 ENTRY. 
      * 
      * INPUT:   CAT-WORK         - ELEMENT OTHER, "88LEVEL"
      *          COMMENT-COL      - POINTER TO FIRST COLUMN OF ENTRY
      *                             WITHIN "CAT-DETAIL" 
  
       LEVEL-88.
  
      * START LEVEL-88 ENTRY INDENTED UNDER ELEMENT ENTRY.
           ADD INDENT-INC TO INDENT.
           MOVE 88 TO OUT-FIELD.
           MOVE 3 TO OUT-LEN. 
           PERFORM START-STMT THRU STMT-XIT.
  
      * TREAT "OTHER" CONTENTS SAME AS A COMMENT BECAUSE IT MAY BE TOO
      * LONG TO FIT ON A LINE.
           SUBTRACT COLUMN-OUT FROM 73 GIVING COLUMNS-LEFT. 
  
      * FIND LENGTH OF DETAIL WITHOUT TRAILING BLANKS.
           SUBTRACT 2 FROM DETAIL-LEN.
           PERFORM VARYING COMMENT-LEN FROM DETAIL-LEN  BY -1 
             UNTIL CAT-DETAIL (COMMENT-COL + COMMENT-LEN : 1) 
               NOT = SPACE
               OR COMMENT-LEN = ZERO
             CONTINUE 
           END-PERFORM
           ADD 2 TO DETAIL-LEN. 
           ADD 1 TO COMMENT-LEN.
  
       720-LEV88-LOOP.
  
      * IF DETAIL IS TOO LONG FOR ONE LINE, SPLIT IT ON A WORD BOUNDARY 
      * AND MOVE FIRST PART TO LINE.
           IF COMMENT-LEN > COLUMNS-LEFT
           THEN 
             SUBTRACT 1 FROM COLUMNS-LEFT 
             PERFORM VARYING PICK-IDX FROM COLUMNS-LEFT BY -1 
               UNTIL CAT-DETAIL (COMMENT-COL + PICK-IDX : 1) = SPACE
                 OR PICK-IDX = ZERO 
               CONTINUE 
             END-PERFORM
             ADD 1 TO COLUMNS-LEFT
  
             IF PICK-IDX < ZERO 
             THEN 
               MOVE COLUMNS-LEFT TO PICK-IDX
             ELSE 
               ADD 1 TO PICK-IDX
             END-IF 
  
             MOVE CAT-DETAIL (COMMENT-COL : PICK-IDX) TO OUT-FIELD
             MOVE PICK-IDX TO OUT-LEN 
             PERFORM ADD-TO-STMT THRU STMT-XIT
  
      * DETERMINE HOW MUCH OF DETAIL IS LEFT AND LOOP BACK TO MOVE IT.
             ADD PICK-IDX TO COMMENT-COL
             SUBTRACT PICK-IDX FROM COMMENT-LEN 
             SUBTRACT INDENT, INDENT-INC FROM 73 GIVING COLUMNS-LEFT
             GO TO 720-LEV88-LOOP 
  
      * IF DETAIL FITS ON LINE, JUST MOVE IT. 
           ELSE 
             MOVE CAT-DETAIL (COMMENT-COL : COMMENT-LEN) TO OUT-FIELD 
             MOVE COMMENT-LEN TO OUT-LEN
             PERFORM ADD-TO-STMT THRU STMT-XIT
           END-IF 
  
      * END LEVEL-88 ENTRY WITH A PERIOD. 
           MOVE "." TO DMS-LINE (COLUMN-OUT - 1 : 1). 
           SUBTRACT INDENT-INC FROM INDENT. 
  
       LEVEL-88-XIT.
           EXIT.
      /*****************************************************************
      * UTILITIES SPECIFIC TO DMS SUBSCHEMA GENERATION. 
      ******************************************************************
  
      ******************************************************************
      * 
      * OUTPUT-DMS. 
      * 
      * OUTPUT-DMS ADDS THE SEQUENCE NUMBER TO "DMS-LINE" AND MOVES IT
      * TO THE OUTPUT BUFFER "GTBL-OUTPUT-TABLE", WHICH WILL BE PRINTED 
      * WHEN IT BECOMES 40 LINES LONG.  IF A LEVEL-66 ENTRY IS IN 
      * "DMS-LINE", HOWEVER, THE LINE WILL BE WRITTEN TO A RENAME BUFFER
      * FOR LATER USE.
      * 
      * INPUT:   DMS-RENAME       - "Y" IF CURRENT CONTENTS OF DMS-LINE 
      *                             TO BE WRITTEN TO RENAME BUFFER-- NOT
      *                             TO BE RESET BY CALLING PROGRAM
      *          OUT-RENAME       - "Y" IF NEXT CONTENTS OF DMS-LINE TO 
      *                             BE WRITTEN TO RENAME BUFFER -- UNDER
      *                             CONTROL OF CALLING PROGRAM
  
       OUTPUT-DMS.
  
      * CHECK WHETHER LINE GOES TO OUTPUT BUFFER OR RENAME BUFFER.
           IF DMS-RENAME = "N"
           THEN 
  
      * INCREMENT INDEX INTO THE OUTPUT BUFFER. 
             ADD 1 TO GTBL-COUNT
  
      * INSERT SEQUENCE NUMBER INTO LINE. 
             MOVE SEQ-NO TO DMS-SEQNO 
             ADD GTBL-OPT-INCSEQNO TO SEQ-NO
  
      * MOVE LINE IMAGE INTO OUTPUT BUFFER AND CHECK IF IT'S FULL.
             MOVE DMS-LINE TO GTBL-CARD-IMAGE (GTBL-COUNT)
             PERFORM OUTPUT-CHECK THRU OUTPUT-CHECK-XIT 
  
      * IF LINE BELONGS IN RENAME BUFFER, ALLOCATE NEW BLOCK AND MOVE IT
           ELSE 
             ENTER "CMMALF" USING BLK-SIZE, SIZE-CODE, GRP-ID, BLK-FWA
  
      * IF NOT FIRST BLOCK IN LINKED LIST, SAVE FWA IN PREVIOUS BLOCK'S 
      * LINK FIELD. 
             IF PREV-FWA NOT = ZERO 
             THEN 
               MOVE BLK-FWA TO RENAME-LINK
               ENTER "C.CMMMV" USING RENAME-LINK, PREV-FWA, LINK-POSN 
             END-IF 
  
      * MOVE "DMS-LINE" TO NEW BLOCK. 
             MOVE ZERO TO RENAME-LINK 
             ENTER "C.CMMMV" USING DMS-LINE, BLK-FWA
             MOVE BLK-FWA TO PREV-FWA 
  
      * IF FIRST BLOCK, SAVE ITS ADDRESS. 
             IF RENAME-FWA = ZERO 
             THEN 
               MOVE BLK-FWA TO RENAME-FWA 
             END-IF 
           END-IF 
  
           MOVE SPACES TO DMS-LINE. 
  
      * SET FLAG FOR DESTINATION OF NEXT LINE.
           IF OUT-RENAME = "Y"
           THEN 
             MOVE "Y" TO DMS-RENAME 
           ELSE 
             MOVE "N" TO DMS-RENAME 
           END-IF 
  
       OUTPUT-DMS-XIT.
           EXIT.
  
  
      ******************************************************************
      * 
      * OUTPUT-COMMENT. 
      * 
      * MOVE THE CONTENTS OF "CAT-DETAIL" TO COLUMN SEVEN OF THE OUTPUT 
      * BUFFER "GTBL-OUTPUT-TABLE", WHICH WILL BE PRINTED WHEN IT 
      * BECOMES 40 LINES LONG.
  
       OUTPUT-COMMENT.
  
      * INCREMENT INDEX INTO OUTPUT BUFFER AND INITIALIZE COMMENT-LINE
      * POINTERS. 
           ADD 1 TO GTBL-COUNT. 
           MOVE 2 TO COMMENT-COL. 
  
      * FIND LENGTH OF COMMENT WITHOUT TRAILING BLANKS. 
           SUBTRACT 2 FROM DETAIL-LEN.
           PERFORM VARYING COMMENT-LEN FROM DETAIL-LEN  BY -1 
             UNTIL CAT-DETAIL (COMMENT-COL + COMMENT-LEN : 1) 
               NOT = SPACE
               OR COMMENT-LEN = ZERO
             CONTINUE 
           END-PERFORM
           ADD 2 TO DETAIL-LEN. 
           ADD 1 TO COMMENT-LEN.
  
       800-COMMENT-LOOP.
  
      * IF COMMENT IS TOO LONG FOR ONE LINE, SPLIT IT ON A WORD BOUNDARY
      * AND MOVE THE FIRST PART TO THE COMMENT-LINE.
           IF COMMENT-LEN > 64
           THEN 
             PERFORM VARYING PICK-IDX FROM 63 BY -1 
               UNTIL CAT-DETAIL (COMMENT-COL + PICK-IDX : 1) = SPACE
                 OR PICK-IDX < ZERO 
               CONTINUE 
             END-PERFORM
  
             IF PICK-IDX < ZERO 
             THEN 
               MOVE 64 TO PICK-IDX
             ELSE 
               ADD 1 TO PICK-IDX
             END-IF 
             MOVE CAT-DETAIL (COMMENT-COL : PICK-IDX) TO SUBSCH-CMNT
             ADD PICK-IDX TO COMMENT-COL
             SUBTRACT PICK-IDX FROM COMMENT-LEN 
  
      * IF COMMENT FITS ON LINE, JUST MOVE IT.
           ELSE 
             MOVE CAT-DETAIL (COMMENT-COL : COMMENT-LEN) TO SUBSCH-CMNT 
             MOVE ZERO TO COMMENT-LEN 
           END-IF 
  
      * INSERT SEQUENCE NUMBER INTO LINE. 
           MOVE SEQ-NO TO SUB-CMNT-SEQNO. 
           ADD GTBL-OPT-INCSEQNO TO SEQ-NO. 
  
      * MOVE LINE IMAGE INTO OUTPUT BUFFER AND CHECK IF IT'S FULL.
           MOVE SUBSCH-COMMENT TO GTBL-CARD-IMAGE (GTBL-COUNT). 
           PERFORM OUTPUT-CHECK THRU OUTPUT-CHECK-XIT.
  
      * IF NOT FINISHED WITH COMMENT, GO BACK AND OUTPUT THE REST OF IT.
           IF COMMENT-LEN > ZERO
           THEN 
             ADD 1 TO GTBL-COUNT
             GO TO 800-COMMENT-LOOP 
           END-IF 
  
       OUTPUT-COMMENT-XIT.
           EXIT.
  
*CALL DMSIO 
*CALL DMSADD0 
*CALL DMSADD1 
*CALL DMSADD2 
*CALL DMSSAV1 
*CALL DMSSAV2 
*CALL DMSSAV3 
*CALL DMSSAV4 
*CALL DMSSAV5 
*CALL DMSSAVSUB 
*CALL DMSCON1 
*CALL DMSCON2 
*CALL DMSCONSUB 
