*DECK DCCONMDS
       IDENTIFICATION DIVISION. 
       PROGRAM-ID. CONMDS.
*CALL COPYRIGHT 
      *    THIS PROGRAM EXPLODES CDCS MASTER DIRECTORY SOURCE AS PART OF
      *    THE DATA CATALOGUE CONVERSION. 
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION. 
       SOURCE-COMPUTER. CYBER.
       OBJECT-COMPUTER. CYBER.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT SYSPRINT ASSIGN TO "OUTPUT".
           SELECT OPTIONAL MDS-FILE ASSIGN TO MDSOURC 
               USE "RT=Z".
           SELECT IS-FILE 
               ASSIGN TO ISFILE, XNISFIL
               ORGANIZATION IS INDEXED
               RECORD KEY IS IS-PKEY
               ALTERNATE RECORD KEY IS IS-ALTKEY
                   WITH DUPLICATES. 
       DATA DIVISION. 
       FILE SECTION.
       FD  MDS-FILE 
           LABEL RECORDS ARE OMITTED
           RECORD CONTAINS 80 CHARACTERS
           DATA RECORDS ARE MDS-IN. 
       01  MDS-IN.
           02  MDS-LINE                    PICTURE X OCCURS 73 TIMES. 
           02  MDS-ID                      PICTURE X(7).
*CALL SYSPRTFD
*CALL ISFILFD 
       COMMON-STORAGE SECTION.
       77  RETURN-CODE                     PICTURE XX.
*CALL CVTBL 
       01  PRINT-CTL-TBL. 
*CALL WKPRINT 
       01  WRKF-FUNCTION-CODE              PICTURE X. 
*CALL WRKFHDR 
*CALL WRKREDEF
       WORKING-STORAGE SECTION. 
       01  CDCS-NAME. 
           03  CDCS-NAME-CHAR              PICTURE X OCCURS 32 TIMES. 
       01  ERROR-MSG. 
           02  MSG-5                       PICTURE X(67) VALUE
           "DCCVT-05-S ERROR * KEYWORD *SCHEMA* MISSING. SEARCHING FOR *
      -    "SCHEMA*". 
           02  MSG-10                      PICTURE X(40) VALUE
           "DCCVT-10-W ERROR * ENDING PERIOD ASSUMED".
           02  MSG-25                      PICTURE X(51) VALUE
           "DCCVT-25-W ERROR * TOKEN TRUNCATED TO 30 CHARACTERS". 
           02  MSG-30                      PICTURE X(41) VALUE
           "DCCVT-30-S ERROR * SEARCHING FOR A PERIOD". 
           02  MSG-35                      PICTURE X(45) VALUE
           "DCCVT-35-S ERROR * PERIOD FOUND. SCAN RESUMES". 
           02  MSG-40.
               03  FILLER                  PICTURE X(28) VALUE
               "DCCVT-40-S ERROR * KEYWORD *".
               03  SKIPPED-TO-KEYWORD      PICTURE X(10). 
               03  FILLER                  PICTURE X(21) VALUE
               "* FOUND. SCAN RESUMES". 
           02  MSG-45.
               03  FILLER                  PICTURE X(36) VALUE
               "DCCVT-45-S ERROR * UNKNOWN KEYWORD *".
               03  UNKNOWN-KEYWORD         PICTURE X(10). 
               03  FILLER                  PICTURE X(30) VALUE
               "*. SEARCHING FOR KNOWN KEYWORD".
           02  MSG-55                      PICTURE X(39) VALUE
           "DCCVT-55-S ERROR * AREA-NAME UNKNOWN".
           02  MSG-165                     PICTURE X(65) VALUE
           "DCCVT-165-W ERROR * NONNUMERIC LITERAL TRUNCATED TO 30 CHARA
      -    "CTERS". 
           02  MSG-190                     PICTURE X(39) VALUE
           "DCCVT-190-S ERROR * UNKNOWN SCHEMA NAME". 
           02  MSG-310                     PICTURE X(45) VALUE
           "DCCVT-310-S ERROR * KEYWORD *FILE* MISSING".
           02  MSG-315                     PICTURE X(45) VALUE
           "DCCVT-315-S ERROR * KEYWORD *PFN* MISSING". 
           02  MSG-320. 
               03  FILLER                  PICTURE X(19) VALUE
               "DCCVT-320-S ERROR *". 
               03  UNQUOTED-NAME           PICTURE X(9).
               03  FILLER                  PICTURE X(28) VALUE
               "* MUST BE ENCLOSED IN QUOTES".
           02  MSG-325                     PICTURE X(45) VALUE
           "DCCVT-325-S ERROR * KEYWORD *MASTER* MISSING".
           02  MSG-330                     PICTURE X(60) VALUE
           "DCCVT-330-S ERROR * KEYWORD *RECORDS* OR *BLOCKS* MISSING". 
           02  MSG-335                     PICTURE X(45) VALUE
           "DCCVT-335-S ERROR * KEYWORD *RECORDS* MISSING". 
           02  MSG-340                     PICTURE X(52) VALUE
           "DCCVT-340-S ERROR * MORE THAN 3 BEFORE/AFTER PHRASES".
           02  MSG-345                     PICTURE X(45) VALUE
           "DCCVT-345-S ERROR * INVALID TAPE TYPE". 
           02  MSG-350                     PICTURE X(45) VALUE
           "DCCVT-350-S ERROR * INVALID TAPE DENSITY".
           02  MSG-355                     PICTURE X(45) VALUE
           "DCCVT-355-S ERROR * UNKNOWN SUBSCHEMA NAME".
           02  MSG-385. 
               03  FILLER                  PICTURE X(26) VALUE
               "DCCVT-385-S ERROR * FILE *".
               03  EMPTY-FILE-NAME         PICTURE X(7).
               03  FILLER                  PICTURE X(10) VALUE
               "* IS EMPTY".
       01  HEADING-LITS.
           03  CONV-MDS-TITLE          PICTURE X(50) VALUE
           " MASTER   DIRECTORY   SOURCE   CONVERSION   REPORT".
           03  END-REPORT-MSG             PICTURE X(51) VALUE 
           "***END MASTER DIRECTORY SOURCE CONVERSION REPORT***". 
       01  HOLD-AREA-PF.
           02  HOLD-AREA-UN                PICTURE X(7).
           02  HOLD-AREA-PW                PICTURE X(7).
           02  HOLD-AREA-FAMILY            PICTURE X(7).
           02  HOLD-AREA-PACK              PICTURE X(7).
           02  HOLD-AREA-SET               PICTURE X(7).
       01  HOLD-AREA-UNIT-RECORD. 
           02  HOLD-AREA-PVOLSER           PICTURE X(6).
           02  HOLD-AREA-PUNIT             PICTURE X(3).
       01  HOLD-IS-REC. 
           02  HOLD-IS-PKEY.
               03  HOLD-IS-CATNAME         PICTURE X(32). 
               03  HOLD-IS-ALIAS-NO        PICTURE 9(4).
               03  HOLD-IS-SEQ-NO          PICTURE 9(4).
           02  HOLD-IS-ALTKEY.
               03  HOLD-IS-ENTITY-TYPE     PICTURE XX.
               03  HOLD-IS-SCHEMA-ORDINAL  PICTURE 9999.
               03  HOLD-IS-CDCS-NAME       PICTURE X(30). 
       01  HOLD-PF. 
           02  HOLD-UN                     PICTURE X(7).
           02  HOLD-PW                     PICTURE X(7).
           02  HOLD-FAMILY                 PICTURE X(7).
           02  HOLD-PACK                   PICTURE X(7).
           02  HOLD-SET                    PICTURE X(7).
       01  HOLD-UNIT-RECORD.
           02  HOLD-PVOLSER                PICTURE X(6).
           02  HOLD-PUNIT                  PICTURE X(7).
       01  LINE1. 
           03  FILLER                      PICTURE X. 
           03  LINE1A                      PICTURE X(10). 
           03  FILLER                      PICTURE X(9).
           03  LINE1B                      PICTURE X(32). 
           03  FILLER                      PICTURE XX.
           03  LINE1C                      PICTURE X(80). 
       01  SEQNO-ARRAY. 
           02  SEQNO-ARRAY-COMP-1.
               03  SEQNO-COMP-1            PICTURE 9(4) COMP-1
                                           OCCURS 4 TIMES.
           02  SEQNO REDEFINES SEQNO-ARRAY-COMP-1.
               03  SEQNO-CHAR              PICTURE X OCCURS 40 TIMES. 
       01  SEQ-DIGIT-ARRAY. 
           02  SEQ-DIGIT-COMP-1            PICTURE 9(4) COMP-1
                                           VALUE IS 0.
           02  SEQ-DIGIT-CHAR-ARRAY REDEFINES SEQ-DIGIT-COMP-1. 
               03  SEQ-DIGIT               PICTURE X OCCURS 10 TIMES. 
       01  SKIP-UNTIL-TOKEN-ARRAY.
           02  SKIP-UNTIL-TOKEN            PICTURE X(10)
               OCCURS 1 TO 4 TIMES DEPENDING ON SKIP-UNTIL-TOKEN-COUNT. 
  
       01  WORK-AREA. 
           02  WORKA                       PICTURE X OCCURS 72 TIMES. 
       77  AREA-CATNAME                    PICTURE X(32). 
       77  AREA-LOG                        PICTURE X(8).
       77  AREA-NAME                       PICTURE X(30). 
       77  AREA-PF-NAME                    PICTURE X(7).
       77  CDCS-NAME-LEN-PLUS1             PICTURE 99.
       77  CHAR-COUNT                      PICTURE 99.
       77  CHAR-SUB                        PICTURE 99.
       77  END-SW                          PICTURE X. 
           88 EOF VALUE "E".
       77  END-LOOP                        PICTURE X. 
       77  FILE-CATNAME                    PICTURE X(32). 
       77  FILE-TYPE                       PICTURE XXX. 
       77  INDEX-CATNAME                   PICTURE X(32). 
       77  IN-SUB                          PICTURE 9999.
       77  LOG-PARAM                       PICTURE XX.
       77  LOG-SUB                         PICTURE 9. 
       77  MASTER-AREA-CATNAME             PICTURE X(32). 
       77  MASTER-INDEX-CATNAME            PICTURE X(32). 
       77  PF-NAME                         PICTURE X(7).
       77  SCHEMA-CATNAME                  PICTURE X(32). 
       77  SCHEMA-NAME                     PICTURE X(30). 
       77  SCHEMA-ORD                      PICTURE 9(4).
       77  SEQNO-LEN                       PICTURE 99.
       77  SEQ-NO                          PICTURE 9999.
       77  SKIP-FLAG                       PICTURE X. 
       77  SKIP-SUB                        PICTURE 9. 
       77  SKIP-UNTIL-TOKEN-COUNT          PICTURE 9. 
       77  VERSION-NAME                    PICTURE X(7).
       77  WK-SUB                          PICTURE 9999.
  
       PROCEDURE DIVISION.
  
      ******************************************************************
      * 
      *    MAIN DRIVING ROUTINE 
      * 
      *    INITALIZE SOME DATA ITEMS AND I-O.  THEN ENTER MAIN LOOP.
      *    CALL SUBROUTINES TO PROCESS ADD SCHEMA ENTRY, SCHEMA 
      *    SUBENTRY, VERSION SUBENTRIES, AREA SUBENTRIES, AND SUBSCHEMA 
      *    SUBENTRIES. THE ENTRIES ARE PROCESSED IN THE FOLLOWING ORDER:  
      *    ONE OPTIONAL ADD SCHEMA ENTRY, ONE SCHEMA SUBENTRY, ANY
      *    NUMBER OF VERSION SUBENTRIES, EACH OF WHICH MANY CONTAIN 
      *    ANY NUMBER OF AREA SUBENTRIES, AND ANY NUMBER OF SUBSCHEMA 
      *    SUBENTRIES.  IF KEYWORD "SCHEMA" OR "ADD" IS ENCOUNTERED, GO 
      *    TO THE TOP OF THE MAIN LOOP.  CONTINUE PROCESSING UNTIL END
      *    OF FILE ON MDSFIL. 
      * 
      ******************************************************************
  
       BEGIN-PARA.
           OPEN INPUT MDS-FILE. 
           OPEN I-O IS-FILE.
           OPEN OUTPUT SYSPRINT.
           MOVE 1 TO SEQNO-LEN. 
           MOVE 0 TO SEQNO-COMP-1 (1), SEQNO-COMP-1 (2),
             SEQNO-COMP-1 (3), SEQNO-COMP-1 (4).
           MOVE SPACES TO END-SW, SKIP-FLAG.
           MOVE CONV-MDS-TITLE TO REPORT-TITLE-LONG.
           MOVE 99 TO LINE-CT.
           MOVE 1 TO PRT-CTL. 
           MOVE SPACES TO STD-REPORT-REC. 
           PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.
           PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.
           PERFORM READ-MDSFIL THRU READ-MDSFIL-EXIT. 
           IF END-SW IS EQUAL TO "E"
               MOVE "MDSFIL" TO EMPTY-FILE-NAME 
               MOVE MSG-385 TO STD-REPORT-REC 
               PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT
               GO TO MDS-END
           END-IF.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF END-SW IS EQUAL TO "E"
               GO TO MDS-END. 
       MAIN-SCHEMA. 
           IF WORK-AREA IS EQUAL TO "ADD" 
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               IF WORK-AREA IS EQUAL TO "SCHEMA"
                 OR WORK-AREA IS EQUAL TO "SCHEMAS" 
                   PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
                   IF WORK-AREA IS EQUAL TO "." 
                       PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
                   END-IF 
               END-IF 
           END-IF.
           IF WORK-AREA IS EQUAL TO "SCHEMA"
               PERFORM SCHEMA-SUB THRU SCHEMA-EXIT
               IF SKIP-FLAG IS EQUAL TO "S" 
                   MOVE "SCHEMA" TO SKIP-UNTIL-TOKEN (1)
                   MOVE "ADD" TO SKIP-UNTIL-TOKEN (2) 
                   MOVE 2 TO SKIP-UNTIL-TOKEN-COUNT 
                   PERFORM SKIP THRU SKIP-EXIT
                   GO TO MAIN-SCHEMA
               END-IF 
           ELSE 
               MOVE MSG-5 TO STD-REPORT-REC 
               PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT
               MOVE "S" TO SKIP-FLAG
               MOVE 2 TO SKIP-UNTIL-TOKEN-COUNT 
               MOVE "SCHEMA" TO SKIP-UNTIL-TOKEN (1)
               MOVE "ADD" TO SKIP-UNTIL-TOKEN (2) 
               PERFORM SKIP THRU SKIP-EXIT
               GO TO MAIN-SCHEMA
           END-IF.
           MOVE "MASTER" TO VERSION-NAME. 
       MAIN-VERSION.
           IF EOF 
               GO TO MDS-END. 
           IF WORK-AREA IS EQUAL TO "SCHEMA"
             OR WORK-AREA IS EQUAL TO "ADD" 
               GO TO MAIN-SCHEMA. 
           IF WORK-AREA IS EQUAL TO "VERSION" 
               PERFORM VERSION-SUB THRU VERSION-EXIT
               IF SKIP-FLAG IS EQUAL TO "S" 
                   MOVE "SCHEMA" TO SKIP-UNTIL-TOKEN (1)
                   MOVE "VERSION" TO SKIP-UNTIL-TOKEN (2) 
                   MOVE "SUBSCHEMA" TO SKIP-UNTIL-TOKEN (3) 
                   MOVE "ADD" TO SKIP-UNTIL-TOKEN (4) 
                   MOVE 4 TO SKIP-UNTIL-TOKEN-COUNT 
                   PERFORM SKIP THRU SKIP-EXIT
                   GO TO MAIN-VERSION 
               END-IF 
           GO TO MAIN-VERSION 
           END-IF.
       MAIN-AREA. 
           IF EOF 
               GO TO MDS-END. 
           IF WORK-AREA IS EQUAL TO "SCHEMA"
             OR WORK-AREA IS EQUAL TO "ADD" 
               GO TO MAIN-SCHEMA. 
           IF WORK-AREA IS EQUAL TO "AREA"
               PERFORM AREA-SUB THRU AREA-EXIT
               IF SKIP-FLAG IS EQUAL TO "S" 
                   PERFORM SKIP-PAST-PERIOD THRU SKIP-PAST-PERIOD-EXIT
                   GO TO MAIN-VERSION 
               END-IF 
           GO TO MAIN-VERSION 
           END-IF.
       MAIN-SUBSCHEMA.
           IF EOF 
               GO TO MDS-END. 
           IF WORK-AREA IS EQUAL TO "SCHEMA"
             OR WORK-AREA IS EQUAL TO "ADD" 
               GO TO MAIN-SCHEMA. 
           IF WORK-AREA IS EQUAL TO "SUBSCHEMA" 
               PERFORM SUBSCHEMA-SUB THRU SUBSCHEMA-EXIT
               IF SKIP-FLAG IS EQUAL TO "S" 
                   PERFORM SKIP-PAST-PERIOD THRU SKIP-PAST-PERIOD-EXIT
                   GO TO MAIN-VERSION 
               END-IF 
           GO TO MAIN-VERSION 
           END-IF.
           MOVE WORK-AREA TO UNKNOWN-KEYWORD. 
           MOVE MSG-45 TO STD-REPORT-REC. 
           PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT. 
           MOVE "S" TO SKIP-FLAG. 
           MOVE "SCHEMA" TO SKIP-UNTIL-TOKEN (1). 
           MOVE "VERSION" TO SKIP-UNTIL-TOKEN (2).
           MOVE "SUBSCHEMA" TO SKIP-UNTIL-TOKEN (3).
           MOVE "ADD" TO SKIP-UNTIL-TOKEN (4).
           MOVE 4 TO SKIP-UNTIL-TOKEN-COUNT.
           PERFORM SKIP THRU SKIP-EXIT. 
           GO TO MAIN-VERSION.
       MDS-END. 
           PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.
           MOVE END-REPORT-MSG TO STD-REPORT-REC. 
           PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.
           CLOSE SYSPRINT.
           CLOSE IS-FILE. 
           CLOSE MDS-FILE.
           EXIT PROGRAM.
  
      ******************************************************************
      * 
      *    AREA-SUB THRU AREA-EXIT. 
      * 
      *    SCANS AREA SUBENTRY, SCANS ISFILE TO FIND THAT AREA. 
      *    IF "SAME AS MASTER", CALL WRITE-SCHS TO PREPARE AND WRITE
      *    OUT-SCHS-REC.  ELSE CALL PF-SUB TO SCAN PERMANENT FILE 
      *    INFORMATION AND PREPARE PF-NAME, HOLD-PF, AND
      *    HOLD-UNIT-RECORD.  IF THIS AREA IS PART OF THE MASTER
      *    VERSION, CONSCH HAS ALREADY WRITTEN OUT-REC, 
      *    IS-AREA-REC, AND OUT-SCHS-REC.  IF THIS AREA IS NOT PART OF
      *    THE MASTER VERSION, PREPARE AND WRITE THESE RECORDS, MAKING
      *    THIS AREA THE EALIASOF THE CORRESPONDING AREA OF THE MASTER
      *    VERSION.  CALL APPROPRIATE ROUTINES TO SCAN INDEX AND LOG
      *    SUBENTRIES.  PREPARE AND WRITE OUT-AREAM-REC.
      * 
      *    ON INPUT 
      *    WORK-AREA = "AREA" 
      * 
      *    ON OUTPUT
      *    WORK-AREA = 1ST TOKEN AFTER AREA SUBENTRY
      * 
      ******************************************************************
  
       AREA-SUB.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF WORK-AREA IS EQUAL TO "NAME"
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
           END-IF.
           IF WORK-AREA IS EQUAL TO "IS"
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
           END-IF.
           IF EOF 
               GO TO MDS-END. 
           MOVE WORK-AREA TO AREA-NAME IS-CDCS-NAME.
           MOVE "22" TO IS-ENTITY-TYPE. 
           MOVE SCHEMA-ORD TO IS-SCHEMA-ORDINAL.
           MOVE IS-ALTKEY TO HOLD-IS-ALTKEY.
           START IS-FILE KEY IS EQUAL TO IS-ALTKEY
               INVALID KEY GO TO AREA-ERROR.
       AREA-10. 
           READ IS-FILE 
           IF IS-ALTKEY IS NOT EQUAL TO HOLD-IS-ALTKEY
               GO TO AREA-ERROR.
           IF IS-AREA-SSCH-ORDINAL IS NOT EQUAL TO ZERO 
             OR IS-AREA-MASTER IS NOT EQUAL TO "M"
               GO TO AREA-10. 
           MOVE IS-CATNAME TO AREA-CATNAME, MASTER-AREA-CATNAME.
           MOVE IS-AREA-XN-CATNAME TO MASTER-INDEX-CATNAME. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
               GO TO MDS-END
           END-IF.
           IF WORK-AREA IS NOT EQUAL TO "SAME"
               GO TO AREA-20. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF WORK-AREA IS EQUAL TO "AS"
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
           END-IF.
           IF EOF 
               GO TO MDS-END
           END-IF.
           IF WORK-AREA IS NOT EQUAL TO "MASTER"
              MOVE MSG-325 TO STD-REPORT-REC
              GO TO AREA-ERROR-10 
           END-IF.
           PERFORM WRITE-SCHS THRU WRITE-SCHS-EXIT. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF WORK-AREA IS EQUAL TO "." 
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
           ELSE 
               MOVE MSG-10 TO STD-REPORT-REC
               PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT
           END-IF.
           GO TO AREA-EXIT. 
      * 
      *    PROCESS AREA SUBENTRY
      * 
       AREA-20. 
           PERFORM PF-SUB THRU PF-EXIT. 
           IF SKIP-FLAG IS EQUAL TO "S" 
               GO TO AREA-EXIT. 
           MOVE HOLD-PF TO HOLD-AREA-PF.
           MOVE HOLD-PVOLSER TO HOLD-AREA-PVOLSER.
           MOVE HOLD-PUNIT TO HOLD-AREA-PUNIT.
           MOVE PF-NAME TO AREA-PF-NAME.
           IF VERSION-NAME IS NOT EQUAL TO "MASTER" 
               MOVE "E" TO OUT-EALIASOF-FLAG
               MOVE MASTER-AREA-CATNAME TO OUT-EALIASOF-NAME
               MOVE ZERO TO OUT-99-GROUP
               ADD 1 TO STRUCT-COUNT
               MOVE STRUCT-COUNT TO OUT-STCR
               MOVE "22" TO IS-ENTITY-TYPE
               MOVE SCHEMA-ORD TO IS-SCHEMA-ORDINAL 
               MOVE AREA-NAME TO IS-CDCS-NAME 
               PERFORM WRITE-ENTITY THRU WRITE-ENTITY-EXIT
               MOVE IS-CATNAME TO AREA-CATNAME
               MOVE ZERO TO IS-AREA-SSCH-ORDINAL
               MOVE SPACE TO IS-AREA-MASTER, IS-AREA-XN-CATNAME 
               WRITE IS-AREA-REC
               PERFORM WRITE-SCHS THRU WRITE-SCHS-EXIT
           END-IF.
           MOVE SPACE TO AREA-LOG, INDEX-CATNAME. 
           MOVE 1 TO LOG-SUB. 
       AREA-30. 
           IF WORK-AREA IS EQUAL TO "." 
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               GO TO AREA-40
           END-IF.
           IF WORK-AREA IS EQUAL TO "LOG" 
               PERFORM LOG-SUBROUTINE THRU LOG-EXIT 
               IF SKIP-FLAG IS EQUAL TO "S" 
                   GO TO AREA-EXIT
               END-IF 
               GO TO AREA-30
           END-IF.
           IF WORK-AREA IS EQUAL TO "INDEX" 
               PERFORM INDEX-SUB THRU INDEX-EXIT
               IF SKIP-FLAG IS EQUAL TO "S" 
                   GO TO AREA-EXIT
               END-IF 
               GO TO AREA-30
           END-IF.
           MOVE WORK-AREA TO UNKNOWN-KEYWORD. 
           MOVE MSG-45 TO STD-REPORT-REC. 
           GO TO AREA-ERROR-10. 
       AREA-40. 
           IF VERSION-NAME IS EQUAL TO "MASTER" 
               MOVE SPACES TO OUT-EALIASOF-FLAG, OUT-EALIASOF-NAME
           ELSE 
               MOVE "E" TO OUT-EALIASOF-FLAG
               MOVE MASTER-AREA-CATNAME TO OUT-EALIASOF-NAME
           END-IF.
           MOVE "22" TO OUT-ENTRY-TYPE. 
           MOVE ZERO TO OUT-99-GROUP. 
           MOVE AREA-CATNAME TO OUT-CATNAME.
           MOVE "450" TO OUT-CATEGORY-TYPE. 
           ADD 1 TO STRUCT-COUNT. 
           MOVE STRUCT-COUNT TO OUT-STCR. 
           MOVE AREA-NAME TO OUT-CDCS-NAME. 
           MOVE "05" TO OUT-FIELD-TYPE. 
           MOVE SPACES TO OUT-FILLER. 
           MOVE AREA-PF-NAME TO OUT-AREAM-PFNAREA.
           MOVE HOLD-AREA-PF TO OUT-AREAM-PF. 
           MOVE HOLD-AREA-UNIT-RECORD TO OUT-AREAM-UNIT-RECORD. 
           MOVE AREA-LOG TO OUT-AREAM-LOG.
           MOVE INDEX-CATNAME TO OUT-AREAM-INDXFIL. 
           CALL "WRKFOUT".
           GO TO AREA-EXIT. 
       AREA-ERROR.
           MOVE MSG-55 TO STD-REPORT-REC. 
       AREA-ERROR-10. 
           PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT. 
           MOVE "S" TO SKIP-FLAG. 
       AREA-EXIT. 
           EXIT.
  
*CALL DISPLAYLN 
*CALL WRITELN 
  
      ******************************************************************
      * 
      *    GEN-NAME THRU GEN-NAME-EXIT
      * 
      *    APPEND A SEQUENCE NUMBER TO A CDCS NAME IN ORDER TO GENERATE 
      *    A UNIQUE CATNAME 
      * 
      *    ON INPUT 
      *    CDCS-NAME = CDCS NAME
      *    SEQNO = CURRENT SEQUENCE NUMBER
      *    SEQNO-LEN = NUMBER OF CHARACTERS IN SEQUENCE NUMBER
      * 
      *    ON OUTPUT
      *    CDCS-NAME = CDCS NAME WITH SEQUENCE NUMBER APPENDED.  THIS 
      *                NAME MAY OR MAY NOT BE A UNIQUE CATNAME. 
      *    SEQNO, SEQNO-LEN UPDATED TO REFLECT NEW SEQUENCE NUMBER
      * 
      *    LOGIC
      *    GENERATE NEW SEQUENCE NUMBER IN SEQNO.  THE SEQUENCE IS A, B,
      *    ..., Z, 0, 1, ..., 9, AA, BA, ..., 9A, AB, BB, ..., 9B, ..., 
      *    99, AAA, BAA, ..., 999.  IF THE LENGTH OF NAME PLUS LENGTH 
      *    OF SEQUENCE NUMBER IS 32 OR LESS, THE SEQUENCE NUMBER IS 
      *    APPENDED TO THE NAME, FOR EXAMPLE, JOB WILL BE CHANGED TO
      *    JOBA.  OTHERWISE THE NAME WILL BE TRUNCATED ON THE RIGHT TO
      *    ALLOW THE FULL SEQUENCE NUMBER TO BE APPENDED. 
      * 
      ******************************************************************
  
       GEN-NAME.
           PERFORM VARYING CHAR-SUB FROM 1 BY 1 
             UNTIL CDCS-NAME-CHAR (CHAR-SUB) IS EQUAL TO SPACE
               MOVE "F" TO END-LOOP 
           END-PERFORM. 
           MOVE CHAR-SUB TO CDCS-NAME-LEN-PLUS1.
           MOVE "F" TO END-LOOP.
           PERFORM VARYING CHAR-SUB FROM 1 BY 1 
             UNTIL END-LOOP IS EQUAL TO "T" 
               IF SEQNO-CHAR (CHAR-SUB) IS EQUAL TO "9" 
                   MOVE "A" TO SEQNO-CHAR (CHAR-SUB)
               ELSE 
                   MOVE SEQNO-CHAR (CHAR-SUB) TO SEQ-DIGIT (10) 
                   ADD 1 TO SEQ-DIGIT-COMP-1
                   MOVE "T" TO END-LOOP 
                   MOVE SEQ-DIGIT (10) TO SEQNO-CHAR (CHAR-SUB) 
                   IF CHAR-SUB IS GREATER THAN SEQNO-LEN
                       MOVE CHAR-SUB TO SEQNO-LEN 
                   END-IF 
               END-IF 
           END-PERFORM. 
           IF SEQNO-LEN + CDCS-NAME-LEN-PLUS1 IS NOT GREATER THAN 32
               MOVE SEQNO (1 : SEQNO-LEN) TO
                 CDCS-NAME (CDCS-NAME-LEN-PLUS1 : SEQNO-LEN)
           ELSE 
               MOVE SEQNO (1 : SEQNO-LEN) TO
                 CDCS-NAME (32 - SEQNO-LEN : SEQNO-LEN) 
           END-IF.
       GEN-NAME-EXIT. 
           EXIT.
  
  
      ******************************************************************
      * 
      *    GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
      * 
      *    GET THE NEXT TOKEN.
      * 
      *    ON INPUT 
      *    SUB-LINE (IN-SUB) = 1ST CHARACTER AFTER LAST TOKEN 
      * 
      *    ON OUTPUT
      *    IF END-OF-FILE ENCOUNTERED 
      *        END-SW = "E" 
      *    IF END-OF-FILE NOT ENCOUNTERED 
      *        WORK-AREA = TOKEN
      * 
      ******************************************************************
  
       GET-NEXT-TOKEN.
           PERFORM SPACER THRU SPACER-EXIT. 
           IF EOF 
               GO TO GET-NEXT-TOKEN-EXIT. 
           PERFORM SCAN THRU SCAN-EXIT. 
       GET-NEXT-TOKEN-EXIT. 
           EXIT.
  
      ******************************************************************
      * 
      *    INDEX-SUB THRU INDEX-EXIT
      * 
      *    SCAN INDEX SUBENTRY. 
      *    CALL PF-SUB TO SCAN PF SUBENTRY AND SET UP PF-NAME, HOLD-PF, 
      *    AND HOLD-UNIT-RECORD.  PREPARE OUT-REC FOR FILE AND CALL 
      *    WRITE-ENTITY TO WRITE IT TO WORK-FILE.  IF VERSION-NAME
      *    IS NOT EQUAL TO "MASTER", MAKE THIS FILE THE EALIASOF THE
      *    FILE FOR THE MASTER INDEX IN THE MASTER VERSION. 
      *    WRITE IS-FILE-REC TO IS-FILE.  WRITE OUT-FILEU-REC 
      *    AND OUT-FILEM-REC.  IF VERSION-NAME IS EQUAL TO "MASTER",
      *    UPDATE IS-AREA-REC OF CORRESPONDING AREA IN THE MASTER 
      *    VERSION TO INCLUDE THE CATNAME OF THE MASTER INDEX FILE. 
      * 
      *    ON INPUT 
      *    WORK-AREA = "INDEX"
      *    VERSION-NAME SET UP
      *    IF VERSION-NAME NOT EQUAL TO "MASTER"
      *        MASTER-INDEX-CATNAME SET UP
      * 
      *    ON OUTPUT
      *    OUT-REC, OUT-FILEU-REC, OUT-FILEM-REC WRITTEN FOR FILE 
      *    INDEX-CATNAME SET UP 
      *    IF VERSION-NAME IS EQUAL TO "MASTER" 
      *        IS-AREA-REC IS REWRITTEN WITH IS-AREA-XN-CATNAME SET UP
      * 
      ******************************************************************
  
       INDEX-SUB. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF WORK-AREA IS EQUAL TO "FILE"
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
           END-IF.
           IF WORK-AREA IS EQUAL TO "ASSIGNED"
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
           END-IF.
           IF EOF 
               GO TO MDS-END. 
           PERFORM PF-SUB THRU PF-EXIT. 
           IF SKIP-FLAG IS EQUAL TO "S" 
               GO TO SCHEMA-PF-EXIT.
           IF VERSION-NAME IS EQUAL TO "MASTER" 
               MOVE SPACES TO OUT-EALIASOF-FLAG, OUT-EALIASOF-NAME
           ELSE 
               MOVE "E" TO OUT-EALIASOF-FLAG
               MOVE MASTER-INDEX-CATNAME TO OUT-EALIASOF-NAME 
           END-IF.
           MOVE ZERO TO OUT-99-GROUP. 
           ADD 1 TO STRUCT-COUNT. 
           MOVE STRUCT-COUNT TO OUT-STCR. 
           MOVE "20" TO IS-ENTITY-TYPE. 
           MOVE SCHEMA-ORD TO IS-SCHEMA-ORDINAL.
           MOVE PF-NAME TO IS-CDCS-NAME.
           PERFORM WRITE-ENTITY THRU WRITE-ENTITY-EXIT. 
           MOVE IS-CATNAME TO INDEX-CATNAME.
           WRITE IS-FILE-REC. 
           IF VERSION-NAME IS EQUAL TO "MASTER" 
               MOVE IS-CATNAME TO MASTER-INDEX-CATNAME
               MOVE MASTER-AREA-CATNAME TO IS-CATNAME 
               MOVE ZERO TO IS-ALIAS-NO, IS-SEQ-NO
               START IS-FILE KEY IS EQUAL TO IS-PKEY
               READ IS-FILE 
               MOVE MASTER-INDEX-CATNAME TO IS-AREA-XN-CATNAME
               REWRITE IS-AREA-REC
           END-IF.
           IF HOLD-UNIT-RECORD IS NOT EQUAL TO SPACE
               MOVE HOLD-PVOLSER TO OUT-FILEU-PVOLSER 
               MOVE HOLD-PUNIT TO OUT-FILEU-PUNIT 
               MOVE "220" TO OUT-CATEGORY-TYPE
               MOVE "65" TO OUT-FIELD-TYPE
               ADD 1 TO STRUCT-COUNT
               MOVE STRUCT-COUNT TO OUT-STCR
               CALL "WRKFOUT" 
           END-IF.
           MOVE "450" TO OUT-CATEGORY-TYPE. 
           MOVE "05" TO OUT-FIELD-TYPE. 
           ADD 1 TO STRUCT-COUNT. 
           MOVE STRUCT-COUNT TO OUT-STCR. 
           MOVE SPACES TO OUT-FILLER. 
           MOVE "I" TO OUT-FILEM-FTYPE. 
           MOVE HOLD-PF TO OUT-FILEM-PF.
           CALL "WRKFOUT".
       INDEX-EXIT.
           EXIT.
  
      ******************************************************************
      * 
      *    JOB-SUB THRU JOB-EXIT
      * 
      *    SCAN JOB CONTROL PHRASE OF SCHEMA SUBENTRY.  PREPARE AND 
      *    WRITE OUT-SCHJ-REC.
      * 
      *    ON INPUT 
      *    WORK-AREA = "JOB"
      * 
      *    ON OUTPUT
      *    IF NO ERROR
      *        SKIP-FLAG = SPACE
      *        OUT-SCHJ-REC WRITTEN 
      *    IF ERROR AND REST OF SCHEMA SUBENTRY MUST BE SKIPPED 
      *        SKIP-FLAG = "S"
      * 
      ******************************************************************
  
       JOB-SUB. 
           MOVE SPACES TO OUT-FILLER. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF WORK-AREA IS EQUAL TO "CONTROL" 
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
           END-IF.
           IF WORK-AREA IS EQUAL TO "INFORMATION" 
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
           END-IF.
           IF EOF 
               GO TO MDS-END. 
           GO TO JOB-20.
       JOB-10.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
               GO TO MDS-END. 
       JOB-20.
           IF WORK-AREA IS EQUAL TO "TAPE"
               GO TO JOB-TAPE.
           IF WORK-AREA IS EQUAL TO "UN"
             OR WORK-AREA IS EQUAL TO "ID"
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               IF WORK-AREA IS EQUAL TO "IS"
                   PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               END-IF 
               IF EOF 
                   GO TO MDS-END
                END-IF
               IF WK-SUB IS LESS THAN 3 
                 OR WORKA (1) IS NOT EQUAL TO QUOTE 
                 OR WORKA (WK-SUB) IS NOT EQUAL TO QUOTE
                   GO TO JOB-30 
               ELSE 
                   SUBTRACT 2 FROM WK-SUB 
                   MOVE WORK-AREA (2 : WK-SUB) TO OUT-SCHJC-UN
               END-IF 
               GO TO JOB-10 
           END-IF.
           IF WORK-AREA IS EQUAL TO "PW"
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               IF WORK-AREA IS EQUAL TO "IS"
                   PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               END-IF 
               IF EOF 
                   GO TO MDS-END
                END-IF
               IF WK-SUB IS LESS THAN 3 
                 OR WORKA (1) IS NOT EQUAL TO QUOTE 
                 OR WORKA (WK-SUB) IS NOT EQUAL TO QUOTE
                   GO TO JOB-30 
               ELSE 
                   SUBTRACT 2 FROM WK-SUB 
                   MOVE WORK-AREA (2 : WK-SUB) TO OUT-SCHJC-PW
               END-IF 
               GO TO JOB-10 
           END-IF.
           IF WORK-AREA IS EQUAL TO "FAMILY"
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               IF WORK-AREA IS EQUAL TO "NAME"
                   PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               END-IF 
               IF WORK-AREA IS EQUAL TO "IS"
                   PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               END-IF 
               IF EOF 
                   GO TO MDS-END
               END-IF 
               MOVE WORK-AREA TO OUT-SCHJC-FAMILY 
               GO TO JOB-10 
           END-IF.
           IF WORK-AREA IS EQUAL TO "ACCOUNT" 
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               IF WORK-AREA IS EQUAL TO "IS"
                   PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               END-IF 
               IF EOF 
                   GO TO MDS-END
                END-IF
               IF WK-SUB IS LESS THAN 3 
                 OR WORKA (1) IS NOT EQUAL TO QUOTE 
                 OR WORKA (WK-SUB) IS NOT EQUAL TO QUOTE
                   GO TO JOB-30 
               ELSE 
                   MOVE WORK-AREA TO OUT-SCHJC-ACCOUNT
               END-IF 
               GO TO JOB-10 
           END-IF.
           IF WORK-AREA IS EQUAL TO "CHARGE"
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               IF WORK-AREA IS EQUAL TO "IS"
                   PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               END-IF 
               IF EOF 
                   GO TO MDS-END
                END-IF
               IF WK-SUB IS LESS THAN 3 
                 OR WORKA (1) IS NOT EQUAL TO QUOTE 
                 OR WORKA (WK-SUB) IS NOT EQUAL TO QUOTE
                   GO TO JOB-30 
               ELSE 
                   MOVE WORK-AREA TO OUT-SCHJC-CHARGE 
               END-IF 
               GO TO JOB-10 
           END-IF.
           MOVE "26" TO OUT-ENTRY-TYPE. 
           MOVE SPACE TO OUT-EALIASOF-FLAG, OUT-EALIASOF-NAME.
           MOVE ZERO TO OUT-99-GROUP. 
           MOVE SCHEMA-CATNAME TO OUT-CATNAME.
           MOVE "475" TO OUT-CATEGORY-TYPE. 
           ADD 1 TO STRUCT-COUNT. 
           MOVE STRUCT-COUNT TO OUT-STCR. 
           MOVE SCHEMA-NAME TO OUT-CDCS-NAME. 
           MOVE "05" TO OUT-FIELD-TYPE. 
           CALL "WRKFOUT".
           GO TO JOB-EXIT.
       JOB-TAPE.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
               GO TO MDS-END. 
           IF WORK-AREA IS EQUAL TO "TYPE"
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               IF WORK-AREA IS EQUAL TO "IS"
                   PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               END-IF 
               IF EOF 
                   GO TO MDS-END
               END-IF 
               IF WORK-AREA IS EQUAL TO "MT"
                 OR WORK-AREA IS EQUAL TO "NT"
                   MOVE WORK-AREA TO OUT-SCHJC-TTYPE
                   GO TO JOB-TAPE 
               ELSE 
                   MOVE MSG-345 TO STD-REPORT-REC 
                   GO TO JOB-ERROR
               END-IF 
           END-IF.
           IF WORK-AREA IS EQUAL TO "DENSITY" 
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               IF WORK-AREA IS EQUAL TO "IS"
                   PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               END-IF 
               IF EOF 
                   GO TO MDS-END
               END-IF 
               IF WORK-AREA IS EQUAL TO "LO"
                 OR WORK-AREA IS EQUAL TO "HI"
                 OR WORK-AREA IS EQUAL TO "HY"
                 OR WORK-AREA IS EQUAL TO "HD"
                 OR WORK-AREA IS EQUAL TO "PE"
                 OR WORK-AREA IS EQUAL TO "GE"
                   MOVE WORK-AREA TO OUT-SCHJC-DENSITY
                   GO TO JOB-TAPE 
               ELSE 
                   MOVE MSG-350 TO STD-REPORT-REC 
                   GO TO JOB-ERROR
               END-IF 
           END-IF.
           GO TO JOB-20.
       JOB-30.
           MOVE WORK-AREA TO UNQUOTED-NAME. 
           MOVE MSG-320 TO STD-REPORT-REC.
       JOB-ERROR. 
           PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT. 
           MOVE "S" TO SKIP-FLAG. 
       JOB-EXIT.
           EXIT.
  
  
      ******************************************************************
      * 
      *    LOG-SUBROUTINE THRU LOG-EXIT 
      * 
      *    SCAN LOG PHRASE OF AREA SUBENTRY.  PREPARE AREA-LOG
      * 
      *    ON INPUT 
      *    WORK-AREA = "LOG"
      * 
      *    ON OUTPUT
      *    IF NO ERRORS 
      *        SKIP-FLAG = SPACE
      *        AREA-LOG, LOG-SUB UPDATED
      *        WORK-AREA = 1ST TOKEN AFTER LOG PHRASE 
      *    IF ERRORS AND REST OF AREA SUBENTRY MUST BE SKIPPED
      *        SKIP-FLAG = "S"
      * 
      ******************************************************************
  
       LOG-SUBROUTINE.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
       LOG-10.
           IF EOF 
               GO TO MDS-END. 
           IF WORK-AREA IS NOT EQUAL TO "BEFORE"
             AND WORK-AREA IS NOT EQUAL TO "AFTER"
               GO TO LOG-EXIT.
           IF WORK-AREA IS EQUAL TO "BEFORE"
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               IF WORK-AREA IS EQUAL TO "IMAGE" 
                   PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               END-IF 
               IF EOF 
                   GO TO MDS-END
               END-IF 
               IF WORK-AREA IS EQUAL TO "RECORDS" 
                   MOVE "BR" TO LOG-PARAM 
               ELSE 
                   IF WORK-AREA IS EQUAL TO "BLOCKS"
                       MOVE "BB" TO LOG-PARAM 
                   ELSE 
                       GO TO LOG-ERROR
                   END-IF 
               END-IF 
               GO TO LOG-20 
           END-IF.
           IF WORK-AREA IS EQUAL TO "AFTER" 
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               IF WORK-AREA IS EQUAL TO "IMAGE" 
                   PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               END-IF 
               IF EOF 
                   GO TO MDS-END
               END-IF 
               IF WORK-AREA IS EQUAL TO "RECORDS" 
                   MOVE "AR" TO LOG-PARAM 
               ELSE 
                   MOVE MSG-335 TO STD-REPORT-REC 
                   GO TO LOG-ERROR-10 
               END-IF 
           END-IF.
       LOG-20.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF WORK-AREA IS EQUAL TO "OFF" 
               GO TO LOG-SUBROUTINE.
           IF LOG-SUB IS EQUAL TO 1 
               MOVE LOG-PARAM TO AREA-LOG 
               ADD 2 TO LOG-SUB 
           ELSE 
               IF LOG-SUB IS GREATER THAN 6 
                   MOVE MSG-340 TO STD-REPORT-REC 
                   GO TO LOG-ERROR-10 
               ELSE 
                   MOVE "/" TO AREA-LOG (LOG-SUB : 1) 
                   ADD 1 TO LOG-SUB 
                   MOVE LOG-PARAM TO AREA-LOG (LOG-SUB : 2) 
                   ADD 2 TO LOG-SUB 
               END-IF 
           END-IF.
           IF WORK-AREA IS EQUAL TO "ON"
               GO TO LOG-SUBROUTINE 
           ELSE 
               GO TO LOG-10 
           END-IF.
       LOG-ERROR. 
           MOVE MSG-330 TO STD-REPORT-REC.
       LOG-ERROR-10.
           PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT. 
           MOVE "S" TO SKIP-FLAG. 
       LOG-EXIT.
           EXIT.
  
      ******************************************************************
      * 
      *    PF-SUB THRU PF-EXIT
      * 
      *    SCAN PERMANENT FILE INFORMATION SUBENTRY.  PREPARE PF-NAME,
      *    HOLD-PF, AND HOLD-UNIT-RECORD. 
      * 
      *    ON INPUT 
      *    WORK-AREA SHOULD BE "PFN"
      * 
      *    ON OUTPUT
      *    IF NO ERRORS 
      *        SKIP-FLAG = SPACE
      *        PF-NAME, HOLD-PF, AND HOLD-UNIT-RECORD SET UP
      *    IF ERRORS AND REST OF SUBENTRY MUST BE SKIPPED 
      *        SKIP-FLAG = "S"
      * 
      ******************************************************************
  
       PF-SUB.
           IF WORK-AREA IS NOT EQUAL TO "PFN" 
               MOVE MSG-315 TO STD-REPORT-REC 
               PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT
               MOVE "S" TO SKIP-FLAG
               GO TO PF-EXIT
           END-IF.
           MOVE SPACES TO HOLD-PF, HOLD-UNIT-RECORD.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF WORK-AREA IS EQUAL TO "IS"
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
               GO TO MDS-END. 
           IF WK-SUB IS LESS THAN 3 
             OR WORKA (1) IS NOT EQUAL TO QUOTE 
             OR WORKA (WK-SUB) IS NOT EQUAL TO QUOTE
               GO TO PF-20
           ELSE 
               SUBTRACT 2 FROM WK-SUB 
               MOVE WORK-AREA (2 : WK-SUB) TO PF-NAME 
           END-IF.
       PF-10. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
                GO TO MDS-END.
           IF WORK-AREA IS EQUAL TO "UN"
             OR WORK-AREA IS EQUAL TO "ID"
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               IF WORK-AREA IS EQUAL TO "IS"
                   PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               END-IF 
               IF EOF 
                   GO TO MDS-END
                END-IF
               IF WK-SUB IS LESS THAN 3 
                 OR WORKA (1) IS NOT EQUAL TO QUOTE 
                 OR WORKA (WK-SUB) IS NOT EQUAL TO QUOTE
                   GO TO PF-20
               ELSE 
                   SUBTRACT 2 FROM WK-SUB 
                   MOVE WORK-AREA (2 : WK-SUB) TO HOLD-UN 
               END-IF 
               GO TO PF-10
           END-IF.
           IF WORK-AREA IS EQUAL TO "PW"
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               IF WORK-AREA IS EQUAL TO "IS"
                   PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               END-IF 
               IF EOF 
                   GO TO MDS-END
               END-IF 
               IF WK-SUB IS LESS THAN 3 
                 OR WORKA (1) IS NOT EQUAL TO QUOTE 
                 OR WORKA (WK-SUB) IS NOT EQUAL TO QUOTE
                   GO TO PF-20
               ELSE 
                   SUBTRACT 2 FROM WK-SUB 
                   MOVE WORK-AREA (2 : WK-SUB) TO HOLD-PW 
               END-IF 
               GO TO PF-10
           END-IF.
           IF WORK-AREA IS EQUAL TO "FAMILY"
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               IF WORK-AREA IS EQUAL TO "NAME"
                   PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               END-IF 
               IF WORK-AREA IS EQUAL TO "IS"
                   PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               END-IF 
               IF EOF 
                   GO TO MDS-END
               END-IF 
               MOVE WORK-AREA TO HOLD-FAMILY
               GO TO PF-10
           END-IF.
           IF WORK-AREA IS EQUAL TO "PACK"
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               IF WORK-AREA IS EQUAL TO "NAME"
                   PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               END-IF 
               IF WORK-AREA IS EQUAL TO "IS"
                   PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               END-IF 
               IF EOF 
                   GO TO MDS-END
               END-IF 
               MOVE WORK-AREA TO HOLD-PACK
               GO TO PF-10
           END-IF.
           IF WORK-AREA IS EQUAL TO "SET" 
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               IF WORK-AREA IS EQUAL TO "NAME"
                   PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               END-IF 
               IF WORK-AREA IS EQUAL TO "IS"
                   PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               END-IF 
               IF EOF 
                   GO TO MDS-END
               END-IF 
               MOVE WORK-AREA TO HOLD-SET 
               GO TO PF-10
           END-IF.
           IF WORK-AREA IS EQUAL TO "VSN" 
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               IF WORK-AREA IS EQUAL TO "IS"
                   PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               END-IF 
               IF EOF 
                   GO TO MDS-END
               END-IF 
               IF WK-SUB IS LESS THAN 3 
                 OR WORKA (1) IS NOT EQUAL TO QUOTE 
                 OR WORKA (WK-SUB) IS NOT EQUAL TO QUOTE
                   GO TO PF-20
               ELSE 
                   SUBTRACT 2 FROM WK-SUB 
                   MOVE WORK-AREA (2 : WK-SUB) TO HOLD-PVOLSER
               END-IF 
               GO TO PF-10
           END-IF.
           IF WORK-AREA IS EQUAL TO "DEVICE"
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               IF WORK-AREA IS EQUAL TO "TYPE"
                   PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               END-IF 
               IF WORK-AREA IS EQUAL TO "IS"
                   PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               END-IF 
               IF EOF 
                    GO TO MDS-END 
               END-IF 
               MOVE WORK-AREA TO HOLD-PUNIT 
               GO TO PF-10
           END-IF.
           GO TO PF-EXIT. 
       PF-20. 
           MOVE WORK-AREA TO UNQUOTED-NAME. 
           MOVE MSG-320 TO STD-REPORT-REC.
           PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT. 
           MOVE "S" TO SKIP-FLAG. 
       PF-EXIT. 
           EXIT.
  
  
      ******************************************************************
      * 
      *    PROCEDURE-SUB THRU PROCEDURE-EXIT
      * 
      *    SCAN PROCEDURE PHRASE OF SCHEMA SUBENTRY.  CALL SCHEMA-PF-SUB
      *    TO SCAN PERMANENT FILE INFORMATION SUBENTRY AND WRITE
      *    OUT-FILEM-REC AND, IF NECESSARY, OUT-FILEU-REC.
      *    FOR EVERY DBP FOR THIS SCHEMA ON IS-FILE, WRITE OUT-FILES-REC
      * 
      *    ON INPUT 
      *    WORK-AREA = "PROCEDURE"
      * 
      *    ON OUTPUT
      *    IF NO ERROR
      *        OUT-FILEM-REC, OUT-FILEU-REC WRITTEN 
      *        OUT-FILES-REC WRITTEN FOR EVERY DBP OF THIS SCHEMA 
      *        SKIP-FLAG = SPACE
      *        WORK-AREA = FIRST TOKEN AFTER PROCEDURE PHRASE 
      *    IF ERROR AND REST OF SCHEMA SUBENTRY MUST BE SKIPPED 
      *        SKIP-FLAG = "S"
      * 
      ******************************************************************
  
       PROCEDURE-SUB. 
           MOVE "PRO" TO FILE-TYPE. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF WORK-AREA IS EQUAL TO "LIBRARY" 
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
           END-IF.
           IF EOF 
               GO TO MDS-END. 
           PERFORM SCHEMA-PF-SUB THRU SCHEMA-PF-EXIT. 
           IF SKIP-FLAG IS EQUAL TO "S" 
               GO TO PROCEDURE-EXIT.
           MOVE "300" TO OUT-CATEGORY-TYPE. 
           MOVE "05" TO OUT-FIELD-TYPE. 
           MOVE "03" TO IS-ENTITY-TYPE. 
           MOVE SPACES TO OUT-FILLER. 
           MOVE SCHEMA-ORD TO IS-SCHEMA-ORDINAL.
           MOVE SPACES TO IS-CDCS-NAME. 
           START IS-FILE KEY IS GREATER THAN IS-ALTKEY
               INVALID KEY GO TO PROCEDURE-EXIT.
       PROCEDURE-10.
           READ IS-FILE.
           IF IS-ENTITY-TYPE IS NOT EQUAL TO "03" 
             OR IS-SCHEMA-ORDINAL IS NOT EQUAL TO SCHEMA-ORD
               GO TO PROCEDURE-EXIT.
           MOVE IS-CATNAME TO OUT-FILES-CATNAME.
           ADD 1 TO STRUCT-COUNT. 
           MOVE STRUCT-COUNT TO OUT-STCR. 
           CALL "WRKFOUT".
           GO TO PROCEDURE-10.
       PROCEDURE-EXIT.
           EXIT.
  
  
      ******************************************************************
      * 
      *    PROCESS-ERROR THRU PROCESS-ERROR-EXIT
      * 
      *    PRINTS ERROR MESSAGE.  SETS RETURN-CODE TO 8.
      * 
      *    ON INPUT 
      *    STD-REPORT-REC CONTAINS ERROR MESSAGE
      * 
      *    ON OUTPUT
      *    ERROR MESSAGE PRINTED
      *    RETURN-CODE = 8
      * 
      ******************************************************************
  
       PROCESS-ERROR. 
           PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.
           MOVE 8 TO RETURN-CODE. 
       PROCESS-ERROR-EXIT.
           EXIT.
  
  
      ******************************************************************
      * 
      *    READ-MDSFIL THRU READ-MDSFIL-EXIT
      * 
      *    READ NEXT RECORD OF MDSFIL 
      * 
      *    ON OUTPUT
      *    IF END-OF-FILE ENCOUNTERED 
      *        END-SW = "E" 
      *    IF END-OF-FILE NOT ENCOUNTERED 
      *        MDS-IN CONTAINS NEXT RECORD
      *        NEXT RECORD WRITTEN TO OUTPUT FILE 
      *        IN-SUB = 1 
      * 
      ******************************************************************
  
       READ-MDSFIL. 
           IF END-SW IS EQUAL TO "E"
               GO TO READ-MDSFIL-EXIT.
           READ MDS-FILE AT END 
               MOVE "E" TO END-SW 
               GO TO READ-MDSFIL-EXIT.
           MOVE MDS-IN TO STD-REPORT-REC. 
           PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.
           MOVE 1 TO IN-SUB.
           MOVE SPACES TO MDS-LINE (73).
       READ-MDSFIL-EXIT.
           EXIT.
  
      ******************************************************************
      * 
      *    SCAN THRU SCAN-EXIT
      * 
      *    COPY NEXT TOKEN TO WORK-AREA 
      * 
      *    ON INPUT 
      *    MDS-LINE (IN-SUB) = 1ST CHARACTER OF TOKEN 
      * 
      *    ON OUTPUT
      *    MDS-LINE (IN-SUB) = 1ST CHARACTER AFTER TOKEN
      *    WORK-AREA (1 : WK-SUB) = TOKEN 
      *    NON-LITERAL TOKEN MAY BE A PERIOD OR A SERIES OF 
      *    CHARACTERS TERMINATED BY A PERIOD, COMMA, SEMICOLON, OR
      *    SPACE.  IF THE TOKEN IS A SERIES OF CHARACTERS 
      *    TERMINATED BY A PERIOD, THE PERIOD WILL NOT BE PART OF THE 
      *    TOKEN, BUT WILL BE RETURNED AS THE TOKEN BY THE NEXT CALL TO 
      *    SCAN.
      * 
      ******************************************************************
  
       SCAN.
           MOVE 1 TO WK-SUB.
           MOVE SPACES TO WORK-AREA.
           IF MDS-LINE (IN-SUB) IS EQUAL TO QUOTE 
               GO TO SCAN-LIT.
           MOVE MDS-LINE (IN-SUB) TO WORKA (WK-SUB).
           IF MDS-LINE (IN-SUB) IS EQUAL TO "." 
               ADD 1 TO IN-SUB
               IF IN-SUB IS GREATER THAN 72 
                   PERFORM READ-MDSFIL THRU READ-MDSFIL-EXIT
               END-IF 
               GO TO SCAN-EXIT
           END-IF.
       SCAN-LOOP. 
           ADD 1 TO IN-SUB. 
           IF IN-SUB IS GREATER THAN 72 
               PERFORM READ-MDSFIL THRU READ-MDSFIL-EXIT
           END-IF.
           IF MDS-LINE (IN-SUB) IS EQUAL TO SPACE 
             OR MDS-LINE (IN-SUB) IS EQUAL TO "," 
             OR MDS-LINE (IN-SUB) IS EQUAL TO ";" 
               GO TO SCAN-LOOP-END
           END-IF.
           IF MDS-LINE (IN-SUB) IS EQUAL TO "." 
               GO TO SCAN-LOOP-END. 
           ADD 1 TO WK-SUB. 
           MOVE MDS-LINE (IN-SUB) TO WORKA (WK-SUB).
           GO TO SCAN-LOOP. 
       SCAN-LOOP-END. 
           IF WK-SUB IS GREATER THAN 30 
               MOVE MSG-25 TO STD-REPORT-REC
               PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT
               MOVE 30 TO WK-SUB
               MOVE SPACES TO WORK-AREA (31 : END)
           END-IF.
           GO TO SCAN-EXIT. 
       SCAN-LIT.
           MOVE 0 TO CHAR-COUNT.
           MOVE MDS-LINE (IN-SUB) TO WORKA (WK-SUB).
       SCAN-LIT-LOOP. 
           ADD 1 TO IN-SUB WK-SUB.
           IF IN-SUB IS GREATER THAN 72 
               PERFORM READ-MDSFIL THRU READ-MDSFIL-EXIT
               IF END-SW IS EQUAL TO "E"
                   MOVE QUOTE TO MDS-LINE (1) 
                   MOVE SPACE TO MDS-LINE (2) 
               END-IF 
           END-IF.
           MOVE MDS-LINE (IN-SUB) TO WORKA (WK-SUB).
           IF MDS-LINE (IN-SUB) IS NOT EQUAL TO QUOTE 
               ADD 1 TO CHAR-COUNT
               IF CHAR-COUNT IS GREATER THAN 30 
                   MOVE MSG-165 TO STD-REPORT-REC 
                   PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT
                   GO TO SCAN-LIT-DISCARD 
               END-IF 
               GO TO SCAN-LIT-LOOP
           END-IF.
           ADD 1 TO IN-SUB WK-SUB.
           IF IN-SUB IS GREATER THAN 72 
               PERFORM READ-MDSFIL THRU READ-MDSFIL-EXIT
               IF END-SW IS EQUAL TO "E"
                   MOVE SPACES TO MDS-LINE (1)
               END-IF 
           END-IF 
           IF MDS-LINE (IN-SUB) IS EQUAL TO QUOTE 
               ADD 1 TO CHAR-COUNT
               IF CHAR-COUNT IS GREATER THAN 30 
                   MOVE MSG-165 TO STD-REPORT-REC 
                   PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT
                   GO TO SCAN-LIT-DISCARD-LOOP
               END-IF 
               MOVE MDS-LINE (IN-SUB) TO WORKA (WK-SUB) 
               GO TO SCAN-LIT-LOOP
           END-IF.
           SUBTRACT 1 FROM WK-SUB.
           GO TO SCAN-EXIT. 
       SCAN-LIT-DISCARD.
           MOVE QUOTE TO WORKA (WK-SUB).
       SCAN-LIT-DISCARD-LOOP. 
           ADD 1 TO IN-SUB. 
           IF IN-SUB IS GREATER THAN 72 
               PERFORM READ-MDSFIL THRU READ-MDSFIL-EXIT
               IF END-SW IS EQUAL TO "E"
                   GO TO SCAN-EXIT
               END-IF 
           END-IF.
           IF MDS-LINE (IN-SUB) IS NOT EQUAL TO QUOTE 
               GO TO SCAN-LIT-DISCARD-LOOP
           END-IF.
           ADD 1 TO IN-SUB. 
           IF IN-SUB IS GREATER THAN 72 
               PERFORM READ-MDSFIL THRU READ-MDSFIL-EXIT
               IF END-SW IS EQUAL TO "E"
                   GO TO SCAN-EXIT
               END-IF 
           END-IF.
           IF MDS-LINE (IN-SUB) IS EQUAL TO QUOTE 
               GO TO SCAN-LIT-DISCARD-LOOP
           END-IF.
       SCAN-EXIT. 
           EXIT.
  
  
      ******************************************************************
      * 
      *    SCHEMA-PF-SUB THRU SCHEMA-PF-EXIT
      * 
      *    CALL PF-SUB TO SCAN PF SUBENTRY AND SET UP PF-NAME, HOLD-PF, 
      *    AND HOLD-UNIT-RECORD.  PREPARE OUT-REC FOR FILE AND CALL 
      *    WRITE-ENTITY TO WRITE IT TO WORK-FILE.  WRITE IS-FILE-REC
      *    TO IS-FILE.  SET UP AND WRITE OUT-FILEU-REC.  SET UP 
      *    OUT-FILEM-REC.  IF THIS IS NOT A TRANSACTION FILE, WRITE 
      *    OUT-FILEM-REC. 
      * 
      *    ON INPUT 
      *    WORK-AREA = SHOULD BE "PFN"
      *    FILE-TYPE SET UP 
      * 
      *    ON OUTPUT
      *    IF NO ERROR
      *        OUT-REC, OUT-FILEU-REC WRITTEN FOR FILE
      *        HOLD-UNIT-RECORD, FILE-CATNAME, OUT-FILEM-REC SET UP 
      *        SKIP-FLAG = SPACE
      *        IF NOT A TRANSACTION FILE
      *            OUT-FILEM-REC WRITTEN
      *    IF ERROR AND REST OF SCHEMA SUBENTRY MUST BE SKIPPED 
      *        SKIP-FLAG = "S"
      * 
      ******************************************************************
  
       SCHEMA-PF-SUB. 
           PERFORM PF-SUB THRU PF-EXIT. 
           IF SKIP-FLAG IS EQUAL TO "S" 
               GO TO SCHEMA-PF-EXIT.
           MOVE SPACES TO OUT-EALIASOF-FLAG, OUT-EALIASOF-NAME. 
           MOVE ZERO TO OUT-99-GROUP. 
           ADD 1 TO STRUCT-COUNT. 
           MOVE STRUCT-COUNT TO OUT-STCR. 
           MOVE "20" TO IS-ENTITY-TYPE. 
           MOVE SCHEMA-ORD TO IS-SCHEMA-ORDINAL.
           MOVE PF-NAME TO IS-CDCS-NAME.
           PERFORM WRITE-ENTITY THRU WRITE-ENTITY-EXIT. 
           MOVE IS-CATNAME TO FILE-CATNAME. 
           WRITE IS-FILE-REC. 
           IF HOLD-UNIT-RECORD IS NOT EQUAL TO SPACE
               MOVE HOLD-PVOLSER TO OUT-FILEU-PVOLSER 
               MOVE HOLD-PUNIT TO OUT-FILEU-PUNIT 
               MOVE "220" TO OUT-CATEGORY-TYPE
               MOVE "65" TO OUT-FIELD-TYPE
               ADD 1 TO STRUCT-COUNT
               MOVE STRUCT-COUNT TO OUT-STCR
               CALL "WRKFOUT" 
           END-IF.
           MOVE "450" TO OUT-CATEGORY-TYPE. 
           MOVE "05" TO OUT-FIELD-TYPE. 
           ADD 1 TO STRUCT-COUNT. 
           MOVE STRUCT-COUNT TO OUT-STCR. 
           MOVE SPACES TO OUT-FILLER. 
           MOVE FILE-TYPE TO OUT-FILEM-FTYPE. 
      * 
      *    FOR JOURNAL LOG FILE, OUT-SCHM-FILE-TYPE = "JLO", BUT
      *    OUT-FILEM-FTYPE = L
      * 
           IF OUT-FILEM-FTYPE IS EQUAL TO "J" 
               MOVE "L" TO OUT-FILEM-FTYPE
           END-IF 
           MOVE HOLD-PF TO OUT-FILEM-PF.
           IF FILE-TYPE IS NOT EQUAL TO "TRA" 
               CALL "WRKFOUT" 
           END-IF.
       SCHEMA-PF-EXIT.
           EXIT.
  
      ******************************************************************
      * 
      *    SCHEMA-SUB THRU SCHEMA-EXIT. 
      * 
      *    SCANS SCHEMA SUBENTRY. SCANS ISFILE TO FIND THAT SCHEMA. 
      *    PREPARES AND WRITES OUT-SCHM-LFN-REC.  CALLS SUBROUTINES 
      *    TO PROCESS PROCEDURE AND TRANSACTION FILE INFORMATION. 
      *    PROCESSES RESTART, JOURNAL, AND QUICK FILE INFORMATION AND 
      *    CALLS SCHEMA-PF-SUB TO PROCESS EACH PERMANENT FILE 
      *    INFORMATION SUBENTRY.  FOR EACH FILE, PREPARES AND WRITES
      *    OUT-SCHM-FILE-REC.  CALLS SUBROUTINE TO PROCESS JOB CONTROL
      *    INFORMATION. 
      * 
      *    ON INPUT 
      *    WORK-AREA = "SCHEMA" 
      * 
      *    ON OUTPUT
      *    IF NO ERROR
      *        WORK-AREA = 1ST TOKEN AFTER SCHEMA SUBENTRY
      *        SCHEMA-ORD SET UP
      *        APPROPRIATE RECORDS WRITTEN TO WORK-FILE 
      *        SKIP-FLAG = SPACE
      *    IF ERROR AND REST OF SCHEMA SUBENTRY MUST BE SKIPPED 
      *        SKIP-FLAG = "S"
      * 
      ******************************************************************
  
       SCHEMA-SUB.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF WORK-AREA IS EQUAL TO "NAME"
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
           END-IF.
           IF WORK-AREA IS EQUAL TO "IS"
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
           END-IF.
           IF EOF 
               GO TO MDS-END. 
           MOVE WORK-AREA TO SCHEMA-NAME. 
           MOVE "26" TO IS-ENTITY-TYPE. 
           MOVE SPACES TO IS-CDCS-NAME. 
           MOVE ZERO TO IS-SCHEMA-ORDINAL.
           START IS-FILE KEY IS GREATER THAN IS-ALTKEY
               INVALID KEY GO TO SCHEMA-ERROR.
       SCHEMA-10. 
           READ IS-FILE 
               AT END GO TO SCHEMA-ERROR. 
           IF IS-CDCS-NAME IS NOT EQUAL TO SCHEMA-NAME
               GO TO SCHEMA-10. 
           MOVE IS-SCHEMA-ORDINAL TO SCHEMA-ORD.
           MOVE IS-CDCS-NAME TO SCHEMA-NAME.
           MOVE IS-CATNAME TO SCHEMA-CATNAME. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF WORK-AREA IS NOT EQUAL TO "FILE"
               MOVE MSG-310 TO STD-REPORT-REC 
               GO TO SCHEMA-ERROR-10
           END-IF.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF WORK-AREA IS EQUAL TO "NAME"
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
           END-IF.
           IF WORK-AREA IS EQUAL TO "IS"
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
           END-IF.
           IF EOF 
               GO TO MDS-END. 
           MOVE "26" TO OUT-ENTRY-TYPE. 
           MOVE SPACE TO OUT-EALIASOF-FLAG, OUT-EALIASOF-NAME,
             OUT-FILLER.
           MOVE ZERO TO OUT-99-GROUP. 
           MOVE SCHEMA-CATNAME TO OUT-CATNAME.
           MOVE "450" TO OUT-CATEGORY-TYPE. 
           ADD 1 TO STRUCT-COUNT. 
           MOVE STRUCT-COUNT TO OUT-STCR. 
           MOVE SCHEMA-NAME TO OUT-CDCS-NAME. 
           MOVE "05" TO OUT-FIELD-TYPE. 
           MOVE WORK-AREA TO OUT-SCHM-SCHLFN. 
           CALL "WRKFOUT".
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
       SCHEMA-20. 
           IF WORK-AREA IS EQUAL TO "." 
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               GO TO SCHEMA-EXIT
           END-IF.
           IF EOF 
               GO TO MDS-END. 
           IF WORK-AREA IS EQUAL TO "PROCEDURE" 
               PERFORM PROCEDURE-SUB THRU PROCEDURE-EXIT
               GO TO SCHEMA-30
           END-IF.
           IF WORK-AREA IS EQUAL TO "TRANSACTION" 
               PERFORM TRANSACTION-SUB THRU TRANSACTION-EXIT
               GO TO SCHEMA-30
           END-IF.
           IF WORK-AREA IS EQUAL TO "RESTART" 
               MOVE "RES" TO FILE-TYPE
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               IF WORK-AREA IS EQUAL TO "IDENTIFIER"
                   PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               END-IF 
               IF WORK-AREA IS EQUAL TO "FILE"
                   PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               END-IF 
               IF EOF 
                   GO TO MDS-END
               END-IF 
               PERFORM SCHEMA-PF-SUB THRU SCHEMA-PF-EXIT
               GO TO SCHEMA-30
           END-IF.
           IF WORK-AREA IS EQUAL TO "JOURNAL" 
               MOVE "JLO" TO FILE-TYPE
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               IF WORK-AREA IS EQUAL TO "LOG" 
                   PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               END-IF 
               IF WORK-AREA IS EQUAL TO "FILE"
                   PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               END-IF 
               IF EOF 
                   GO TO MDS-END
               END-IF 
               PERFORM SCHEMA-PF-SUB THRU SCHEMA-PF-EXIT
               GO TO SCHEMA-30
           END-IF.
           IF WORK-AREA IS EQUAL TO "QUICK" 
               MOVE "QRF" TO FILE-TYPE
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               IF WORK-AREA IS EQUAL TO "RECOVERY"
                   PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               END-IF 
               IF WORK-AREA IS EQUAL TO "FILE"
                   PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               END-IF 
               IF EOF 
                   GO TO MDS-END
               END-IF 
               PERFORM SCHEMA-PF-SUB THRU SCHEMA-PF-EXIT
               GO TO SCHEMA-30
           END-IF.
           IF WORK-AREA IS EQUAL TO "JOB" 
               PERFORM JOB-SUB THRU JOB-EXIT
               IF SKIP-FLAG IS EQUAL TO "S" 
                   GO TO SCHEMA-EXIT
               END-IF 
               GO TO SCHEMA-20
           END-IF.
           MOVE WORK-AREA TO UNKNOWN-KEYWORD. 
           MOVE MSG-45 TO STD-REPORT-REC. 
           GO TO SCHEMA-ERROR-10. 
       SCHEMA-30. 
           IF SKIP-FLAG IS EQUAL TO "S" 
               GO TO SCHEMA-EXIT. 
           MOVE "26" TO OUT-ENTRY-TYPE. 
           MOVE SPACE TO OUT-EALIASOF-FLAG, OUT-EALIASOF-NAME,
             OUT-FILLER.
           MOVE ZERO TO OUT-99-GROUP. 
           MOVE SCHEMA-CATNAME TO OUT-CATNAME.
           MOVE "450" TO OUT-CATEGORY-TYPE. 
           ADD 1 TO STRUCT-COUNT. 
           MOVE STRUCT-COUNT TO OUT-STCR. 
           MOVE SCHEMA-NAME TO OUT-CDCS-NAME. 
           MOVE "10" TO OUT-FIELD-TYPE. 
           MOVE FILE-TYPE TO OUT-SCHM-FILE-TYPE.
           MOVE FILE-CATNAME TO OUT-SCHM-FILE-CATNAME.
           CALL "WRKFOUT".
           GO TO SCHEMA-20. 
       SCHEMA-ERROR.
           MOVE MSG-190 TO STD-REPORT-REC.
       SCHEMA-ERROR-10. 
           PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT. 
           MOVE "S" TO SKIP-FLAG. 
       SCHEMA-EXIT. 
           EXIT.
  
      ******************************************************************
      * 
      *    SKIP THRU SKIP-EXIT. 
      * 
      *    SKIP TOKENS UNTIL END-OF-FILE OR UNTIL TOKEN IS EQUAL
      *    TO TOKEN IN SKIP-UNTIL-TOKEN ARRAY 
      * 
      *    ON INPUT 
      *    SKIP-UNTIL-TOKEN AND SKIP-UNTIL-TOKEN-COUNT SET UP 
      *    WORK-AREA = TOKEN WHICH WAS BEING PROCESSED WHEN ERROR WAS 
      *      ENCOUNTERED
      * 
      *    ON OUTPUT
      *    IF END-OF-FILE ENCOUNTERED BEFORE CORRECT TOKEN FOUND
      *        RETURNS TO MDS-END, NOT TO CALLER
      *    IF CORRECT TOKEN FOUND 
      *        WORK-AREA = CORRECT TOKEN
      * 
      ******************************************************************
  
       SKIP.
           PERFORM VARYING SKIP-SUB FROM 1 BY 1 
             UNTIL SKIP-SUB IS GREATER THAN SKIP-UNTIL-TOKEN-COUNT
               IF WORK-AREA IS EQUAL TO SKIP-UNTIL-TOKEN (SKIP-SUB) 
                   MOVE WORK-AREA TO SKIPPED-TO-KEYWORD 
                   MOVE MSG-40 TO STD-REPORT-REC
                   PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT
                   MOVE SPACE TO SKIP-FLAG
                   GO TO SKIP-EXIT
               END-IF 
           END-PERFORM. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF END-SW IS NOT EQUAL TO "E"
               GO TO SKIP 
           ELSE 
               GO TO MDS-END
           END-IF.
       SKIP-EXIT. 
           EXIT.
  
  
      ******************************************************************
      * 
      *    SKIP-PAST-PERIOD THRU SKIP-PAST-PERIOD-EXIT
      * 
      *    SKIP TOKENS UNTIL PERIOD IS ENCOUNTERED.  THEN CALL
      *    GET-NEXT-TOKEN TO GET TOKEN AFTER PERIOD 
      * 
      *    ON INPUT 
      *    WORK-AREA = TOKEN WHICH WAS BEING PROCESSED WHEN ERROR WAS 
      *      ENCOUNTERED
      * 
      *    ON OUTPUT
      *    IF END-OF-FILE ENCOUNTERED BEFORE PERIOD FOUND 
      *        RETURNS TO MDS-END, NOT TO CALLER
      *    IF PERIOD FOUND
      *        WORK-AREA = 1ST TOKEN AFTER PERIOD 
      * 
      ******************************************************************
  
       SKIP-PAST-PERIOD.
           MOVE MSG-30 TO STD-REPORT-REC. 
           PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT. 
       SKIP-PAST-PERIOD-10. 
           IF WORK-AREA IS EQUAL TO "." 
               MOVE MSG-35 TO STD-REPORT-REC
               PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT
               MOVE SPACE TO SKIP-FLAG
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               IF EOF 
                   GO TO MDS-END
               END-IF 
               GO TO SKIP-PAST-PERIOD-EXIT
           END-IF.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
               GO TO MDS-END. 
           GO TO SKIP-PAST-PERIOD-10. 
       SKIP-PAST-PERIOD-EXIT. 
           EXIT.
  
      ******************************************************************
      * 
      *    SPACER THRU SPACER-EXIT
      * 
      *    SPACE OVER BLANKS, COMMAS, AND SEMICOLONS. 
      * 
      *    ON OUTPUT
      *    MDS-LINE (IN-SUB) = FIRST CHARACTER OF NEXT TOKEN
      * 
      ******************************************************************
  
       SPACER.
           IF MDS-LINE (IN-SUB) IS NOT EQUAL TO SPACE 
             AND MDS-LINE (IN-SUB) IS NOT EQUAL TO ","
             AND MDS-LINE (IN-SUB) IS NOT EQUAL TO ";"
               GO TO SPACER-EXIT. 
           ADD 1 TO IN-SUB. 
           IF IN-SUB LESS THAN 73 GO TO SPACER. 
           PERFORM READ-MDSFIL THRU READ-MDSFIL-EXIT. 
           IF END-SW IS EQUAL TO "E"
               GO TO SPACER-EXIT. 
           GO TO SPACER.
       SPACER-EXIT. 
           EXIT.
  
      ******************************************************************
      * 
      *    SUBSCHEMA-SUB THRU SUBSCHEMA-EXIT. 
      * 
      *    SCANS SUBSCHEMA SUBENTRY, SCANS ISFILE TO FIND THE SUBSCHEMA,
      *    PREPARES AND WRITES OUT-SSCHM-LFN-REC
      * 
      *    ON INPUT 
      *    WORK-AREA = "SUBSCHEMA"
      * 
      *    ON OUTPUT
      *    IF NO ERROR
      *        WORK-AREA = 1ST TOKEN AFTER SUBSCHEMA SUBENTRY 
      *        OUT-SSCHM-LFN-REC WRITTEN
      *        SKIP-FLAG = SPACE
      *    IF ERROR AND REST OF SUBSCHEMA ENTRY MUST BE SKIPPED 
      *        SKIP-FLAG = "S"
      * 
      ******************************************************************
  
       SUBSCHEMA-SUB. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF WORK-AREA IS EQUAL TO "NAME"
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
           END-IF.
           IF WORK-AREA IS EQUAL TO "IS"
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
           END-IF.
           IF EOF 
               GO TO MDS-END. 
           MOVE WORK-AREA TO SCHEMA-NAME. 
           MOVE "24" TO IS-ENTITY-TYPE. 
           MOVE WORK-AREA TO IS-CDCS-NAME.
           MOVE SCHEMA-ORD TO IS-SCHEMA-ORDINAL.
           START IS-FILE KEY IS EQUAL TO IS-ALTKEY
               INVALID KEY GO TO SUBSCHEMA-ERROR. 
           READ IS-FILE.
           MOVE IS-CATNAME TO OUT-CATNAME.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF WORK-AREA IS NOT EQUAL TO "FILE"
               MOVE MSG-310 TO STD-REPORT-REC 
               GO TO SUBSCHEMA-ERROR-10 
           END-IF.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF WORK-AREA IS EQUAL TO "NAME"
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
           END-IF.
           IF WORK-AREA IS EQUAL TO "IS"
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
           END-IF.
           IF EOF 
               GO TO MDS-END. 
           MOVE "24" TO OUT-ENTRY-TYPE. 
           MOVE SPACE TO OUT-EALIASOF-FLAG, OUT-EALIASOF-NAME,
             OUT-FILLER.
           MOVE ZERO TO OUT-99-GROUP. 
           MOVE "450" TO OUT-CATEGORY-TYPE. 
           ADD 1 TO STRUCT-COUNT. 
           MOVE STRUCT-COUNT TO OUT-STCR. 
           MOVE IS-CDCS-NAME TO OUT-CDCS-NAME.
           MOVE "05" TO OUT-FIELD-TYPE. 
           MOVE WORK-AREA TO OUT-SSCHM-SSLFN. 
           CALL "WRKFOUT".
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF WORK-AREA IS EQUAL TO "." 
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
           ELSE 
               MOVE MSG-10 TO STD-REPORT-REC
               PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT
           END-IF.
           GO TO SUBSCHEMA-EXIT.
       SUBSCHEMA-ERROR. 
           MOVE MSG-355 TO STD-REPORT-REC.
       SUBSCHEMA-ERROR-10.
           PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT. 
           MOVE "S" TO SKIP-FLAG. 
       SUBSCHEMA-EXIT.
           EXIT.
  
      ******************************************************************
      * 
      *    TRANSACTION-SUB THRU TRANSACTION-EXIT
      * 
      *    SCAN TRANSACTION PHRASE OF SCHEMA SUBENTRY.  CALL PFN-SUB
      *    TO SCAN PERMANENT FILE INFORMATION SUBENTRY AND PREPARE
      *    OUT-FILEM-REC AND HOLD-UNIT-RECORD.  SCAN UNIT AND UPDATE
      *    PHRASES OF TRANSACTION PHRASE.  WRITE OUT-FILEM-REC AND, IF
      *    NECESSARY, OUT-FILEU-REC 
      * 
      *    ON INPUT 
      *    WORK-AREA = "TRANSACTION"
      * 
      *    ON OUTPUT
      *    IF NO ERROR
      *        OUT-FILEM-REC, OUT-FILEU-REC WRITTEN 
      *        WORK-AREA = 1ST TOKEN AFTER TRANSACTION PHRASE 
      *        SKIP-FLAG = SPACE
      *    IF ERROR AND REST OF SCHEMA SUBENTRY MUST BE SKIPPED 
      *        SKIP-FLAG = "S"
      * 
      ******************************************************************
  
       TRANSACTION-SUB. 
           MOVE "TRA" TO FILE-TYPE. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF WORK-AREA IS EQUAL TO "RECOVERY"
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
           END-IF.
           IF WORK-AREA IS EQUAL TO "FILE"
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
           END-IF.
           IF EOF 
               GO TO MDS-END. 
           PERFORM SCHEMA-PF-SUB THRU SCHEMA-PF-EXIT. 
           IF SKIP-FLAG IS EQUAL TO "S" 
               GO TO TRANSACTION-EXIT.
           GO TO TRANSACTION-20.
       TRANSACTION-10.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
       TRANSACTION-20.
           IF EOF 
                GO TO MDS-END.
           IF WORK-AREA IS EQUAL TO "UNIT"
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               IF WORK-AREA IS EQUAL TO "LIMIT" 
                   PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               END-IF 
               IF WORK-AREA IS EQUAL TO "IS"
                   PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               END-IF 
               IF EOF 
                   GO TO MDS-END
                END-IF
               MOVE WORK-AREA TO OUT-FILEM-UNLMT
               GO TO TRANSACTION-10 
           END-IF.
           IF WORK-AREA IS EQUAL TO "UPDATE"
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               IF WORK-AREA IS EQUAL TO "LIMIT" 
                   PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               END-IF 
               IF WORK-AREA IS EQUAL TO "IS"
                   PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               END-IF 
               IF EOF 
                   GO TO MDS-END
               END-IF 
               MOVE WORK-AREA TO OUT-FILEM-UPLMT
               GO TO TRANSACTION-10 
           END-IF.
           CALL "WRKFOUT".
       TRANSACTION-EXIT.
           EXIT.
  
       USER-ROUTINE.
           GO TO USER-ROUTINE-XIT.
       USER-ROUTINE-XIT.
           EXIT.
  
  
      ******************************************************************
      * 
      *    VERSION-SUB THRU VERSION-EXIT. 
      * 
      *    SCANS VERSION SUBENTRY, STORES VERSION NAME IN VERSION-NAME. 
      *    IF VERSION SUBENTRY IS TERMINATED WITH PERIOD, SCAN ISFILE 
      *    FOR ALL AREAS IN SCHEMA.  FOR EACH AREA, CALL WRITE-SCHS 
      *    TO WRITE OUT-SCHS-REC. 
      * 
      *    ON INPUT 
      *    WORK-AREA = "VERSION"
      * 
      *    ON OUTPUT
      *    WORK-AREA = 1ST TOKEN AFTER VERSION SUBENTRY 
      *    VERSION-NAME SET UP
      *    IF VERSION SUBENTRY IS TERMINATED WITH PERIOD
      *        OUT-SCHS-REC WRITTEN FOR EVERY AREA IN SCHEMA
      * 
      ******************************************************************
  
       VERSION-SUB. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF WORK-AREA IS EQUAL TO "NAME"
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
           END-IF.
           IF WORK-AREA IS EQUAL TO "IS"
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
           END-IF.
           IF EOF 
               GO TO MDS-END. 
           MOVE WORK-AREA TO VERSION-NAME.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF WORK-AREA IS NOT EQUAL TO "." 
               GO TO VERSION-EXIT.
           IF VERSION-NAME IS EQUAL TO "MASTER" 
               GO TO VERSION-EXIT 
           END-IF.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           MOVE "22" TO IS-ENTITY-TYPE. 
           MOVE SCHEMA-ORD TO IS-SCHEMA-ORDINAL 
           MOVE SPACES TO IS-CDCS-NAME. 
           START IS-FILE KEY IS GREATER THAN IS-ALTKEY
               INVALID KEY GO TO VERSION-EXIT.
       VERSION-10.
           READ IS-FILE 
               AT END GO TO VERSION-EXIT. 
           IF IS-ENTITY-TYPE IS NOT EQUAL TO "22" 
             OR IS-SCHEMA-ORDINAL IS NOT EQUAL TO SCHEMA-ORD
               GO TO VERSION-EXIT.
           IF IS-AREA-SSCH-ORDINAL IS NOT EQUAL TO 0
             OR IS-AREA-MASTER IS NOT EQUAL TO "M"
               GO TO VERSION-10.
           MOVE IS-CATNAME TO AREA-CATNAME. 
           PERFORM WRITE-SCHS THRU WRITE-SCHS-EXIT. 
           GO TO VERSION-10.
       VERSION-EXIT.
           EXIT.
  
      ******************************************************************
      * 
      *    WRITE-ENTITY THRU WRITE-ENTITY-EXIT
      * 
      *    DETERMINE A UNIQUE CATNAME FOR CDCS NAME.  WRITE OUT-REC 
      * 
      *    ON INPUT, THE FOLLOWING FIELDS ARE SET 
      *        OUT-EALIASOF-FLAG
      *        OUT-99-GROUP 
      *        OUT-STCR 
      *        OUT-EALIASOF-NAME
      *        IS-ALTKEY
      * 
      *    ON OUTPUT, THE FOLLOWING FIELDS ARE SET UP 
      *        OUT-ENTRY-TYPE 
      *        OUT-CATNAME
      *        OUT-CATEGORY-TYPE
      *        OUT-CDCS-NAME
      *        OUT-FIELD-TYPE 
      *        IS-PKEY
      *    OUT-REC IS WRITTEN.
      *    IS-REC IS SET UP.
      *    OUT-FILLER = SPACES
      * 
      *    LOGIC
      *    FORM IS-PKEY.  READ IS-FILE TO DETERMINE IF CATNAME ALREADY
      *    EXITS.  IF NOT, CALL GEN-NAME TO APPEND SEQUENCE NUMBER TO 
      *    HOPEFULLY GENERATE A UNIQUE CATNAME AND READ IS-FILE TO
      *    DETERMINE IF NEW CATNAME ALREADY EXISTS.  REPEAT UNTIL UNIQUE
      *    CATNAME IS GENERATED.  WRITE OUT-REC.
      * 
      ******************************************************************
  
       WRITE-ENTITY.
           MOVE IS-CDCS-NAME TO IS-CATNAME. 
           MOVE ZERO TO IS-SEQ-NO, IS-ALIAS-NO. 
           MOVE IS-ENTITY-TYPE TO OUT-ENTRY-TYPE. 
           MOVE "000" TO OUT-CATEGORY-TYPE. 
           MOVE IS-CDCS-NAME TO OUT-CDCS-NAME.
           MOVE "00" TO OUT-FIELD-TYPE. 
           MOVE "S" TO OUT-LANG-CODE. 
           MOVE SPACES TO OUT-FILLER. 
       WRITE-ENTITY-10. 
           START IS-FILE KEY IS EQUAL TO IS-PKEY
               INVALID KEY GO TO WRITE-ENTITY-20. 
           MOVE IS-CDCS-NAME TO CDCS-NAME.
           PERFORM GEN-NAME THRU GEN-NAME-EXIT. 
           MOVE CDCS-NAME TO IS-CATNAME.
           GO TO WRITE-ENTITY-10. 
       WRITE-ENTITY-20. 
           MOVE IS-CATNAME TO OUT-CATNAME.
           CALL "WRKFOUT".
       WRITE-ENTITY-EXIT. 
           EXIT.
  
  
      ******************************************************************
      * 
      *    WRITE-SCHS THRU WRITE-SCHS-EXIT
      * 
      *    PREPARE AND WRITE OUT-SCHS-REC 
      * 
      *    ON INPUT 
      *    SCHEMA-CATNAME, AREA-CATNAME, VERSION-NAME SET UP
      * 
      *    ON OUTPUT
      *    OUT-SCHS-REC WRITTEN 
      * 
      ******************************************************************
  
       WRITE-SCHS.
           MOVE "26" TO OUT-ENTRY-TYPE. 
           MOVE SPACE TO OUT-EALIASOF-FLAG, OUT-EALIASOF-NAME,
             OUT-FILLER.
           MOVE ZERO TO OUT-99-GROUP. 
           MOVE SCHEMA-CATNAME TO OUT-CATNAME.
           MOVE "300" TO OUT-CATEGORY-TYPE. 
           ADD 1 TO STRUCT-COUNT. 
           MOVE STRUCT-COUNT TO OUT-STCR. 
           MOVE SCHEMA-NAME TO OUT-CDCS-NAME. 
           MOVE "05" TO OUT-FIELD-TYPE. 
           MOVE AREA-CATNAME TO OUT-SCHS-CATNAME. 
           MOVE "A" TO OUT-SCHS-CTYPE.
           MOVE VERSION-NAME TO OUT-SCHS-AVERS. 
           CALL "WRKFOUT".
       WRITE-SCHS-EXIT. 
           EXIT.
