*DECK DCDMS328
       IDENTIFICATION DIVISION. 
       PROGRAM-ID.   DMS328.
  
      ******************************************************************
      * 
      * THIS MODULE PROCESSES THE GENERATION OF A CDCS (DMS-170) MASTER 
      * DIRECTORY.  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 
*CALL DATAVER 
  
      ******************************************************************
      * 
      * ITEMS SPECIFIC TO MASTER DIRECTORY GENERATION.
  
      ******************************************************************
      * 
      * VALUES RELATING TO INDENTATION OF MASTER DIRECTORY LINES. 
       01  INDENT-VALUES. 
           03  INDENT-INIT        PICTURE 99     VALUE 5. 
           03  INDENT-INC         PICTURE 99     VALUE 4. 
           03  INDENT-MAX         PICTURE 99     VALUE 40.
  
      ******************************************************************
      * 
       01  MISCELLANEOUS. 
           03  FILE-CATNAME       PICTURE X(32).
           03  FILE-TYPE          PICTURE X.
           03  PREVIOUS-VERSION   PICTURE X(7). 
           03  PICK-IDX           PICTURE 99. 
           03  SCHEMA-LFN         PICTURE X(7). 
           03  SUBSCH-LFN         PICTURE X(7). 
  
      ******************************************************************
      * 
      * LIST OF KEYWORDS/PHRASES USED IN MASTER DIRECTORY GENERATION. 
      * 
       01  KEYWORD-LIST.
           03  KW-ACCOUNT         PICTURE X(10)  VALUE "ACCOUNT IS".
           03  KW-ACCOUNT-LEN     PICTURE 99     VALUE 10.
           03  KW-AFT-REC         PICTURE X(13)  VALUE "AFTER RECORDS". 
           03  KW-AFT-REC-LEN     PICTURE 99     VALUE 13.
           03  KW-AREA            PICTURE X(7)   VALUE "AREA IS". 
           03  KW-AREA-LEN        PICTURE 99     VALUE 7. 
           03  KW-BEF-BLK         PICTURE X(13)  VALUE "BEFORE BLOCKS". 
           03  KW-BEF-BLK-LEN     PICTURE 99     VALUE 13.
           03  KW-BEF-REC         PICTURE X(14)  VALUE "BEFORE RECORDS".
           03  KW-BEF-REC-LEN     PICTURE 99     VALUE 14.
           03  KW-CHARGE          PICTURE X(9)   VALUE "CHARGE IS". 
           03  KW-CHARGE-LEN      PICTURE 99     VALUE 9. 
           03  KW-DENS            PICTURE X(10)  VALUE "DENSITY IS".
           03  KW-DENS-LEN        PICTURE 99     VALUE 10.
           03  KW-DEVICE          PICTURE X(14)  VALUE "DEVICE TYPE IS".
           03  KW-DEVICE-LEN      PICTURE 99     VALUE 14.
           03  KW-FAMILY          PICTURE X(14)  VALUE "FAMILY NAME IS".
           03  KW-FAMILY-LEN      PICTURE 99     VALUE 14.
           03  KW-FILE            PICTURE X(12)  VALUE "FILE NAME IS".
           03  KW-FILE-LEN        PICTURE 99     VALUE 12.
           03  KW-INDEX           PICTURE X(19)  VALUE
                                  "INDEX FILE ASSIGNED".
           03  KW-INDEX-LEN       PICTURE 99     VALUE 19.
           03  KW-JOB             PICTURE X(23)  VALUE
                                  "JOB CONTROL INFORMATION".
           03  KW-JOB-LEN         PICTURE 99     VALUE 23.
           03  KW-JOURNAL         PICTURE X(16)  VALUE
                                  "JOURNAL LOG FILE". 
           03  KW-JOURNAL-LEN     PICTURE 99     VALUE 16.
           03  KW-LOG             PICTURE X(3)   VALUE "LOG". 
           03  KW-LOG-LEN         PICTURE 99     VALUE 3. 
           03  KW-MASTER          PICTURE X(6)   VALUE "MASTER".
           03  KW-MASTER-LEN      PICTURE 99     VALUE 6. 
           03  KW-OF              PICTURE X(2)   VALUE "OF".
           03  KW-OF-LEN          PICTURE 99     VALUE 2. 
           03  KW-PACK            PICTURE X(12)  VALUE "PACK NAME IS".
           03  KW-PACK-LEN        PICTURE 99     VALUE 12.
           03  KW-PFN             PICTURE X(6)   VALUE "PFN IS".
           03  KW-PFN-LEN         PICTURE 99     VALUE 6. 
           03  KW-PROC-LIB        PICTURE X(17)  VALUE
                                  "PROCEDURE LIBRARY".
           03  KW-PROC-LIB-LEN    PICTURE 99     VALUE 17.
           03  KW-PW              PICTURE X(5)   VALUE "PW IS". 
           03  KW-PW-LEN          PICTURE 99     VALUE 5. 
           03  KW-QUICK           PICTURE X(19)  VALUE
                                  "QUICK RECOVERY FILE".
           03  KW-QUICK-LEN       PICTURE 99     VALUE 19.
           03  KW-RESTART         PICTURE X(23)  VALUE
                                  "RESTART IDENTIFIER FILE".
           03  KW-RESTART-LEN     PICTURE 99     VALUE 23.
           03  KW-SAME            PICTURE X(15)  VALUE
                                  "SAME AS MASTER.".
           03  KW-SAME-LEN        PICTURE 99     VALUE 15.
           03  KW-SCHEMA          PICTURE X(9)   VALUE "SCHEMA IS". 
           03  KW-SCHEMA-LEN      PICTURE 99     VALUE 9. 
           03  KW-SET             PICTURE X(11)  VALUE "SET NAME IS". 
           03  KW-SET-LEN         PICTURE 99     VALUE 11.
           03  KW-SUBSCH          PICTURE X(12)  VALUE "SUBSCHEMA IS".
           03  KW-SUBSCH-LEN      PICTURE 99     VALUE 12.
           03  KW-TAPE            PICTURE X(4)   VALUE "TAPE".
           03  KW-TAPE-LEN        PICTURE 99     VALUE 4. 
           03  KW-TRANSAC         PICTURE X(25)  VALUE
                                  "TRANSACTION RECOVERY FILE".
           03  KW-TRANSAC-LEN     PICTURE 99     VALUE 25.
           03  KW-TYPE            PICTURE X(7)   VALUE "TYPE IS". 
           03  KW-TYPE-LEN        PICTURE 99     VALUE 7. 
           03  KW-UN              PICTURE X(5)   VALUE "UN IS". 
           03  KW-UN-LEN          PICTURE 99     VALUE 5. 
           03  KW-UNIT            PICTURE X(13)  VALUE "UNIT LIMIT IS". 
           03  KW-UNIT-LEN        PICTURE 99     VALUE 13.
           03  KW-UPDATE          PICTURE X(15)  VALUE
                                  "UPDATE LIMIT IS".
           03  KW-UPDATE-LEN      PICTURE 99     VALUE 15.
           03  KW-VERSION         PICTURE X(10)  VALUE "VERSION IS".
           03  KW-VERSION-LEN     PICTURE 99     VALUE 10.
           03  KW-VSN             PICTURE X(6)   VALUE "VSN IS".
           03  KW-VSN-LEN         PICTURE 99     VALUE 6. 
*CALL DATAIO
*CALL DATADD
*CALL DATSAV1 
*CALL DATSAV3 
*CALL DATSAV4 
*CALL DATCON1 
*CALL DATCONMD
  
*CALL MAST1WS 
  
*CALL TESTWACOM 
  
*CALL DCDWA20 
  
*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 SCHEMA-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 MASTER-SIZE TO BLK-SIZE.
           MOVE ZERO TO GRP-TYPE. 
           MOVE ZERO TO SIZE-CODE.
  
      * THE MASTER DIRECTORY DOES NOT ALLOW COMMENTS AT ALL.
           MOVE "Y" TO SKIP-COMMENTS. 
  
      ******************************************************************
      * THIS SECTION OF PROCEDURES ACCESSES PRIMARILY THE SCHEMA ENTITY 
      ******************************************************************
  
  
      ******************************************************************
      * 
      * SCHEMA SUBENTRY.
  
       100-SCHEMA-SUBENTRY. 
  
      * START SCHEMA SUBENTRY WITH KEYWORD "SCHEMA" ON A NEW LINE.
           MOVE KW-SCHEMA TO OUT-FIELD. 
           MOVE KW-SCHEMA-LEN TO OUT-LEN. 
           PERFORM START-STMT THRU STMT-XIT.
  
      * 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 150-NORMAL-TERMINATION 
           END-IF 
  
      * MOVE NAMES CATEGORY OF SCHEMA ENTRY INTO "CAT-WORK".
           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-SCH-DMS = SPACES 
           THEN 
             MOVE SCHEMA-CATNAME (1 : 30) TO OUT-FIELD
           ELSE 
             MOVE NAME-SCH-DMS (1 : 30) TO OUT-FIELD
           END-IF 
  
      * SAVE FIRST SEVEN CHARACTERS OF NAME IN CASE NEEDED FOR LFN. 
           MOVE OUT-FIELD (1 : 7) TO SCHEMA-LFN.
  
      * FIND LENGTH OF SCHEMA-NAME AND MOVE IT TO STATEMENT.
           PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT.
           PERFORM ADD-TO-STMT THRU STMT-XIT. 
  
           ADD INDENT-INC TO INDENT.
  
      * MOVE SCHEMA'S LINETYPE "L" MDINFO LINE INTO "CAT-WORK". 
           MOVE CAT-NO-MDI TO DATA-ENTRY-CAT. 
           MOVE "L" TO DATA-ENTRY-LINETYPE. 
           PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT.
           MOVE SPACE TO DATA-ENTRY-LINETYPE. 
  
      * CREATE THE FILE CLAUSE USING THE "SCHLFN" FIELD FROM MDINFO IF
      * GIVEN, OTHERWISE USE FIRST SEVEN CHAR'S OF SCHEMA'S DMSNAME.
           IF DATA-RETURN-CODE = ZERO 
             AND MD-SCH-SCHLFN NOT = SPACES 
           THEN 
             MOVE MD-SCH-SCHLFN TO SCHEMA-LFN 
           END-IF 
  
      * START FILE CLAUSE ON NEW LINE.
           MOVE KW-FILE TO OUT-FIELD. 
           MOVE KW-FILE-LEN TO OUT-LEN. 
           PERFORM START-STMT THRU STMT-XIT.
  
           MOVE SCHEMA-LFN TO OUT-FIELD.
           PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT.
           PERFORM ADD-TO-STMT THRU STMT-XIT. 
  
      * LOOP THROUGH ALL MDINFO LINES, GENERATING ANY OPTIONAL CLAUSES
      * GIVEN.
           PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT.
           PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT.
           PERFORM UNTIL DATA-RETURN-CODE NOT = ZERO
  
      * PROCEDURE LIBRARY.
             IF CAT-LINE-TYPE = "P" 
               AND MD-SCH-PROCLIB NOT = SPACES
             THEN 
               MOVE KW-PROC-LIB TO OUT-FIELD
               MOVE KW-PROC-LIB-LEN TO OUT-LEN
               PERFORM START-STMT THRU STMT-XIT 
  
               MOVE MD-SCH-PROCLIB TO FILE-CATNAME
               MOVE CAT-LINE-TYPE TO FILE-TYPE
               PERFORM PERM-FILE-INFO THRU PERM-FILE-INFO-XIT 
             END-IF 
  
      * TRANSACTION RECOVERY FILE.
             IF CAT-LINE-TYPE = "T" 
               AND MD-SCH-TRANFILE NOT = SPACES 
             THEN 
               MOVE KW-TRANSAC TO OUT-FIELD 
               MOVE KW-TRANSAC-LEN TO OUT-LEN 
               PERFORM START-STMT THRU STMT-XIT 
  
               MOVE MD-SCH-TRANFILE TO FILE-CATNAME 
               MOVE CAT-LINE-TYPE TO FILE-TYPE
               PERFORM PERM-FILE-INFO THRU PERM-FILE-INFO-XIT 
             END-IF 
  
      * RESTART IDENTIFIER FILE.
             IF CAT-LINE-TYPE = "R" 
               AND MD-SCH-RESTART NOT = SPACES
             THEN 
               MOVE KW-RESTART TO OUT-FIELD 
               MOVE KW-RESTART-LEN TO OUT-LEN 
               PERFORM START-STMT THRU STMT-XIT 
  
               MOVE MD-SCH-RESTART TO FILE-CATNAME
               MOVE CAT-LINE-TYPE TO FILE-TYPE
               PERFORM PERM-FILE-INFO THRU PERM-FILE-INFO-XIT 
             END-IF 
  
      * JOURNAL LOG FILE. 
             IF CAT-LINE-TYPE = "J" 
               AND MD-SCH-JLOG NOT = SPACES 
             THEN 
               MOVE KW-JOURNAL TO OUT-FIELD 
               MOVE KW-JOURNAL-LEN TO OUT-LEN 
               PERFORM START-STMT THRU STMT-XIT 
  
               MOVE MD-SCH-JLOG TO FILE-CATNAME 
               MOVE "L" TO FILE-TYPE
               PERFORM PERM-FILE-INFO THRU PERM-FILE-INFO-XIT 
             END-IF 
  
      * QUICK RECOVERY FILE.
             IF CAT-LINE-TYPE = "Q" 
               AND MD-SCH-QR-FILE NOT = SPACES
             THEN 
               MOVE KW-QUICK TO OUT-FIELD 
               MOVE KW-QUICK-LEN TO OUT-LEN 
               PERFORM START-STMT THRU STMT-XIT 
  
               MOVE MD-SCH-QR-FILE TO FILE-CATNAME
               MOVE CAT-LINE-TYPE TO FILE-TYPE
               PERFORM PERM-FILE-INFO THRU PERM-FILE-INFO-XIT 
             END-IF 
  
      * MOVE NEXT MDINFO LINE INTO "CAT-WORK".
             PERFORM MOVE-NEXT-LINE THRU MOVE-NEXT-LINE-XIT 
             PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT 
           END-PERFORM
  
       110-END-SCH-MDINFO.
  
      * IF THE SCHEMA HAS A JOBCONTROL CATEGORY, GENERATE A JOB CONTROL 
      * INFORMATION CLAUSE. 
           MOVE CAT-NO-JOB TO DATA-ENTRY-CAT. 
           PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT.
           PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT.
           PERFORM CON-SCH-JOB THRU CON-SCH-JOB-XIT.
  
           IF CONSOLID-LINE = SPACES
           THEN 
             GO TO 120-END-SCH-SUBENTRY 
           END-IF 
  
      * START CLAUSE WITH ITS TITLE.
           MOVE KW-JOB TO OUT-FIELD 
           MOVE KW-JOB-LEN TO OUT-LEN 
           PERFORM START-STMT THRU STMT-XIT 
           ADD INDENT-INC TO INDENT 
  
      * GENERATE A TAPE PHRASE IF TAPE TYPE AND/OR DENSITY GIVEN. 
           IF SCH-JOB-TTYPE NOT = SPACES
             OR SCH-JOB-DENSITY NOT = SPACES
           THEN 
             MOVE KW-TAPE TO OUT-FIELD
             MOVE KW-TAPE-LEN TO OUT-LEN
             PERFORM START-STMT THRU STMT-XIT 
  
             IF SCH-JOB-TTYPE NOT = SPACES
             THEN 
               MOVE KW-TYPE TO OUT-FIELD
               MOVE SCH-JOB-TTYPE TO OUT-FIELD (KW-TYPE-LEN + 2 : 2)
               ADD KW-TYPE-LEN, 3 GIVING OUT-LEN
               PERFORM ADD-TO-STMT THRU STMT-XIT
             END-IF 
  
             IF SCH-JOB-DENSITY NOT = SPACES
             THEN 
               MOVE KW-DENS TO OUT-FIELD
               MOVE SCH-JOB-DENSITY TO OUT-FIELD (KW-DENS-LEN + 2 : 2)
               ADD KW-DENS-LEN, 3 GIVING OUT-LEN
               PERFORM ADD-TO-STMT THRU STMT-XIT
             END-IF 
           END-IF 
  
      * USER NUMBER PHRASE. 
           IF SCH-JOB-UN NOT = SPACES 
           THEN 
             MOVE KW-UN TO OUT-FIELD
             MOVE KW-UN-LEN TO OUT-LEN
             PERFORM START-STMT THRU STMT-XIT 
  
             MOVE SCH-JOB-UN TO OUT-FIELD 
             PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT 
             MOVE "Y" TO OUT-QUOTE
             PERFORM ADD-TO-STMT THRU STMT-XIT
           END-IF 
  
      * PASSWORD PHRASE.
           IF SCH-JOB-PW NOT = SPACES 
           THEN 
             MOVE KW-PW TO OUT-FIELD
             MOVE KW-PW-LEN TO OUT-LEN
             PERFORM START-STMT THRU STMT-XIT 
  
             MOVE SCH-JOB-PW TO OUT-FIELD 
             PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT 
             MOVE "Y" TO OUT-QUOTE
             PERFORM ADD-TO-STMT THRU STMT-XIT
           END-IF 
  
      * FAMILY NAME PHRASE. 
           IF SCH-JOB-FAMILY NOT = SPACES 
           THEN 
             MOVE KW-FAMILY TO OUT-FIELD
             MOVE KW-FAMILY-LEN TO OUT-LEN
             PERFORM START-STMT THRU STMT-XIT 
  
             MOVE SCH-JOB-FAMILY TO OUT-FIELD 
             PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT 
             PERFORM ADD-TO-STMT THRU STMT-XIT
           END-IF 
  
      * ACCOUNT PHRASE. 
           IF SCH-JOB-ACCOUNT NOT = SPACES
           THEN 
             MOVE KW-ACCOUNT TO OUT-FIELD 
             MOVE KW-ACCOUNT-LEN TO OUT-LEN 
             PERFORM START-STMT THRU STMT-XIT 
  
             MOVE SCH-JOB-ACCOUNT TO OUT-FIELD
             PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT 
             MOVE "Y" TO OUT-QUOTE
             PERFORM ADD-TO-STMT THRU STMT-XIT
           END-IF 
  
      * CHARGE PHRASE.
           IF SCH-JOB-CHARGE NOT = SPACES 
           THEN 
             MOVE KW-CHARGE TO OUT-FIELD
             MOVE KW-CHARGE-LEN TO OUT-LEN
             PERFORM START-STMT THRU STMT-XIT 
  
             MOVE SCH-JOB-CHARGE TO OUT-FIELD 
             PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT 
             MOVE "Y" TO OUT-QUOTE
             PERFORM ADD-TO-STMT THRU STMT-XIT
           END-IF 
  
       120-END-SCH-SUBENTRY.
  
      * END SCHEMA SUBENTRY WITH A PERIOD.
           MOVE "." TO DMS-LINE (COLUMN-OUT - 1 : 1). 
           MOVE INDENT-INIT TO INDENT.
  
  
      ******************************************************************
      * 
      * MASTER VERSION SUBENTRY.
  
      * 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.
           PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT.
  
      * IF SCHEMA HAS NO STRUCTURE, DIAGNOSE AND GIVE UP. 
           IF DATA-RETURN-CODE NOT = ZERO 
           THEN 
             MOVE IDX-600 TO MSG-IDX
             PERFORM ERROR-TYPE1 THRU ERROR-TYPE1-XIT 
             GO TO 150-NORMAL-TERMINATION 
           END-IF 
  
      * START THE MASTER VERSION SUBENTRY WITH A BLANK LINE FOLLOWED BY 
      * ITS TITLE.
           MOVE ZERO TO OUT-LEN.
           PERFORM START-STMT THRU STMT-XIT.
  
           MOVE KW-VERSION TO OUT-FIELD.
           MOVE KW-VERSION-LEN TO OUT-LEN.
           PERFORM START-STMT THRU STMT-XIT.
  
           MOVE KW-MASTER TO OUT-FIELD. 
           MOVE KW-MASTER-LEN TO OUT-LEN. 
           PERFORM ADD-TO-STMT THRU STMT-XIT. 
  
      * INITIALIZE FOR MASTER AREA CATNAME CHECK. 
           ENTER "CMMAGR" USING GRP-TYPE, GRP-ID. 
           MOVE ZERO TO MASTER-FWA. 
           MOVE 1 TO MASTER-IDX.
           MOVE "N" TO FOUND-MASTER.
  
      * FOR EACH INCLUDED AREA IN THE MASTER VERSION, GENERATE AN AREA
      * SUBENTRY. 
           PERFORM UNTIL DATA-RETURN-CODE NOT = ZERO
             PERFORM CON-SCH-STC THRU CON-SCH-STC-XIT 
  
             IF SCH-STC-CNAME NOT = SPACES
               AND SCH-STC-INCL NOT = "N" 
               AND SCH-STC-CTYPE = "A"
             THEN 
  
      * ALL OF THE MASTER AREAS MUST COME BEFORE THE FIRST ALTERNATE
      * VERSION AREA. 
               IF SCH-STC-AVERS = SPACES OR "MASTER"
               THEN 
                 MOVE "Y" TO FOUND-MASTER 
                 MOVE SCH-STC-CNAME TO AREA-CATNAME 
                 PERFORM SAVE-MASTER-AREAS THRU SAVE-MASTER-AREAS-XIT 
                 PERFORM AREA-SUBENTRY THRU AREA-SUBENTRY-XIT 
  
      * FIRST ALTERNATE VERSION FOUND -- GO PROCESS THEM. 
               ELSE 
                 IF FOUND-MASTER = "Y"
                 THEN 
                   GO TO 130-ALTERNATE-VERSION
  
      * ERROR IF ALTERNATE VERSION FOUND BEFORE MASTER. 
                 ELSE 
                   MOVE IDX-730 TO MSG-IDX
                   MOVE SCH-STC-AVERS TO MSG-NAME 
                   PERFORM ERROR-TYPE2 THRU ERROR-TYPE2-XIT 
                 END-IF 
               END-IF 
             END-IF 
           END-PERFORM
  
  
      ******************************************************************
      * 
      * ALTERNATE VERSION SUBENTRY. 
  
       130-ALTERNATE-VERSION. 
  
      * FLUSH MASTER AREA CATNAME BUFFER IF NEEDED. 
           IF MASTER-IDX NOT = 1
           THEN 
             MOVE 99 TO MASTER-IDX
             PERFORM SAVE-MASTER-AREAS THRU SAVE-MASTER-AREAS-XIT 
           END-IF 
  
      * LOOP THROUGH REMAINING STRUCTURE LINES TO GENERATE AREA 
      * SUBENTRIES FOR ALL AREAS IN ALTERNATE VERSIONS. 
           MOVE SPACES TO PREVIOUS-VERSION. 
           PERFORM UNTIL SCH-STC-CNAME = SPACES 
             IF SCH-STC-INCL NOT = "N"
               AND SCH-STC-CTYPE = "A"
             THEN 
  
      * ERROR IF MASTER AREA OCCURS AFTER FIRST ALTERNATE VERSION AREA. 
               IF SCH-STC-AVERS = SPACES OR "MASTER"
               THEN 
                 MOVE IDX-730 TO MSG-IDX
                 MOVE KW-MASTER TO MSG-NAME 
                 PERFORM ERROR-TYPE2 THRU ERROR-TYPE2-XIT 
  
               ELSE 
  
      * IF THIS IS A NEW VERSION NAME, START A NEW ALTERNATE VERSION
      * SUBENTRY. 
                 IF SCH-STC-AVERS NOT = PREVIOUS-VERSION
                 THEN 
                   MOVE SCH-STC-AVERS TO PREVIOUS-VERSION 
                   MOVE ZERO TO OUT-LEN 
                   PERFORM START-STMT THRU STMT-XIT 
  
                   MOVE KW-VERSION TO OUT-FIELD 
                   MOVE KW-VERSION-LEN TO OUT-LEN 
                   PERFORM START-STMT THRU STMT-XIT 
  
                   MOVE SCH-STC-AVERS TO OUT-FIELD
                   PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT 
                   PERFORM ADD-TO-STMT THRU STMT-XIT
                 END-IF 
  
      * CHECK AREA'S CATNAME AGAINST MASTER AREA CATNAMES FOR A MATCH.
                 MOVE "Y" TO FOUND-VERSION
                 MOVE SCH-STC-CNAME TO AREA-CATNAME 
                 PERFORM CHECK-MASTER-AREAS THRU CHECK-MASTER-AREAS-XIT 
  
      * IF CATNAME NOT SAME AS ANY MASTER, LOOK FOR MDINFO CATEGORY TO
      * GENERATE AREA'S SUBENTRY. 
                 IF FOUND-VERSION = "Y" 
                 THEN 
                   PERFORM AREA-SUBENTRY THRU AREA-SUBENTRY-XIT 
                 END-IF 
  
      * IF AREA'S CATNAME MATCHED THAT OF A MASTER AREA OR IT HAD NO
      * MDINFO CATEGORY, IT IS THE SAME AS THE MASTER.
                 IF FOUND-VERSION = "N" 
                 THEN 
                   ADD INDENT-INC TO INDENT 
                   MOVE KW-AREA TO OUT-FIELD
                   MOVE KW-AREA-LEN TO OUT-LEN
                   PERFORM START-STMT THRU STMT-XIT 
  
                   PERFORM SAVE-SCH-INFO THRU SAVE-SCH-INFO-XIT 
                   PERFORM ADD-AREA-NAME THRU ADD-AREA-NAME-XIT 
                   PERFORM RESTORE-SCH-INFO THRU RESTORE-SCH-INFO-XIT 
  
                   MOVE KW-SAME TO OUT-FIELD
                   MOVE KW-SAME-LEN TO OUT-LEN
                   PERFORM ADD-TO-STMT THRU STMT-XIT
                   SUBTRACT INDENT-INC FROM INDENT
                 END-IF 
               END-IF 
             END-IF 
  
      * CONSOLIDATE NEXT STRUCTURE LINE IF NEEDED.
             PERFORM CON-SCH-STC THRU CON-SCH-STC-XIT 
           END-PERFORM
  
      * GET RID OF MASTER AREA CATNAME LIST.
           ENTER "CMMFGR" USING GRP-ID. 
  
  
      ******************************************************************
      * 
      * SUBSCHEMA SUBENTRY. 
  
       140-SUBSCHEMA-SUBENTRY.
  
      * MOVE SCHEMA'S FIRST STRUCTURE LINE BACK INTO "CAT-WORK" ONE MORE
      * TIME, THIS TIME TO LOOK FOR INCLUDED SUBSCHEMAS.
           PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT.
           PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT.
  
      * LOOP THROUGH SCHEMA'S STRUCTURE LINES, GENERATING A SUBSCHEMA 
      * SUBENTRY FOR EACH INCLUDED SUBSCHEMA. 
           PERFORM UNTIL DATA-RETURN-CODE NOT = ZERO
             PERFORM CON-SCH-STC THRU CON-SCH-STC-XIT 
  
             IF SCH-STC-CNAME NOT = SPACES
               AND SCH-STC-INCL NOT = "N" 
               AND SCH-STC-CTYPE = "S"
             THEN 
               MOVE SCH-STC-CNAME TO SUBSCH-CATNAME 
               PERFORM SUBSCH-SUBENTRY THRU SUBSCH-SUBENTRY-XIT 
             END-IF 
           END-PERFORM
  
  
      ******************************************************************
      * 
      * TIME FOR NORMAL TERMINATION.
      * SET FLAG TO TELL "DMS300" THAT AND EXIT.
  
       150-NORMAL-TERMINATION.
           PERFORM OUTPUT-DMS THRU OUTPUT-DMS-XIT.
           MOVE REQ-TERMINATE TO GTBL-REQ.
           EXIT PROGRAM.
      /*****************************************************************
      ******************************************************************
      * 
      * PERMANENT FILE INFORMATION SUBENTRY.
      * 
      * INPUT:   FILE-CATNAME     - CATNAME OF FILE FOR WHICH PERM-FILE-
      *                             INFO SUBENTRY TO BE GENERATED 
      *          FILE-TYPE        - TYPE OF FILE EXPECTED 
  
       PERM-FILE-INFO.
           PERFORM SAVE-ALT-INFO THRU SAVE-ALT-INFO-XIT.
           PERFORM CLEAR-DATA-ENTRY THRU CLEAR-DATA-ENTRY-XIT.
           ADD INDENT-INC TO INDENT.
  
      * READ FIRST RECORD OF FILE ENTRY INTO "DATA-RECORD". 
           MOVE FILE-CATNAME TO DATA-ENTRY-NAME.
           PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT.
  
      * IF ENTRY FOR FILE 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 END-PERM-FILE-INFO 
           END-IF 
  
      * MOVE THE FILE'S MDINFO CATEGORY INTO "CAT-WORK" AND CONSOLIDATE 
      * IF NEEDED.
           MOVE CAT-NO-MDI TO DATA-ENTRY-CAT. 
           PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT.
           PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT.
           PERFORM CON-FILE-MDI THRU CON-FILE-MDI-XIT.
  
      * ERROR IF FILE'S TYPE DOES NOT MATCH THAT EXPECTED.
           IF AF-MD-TYPE NOT = FILE-TYPE
           THEN 
             MOVE IDX-735 TO MSG-IDX
             MOVE FILE-CATNAME TO MSG-NAME
             PERFORM ERROR-TYPE2 THRU ERROR-TYPE2-XIT 
             GO TO END-PERM-FILE-INFO 
           END-IF 
  
      * MOVE THE FILE'S UNIT CATEGORY INTO "CAT-WORK" AND CONSOLIDATE 
      * WITH MDINFO INFORMATION.
           MOVE CAT-NO-UNIT TO DATA-ENTRY-CAT.
           PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT.
           PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT.
           PERFORM CON-FILE-UNIT THRU CON-FILE-UNIT-XIT.
  
      * START THE "PFN" CLAUSE. 
           MOVE KW-PFN TO OUT-FIELD.
           MOVE KW-PFN-LEN TO OUT-LEN.
           PERFORM START-STMT THRU STMT-XIT.
  
      * MOVE NAMES CATEGORY OF FILE ENTRY INTO "CAT-WORK".
           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 FIRST SEVEN CHAR'S OF THE CATNAME.
           IF DATA-RETURN-CODE NOT = ZERO 
             OR NAME-FILE-DMS = SPACES
           THEN 
             MOVE FILE-CATNAME (1 : 7) TO OUT-FIELD 
           ELSE 
             MOVE NAME-FILE-DMS (1 : 7) TO OUT-FIELD
           END-IF 
  
      * FIND LENGTH OF FILE-NAME AND MOVE IT TO STATEMENT.
           IF FILE-TYPE = "L" OR "T"
           THEN 
             MOVE 6 TO OUT-LEN
           ELSE 
             PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT 
           END-IF 
           MOVE "Y" TO OUT-QUOTE. 
           PERFORM ADD-TO-STMT THRU STMT-XIT. 
  
      * ADD THE FILE-INFO CLAUSES WHICH PERM-FILES HAVE IN COMMON WITH
      * AREAS.
           PERFORM FILE-INFO THRU FILE-INFO-XIT.
  
      * IF A TRANSACTION RECOVERY FILE, ALSO GENERATE ITS UNIT AND
      * UPDATE LIMITS IF GIVEN. 
           IF AF-MD-TYPE = "T"
           THEN 
  
      * UNIT LIMIT. 
             IF AF-MD-UNLMT NOT = SPACES
             THEN 
               MOVE KW-UNIT TO OUT-FIELD
               MOVE KW-UNIT-LEN TO OUT-LEN
               PERFORM START-STMT THRU STMT-XIT 
  
               MOVE AF-MD-UNLMT TO OUT-FIELD
               PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT 
               PERFORM ADD-TO-STMT THRU STMT-XIT
             END-IF 
  
      * UPDATE LIMIT. 
             IF AF-MD-UPLMT NOT = SPACES
             THEN 
               MOVE KW-UPDATE TO OUT-FIELD
               MOVE KW-UPDATE-LEN TO OUT-LEN
               PERFORM START-STMT THRU STMT-XIT 
  
               MOVE AF-MD-UPLMT TO OUT-FIELD
               PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT 
               PERFORM ADD-TO-STMT THRU STMT-XIT
             END-IF 
           END-IF 
  
       END-PERM-FILE-INFO.
           PERFORM RESTORE-ALT-INFO THRU RESTORE-ALT-INFO-XIT.
           SUBTRACT INDENT-INC FROM INDENT. 
  
       PERM-FILE-INFO-XIT.
           EXIT.
  
  
  
      ******************************************************************
      * 
      * FILE INFO CLAUSES.
      * 
      * ADD THE FILE INFO CLAUSES THAT THE AREA SUBENTRY AND THE PERM 
      * FILE INFO SUBENTRY HAVE IN COMMON.
      * 
      * INPUT:   CONSOLID-LINE    - AREA/FILE MDINFO
  
       FILE-INFO. 
  
      * ADD THE USER NUMBER.
           MOVE KW-UN TO OUT-FIELD. 
           MOVE KW-UN-LEN TO OUT-LEN. 
           PERFORM START-STMT THRU STMT-XIT.
  
           MOVE AF-MD-UN TO OUT-FIELD.
           PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT.
           MOVE "Y" TO OUT-QUOTE. 
           PERFORM ADD-TO-STMT THRU STMT-XIT. 
  
      * THE REST OF THE CLAUSES ARE OPTIONAL -- ADD ONLY IF GIVEN.
  
      * PASSWORD. 
           IF AF-MD-PW NOT = SPACES 
           THEN 
             MOVE KW-PW TO OUT-FIELD
             MOVE KW-PW-LEN TO OUT-LEN
             PERFORM START-STMT THRU STMT-XIT 
  
             MOVE AF-MD-PW TO OUT-FIELD 
             PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT 
             MOVE "Y" TO OUT-QUOTE
             PERFORM ADD-TO-STMT THRU STMT-XIT
           END-IF 
  
      * FAMILY NAME.
           IF AF-MD-FAMILY NOT = SPACES 
           THEN 
             MOVE KW-FAMILY TO OUT-FIELD
             MOVE KW-FAMILY-LEN TO OUT-LEN
             PERFORM START-STMT THRU STMT-XIT 
  
             MOVE AF-MD-FAMILY TO OUT-FIELD 
             PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT 
             PERFORM ADD-TO-STMT THRU STMT-XIT
           END-IF 
  
      * PACK NAME.
           IF AF-MD-PACK NOT = SPACES 
           THEN 
             MOVE KW-PACK TO OUT-FIELD
             MOVE KW-PACK-LEN TO OUT-LEN
             PERFORM START-STMT THRU STMT-XIT 
  
             MOVE AF-MD-PACK TO OUT-FIELD 
             PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT 
             PERFORM ADD-TO-STMT THRU STMT-XIT
           END-IF 
  
      * SET NAME. 
           IF AF-MD-SET NOT = SPACES
           THEN 
             MOVE KW-SET TO OUT-FIELD 
             MOVE KW-SET-LEN TO OUT-LEN 
             PERFORM START-STMT THRU STMT-XIT 
  
             MOVE AF-MD-SET TO OUT-FIELD
             PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT 
             PERFORM ADD-TO-STMT THRU STMT-XIT
           END-IF 
  
      * VOLUME SERIAL NUMBER. 
           IF AF-MD-VSN NOT = SPACES
           THEN 
             MOVE KW-VSN TO OUT-FIELD 
             MOVE KW-VSN-LEN TO OUT-LEN 
             PERFORM START-STMT THRU STMT-XIT 
  
             MOVE AF-MD-VSN TO OUT-FIELD
             PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT 
             MOVE "Y" TO OUT-QUOTE
             PERFORM ADD-TO-STMT THRU STMT-XIT
           END-IF 
  
      * DEVICE TYPE.
           IF AF-MD-DEVICE NOT = SPACES 
           THEN 
             MOVE KW-DEVICE TO OUT-FIELD
             MOVE KW-DEVICE-LEN TO OUT-LEN
             PERFORM START-STMT THRU STMT-XIT 
  
             MOVE AF-MD-DEVICE TO OUT-FIELD 
             PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT 
             PERFORM ADD-TO-STMT THRU STMT-XIT
           END-IF 
  
       FILE-INFO-XIT. 
           EXIT.
      /*****************************************************************
      ******************************************************************
      * 
      * AREA SUBENTRY.
      * 
      * INPUT:   AREA-CATNAME     - CATNAME OF GIVEN AREA 
      *          CONSOLID-LINE    - SCHEMA STRUCTURE
      *          CAT-WORK         - NEXT SCHEMA STRUCTURE 
      *          FOUND-VERSION    - DEFAULT VALUE OF "Y"
      * 
      * OUTPUT:  FOUND-VERSION    - "N" IF NO MDINFO CATEGORY FOUND 
  
       AREA-SUBENTRY. 
           PERFORM SAVE-SCH-INFO THRU SAVE-SCH-INFO-XIT.
           PERFORM CLEAR-DATA-ENTRY THRU CLEAR-DATA-ENTRY-XIT.
           ADD INDENT-INC TO INDENT.
  
      * READ FIRST RECORD OF AREA ENTRY INTO "DATA-RECORD". 
           MOVE AREA-CATNAME TO DATA-ENTRY-NAME.
           PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT.
  
      * IF ENTRY FOR AREA 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 END-AREA-SUBENTRY
           END-IF 
  
      * MOVE THE AREA'S MDINFO CATEGORY INTO "CAT-WORK" AND CONSOLIDATE 
      * IF NEEDED.
           MOVE CAT-NO-MDI TO DATA-ENTRY-CAT. 
           PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT.
           PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT.
           PERFORM CON-AREA-MDI THRU CON-AREA-MDI-XIT.
  
      * IF NO MDINFO, SET FLAG THAT SAME AS MASTER AND RETURN.
           IF CONSOLID-LINE = SPACES
           THEN 
             MOVE "N" TO FOUND-VERSION
             GO TO END-AREA-SUBENTRY
           END-IF 
  
      * START AREA SUBENTRY ON A NEW LINE AND ADD THE AREA'S DMSNAME. 
           MOVE KW-AREA TO OUT-FIELD. 
           MOVE KW-AREA-LEN TO OUT-LEN. 
           PERFORM START-STMT THRU STMT-XIT.
  
           PERFORM ADD-AREA-NAME THRU ADD-AREA-NAME-XIT.
           ADD INDENT-INC TO INDENT.
  
      * START THE "PFN" CLAUSE. 
           MOVE KW-PFN TO OUT-FIELD.
           MOVE KW-PFN-LEN TO OUT-LEN.
           PERFORM START-STMT THRU STMT-XIT.
  
      * IF NO AREA-PFN GIVEN, ASSUME FIRST SEVEN CHAR'S OF THE DMSNAME. 
           IF AF-MD-PFN = SPACES
           THEN 
             MOVE AREA-DNAME (1 : 7) TO OUT-FIELD 
           ELSE 
             MOVE AF-MD-PFN (1 : 7) TO OUT-FIELD
           END-IF 
  
      * FIND LENGTH OF AREA-PFN AND MOVE IT TO STATEMENT. 
           PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT.
           MOVE "Y" TO OUT-QUOTE. 
           PERFORM ADD-TO-STMT THRU STMT-XIT. 
  
      * ADD ALL THE OTHER FILE INFO CLAUSES THE AREA HAS IN COMMON WITH 
      * PERM-FILES. 
           PERFORM FILE-INFO THRU FILE-INFO-XIT.
  
      * IF A LOG OPTION IS SPECIFIED, ADD THE LOG CLAUSE. 
           IF AF-MD-LOG NOT = SPACES
           THEN 
             MOVE KW-LOG TO OUT-FIELD 
             MOVE KW-LOG-LEN TO OUT-LEN 
             PERFORM START-STMT THRU STMT-XIT 
  
      * PICK UP EACH LOG OPTION GIVEN AND ADD IT TO LINE. 
             PERFORM VARYING PICK-IDX FROM 1 BY 3 
               UNTIL PICK-IDX > 8 
  
               IF AF-MD-LOG (PICK-IDX : 2) = "BR" 
               THEN 
                 MOVE KW-BEF-REC TO OUT-FIELD 
                 MOVE KW-BEF-REC-LEN TO OUT-LEN 
                 PERFORM ADD-TO-STMT THRU STMT-XIT
               END-IF 
  
               IF AF-MD-LOG (PICK-IDX : 2) = "AR" 
               THEN 
                 MOVE KW-AFT-REC TO OUT-FIELD 
                 MOVE KW-AFT-REC-LEN TO OUT-LEN 
                 PERFORM ADD-TO-STMT THRU STMT-XIT
               END-IF 
  
               IF AF-MD-LOG (PICK-IDX : 2) = "BB" 
               THEN 
                 MOVE KW-BEF-BLK TO OUT-FIELD 
                 MOVE KW-BEF-BLK-LEN TO OUT-LEN 
                 PERFORM ADD-TO-STMT THRU STMT-XIT
               END-IF 
             END-PERFORM
           END-IF 
  
      * IF AN INDEX FILE IS GIVEN, GENERATE A PERM-FILE INFO CLAUSE 
      * FOR IT. 
           IF AF-MD-IDX NOT = SPACES
           THEN 
             MOVE KW-INDEX TO OUT-FIELD 
             MOVE KW-INDEX-LEN TO OUT-LEN 
             PERFORM START-STMT THRU STMT-XIT 
  
             MOVE AF-MD-IDX TO FILE-CATNAME 
             MOVE "I" TO FILE-TYPE
             PERFORM PERM-FILE-INFO THRU PERM-FILE-INFO-XIT 
           END-IF 
  
       END-AREA-SUBENTRY. 
           PERFORM RESTORE-SCH-INFO THRU RESTORE-SCH-INFO-XIT.
           MOVE INDENT-INIT TO INDENT.
           MOVE "." TO DMS-LINE (COLUMN-OUT - 1 : 1). 
  
       AREA-SUBENTRY-XIT. 
           EXIT.
      /*****************************************************************
      ******************************************************************
      * 
      * SUBSCHEMA SUBENTRY. 
      * 
      * INPUT:   SUBSCH-CATNAME   - CATNAME OF GIVEN SUBSCHEMA
      *          CONSOLID-LINE    - SCHEMA STRUCTURE
      *          CAT-WORK         - NEXT SCHEMA STRUCTURE 
  
       SUBSCH-SUBENTRY. 
           PERFORM SAVE-SCH-INFO THRU SAVE-SCH-INFO-XIT.
           PERFORM CLEAR-DATA-ENTRY THRU CLEAR-DATA-ENTRY-XIT.
  
      * READ FIRST RECORD OF SUBSCHEMA ENTRY INTO "DATA-RECORD".
           MOVE SUBSCH-CATNAME TO DATA-ENTRY-NAME.
           PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT.
  
      * IF SUBSCHEMA 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 END-SUBSCH-SUBENTRY
           END-IF 
  
      * START SUBSCHEMA SUBENTRY WITH A BLNAK LINE FOLLOWED BY THE
      * KEYWORD "SUBSCHEMA" ON A NEW LINE.
           MOVE ZERO TO OUT-LEN.
           PERFORM START-STMT THRU STMT-XIT.
  
           MOVE KW-SUBSCH TO OUT-FIELD. 
           MOVE KW-SUBSCH-LEN TO OUT-LEN. 
           PERFORM START-STMT THRU STMT-XIT.
  
      * 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.
           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 
  
      * SAVE FIRST SEVEN CHARACTERS OF NAME IN CASE NEEDED FOR LFN. 
           MOVE OUT-FIELD (1 : 7) TO SUBSCH-LFN.
  
      * FIND LENGTH OF SUBSCHEMA-NAME AND MOVE IT TO LINE.
           PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT.
           PERFORM ADD-TO-STMT THRU STMT-XIT. 
  
           ADD INDENT-INC TO INDENT.
  
      * MOVE SUBSCHEMA'S MDINFO LINE INTO "CAT-WORK". 
           MOVE CAT-NO-MDI TO DATA-ENTRY-CAT. 
           PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT.
  
      * CREATE THE FILE CLAUSE USING THE "SSLFN" FIELD FROM MDINFO IF 
      * GIVEN, OTHERWISE USE FIRST SEVEN CHAR'S OF SUBSCHEMA'S DMSNAME. 
           IF DATA-RETURN-CODE = ZERO 
             AND MD-SS-SSLFN NOT = SPACES 
           THEN 
             MOVE MD-SS-SSLFN TO SUBSCH-LFN 
           END-IF 
  
      * START FILE CLAUSE ON NEW LINE.
           MOVE KW-FILE TO OUT-FIELD. 
           MOVE KW-FILE-LEN TO OUT-LEN. 
           PERFORM START-STMT THRU STMT-XIT.
  
           MOVE SUBSCH-LFN TO OUT-FIELD.
           PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT.
           PERFORM ADD-TO-STMT THRU STMT-XIT. 
  
      * END SUBSCHEMA SUBENTRY WITH A PERIOD. 
           MOVE "." TO DMS-LINE (COLUMN-OUT - 1 : 1). 
           MOVE INDENT-INIT TO INDENT.
  
       END-SUBSCH-SUBENTRY. 
           PERFORM RESTORE-SCH-INFO THRU RESTORE-SCH-INFO-XIT.
  
       SUBSCH-SUBENTRY-XIT. 
           EXIT.
      /*****************************************************************
      * UTILITIES SPECIFIC TO MASTER DIRECTORY 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.
  
       OUTPUT-DMS.
  
      * 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.
  
           MOVE SPACES TO DMS-LINE. 
  
       OUTPUT-DMS-XIT.
           EXIT.
  
  
      ******************************************************************
      * 
      * OUTPUT-COMMENT. 
      * 
      * THE MASTER DIRECTORY DOES NOT ACCEPT COMMENTS, SO THIS ROUTINE
      * IS A NO-OP. 
  
       OUTPUT-COMMENT.
       OUTPUT-COMMENT-XIT.
           EXIT.
*CALL DMSVERS 
*CALL DMSIO 
*CALL DMSADD0 
*CALL DMSSAV1 
*CALL DMSSAV4 
*CALL DMSCON1 
*CALL DMSCONMD
  
