*DECK DCCONSCH
       IDENTIFICATION DIVISION. 
       PROGRAM-ID. CONSCH.
*CALL COPYRIGHT 
      *    THIS PROGRAM EXPLODES CDCS SCHEMA ENTRIES 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 SCH-FILE ASSIGN TO SCHFIL
               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  SCH-FILE 
           LABEL RECORDS ARE OMITTED
           RECORD CONTAINS 80 CHARACTERS
           DATA RECORDS ARE SCH-IN. 
       01  SCH-IN.
           02  SCH-LINE                    PICTURE X OCCURS 73 TIMES. 
           02  SCH-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  BIN-ONE                         PICTURE 999 COMP-1 VALUE 1.
       01  BIN-ZERO                        PICTURE 999 COMP-1 VALUE 0.
       01  ANOTHER-BIN REDEFINES BIN-ZERO.
           02  SIX-BIT-ZERO                PICTURE X. 
           02  FILLER                      PICTURE X(9).
       01  CDCS-NAME. 
           03  CDCS-NAME-CHAR              PICTURE X OCCURS 32 TIMES. 
       01  COMMENT-AREA.
           03  COMMENT-A                   PICTURE X OCCURS 67 TIMES. 
       01  DUMMY-FIT. 
           02  LFN                         PICTURE X(7).
           02  FIT-STAT                    PICTURE 9(4) COMP-4. 
           02  WORD1                       PICTURE 99   COMP-1. 
           02  WORD2                       PICTURE 99   COMP-1. 
           02  WORD3                       PICTURE 99   COMP-1. 
           02  WORD4                       PICTURE 99   COMP-1. 
           02  WORD5                       PICTURE 99   COMP-1. 
           02  WORD6                       PICTURE 99   COMP-1. 
       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-15                      PICTURE X(61) VALUE
           "DCCVT-15-S ERROR * PICTURE MUST BE SURROUNDED BY QUOTES". 
           02  MSG-20                      PICTURE X(64) VALUE
           "DCCVT-20-W ERROR * KEYWORD *BEFORE*, *ERROR*, OR *AFTER* MIS
      -    "SING".
           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-50                      PICTURE X(43) VALUE
           "DCCVT-50-S ERROR * KEYWORD *WITHIN* MISSING". 
           02  MSG-55                      PICTURE X(36) VALUE
           "DCCVT-55-S ERROR * AREA-NAME UNKNOWN".
           02  MSG-60                      PICTURE X(49) VALUE
           "DCCVT-60-S ERROR * AREA-NAME NOT UNIQUE IN SCHEMA". 
           02  MSG-65                      PICTURE X(51) VALUE
           "DCCVT-65-S ERROR * RECORD-NAME NOT UNIQUE IN SCHEMA". 
           02  MSG-70                      PICTURE X(44) VALUE
           "DCCVT-70-S ERROR * KEYWORD *CONTROL* MISSING".
           02  MSG-75                      PICTURE X(43) VALUE
           "DCCVT-75-S ERROR * UNKNOWN SEQUENCE". 
           02  MSG-80                      PICTURE X(41) VALUE
           "DCCVT-80-S ERROR * KEYWORD *CODE* MISSING". 
           02  MSG-85                      PICTURE X(38) VALUE
           "DCCVT-85-S ERROR * RECORD-NAME UNKNOWN".
           02  MSG-90.
               03  FILLER                  PICTURE X(30) VALUE
               "DCCVT-90-S ERROR * DATA-NAME *".
               03  UNKNOWN-DATA-NAME       PICTURE X(30). 
               03  FILLER                  PICTURE X(9) VALUE 
               "* UNKNOWN". 
           02  MSG-95                      PICTURE X(38) VALUE
           "DCCVT-95-S ERROR * KEYWORD *<* MISSING".
           02  MSG-100                     PICTURE X(39) VALUE
           "DCCVT-100-W ERROR * KEYWORD *>* ASSUMED". 
           02  MSG-105                     PICTURE X(40) VALUE
           "DCCVT-105-S ERROR * LEVEL TABLE EXCEEDED".
           02  MSG-110                     PICTURE X(40) VALUE
           "DCCVT-110-S ERROR * INVALID LEVEL NUMBER".
           02  MSG-115                     PICTURE X(44) VALUE
           "DCCVT-115-S ERROR * KEYWORD *RESULT* MISSING".
           02  MSG-120                     PICTURE X(45) VALUE
           "DCCVT-120-S ERROR * KEYWORD *DEPENDS* MISSING". 
           02  MSG-125                     PICTURE X(40) VALUE
           "DCCVT-125-S ERROR * KEYWORD *EQ* MISSING".
           02  MSG-130                     PICTURE X(39) VALUE
           "DCCVT-130-S ERROR * KEYWORD *)* MISSING". 
           02  MSG-135                     PICTURE X(42) VALUE
           "DCCVT-135-S ERROR * KEYWORD *JOIN* MISSING".
           02  MSG-140                     PICTURE X(57) VALUE
           "DCCVT-140-S ERROR * SUBSCRIPT CONTAINS MORE THAN 4 DIGITS". 
           02  MSG-145                     PICTURE X(42) VALUE
           "DCCVT-145-S ERROR * KEYWORD *CALL* MISSING".
           02  MSG-150                     PICTURE X(60) VALUE
          "DCCVT-150-S ERROR * KEYWORD *SYSTEM* OR *PROCEDURE* MISSING".
           02  MSG-155                     PICTURE X(55) VALUE
           "DCCVT-155-S ERROR * KEYWORD *BY* OR *PROCEDURE* MISSING". 
           02  MSG-160                     PICTURE X(37) VALUE
           "DCCVT-160-S ERROR * INVALID SUBSCRIPT". 
           02  MSG-165                     PICTURE X(65) VALUE
           "DCCVT-165-W ERROR * NONNUMERIC LITERAL TRUNCATED TO 30 CHARA
      -    "CTERS". 
           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".
           02  MSG-490                     PICTURE X(54) VALUE
           "DCCVT-490-W ERROR * PICTURE TRUNCATED TO 25 CHARACTERS".
       02  FIND-IS-ALTKEY.
           03  FIND-IS-ENTITY-TYPE         PICTURE XX.
           03  FIND-IS-SCHEMA-ORDINAL      PICTURE 9999.
           03  FIND-IS-CDCS-NAME           PICTURE X(30). 
      *************************************************************** 
      * 
      *     HEADING LITERALS
      * 
       01  HEADING-LITS.
           03  CONV-SCH-TITLE          PICTURE X(50) VALUE
          " S C H E M A   C O N V E R S I O N   R E P O R T ".
           03  END-REPORT-MSG             PICTURE X(34) 
               VALUE "***END SCHEMA CONVERSION REPORT***".
       01  HOLD-ATTRIBUTE.
           02  HOLD-LENGTH                 PICTURE X(10). 
           02  HOLD-FORMAT                 PICTURE XXX. 
           02  HOLD-PICTURE                PICTURE X(25). 
           02  HOLD-JUST                   PICTURE X. 
           02  HOLD-SYNC                   PICTURE X. 
       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  LEVEL-TABLE. 
           02  LEV-TAB                     OCCURS 11 TIMES. 
               03  LEVT-CATNAME            PICTURE X(32). 
               03  LEVT-CDCS-NAME          PICTURE X(30). 
               03  LEVT-GRP-ELE            PICTURE X. 
               03  LEVT-LEVEL-NO           PICTURE 99.
       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  NOTE-CDCS-REC. 
           03  NOTE-ENTRY-TYPE             PICTURE XX.
           03  NOTE-99-GROUP               PICTURE 99.
           03  NOTE-CATNAME                PICTURE X(32). 
           03  NOTE-CATEGORY-TYPE          PICTURE XXX. 
           03  NOTE-CDCS-NAME              PICTURE X(30). 
       01  NOTE-HOLD-CDCS-REC.
           03  FILLER                      PICTURE X(127).
           03  HOLD-LARGEST-REC            PICTURE X(469).
       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. 
       01  ALIAS-NO                        PICTURE 9999.
       01  ALIAS-WITH-SAME-ATT             PICTURE 9999.
       01  AREA-CATNAME                    PICTURE X(32). 
       01  AREA-NAME                       PICTURE X(30). 
       01  AREA-SUB                        PICTURE 9. 
       01  CATNAME-MAY-BE-GROUP            PICTURE X. 
       01  CDCS-NAME-LEN-PLUS1             PICTURE 99.
       01  CKEYID                          PICTURE X(30). 
       01  CHAR-COUNT                      PICTURE 99.
       01  CHAR-SUB                        PICTURE 99.
       01  CHECKBY                         PICTURE X(13). 
       01  CHK-SUB                         PICTURE 99.
       01  CMT-SUB                         PICTURE 9999.
       01  COMPRESSION-TYPE                PICTURE XX.
       01  DATA-NAME                       PICTURE X(30). 
       01  DATA-SUB                        PICTURE 9. 
       01  DONE                            PICTURE X. 
       01  DUPES                           PICTURE X. 
       01  EALIASOF                        PICTURE X(32). 
       01  EALIASOF-FLAG                   PICTURE X. 
       01  END-LOOP                        PICTURE X. 
       01  END-SW                          PICTURE X. 
           88 EOF VALUE "E".
       01  ENTITY-WRITTEN                  PICTURE X. 
       01  FIND-ALIAS                      PICTURE X(4).
       01  FIND-CATNAME                    PICTURE X(32). 
       01  FIND-DATA-NAME                  PICTURE X(30). 
       01  FIND-RECORD-CATNAME             PICTURE X(32). 
       01  FIND-RECORD-NAME                PICTURE X(30). 
       01  IN-SUB                          PICTURE 9999.
       01  HOLD-COMPLEX                    PICTURE X. 
       01  HOLD-DEC                        PICTURE X. 
       01  HOLD-FIXED                      PICTURE X. 
       01  HOLD-FLOAT                      PICTURE X. 
       01  HOLD-REAL                       PICTURE X. 
       01  LENGTH-SUB                      PICTURE 99.
       01  LEVEL-NO                        PICTURE 99.
       01  LV-SUB                          PICTURE 99.
       01  LV-SUB-M1                       PICTURE 99.
       01  NAME-FOUND                      PICTURE X. 
       01  NAME-FOUND-NO-PRO-VAL           PICTURE X. 
       01  OCCURS-TO                       PICTURE X(32). 
       01  PERIOD-FLAG                     PICTURE X. 
           88  PER-FOUND VALUE ".". 
       01  PIC-FOUND                       PICTURE X. 
       01  PRO-VAL                         PICTURE X. 
       01  RECORD-CATNAME                  PICTURE X(32). 
       01  RECORD-NAME                     PICTURE X(30). 
       01  RECORD-SUB                      PICTURE 9. 
       01  REPEAT-COMPRESSION              PICTURE X. 
       01  SAVE-STRUCT-COUNT               PICTURE 9(7).
       01  SCHEMA-CATNAME                  PICTURE X(32). 
       01  SCHEMA-NAME                     PICTURE X(30). 
       01  SCHEMA-ORD                      PICTURE 9(4).
       01  SEQNO-LEN                       PICTURE 99.
       01  SEQ-NO                          PICTURE 9999.
       01  SKIP-FLAG                       PICTURE X. 
       01  SKIP-SUB                        PICTURE 9. 
       01  SKIP-UNTIL-TOKEN-COUNT          PICTURE 9. 
       01  SUBSCRIPT                       PICTURE X(16). 
       01  SUBSCRIPT-COUNT                 PICTURE 9. 
       01  SUB-SUB                         PICTURE 99.
       01  TALIAS                          PICTURE X(4).
       01  TEMP-USING                      PICTURE X. 
       01  TYPEKEY                         PICTURE X. 
       01  TYPEPROC                        PICTURE XX.
       01  WK-SUB                          PICTURE 9999.
  
       PROCEDURE DIVISION.
  
      ******************************************************************
      * 
      *    MAIN DRIVING ROUTINE 
      * 
      *    INITALIZE SOME DATA ITEMS AND I-O.  THEN ENTER MAIN LOOP.
      *    CALL SUBROUTINES TO PROCESS SCHEMA ID, AREA
      *    DESCRIPTION, RECORD DESCRIPTION, DATA CONTROL, CONSTRAINT, 
      *    AND RELATION ENTRIES.  THE ENTRIES ARE PROCESSED IN THE
      *    FOLLOWING ORDER:  ONE SCHEMA ID ENTRY, ANY NUMBER OF AREA
      *    AND/OR RECORD DESCRIPTION ENTRIES, ONE DATA CONTROL ENTRY, 
      *    ANY NUMBER OF CONSTRAINT ENTRIES, AND ANY NUMBER OF RELATION 
      *    ENTRIES.  IF KEYWORD "SCHEMA" IS ENCOUNTERED, GO TO THE
      *    TOP OF THE MAIN LOOP.  CONTINUE PROCESSING UNTIL END OF FILE 
      *    ON SCHFIL. 
      * 
      ******************************************************************
  
       BEGIN-PARA.
           MOVE "ISFILE" TO LFN.
           INSPECT LFN REPLACING ALL " " BY SIX-BIT-ZERO. 
           ENTER FTN5 "EVICT" USING DUMMY-FIT, BIN-ONE. 
           MOVE "XNISFIL" TO LFN. 
           INSPECT LFN REPLACING ALL " " BY SIX-BIT-ZERO. 
           ENTER FTN5 "EVICT" USING DUMMY-FIT, BIN-ONE. 
           OPEN INPUT SCH-FILE. 
           OPEN OUTPUT SYSPRINT.
           OPEN OUTPUT IS-FILE. 
           CLOSE IS-FILE. 
           OPEN I-O IS-FILE.
           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, NOTE-CDCS-REC, SKIP-FLAG. 
           MOVE 0 TO SCHEMA-ORD.
           MOVE CONV-SCH-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 DISPLAY-LINE THRU DISPLAY-LINE-XIT.
           PERFORM READ-SCHFIL THRU READ-SCHFIL-EXIT. 
           IF END-SW IS EQUAL TO "E"
               MOVE "SCHFIL" TO EMPTY-FILE-NAME 
               MOVE MSG-385 TO STD-REPORT-REC 
               PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT
               GO TO SCH-END
           END-IF.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF END-SW IS EQUAL TO "E"
               GO TO SCH-END. 
       MAIN-SCHEMA. 
           IF WORK-AREA IS EQUAL TO "SCHEMA"
               PERFORM SCHEMA-ID THRU SCHEMA-ID-EXIT
           ELSE 
               MOVE MSG-5 TO STD-REPORT-REC 
               PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT
               MOVE "S" TO SKIP-FLAG
               MOVE 1 TO SKIP-UNTIL-TOKEN-COUNT 
               MOVE "SCHEMA" TO SKIP-UNTIL-TOKEN (1)
               PERFORM SKIP THRU SKIP-EXIT
               GO TO MAIN-SCHEMA
           END-IF.
       MAIN-AREA. 
           IF EOF 
               GO TO SCH-END. 
           IF WORK-AREA IS EQUAL TO "SCHEMA"
               GO TO MAIN-SCHEMA. 
           IF WORK-AREA IS EQUAL TO "AREA"
               PERFORM AREA-DESC THRU AREA-DESC-EXIT
               IF SKIP-FLAG IS EQUAL TO "S" 
                   PERFORM SKIP-PAST-PERIOD THRU SKIP-PAST-PERIOD-EXIT
               END-IF 
               GO TO MAIN-AREA
           END-IF.
           IF WORK-AREA IS EQUAL TO "RECORD"
               PERFORM RECORD-DESC THRU RECORD-DESC-EXIT
               IF SKIP-FLAG IS EQUAL TO "S" 
                   MOVE "AREA" TO SKIP-UNTIL-TOKEN (1)
                   MOVE "RECORD" TO SKIP-UNTIL-TOKEN (2)
                   MOVE "DATA" TO SKIP-UNTIL-TOKEN (3)
                   MOVE "SCHEMA" TO SKIP-UNTIL-TOKEN (4)
                   MOVE 4 TO SKIP-UNTIL-TOKEN-COUNT 
                   PERFORM SKIP THRU SKIP-EXIT
               END-IF 
               GO TO MAIN-AREA
           END-IF.
           IF WORK-AREA IS EQUAL TO "DATA"
               PERFORM DATA-CONTROL THRU DATA-CONTROL-EXIT
               GO TO MAIN-CONSTRAINT
           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 "AREA" TO SKIP-UNTIL-TOKEN (1). 
           MOVE "RECORD" TO SKIP-UNTIL-TOKEN (2). 
           MOVE "DATA" TO SKIP-UNTIL-TOKEN (3). 
           MOVE "SCHEMA" TO SKIP-UNTIL-TOKEN (4). 
           MOVE 4 TO SKIP-UNTIL-TOKEN-COUNT.
           PERFORM SKIP THRU SKIP-EXIT. 
           GO TO MAIN-AREA. 
       MAIN-CONSTRAINT. 
           IF EOF 
               GO TO SCH-END. 
           IF WORK-AREA IS EQUAL TO "SCHEMA"
               GO TO MAIN-SCHEMA. 
           MOVE "26" TO NOTE-ENTRY-TYPE.
           MOVE ZERO TO NOTE-99-GROUP.
           MOVE SCHEMA-CATNAME TO NOTE-CATNAME. 
           MOVE "550" TO NOTE-CATEGORY-TYPE.
           MOVE SCHEMA-NAME TO NOTE-CDCS-NAME.
           IF WORK-AREA IS EQUAL TO "CONSTRAINT"
               PERFORM CONSTRAINT THRU CONSTRAINT-EXIT
               IF SKIP-FLAG IS EQUAL TO "S" 
                   PERFORM SKIP-PAST-PERIOD THRU SKIP-PAST-PERIOD-EXIT
               END-IF 
               GO TO MAIN-CONSTRAINT
           END-IF.
           MOVE "26" TO NOTE-ENTRY-TYPE.
           MOVE ZERO TO NOTE-99-GROUP.
           MOVE SCHEMA-CATNAME TO NOTE-CATNAME. 
           MOVE "575" TO NOTE-CATEGORY-TYPE.
           MOVE SCHEMA-NAME TO NOTE-CDCS-NAME.
       MAIN-RELATION. 
           IF EOF 
               GO TO SCH-END. 
           IF WORK-AREA IS EQUAL TO "SCHEMA"
               GO TO MAIN-SCHEMA. 
           IF WORK-AREA IS EQUAL TO "RELATION"
               PERFORM RELATION THRU RELATION-EXIT
               IF SKIP-FLAG IS EQUAL TO "S" 
                   PERFORM SKIP-PAST-PERIOD THRU SKIP-PAST-PERIOD-EXIT
               END-IF 
               GO TO MAIN-RELATION
           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 "CONSTRAINT" TO SKIP-UNTIL-TOKEN (1). 
           MOVE "RELATION" TO SKIP-UNTIL-TOKEN (2). 
           MOVE "SCHEMA" TO SKIP-UNTIL-TOKEN (3). 
           MOVE 3 TO SKIP-UNTIL-TOKEN-COUNT.
           PERFORM SKIP THRU SKIP-EXIT. 
           GO TO MAIN-CONSTRAINT. 
       SCH-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 SCH-FILE.
           EXIT PROGRAM.
  
      ******************************************************************
      * 
      *    AREA-ACCESS THRU AREA-ACCESS-EXIT. 
      * 
      *    SCANS ACCESS-CONTROL CLAUSE OF AREA DESCRIPTION ENTRY
      *    AND WRITES OUT-AREAC-MODE-REC AND OUT-AREAC-LOCK-REC 
      *    TO WORK-FILE.  CALLS DBPROC TO WRITE OUT-REC FOR 
      *    DBPROC IF NECESSARY. 
      * 
      *    ON INPUT 
      *    WORK-AREA = "ACCESS-CONTROL" 
      *    AREA-NAME, AREA-CATNAME SET UP 
      * 
      *    ON OUTPUT
      *    IF PERIOD ENDED ACCESS-CONTROL CLAUSE
      *        WORK-AREA = "."
      *        PER-FOUND = TRUE 
      *    IF PERIOD DID NOT END ACCESS-CONTROL CLAUSE
      *        WORK-AREA = 1ST TOKEN AFTER ACCESS-CONTROL CLAUSE
      *    OUT-AREAC-MODE-REC AND OUT-AREAC-LOCK-REC WRITTEN TO 
      *    WORK-FILE.  IF NEW DBPROC ENCOUNTERED, OUT-REC 
      *    FOR DBPROC WRITTEN TO WORK-FILE. 
      * 
      ******************************************************************
  
       AREA-ACCESS. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF END-SW IS EQUAL TO "E"
               GO TO SCH-END. 
           MOVE "22" TO OUT-ENTRY-TYPE. 
           MOVE ZERO TO OUT-99-GROUP. 
           MOVE AREA-CATNAME TO OUT-CATNAME.
           MOVE "425" TO OUT-CATEGORY-TYPE. 
           MOVE AREA-NAME TO OUT-CDCS-NAME. 
           IF WORK-AREA IS NOT EQUAL TO "LOCK"
               GO TO AREA-ACCESS-10.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF END-SW IS EQUAL TO "E"
               GO TO SCH-END. 
       AREA-ACCESS-10.
           MOVE SPACES TO OUT-FILLER. 
           MOVE 1 TO AREA-SUB.
           GO TO AREA-ACCESS-30.
       AREA-ACCESS-20.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF END-SW IS EQUAL TO "E"
               GO TO AREA-ACCESS-40.
           IF WORK-AREA IS EQUAL TO "." 
               SET PER-FOUND TO TRUE
               GO TO AREA-ACCESS-40 
           END-IF.
           IF AREA-SUB IS GREATER THAN 2
               GO TO AREA-ACCESS-40.
       AREA-ACCESS-30.
           IF WORK-AREA IS EQUAL TO "FOR" 
               GO TO AREA-ACCESS-20.
           IF WORK-AREA IS EQUAL TO "UPDATE"
               IF AREA-SUB IS EQUAL TO 1
                   MOVE "U" TO OUT-AREAC-MODE 
                   ADD 1 TO AREA-SUB
               ELSE 
                   MOVE "/U" TO OUT-AREAC-MODE (AREA-SUB : 2) 
                   ADD 2 TO AREA-SUB
               END-IF 
               GO TO AREA-ACCESS-20 
           END-IF.
           IF WORK-AREA IS EQUAL TO "RETRIEVAL" 
               IF AREA-SUB IS EQUAL TO 1
                   MOVE "R" TO OUT-AREAC-MODE 
                   ADD 1 TO AREA-SUB
               ELSE 
                   MOVE "/R" TO OUT-AREAC-MODE (AREA-SUB : 2) 
                   ADD 2 TO AREA-SUB
               END-IF 
               GO TO AREA-ACCESS-20 
           END-IF.
       AREA-ACCESS-40.
           IF AREA-SUB IS NOT EQUAL TO 1
               ADD 1 TO STRUCT-COUNT
               MOVE STRUCT-COUNT TO OUT-STCR
               MOVE "05" TO OUT-FIELD-TYPE
               CALL "WRKFOUT" 
           END-IF 
           MOVE SPACES TO OUT-FILLER. 
           IF END-SW IS EQUAL TO "E"
               GO TO SCH-END. 
           IF PER-FOUND 
               GO TO AREA-ACCESS-EXIT.
           IF WORK-AREA IS NOT EQUAL TO "IS"
               GO TO AREA-ACCESS-60.
       AREA-ACCESS-50.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF END-SW IS EQUAL TO "E"
               GO TO SCH-END. 
           IF WORK-AREA IS EQUAL TO "." 
               GO TO AREA-ACCESS-EXIT.
       AREA-ACCESS-60.
           IF WORK-AREA IS NOT EQUAL TO "PROCEDURE" 
               MOVE WORK-AREA TO OUT-AREAC-LOCK 
               GO TO AREA-ACCESS-90 
           END-IF.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF END-SW IS EQUAL TO "E"
               GO TO SCH-END. 
           IF WORK-AREA IS EQUAL TO "." 
               GO TO AREA-ACCESS-EXIT.
           PERFORM DBPROC THRU DBPROC-EXIT. 
           MOVE IS-CATNAME TO OUT-AREAC-LOCK. 
       AREA-ACCESS-90.
           MOVE "22" TO OUT-ENTRY-TYPE. 
           MOVE ZERO TO OUT-99-GROUP. 
           MOVE AREA-CATNAME TO OUT-CATNAME.
           MOVE "425" TO OUT-CATEGORY-TYPE. 
           ADD 1 TO STRUCT-COUNT. 
           MOVE STRUCT-COUNT TO OUT-STCR. 
           MOVE AREA-NAME TO OUT-CDCS-NAME. 
           MOVE "10" TO OUT-FIELD-TYPE. 
           CALL "WRKFOUT".
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF END-SW IS EQUAL TO "E"
               GO TO SCH-END. 
           IF WORK-AREA IS EQUAL TO "." 
               SET PER-FOUND TO TRUE
               GO TO AREA-ACCESS-EXIT 
           END-IF.
           IF WORK-AREA IS EQUAL TO "OR"
               GO TO AREA-ACCESS-50.
       AREA-ACCESS-EXIT.
           EXIT.
  
      ******************************************************************
      * 
      *    AREA-CALL THRU AREA-CALL-EXIT. 
      * 
      *    SCANS CALL CLAUSE OF AREA DESCRIPTION ENTRY
      *    AND WRITES OUT-ELEP-REC TO WRKFILE.  CALLS DBPROC
      *    TO WRITE OUT-REC FOR DBPROC IF NECESSARY.
      * 
      *    ON INPUT 
      *    WORK-AREA = "CALL" 
      *    AREA-NAME, AREA-CATNAME SET UP 
      * 
      *    ON OUTPUT
      *    IF PERIOD ENDED CALL CLAUSE
      *        WORK-AREA = "."
      *        PER-FOUND = TRUE 
      *    IF PERIOD DID NOT END CALL CLAUSE
      *        WORK-AREA = 1ST TOKEN AFTER CALL CLAUSE
      *    OUT-ELEP-REC WRITTEN TO WORK-FILE
      *    IF NEW DBPROC ENCOUNTERED, OUT-REC FOR DBPROC
      *    WRITTEN TO WORK-FILE.
      * 
      ******************************************************************
  
       AREA-CALL. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF END-SW IS EQUAL TO "E"
               GO TO SCH-END. 
           PERFORM DBPROC THRU DBPROC-EXIT. 
           MOVE SPACES TO OUT-ELEP-REC. 
           MOVE "22" TO OUT-ENTRY-TYPE. 
           MOVE ZERO TO OUT-99-GROUP. 
           MOVE AREA-CATNAME TO OUT-CATNAME.
           MOVE "400" 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 IS-CATNAME TO OUT-ELEP-DBPROC.
           MOVE "CA" TO OUT-ELEP-TYPEPROC.
           MOVE 1 TO AREA-SUB.
       AREA-CALL-TIME.
           IF AREA-SUB IS GREATER THAN 4
               MOVE 1 TO AREA-SUB 
               GO TO AREA-CALL-OPTION-10
           END-IF.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF END-SW IS EQUAL TO "E"
               GO TO AREA-CALL-WRITE-EXIT.
       AREA-CALL-TIME-10. 
           IF WORK-AREA IS EQUAL TO "BEFORE"
               IF AREA-SUB IS EQUAL TO 1
                   MOVE "B" TO OUT-ELEP-TIME
                   ADD 1 TO AREA-SUB
               ELSE 
                   MOVE "/B" TO OUT-ELEP-TIME (AREA-SUB : 2)
                   ADD 2 TO AREA-SUB
               END-IF 
               GO TO AREA-CALL-TIME 
           END-IF.
           IF WORK-AREA IS EQUAL TO "AFTER" 
               IF AREA-SUB IS EQUAL TO 1
                   MOVE "A" TO OUT-ELEP-TIME
                   ADD 1 TO AREA-SUB
               ELSE 
                   MOVE "/A" TO OUT-ELEP-TIME (AREA-SUB : 2)
                   ADD 2 TO AREA-SUB
               END-IF 
               GO TO AREA-CALL-TIME 
           END-IF.
           IF WORK-AREA IS EQUAL TO "ON"
               GO TO AREA-CALL-TIME.
           IF WORK-AREA IS EQUAL TO "ERROR" 
               IF AREA-SUB IS EQUAL TO 1
                   MOVE "E" TO OUT-ELEP-TIME
                   ADD 1 TO AREA-SUB
               ELSE 
                   MOVE "/E" TO OUT-ELEP-TIME (AREA-SUB : 2)
                   ADD 2 TO AREA-SUB
               END-IF 
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               IF END-SW IS EQUAL TO "E"
                   GO TO AREA-CALL-WRITE-EXIT 
               END-IF 
               IF WORK-AREA IS EQUAL TO "DURING"
                   GO TO AREA-CALL-TIME 
               ELSE 
                   IF AREA-SUB IS NOT GREATER THAN 4
                       GO TO AREA-CALL-TIME-10
                   END-IF 
               END-IF 
           END-IF.
           IF AREA-SUB IS EQUAL TO 1
               MOVE MSG-20 TO STD-REPORT-REC
               PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT
           END-IF.
       AREA-CALL-OPTION.
           IF WORK-AREA IS EQUAL TO "." 
               SET PER-FOUND TO TRUE
               GO TO AREA-CALL-WRITE-EXIT 
           END-IF.
           MOVE 1 TO AREA-SUB.
           GO TO AREA-CALL-OPTION-20. 
       AREA-CALL-OPTION-10. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF END-SW IS EQUAL TO "E"
               GO TO AREA-CALL-WRITE-EXIT.
           IF WORK-AREA IS EQUAL TO "." 
               SET PER-FOUND TO TRUE
               GO TO AREA-CALL-WRITE-EXIT 
           END-IF.
           IF AREA-SUB IS GREATER THAN 6
               GO TO AREA-CALL-WRITE-EXIT.
       AREA-CALL-OPTION-20. 
           IF WORK-AREA IS EQUAL TO "OPEN"
               IF AREA-SUB IS EQUAL TO 1
                   MOVE "O" TO OUT-ELEP-OPTION
                   ADD 1 TO AREA-SUB
               ELSE 
                   MOVE "/O" TO OUT-ELEP-OPTION (AREA-SUB : 2)
                   ADD 2 TO AREA-SUB
               END-IF 
               GO TO AREA-CALL-OPTION-10
           END-IF.
           IF WORK-AREA IS EQUAL TO "FOR" 
               GO TO AREA-CALL-OPTION-10. 
           IF WORK-AREA IS EQUAL TO "UPDATE"
               IF AREA-SUB IS EQUAL TO 1
                   MOVE "U" TO OUT-ELEP-OPTION
                   ADD 1 TO AREA-SUB
               ELSE 
                   MOVE "/U" TO OUT-ELEP-OPTION (AREA-SUB : 2)
                   ADD 2 TO AREA-SUB
               END-IF 
               GO TO AREA-CALL-OPTION-10
           END-IF.
           IF WORK-AREA IS EQUAL TO "RETRIEVAL" 
               IF AREA-SUB IS EQUAL TO 1
                   MOVE "R" TO OUT-ELEP-OPTION
                   ADD 1 TO AREA-SUB
               ELSE 
                   MOVE "/R" TO OUT-ELEP-OPTION (AREA-SUB : 2)
                   ADD 2 TO AREA-SUB
               END-IF 
               GO TO AREA-CALL-OPTION-10
           END-IF.
           IF WORK-AREA IS EQUAL TO "CLOSE" 
               IF AREA-SUB IS EQUAL TO 1
                   MOVE "C" TO OUT-ELEP-OPTION
                   ADD 1 TO AREA-SUB
               ELSE 
                   MOVE "/C" TO OUT-ELEP-OPTION (AREA-SUB : 2)
                   ADD 2 TO AREA-SUB
               END-IF 
               GO TO AREA-CALL-OPTION-10
           END-IF.
       AREA-CALL-WRITE-EXIT.
           CALL "WRKFOUT".
       AREA-CALL-EXIT.
           EXIT.
  
      ******************************************************************
      * 
      *    AREA-CONTROL THRU AREA-CONTROL-EXIT. 
      * 
      *    SCANS AREA CONTROL ENTRY, AND CALLS APPROPRIATE SUBROUTINES
      *    TO HANDLE COMPRESSION/DECOMPRESSION, KEY, SEQUENCE, AND
      *    RECORD CODE CLAUSES. 
      * 
      *    ON INPUT 
      *    WORK-AREA = "AREA" 
      * 
      *    ON OUTPUT
      *    IF NO ERROR
      *        WORK-AREA = 1ST TOKEN AFTER AREA CONTROL ENTRY 
      *        NOTE-CDCS-REC DESCRIBES NAMED AREA 
      *        SKIP-FLAG = SPACE
      *    IF ERROR AND REST OF AREA CONTROL ENTRY MUST BE SKIPPED
      *        SKIP-FLAG = "S"
      * 
      ******************************************************************
  
       AREA-CONTROL.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF END-SW IS EQUAL TO "E"
               GO TO SCH-END. 
           IF WORK-AREA IS NOT EQUAL TO "NAME"
               GO TO AREA-CONTROL-10. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF END-SW IS EQUAL TO "E"
               GO TO SCH-END. 
       AREA-CONTROL-10. 
           IF WORK-AREA IS NOT EQUAL TO "IS"
               GO TO AREA-CONTROL-20. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF END-SW IS EQUAL TO "E"
               GO TO SCH-END. 
       AREA-CONTROL-20. 
           MOVE "22" TO IS-ENTITY-TYPE. 
           MOVE SCHEMA-ORD TO IS-SCHEMA-ORDINAL.
           MOVE WORK-AREA TO IS-CDCS-NAME.
           START IS-FILE KEY IS EQUAL TO IS-ALTKEY
             INVALID KEY GO TO AREA-CONTROL-30. 
           READ IS-FILE.
           IF IS-AREA-SSCH-ORDINAL IS EQUAL TO ZERO 
               GO TO AREA-CONTROL-40. 
       AREA-CONTROL-30. 
           MOVE MSG-55 TO STD-REPORT-REC. 
           PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT. 
           MOVE "S" TO SKIP-FLAG. 
           GO TO AREA-CONTROL-EXIT. 
       AREA-CONTROL-40. 
           MOVE IS-CDCS-NAME TO AREA-NAME, NOTE-CDCS-NAME.
           MOVE IS-CATNAME TO AREA-CATNAME, NOTE-CATNAME. 
           MOVE "22" TO NOTE-ENTRY-TYPE.
           MOVE ZERO TO NOTE-99-GROUP.
           MOVE "001" TO NOTE-CATEGORY-TYPE.
       AREA-CONTROL-50. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
       AREA-CONTROL-60. 
           IF EOF 
               GO TO SCH-END. 
           IF WORK-AREA IS EQUAL TO "." 
               GO TO AREA-CONTROL-PER-EXIT
           END-IF.
           IF WORK-AREA IS EQUAL TO "FOR" 
               GO TO AREA-CONTROL-50. 
           IF WORK-AREA IS EQUAL TO "COMPRESSION" 
             OR WORK-AREA IS EQUAL TO "DECOMPRESSION" 
               PERFORM COMPRESSION THRU COMPRESSION-EXIT
               IF SKIP-FLAG IS EQUAL TO "S" 
                   GO TO AREA-CONTROL-EXIT
               ELSE 
                   GO TO AREA-CONTROL-60
               END-IF 
           END-IF.
           IF WORK-AREA IS EQUAL TO "KEY" 
               MOVE SPACE TO DUPES, TEMP-USING
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               IF EOF 
                   GO TO SCH-END
               END-IF 
               IF WORK-AREA IS EQUAL TO "." 
                   GO TO AREA-CONTROL-PER-EXIT
               END-IF 
               IF WORK-AREA IS EQUAL TO "IDENTIFIER"
                 OR WORK-AREA IS EQUAL TO "ID"
                   PERFORM KEY-ID THRU KEY-ID-EXIT
               ELSE 
                   PERFORM KEY-ROUTINE THRU KEY-EXIT
               END-IF 
               IF SKIP-FLAG IS EQUAL TO "S" 
                   GO TO AREA-CONTROL-EXIT
               ELSE 
                   GO TO AREA-CONTROL-60
               END-IF 
           END-IF.
           IF WORK-AREA IS EQUAL TO "SEQUENCE"
               PERFORM SEQUENCE-ROUTINE THRU SEQUENCE-EXIT
               IF SKIP-FLAG IS EQUAL TO "S" 
                   GO TO AREA-CONTROL-EXIT
               ELSE 
                   GO TO AREA-CONTROL-60
               END-IF 
           END-IF.
           IF WORK-AREA IS EQUAL TO "RECORD"
               PERFORM RECORD-CODE THRU RECORD-CODE-EXIT
               IF SKIP-FLAG IS EQUAL TO "S" 
                   GO TO AREA-CONTROL-EXIT
               ELSE 
                   GO TO AREA-CONTROL-60
               END-IF 
           END-IF.
           MOVE MSG-10 TO STD-REPORT-REC. 
           PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT. 
       AREA-CONTROL-PER-EXIT. 
           IF WORK-AREA IS EQUAL TO "." 
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
       AREA-CONTROL-EXIT. 
           EXIT.
  
      ******************************************************************
      * 
      *    AREA-DESC THRU AREA-DESC-EXIT. 
      * 
      *    SCANS AREA DESCRIPTION ENTRY, PREPARES AREA ENTITY 
      *    AND WRITES ENTITY TO WORK-FILE AND IS-FILE.  CALLS 
      *    SUBROUTINES TO HANDLE CALL AND ACCESS-CONTROL CLAUSES. 
      *    CALLS WRITE-SCHS TO WRITE OUT-SCHS-REC SPECIFYING THAT 
      *    CURRENT SCHEMA CONTAINS CURRENT AREA.
      * 
      *    ON INPUT 
      *    WORK-AREA = "AREA" 
      * 
      *    ON OUTPUT
      *    IF NO ERROR
      *        WORK-AREA = 1ST TOKEN AFTER AREA DESCRIPTION ENTRY 
      *        AREA ENTITY RECORD WRITTEN TO WORK-FILE AND IS-FILE
      *        NOTE-CDCS-REC DESCRIBES CURRENT AREA 
      *        SKIP-FLAG = SPACE
      *    IF ERROR AND REST OF AREA DESCRIPTION ENTRY MUST BE SKIPPED
      *        SKIP-FLAG = "S"
      * 
      ******************************************************************
  
       AREA-DESC. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF END-SW IS EQUAL TO "E"
               GO TO SCH-END. 
           IF WORK-AREA IS NOT EQUAL TO "NAME"
               GO TO AREA-DESC-10.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF END-SW IS EQUAL TO "E"
               GO TO SCH-END. 
       AREA-DESC-10.
           IF WORK-AREA IS NOT EQUAL TO "IS"
               GO TO AREA-DESC-20.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF END-SW IS EQUAL TO "E"
               GO TO SCH-END. 
       AREA-DESC-20.
           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 "22" TO IS-ENTITY-TYPE. 
           MOVE SCHEMA-ORD TO IS-SCHEMA-ORDINAL.
           MOVE WORK-AREA TO IS-CDCS-NAME.
           START IS-FILE KEY IS EQUAL TO IS-ALTKEY
             INVALID KEY GO TO AREA-DESC-25.
           READ IS-FILE.
           IF IS-AREA-SSCH-ORDINAL IS EQUAL TO ZERO 
               MOVE MSG-60 TO STD-REPORT-REC
               PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT
               MOVE "S" TO SKIP-FLAG
               GO TO AREA-DESC-EXIT 
           END-IF.
       AREA-DESC-25.
           PERFORM WRITE-ENTITY THRU WRITE-ENTITY-EXIT. 
           MOVE OUT-CDCS-NAME TO AREA-NAME, NOTE-CDCS-NAME. 
           MOVE OUT-CATNAME TO AREA-CATNAME, NOTE-CATNAME.
           MOVE "22" TO NOTE-ENTRY-TYPE.
           MOVE ZERO TO NOTE-99-GROUP.
           MOVE "001" TO NOTE-CATEGORY-TYPE.
           MOVE 0 TO IS-AREA-SSCH-ORDINAL.
           MOVE "M" TO IS-AREA-MASTER.
           MOVE SPACES TO IS-AREA-XN-CATNAME. 
           WRITE IS-AREA-REC. 
           PERFORM WRITE-SCHS THRU WRITE-SCHS-EXIT. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF END-SW IS EQUAL TO "E"
               GO TO SCH-END. 
           IF WORK-AREA IS EQUAL TO "." 
               SET PER-FOUND TO TRUE
               GO TO AREA-DESC-PER-EXIT 
           END-IF.
       AREA-DESC-30.
           IF WORK-AREA IS EQUAL TO "CALL"
               MOVE SPACE TO PERIOD-FLAG
               PERFORM AREA-CALL THRU AREA-CALL-EXIT
               IF END-SW IS EQUAL TO "E"
                   GO TO SCH-END
               END-IF 
               IF PER-FOUND 
                   GO TO AREA-DESC-PER-EXIT 
               ELSE 
                   GO TO AREA-DESC-30 
               END-IF 
           END-IF.
           IF WORK-AREA IS EQUAL TO "ACCESS-CONTROL"
               MOVE SPACE TO PERIOD-FLAG
               PERFORM AREA-ACCESS THRU AREA-ACCESS-EXIT
               IF END-SW IS EQUAL TO "E"
                   GO TO SCH-END
               END-IF 
               IF PER-FOUND 
                   GO TO AREA-DESC-PER-EXIT 
               ELSE 
                   GO TO AREA-DESC-30 
               END-IF 
           END-IF.
           MOVE MSG-10 TO STD-REPORT-REC. 
           PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT. 
       AREA-DESC-PER-EXIT.
           IF PER-FOUND 
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
       AREA-DESC-EXIT.
           EXIT.
  
      ******************************************************************
      * 
      *    CHECK-SUB THRU CHECK-EXIT
      * 
      *    SCAN CHECK CLAUSE.  WRITE OUT-ELEV-CHECKBY-REC.
      *    WRITE OUT-ELEP-REC, IF NECESSARY.
      *    CALL DBPROC TO WRITE OUT-REC FOR DBPROC, IF NECESSARY. 
      *    CALL CHECK-VALUE TO PROCESS VALUES IF NECESSARY. 
      * 
      *    ON INPUT 
      *    WORK-AREA = "CHECK"
      *    LEVEL-TABLE, LV-SUB SET UP 
      * 
      *    ON OUTPUT
      *    PRO-VAL = "P"
      *    WORK-AREA = 1ST TOKEN AFTER CHECK CLAUSE.
      *    A TOKEN WHICH IS NOT A PERIOD OR A KEYWORD IN THE DATA 
      *    DESCRIPTION ENTRY IS ASSUMED TO BE THE NAME OF A DBP.
      *    THE FIRST TIME "PICTURE" IS ENCOUNTERED, IT IS PART OF 
      *    THE CHECK CLAUSE.  IF IT IS ENCOUNTERED A SECOND TIME, 
      *    IT STARTS THE PICTURE CLAUSE.
      * 
      ******************************************************************
  
       CHECK-SUB. 
           MOVE "P" TO PRO-VAL. 
           MOVE SPACES TO CHECKBY, PIC-FOUND. 
           MOVE 1 TO CHK-SUB. 
           MOVE "E" TO LEVT-GRP-ELE (LV-SUB). 
           ADD 1 TO STRUCT-COUNT. 
           MOVE STRUCT-COUNT TO SAVE-STRUCT-COUNT.
           IF ENTITY-WRITTEN IS EQUAL TO SPACE
               PERFORM WRITE-ELEMENT-PRO-VAL THRU 
                 WRITE-ELEMENT-PRO-VAL-EXIT.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
             OR WORK-AREA IS EQUAL TO "." 
               GO TO CHECK-EXIT.
           IF WORK-AREA IS NOT EQUAL TO "IS"
               GO TO CHECK-20.
       CHECK-10.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF CHK-SUB IS GREATER THAN 10
               GO TO CHECK-30.
       CHECK-20.
           IF EOF 
             OR WORK-AREA IS EQUAL TO "." 
               GO TO CHECK-30.
           IF WORK-AREA IS EQUAL TO "PICTURE" 
             OR WORK-AREA IS EQUAL TO "PIC" 
               IF PIC-FOUND IS EQUAL TO "P" 
                   GO TO CHECK-30 
               END-IF 
               MOVE "P" TO PIC-FOUND
               IF CHK-SUB IS EQUAL TO 1 
                   MOVE "PIC" TO CHECKBY
                   ADD 3 TO CHK-SUB 
               ELSE 
                   MOVE "/PIC" TO CHECKBY (CHK-SUB : 4) 
                   ADD 4 TO CHK-SUB 
               END-IF 
               GO TO CHECK-10 
           END-IF.
           IF WORK-AREA IS EQUAL TO "VALUE" 
               PERFORM CHECK-VALUE THRU CHECK-VALUE-EXIT
               GO TO CHECK-20 
           END-IF.
           IF WORK-AREA IS EQUAL TO "TYPE"
             OR WORK-AREA IS EQUAL TO "OCCURS"
             OR WORK-AREA IS EQUAL TO "IS"
             OR WORK-AREA IS EQUAL TO "ACTUAL"
             OR WORK-AREA IS EQUAL TO "VIRTUAL" 
             OR WORK-AREA IS EQUAL TO "CHECK" 
             OR WORK-AREA IS EQUAL TO "FOR" 
             OR WORK-AREA IS EQUAL TO "ENCODING"
             OR WORK-AREA IS EQUAL TO "DECODING"
             OR WORK-AREA IS EQUAL TO "CALL"
               GO TO CHECK-30.
           IF CHK-SUB IS EQUAL TO 1 
               MOVE "PROC" TO CHECKBY 
               ADD 4 TO CHK-SUB 
           ELSE 
               MOVE "/PROC" TO CHECKBY (CHK-SUB : 5)
               ADD 5 TO CHK-SUB 
           END-IF.
           PERFORM DBPROC THRU DBPROC-EXIT. 
           MOVE EALIASOF-FLAG TO OUT-EALIASOF-FLAG. 
           MOVE EALIASOF TO OUT-EALIASOF-NAME.
           MOVE "05" TO OUT-ENTRY-TYPE. 
           MOVE ZERO TO OUT-99-GROUP. 
           MOVE LEVT-CATNAME (LV-SUB) TO OUT-CATNAME. 
           MOVE "400" TO OUT-CATEGORY-TYPE. 
           ADD 1 TO STRUCT-COUNT. 
           MOVE STRUCT-COUNT TO OUT-STCR. 
           MOVE DATA-NAME TO OUT-CDCS-NAME. 
           MOVE "05" TO OUT-FIELD-TYPE. 
           MOVE SPACES TO OUT-FILLER. 
           MOVE IS-CATNAME TO OUT-ELEP-DBPROC.
           MOVE "CH" TO OUT-ELEP-TYPEPROC.
           CALL "WRKFOUT".
           GO TO CHECK-10.
       CHECK-30.
           MOVE SPACES TO OUT-FILLER. 
           MOVE EALIASOF-FLAG TO OUT-EALIASOF-FLAG. 
           MOVE EALIASOF TO OUT-EALIASOF-NAME.
           MOVE "05" TO OUT-ENTRY-TYPE. 
           MOVE ZERO TO OUT-99-GROUP. 
           MOVE LEVT-CATNAME (LV-SUB) TO OUT-CATNAME. 
           MOVE "110" TO OUT-CATEGORY-TYPE. 
           MOVE SAVE-STRUCT-COUNT TO OUT-STCR.
           MOVE DATA-NAME TO OUT-CDCS-NAME. 
           MOVE "20" TO OUT-FIELD-TYPE. 
           MOVE CHECKBY TO OUT-ELEV-CHECKBY.
           CALL "WRKFOUT".
       CHECK-EXIT.
           EXIT.
  
  
      ******************************************************************
      * 
      *    CHECK-VALUE THRU CHECK-VALUE-EXIT
      * 
      *    SCAN VALUES WITHIN CHECK CLAUSE.  WRITE OUT-ELEV-CKVAL-REC.
      * 
      *    ON INPUT 
      *    WORK-AREA = "VALUE"
      *    CHK-SUB, CHECKBY SET UP
      *    LEVEL-TABLE, LV-SUB SET UP 
      * 
      *    ON OUTPUT
      *    WORK-AREA IS 1ST TOKEN WHICH IS NOT A VALUE. A VALUE IS
      *      A LITERAL SURROUNDED BY QUOTES OR A NUMBER.
      *    CHK-SUB, CHECKBY UPDATED.
      *    OUT-ELEV-CKVAL-REC WRITTEN FOR EVERY VALUE OR PAIR OF VALUES 
      * 
      ******************************************************************
  
       CHECK-VALUE. 
           MOVE EALIASOF-FLAG TO OUT-EALIASOF-FLAG. 
           MOVE EALIASOF TO OUT-EALIASOF-NAME.
           MOVE "05" TO OUT-ENTRY-TYPE. 
           MOVE ZERO TO OUT-99-GROUP. 
           MOVE LEVT-CATNAME (LV-SUB) TO OUT-CATNAME. 
           MOVE "110" TO OUT-CATEGORY-TYPE. 
           MOVE DATA-NAME TO OUT-CDCS-NAME. 
           MOVE "25" TO OUT-FIELD-TYPE. 
           MOVE SPACES TO OUT-FILLER. 
           IF CHK-SUB IS EQUAL TO 1 
               MOVE "VAL" TO CHECKBY
               ADD 3 TO CHK-SUB 
           ELSE 
               MOVE "/VAL" TO CHECKBY (CHK-SUB : 4) 
               ADD 4 TO CHK-SUB 
           END-IF.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF WORK-AREA IS EQUAL TO "NOT" 
               MOVE "N" TO CHECKBY (CHK-SUB : 1)
               ADD 1 TO CHK-SUB 
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
           END-IF.
       CHECK-VALUE-10.
           IF EOF 
             OR WORK-AREA IS EQUAL TO "." 
               GO TO CHECK-VALUE-EXIT.
           IF WORKA (1) IS LESS THAN "0"
             OR WORKA (1) IS GREATER THAN "9" 
               IF WORKA (1) IS EQUAL TO "+" 
                 OR WORKA (1) IS EQUAL TO "-" 
                 OR WORKA (1) IS EQUAL TO QUOTE 
                   GO TO CHECK-VALUE-20 
               END-IF 
               GO TO CHECK-VALUE-EXIT 
           END-IF.
       CHECK-VALUE-20.
           ADD 1 TO STRUCT-COUNT. 
           MOVE STRUCT-COUNT TO OUT-STCR. 
           MOVE WORK-AREA TO OUT-ELEV-CKVAL.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF WORK-AREA IS NOT EQUAL TO "THRU"
               MOVE SPACES TO OUT-ELEV-THRUVAL
               CALL "WRKFOUT" 
               GO TO CHECK-VALUE-10 
           END-IF.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
             OR WORK-AREA IS EQUAL TO "." 
               MOVE SPACES TO OUT-ELEV-THRUVAL
           ELSE 
               MOVE WORK-AREA TO OUT-ELEV-THRUVAL 
           END-IF.
           CALL "WRKFOUT".
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           GO TO CHECK-VALUE-10.
       CHECK-VALUE-EXIT.
           EXIT.
  
      ******************************************************************
      * 
      *    CIDEN THRU CIDEN-EXIT
      * 
      *    SCAN DATA NAME AND ITS OPTIONAL QUALIFIER MAKING UP
      *    CONCATENATED KEY.  WRITE OUT-AREAK-CCKEY-REC.
      * 
      *    ON INPUT 
      *    WORK-AREA = DATA-NAME
      * 
      *    ON OUTPUT
      *    IF NO ERROR
      *        WORK-AREA = 1ST TOKEN AFTER DATA-NAME OR ITS QUALIFIER 
      *        OUT-AREAK-CCKEY-REC WRITTEN TO WRKFILE 
      *        SKIP-FLAG = SPACE
      *    IF ERROR AND THE REST OF THE AREA CONTROL ENTRY MUST BE
      *      SKIPPED
      *        SKIP-FLAG = "S"
      * 
      ******************************************************************
  
       CIDEN. 
           MOVE SPACE TO CATNAME-MAY-BE-GROUP.
           PERFORM QUALIFY-SUB THRU QUALIFY-EXIT. 
           IF SKIP-FLAG IS EQUAL TO "S" 
               GO TO CIDEN-EXIT.
           MOVE SPACES TO OUT-FILLER. 
           MOVE FIND-CATNAME TO OUT-AREAK-CIDEN.
           MOVE FIND-ALIAS TO OUT-AREAK-CALIAS. 
           MOVE FIND-RECORD-CATNAME TO OUT-AREAK-CQUAL. 
           ADD 1 TO STRUCT-COUNT. 
           MOVE STRUCT-COUNT TO OUT-STCR. 
           CALL "WRKFOUT".
       CIDEN-EXIT.
           EXIT.
  
      ******************************************************************
      * 
      *    CODING-SUB THRU CODING-EXIT
      * 
      *    SCAN ENCODING/DECODING CLAUSE.  IF ELEMENT ENTITY NOT WRITTEN
      *    CALL WRITE-ELEMENT-PRO-VAL TO WRITE ENTITY.
      *    CALL DBPROC TO WRITE DBPROC ENTITY, IF NECESSARY.
      *    WRITE OUT-ELEP-REC.
      * 
      *    ON INPUT 
      *    WORK-AREA = "ENCODING" OR "DECODING" 
      *    DATA-NAME = NAME OF ELEMENT
      * 
      *    ON OUTPUT
      *    ENTITY-WRITTEN = "W" 
      *    HOLD-IS-PKEY SET UP
      *    EALIASOF-FLAG SET UP 
      *    OUT-REC WRITTEN FOR ELEMENT, DBPROC
      *    OUT-ELEP-REC WRITTEN 
      *    WORK-AREA = 1ST TOKEN AFTER ENCODING/DECODING CLAUSE 
      * 
      ******************************************************************
  
       CODING-SUB.
           MOVE "P" TO PRO-VAL. 
           IF ENTITY-WRITTEN IS EQUAL TO SPACE
               PERFORM WRITE-ELEMENT-PRO-VAL THRU 
                 WRITE-ELEMENT-PRO-VAL-EXIT.
           IF WORK-AREA IS EQUAL TO "ENCODING"
               MOVE "EC" TO TYPEPROC
           ELSE 
               MOVE "DC" TO TYPEPROC
           END-IF.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
             OR WORK-AREA IS EQUAL TO "." 
               GO TO CODING-EXIT. 
           IF WORK-AREA IS NOT EQUAL TO "ALWAYS"
               GO TO CODING-10. 
           MOVE "A" TO TYPEPROC (2 : 1).
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
             OR WORK-AREA IS EQUAL TO "." 
               GO TO CODING-EXIT. 
       CODING-10. 
           IF WORK-AREA IS NOT EQUAL TO "CALL"
               MOVE MSG-145 TO STD-REPORT-REC 
               PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT
               MOVE "S" TO SKIP-FLAG
               GO TO CODING-EXIT
           END-IF.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
             OR WORK-AREA IS EQUAL TO "." 
               GO TO CODING-EXIT. 
           PERFORM DBPROC THRU DBPROC-EXIT. 
           MOVE EALIASOF-FLAG TO OUT-EALIASOF-FLAG. 
           MOVE EALIASOF TO OUT-EALIASOF-NAME.
           MOVE "05" TO OUT-ENTRY-TYPE. 
           MOVE ZERO TO OUT-99-GROUP. 
           MOVE LEVT-CATNAME (LV-SUB) TO OUT-CATNAME. 
           MOVE "400" TO OUT-CATEGORY-TYPE. 
           ADD 1 TO STRUCT-COUNT. 
           MOVE STRUCT-COUNT TO OUT-STCR. 
           MOVE DATA-NAME TO OUT-CDCS-NAME. 
           MOVE "05" TO OUT-FIELD-TYPE. 
           MOVE SPACES TO OUT-FILLER. 
           MOVE IS-CATNAME TO OUT-ELEP-DBPROC.
           MOVE TYPEPROC TO OUT-ELEP-TYPEPROC.
           CALL "WRKFOUT".
           MOVE "E" TO LEVT-GRP-ELE (LV-SUB). 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
       CODING-EXIT. 
           EXIT.
  
      ******************************************************************
      * 
      *    COMMENTER THRU COMMENTER-EXIT
      * 
      *    SPACE OVER COMMENTS.   CALL WRITE-NOTE TO WRITE COMMENTS 
      *    TO WRKFILE.
      * 
      *    ON INPUT 
      *    SCH-LINE (IN-SUB) = 1ST CHARACTER AFTER "/*" 
      * 
      *    ON OUTPUT
      *    SCH-LINE (IN-SUB) = 1ST CHARACTER AFTER "*/" 
      *    COMMENT HAS BEEN PROCESSED 
      * 
      ******************************************************************
       COMMENTER. 
           MOVE 1 TO CMT-SUB. 
           MOVE SPACES TO COMMENT-AREA. 
       COMMENT-10.
           IF SCH-IN (IN-SUB : 2) EQUAL TO "*/" 
               GO TO COMMENT-30.
       COMMENT-20.
           MOVE SCH-LINE (IN-SUB) TO COMMENT-A (CMT-SUB). 
           ADD 1 TO CMT-SUB.
           IF CMT-SUB IS GREATER THAN 66
               PERFORM WRITE-NOTE THRU WRITE-NOTE-EXIT
               MOVE 1 TO CMT-SUB
               MOVE SPACES TO COMMENT-AREA
           END-IF.
           ADD 1 TO IN-SUB. 
           IF IN-SUB IS GREATER THAN 72 
               PERFORM READ-SCHFIL THRU READ-SCHFIL-EXIT
               IF END-SW IS EQUAL TO "E"
                   IF CMT-SUB IS NOT EQUAL TO 1 
                       PERFORM WRITE-NOTE THRU WRITE-NOTE-EXIT
                   END-IF 
                   GO TO COMMENTER-EXIT 
               END-IF 
           END-IF.
           GO TO COMMENT-10.
       COMMENT-30.
           IF CMT-SUB IS NOT EQUAL TO 1 
               PERFORM WRITE-NOTE THRU WRITE-NOTE-EXIT
           END-IF.
           ADD 2 TO IN-SUB. 
           IF IN-SUB IS GREATER THAN 72 
               PERFORM READ-SCHFIL THRU READ-SCHFIL-EXIT
           END-IF.
       COMMENTER-EXIT.
           EXIT.
  
      ******************************************************************
      * 
      *    COMPRESSION THRU COMPRESSION-EXIT. 
      * 
      *    SCANS COMPRESSION/DECOMPRESSION CLAUSE, WRITES 
      *    OUT-ELEP-REC TO WORK-FILE.  CALLS DBPROC TO WRITE
      *    OUT-REC FOR DBPROC IF NECESSARY. 
      * 
      *    ON INPUT 
      *    WORK-AREA = "COMPRESSION" OR "DECOMPRESSION" 
      *    AREA-NAME, AREA-CATNAME SET UP 
      * 
      *    ON OUTPUT
      *    IF NO ERROR
      *        WORK-AREA = 1ST TOKEN AFTER COMPRESSION/DECOMPRESSION
      *          CLAUSE 
      *        OUT-ELEP-REC WRITTEN TO WORK-FILE. 
      *        OUT-REC FOR DBPROC WRITTEN.
      *        SKIP-FLAG = SPACE
      *    IF ERROR AND REST OF AREA CONTROL ENTRY MUST BE SKIPPED
      *        SKIP-FLAG = "S"
      * 
      ******************************************************************
  
       COMPRESSION. 
           MOVE SPACE TO REPEAT-COMPRESSION, OUT-FILLER.
           IF WORK-AREA = "COMPRESSION" 
               MOVE "CP" TO COMPRESSION-TYPE
           ELSE 
               MOVE "DP" TO COMPRESSION-TYPE
           END-IF.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
               GO TO SCH-END. 
           IF WORK-AREA IS EQUAL TO "." 
               GO TO COMPRESSION-EXIT.
           IF (WORK-AREA IS EQUAL TO "COMPRESSION"
             AND COMPRESSION-TYPE IS EQUAL TO "DP") 
             OR (WORK-AREA IS EQUAL TO "DECOMPRESSION"
             AND COMPRESSION-TYPE IS EQUAL TO "CP") 
               MOVE "R" TO REPEAT-COMPRESSION 
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               IF EOF 
                   GO TO SCH-END
               END-IF 
               IF WORK-AREA IS EQUAL TO "." 
                   GO TO COMPRESSION-EXIT 
               END-IF 
           END-IF.
           IF WORK-AREA IS NOT EQUAL TO "USE" 
               GO TO COMPRESSION-10.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
               GO TO SCH-END. 
           IF WORK-AREA IS EQUAL TO "." 
               GO TO COMPRESSION-EXIT.
       COMPRESSION-10.
           IF WORK-AREA IS EQUAL TO "SYSTEM"
               MOVE "SYSTEM" TO OUT-ELEP-DBPROC 
               GO TO COMPRESSION-30 
           END-IF.
           IF WORK-AREA IS NOT EQUAL TO "PROCEDURE" 
               MOVE MSG-150 TO STD-REPORT-REC 
               PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT
               MOVE "S" TO SKIP-FLAG
               GO TO COMPRESSION-EXIT 
           END-IF.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
               GO TO SCH-END. 
           IF WORK-AREA IS EQUAL TO "." 
               GO TO COMPRESSION-EXIT.
           PERFORM DBPROC THRU DBPROC-EXIT. 
           MOVE IS-CATNAME TO OUT-ELEP-DBPROC.
       COMPRESSION-30.
           MOVE "22" TO OUT-ENTRY-TYPE. 
           MOVE ZERO TO OUT-99-GROUP. 
           MOVE AREA-CATNAME TO OUT-CATNAME.
           MOVE "400" 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 COMPRESSION-TYPE TO OUT-ELEP-TYPEPROC.
           CALL "WRKFOUT".
           IF REPEAT-COMPRESSION IS EQUAL TO "R"
               IF COMPRESSION-TYPE IS EQUAL TO "CP" 
                   MOVE "DP" TO OUT-ELEP-TYPEPROC 
               ELSE 
                   MOVE "CP" TO OUT-ELEP-TYPEPROC 
               END-IF 
               ADD 1 TO STRUCT-COUNT
               MOVE STRUCT-COUNT TO OUT-STCR
               CALL "WRKFOUT" 
           END-IF.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
       COMPRESSION-EXIT.
           EXIT.
  
      ******************************************************************
      * 
      *    CONSTRAINT THRU CONSTRAINT-EXIT. 
      * 
      *    SCANS CONSTRAINT ENTRY AND WRITES OUT-SCHB-REC TO WORK-FILE
      * 
      *    ON INPUT 
      *    WORK-AREA = "CONSTRAINT" 
      *    SCHEMA-NAME, SCHEMA-CATNAME SET UP 
      * 
      *    ON OUTPUT
      *    IF NO ERROR
      *        WORK-AREA = 1ST TOKEN AFTER CONSTRAINT NAME CLAUSE 
      *        OUT-SCHS-REC WRITTEN TO WORK-FILE. 
      *        SKIP-FLAG = SPACE
      *    IF ERROR AND REST OF CONSTRAINT ENTRY MUST BE SKIPPED
      *        SKIP-FLAG = "S"
      * 
      ******************************************************************
  
       CONSTRAINT.
           MOVE SPACES TO OUT-FILLER. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
             OR WORK-AREA IS EQUAL TO "." 
               GO TO CONSTRAINT-EXIT. 
           IF WORK-AREA IS NOT EQUAL TO "NAME"
               GO TO CONSTRAINT-10. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
             OR WORK-AREA IS EQUAL TO "." 
               GO TO CONSTRAINT-EXIT. 
       CONSTRAINT-10. 
           IF WORK-AREA IS NOT EQUAL TO "IS"
               GO TO CONSTRAINT-20. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
             OR WORK-AREA IS EQUAL TO "." 
               GO TO CONSTRAINT-EXIT. 
       CONSTRAINT-20. 
           MOVE WORK-AREA TO OUT-SCHB-CONNAME.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
             OR WORK-AREA IS EQUAL TO "." 
               GO TO CONSTRAINT-EXIT. 
           MOVE WORK-AREA TO FIND-DATA-NAME.
           MOVE SPACES TO FIND-RECORD-NAME. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF WORK-AREA IS EQUAL TO "OF"
             OR WORK-AREA IS EQUAL TO "IN"
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               IF NOT EOF 
                 AND WORK-AREA IS NOT EQUAL TO "."
                   MOVE WORK-AREA TO FIND-RECORD-NAME 
                   PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               END-IF 
           END-IF.
           MOVE "G" TO CATNAME-MAY-BE-GROUP.
           PERFORM SEARCH-FOR-CATNAME THRU SEARCH-FOR-CATNAME-EXIT. 
           IF FIND-CATNAME IS EQUAL TO SPACE
               MOVE FIND-DATA-NAME TO OUT-SCHB-CNAME
           ELSE 
               MOVE FIND-CATNAME TO OUT-SCHB-CNAME
           END-IF.
           MOVE FIND-ALIAS TO OUT-SCHB-CALIAS.
           MOVE FIND-RECORD-CATNAME TO OUT-SCHB-AOFREC. 
           IF WORK-AREA IS NOT EQUAL TO "DEPENDS" 
               MOVE MSG-120 TO STD-REPORT-REC 
               PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT
               MOVE "S" TO SKIP-FLAG
               GO TO CONSTRAINT-EXIT
           ELSE 
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               IF EOF 
                   GO TO CONSTRAINT-EXIT
               END-IF 
           END-IF.
           IF WORK-AREA IS NOT EQUAL TO "ON"
               GO TO CONSTRAINT-30. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
               GO TO CONSTRAINT-EXIT. 
       CONSTRAINT-30. 
           MOVE WORK-AREA TO FIND-DATA-NAME.
           MOVE SPACES TO FIND-RECORD-NAME. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF WORK-AREA IS EQUAL TO "OF"
             OR WORK-AREA IS EQUAL TO "IN"
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               IF NOT EOF 
                 AND WORK-AREA IS NOT EQUAL TO "."
                   MOVE WORK-AREA TO FIND-RECORD-NAME 
                   PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               END-IF 
           END-IF.
           MOVE "G" TO CATNAME-MAY-BE-GROUP.
           PERFORM SEARCH-FOR-CATNAME THRU SEARCH-FOR-CATNAME-EXIT. 
           MOVE "26" TO OUT-ENTRY-TYPE. 
           MOVE SPACES TO OUT-EALIASOF-FLAG, OUT-EALIASOF-NAME. 
           MOVE ZERO TO OUT-99-GROUP. 
           MOVE SCHEMA-CATNAME TO OUT-CATNAME.
           MOVE "550" 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".
           MOVE SPACES TO OUT-FILLER. 
           ADD 1 TO STRUCT-COUNT. 
           MOVE STRUCT-COUNT TO OUT-STCR. 
           MOVE "10" TO OUT-FIELD-TYPE. 
           IF FIND-CATNAME IS EQUAL TO SPACE
               MOVE FIND-DATA-NAME TO OUT-SCHB-DEPENDS
           ELSE 
               MOVE FIND-CATNAME TO OUT-SCHB-DEPENDS
           END-IF.
           MOVE FIND-ALIAS TO OUT-SCHB-DALIAS.
           MOVE FIND-RECORD-CATNAME TO OUT-SCHB-BOFREC. 
           CALL "WRKFOUT".
           IF EOF 
               GO TO CONSTRAINT-EXIT. 
           IF WORK-AREA IS NOT EQUAL TO "." 
               MOVE MSG-10 TO STD-REPORT-REC
               PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT
           ELSE 
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
           END-IF.
       CONSTRAINT-EXIT. 
           EXIT.
  
      ******************************************************************
      * 
      *    DATA-CALL THRU DATA-CALL-EXIT. 
      * 
      *    SCANS CALL CLAUSE OF DATA DESCRIPTION ENTRY
      *    AND WRITES OUT-ELEP-REC TO WRKFILE. CALLS DBPROC 
      *    TO WRITE OUT-REC FOR DBPROC IF NECESSARY.
      * 
      *    ON INPUT 
      *    WORK-AREA = "CALL" 
      *    LEVEL-TABLE, LV-SUB, ENTITY-WRITTEN SET UP 
      * 
      *    ON OUTPUT
      *    PRO-VAL = "P"
      *    ENTITY-WRITTEN = "W" 
      *    IF PERIOD ENDED CALL CLAUSE
      *        WORK-AREA = "."
      *        PER-FOUND = TRUE 
      *    IF PERIOD DID NOT END CALL CLAUSE
      *        WORK-AREA = 1ST TOKEN AFTER CALL CLAUSE
      *    OUT-ELEP-REC WRITTEN TO WORK-FILE
      *    IF NEW DBPROC ENCOUNTERED, OUT-REC FOR DBPROC
      *    WRITTEN TO WORK-FILE.
      * 
      ******************************************************************
  
       DATA-CALL. 
           MOVE "P" TO PRO-VAL. 
           MOVE "E" TO LEVT-GRP-ELE (LV-SUB). 
           IF ENTITY-WRITTEN IS EQUAL TO SPACE
               PERFORM WRITE-ELEMENT-PRO-VAL THRU 
                 WRITE-ELEMENT-PRO-VAL-EXIT.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF END-SW IS EQUAL TO "E"
               GO TO SCH-END. 
           PERFORM DBPROC THRU DBPROC-EXIT. 
           MOVE "05" TO OUT-ENTRY-TYPE. 
           MOVE EALIASOF-FLAG TO OUT-EALIASOF-FLAG. 
           MOVE ZERO TO OUT-99-GROUP. 
           MOVE LEVT-CATNAME (LV-SUB) TO OUT-CATNAME. 
           MOVE "400" TO OUT-CATEGORY-TYPE. 
           ADD 1 TO STRUCT-COUNT. 
           MOVE STRUCT-COUNT TO OUT-STCR. 
           MOVE DATA-NAME TO OUT-CDCS-NAME. 
           MOVE "05" TO OUT-FIELD-TYPE. 
           MOVE SPACES TO OUT-FILLER. 
           MOVE EALIASOF TO OUT-EALIASOF-NAME.
           MOVE IS-CATNAME TO OUT-ELEP-DBPROC.
           MOVE "CA" TO OUT-ELEP-TYPEPROC.
           MOVE 1 TO DATA-SUB.
       DATA-CALL-TIME.
           IF DATA-SUB IS GREATER THAN 4
               MOVE 1 TO DATA-SUB 
               GO TO DATA-CALL-OPTION-10
           END-IF.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF END-SW IS EQUAL TO "E"
               GO TO DATA-CALL-WRITE-EXIT.
       DATA-CALL-TIME-10. 
           IF WORK-AREA IS EQUAL TO "BEFORE"
               IF DATA-SUB IS EQUAL TO 1
                   MOVE "B" TO OUT-ELEP-TIME
                   ADD 1 TO DATA-SUB
               ELSE 
                   MOVE "/B" TO OUT-ELEP-TIME (DATA-SUB : 2)
                   ADD 2 TO DATA-SUB
               END-IF 
               GO TO DATA-CALL-TIME 
           END-IF.
           IF WORK-AREA IS EQUAL TO "AFTER" 
               IF DATA-SUB IS EQUAL TO 1
                   MOVE "A" TO OUT-ELEP-TIME
                   ADD 1 TO DATA-SUB
               ELSE 
                   MOVE "/A" TO OUT-ELEP-TIME (DATA-SUB : 2)
                   ADD 2 TO DATA-SUB
               END-IF 
               GO TO DATA-CALL-TIME 
           END-IF.
           IF WORK-AREA IS EQUAL TO "ON"
               GO TO DATA-CALL-TIME.
           IF WORK-AREA IS EQUAL TO "ERROR" 
               IF DATA-SUB IS EQUAL TO 1
                   MOVE "E" TO OUT-ELEP-TIME
                   ADD 1 TO DATA-SUB
               ELSE 
                   MOVE "/E" TO OUT-ELEP-TIME (DATA-SUB : 2)
                   ADD 2 TO DATA-SUB
               END-IF 
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               IF END-SW IS EQUAL TO "E"
                   GO TO DATA-CALL-WRITE-EXIT 
               END-IF 
               IF WORK-AREA IS EQUAL TO "DURING"
                   GO TO DATA-CALL-TIME 
               ELSE 
                   IF DATA-SUB IS NOT GREATER THAN 4
                       GO TO DATA-CALL-TIME-10
                   END-IF 
               END-IF 
           END-IF.
           IF DATA-SUB IS EQUAL TO 1
               MOVE MSG-20 TO STD-REPORT-REC
               PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT
           END-IF.
       DATA-CALL-OPTION.
           IF WORK-AREA IS EQUAL TO "." 
               SET PER-FOUND TO TRUE
               GO TO DATA-CALL-WRITE-EXIT 
           END-IF.
           MOVE 1 TO DATA-SUB.
           GO TO DATA-CALL-OPTION-20. 
       DATA-CALL-OPTION-10. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF END-SW IS EQUAL TO "E"
               GO TO DATA-CALL-WRITE-EXIT.
           IF WORK-AREA IS EQUAL TO "." 
               SET PER-FOUND TO TRUE
               GO TO DATA-CALL-WRITE-EXIT 
           END-IF.
           IF DATA-SUB IS GREATER THAN 4
               GO TO DATA-CALL-WRITE-EXIT.
       DATA-CALL-OPTION-20. 
           IF WORK-AREA IS EQUAL TO "STORE" 
               IF DATA-SUB IS EQUAL TO 1
                   MOVE "S" TO OUT-ELEP-OPTION
                   ADD 1 TO DATA-SUB
               ELSE 
                   MOVE "/S" TO OUT-ELEP-OPTION (DATA-SUB : 2)
                   ADD 2 TO DATA-SUB
               END-IF 
               GO TO DATA-CALL-OPTION-10
           END-IF.
           IF WORK-AREA IS EQUAL TO "MODIFY"
               IF DATA-SUB IS EQUAL TO 1
                   MOVE "M" TO OUT-ELEP-OPTION
                   ADD 1 TO DATA-SUB
               ELSE 
                   MOVE "/M" TO OUT-ELEP-OPTION (DATA-SUB : 2)
                   ADD 2 TO DATA-SUB
               END-IF 
               GO TO DATA-CALL-OPTION-10
           END-IF.
           IF WORK-AREA IS EQUAL TO "GET" 
               IF DATA-SUB IS EQUAL TO 1
                   MOVE "G" TO OUT-ELEP-OPTION
                   ADD 1 TO DATA-SUB
               ELSE 
                   MOVE "/G" TO OUT-ELEP-OPTION (DATA-SUB : 2)
                   ADD 2 TO DATA-SUB
               END-IF 
               GO TO DATA-CALL-OPTION-10
           END-IF.
       DATA-CALL-WRITE-EXIT.
           CALL "WRKFOUT".
       DATA-CALL-EXIT.
           EXIT.
  
      ******************************************************************
      * 
      *    DATA-CONTROL THRU DATA-CONTROL-EXIT
      * 
      *    SCANS DATA CONTROL ENTRY. CALLS AREA-CONTROL FOR EACH
      *    AREA CONTROL ENTRY.
      * 
      *    ON INPUT 
      *    WORK-AREA = "DATA" 
      * 
      *    ON OUTPUT
      *    WORK-AREA = 1ST TOKEN AFTER DATA CONTROL ENTRY 
      * 
      ******************************************************************
  
       DATA-CONTROL.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
               GO TO SCH-END. 
           IF WORK-AREA IS NOT EQUAL TO "CONTROL" 
               MOVE MSG-70 TO STD-REPORT-REC
               PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT
               PERFORM SKIP-PAST-PERIOD THRU SKIP-PAST-PERIOD-EXIT
               GO TO DATA-CONTROL-10
           ELSE 
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               IF EOF 
                   GO TO SCH-END
               END-IF 
           END-IF.
           IF WORK-AREA IS NOT EQUAL TO "." 
               MOVE MSG-10 TO STD-REPORT-REC
               PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT
           ELSE 
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               IF EOF 
                   GO TO SCH-END
               END-IF 
           END-IF.
       DATA-CONTROL-10. 
           IF WORK-AREA IS EQUAL TO "AREA"
               PERFORM AREA-CONTROL THRU AREA-CONTROL-EXIT
               IF SKIP-FLAG IS EQUAL TO "S" 
                   PERFORM SKIP-PAST-PERIOD THRU SKIP-PAST-PERIOD-EXIT
               END-IF 
               IF EOF 
                   GO TO SCH-END
               ELSE 
                   GO TO DATA-CONTROL-10
               END-IF 
           END-IF.
       DATA-CONTROL-EXIT. 
           EXIT.
  
      ******************************************************************
      * 
      *    DATA-DESC THRU DATA-DESC-EXIT
      * 
      *    SCAN DATA DESCRIPTION ENTRY.  DETERMINE IF ELEMENT NAME IS 
      *    UNIQUE. IF NOT, DETERMINE IF DATA ITEM IS
      *    ELEMENT OR GROUP.  DETERMINE IF ELEMENT IS SAME AS A PREVIOUS
      *    ITEM (IN WHICH CASE THE OLD ITEM WILL BE USED), OR IF THE
      *    CURRENT ITEM IS ALIAS OF OR EALIASOF PREVIOUS ITEM.
      * 
      *    INITIALLY ASSUME AN ITEM IS A GROUP ITEM.  IF ANY CLAUSE 
      *    OTHER THAN "OCCURS" IS ENCOUNTERED, IT IS AN ELEMENT.
      *    IF AN ITEM WHICH WAS DETERMINED TO BE AN ELEMENT IS FOLLOWED 
      *    BY A SUBORDINATE ITEM, THE SUBORDINATE ITEM IS DIAGNOSED 
      *    TO HAVE AN INVALID LEVEL NUMBER AND IS SKIPPED.
      *    OUT-REC CANNOT BE WRITTEN UNTIL IT IS KNOWN WHETHER THE
      *    ITEM IS AN ELEMENT OR GROUP.  IF IT HAS PROCESS OR VALUE 
      *    INFO, AND OUT-REC HAS NOT BEEN WRITTEN, IT MUST BE 
      *    WRITTEN BEFORE THE RESULT... CLAUSE CAN BE PROCESSED.
      *    ATTRIBUTES ARE SAVED AND WRITTEN WHEN THE END OF THE ENTRY 
      *    IS ENCOUNTERED.
      * 
      *    MAINTAIN ALL PARENTS OF CURRENT DATA ITEM IN LEVEL-TABLE.
      *    LEV-TAB (1) DESCRIBES RECORD.  LEV-TAB (LV-SUB) DESCRIBES
      *    CURRENT ITEM.  LEV-TAB (LV-SUB-M1) DESCRIBES IMMEDIATE PARENT. 
      *    LEVT-LEVEL-NO (N) < LEVT-LEVEL-NO (N+1).  THIS TABLE IS USED 
      *    TO WRITE STRUCTURE RECORDS.
      * 
      *    ON INPUT 
      *    LEVEL-TABLE SET UP 
      *    LV-SUB = INDEX WITHIN LEVEL-TABLE OF PREVIOUS DATA ITEM
      *    WORK-AREA = 1ST TOKEN OF DATA DESCRIPTION ENTRY
      *        WHICH MAY BE LEVEL NUMBER OR DATA NAME 
      * 
      *    ON OUTPUT
      *    IF NO ERROR ENCOUNTERED
      *        WORK-AREA = "."
      *        NOTE-CDCS-REC DESCRIBES STRUCTURE CATEGORY OF ELEMENT'S
      *          PARENT 
      *        LEVEL-TABLE, LV-SUB UPDATED
      *        IF NECESSARY, OUT-REC OR OUT-ELEAL-REC WRITTEN 
      *        ALL NECESSARY ELEMENT RECORDS WRITTEN TO WRKFILE 
      *        SKIP-FLAG = SPACE
      *    IF ERROR AND REST OF DATA DESCRIPTION ENTRY MUST BE SKIPPED
      *        SKIP-FLAG = "S"
      * 
      ******************************************************************
  
       DATA-DESC. 
           PERFORM GET-LEVEL THRU GET-LEVEL-EXIT. 
           IF EOF 
             OR WORK-AREA IS EQUAL TO "." 
               GO TO DATA-DESC-EXIT.
           IF LEVEL-NO IS EQUAL TO LEVT-LEVEL-NO (LV-SUB) 
               GO TO DATA-DESC-03.
           IF LEVEL-NO IS GREATER THAN LEVT-LEVEL-NO (LV-SUB) 
               IF LEVT-GRP-ELE (LV-SUB) IS EQUAL TO "E" 
                   MOVE MSG-110 TO STD-REPORT-REC 
                   GO TO DATA-DESC-ERROR-SKIP 
               END-IF 
               IF LV-SUB IS GREATER THAN 10 
                   MOVE MSG-105 TO STD-REPORT-REC 
                   GO TO DATA-DESC-ERROR-SKIP 
               END-IF 
               MOVE LV-SUB TO LV-SUB-M1 
               ADD 1 TO LV-SUB
           ELSE 
               PERFORM VARYING LV-SUB FROM LV-SUB BY -1 
                 UNTIL LEVEL-NO IS NOT LESS THAN
                 LEVT-LEVEL-NO (LV-SUB) 
                   MOVE SPACES TO LEV-TAB (LV-SUB)
               END-PERFORM
               SUBTRACT 1 FROM LV-SUB GIVING LV-SUB-M1
           END-IF.
       DATA-DESC-03.
           IF LV-SUB IS EQUAL TO 2
               MOVE "13" TO NOTE-ENTRY-TYPE 
               MOVE 0 TO NOTE-99-GROUP
           ELSE 
               MOVE "10" TO NOTE-ENTRY-TYPE 
               SUBTRACT LEVT-LEVEL-NO (LV-SUB-M1) FROM
                 99 GIVING NOTE-99-GROUP
           END-IF.
           MOVE LEVT-CATNAME (LV-SUB-M1) TO NOTE-CATNAME. 
           MOVE "300" TO NOTE-CATEGORY-TYPE.
           MOVE LEVT-CDCS-NAME (LV-SUB-M1) TO NOTE-CDCS-NAME. 
           MOVE SPACES TO LEVT-CATNAME (LV-SUB).
           MOVE WORK-AREA TO LEVT-CDCS-NAME (LV-SUB), DATA-NAME.
           MOVE "G" TO LEVT-GRP-ELE (LV-SUB). 
           MOVE LEVEL-NO TO LEVT-LEVEL-NO (LV-SUB). 
           MOVE SPACES TO PRO-VAL, HOLD-ATTRIBUTE, OCCURS-TO, TALIAS, 
             ENTITY-WRITTEN.
           MOVE 0 TO ALIAS-NO.
       DATA-DESC-5. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
       DATA-DESC-10.
           IF EOF 
             OR WORK-AREA IS EQUAL TO "." 
               GO TO DATA-DESC-20.
           IF WORK-AREA IS EQUAL TO "PIC" 
             OR WORK-AREA IS EQUAL TO "PICTURE" 
               PERFORM PIC-SUB THRU PIC-EXIT
               IF SKIP-FLAG IS EQUAL TO "S" 
                   GO TO DATA-DESC-EXIT 
               ELSE 
                   GO TO DATA-DESC-10 
               END-IF 
           END-IF.
           IF WORK-AREA IS EQUAL TO "TYPE"
               PERFORM TYPE-SUB THRU TYPE-EXIT
               GO TO DATA-DESC-10 
           END-IF.
           IF WORK-AREA IS EQUAL TO "OCCURS"
               PERFORM OCCURS-SUB THRU OCCURS-EXIT
               IF SKIP-FLAG IS EQUAL TO "S" 
                   GO TO DATA-DESC-EXIT 
               ELSE 
                   GO TO DATA-DESC-10 
               END-IF 
           END-IF.
           IF WORK-AREA IS EQUAL TO "IS"
               GO TO DATA-DESC-5. 
           IF WORK-AREA IS EQUAL TO "ACTUAL"
             OR WORK-AREA IS EQUAL TO "VIRTUAL" 
               PERFORM RESULT-SUB THRU RESULT-EXIT
               IF SKIP-FLAG IS EQUAL TO "S" 
                   GO TO DATA-DESC-EXIT 
               ELSE 
                   GO TO DATA-DESC-10 
               END-IF 
           END-IF.
           IF WORK-AREA IS EQUAL TO "CHECK" 
               PERFORM CHECK-SUB THRU CHECK-EXIT
               GO TO DATA-DESC-10 
           END-IF.
           IF WORK-AREA IS EQUAL TO "FOR" 
               GO TO DATA-DESC-5. 
           IF WORK-AREA IS EQUAL TO "ENCODING"
             OR WORK-AREA IS EQUAL TO "DECODING"
               PERFORM CODING-SUB THRU CODING-EXIT
               IF SKIP-FLAG IS EQUAL TO "S" 
                   GO TO DATA-DESC-EXIT 
               ELSE 
                   GO TO DATA-DESC-10 
               END-IF 
           END-IF.
           IF WORK-AREA IS EQUAL TO "CALL"
               PERFORM DATA-CALL THRU DATA-CALL-EXIT
               GO TO DATA-DESC-10 
           END-IF.
           MOVE MSG-10 TO STD-REPORT-REC. 
           PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT. 
       DATA-DESC-20.
           IF ENTITY-WRITTEN IS EQUAL TO "W"
  
      *    THE DATA ITEM IS AN ELEMENT.  OUT-REC HAS ALREADY
      *    BEEN WRITTEN AS PART OF PROCESS OR VALUE PROCESSING
  
               MOVE HOLD-IS-REC TO IS-REC 
               MOVE EALIASOF-FLAG TO OUT-EALIASOF-FLAG
               MOVE EALIASOF TO OUT-EALIASOF-NAME 
               PERFORM WRITE-ELEMENT-ATT THRU 
                 WRITE-ELEMENT-ATT-EXIT 
               GO TO DATA-DESC-EXIT 
           END-IF.
           IF LEVT-GRP-ELE (LV-SUB) IS EQUAL TO "G" 
  
      *    THE DATA ITEM IS A GROUP.
  
               MOVE "10" TO IS-ENTITY-TYPE
               MOVE SCHEMA-ORD TO IS-SCHEMA-ORDINAL 
               MOVE DATA-NAME TO IS-CDCS-NAME 
               MOVE SPACES TO OUT-EALIASOF-FLAG, OUT-EALIASOF-NAME
               SUBTRACT LEVEL-NO FROM 99 GIVING OUT-99-GROUP
               ADD 1 TO STRUCT-COUNT
               MOVE STRUCT-COUNT TO OUT-STCR
               PERFORM WRITE-ENTITY THRU WRITE-ENTITY-EXIT
               MOVE IS-CATNAME TO LEVT-CATNAME (LV-SUB) 
               MOVE 0 TO IS-GRP-SSCH-ORDINAL
               MOVE LEVT-CATNAME (1) TO IS-GRP-RECORD-CATNAME 
               MOVE LEVT-CATNAME (LV-SUB-M1) TO IS-GRP-PARENT-CATNAME 
               MOVE LEVT-LEVEL-NO (LV-SUB) TO IS-GRP-LEVEL-NO 
               WRITE IS-GRP-REC 
               PERFORM WRITE-PARENT-STRUCTURE THRU
                 WRITE-PARENT-STRUCTURE-EXIT
               GO TO DATA-DESC-EXIT 
           END-IF.
           PERFORM SEARCH-FOR-ELEMENT THRU SEARCH-FOR-ELEMENT-EXIT. 
           IF NAME-FOUND IS EQUAL TO SPACE
  
      *    THE DATA ITEM IS AN ELEMENT WITH A UNIQUE NAME.
  
               MOVE SPACES TO OUT-EALIASOF-FLAG, OUT-EALIASOF-NAME
               MOVE ZERO TO ALIAS-NO
               PERFORM WRITE-ELEMENT-ATT THRU 
                 WRITE-ELEMENT-ATT-EXIT 
               GO TO DATA-DESC-EXIT 
           END-IF.
           IF NAME-FOUND-NO-PRO-VAL IS EQUAL TO SPACES
  
      *    THE DATA ITEM IS AN ELEMENT.  OLD ELEMENTS WITH THE SAME NAME
      *    AND WITH PROCESS OR VALUE INFO EXIST.  THE ITEM IS AN
      *    EALIASOF THE FIRST INSTANCE. 
  
               MOVE "E" TO OUT-EALIASOF-FLAG
               MOVE EALIASOF TO OUT-EALIASOF-NAME 
               MOVE ZERO TO ALIAS-NO
               PERFORM WRITE-ELEMENT-ATT
                 THRU WRITE-ELEMENT-ATT-EXIT
               GO TO DATA-DESC-EXIT 
           END-IF.
  
      *    THE DATA ITEM IS AN ELEMENT WITH NO PROCESS OR 
      *    VALUE INFO. AN OLD ELEMENT WITH THE SAME 
      *    NAME AND WITH NO PROCESS OR VALUE INFO EXISTS. 
  
           MOVE IS-CATNAME TO LEVT-CATNAME (LV-SUB).
           IF HOLD-ATTRIBUTE IS EQUAL TO IS-ELE-ATTRIBUTE 
  
      *    THE DATA ITEM IS THE SAME AS THE OLD ELEMENT.
  
               MOVE ZERO TO ALIAS-NO, IS-ALIAS-NO 
               MOVE SEQ-NO TO IS-SEQ-NO 
           END-IF.
           IF ALIAS-WITH-SAME-ATT IS NOT EQUAL TO ZERO
  
      *    THE DATA ITEM IS THE SAME AS AN OLD ALIAS OF OLD ELEMENT 
  
               MOVE ALIAS-WITH-SAME-ATT TO ALIAS-NO, IS-ALIAS-NO
               MOVE SEQ-NO TO IS-SEQ-NO 
           END-IF.
           PERFORM WRITE-PARENT-STRUCTURE THRU
               WRITE-PARENT-STRUCTURE-EXIT. 
           IF HOLD-ATTRIBUTE IS NOT EQUAL TO IS-ELE-ATTRIBUTE 
             AND ALIAS-WITH-SAME-ATT IS EQUAL TO ZERO 
  
      *    THE DATA ITEM IS THE ALIAS OF THE OLD ELEMENT. 
  
               MOVE "05" TO OUT-ENTRY-TYPE
               MOVE IS-ELE-EALIASOF-FLAG TO OUT-EALIASOF-FLAG 
               MOVE ZERO TO OUT-99-GROUP
               MOVE IS-CATNAME TO OUT-CATNAME 
               MOVE "211" TO OUT-CATEGORY-TYPE
               ADD 1 TO STRUCT-COUNT
               MOVE STRUCT-COUNT TO OUT-STCR
               MOVE DATA-NAME TO OUT-CDCS-NAME
               MOVE "05" TO OUT-FIELD-TYPE
               MOVE SPACES TO OUT-FILLER
               MOVE HOLD-ATTRIBUTE TO OUT-ELEAL-ATTRIBUTE 
               MOVE ALIAS-NO TO OUT-ELEAL-CATEGORY-LINE 
               MOVE SPACES TO OUT-ELEAL-ADATANAM
               CALL "WRKFOUT" 
               MOVE SEQ-NO TO IS-SEQ-NO 
               MOVE ALIAS-NO TO IS-ALIAS-NO 
           END-IF.
           MOVE ZERO TO IS-ELE-SSCH-ORDINAL 
           MOVE LEVT-CATNAME (1) TO IS-ELE-RECORD-CATNAME 
           MOVE LEVT-CATNAME (LV-SUB-M1) TO IS-ELE-PARENT-CATNAME 
           MOVE LEVT-LEVEL-NO (LV-SUB) TO IS-ELE-LEVEL-NO.
           MOVE HOLD-ATTRIBUTE TO IS-ELE-ATTRIBUTE
           MOVE SPACE TO IS-ELE-PRO-VAL, IS-ELE-EALIASOF-FLAG,
             IS-ELE-LEVEL88.
           WRITE IS-ELE-REC 
           GO TO DATA-DESC-EXIT.
       DATA-DESC-ERROR-SKIP.
           PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT. 
           MOVE "S" TO SKIP-FLAG. 
       DATA-DESC-EXIT.
           EXIT.
  
  
      ******************************************************************
      * 
      *    DBPROC THRU DBPROC-EXIT
      * 
      *    DETERMINES IF DBPROC ALREADY EXISTS ON ISFILE.  READS
      *    IS-REC IF IT EXISTS.  CREATES AND WRITES IS-REC AND
      *    OUT-REC IF IT DID NOT EXIST. 
      * 
      *    ON INPUT 
      *    WORK-AREA = PROCEDURE-NAME 
      * 
      *    ON OUTPUT
      *    IS-REC CONTAINS DBPROC ENTRY 
      *    IN PARTICULAR, IS-CATNAME = PROCEDURE CATNAME
      * 
      ******************************************************************
  
       DBPROC.
           MOVE "03" 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 DBPROC-10. 
           READ IS-FILE.
           GO TO DBPROC-EXIT. 
       DBPROC-10. 
           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. 
           PERFORM WRITE-ENTITY THRU WRITE-ENTITY-EXIT. 
           WRITE IS-REC.
       DBPROC-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-LEVEL THRU GET-LEVEL-EXIT
      * 
      *    SCAN CURRENT TOKEN FOR LEVEL NUMBER
      *    IF CURRENT TOKEN IS NOT LEVEL NUMBER, ASSUME LEVEL NUMBER
      *    IS 01
      * 
      *    ON INPUT 
      *    WORK-AREA = CURRENT TOKEN WHICH MAY OR MAY NOT BE LEVEL
      *      NUMBER 
      *    WK-SUB = NUMBER OF CHARACTERS IN CURRENT TOKEN 
      * 
      *    ON OUTPUT
      *    LEVEL-NO = LEVEL NUMBER
      *    WORK-AREA = DATA NAME
      * 
      ******************************************************************
  
       GET-LEVEL. 
           IF WK-SUB IS EQUAL TO 1
               IF WORKA (1) IS LESS THAN "0"
                 OR WORKA (1) IS GREATER THAN "9" 
                   GO TO LEVEL-NOT-SPECIFIED
               END-IF 
               MOVE "0" TO LEVEL-NO 
               MOVE WORKA (1) TO LEVEL-NO (2 : 1) 
               GO TO GET-LEVEL-10 
           END-IF.
           IF WK-SUB IS EQUAL TO 2
               IF WORKA (1) IS LESS THAN "0"
                 OR WORKA (1) IS GREATER THAN "9" 
                 OR WORKA (2) IS LESS THAN "0"
                 OR WORKA (2) IS GREATER THAN "9" 
                   GO TO LEVEL-NOT-SPECIFIED
               END-IF 
               MOVE WORK-AREA TO LEVEL-NO 
               GO TO GET-LEVEL-10 
           END-IF.
       LEVEL-NOT-SPECIFIED. 
           MOVE "01" TO LEVEL-NO. 
           GO TO GET-LEVEL-EXIT.
       GET-LEVEL-10.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
       GET-LEVEL-EXIT.
           EXIT.
  
      ******************************************************************
      * 
      *    GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
      * 
      *    GET THE NEXT TOKEN.
      * 
      *    ON INPUT 
      *    SCH-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. 
           PERFORM SCAN THRU SCAN-EXIT. 
       GET-NEXT-TOKEN-EXIT. 
           EXIT.
  
      ******************************************************************
      * 
      *    JOIN THRU JOIN-EXIT
      * 
      *    SCAN IDENTIFIER PAIR.  WRITE OUT-SCHJ-ID1-REC FOR
      *    FIRST AND SECOND IDENTIFIERS.
      * 
      *    ON INPUT 
      *    WORK-AREA = 1ST TOKEN OF 1ST IDENTIFIER OF PAIR
      * 
      *    ON OUTPUT
      *    IF NO ERROR
      *        WORK-AREA = 1ST TOKEN AFTER 2ND IDENTIFIER OF PAIR.
      *        OUT-SCHJ-ID1, WRITTEN TO WRKFILE FOR 1ST AND 2ND ID
      *        SKIP-FLAG = SPACE
      *    IF ERROR AND REST OF RELATION ENTRY MUST BE SKIPPED
      *        SKIP-FLAG = "S"
      * 
      ******************************************************************
  
       JOIN.
           MOVE SPACES TO OUT-FILLER. 
           PERFORM JOIN-IDEN THRU JOIN-IDEN-EXIT. 
           IF SKIP-FLAG IS EQUAL TO "S" 
               GO TO JOIN-EXIT. 
           IF WORK-AREA IS EQUAL TO "EQ"
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               IF EOF 
                   GO TO JOIN-EXIT
               END-IF 
           ELSE 
               MOVE MSG-125 TO STD-REPORT-REC 
               PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT
               MOVE "S" TO SKIP-FLAG
               GO TO JOIN-EXIT
           END-IF.
           ADD 1 TO STRUCT-COUNT. 
           MOVE STRUCT-COUNT TO OUT-STCR. 
           MOVE "10" TO OUT-FIELD-TYPE. 
           MOVE FIND-ALIAS TO OUT-SCHJ-I1ALIAS. 
           MOVE FIND-RECORD-CATNAME TO OUT-SCHJ-I1REC.
           CALL "WRKFOUT".
           PERFORM JOIN-IDEN THRU JOIN-IDEN-EXIT. 
           IF SKIP-FLAG IS EQUAL TO "S" 
               GO TO JOIN-EXIT. 
           ADD 1 TO STRUCT-COUNT. 
           MOVE STRUCT-COUNT TO OUT-STCR. 
           MOVE "45" TO OUT-FIELD-TYPE. 
           MOVE FIND-ALIAS TO OUT-SCHJ-I1ALIAS. 
           MOVE FIND-RECORD-CATNAME TO OUT-SCHJ-I1REC.
           CALL "WRKFOUT".
       JOIN-EXIT. 
           EXIT.
  
  
      ******************************************************************
      * 
      *    JOIN-IDEN THRU JOIN-IDEN-EXIT
      * 
      *    SCAN JOIN IDENTIFIER INCLUDING SUBSCRIPTS AND QUALIFIERS.
      *    JOIN IDENTIFIER MAY BE AN ELEMENT, A GROUP, OR CONCATENATED
      *    KEY.  IF CATNAME CANNOT BE FOUND, IDENTIFIER IS ASSUMED TO BE
      *    CONCATENATED KEY.
      *    CALL SEARCH-FOR-CATNAME TO DETERMINE FIND-CATNAME, 
      *    FIND-ALIAS, AND FIND-RECORD-CATNAME.  CONCATENATE
      *    FIND-CATNAME AND SUBSCRIPT AND STORE IN OUT-SCHJ-ID1.
      * 
      *    ON INPUT 
      *    WORK-AREA = JOIN IDENTIFIER
      * 
      *    ON OUTPUT
      *    IF NO ERROR
      *        WORK-AREA = 1ST TOKEN AFTER JOIN IDENTIFIER (MAY BE .) 
      *        SKIP-FLAG = SPACE
      *        OUT-SCHJ-ID1 = FIND-CATNAME CONCATENATED WITH SUBSCRIPT
      *    IF ERROR AND REST OF RELATION ENTRY MUST BE SKIPPED
      *        SKIP-FLAG = "S"
      * 
      ******************************************************************
  
       JOIN-IDEN. 
           MOVE WORK-AREA TO FIND-DATA-NAME.
           MOVE SPACES TO FIND-RECORD-NAME, DONE, SUBSCRIPT.
           MOVE 0 TO SUBSCRIPT-COUNT. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF WORK-AREA IS NOT EQUAL TO "(" 
               GO TO JOIN-IDEN-10.
           MOVE "[" TO SUBSCRIPT. 
           MOVE 2 TO SUB-SUB. 
           PERFORM UNTIL DONE IS EQUAL TO "D" 
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               IF NOT EOF 
                 AND WORK-AREA IS NOT EQUAL TO "."
                 AND WORK-AREA IS NOT EQUAL TO ")"
                 AND SUBSCRIPT-COUNT IS LESS THAN 3 
                   IF (WORKA (1) IS LESS THAN "0" 
                     OR WORKA (1) IS GREATER THAN "9")
                     AND WORK-AREA IS NOT EQUAL TO "ANY"
                       MOVE MSG-160 TO STD-REPORT-REC 
                       PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT
                       MOVE "S" TO SKIP-FLAG
                       GO TO JOIN-IDEN-EXIT 
                   END-IF 
                   IF WK-SUB IS GREATER THAN 4
                       MOVE MSG-140 TO STD-REPORT-REC 
                       PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT
                       MOVE "S" TO SKIP-FLAG
                       GO TO JOIN-IDEN-EXIT 
                   END-IF 
                   MOVE WORK-AREA TO SUBSCRIPT (SUB-SUB : END)
                   ADD 1 TO SUBSCRIPT-COUNT 
                   ADD WK-SUB TO SUB-SUB
                   MOVE "," TO SUBSCRIPT (SUB-SUB : 1)
                   ADD 1 TO SUB-SUB 
               ELSE 
                   MOVE "D" TO DONE 
               END-IF 
           END-PERFORM. 
           SUBTRACT 1 FROM SUB-SUB. 
           IF SUBSCRIPT (SUB-SUB : 1) IS NOT EQUAL TO "," 
               ADD 1 TO SUB-SUB.
           MOVE "]" TO SUBSCRIPT (SUB-SUB : 1). 
           IF WORK-AREA IS NOT EQUAL TO ")" 
               MOVE MSG-130 TO STD-REPORT-REC 
               PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT
               MOVE "S" TO SKIP-FLAG
               GO TO JOIN-IDEN-EXIT 
           ELSE 
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
           END-IF.
       JOIN-IDEN-10.
           IF NOT EOF 
             AND WORK-AREA IS EQUAL TO "OF" 
             OR WORK-AREA IS EQUAL TO "IN"
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               IF NOT EOF 
                 AND WORK-AREA IS NOT EQUAL TO "."
                   MOVE WORK-AREA TO FIND-RECORD-NAME 
                   PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               END-IF 
           END-IF.
           MOVE "G" TO CATNAME-MAY-BE-GROUP.
           PERFORM SEARCH-FOR-CATNAME THRU SEARCH-FOR-CATNAME-EXIT. 
           IF FIND-CATNAME IS EQUAL TO SPACE
               MOVE FIND-DATA-NAME TO OUT-SCHJ-ID1
           ELSE 
               MOVE FIND-CATNAME TO OUT-SCHJ-ID1
           END-IF.
           IF SUBSCRIPT IS EQUAL TO SPACE 
               GO TO JOIN-IDEN-EXIT.
           PERFORM VARYING SUB-SUB FROM 1 BY 1
             UNTIL OUT-SCHJ-ID1 (SUB-SUB : 1) IS EQUAL TO SPACE 
               MOVE "D" TO DONE 
           END-PERFORM. 
           MOVE SUBSCRIPT TO OUT-SCHJ-ID1 (SUB-SUB : END) 
       JOIN-IDEN-EXIT.
           EXIT.
  
      ******************************************************************
      * 
      *    KEY-ID THRU KEY-ID-EXIT. 
      * 
      *    SCAN KEY ID CLAUSE FOR CONCATENATED KEY AND
      *    WRITE OUT-AREAK-CKEY-REC TO WORK-FILE
      * 
      *    ON INPUT 
      *    WORK-AREA = "IDENTIFIER" OR "ID" 
      * 
      *    ON OUTPUT
      *    IF NO ERROR
      *        WORK-AREA = 1ST TOKEN AFTER KEY ID CLAUSE (MAY BE .) 
      *        SKIP-FLAG = SPACE
      *        OUT-AREAK-CKEY-REC WRITTEN TO WORK-FILE
      *    IF ERROR AND REST OF AREA CONTROL ENTRY MUST BE SKIPPED
      *        SKIP-FLAG = "S"
      * 
      ******************************************************************
  
       KEY-ID.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
             OR WORK-AREA IS EQUAL TO "." 
               GO TO KEY-ID-EXIT. 
           MOVE "P" TO TYPEKEY. 
           IF WORK-AREA IS NOT EQUAL TO "IS"
               GO TO KEY-ID-10. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
             OR WORK-AREA IS EQUAL TO "." 
               GO TO KEY-ID-EXIT. 
       KEY-ID-10. 
           IF WORK-AREA IS NOT EQUAL TO "ALTERNATE" 
               GO TO KEY-ID-20. 
           MOVE "A" TO TYPEKEY. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
             OR WORK-AREA IS EQUAL TO "." 
               GO TO KEY-ID-EXIT. 
       KEY-ID-20. 
           MOVE WORK-AREA TO CKEYID.
           ADD 1 TO STRUCT-COUNT. 
           MOVE STRUCT-COUNT TO SAVE-STRUCT-COUNT.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
             OR WORK-AREA IS EQUAL TO "." 
               GO TO KEY-ID-EXIT. 
           IF WORK-AREA IS NOT EQUAL TO "<" 
               MOVE MSG-95 TO STD-REPORT-REC
               PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT
               MOVE "S" TO SKIP-FLAG
               GO TO KEY-ID-EXIT
           END-IF.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
       KEY-ID-30. 
           MOVE "22" TO OUT-ENTRY-TYPE. 
           MOVE SPACES TO OUT-EALIASOF-FLAG, OUT-EALIASOF-NAME. 
           MOVE ZERO TO OUT-99-GROUP. 
           MOVE AREA-CATNAME TO OUT-CATNAME.
           MOVE "500" TO OUT-CATEGORY-TYPE. 
           MOVE AREA-NAME TO OUT-CDCS-NAME. 
           MOVE "45" TO OUT-FIELD-TYPE. 
       KEY-ID-40. 
           IF EOF 
             OR WORK-AREA IS EQUAL TO "." 
               MOVE MSG-100 TO STD-REPORT-REC 
               PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT
               GO TO KEY-ID-60
           END-IF.
           IF WORK-AREA IS EQUAL TO ">" 
               GO TO KEY-ID-50. 
           PERFORM CIDEN THRU CIDEN-EXIT. 
           IF SKIP-FLAG IS EQUAL TO "S" 
               GO TO KEY-ID-EXIT
           ELSE 
               GO TO KEY-ID-40
           END-IF.
       KEY-ID-50. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF NOT EOF 
             AND WORK-AREA IS NOT EQUAL TO "."
               PERFORM KEY-USING-DUP THRU KEY-USING-DUP-EXIT
           END-IF.
       KEY-ID-60. 
           MOVE "22" TO OUT-ENTRY-TYPE. 
           MOVE SPACES TO OUT-EALIASOF-FLAG, OUT-EALIASOF-NAME, 
             OUT-FILLER.
           MOVE ZERO TO OUT-99-GROUP. 
           MOVE AREA-CATNAME TO OUT-CATNAME.
           MOVE "500" TO OUT-CATEGORY-TYPE. 
           MOVE SAVE-STRUCT-COUNT TO OUT-STCR.
           MOVE AREA-NAME TO OUT-CDCS-NAME. 
           MOVE "30" TO OUT-FIELD-TYPE. 
           MOVE CKEYID TO OUT-AREAK-CKEYID. 
           MOVE TYPEKEY TO OUT-AREAK-CTYPKEY. 
           MOVE DUPES TO OUT-AREAK-CDUPES.
           MOVE TEMP-USING TO OUT-AREAK-CUSING. 
           CALL "WRKFOUT".
       KEY-ID-EXIT. 
           EXIT.
  
      ******************************************************************
      * 
      *    KEY-ROUTINE THRU KEY-EXIT. 
      * 
      *    SCAN KEY CLAUSE FOR NONCONCATENATED KEY AND
      *    WRITES OUT-AREAK-KEY-REC TO WORK-FILE
      * 
      *    ON INPUT 
      *    WORK-AREA = 1ST TOKEN AFTER "KEY"
      * 
      *    ON OUTPUT
      *    IF NO ERROR
      *        WORK-AREA = 1ST TOKEN AFTER KEY CLAUSE (MAY BE .)
      *        SKIP-FLAG = SPACE
      *        OUT-AREAK-KEY-REC WRITTEN TO WORK-FILE 
      *    IF ERROR AND REST OF AREA CONTROL ENTRY MUST BE SKIPPED
      *        SKIP-FLAG = "S"
      * 
      ******************************************************************
  
       KEY-ROUTINE. 
           MOVE "P" TO TYPEKEY. 
           IF WORK-AREA IS NOT EQUAL TO "IS"
               GO TO KEY-10.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
               GO TO SCH-END. 
           IF WORK-AREA IS EQUAL TO "." 
               GO TO KEY-EXIT.
       KEY-10.
           IF WORK-AREA IS NOT EQUAL TO "ALTERNATE" 
               GO TO KEY-20.
           MOVE "A" TO TYPEKEY. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
               GO TO SCH-END. 
           IF WORK-AREA IS EQUAL TO "." 
               GO TO KEY-EXIT.
       KEY-20.
           MOVE "G" TO CATNAME-MAY-BE-GROUP.
           PERFORM QUALIFY-SUB THRU QUALIFY-EXIT. 
           IF SKIP-FLAG IS EQUAL TO "S" 
               GO TO KEY-EXIT 
           END-IF.
           IF NOT EOF 
             AND WORK-AREA IS NOT EQUAL TO "."
               PERFORM KEY-USING-DUP THRU KEY-USING-DUP-EXIT. 
           MOVE "22" TO OUT-ENTRY-TYPE. 
           MOVE SPACES TO OUT-EALIASOF-FLAG, OUT-EALIASOF-NAME, 
             OUT-FILLER.
           MOVE ZERO TO OUT-99-GROUP. 
           MOVE AREA-CATNAME TO OUT-CATNAME.
           MOVE "500" 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 FIND-CATNAME TO OUT-AREAK-KEYNAME.
           MOVE FIND-ALIAS TO OUT-AREAK-KALIAS. 
           MOVE FIND-RECORD-CATNAME TO OUT-AREAK-KOFREC.
           MOVE TYPEKEY TO OUT-AREAK-TYPEKEY. 
           MOVE DUPES TO OUT-AREAK-DUPES. 
           MOVE TEMP-USING TO OUT-AREAK-USING.
           CALL "WRKFOUT".
       KEY-EXIT.
           EXIT.
  
  
      ******************************************************************
      * 
      *    KEY-USING-DUP THRU KEY-USING-DUP-EXIT. 
      * 
      *    SCAN KEY OR KEY ID CLAUSE FOR USING AND DUPLICATES PHRASE. 
      *    WRITES OUT-ELEP-REC TO WORK-FILE IF USING PHRASE FOUND.
      * 
      *    ON INPUT 
      *    IF SCANNING KEY CLAUSE, WORK-AREA = 1ST TOKEN AFTER DATA 
      *        NAME AND ITS QUALIFIER 
      *    IF SCANNING KEY ID CLAUSE, WORK-AREA = 1ST TOKEN AFTER ">" 
      * 
      *    ON OUTPUT
      *    WORK-AREA = 1ST TOKEN AFTER KEY CLAUSE (MAY BE .)
      *    TEMP-USING, DUPES SET
      *    IF USING PHRASE FOUND, OUT-ELEP-REC WRITTEN TO WORK-FILE 
      * 
      ******************************************************************
  
       KEY-USING-DUP. 
           IF WORK-AREA IS NOT EQUAL TO "USING" 
               GO TO KEY-USING-DUP-10.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
             OR WORK-AREA IS EQUAL TO "." 
               GO TO KEY-USING-DUP-EXIT.
           PERFORM DBPROC THRU DBPROC-EXIT. 
           MOVE SPACES TO OUT-ELEP-REC. 
           MOVE "22" TO OUT-ENTRY-TYPE. 
           MOVE ZERO TO OUT-99-GROUP. 
           MOVE AREA-CATNAME TO OUT-CATNAME.
           MOVE "400" 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 IS-CATNAME TO OUT-ELEP-DBPROC.
           MOVE "US" TO OUT-ELEP-TYPEPROC.
           CALL "WRKFOUT".
           MOVE "Y" TO TEMP-USING.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
             OR WORK-AREA IS EQUAL TO "." 
               GO TO KEY-USING-DUP-EXIT.
       KEY-USING-DUP-10.
           IF WORK-AREA IS NOT EQUAL TO "DUPLICATES"
               GO TO KEY-USING-DUP-EXIT.
           MOVE "A" TO DUPES. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
             OR WORK-AREA IS EQUAL TO "." 
               GO TO KEY-USING-DUP-EXIT.
           IF WORK-AREA IS NOT EQUAL TO "ARE" 
               GO TO KEY-USING-DUP-20.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
             OR WORK-AREA IS EQUAL TO "." 
               GO TO KEY-USING-DUP-EXIT.
       KEY-USING-DUP-20.
           IF WORK-AREA IS EQUAL TO "INDEXED" 
               MOVE "I" TO DUPES
               GO TO KEY-USING-DUP-30 
           END-IF.
           IF WORK-AREA IS EQUAL TO "FIRST" 
               MOVE "F" TO DUPES
               GO TO KEY-USING-DUP-30 
           END-IF.
           IF WORK-AREA IS EQUAL TO "NOT" 
               MOVE "N" TO DUPES
               GO TO KEY-USING-DUP-30 
           END-IF.
           IF WORK-AREA IS NOT EQUAL TO "ALLOWED" 
               GO TO KEY-USING-DUP-EXIT.
       KEY-USING-DUP-30.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
             OR WORK-AREA IS NOT EQUAL TO "ALLOWED" 
               GO TO KEY-USING-DUP-EXIT.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
       KEY-USING-DUP-EXIT.
           EXIT.
  
  
      ******************************************************************
      * 
      *    OCCURS-SUB THRU OCCURS-EXIT
      * 
      *    SCAN OCCURS CLAUSE.  STORE OCCURS INFORMATION IN OCCURS-T0 
      *      AND TALIAS.
      * 
      *    ON INPUT 
      *    WORK-AREA = "OCCURS" 
      * 
      *    ON OUTPUT
      *    IF NO ERROR
      *        OCCURS-TO, TALIAS SET UP.
      *        WORK-AREA = 1ST TOKEN AFTER OCCURS CLAUSE
      *        SKIP-FLAG = SPACE
      *    IF ERROR AND REST OF DATA DESCRIPTION ENTRY MUST BE SKIPPED
      *        SKIP-FLAG = "S"
      * 
      ******************************************************************
  
       OCCURS-SUB.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
             OR WORK-AREA IS EQUAL TO "." 
               GO TO OCCURS-EXIT. 
           IF WK-SUB IS GREATER THAN 4
               GO TO OCCURS-DATA-NAME.
           IF WK-SUB IS GREATER THAN 0
             AND (WORKA (1) IS LESS THAN "0"
             OR WORKA (1) IS GREATER THAN "9")
               GO TO OCCURS-DATA-NAME.
           IF WK-SUB IS GREATER THAN 1
             AND (WORKA (2) IS LESS THAN "0"
             OR WORKA (2) IS GREATER THAN "9")
               GO TO OCCURS-DATA-NAME.
           IF WK-SUB IS GREATER THAN 2
             AND (WORKA (3) IS LESS THAN "0"
             OR WORKA (3) IS GREATER THAN "9")
               GO TO OCCURS-DATA-NAME.
           IF WK-SUB IS GREATER THAN 3
             AND (WORKA (4) IS LESS THAN "0"
             OR WORKA (4) IS GREATER THAN "9")
               GO TO OCCURS-DATA-NAME.
           MOVE WORK-AREA TO OCCURS-TO. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           GO TO OCCURS-10. 
       OCCURS-DATA-NAME.
           MOVE WORK-AREA TO FIND-DATA-NAME.
           MOVE RECORD-NAME TO FIND-RECORD-NAME.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF WORK-AREA IS EQUAL TO "OF"
             OR WORK-AREA IS EQUAL TO "IN"
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               IF NOT EOF 
                 AND WORK-AREA IS NOT EQUAL TO "."
                   PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               END-IF 
           END-IF.
           MOVE SPACE TO CATNAME-MAY-BE-GROUP.
           PERFORM SEARCH-FOR-CATNAME THRU SEARCH-FOR-CATNAME-EXIT. 
           IF FIND-CATNAME IS EQUAL TO SPACES 
               MOVE FIND-DATA-NAME TO UNKNOWN-DATA-NAME 
               MOVE MSG-90 TO STD-REPORT-REC
               PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT
               MOVE "S" TO SKIP-FLAG
               GO TO OCCURS-EXIT
           ELSE 
               MOVE FIND-CATNAME TO OCCURS-TO 
               MOVE FIND-ALIAS TO TALIAS
           END-IF.
       OCCURS-10. 
           IF EOF 
             OR WORK-AREA IS NOT EQUAL TO "TIMES" 
               GO TO OCCURS-EXIT. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
       OCCURS-EXIT. 
           EXIT.
  
      ******************************************************************
      * 
      *    PIC-SUB THRU PIC-EXIT
      * 
      *    SCAN PICTURE CLAUSE.  STORE PICTURE IN HOLD-PICTURE. 
      * 
      *    ON INPUT 
      *    WORK-AREA = "PIC" OR "PICTURE" 
      *    LEVEL-TABLE, LV-SUB SET UP 
      * 
      *    ON OUTPUT
      *    IF NO ERROR
      *        HOLD-PICTURE CONTAINS PICTURE, TRUNCATED TO 25 CHARACTERS
      *          IF NECESSARY 
      *        WORK-AREA = 1ST TOKEN AFTER PICTURE CLAUSE 
      *        SKIP-FLAG = SPACE
      *    IF ERROR AND REST OF DATA DESCRIPTION ENTRY MUST BE SKIPPED
      *        SKIP-FLAG = "S"
      * 
      ******************************************************************
  
       PIC-SUB. 
           MOVE "E" TO LEVT-GRP-ELE (LV-SUB). 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
             OR WORK-AREA IS EQUAL TO "." 
               GO TO PIC-EXIT.
           IF WORK-AREA IS NOT EQUAL TO "IS"
               GO TO PIC-10.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
             OR WORK-AREA IS EQUAL TO "." 
               GO TO PIC-EXIT.
       PIC-10.
           IF WK-SUB IS LESS THAN 3 
             OR WORKA (1) IS NOT EQUAL TO QUOTE 
             OR WORKA (WK-SUB) IS NOT EQUAL TO QUOTE
               MOVE MSG-15 TO STD-REPORT-REC
               PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT
               MOVE "S" TO SKIP-FLAG
               GO TO PIC-EXIT 
           END-IF.
           IF WK-SUB IS GREATER THAN 27 
               MOVE MSG-490 TO STD-REPORT-REC 
               PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT
               MOVE 27 TO WK-SUB
           END-IF.
           SUBTRACT 2 FROM WK-SUB.
           MOVE WORK-AREA (2 : WK-SUB) TO HOLD-PICTURE. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
       PIC-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.
  
      ******************************************************************
      * 
      *    QUALIFY-SUB THRU QUALIFY-EXIT
      * 
      *    SCANS DATA NAME AND ITS OPTIONAL RECORD QUALIFIER.  SETS 
      *    UP PARAMETERS FOR AND CALLS SEARCH-FOR-CATNAME.
      * 
      *    ON INPUT 
      *    WORK-AREA = DATA NAME
      *    CATNAME-MAY-BE-GROUP = SPACE TO FIND ELEMENT ONLY
      *    CATNAME-MAY-BE-GROUP = "G" TO FIND ELEMENT OR GROUP
      * 
      *    ON OUTPUT
      *    WORK-AREA = 1ST TOKEN AFTER DATA NAME AND ITS QUALIFIER
      *    SKIP-FLAG = "S" IF SEARCH-FOR-CATNAME DID NOT FIND NAME
      *    SKIP-FLAG = SPACE IF SEARCH-FOR-CATNAME DID FIND NAME
      * 
      ******************************************************************
  
       QUALIFY-SUB. 
           MOVE WORK-AREA TO FIND-DATA-NAME.
           MOVE SPACES TO FIND-RECORD-NAME. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF WORK-AREA IS EQUAL TO "OF"
             OR WORK-AREA IS EQUAL TO "IN"
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               IF NOT EOF 
                 AND WORK-AREA IS NOT EQUAL TO "."
                   MOVE WORK-AREA TO FIND-RECORD-NAME 
                   PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               END-IF 
           END-IF.
           PERFORM SEARCH-FOR-CATNAME THRU SEARCH-FOR-CATNAME-EXIT. 
           IF FIND-CATNAME IS EQUAL TO SPACE
               MOVE FIND-DATA-NAME TO UNKNOWN-DATA-NAME 
               MOVE MSG-90 TO STD-REPORT-REC
               PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT
               MOVE "S" TO SKIP-FLAG
           END-IF.
       QUALIFY-EXIT.
           EXIT.
  
      ******************************************************************
      * 
      *    RC-VALUE THRU RC-VALUE-EXIT
      * 
      *    SCANS VALUE CLAUSE OF RECORD CLAUSE, PREPARES AND WRITES 
      *    OUT-AREAS-RCVALUE-REC
      * 
      *    ON INPUT 
      *    WORK-AREA = "VALUE"
      * 
      *    ON OUTPUT
      *    IF NO ERROR
      *        WORK-AREA = 1ST TOKEN AFTER VALUE CLAUSE 
      *        OUT-AREAS-RCVALUE-REC WRITTEN TO WORK-FILE 
      *        SKIP-FLAG = SPACE
      *    IF ERROR AND REST OF AREA CONTROL ENTRY MUST BE SKIPPED
      *        SKIP-FLAG = "S"
      * 
      ******************************************************************
  
       RC-VALUE.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
               GO TO SCH-END. 
           IF WORK-AREA IS NOT EQUAL TO "FOR" 
               GO TO RC-VALUE-10. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
               GO TO SCH-END. 
       RC-VALUE-10. 
           MOVE "13" TO IS-ENTITY-TYPE. 
           MOVE SCHEMA-ORD TO IS-SCHEMA-ORDINAL.
           MOVE WORK-AREA TO IS-CDCS-NAME.
           START IS-FILE KEY IS EQUAL TO IS-ALTKEY
             INVALID KEY GO TO RC-VALUE-ERROR.
           READ IS-FILE.
           IF IS-REC-SSCH-ORDINAL IS NOT EQUAL TO ZERO
               GO TO RC-VALUE-ERROR.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
               GO TO SCH-END. 
           IF WORK-AREA IS EQUAL TO "." 
               GO TO RC-VALUE-EXIT. 
           IF WORK-AREA IS NOT EQUAL TO "IS"
               GO TO RC-VALUE-20. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
               GO TO SCH-END. 
           IF WORK-AREA IS EQUAL TO "." 
               GO TO RC-VALUE-EXIT. 
       RC-VALUE-20. 
           MOVE "22" TO OUT-ENTRY-TYPE. 
           MOVE SPACES TO OUT-EALIASOF-FLAG, OUT-EALIASOF-NAME, 
             OUT-FILLER.
           MOVE ZERO TO OUT-99-GROUP. 
           MOVE AREA-CATNAME TO OUT-CATNAME.
           MOVE "300" TO OUT-CATEGORY-TYPE. 
           MOVE IS-REC-OUT-STCR TO OUT-STCR.
           MOVE AREA-NAME TO OUT-CDCS-NAME. 
           MOVE "15" TO OUT-FIELD-TYPE. 
           MOVE WORK-AREA TO OUT-AREAS-RCVALUE. 
           CALL "WRKFOUT".
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           GO TO RC-VALUE-EXIT. 
       RC-VALUE-ERROR.
           MOVE MSG-85 TO STD-REPORT-REC. 
           PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT. 
           MOVE "S" TO SKIP-FLAG. 
       RC-VALUE-EXIT. 
           EXIT.
  
      ******************************************************************
      * 
      *    READ-SCHFIL THRU READ-SCHFIL-EXIT
      * 
      *    READ NEXT RECORD OF SCHFIL 
      * 
      *    ON OUTPUT
      *    IF END-OF-FILE ENCOUNTERED 
      *        END-SW = "E" 
      *    IF END-OF-FILE NOT ENCOUNTERED 
      *        SCH-IN CONTAINS NEXT RECORD
      *        NEXT RECORD WRITTEN TO OUTPUT FILE 
      *        IN-SUB = 1 
      * 
      ******************************************************************
  
       READ-SCHFIL. 
           IF END-SW IS EQUAL TO "E"
               GO TO READ-SCHFIL-EXIT 
           END-IF.
           READ SCH-FILE AT END 
               MOVE "E" TO END-SW 
               GO TO READ-SCHFIL-EXIT.
           MOVE SCH-IN TO STD-REPORT-REC. 
           PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.
           MOVE 1 TO IN-SUB.
           MOVE SPACES TO SCH-LINE (73).
       READ-SCHFIL-EXIT.
           EXIT.
  
      ******************************************************************
      * 
      *    RECORD-CALL THRU RECORD-CALL-EXIT. 
      * 
      *    SCANS CALL CLAUSE OF RECORD DESCRIPTION ENTRY
      *    AND WRITES OUT-ELEP-REC TO WRKFILE 
      * 
      *    ON INPUT 
      *    WORK-AREA = "CALL" 
      *    RECORD-NAME, RECORD-CATNAME SET UP 
      * 
      *    ON OUTPUT
      *    IF PERIOD ENDED CALL CLAUSE
      *        WORK-AREA = "."
      *        PER-FOUND = TRUE 
      *    IF PERIOD DID NOT END CALL CLAUSE
      *        WORK-AREA = 1ST TOKEN AFTER CALL CLAUSE
      *    OUT-ELEP-REC WRITTEN TO WORK-FILE
      *    IF NEW DBPROC ENCOUNTERED, OUT-REC FOR DBPROC
      *    WRITTEN TO WORK-FILE.
      * 
      ******************************************************************
  
       RECORD-CALL. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF END-SW IS EQUAL TO "E"
               GO TO SCH-END. 
           PERFORM DBPROC THRU DBPROC-EXIT. 
           MOVE "13" TO OUT-ENTRY-TYPE. 
           MOVE ZERO TO OUT-99-GROUP. 
           MOVE RECORD-CATNAME TO OUT-CATNAME.
           MOVE "400" TO OUT-CATEGORY-TYPE. 
           ADD 1 TO STRUCT-COUNT. 
           MOVE STRUCT-COUNT TO OUT-STCR. 
           MOVE RECORD-NAME TO OUT-CDCS-NAME. 
           MOVE "05" TO OUT-FIELD-TYPE. 
           MOVE SPACES TO OUT-FILLER. 
           MOVE IS-CATNAME TO OUT-ELEP-DBPROC.
           MOVE "CA" TO OUT-ELEP-TYPEPROC.
           MOVE 1 TO RECORD-SUB.
       RECORD-CALL-TIME.
           IF RECORD-SUB IS GREATER THAN 4
               MOVE 1 TO RECORD-SUB 
               GO TO RECORD-CALL-OPTION-10
           END-IF.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF END-SW IS EQUAL TO "E"
               GO TO RECORD-CALL-WRITE-EXIT.
       RECORD-CALL-TIME-10. 
           IF WORK-AREA IS EQUAL TO "BEFORE"
               IF RECORD-SUB IS EQUAL TO 1
                   MOVE "B" TO OUT-ELEP-TIME
                   ADD 1 TO RECORD-SUB
               ELSE 
                   MOVE "/B" TO OUT-ELEP-TIME (RECORD-SUB : 2)
                   ADD 2 TO RECORD-SUB
               END-IF 
               GO TO RECORD-CALL-TIME 
           END-IF.
           IF WORK-AREA IS EQUAL TO "AFTER" 
               IF RECORD-SUB IS EQUAL TO 1
                   MOVE "A" TO OUT-ELEP-TIME
                   ADD 1 TO RECORD-SUB
               ELSE 
                   MOVE "/A" TO OUT-ELEP-TIME (RECORD-SUB : 2)
                   ADD 2 TO RECORD-SUB
               END-IF 
               GO TO RECORD-CALL-TIME 
           END-IF.
           IF WORK-AREA IS EQUAL TO "ON"
               GO TO RECORD-CALL-TIME.
           IF WORK-AREA IS EQUAL TO "ERROR" 
               IF RECORD-SUB IS EQUAL TO 1
                   MOVE "E" TO OUT-ELEP-TIME
                   ADD 1 TO RECORD-SUB
               ELSE 
                   MOVE "/E" TO OUT-ELEP-TIME (RECORD-SUB : 2)
                   ADD 2 TO RECORD-SUB
               END-IF 
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               IF END-SW IS EQUAL TO "E"
                   GO TO RECORD-CALL-WRITE-EXIT 
               END-IF 
               IF WORK-AREA IS EQUAL TO "DURING"
                   GO TO RECORD-CALL-TIME 
               ELSE 
                   IF RECORD-SUB IS NOT GREATER THAN 4
                       GO TO RECORD-CALL-TIME-10
                   END-IF 
               END-IF 
           END-IF.
           IF RECORD-SUB IS EQUAL TO 1
               MOVE MSG-20 TO STD-REPORT-REC
               PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT
           END-IF.
       RECORD-CALL-OPTION.
           IF WORK-AREA IS EQUAL TO "." 
               SET PER-FOUND TO TRUE
               GO TO RECORD-CALL-WRITE-EXIT 
           END-IF.
           MOVE 1 TO RECORD-SUB.
           GO TO RECORD-CALL-OPTION-20. 
       RECORD-CALL-OPTION-10. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF END-SW IS EQUAL TO "E"
               GO TO RECORD-CALL-WRITE-EXIT.
           IF WORK-AREA IS EQUAL TO "." 
               SET PER-FOUND TO TRUE
               GO TO RECORD-CALL-WRITE-EXIT 
           END-IF.
           IF RECORD-SUB IS GREATER THAN 8
               GO TO RECORD-CALL-WRITE-EXIT.
       RECORD-CALL-OPTION-20. 
           IF WORK-AREA IS EQUAL TO "STORE" 
               IF RECORD-SUB IS EQUAL TO 1
                   MOVE "S" TO OUT-ELEP-OPTION
                   ADD 1 TO RECORD-SUB
               ELSE 
                   MOVE "/S" TO OUT-ELEP-OPTION (RECORD-SUB : 2)
                   ADD 2 TO RECORD-SUB
               END-IF 
               GO TO RECORD-CALL-OPTION-10
           END-IF.
           IF WORK-AREA IS EQUAL TO "DELETE"
               IF RECORD-SUB IS EQUAL TO 1
                   MOVE "D" TO OUT-ELEP-OPTION
                   ADD 1 TO RECORD-SUB
               ELSE 
                   MOVE "/D" TO OUT-ELEP-OPTION (RECORD-SUB : 2)
                   ADD 2 TO RECORD-SUB
               END-IF 
               GO TO RECORD-CALL-OPTION-10
           END-IF.
           IF WORK-AREA IS EQUAL TO "MODIFY"
               IF RECORD-SUB IS EQUAL TO 1
                   MOVE "M" TO OUT-ELEP-OPTION
                   ADD 1 TO RECORD-SUB
               ELSE 
                   MOVE "/M" TO OUT-ELEP-OPTION (RECORD-SUB : 2)
                   ADD 2 TO RECORD-SUB
               END-IF 
               GO TO RECORD-CALL-OPTION-10
           END-IF.
           IF WORK-AREA IS EQUAL TO "FIND"
               IF RECORD-SUB IS EQUAL TO 1
                   MOVE "F" TO OUT-ELEP-OPTION
                   ADD 1 TO RECORD-SUB
               ELSE 
                   MOVE "/F" TO OUT-ELEP-OPTION (RECORD-SUB : 2)
                   ADD 2 TO RECORD-SUB
               END-IF 
               GO TO RECORD-CALL-OPTION-10
           END-IF.
           IF WORK-AREA IS EQUAL TO "GET" 
               IF RECORD-SUB IS EQUAL TO 1
                   MOVE "G" TO OUT-ELEP-OPTION
                   ADD 1 TO RECORD-SUB
               ELSE 
                   MOVE "/G" TO OUT-ELEP-OPTION (RECORD-SUB : 2)
                   ADD 2 TO RECORD-SUB
               END-IF 
               GO TO RECORD-CALL-OPTION-10
           END-IF.
       RECORD-CALL-WRITE-EXIT.
           CALL "WRKFOUT".
       RECORD-CALL-EXIT.
           EXIT.
  
  
      ******************************************************************
      * 
      *    RECORD-CODE THRU RECORD-CODE-EXIT
      * 
      *    SCANS RECORD CODE CLAUSE, PREPARES AND WRITES
      *    OUT-ELEP-REC AND OUT-AREAP-RC-REC.  CALLS
      *    RC-VALUE TO PROCESS "VALUE" PHRASE.
      * 
      *    ON INPUT 
      *    WORK-AREA = "RECORD" 
      *    AREA-NAME, AREA-CATNAME SET UP 
      * 
      *    ON OUTPUT
      *    IF NO ERROR
      *        WORK-AREA = 1ST TOKEN AFTER RECORD CODE CLAUSE 
      *        OUT-ELEP-REC AND OUT-AREAP-RC-REC WRITTEN TO WRKFILE 
      *        SKIP-FLAG = SPACE
      *    IF ERROR AND REST OF AREA CONTROL ENTRY MUST BE SKIPPED
      *        SKIP-FLAG = "S"
      * 
      ******************************************************************
  
       RECORD-CODE. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
               GO TO SCH-END. 
           IF WORK-AREA IS NOT EQUAL TO "CODE"
               MOVE MSG-80 TO STD-REPORT-REC
               PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT
               MOVE "S" TO SKIP-FLAG
               GO TO RECORD-CODE-EXIT 
           ELSE 
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               IF EOF 
                   GO TO SCH-END
               END-IF 
           END-IF.
           IF WORK-AREA IS NOT EQUAL TO "IS"
               GO TO RECORD-CODE-10.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
               GO TO SCH-END. 
       RECORD-CODE-10.
           IF WORK-AREA IS EQUAL TO "PROCEDURE" 
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               IF EOF 
                   GO TO SCH-END
               END-IF 
               IF WORK-AREA IS EQUAL TO "." 
                   GO TO RECORD-CODE-EXIT 
               END-IF 
               PERFORM DBPROC THRU DBPROC-EXIT
               MOVE "22" TO OUT-ENTRY-TYPE
               MOVE ZERO TO OUT-99-GROUP
               MOVE AREA-CATNAME TO OUT-CATNAME 
               MOVE "400" 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 "RC" TO OUT-ELEP-TYPEPROC 
               MOVE IS-CATNAME TO OUT-ELEP-DBPROC 
               CALL "WRKFOUT" 
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               GO TO RECORD-CODE-VALUE
           END-IF.
           IF WORK-AREA IS NOT EQUAL TO "BY"
               MOVE MSG-155 TO STD-REPORT-REC 
               PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT
               MOVE "S" TO SKIP-FLAG
               GO TO RECORD-CODE-EXIT 
           END-IF.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
               GO TO SCH-END. 
           IF WORK-AREA IS EQUAL TO "." 
               GO TO RECORD-CODE-EXIT.
           MOVE "22" TO OUT-ENTRY-TYPE. 
           MOVE ZERO TO OUT-99-GROUP. 
           MOVE AREA-CATNAME TO OUT-CATNAME.
           MOVE "400" TO OUT-CATEGORY-TYPE. 
           ADD 1 TO STRUCT-COUNT. 
           MOVE STRUCT-COUNT TO OUT-STCR. 
           MOVE AREA-NAME TO OUT-CDCS-NAME. 
           MOVE "25" TO OUT-FIELD-TYPE. 
           MOVE SPACE TO CATNAME-MAY-BE-GROUP, OUT-FILLER.
           PERFORM QUALIFY-SUB THRU QUALIFY-EXIT. 
           IF SKIP-FLAG IS EQUAL TO "S" 
               GO TO RECORD-CODE-EXIT.
           MOVE FIND-CATNAME TO OUT-AREAP-RCDATA. 
           MOVE FIND-ALIAS TO OUT-AREAP-RCALIAS.
           MOVE FIND-RECORD-CATNAME TO OUT-AREAP-RCQUAL.
           CALL "WRKFOUT".
       RECORD-CODE-VALUE. 
           IF EOF 
               GO TO SCH-END. 
           IF WORK-AREA IS EQUAL TO "." 
               GO TO RECORD-CODE-EXIT.
       RECORD-CODE-VALUE-10.
           IF WORK-AREA IS EQUAL TO "VALUE" 
               PERFORM RC-VALUE THRU RC-VALUE-EXIT
               IF SKIP-FLAG IS EQUAL TO "S" 
                   GO TO RECORD-CODE-EXIT 
               END-IF 
               IF EOF 
                   GO TO SCH-END
               ELSE 
                   GO TO RECORD-CODE-VALUE-10 
               END-IF 
           END-IF.
       RECORD-CODE-EXIT.
           EXIT.
  
      ******************************************************************
      * 
      *    RECORD-DESC THRU RECORD-DESC-EXIT
      * 
      *    SCANS RECORD ENTRY, PREPARES RECORD ENTITY 
      *    AND WRITES ENTITY TO WORK-FILE AND IS-FILE.
      *    CALLS RECORD-CALL TO PROCESS CALL CLAUSE.  INITIALIZES 
      *    LEVEL-TABLE.  CALLS DATA-DESC FOR EVERY DATA ITEM IN RECORD. 
      * 
      *    ON INPUT 
      *    WORK-AREA = "RECORD" 
      * 
      *    ON OUTPUT
      *    IF NO ERROR
      *        SKIP-FLAG = SPACE
      *        WORK-AREA = 1ST TOKEN AFTER RECORD ENTRY (INCLUDING
      *          ALL DATA DESCRIPTION ENTRIES IN RECORD)
      *        OUT-REC, OUT-AREAS-REC WRITTEN TO WRKFILE
      *        NOTE-CDCS-REC DESCRIBES NAME CATEGORY OF CURRENT RECORD, 
      *          OR, IF RECORD CONTAINS DATA ITEMS, DESCRIBES STRUCTURE 
      *          CATEGORY OF PARENT OF LAST DATA ITEM 
      *    IF ERROR AND RECORD ENTRY (INCLUDING ALL DATA DESCRIPTION
      *      ENTRIES IN RECORD) MUST BE SKIPPED 
      *        SKIP-FLAG = "S"
      * 
      ******************************************************************
  
       RECORD-DESC. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
               GO TO SCH-END. 
           IF WORK-AREA IS NOT EQUAL TO "NAME"
               GO TO RECORD-DESC-10.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
               GO TO SCH-END. 
       RECORD-DESC-10.
           IF WORK-AREA IS NOT EQUAL TO "IS"
               GO TO RECORD-DESC-20.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
               GO TO SCH-END. 
       RECORD-DESC-20.
           MOVE SPACES TO OUT-EALIASOF-FLAG, OUT-EALIASOF-NAME, 
             OUT-FILLER.
           MOVE ZERO TO OUT-99-GROUP. 
           ADD 1 TO STRUCT-COUNT. 
           MOVE STRUCT-COUNT TO OUT-STCR. 
           MOVE "13" TO IS-ENTITY-TYPE. 
           MOVE SCHEMA-ORD TO IS-SCHEMA-ORDINAL.
           MOVE WORK-AREA TO IS-CDCS-NAME.
           START IS-FILE KEY IS EQUAL TO IS-ALTKEY
             INVALID KEY GO TO RECORD-DESC-25.
           READ IS-FILE.
           IF IS-REC-SSCH-ORDINAL IS EQUAL TO ZERO
               MOVE MSG-65 TO STD-REPORT-REC
               PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT
               MOVE "S" TO SKIP-FLAG
               GO TO RECORD-DESC-EXIT 
           END-IF.
       RECORD-DESC-25.
           PERFORM WRITE-ENTITY THRU WRITE-ENTITY-EXIT. 
           MOVE IS-REC TO HOLD-IS-REC.
           MOVE IS-CDCS-NAME TO RECORD-NAME, NOTE-CDCS-NAME.
           MOVE IS-CATNAME TO RECORD-CATNAME, NOTE-CATNAME. 
           MOVE "13" TO NOTE-ENTRY-TYPE.
           MOVE ZERO TO NOTE-99-GROUP.
           MOVE "001" TO NOTE-CATEGORY-TYPE.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
               GO TO SCH-END. 
           IF WORK-AREA IS NOT EQUAL TO "WITHIN"
               MOVE MSG-50 TO STD-REPORT-REC
               PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT
               MOVE "S" TO SKIP-FLAG
               GO TO RECORD-DESC-EXIT 
           END-IF.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF END-SW IS EQUAL TO "E"
               GO TO SCH-END. 
           MOVE "22" TO IS-ENTITY-TYPE. 
           MOVE SCHEMA-ORD TO IS-SCHEMA-ORDINAL.
           MOVE WORK-AREA TO IS-CDCS-NAME.
           START IS-FILE KEY IS EQUAL TO IS-ALTKEY
             INVALID KEY GO TO RECORD-WITHIN. 
           READ IS-FILE.
           GO TO RECORD-WITHIN-10.
       RECORD-WITHIN. 
           MOVE MSG-55 TO STD-REPORT-REC. 
           PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT. 
           MOVE "S" TO SKIP-FLAG. 
           GO TO RECORD-DESC-EXIT.
       RECORD-WITHIN-10.
           MOVE "22" TO OUT-ENTRY-TYPE. 
           MOVE ZERO TO OUT-99-GROUP. 
           MOVE IS-CATNAME TO OUT-CATNAME, IS-REC-PARENT-CATNAME. 
           MOVE "300" 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 RECORD-CATNAME TO OUT-AREAS-CATNAME.
           CALL "WRKFOUT".
           ADD 1 TO STRUCT-COUNT. 
           MOVE HOLD-IS-REC TO IS-REC.
           MOVE 0 TO IS-REC-SSCH-ORDINAL. 
           MOVE STRUCT-COUNT TO IS-REC-OUT-STCR.
           WRITE IS-REC-REC.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF END-SW IS EQUAL TO "E"
               GO TO SCH-END. 
           IF WORK-AREA IS EQUAL TO "." 
               SET PER-FOUND TO TRUE
               GO TO RECORD-DESC-PER-EXIT 
           END-IF.
       RECORD-DESC-30.
           IF WORK-AREA IS EQUAL TO "CALL"
               MOVE SPACE TO PERIOD-FLAG
               PERFORM RECORD-CALL THRU RECORD-CALL-EXIT
               IF END-SW IS EQUAL TO "E"
                   GO TO SCH-END
               END-IF 
               IF PER-FOUND 
                   GO TO RECORD-DESC-PER-EXIT 
               ELSE 
                   GO TO RECORD-DESC-30 
               END-IF 
           END-IF.
           MOVE MSG-10 TO STD-REPORT-REC. 
           PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT. 
       RECORD-DESC-PER-EXIT.
           PERFORM VARYING LV-SUB FROM 1 BY 1 
             UNTIL LV-SUB IS GREATER THAN 11
               MOVE SPACES TO LEV-TAB (LV-SUB)
           END-PERFORM. 
           MOVE RECORD-CATNAME TO LEVT-CATNAME (1). 
           MOVE RECORD-NAME TO LEVT-CDCS-NAME (1).
           MOVE "R" TO LEVT-GRP-ELE (1).
           MOVE ZERO TO LEVT-LEVEL-NO (1).
           MOVE 1 TO LV-SUB.
       DATA-DESC-LOOP.
           IF WORK-AREA IS EQUAL TO "." 
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
            OR WORK-AREA IS EQUAL TO "RECORD" 
            OR WORK-AREA IS EQUAL TO "AREA" 
            OR WORK-AREA IS EQUAL TO "DATA" 
            OR WORK-AREA IS EQUAL TO "SCHEMA" 
              GO TO RECORD-DESC-EXIT. 
           PERFORM DATA-DESC THRU DATA-DESC-EXIT. 
           IF SKIP-FLAG IS EQUAL TO "S" 
               PERFORM SKIP-PAST-PERIOD THRU SKIP-PAST-PERIOD-EXIT
           END-IF.
           GO TO DATA-DESC-LOOP.
       RECORD-DESC-EXIT.
           EXIT.
  
      ******************************************************************
      * 
      *    RELATION THRU RELATION-EXIT. 
      * 
      *    SCANS RELATION ENTRY AND WRITES OUT-SCHJ-REL-REC,
      *    OUT-SCHJ-ID1-REC TO WORK-FILE FOR 1ST AND 2ND IDENTIFIER 
      * 
      *    ON INPUT 
      *    WORK-AREA = "RELATION" 
      * 
      *    ON OUTPUT
      *    IF NO ERROR
      *        SKIP-FLAG = SPACE
      *        WORK-AREA = 1ST TOKEN AFTER RELATION ENTRY 
      *        OUT-SCHJ-REL-REC, OUT-SCHJ-ID1-REC FOR 1ST AND 2ND ID
      *        WRITTEN TO WORK-FILE.
      *    IF ERROR AND REST OF RELATION ENTRY MUST BE SKIPPED
      *        SKIP-FLAG = "S"
      * 
      ******************************************************************
  
       RELATION.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
             OR WORK-AREA IS EQUAL TO "." 
               GO TO RELATION-EXIT. 
           IF WORK-AREA IS NOT EQUAL TO "NAME"
               GO TO RELATION-10. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
             OR WORK-AREA IS EQUAL TO "." 
               GO TO RELATION-EXIT. 
       RELATION-10. 
           IF WORK-AREA IS NOT EQUAL TO "IS"
               GO TO RELATION-20. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
             OR WORK-AREA IS EQUAL TO "." 
               GO TO RELATION-EXIT. 
       RELATION-20. 
           MOVE "26" TO OUT-ENTRY-TYPE. 
           MOVE SPACES TO OUT-EALIASOF-FLAG, OUT-EALIASOF-NAME, 
             OUT-FILLER.
           MOVE ZERO TO OUT-99-GROUP. 
           MOVE SCHEMA-CATNAME TO OUT-CATNAME.
           MOVE "575" 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-SCHJ-RELNAME.
           CALL "WRKFOUT".
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
             OR WORK-AREA IS EQUAL TO "." 
               GO TO RELATION-EXIT. 
           IF WORK-AREA IS NOT EQUAL TO "JOIN"
               MOVE MSG-135 TO STD-REPORT-REC 
               PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT
               MOVE "S" TO SKIP-FLAG
               GO TO RELATION-EXIT
           END-IF.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
             OR WORK-AREA IS EQUAL TO "." 
               GO TO RELATION-EXIT. 
           IF WORK-AREA IS NOT EQUAL TO "WHERE" 
               GO TO RELATION-30. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
             OR WORK-AREA IS EQUAL TO "." 
               GO TO RELATION-EXIT. 
       RELATION-30. 
           PERFORM JOIN THRU JOIN-EXIT. 
           IF SKIP-FLAG IS EQUAL TO "S" 
             OR EOF 
               GO TO RELATION-EXIT. 
           IF WORK-AREA IS EQUAL TO "." 
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
           ELSE 
               GO TO RELATION-30
           END-IF.
       RELATION-EXIT. 
           EXIT.
  
  
      ******************************************************************
      * 
      *    RESULT-SUB THRU RESULT-EXIT
      * 
      *    SCAN RESULT CLAUSE.  IF ELEMENT ENTITY NOT WRITTEN,
      *    CALL WRITE-ELEMENT-PRO-VAL TO WRITE ENTITY.
      *    CALL DBPROC TO WRITE DBPROC ENTITY, IF NECESSARY.
      *    WRITE OUT-ELEP-REC 
      * 
      *    ON INPUT 
      *    WORK-AREA = "ACTUAL" OR "VIRTUAL"
      *    DATA-NAME = NAME OF ELEMENT
      *    LEVEL-TABLE, LV-SUB, ENTITY-WRITTEN SET UP 
      * 
      *    ON OUTPUT
      *    IF NO ERROR
      *        ENTITY-WRITTEN = "W" 
      *        HOLD-IS-PKEY SET UP
      *        EALIASOF SET UP
      *        OUT-REC WRITTEN FOR ELEMENT, DBPROC
      *        OUT-ELEP-REC WRITTEN 
      *        WORK-AREA = 1ST TOKEN AFTER RESULT CLAUSE
      *        PRO-VAL = "P"
      *        SKIP-FLAG = SPACE
      *    IF ERROR AND REST OF DATA DESCRIPTION ENTRY MUST BE SKIPPED
      *        SKIP-FLAG = "S"
      * 
      ******************************************************************
  
       RESULT-SUB.
           MOVE "P" TO PRO-VAL. 
           IF ENTITY-WRITTEN IS EQUAL TO SPACE
               PERFORM WRITE-ELEMENT-PRO-VAL THRU 
                 WRITE-ELEMENT-PRO-VAL-EXIT.
           IF WORK-AREA IS EQUAL TO "ACTUAL"
               MOVE "AR" TO TYPEPROC
           ELSE 
               MOVE "VR" TO TYPEPROC
           END-IF.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF WORK-AREA IS NOT EQUAL TO "RESULT"
               MOVE "S" TO SKIP-FLAG
               MOVE MSG-115 TO STD-REPORT-REC 
               PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT
               GO TO RESULT-EXIT
           END-IF.
           IF EOF 
             OR WORK-AREA IS EQUAL TO "." 
               GO TO RESULT-EXIT. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
             OR WORK-AREA IS EQUAL TO "." 
               GO TO RESULT-EXIT. 
           IF WORK-AREA IS NOT EQUAL TO "OF"
               GO TO RESULT-10. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
             OR WORK-AREA IS EQUAL TO "." 
               GO TO RESULT-EXIT. 
       RESULT-10. 
           PERFORM DBPROC THRU DBPROC-EXIT. 
           MOVE EALIASOF-FLAG TO OUT-EALIASOF-FLAG. 
           MOVE EALIASOF TO OUT-EALIASOF-NAME.
           MOVE "05" TO OUT-ENTRY-TYPE. 
           MOVE ZERO TO OUT-99-GROUP. 
           MOVE LEVT-CATNAME (LV-SUB) TO OUT-CATNAME. 
           MOVE "400" TO OUT-CATEGORY-TYPE. 
           ADD 1 TO STRUCT-COUNT. 
           MOVE STRUCT-COUNT TO OUT-STCR. 
           MOVE DATA-NAME TO OUT-CDCS-NAME. 
           MOVE "05" TO OUT-FIELD-TYPE. 
           MOVE SPACES TO OUT-FILLER. 
           MOVE IS-CATNAME TO OUT-ELEP-DBPROC.
           MOVE TYPEPROC TO OUT-ELEP-TYPEPROC.
           MOVE SPACES TO OUT-ELEP-TIME, OUT-ELEP-OPTION. 
           CALL "WRKFOUT".
           MOVE "E" TO LEVT-GRP-ELE (LV-SUB). 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
       RESULT-EXIT. 
           EXIT.
  
      ******************************************************************
      * 
      *    SCAN THRU SCAN-EXIT
      * 
      *    COPY NEXT TOKEN TO WORK-AREA 
      * 
      *    ON INPUT 
      *    SCH-LINE (IN-SUB) = 1ST CHARACTER OF TOKEN 
      * 
      *    ON OUTPUT
      *    SCH-LINE (IN-SUB) = 1ST CHARACTER AFTER TOKEN
      *    WORK-AREA (1 : WK-SUB) = TOKEN 
      *    NON-LITERAL TOKEN MAY BE (, ), <, >, PERIOD (IF
      *    PERIOD FOLLOWED BY SPACE IS ENCOUNTERED), OR SERIES OF 
      *    CHARACTERS TERMINATED BY ONE OF THE PREVIOUS SPECIAL 
      *    CHARACTERS OR SPACE.  IF THE TOKEN IS A SERIES OF CHARACTERS 
      *    TERMINATED BY (, ), <, >, OR PERIOD, THE TERMINATING 
      *    CHARACTER 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 SCH-LINE (IN-SUB) IS EQUAL TO QUOTE 
               GO TO SCAN-LIT.
           MOVE SCH-LINE (IN-SUB) TO WORKA (WK-SUB).
           IF SCH-IN (IN-SUB : 2) IS EQUAL TO ". "
             OR SCH-LINE (IN-SUB) IS EQUAL TO "(" 
             OR SCH-LINE (IN-SUB) IS EQUAL TO ")" 
             OR SCH-LINE (IN-SUB) IS EQUAL TO "<" 
             OR SCH-LINE (IN-SUB) IS EQUAL TO ">" 
               ADD 1 TO IN-SUB
               IF IN-SUB IS GREATER THAN 72 
                   PERFORM READ-SCHFIL THRU READ-SCHFIL-EXIT
               END-IF 
               GO TO SCAN-EXIT
           END-IF.
       SCAN-LOOP. 
           ADD 1 TO IN-SUB. 
           IF SCH-LINE (IN-SUB) IS EQUAL TO SPACE 
             OR SCH-LINE (IN-SUB) IS EQUAL TO "," 
             OR SCH-LINE (IN-SUB) IS EQUAL TO ";" 
               IF IN-SUB IS GREATER THAN 72 
                   PERFORM READ-SCHFIL THRU READ-SCHFIL-EXIT
               END-IF 
               GO TO SCAN-LOOP-END
           END-IF.
           IF SCH-IN (IN-SUB : 2) IS EQUAL TO ". "
             OR SCH-LINE (IN-SUB) IS EQUAL TO "(" 
             OR SCH-LINE (IN-SUB) IS EQUAL TO ")" 
             OR SCH-LINE (IN-SUB) IS EQUAL TO "<" 
             OR SCH-LINE (IN-SUB) IS EQUAL TO ">" 
               GO TO SCAN-LOOP-END. 
           ADD 1 TO WK-SUB. 
           MOVE SCH-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 SCH-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-SCHFIL THRU READ-SCHFIL-EXIT
               IF END-SW IS EQUAL TO "E"
                   MOVE QUOTE TO SCH-LINE (1) 
                   MOVE SPACE TO SCH-LINE (2) 
               END-IF 
           END-IF.
           MOVE SCH-LINE (IN-SUB) TO WORKA (WK-SUB).
           IF SCH-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-SCHFIL THRU READ-SCHFIL-EXIT
               IF END-SW IS EQUAL TO "E"
                   MOVE SPACES TO SCH-LINE (1)
               END-IF 
           END-IF 
           IF SCH-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 SCH-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-SCHFIL THRU READ-SCHFIL-EXIT
               IF END-SW IS EQUAL TO "E"
                   GO TO SCAN-EXIT
               END-IF 
           END-IF.
           IF SCH-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-SCHFIL THRU READ-SCHFIL-EXIT
               IF END-SW IS EQUAL TO "E"
                   GO TO SCAN-EXIT
               END-IF 
           END-IF.
           IF SCH-LINE (IN-SUB) IS EQUAL TO QUOTE 
               GO TO SCAN-LIT-DISCARD-LOOP
           END-IF.
       SCAN-EXIT. 
           EXIT.
  
      ******************************************************************
      * 
      *    SCHEMA-ID THRU SCHEMA-ID-EXIT. 
      * 
      *    SCANS SCHEMA IDENTIFICATION ENTRY, PREPARES SCHEMA ENTITY
      *    AND WRITES ENTITY TO WORK-FILE AND IS-FILE 
      * 
      *    ON INPUT 
      *    WORK-AREA = "SCHEMA" 
      *    SCHEMA-ORD = ORDINAL OF PREVIOUS SCHEMA
      * 
      *    ON OUTPUT
      *    WORK-AREA = 1ST TOKEN AFTER SCHEMA ID ENTRY
      *    SCHEMA-ORD INCREMENTED BY 1
      *    SCHEMA ENTITY RECORD WRITTEN TO WORK-FILE AND IS-FILE
      *    SCHEMA-NAME, SCHEMA-CATNAME SET UP 
      *    NOTE-CDCS-REC DESCRIBES CURRENT SCHEMA 
      * 
      ******************************************************************
  
       SCHEMA-ID. 
           ADD 1 TO SCHEMA-ORD. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF END-SW IS EQUAL TO "E"
               GO TO SCH-END. 
           IF WORK-AREA IS NOT EQUAL TO "NAME"
               GO TO SCHEMA-ID-10.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF END-SW IS EQUAL TO "E"
               GO TO SCH-END. 
       SCHEMA-ID-10.
           IF WORK-AREA IS NOT EQUAL TO "IS"
               GO TO SCHEMA-ID-20.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF END-SW IS EQUAL TO "E"
               GO TO SCH-END. 
       SCHEMA-ID-20.
           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 "26" TO IS-ENTITY-TYPE. 
           MOVE SCHEMA-ORD TO IS-SCHEMA-ORDINAL.
           MOVE WORK-AREA TO IS-CDCS-NAME.
           PERFORM WRITE-ENTITY THRU WRITE-ENTITY-EXIT. 
           MOVE OUT-CDCS-NAME TO SCHEMA-NAME, NOTE-CDCS-NAME. 
           MOVE OUT-CATNAME TO SCHEMA-CATNAME, NOTE-CATNAME.
           MOVE "26" TO NOTE-ENTRY-TYPE.
           MOVE ZERO TO NOTE-99-GROUP.
           MOVE "001" TO NOTE-CATEGORY-TYPE.
           WRITE IS-REC.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF END-SW IS EQUAL TO "E"
               GO TO SCH-END. 
           IF WORK-AREA IS NOT EQUAL TO "." 
               MOVE MSG-10 TO STD-REPORT-REC
               PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT
           ELSE 
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               IF END-SW IS EQUAL TO "E"
                   GO TO SCH-END
               END-IF 
           END-IF.
       SCHEMA-ID-EXIT.
           EXIT.
  
      ******************************************************************
      * 
      *    SEARCH-FOR-CATNAME THRU SEARCH-FOR-CATNAME-EXIT
      * 
      *    SEARCH IS-FILE FOR DATA ITEM NAMED FIND-DATA-NAME OF RECORD
      *    NAMED FIND-RECORD-NAME.  IF FIND-RECORD-NAME IS EQUAL TO 
      *    SPACES, RETURN CATNAME OF FIRST ELEMENT NAMED FIND-DATA-NAME 
      *    ENCOUNTERED. 
      * 
      *    ON INPUT 
      *    FIND-DATA-NAME = NAME OF DATA ITEM 
      *    IF FIRST OCCURRENCE OF FIND-DATA-NAME DESIRED, 
      *        FIND-RECORD-NAME = SPACE 
      *    IF DATA NAME MUST BELONG TO SPECIFIC RECORD, 
      *        FIND-RECORD-NAME = RECORD NAME 
      *    TO FIND ELEMENT ONLY 
      *        CATNAME-MAY-BE-GROUP = SPACE 
      *    TO FIND ELEMENT OR GROUP 
      *        CATNAME-MAY-BE-GROUP = "G" 
      * 
      *    ON OUTPUT
      *    IF DESIRED OCCURRENCE OF DATA-NAME NOT FOUND,
      *        FIND-CATNAME = SPACE 
      *        FIND-ALIAS = SPACE 
      * 
      *    IF DESIRED OCCURRENCE OF DATA-NAME FOUND,
      *        FIND-CATNAME = CATNAME OF ITEM 
      *        FIND-ALIAS = ALIAS NUMBER OF ITEM
      *        IF RECORD QUALIFIER GIVEN (FIND-RECORD-NAME <> SPACE)
      *            FIND-RECORD-CATNAME = CATNAME OF ITEM'S RECORD 
      *        IF NO RECORD QUALIFIER GIVEN (FIND-RECORD-NAME = SPACE)
      *            FIND-RECORD-CATNAME = SPACE
      * 
      ******************************************************************
  
       SEARCH-FOR-CATNAME.
           MOVE SPACES TO FIND-CATNAME, FIND-ALIAS, FIND-RECORD-CATNAME.
           IF FIND-RECORD-NAME IS  EQUAL TO SPACES
               GO TO SEARCH-FOR-CATNAME-05. 
           MOVE "13" TO IS-ENTITY-TYPE. 
           MOVE SCHEMA-ORD TO IS-SCHEMA-ORDINAL.
           MOVE FIND-RECORD-NAME TO IS-CDCS-NAME. 
           START IS-FILE KEY IS EQUAL TO IS-ALTKEY
             INVALID KEY GO TO SEARCH-FOR-CATNAME-EXIT. 
           READ IS-FILE.
           MOVE IS-CATNAME TO FIND-RECORD-CATNAME.
       SEARCH-FOR-CATNAME-05. 
           MOVE "05" TO IS-ENTITY-TYPE. 
           MOVE SCHEMA-ORD TO IS-SCHEMA-ORDINAL.
           MOVE FIND-DATA-NAME TO IS-CDCS-NAME. 
           MOVE IS-ALTKEY TO FIND-IS-ALTKEY.
       SEARCH-FOR-CATNAME-07. 
           START IS-FILE KEY IS EQUAL TO IS-ALTKEY
             INVALID KEY GO TO SEARCH-FOR-CATNAME-20. 
       SEARCH-FOR-CATNAME-10. 
           READ IS-FILE.
           IF IS-ALTKEY IS NOT EQUAL TO FIND-IS-ALTKEY
               GO TO SEARCH-FOR-CATNAME-20. 
           IF FIND-RECORD-NAME IS EQUAL TO SPACES 
             OR FIND-RECORD-CATNAME IS EQUAL TO IS-ELE-RECORD-CATNAME 
               MOVE IS-CATNAME TO FIND-CATNAME
               IF FIND-RECORD-NAME IS NOT EQUAL TO SPACES 
                   MOVE IS-ELE-RECORD-CATNAME TO FIND-RECORD-CATNAME
               END-IF 
               IF IS-ALIAS-NO IS NOT EQUAL TO ZERO
                   MOVE IS-ALIAS-NO TO FIND-ALIAS 
               END-IF 
               GO TO SEARCH-FOR-CATNAME-EXIT
           END-IF.
           GO TO SEARCH-FOR-CATNAME-10. 
       SEARCH-FOR-CATNAME-20. 
           IF CATNAME-MAY-BE-GROUP IS EQUAL TO SPACE
               GO TO SEARCH-FOR-CATNAME-EXIT. 
           MOVE SPACE TO CATNAME-MAY-BE-GROUP.
           MOVE "10" TO FIND-IS-ENTITY-TYPE.
           MOVE FIND-IS-ALTKEY TO IS-ALTKEY.
           GO TO SEARCH-FOR-CATNAME-07. 
       SEARCH-FOR-CATNAME-EXIT. 
           EXIT.
  
  
      ******************************************************************
      * 
      *    SEARCH-FOR-ELEMENT THRU SEARCH-FOR-ELEMENT-EXIT
      * 
      *    SEARCH IS-FILE FOR ELEMENT NAMED DATA-NAME 
      * 
      *    ON INPUT 
      *    SCHEMA-ORDINAL = SCHEMA ORDINAL
      *    DATA-NAME = NAME OF ELEMENT
      * 
      *    ON OUTPUT
      *    IF ELEMENT NAMED DATA-NAME NOT FOUND,
      *        NAME-FOUND = SPACE 
      *        ALIAS-NO = ZERO
      *    IF ELEMENT NAMED DATA-NAME FOUND,
      *        NAME-FOUND = "T" 
      *        ALIAS-NO = NEXT HIGHEST ALIAS-NO FOR DATA-NAME 
      *        SEQ-NO = NEXT HIGHEST SEQ-NO FOR DATA-NAME 
      *        EALIASOF = CATNAME OF FIRST OCCURRENCE 
      *        EALIASOF-FLAG = "E"
      *        IF AN OCCURRENCE HAS NO PROCESS OR VALUE INFO
      *            NAME-FOUND-NO-PRO-VAL = "T"
      *            IS-ELE-REC CONTAINS ELEMENT WITH GIVEN 
      *              NAME AND NO PROCESS OR VALUE INFO
      *        IF ALL OCCURRENCES HAVE PROCESS OR VALUE INFO
      *            NAME-FOUND-NO-PRO-VAL = SPACE
      *        IF AN ALIAS OF DATA-NAME FOUND WITH SAME ATTRIBUTES AS 
      *          HOLD-ATTRIBUTE 
      *            ALIAS-WITH-SAME-ATT = ALIAS-NO OF THAT ALIAS 
      * 
      ******************************************************************
  
       SEARCH-FOR-ELEMENT.
           MOVE "05" TO IS-ENTITY-TYPE. 
           MOVE SCHEMA-ORD TO IS-SCHEMA-ORDINAL.
           MOVE DATA-NAME TO IS-CDCS-NAME.
           MOVE IS-ALTKEY TO HOLD-IS-ALTKEY.
           MOVE SPACE TO EALIASOF, NAME-FOUND, NAME-FOUND-NO-PRO-VAL, 
             EALIASOF-FLAG. 
           MOVE ZERO TO ALIAS-NO, SEQ-NO, ALIAS-WITH-SAME-ATT 
           START IS-FILE KEY IS EQUAL TO IS-ALTKEY
             INVALID KEY GO TO SEARCH-FOR-ELEMENT-EXIT. 
       SEARCH-FOR-ELEMENT-10. 
           READ IS-FILE.
           IF IS-ALTKEY IS NOT EQUAL TO HOLD-IS-ALTKEY
               GO TO SEARCH-FOR-ELEMENT-20. 
           IF IS-SEQ-NO IS NOT EQUAL TO ZERO
             OR IS-ALIAS-NO IS NOT EQUAL TO ZERO
               IF IS-SEQ-NO IS GREATER THAN SEQ-NO
                   MOVE IS-SEQ-NO TO SEQ-NO 
               END-IF 
               IF IS-ALIAS-NO IS GREATER THAN ALIAS-NO
                   MOVE IS-ALIAS-NO TO ALIAS-NO 
               END-IF 
               IF IS-ALIAS-NO IS NOT EQUAL TO ZERO
                 AND ALIAS-WITH-SAME-ATT IS EQUAL TO ZERO 
                 AND HOLD-ATTRIBUTE IS EQUAL TO IS-ELE-ATTRIBUTE
                   MOVE IS-ALIAS-NO TO ALIAS-WITH-SAME-ATT
               END-IF 
               GO TO SEARCH-FOR-ELEMENT-10
           END-IF.
           MOVE "T" TO NAME-FOUND.
           IF EALIASOF-FLAG IS EQUAL TO SPACE 
               MOVE IS-CATNAME TO EALIASOF
               MOVE "E" TO EALIASOF-FLAG
               END-IF.
           IF IS-ELE-PRO-VAL IS EQUAL TO SPACE
             AND NAME-FOUND-NO-PRO-VAL IS EQUAL TO SPACE
               MOVE "T" TO NAME-FOUND-NO-PRO-VAL
               MOVE IS-PKEY TO HOLD-IS-PKEY 
           END-IF.
           GO TO SEARCH-FOR-ELEMENT-10. 
       SEARCH-FOR-ELEMENT-20. 
           IF NAME-FOUND-NO-PRO-VAL IS EQUAL TO "T" 
               MOVE HOLD-IS-PKEY TO IS-PKEY 
               START IS-FILE KEY IS EQUAL TO IS-PKEY
               READ IS-FILE 
           END-IF.
           ADD 1 TO ALIAS-NO. 
           ADD 1 TO SEQ-NO. 
       SEARCH-FOR-ELEMENT-EXIT. 
           EXIT.
  
      ******************************************************************
      * 
      *    SEQUENCE-ROUTINE THRU SEQUENCE-EXIT. 
      * 
      *    SCANS SEQUENCE CLAUSE, PREPARES AND WRITES 
      *    OUT-AREAA-SEQ-REC. 
      * 
      *    ON INPUT 
      *    WORK-AREA = "SEQUENCE" 
      *    AREA-NAME, AREA-CATNAME SET UP 
      * 
      *    ON OUTPUT
      *    IF NO ERROR
      *        WORK-AREA = 1ST TOKEN AFTER SEQUENCE ENTRY 
      *        OUT-AREAA-SEQ-REC WRITTEN TO WORK-FILE 
      *        SKIP-FLAG = SPACE
      *    IF ERROR AND REST OF AREA CONTROL ENTRY MUST BE SKIPPED
      *        SKIP-FLAG = "S"
      * 
      ******************************************************************
  
       SEQUENCE-ROUTINE.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF END-SW IS EQUAL TO "E"
               GO TO SCH-END. 
           IF WORK-AREA IS NOT EQUAL TO "IS"
               GO TO SEQUENCE-10. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF END-SW IS EQUAL TO "E"
               GO TO SCH-END. 
       SEQUENCE-10. 
           MOVE SPACE TO OUT-FILLER.
           IF WORK-AREA IS EQUAL TO "ASCII" 
               MOVE "A" TO OUT-AREAA-SEQUENCE.
           IF WORK-AREA IS EQUAL TO "COBOL" 
               MOVE "C" TO OUT-AREAA-SEQUENCE.
           IF WORK-AREA IS EQUAL TO "DISPLAY" 
               MOVE "D" TO OUT-AREAA-SEQUENCE.
           IF OUT-AREAA-SEQUENCE IS EQUAL TO SPACE
               MOVE MSG-75 TO STD-REPORT-REC
               PERFORM PROCESS-ERROR THRU PROCESS-ERROR-EXIT
               MOVE "S" TO SKIP-FLAG
               GO TO SEQUENCE-EXIT
           END-IF.
           MOVE "22" TO OUT-ENTRY-TYPE. 
           MOVE SPACES TO OUT-EALIASOF-FLAG, OUT-EALIASOF-NAME
           MOVE ZERO TO OUT-99-GROUP. 
           MOVE AREA-CATNAME TO OUT-CATNAME.
           MOVE "210" TO OUT-CATEGORY-TYPE. 
           ADD 1 TO STRUCT-COUNT. 
           MOVE STRUCT-COUNT TO OUT-STCR. 
           MOVE AREA-NAME TO OUT-CDCS-NAME. 
           MOVE "39" TO OUT-FIELD-TYPE. 
           CALL "WRKFOUT".
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
       SEQUENCE-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 SCH-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 SCH-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 SCH-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 SCH-END
               END-IF 
               GO TO SKIP-PAST-PERIOD-EXIT
           END-IF.
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
               GO TO SCH-END. 
           GO TO SKIP-PAST-PERIOD-10. 
       SKIP-PAST-PERIOD-EXIT. 
           EXIT.
  
      ******************************************************************
      * 
      *    SPACER THRU SPACER-EXIT
      * 
      *    SPACE OVER BLANKS, COMMAS, AND SEMICOLONS.     PROCESS COMMENTS
      * 
      *    ON OUTPUT
      *    SCH-LINE (IN-SUB) = FIRST CHARACTER OF NEXT TOKEN
      *    IF AN ENTITY HAS BEEN PROCESSED, ALL COMMENTS HAVE 
      *    BEEN WRITTEN AS DESCRIPTION RECORDS
      * 
      ******************************************************************
  
       SPACER.
           IF SCH-LINE (IN-SUB) IS NOT EQUAL TO SPACE 
             AND SCH-LINE (IN-SUB) IS NOT EQUAL TO ","
             AND SCH-LINE (IN-SUB) IS NOT EQUAL TO ";"
               GO TO SPACER-10. 
           ADD 1 TO IN-SUB. 
           IF IN-SUB LESS THAN 73 GO TO SPACER. 
           PERFORM READ-SCHFIL THRU READ-SCHFIL-EXIT. 
           IF END-SW IS EQUAL TO "E"
               GO TO SPACER-EXIT. 
           GO TO SPACER.
       SPACER-10. 
           IF SCH-IN (IN-SUB : 2) IS NOT EQUAL TO "/*"
               GO TO SPACER-EXIT. 
           ADD 2 TO IN-SUB. 
           IF IN-SUB IS GREATER THAN 72 
               PERFORM READ-SCHFIL THRU READ-SCHFIL-EXIT
               IF END-SW IS EQUAL TO "E"
                   GO TO SPACER-EXIT
               END-IF 
           END-IF.
           PERFORM COMMENTER THRU COMMENTER-EXIT. 
           IF END-SW IS NOT EQUAL TO "E"
               GO TO SPACER.
       SPACER-EXIT. 
           EXIT.
  
      ******************************************************************
      * 
      *    TYPE-SUB THRU TYPE-EXIT
      * 
      *    SCAN TYPE CLAUSE.  STORE TYPE IN HOLD-FORMAT.
      *    STORE LENGTH IN HOLD-LENGTH. 
      * 
      *    ON INPUT 
      *    WORK-AREA = "TYPE" 
      * 
      *    ON OUTPUT
      *    WORK-AREA = 1ST TOKEN AFTER TYPE CLAUSE
      *    HOLD-FORMAT, HOLD-LENGTH SET UP
      * 
      ******************************************************************
  
       TYPE-SUB.
           MOVE "E" TO LEVT-GRP-ELE (LV-SUB). 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
             OR WORK-AREA IS EQUAL TO "." 
               GO TO TYPE-EXIT. 
           IF WORK-AREA IS NOT EQUAL TO "IS"
               GO TO TYPE-10. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
             OR WORK-AREA IS EQUAL TO "." 
               GO TO TYPE-EXIT. 
       TYPE-10. 
           IF WORK-AREA IS EQUAL TO "CHARACTER" 
             OR WORK-AREA IS EQUAL TO "CHAR"
               MOVE "C" TO HOLD-FORMAT
               PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT
               GO TO TYPE-50
           END-IF.
           MOVE SPACE TO HOLD-COMPLEX, HOLD-DEC, HOLD-FIXED,
             HOLD-FLOAT, HOLD-REAL. 
           GO TO TYPE-30. 
       TYPE-20. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
             OR WORK-AREA IS EQUAL TO "." 
               GO TO TYPE-40. 
       TYPE-30. 
           IF WORK-AREA IS EQUAL TO "COMPLEX" 
               MOVE "T" TO HOLD-COMPLEX 
               GO TO TYPE-20
           END-IF 
           IF WORK-AREA IS EQUAL TO "DECIMAL" 
             OR WORK-AREA IS EQUAL TO "DEC" 
               MOVE "T" TO HOLD-DEC 
               GO TO TYPE-20
           END-IF 
           IF WORK-AREA IS EQUAL TO "FIXED" 
               MOVE "T" TO HOLD-FIXED 
               GO TO TYPE-20
           END-IF 
           IF WORK-AREA IS EQUAL TO "FLOAT" 
               MOVE "T" TO HOLD-FLOAT 
               GO TO TYPE-20
           END-IF 
           IF WORK-AREA IS EQUAL TO "REAL"
               MOVE "T" TO HOLD-REAL
               GO TO TYPE-20
           END-IF 
       TYPE-40. 
           IF HOLD-COMPLEX IS EQUAL TO "T"
               IF HOLD-DEC IS EQUAL TO "T"
                   MOVE "COD" TO HOLD-FORMAT
               ELSE 
                   MOVE "CO" TO HOLD-FORMAT 
               END-IF 
           GO TO TYPE-50
           END-IF.
           IF HOLD-DEC IS EQUAL TO "T"
               IF HOLD-FIXED IS EQUAL TO "T"
                   IF HOLD-REAL IS EQUAL TO "T" 
                       MOVE "DFR" TO HOLD-FORMAT
                   ELSE 
                       MOVE "FID" TO HOLD-FORMAT
                   END-IF 
                   GO TO TYPE-50
               END-IF 
               IF HOLD-FLOAT IS EQUAL TO "T"
                   IF HOLD-REAL IS EQUAL TO "T" 
                       MOVE "DRF" TO HOLD-FORMAT
                   ELSE 
                       MOVE "FD" TO HOLD-FORMAT 
                   END-IF 
                   GO TO TYPE-50
               END-IF 
               IF HOLD-REAL IS EQUAL TO "T" 
                   MOVE "DR" TO HOLD-FORMAT 
               ELSE 
                   MOVE "D" TO HOLD-FORMAT
               END-IF 
               GO TO TYPE-50
           END-IF.
           IF HOLD-FIXED IS EQUAL TO "T"
               IF HOLD-REAL IS EQUAL TO "T" 
                   MOVE "FIR" TO HOLD-FORMAT
               ELSE 
                   MOVE "FI" TO HOLD-FORMAT 
               END-IF 
               GO TO TYPE-50
           END-IF.
           IF HOLD-FLOAT IS EQUAL TO "T"
               IF HOLD-REAL IS EQUAL TO "T" 
                   MOVE "FR" TO HOLD-FORMAT 
               ELSE 
                   MOVE "F" TO HOLD-FORMAT
               END-IF 
               GO TO TYPE-50
           END-IF.
           IF HOLD-REAL IS EQUAL TO "T" 
               MOVE "R" TO HOLD-FORMAT. 
       TYPE-50. 
           IF EOF 
             OR WORK-AREA IS EQUAL TO "." 
               GO TO TYPE-EXIT. 
           IF WORKA (1) IS LESS THAN "0"
             OR WORKA (1) IS GREATER THAN "9" 
               GO TO TYPE-EXIT. 
           MOVE WORK-AREA TO HOLD-LENGTH. 
           IF WK-SUB IS GREATER THAN 8
               GO TO TYPE-EXIT. 
           ADD WK-SUB, 1 GIVING LENGTH-SUB. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
             OR WORK-AREA IS EQUAL TO "." 
               GO TO TYPE-EXIT. 
           IF WORK-AREA IS NOT EQUAL TO "," 
               GO TO TYPE-60. 
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
           IF EOF 
             OR WORK-AREA IS EQUAL TO "." 
               GO TO TYPE-EXIT. 
       TYPE-60. 
           IF WORKA (1) IS LESS THAN "0"
             OR WORKA (1) IS GREATER THAN "9" 
               IF WORKA (1) IS NOT EQUAL TO "-" 
                   GO TO TYPE-EXIT
               END-IF 
           END-IF.
           MOVE "." TO HOLD-LENGTH (LENGTH-SUB : 1).
           ADD 1 TO LENGTH-SUB. 
           MOVE WORK-AREA TO HOLD-LENGTH (LENGTH-SUB : END).
           PERFORM GET-NEXT-TOKEN THRU GET-NEXT-TOKEN-EXIT. 
       TYPE-EXIT. 
           EXIT.
  
  
*CALL USERROUT
  
      ******************************************************************
      * 
      *    WRITE-ELEMENT-ATT THRU 
      *        WRITE-ELEMENT-ATT-EXIT 
      * 
      *    IF OUT-REC NOT ALREADY WRITTEN, CALL WRITE-ENTITY
      *      TO WRITE OUT-REC 
      *    IF ELEMENT HAS ATTRIBUTES, WRITE OUT-ELEAT-REC 
      *    CALL WRITE-PARENT-STRUCTURE TO WRITE OUT-GRPS-REC
      *    WRITE IS-ELE-REC 
      * 
      *    ON INPUT 
      *    DATA-NAME = NAME OF ELEMENT
      *    LEVEL-TABLE, PRO-VAL SET 
      *    OUT-EALIASOF-FLAG, OUT-EALIASOF-NAME SET 
      *    HOLD-ATTRIBUTE, ALIAS-NO SET 
      * 
      *    ON OUTPUT
      *    OUT-REC, OUT-ELEAT-REC, OUT-GRPS-REC, IS-ELE-REC 
      *      WRITTEN
      * 
      ******************************************************************
  
       WRITE-ELEMENT-ATT. 
           MOVE "05" TO IS-ENTITY-TYPE. 
           MOVE SCHEMA-ORD TO IS-SCHEMA-ORDINAL.
           MOVE DATA-NAME TO IS-CDCS-NAME.
           MOVE ZERO TO OUT-99-GROUP. 
           IF ENTITY-WRITTEN IS EQUAL TO SPACE
               ADD 1 TO STRUCT-COUNT
               MOVE STRUCT-COUNT TO OUT-STCR
               PERFORM WRITE-ENTITY THRU WRITE-ENTITY-EXIT
               MOVE OUT-CATNAME TO LEVT-CATNAME (LV-SUB)
               MOVE "W" TO ENTITY-WRITTEN 
           END-IF.
           IF HOLD-ATTRIBUTE IS NOT EQUAL TO SPACE
               MOVE "210" TO OUT-CATEGORY-TYPE
               ADD 1 TO STRUCT-COUNT
               MOVE STRUCT-COUNT TO OUT-STCR
               MOVE "05" TO OUT-FIELD-TYPE
               MOVE SPACES TO OUT-FILLER
               MOVE HOLD-ATTRIBUTE TO OUT-ELEAT-ATTRIBUTE 
               CALL "WRKFOUT" 
           END-IF.
           MOVE OUT-EALIASOF-FLAG TO IS-ELE-EALIASOF-FLAG.
           PERFORM WRITE-PARENT-STRUCTURE.
           MOVE ZERO TO IS-ELE-SSCH-ORDINAL.
           MOVE LEVT-CATNAME (1) TO IS-ELE-RECORD-CATNAME.
           MOVE LEVT-CATNAME (LV-SUB-M1) TO IS-ELE-PARENT-CATNAME.
           MOVE LEVT-LEVEL-NO (LV-SUB) TO IS-ELE-LEVEL-NO.
           MOVE HOLD-ATTRIBUTE TO IS-ELE-ATTRIBUTE. 
           MOVE PRO-VAL TO IS-ELE-PRO-VAL.
           WRITE IS-ELE-REC.
       WRITE-ELEMENT-ATT-EXIT.
           EXIT.
  
      ******************************************************************
      * 
      *    WRITE-ELEMENT-PRO-VAL THRU WRITE-ELEMENT-PRO-VAL-EXIT
      * 
      *    THE CURRENT ELEMENT HAS PROCES OR VALUE INFORMATION SO IT
      *    CANNOT USE OR BE THE ALIAS OF A PREVIOUS ELEMENT OF THE
      *    SAME NAME. 
      *    READ IS-FILE TO DETERMINE IF ANOTHER ELEMENT WITH SAME NAME
      *    EXITS.  IF SO MAKE THIS ELEMENT THE EALIASOF THE EXISTING
      *    ELEMENT.  CALL WRITE-ENTITY TO WRITE OUT-REC.
      * 
      *    ON INPUT 
      *    LEVEL-TABLE, LV-SUB SET UP 
      *    DATA-NAME SET UP.
      * 
      *    ON OUTPUT
      *    ENTITY-WRITTEN = "W" 
      *    HOLD-IS-PKEY = IS-PKEY 
      *    LEVT-CATNAME (LV-SUB) = CATNAME
      *    OUT-REC WRITTEN TO WORK-FILE 
      * 
      ******************************************************************
  
       WRITE-ELEMENT-PRO-VAL. 
           MOVE "05" TO IS-ENTITY-TYPE. 
           MOVE SCHEMA-ORD TO IS-SCHEMA-ORDINAL.
           MOVE DATA-NAME TO IS-CDCS-NAME.
           MOVE SPACES TO OUT-EALIASOF-FLAG, OUT-EALIASOF-NAME, 
             EALIASOF-FLAG, EALIASOF. 
           MOVE 0 TO OUT-99-GROUP.
           ADD 1 TO STRUCT-COUNT. 
           MOVE STRUCT-COUNT TO OUT-STCR. 
           START IS-FILE KEY IS EQUAL TO IS-ALTKEY
               INVALID KEY GO TO WRITE-ELEMENT-PRO-VAL-10.
           READ IS-FILE.
           MOVE "E" TO OUT-EALIASOF-FLAG, EALIASOF-FLAG.
           MOVE IS-CATNAME TO OUT-EALIASOF-NAME, EALIASOF.
       WRITE-ELEMENT-PRO-VAL-10.
           PERFORM WRITE-ENTITY THRU WRITE-ENTITY-EXIT. 
           MOVE IS-PKEY TO HOLD-IS-PKEY.
           MOVE IS-CATNAME TO LEVT-CATNAME (LV-SUB).
           MOVE "W" TO ENTITY-WRITTEN.
       WRITE-ELEMENT-PRO-VAL-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. 
       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.
           MOVE SPACES TO OUT-FILLER. 
           CALL "WRKFOUT".
       WRITE-ENTITY-EXIT. 
           EXIT.
  
      ******************************************************************
      * 
      *    WRITE-NOTE THRU WRITE-NOTE-EXIT
      * 
      *    IF "INCLUDE NOTES" WAS NOT SPECIFIED, IF SOURCE IS BEING 
      *    SKIPPED DUE TO AN ERROR, OR IF NO ENTITY HAS BEEN IDENTIFIED,
      *    EXIT.  SAVE CURRENT RECORD AREA.  FILL IN OUT-NOTE-REC 
      *    FROM NOTE-CDCS-REC AND COMMENT-AREA.  WRITE OUT-NOTE-REC.
      *    RESTORE CURRENT RECORD AREA.  NOTE-CDCS-REC IS SET UP ON 
      *    THE ASSUMPTION THAT COMMENTS ARE PART OF OR FOLLOW ENTRIES 
      *    THAT THEY DESCRIBE.
      * 
      *    ON INPUT 
      *    NOTE-CDCS-REC DESCRIBES ENTRY WHICH THIS COMMENT DESCRIBES 
      *    COMMENT-AREA CONTAINS COMMENT
      * 
      *    ON OUTPUT
      *    OUT-NOTE-REC WRITTEN TO WRKFILE
      * 
      ******************************************************************
  
       WRITE-NOTE.
           IF SKIP-FLAG IS EQUAL TO "S" 
             OR NOTE-ENTRY-TYPE IS EQUAL TO SPACE 
             OR INCLUDE-NOTES IS EQUAL TO SPACE 
               GO TO WRITE-NOTE-EXIT. 
           MOVE OUT-SSCHR-EXP-REC TO NOTE-HOLD-CDCS-REC.
           MOVE NOTE-ENTRY-TYPE TO OUT-ENTRY-TYPE.
           MOVE NOTE-99-GROUP TO OUT-99-GROUP.
           MOVE NOTE-CATNAME TO OUT-CATNAME.
           MOVE NOTE-CATEGORY-TYPE TO OUT-CATEGORY-TYPE.
           ADD 1 TO STRUCT-COUNT. 
           MOVE STRUCT-COUNT TO OUT-STCR. 
           MOVE NOTE-CDCS-NAME TO OUT-CDCS-NAME.
           MOVE "01" TO OUT-FIELD-TYPE. 
           MOVE SPACES TO OUT-FILLER. 
           MOVE COMMENT-AREA TO OUT-NOTE. 
           CALL "WRKFOUT".
           MOVE NOTE-HOLD-CDCS-REC TO OUT-SSCHR-EXP-REC.
       WRITE-NOTE-EXIT. 
           EXIT.
  
      ******************************************************************
      * 
      *    WRITE-PARENT-STRUCTURE THRU WRITE-PARENT-STRUCTURE-EXIT
      * 
      *    WRITE OUT-GRPS-REC 
      *    IF ELEMENT OR GROUP HAS OCCURS INFORMATION 
      *    WRITE OUT-GRPS-OCCURS-REC
      * 
      *    ON INPUT 
      *    LEVEL-TABLE SET UP.
      *    LV-SUB IS INDEX OF CURRENT ELEMENT OR GROUP
      *    LV-SUB-M1 IS INDEX OF ITS PARENT 
      *    OCCURS-TO, TALIAS, ALIAS-NO SET UP 
      * 
      *    ON OUTPUT
      *    OUT-GRPS-REC, OUT-GRPS-OCCUR-REC WRITTEN 
      * 
      ******************************************************************
  
       WRITE-PARENT-STRUCTURE.
           MOVE SPACES TO OUT-EALIASOF-FLAG, OUT-EALIASOF-NAME, 
             OUT-FILLER.
           MOVE LEVT-CATNAME (LV-SUB-M1) TO OUT-CATNAME.
           MOVE "300" TO OUT-CATEGORY-TYPE. 
           ADD 1 TO STRUCT-COUNT. 
           MOVE STRUCT-COUNT TO OUT-STCR. 
           MOVE LEVT-CDCS-NAME (LV-SUB-M1) TO OUT-CDCS-NAME.
           MOVE "05" TO OUT-FIELD-TYPE. 
           MOVE LEVT-CATNAME (LV-SUB) TO OUT-GRPS-CATNAME.
           MOVE ALIAS-NO TO OUT-GRPS-ALIAS. 
           MOVE SPACES TO OUT-GRPS-REDEFINE, OUT-GRPS-RDALIAS,
             OUT-GRPS-USAGE, OUT-GRPS-FILLER. 
           IF LV-SUB IS EQUAL TO 2
               MOVE "13" TO OUT-ENTRY-TYPE
               MOVE 0 TO OUT-99-GROUP 
           ELSE 
               MOVE "10" TO OUT-ENTRY-TYPE
               SUBTRACT LEVT-LEVEL-NO (LV-SUB-M1) FROM
                   99 GIVING OUT-99-GROUP 
           END-IF.
           CALL "WRKFOUT".
           IF OCCURS-TO IS NOT EQUAL TO SPACE 
               ADD 1 TO STRUCT-COUNT
               MOVE STRUCT-COUNT TO OUT-STCR
               MOVE "10" TO OUT-FIELD-TYPE
               MOVE SPACES TO OUT-FILLER
               MOVE OCCURS-TO TO OUT-GRPS-TO
               MOVE TALIAS TO OUT-GRPS-TALIAS 
               CALL "WRKFOUT" 
           END-IF.
       WRITE-PARENT-STRUCTURE-EXIT. 
           EXIT.
  
      ******************************************************************
      * 
      *    WRITE-SCHS THRU WRITE-SCHS-EXIT
      * 
      *    WRITE SCHEMA STRUCTURE RECORD FOR SCHEMA CONTAINS MASTER AREA
      * 
      *    ON INPUT 
      *    AREA-CATNAME = AREA CATNAME
      *    SCHEMA-NAME = SCHEMA NAME
      *    SCHEMA-CATNAME = SCHEMA CATNAME
      * 
      *    ON OUTPUT
      *    OUT-SCHS-REC WRITTEN TO WRKFILE
      * 
      ******************************************************************
  
       WRITE-SCHS.
           MOVE "26" TO OUT-ENTRY-TYPE. 
           MOVE SPACES TO OUT-EALIASOF-FLAG, OUT-EALIASOF-NAME, 
             OUT-FILLER.
           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 "MASTER" TO OUT-SCHS-AVERS. 
           CALL "WRKFOUT".
       WRITE-SCHS-EXIT. 
           EXIT.
