*DECK DCSYNX
USETEXT TSCXREF,TDLSCOM,TSCHTBL,TSCDCTB,TCKSCOM 
      PRGM DL30102;                # THIS IS 1,2 OVERLAY               # DL3A030
      BEGIN 
# THIS PROGRAM CONTAINS THE SEMANTIC ROUTINES FOR # 
# THE DATA CONTROL ENTRY - DDL SCHEMA             # 
  
      DEF  AREA$NAME    #   4#;    # AREA NAME TYPE, TO BE USED BY     #
                                   # HASH ROUTINE HASHIT               #
      DEF  DCFIXLENG    #  41#;    # LENGTH OF FIXED PART OF DC ENTRY  #
      DEF  DCPREFIT     #   6#;    # NUMBER OF WORDS IN DC BEFORE FIT  #
      DEF  DEFINED      #   1#;    # ENTRY BEING HASHED IS DEFINED, AS #
                                   # OPPOSED TO REFERENCED             #
      DEF  DFMAXKL      # 240#;    # MAXIMUM SIZE OF KEY ITEM, AS      #
                                   # RESTRICTED BY CDCS                #
      DEF  ITEM$NAME    #   1#;    # ITEM NAME TYPE, TO BE USED BY THE #
                                   # HASH ROUTINE HASHIT               #
      DEF MAXDCENTLEN #1216#;     #MAX DATA CONTROL ENTRY LENGTH,IN THE#
                                  #ABSENCE OF A MEMORY MANAGEMENT SCH- #
                                  #EME. THEORETICAL MAX IS 32767.      #
      DEF RECORD$NAME #2#;
      DEF REFERENCED #0#; 
      DEF SCCWPTR #0#;
      DEF FITLENGTH #35#; 
      DEF SQ #0#; 
      DEF WA #1#; 
      DEF IS #3#; 
      DEF DA #5#; 
      DEF AK #6#; 
  
      XREF ARRAY ZDFFIT[0] S(1);; 
      BASED ARRAY FIT[0] S(1);
*CALL FITCOM
  
      XREF PROC RFITZDF;     # PROCESSES FILE CARD INFORMATION         #
  
  
      ITEM ACCUMSIZE    U;         # CUMULATIVE SIZE OF CONCAT KEY     #
      ITEM JJ           I;         # SCRATCH INDEX VARIABLE            #
      ITEM KEYRCP       U;         # RELATIVE CHARACTER POSITION OF KEY#
      ITEM NOKEY        B;         # TRUE IF NO KEY FOUND IN RECORD    #
      ITEM NUMITEMS     U;         # NUMBER OF ITEMS WITHIN RECORD     #
      ITEM RCP          U;         # RELATIVE CHARACTER POSITION       #
      ITEM SAVEDBADDR   U;         # TEMPORARY FOR BASE ADDRESS        #
      ITEM SIZE         U;         # TEMPORARY SIZE FOR COMPUTING RCP  #
  
      ITEM ALTERKY B,    # TRUE IF ALTERNATE KEY SPECIFIED    # 
           AREAWA,       # WORD ADDRESS OF AREA ENTRY IN SCHEMA # 
           BLANKS C(10) = "          ", 
           BOOLTEMP B,   # TEMPORARY BOOLEAN                  # 
           BYTEINDX U,   # BYTE INDEX INTO THE COLLATING SEQ. TABLE    #
           CDFLAG B,     # TRUE IF COMP/DECOMP CLAUSE WAS SPECIFIED    #
           CKEYSIZE1,    # ACCUMULATED SIZE OF CONCATENATED KEY DATA-  #
                         # NAMES.                                      #
           CKEYSIZE2,    # SIZE OF CONCATENATED KEY FROM BEGINNING POS-#
                         # ITION OF FIRST DATA-NAME TO ENDING POSITION #
                         # OF LAST DATA-NAME.                          #
           COMLOOP,      # LOOP INDUCTION VARIABLE.                    #
           COMPFLG B,    # 1 = COMPRESSION IS SPECIFIED                #
           CONCATPTR,    # VARIABLE POINTER FOR CONCATENATED KEY ENTRY #
           DCFLAG B,     # TRUE IF DATA CTL ENTRY WRITTEN # 
           DCMPFLG B,    # 1 = DECOMPRESSION SPECIFIED                 #
           DCPTR,        # PTR TO DATA CONTROL ADDRESS IN SCHEMA# 
           DIRWA,        # TEMP CELL FOR WORD ADDRESS FOR I/O  #
           FILEORG,      # FILE ORGANIZATION FROM ZZZZZDF FILE #
          TFITCL, 
          TFITCP, 
          TFITHL, 
          TFITTL, 
           FLAG B,       # TEMPORARY FLAG                      #
           I, 
           J, 
           K, 
           KEYORD,           # KEY ORDINAL                             # C
           L, 
               N, 
           NUMDNAMES,    # TOTAL COUNT OF DATA-NAMES IN CONCATENATED KY#
           LASTKEY,      # INDEX TO LAST KEY ENTRY             #
           LITCTR,       # NEXT AVAIL WORD IN LITERAL STORAGE  #
           LINNUMBIN,  # SOURCE LINE NUMBER IN BINARY # 
           LINNUMDIS,  # SOURCE LINE NUMBER IN DISPLAY DECIMAL #
           LITPTR,       # VARIABLE POINTER TO LITERALS.  # 
           LITRCPTR,     # POINTER TO RECORD CODE LITERAL # 
           LITWRD,
           MNRLENG,       # MINIMUM RECORD LENGTH #                      DL3A051
           MULTRECTY,    # NBR OF RECD TYPES FOR AREA # 
           PRIKEYCT,     # COUNT OF PRIMARY KEYS SPECIFIED     #
           PTRDCAREA,    # POINTER TO FIRST WORD OF CURRENT ENTRY # 
           PTRDCKEY,     # PTR TO FIRST WORD OF KEY ENTRY      #
           PTRDCREC,     # POINTER TO FIRST WORD OF RECORDCODE ENTRY# 
           QUALFLAG B,    # TRUE IF KEY IS QUALIFIED  # 
           RCCDVAL, 
           RCDNREC,      # REC ADDR OF DNAME FOR BY PHRASE #
           RECCDFLAG,        # 0 IF NO RECORD CODE #
           RECCDPTR,         # POINTER TO RECORD CODE ENTRY # 
           RCLITCTR,     # COUNT OF RECORD CODE LITERALS. # 
           RECTYPE, 
           SEPTR,        # POINTS TO THE START OF A SUB-ENTRY # 
           SORTKEYCNT,   # COUNT OF SEQUENTIAL SORT KEYS.              #
           SYMLOC,
           TEMPCLASS,    # LOCATIONS TO SAVE               #
           TEMPCL,       #   TEMPORARY VALUES IN           #
           TEMPCP,       #     ENDOVL                      #
           TEMPHL,
           TEMPMNR,                                                      DL3A051
           TEMPMRL, 
           TEMPPTR,      # TEMPORARY STORAGE FOR KEY POINTER(DPTR).    #
           TEMPSIZE,
           TEMPTL,
           WRDADRREC, 
           WRDITMREC,    # WORD ADDRESS OF RECORD KEY ITEM BELONGS TO  #
           WORDINDX U;   # WORD INDEX INTO THE COLLATING SEQ. TABLE    #
  
      ARRAY DIAG991 [0:9];
        ITEM D991        C(00,00,10) = ["  ***991**", 
                                        "          ", 
                                        "    E KEY ", 
                                        "CHARACTERI", 
                                        "STICS NOT ", 
                                        "THE SAME I", 
                                        "N ALL RECO", 
                                        "RD TYPES F", 
                                        "OR AREA   ", 
                                        "          "];
      ARRAY DIAG992 [0:7];
        ITEM D992        C(00,00,10) = ["  ***992**", 
                                        "          ", 
                                        "    E DATA", 
                                        " CONTROL E", 
                                        "NTRY FOR A", 
                                        "REA       ", 
                                        "          ", 
                                        "MISSING   "];
  
      ARRAY DIAG993 [0:13]; 
        ITEM D993        C(00,00,10) = ["  ***993**", 
                                        "          ", 
                                        "    E RECO", 
                                        "RD CODE VA", 
                                        "LUE IS NOT", 
                                        " EQUAL TO ", 
                                        "CHECK VALU", 
                                        "E LITERAL ", 
                                        "OF CORRESP", 
                                        "ONDING ITE", 
                                        "M FOR REC ", 
                                        "          ", 
                                        "IN AREA   ", 
                                        "          "];
  
      ARRAY DIAG994 [0:13]; 
        ITEM D994        C(00,00,10) = ["  ***994**", 
                                        "          ", 
                                        "    E REC ", 
                                        "          ", 
                                        "IN AREA   ", 
                                        "          ", 
                                        "DOES NOT C", 
                                        "ONTAIN ITE", 
                                        "M CORRESPO", 
                                        "NDING TO D", 
                                        "ATANAME IN", 
                                        " LOCATION,", 
                                        " SIZE, AND", 
                                        " CLASS    "];
  
      ARRAY DIAG995 [0:8];
        ITEM D995        C(00,00,10) = ["  ***995**", 
                                        "          ", 
                                        "    E LITE", 
                                        "RALS SPECI", 
                                        "FIED ON LI", 
                                        "NE      , ", 
                                        "ARE NOT IN", 
                                        " ASCENDING", 
                                        " ORDER    "];
  
      ARRAY DIAG996 [0:12]; 
        ITEM D996        C(00,00,10) = ["  ***996**", 
                                        "          ", 
                                        "    E VARI", 
                                        "ABLE DIMEN", 
                                        "SION GROUP", 
                                        " OR GROUP ", 
                                        "CONTROL IT", 
                                        "EM INCONSI", 
                                        "STENT ACRO", 
                                        "SS RECORD ", 
                                        "TYPES FOR ", 
                                        "AREA      ", 
                                        "          "];
  
      ARRAY DIAG997 [0:11]; 
        ITEM D997        C(00,00,10) = ["  ***997**", 
                                        "          ", 
                                        "    T FILE", 
                                        " CARD VALU", 
                                        "ES FOR HL,", 
                                        "TL,CP,CL,M", 
                                        "NR OR MRL ", 
                                        "OVERWRITTE", 
                                        "N BY SCHEM", 
                                        "A VALUES F", 
                                        "OR AREA   ", 
                                        "          "];
  
      ARRAY DIAG998 [0:8];
        ITEM D998        C(00,00,10) = ["  ***998**", 
                                        "          ", 
                                        "    T VARI", 
                                        "ABLE DIMEN", 
                                        "SION GROUP", 
                                        " WITH RECO", 
                                        "RD TYPE NO", 
                                        "T T, AREA ", 
                                        "          "];
  
      ARRAY DIAG999 [0:7];
        ITEM D999        C(00,00,10) = ["  ***999**", 
                                        "          ", 
                                        "    E NO D", 
                                        "ATA CONTRO", 
                                        "L ENTRY FO", 
                                        "R NON-SEQU", 
                                        "ENTIAL ARE", 
                                        "A         "];
  
      ARRAY LITSTORE [0:130];     # STORAGE FOR LITERALS   #
        BEGIN 
        ITEM LITSTORC C(0,0,10);   # LITERAL STORE FOR COMPARE.        #
        ITEM  LITSTOR         U(0,0,60);
        END 
      ARRAY COBCST [0:7]; 
        ITEM COBCS U(0,0,60) =
          [O"65313233343536370000",    #:ABCDEFG  # 
           O"40414344454647500000",    #HIJKLMNO  # 
           O"51525355565760610000",    #PQRSTUVW  # 
           O"62636466677071720000",    #XYZ01234  # 
           O"73747576771722210000",    #56789+-*  # 
           O"23251520260024140000",    #/()$= ,.  # 
           O"05035402270442060000",    # []:"  ^  # 
           O"07103011011213160000"];    #  <>  :   #
      ARRAY ASCCST [0:7]; 
        ITEM ASCCS U(0,0,60) =
          [O"32414243444546470000",    #:ABCDEFG  # 
           O"50515253545556570000",    #HIJKLMNO  # 
           O"60616263646566670000",    #PQRSTUVW  # 
           O"70717220212223240000",    #XYZ01234  # 
           O"25262730311315120000",    #56789+-*  # 
           O"17101104350014160000",    #/()$= ,.  # 
           O"03737505027701060000",    # []:"  ^  # 
           O"07373436407476330000"];   #  <>   :  # 
  
      ARRAY DISPCST[0:7];          # DISPLAY CODE SEQUENCE TABLE       #
        ITEM DISPCS  U(00,00,60) =
             [O"00010203040506070000",    #:ABCDEFG  #
              O"10111213141516170000",    #HIJKLMNO  #
              O"20212223242526270000",    #PQRSTUVW  #
              O"30313233343536370000",    #XYZ01234  #
              O"40414243444546470000",    #56789+-*  #
              O"50515253545556570000",    #/()$= ,.  #
              O"60616263646566670000",    # []%"_!&  #
              O"70717273747576770000"];   #'?<>@\^   #
  
      BASED ARRAY CSTVAL[0:7];
        ITEM COLSEQ U(0,0,60);
  
      STATUS COLSEQS               # COLLATING SEQUENCE VALUES         #
             DISPLAY, 
             ASCII, 
             COBOL; 
  
      SWITCH SETSEQ:COLSEQS        # SET SEQUENCE VALUES               #
             SETDISP:DISPLAY, 
             SETASCII:ASCII,
             SETCOBOL:COBOL;
  
      SWITCH SCHJUMP
          ABRTDDL,               # CALLS ROUTINE TO ABORT DDL # 
          CHCDEND ,               #CHECK IF COMP OR DECOMP SPECIFIED   #
          CHCDEND1 ,              #CHECK IF BOTH COMP/DECOMP SPECIFIED #
          CHCDFLAG ,              #CHECK IF C/D PREVIOUSLY SPECIFIED   #
          CHKAREA  ,              # CHECK IF DATA CTL ENTRY FOR AREA# 
          CHKCONKY  ,             #FINISH CONCAT.KEY PROCESSING.       #
          CHKDNAME  ,             #VALIDATION DURING CONCAT.KEY PROC.  #
          CHKIMBD  ,              #CHECK IF KEY IS IMBEDDED#
          CHKNEMK,                #CHECK IF IT IS NON-EMBEDDED         #
          CHKORG   ,              #CHECK FILE ORGANIZATION  # 
          CHPRCNM  ,              #CHECK PROC NAME FOR USING CLAUSE  #
          CKSYSFLG,               #CHECK IF SYSTEM SPECIFIED IN C/D    #
          DCAINIT  ,              #INITIALIZE DATA CONTROL AREA CLAUSE# 
          DCINIT   ,              #INITIALIZE DATA CONTROL - BEGINNING #
          DNRDSC   ,              #READ SCHEMA FOR DATANAME IN RECORD # 
          ENDOVL   ,              #FINISH ALL DATA CONTROL PROCESSING#
          HASHCKY  ,              #CALL HASH FOR CONCAT.KEY DEFINITION #
          HASHRA   ,              #CALL HASH FOR AREA REF  #
          HASHRI   ,              #CALL HASH FOR DATANAME REF  #
          HASHRR   ,              #CALL HASH FOR RECORD REF  #
          KEYINIT  ,              #INITIALIZE CONCAT.KEY PROCESSING.   #
          LITRCON  ,              #CONVERT RECORD CODE LITERAL# 
          READFIT  ,              #READ FIT FOR AREA FROM ZDF  #
          RECINIT  ,              #INITIALIZE RECORD CODE  #
          RECNAME  ,              #SET QUAL NAME FOR HASH  #
          SAVNAME  ,              #SAVE DATANAME FOR QUALIFICATION  # 
          SETALTK  ,              #SET ALTERNATE KEY FLAG # 
          SETCDTBL,               #STORE VALUES IN COMP/DECOMP TABLE   #
          SETCSTRN ,              # SET FLAG FOR SONSTRAINT ENTRY      # E
          SETRELTN ,              # SET FLAG FOR RELATION ENTRY        #
          SETSERT ,               # SETS UP CALL TO COMPUTE SUB-ENT LEN#
          STARNM   ,              #STORE AREA NAME  # 
          STCDFLAG ,              #SET FLG TO INDICATE C/D IS SPECIFIED#
          STCMPFG  ,              #SET FLAG FOR COMPRESSION            #
          STDCMPFG ,              #SET FLAG FOR DECOMPRESSION          #
          STDNBY   ,              #STORE DATANAME FOR BY CLAUSE  #
          STDUFIR  ,              #SET FIRST FLAG FOR DUPLICATES  # 
          STDUIND  ,              #SET INDEXED FLAG FOR DUPLICATES  # 
          STDUNOT  ,              #SET NOT FLAG FOR DUPLICATES  # 
          STIMKEY  ,              #STORE IMBEDDED KEY VALUES #
          STIMKT1  ,              #TEST IMBED KEY ITEM TYPE  #
          STIMKT2  ,              #TEST DATANAME IN REC IN THIS AREA# 
          STIMKT4  ,              # CHECK KL FOR AK FILE #
          STINTB   ,              #STORE INTEGER FOR RECORD CODE PROC # 
          STKEYNAM  ,             #STORE CONCAT. KEY-NAME.             #
          STNIKEY  ,              #STORE NON-IMBEDDED KEY VALUES# 
          STNIK2   ,              #CHECK FIT PARAMS FOR NON-IMBED KEY#
          STOSEQ   ,               # SET COLLATING SEQUENCE FIELD      #
          STOLITB  ,              #STORE LITERAL FOR REC CODE BY #
          STOPRNM  ,              #STORE PROC NAME FOR KEY USING #
          STORECB  ,              #STORE RECORD FOR REC CODE BY # 
          STRCBPR  ,              #STORE PROC NAME FOR REC CODE BY #
          STSYSFLG,               #SET FLAG TO INDICATE SYSTEM PROC    #
          STVAL    ,              #STORE COUNT OF RECORD CODE VALUES.  #
          TSDUP    ,              #TEST DUPLICATES OPTIONS  # 
          TSBYLIT  ,              # TEST UNIQUE LITERAL VALUES  # 
          TSBYPRO  ,              #TEST PROC PHRASE FOR RECORDCODE  # 
          TSBYREC  ,              #TEST DNAME PHRASE FOR RECORDCODE  #
          TSDNLEN  ,              #CHECK LENGTH OF RECCODE DNAME LS 240#
          TSKEY    ,              #TEST CONDITIONS FOR ALL KEYS  #
          TSRECCD  ,              #TEST RECORDCODE FOR AREA  #
          TSVAL    ;              #TEST FOR RECORD CODE VALUE FIRST TM# 
  
  
  
  
#**********************************************************************#
# THIS PROC CLOSES SCHEMA AND SYMBOL TABLE FILES, AND CALLS COMPASS    #
# ROUTINE DDLABT TO CLOSE OUTPUT AND ABORT DDL WITH THE MESSAGE        #
#      FATAL SYNTAX ERRORS                                             #
      PROC ABORTDDL;
        BEGIN 
        XREF PROC DDLABT; 
        DDLSU = MAXFL;                      #SET FL FOR ABORT CONDITION#
        CLSEOUT;
        CLSESC; 
        DDLABT ( 0 ); 
      END 
  
  
  
# ***************************************************************#
# THIS PROC COMPLETES THE AREA ENTRY FOR DATA CONTROL, WRITES IT #
# TO DISK, AND ZEROES OUT THE BUFFER IN PREPARATION FOR ANOTHER  #
# AREA ENTRY.  THE ITEM FLAG IS SET TRUE ON ENTRY IF THIS IS THE #
# LAST AREA ENTRY.                                               #
      PROC CLSAREA; 
      BEGIN 
      IF DPTR NQ 0
          THEN
          BEGIN 
# CREATE DUMMY RECORD CODE ENTRY IF ONE WAS NOT SPECIFIED.             #
  
            IF PTRDCREC EQ 0 THEN 
              BEGIN 
              SCDCRECCDFLG[0] = TRUE; 
              SCDCRECCDPTR[0] = DPTR; 
              SCDCRECCDLEN[0] = 2;
              PTRDCREC = DPTR;
              SCDCRCCDELIT[DPTR] = 0; 
              SCDCRCDERECA[DPTR + 1] = WRDADRREC; 
              DPTR = DPTR + 2;
              END 
  
            IF DPTR GR MAXDCENTLEN THEN 
              DIAGDL( 288 ); #MAX DATA CONTROL ENTRY LENGTH EXCEEDED.  #
            IF PRIKEYCT EQ 0 THEN 
              DIAGDL(234);         # NO PRIMARY KEY FOR THIS AREA # 
# STORE MNR IN FIT IF NOT USER SPECIFIED OR INCORRECT,EXCEPT FOR RT=T,F# DL3A051
            IF FITRT[0] NQ 1 AND FITRT[0] NQ 5 AND FITMNR[0] NQ MNRLENG 
              THEN BEGIN     # INCORRECT/MISSING MNR #
              IF FITMNR[0] NQ 0 
                THEN DIAGDL( 218 );    # SEND WARNING DIAGNOSTIC #
              FITMNR[0] = MNRLENG;     # STORE CORRECT MNR IN FIT # 
              END 
            SCDCRECCDPTR [0] = PTRDCREC;
            SCDCALTRKYPT [0] = PTRDCKEY;
            SCDCLENG [0] = DPTR;
            SCDCFITLENG[0] = FITLENGTH;    # FIT LENGTH. #
            SCDCFITPTR[0] = DCPREFIT;  # OFFSET POINTER TO THE FIT. # 
            FOR I = 0 STEP 1 UNTIL FITLENGTH-1 DO 
              BEGIN 
              SCDCARFITWRD[I + PTRDCAREA] = FITWORD[I]; 
              FITWORD[I] = 0; 
              END 
            IF FLAG 
              THEN SCDCNXTAREAP [0] = DPTR; 
            DDLRDSC( SCWORKBUF, AREAFIXW, AREAWA ); 
            SCDCARSYMADR[0] = SCAREASYMADD[0];  # STORE AREA SYMBOL    #
                       # TABLE ADDRESS IN DATA CONTROL HEADER FOR LATER#
                       # PROCESSING BECAUSE THIS FIELD IN THE AREA ENT-#
                       # RY IS OVERWRITTEN BY THE D.C. ENTRY LENGTH.   #
            DDLRTSC( SCDCENTRY, DPTR, NEXTPTR );
            SCAREASYMADD[0] = 0;
            SCAREADCNTLA [0] = NEXTPTR;      #PARAMETERS IN # 
            SCAREADCLENG [0] = DPTR;         # AREA ENTRY   # 
            DDLRTSC( SCWORKBUF, AREAFIXW, AREAWA ); 
            PRIORPTR = NEXTPTR; 
            NEXTPTR = NEXTPTR + DPTR; 
            DPTR = 0; 
            DCFLAG = TRUE;
          END 
      MNRLENG = 0;       # INITIALIZE MNR FOR NEXT AREA #                DL3A051
        FOR I = 0  STEP 1  UNTIL 200  DO
          SCDCRCCDELIT [I] = 0; 
        RETURN; 
      END 
  
  
  
  
#*****************************************************************# 
#   BEGIN EXECUTION OF DATA CONTROL OVERLAY                       # 
      DDLDIAG = LOC (DIAGSTD);
*IF DEF,DEBUG 
      TRACE = LOC (TRACEM); 
*ENDIF
      LEXWD = LOC ( LEXWORD); 
      LEXICO = LOC( LEXICON );
      SYNTBL = LOC (SYNTBLE); 
*IF DEF,DEBUG 
      TRACE = LOC(TRACEM);
*ENDIF
      LBLPTR = LOC (LBLPTRS); 
      SWITCHVECTOR = LOC (SCHJUMP); 
      DCTINIT;
      STD$START;
  
  
  
  
  ABRTDDL:   #*********************************************************#
#****************         A B R T D D L         ***********************#
#   CALLS ROUTINE TO ABORT DDL.                                        #
      ABORTDDL; 
  
  
CHCDEND:      #********************************************************#
#********************       C H C D E N D       ***********************#
#CHECK IF COMPRESSION OR DECOMPRESSION WAS SPECIFIED                   #
      IF NOT (COMPFLG OR DCMPFLG) THEN
        STDNO;
      STDYES; 
  
  
CHCDEND1:         #****************************************************#
#*******************        C H C D E N D 1        ********************#
#CHECKS IF BOTH COMPRESSION AND DECOMPRESSION HAVE BEEN SPECIFIED      #
      IF COMPFLG AND DCMPFLG THEN 
        STDYES; 
      STDNO;
  
  
CHCDFLAG:       #******************************************************#
#*******************        C H C D F L A G         *******************#
#CHECK IF THE COMP/DECOMP CLAUSE WAS PREVIOUSLY SPECIFIED              #
      IF CDFLAG THEN         # COMP/DECOMP CLAUSE PREVIOUSLY SPECIFIED #
        STDNO;
      STDYES; 
  
  
CHKAREA:   #*************************************************#
#**************      C H K A R E A        *******************#
# STDNO IF AREA ALREADY HAS A DATA CONTROL ENTRY SPECIFIED,  #
# ELSE STDYES EXIT.                                          #
      DDLRDSC( SCWORKBUF, AREAFIXW, AREAWA ); 
      IF SCAREADCNTLA [0] NQ 0
        THEN
        BEGIN 
        MULTRECTY = MULTRECTY - 1;
        STDNO;
        END 
      STDYES; 
  
  
CHKDNAME:    #*********************************************************#
#********************     C H K D N A M E     *************************#
#   CHECKS DATA-NAME SPECIFIED IN CONCATENATED KEY ENTRY FOR LEGALITY. #
#   VALIDATION CHECKS PERFORMED AND DIAGNOSTICS ISSUED ARE:            #
#   1)    CHECKS IF DATA-NAME IS DEFINED -- D334                       #
#   2)    CHECKS IF DATA-NAME IS CONTIGUOUS -- D333                    #
#   3)    CHECKS IF MORE THAN 64 DATA-NAMES SPECIFIED -- D337          #
#   4)    CHECKS IF DATA-NAME IS AN ELEMENTARY ITEM -- D335            #
#   ALSO, PERTINENT INFORMATION IS STORED IN KEY TABLE.                #
      IF REFSTATUS EQ 0 THEN       # IF CONCATENATED KEY DATA-NAME     #
        BEGIN                      # IS NOT DEFINED IN SCHEMA,ISSUE    #
        DIAGDL( 334);              # DIAGNOSTIC AND RETURN.            #
        STDNO;
        END 
      NUMDNAMES = NUMDNAMES + 1;   # INCREMENT COUNT OF DATA-NAMES     #
      IF NUMDNAMES NQ 1 THEN       # IF NOT THE FIRST DATA-NAME.       #
        BEGIN                      # CHECK IF DATA-NAMES ARE CONTIGUOUS#
        IF DIRWA NQ SYMWRDADDRWK[1] THEN
          BEGIN 
          DIAGDL( 333 );
          STDNO;
          END 
        IF NUMDNAMES GR 64 THEN 
          BEGIN 
        DIAGDL( 337 );
          STDNO;
          END 
        END 
      DDLRDSC( SCWORKBUF,ITEMFIXW , SYMWRDADDRWK[1] );   # READ IN DATA#
                                                 # NAME                #
# IF DATA-NAME IS NOT AN ELEMENTARY ITEM(OR SUBSCRIPTABLE), ERROR      #
      IF SCITMDOMORD[0] NQ 0 OR SCITMDATATYP[0] NQ 1 THEN 
        BEGIN 
        DIAGDL(335);
        STDNO;
        END 
#  STORE BEGINNING WORD AND CHARACTER POSITIONS IN KEY ENTRY.          #
        IF NUMDNAMES EQ 1 THEN
        BEGIN 
        SCDCKEYBWP[DPTR+1] = SCITEMPBWP[0]; 
        SCDCKEYBCP[DPTR+1] = SCITEMBBP[0]/6;
        SCDCRCENTRYA[DPTR] = SCITEMRECA[0];   # STORE RECORD ADDRESS   #
        END 
#  CALCULATE SIZE OF CONCATENATED KEY                                  #
      CKEYSIZE1 = CKEYSIZE1 + SCITEMSIZE[0];
      DIRWA = SYMWRDADDRWK[1] + SCITEMNXTPTR[0];  # WORD ADDRESS OF    #
                             # NEXT DATA ITEM -- SERVES AS A TEST FOR  #
                             # CONTIGUITY.                             #
#  STORE WORD ADDRESS OF SUBJECT DATA-NAME IN KEY ENTRY.               #
      SCDCKEYCNDNA[CONCATPTR] = SYMWRDADDRWK[1];
      IF QUALFLAG THEN             # IF DATA-NAME QUALIFIED, STORE     #
        SCDCKEYCNQAL[CONCATPTR] = TRUE;      # FLAG TO INDICATE SO.    #
      SCDCKEYCNDNO[CONCATPTR] = SCITMORDNUM[0];        # STORE         #
                             # SCHEMA ORDINAL OF DATA-NAME.            #
      QUALFLAG = FALSE; 
      CONCATPTR = CONCATPTR + 1;
      STDYES; 
  
CHKCONKY:    #*********************************************************#
#********************     C H K C O N K Y     *************************#
#   END OF CONCATENATED KEY ENTRY VALIDATION. REMAINING INFORMATION    #
#   IS STORED IN KEY TABLE.                                            #
      IF NUMDNAMES LS 1 THEN       # THERE MUST BE AT LEAST ONE DATA-  #
        BEGIN                      # NAME SPECIFIED FOR A CONCATENATED #
        DIAGDL( 336 );             # KEY. IF NOT, ERROR.               #
        STDNO;
        END 
#  SIZE OF KEY INCLUDING PADDING,IF ANY.                               #
      CKEYSIZE2 =  ABS( SCDCKEYBWP[DPTR+1]-SCITEMPBWP[0])*10 -
                   SCDCKEYBCP[DPTR+1] + SCITEMBBP[0]/6 + SCITEMSIZE[0]; 
#  IF SIZE(ACTUAL) AND SIZE(WITH PADDING) DIFFER, ERROR                #
      IF CKEYSIZE1 NQ CKEYSIZE2 THEN
        BEGIN 
        DIAGDL( 333 );
        STDNO;
        END 
      IF CKEYSIZE1 GR DFMAXKL      # IF KEY LENGTH GR MAXIMUM ALLOWED  #
      THEN
        DIAGDL ( 150 );            # ISSUE DIAGNOSTIC                  #
  
      SCDCKEYSIZ[DPTR+1] = CKEYSIZE1;   # STORE KEY SIZE IN KEY ENTRY. #
      SCDCKEYCNITN[DPTR+2] = NUMDNAMES; # STORE NUMBER OF DATA-NAMES   #
                                        # IN CONCATENATED KEY.         #
      SCDCKEYCNORD[DPTR+2] = KEYORD;    # STORE KEY ORDINAL            # D
      SCDCKEYIMBED[DPTR+1] = TRUE;
      SCDCKEYTYPE[DPTR] = 0;
#  ADJUST CERTAIN FIELDS IN PRESENT ITEM ENTRY IN WORKBUF SO THAT      #
#  COMMON SEMANTIC ROUTINES COULD BE USABLE FOR CONCATENATED KEY PRO-  #
#  CESSING.                                                            #
      SCITEMSIZE[0] = SCDCKEYSIZ[DPTR+1]; 
      SCITEMCLASS[0] = 0; 
      SCITEMBBP[0] = SCDCKEYBCP[DPTR+1]*6;
      SCITEMPBWP[0] = SCDCKEYBWP[DPTR+1]; 
      DIRWA = SCDCRCENTRYA[DPTR]; 
      STDYES; 
  
CHKIMBD:          #*************************************************# 
# *********************        C H K I M B D        ****************# 
# CHECK IF THE KEY IS IMBEDDED. YES EXIT IF IT IS, ELSE NO.         # 
      IF REFSTATUS NQ 0 
        THEN STDYES;
      STDNO;
  
  
  
CHKNEMK:           #************************************************# 
# *********************        C H K N E M K        ****************# 
# CURRENTLY, CDCS DOES NOT SUPPORT NON-EMBEDDED KEY.  SO, DDL WILL  # 
# ISSUE DIAGNOSTIC 212 AND RETURN, IF THE KEY IS NOT DEFINED.       # 
#                                                                   # 
      IF REFSTATUS EQ 0        # KEY HAS NOT BEEN DEFINED           # 
      THEN
        BEGIN 
        STDNO;
        END 
      STDYES; 
  
  
CHKORG:        #**********************************************# 
# *****************     C H K O R G      *********************# 
# CHECK FILE ORGANIZATION FOR THIS PHRASE ( KEY CLAUSE ). INITIALIZE   #
# KEY ENTRY. SETS FLAG FOR NEXT KEY IN PREVIOUS ENTRY IF THERE WAS ONE.#
      WRDITMREC = 0;
      IF PTRDCKEY EQ 0
        THEN PTRDCKEY = DPTR; 
        ELSE
        BEGIN 
          SCDCKEYNITM [LASTKEY + 1] = DPTR - LASTKEY; 
        END 
        LASTKEY = DPTR; 
      IF FILEORG EQ SQ THEN 
        BEGIN 
        SCDCKEYSORT[DPTR + 1] = TRUE;    # SEQUENTIAL SORT KEY  # 
        SORTKEYCNT = SORTKEYCNT + 1;
        END 
      ELSE
        BEGIN 
        SCDCKEYPRI[DPTR + 1] = TRUE;
        PRIKEYCT = PRIKEYCT + 1;
        END 
      SEPTR = DPTR;          # SET SUB-ENTRY POINTER #
      KEYORD = KEYORD + 1;             # INCREMENT KEY ORDINAL         # C
      STDYES; 
  
  
CHPRCNM:     #****************************************************# 
# ******************      C H P R C N M     **********************# 
# CHECK PROCEDURE NAME FOR LEGALITY - 1 TO 7 CHARACTERS           # 
      IF CURLENG GR 7  THEN STDNO;
      STDYES; 
  
  
CKSYSFLG:     #********************************************************#
#*******************        C K S Y S F L G         *******************#
#CHECK TO SEE THAT SYSTEM HAS NOT BEEN PREVIOUSLY SPECIFIED.           #
      IF SCDCCDSYSFLG[0] THEN 
        STDNO;
      STDYES; 
  
  
DCAINIT:     #****************************************************# 
# *******************     D C A I N I T      *********************# 
# INITIALIZE DATA CONTROL ENTRY FOR AREA                          # 
      FLAG = TRUE;
      QUALFLAG = FALSE; 
      CLSAREA;       # CLOSE PREVIOUS AREA #
      PTRDCAREA = DPTR; 
      SCDCSEQOPT[PTRDCAREA] = COLSEQS"COBOL";  # SET DEFAULT SEQUENCE  #
      DPTR = DPTR + DCFIXLENG;
      ALTERKY = FALSE;
      MULTRECTY = 0;
      LASTKEY = 0;
      PTRDCREC = 0; 
      PTRDCKEY = 0; 
      PRIKEYCT = 0; 
      TEMPPTR = 0;
      SORTKEYCNT = 0; 
      FILEORG = 0;
      KEYORD = 0;                                                        C
      RCCDVAL = 0;
      COMPFLG = FALSE;
      DCMPFLG = FALSE;
      CDFLAG = FALSE; 
      STDNO;
  
  
DCINIT:      #****************************************************# 
# **********************    D C I N I T       ********************# 
# INITIALIZE ENTIRE DATA CONTROL SECTION                          # 
      DCPTR = NEXTPTR;
      P<FIT> = LOC(ZDFFIT); 
      P<SCWORKBUF> = SCHBUFF; 
      DPTR = 0; 
      MNRLENG = 0;                                                       DL3A051
      RELLDFLAG = FALSE;
      STDNO;
  
  
DNRDSC:       #***************************************************# 
# **********************    D N R D S C     **********************# 
#  READ SCHEMA ENTRY FOR DATA-NAME.  ERROR IF HASH ROUTINE SAID   # 
#  ITEM WAS NEVER DEFINED.                                        # 
      IF REFSTATUS EQ 0 
        THEN STDNO; 
      DIRWA = SYMWRDADDRWK [1]; 
      DDLRDSC( SCWORKBUF, ITEMFIXW, DIRWA );
# MOVE ITEM ENTRY DOWN TO WORDS 29 THRU 35 #
      FOR I = 0 STEP 1 UNTIL ITEMFIXW - 1 DO
        SCWORKWD[ I + DCFIXLENG] = SCWORKWD[I]; 
      TEMPSIZE = (SCITEMSIZE[DCFIXLENG] - 1)/10;
      STDYES; 
  
  
ENDOVL:      #***************************************************#
# **********************   E N D O V L     **********************#
# THIS IS THE BIG ONE THAT DOES ALL THE CLEANUP FOR DATA CONTROL #
      FLAG = FALSE; 
      CLSAREA;
      IF FATALERR NQ 0
        THEN
        BEGIN 
        IF RELLDFLAG                                                     BC 
           OR CSDFLAG THEN                                               BC 
          STDNO;
        DIAGDL (296); 
        ABORTDDL; 
  
        END 
# READ EACH AREA ENTRY.  SET UP DEFAULT DATA CONTROL FOR AREA IF  # 
# REQUIRED.  USE SYMBOL TABLE REFERENCES TO READ IN EACH AREAS    # 
# RECORDS.  CHANGE DOMPTR FIELDS TO ORDINAL NUMBERS FOR ITEMS.    # 
# SET MRL, HL, TL, CP, CL IN DATA CONTROL FIT.                    # 
      DIRWA = SCCWFRSTAREA[0];         # BEGIN READING AREAS. # 
      FOR I = 0  WHILE DIRWA NQ 0  DO        # BEGIN READING AREAS     #
        BEGIN 
        CKSWA = DIRWA;       # TEMPORARILY STORE AREA WORD ADDRESS# 
        I = AREAFIXW + 3;    # NUMBER OF WORDS OF AREA ENTRY TO BE READ#
        DDLRDSC(SCWORKBUF, I, DIRWA); 
          IF SCAREADCNTLA [0] EQ 0
            THEN
            BEGIN            # NO DATA CONTROL ENTRY SPECIFIED FOR AREA#
              I = SCHAREANAMEC[0];  # DATA CONTROL ENTRY MUST BE SPEC- #
              IF I GR 7 THEN        # IFIED FOR AN AREA IN DDL 3.0     #
                I = 7;              # SET TO FIRST 7 CHARS OF AREA NAME#
              B<0,I*6>D992[6] = B<0,I*6>SCHAREANAME[SCARNAMEPTR[0]];
              DDLPRNT( DIAG992, 80 ); 
              ERRCNTR = ERRCNTR + 1;
              DIAGDL(296);
              ABORTDDL; 
            FOR I = 0 STEP 1 UNTIL DCFIXLENG-1 DO 
              SCDCRCCDELIT[I] = 0;
            FOR I = 0 STEP 1 UNTIL 2 DO 
              NAME[I] = 0;
            SCAREADCNTLA [0] = NEXTPTR; 
            SCAREADCLENG [0] = DCFIXLENG; 
            DDLRTSC( SCWORKBUF, AREAFIXW, DIRWA ); # WRITE AREA HEADER #
            FOR I = 0 STEP 1 UNTIL SCHAREANAMEL[0]-1 DO 
              NAME[I] = SCHAREANAME[SCARNAMEPTR[0]+I];
            NAMETYPE = AREA$NAME; 
            REFDEF = REFERENCED;
            CURWORDADDR = 0;
            HASHIT; 
            IF CTREFAR GQ 2 THEN
              BEGIN 
              CONVLNENBR( SYMSRCLINEWK[1] );
              DIAGDL( 211 );
              FATALERR = FATALERR + 1;
              END 
            FITLFN[0] = B<0,42>SCHAREANAME[SCARNAMEPTR[0]]; 
            RFITZDF;
            IF FITFO[0] EQ WA 
              THEN DIAGDL (133);
            FOR I = 0 STEP 1 UNTIL FITLENGTH-1 DO 
              SCDCARFITWRD[I] = FITWORD[I]; 
            P<FIT> = LOC(SCDCENTRY) + DCPREFIT; # POINT TO FIT IN DC   #
                                                # BUFFER.              #
            SCDCLENG [0] = DCFIXLENG; 
            SCDCSEQOPT[PTRDCAREA] = COLSEQS"COBOL"; 
            IF FITFO[0] NQ SQ 
              THEN
              BEGIN                       # ERROR IF FILE NOT SEQTL # 
              FOR I = 0 STEP 6
                UNTIL 36
              DO
                IF B<I,6>FITLFN[0] NQ 0 
                THEN
                  B<I,6>D999[7] = B<I,6>FITLFN[0];
              DDLPRNT (DIAG999, 80);
              ERRCNTR = ERRCNTR + 1;
              END 
              ELSE
              BEGIN 
            DIAGDL( 294 );
            DDLRDSC ( K, 1, PRIORPTR );   # SET PTR IN PREVIOUS   # 
            IF DCFLAG 
            THEN
            BEGIN 
            B<39,15>K = SCDCLENG[0];      # DATA CONTROL ENTRY    # 
            END 
            DCFLAG = TRUE;
            DDLRTSC ( K, 1, PRIORPTR ); 
            AREAWA = NEXTPTR;             # SAVE DC ENTRY ADDRESS # 
            PRIORPTR = NEXTPTR; 
            NEXTPTR = NEXTPTR + DCFIXLENG;
            END 
          END 
        ELSE
          BEGIN                       # READ EXISTING DATA CTL ENTRY# 
          AREAWA = SCAREADCNTLA [0];    #DC ENTRY ADDRESS    #
          K = SCAREADCLENG [0]; 
          DDLRDSC ( SCDCENTRY, K, AREAWA ); 
          P<FIT> = LOC(SCDCENTRY) + DCPREFIT;  # POINT TO FIT IN DC    #
                                               # BUFFER.               #
          END 
          RECCDFLAG = 0;
          IF NOT SCDCRECCDFLG[0]
            THEN
            BEGIN 
            RECCDPTR = SCDCRECCDPTR [0];
            IF NOT SCDCRCDETYP [RECCDPTR] 
              THEN RECCDFLAG = 1; 
            END 
        TEMPMRL = 0;
        TEMPMNR = 0;                                                     DL3A051
        TEMPCL = 0; 
        TEMPCP = 0; 
        TEMPHL = 0; 
        TEMPTL = 0; 
        TEMPSIZE = 0; 
        TEMPCLASS = 0;
        TFITHL = 0; 
        TFITTL = 0; 
        TFITCP = 0; 
        TFITCL = 0; 
        DIRWA = SCARNXTAREA [0];
        SYMLOC = SCDCARSYMADR[0] + 3;   # STORE AREA SYMBOL TABLE ADDR #
        SYMBUFWORDDF[0] = 0;
        PTRDCAREA = 0;
        RCLITCTR = 0; 
        FOR K = 0  WHILE  SYMLOC NQ 0 
          DO
          BEGIN 
          DDLRDSY ( SYMBUFDF, 1, SYMLOC );
          PTRDCAREA = SYMWRDADDRDF[0];
            IF PTRDCAREA LS DCPTR  AND  PTRDCAREA NQ 0
            THEN
            BEGIN 
            DDLRDSC( SCWORKBUF, RECDFIXW, PTRDCAREA );
            J = SCRECENTLEN [0];
# READ RECORD ENTRY # 
            DDLRDSC ( SCWORKBUF, J, PTRDCAREA );
          IF RECCDFLAG NQ 0 
            THEN RECCDFLAG = 1; 
          RCLITCTR = RCLITCTR + 1;
          FLAG = FALSE; 
        RECTYPE = FITRT[0]; 
          PTRDCREC = SCRECDITMPTR [0];    # PTRDCREC IS INDEX TO #
          K = 1;
          FOR LITCTR = 1  WHILE K NQ 0  DO   #CURRENT ITEM ENTRY #
            BEGIN 
            IF SCITMDOMORD[PTRDCREC] NQ 0 
              THEN
              BEGIN 
              FLAG = TRUE;                # CHANGE DOMPTR TO ORDINAL# 
              SCITMDOMORD[PTRDCREC] = SCITMORDNUM[PTRDCREC -
                                        SCITMDOMORD[PTRDCREC]]; 
              END 
            IF SCITMDIMOCC [PTRDCREC]     # TEST FOR DEPEND ON ARRAY# 
              AND RECTYPE EQ 5     # AND T RECORD TYPE #
              THEN
              BEGIN            # IF FOUND, READ AREA ENTRY #
                TEMPHL =                  # COMPUTE HL FIELD #
              10 * SCITEMPBWP[PTRDCREC] + SCITEMBBP[PTRDCREC] / 6;
              TEMPMNR = TEMPHL;    # STORE MNR #                         DL3A051
                TEMPTL = SCITEMSIZE [PTRDCREC];  # STORE TL # 
              RCDNREC = SCITMDEPORDL [PTRDCREC];
              L = SCRECDITMPTR [0]; 
              FOR I = 0  WHILE ( L LS J  AND
                  RCDNREC NQ SCITMORDNUM [L] )  DO
                L = L + SCITEMNXTPTR [L]; 
                TEMPCP =                  # COMPUTE CP FIELD #
                SCITEMBBP [L] / 6 + SCITEMPBWP [L] * 10;
                 TEMPCL = SCITEMSIZE [L];  # COMPUTE CL FIELD # 
              IF SCITEMCLASS[L] GQ 10      # SET C1 FIELD # 
                THEN
                BEGIN 
            FITC1[0] = TRUE;
                TEMPCP = TEMPCP + 4; #CP,CL CHANGED TO LOOK ONLY AT # 
                TEMPCL = 6;            # LAST 36 BITS, FOR THE CRM     #
                END 
              IF SCITEMSIGNFG [L] AND NOT SCITEMSIGN [L]  # SET SB #
              THEN FITSB[0] = TRUE; 
              IF (TFITHL NQ 0 AND TFITHL NQ TEMPHL) OR
                 (TFITTL NQ 0 AND TFITTL NQ TEMPTL) OR
                 (TFITCP NQ 0 AND TFITCP NQ TEMPCP) OR
                 (TFITCL NQ 0 AND TFITCL NQ TEMPCL) OR
                   (TEMPSIZE NQ 0 AND TEMPSIZE NQ SCITEMSIZE [PTRDCREC])
                   OR ( TEMPCLASS NQ 0  AND  TEMPCLASS
                   NQ SCITEMCLASS [PTRDCREC] )
                  THEN
                  BEGIN 
                  FOR I = 0 STEP 6
                    UNTIL 36
                  DO
                    IF B<I,6>FITLFN[0] NQ 0 
                    THEN
                      B<I,6>D996[12] = B<I,6>FITLFN[0]; 
#    SEND DIAGNOSTIC AND ABORT IF VALUES DIFFER ACROSS REC TYPES #
                  DDLPRNT (DIAG996, 127); 
                  ERRCNTR = ERRCNTR + 1;
                  FATALERR = FATALERR + 1;
  
                  END 
                ELSE
                  BEGIN 
                TFITHL = TEMPHL;
                TFITTL = TEMPTL;
                TFITCP = TEMPCP;
                TFITCL = TEMPCL;
                  TEMPSIZE = SCITEMSIZE [PTRDCREC]; 
                  TEMPCLASS = SCITEMCLASS [PTRDCREC]; 
                  END 
                END 
            IF SCITMDIMOCC [PTRDCREC] AND RECTYPE NQ 5
                THEN              # DIAGNOSTIC IF REC TYPE WAS F #
                BEGIN 
                D998[8] = BLANKS; 
                FOR I = 0  STEP 6  UNTIL 36  DO 
                IF B<I,6>FITLFN[0] NQ 0 
                  THEN B<I,6>D998[8] = B<I,6>FITLFN[0]; 
                DDLPRNT ( DIAG998, 90 );
                ERRCNTR = ERRCNTR + 1;
                END 
      IF SCITEMCLASS[PTRDCREC] LQ 1 AND (SCITEMCHECKS[PTRDCREC] GR 0) 
        THEN
        BEGIN 
        IF SCITMCKVALUE[PTRDCREC+SCITEMCHECKS[PTRDCREC]] THEN 
          BEGIN 
          GOTO SETSEQ[SCDCSEQOPT[0]]; 
            BEGIN 
SETDISP:                           # SET DISPLAY SEQUENCE              #
            P<CSTVAL> = LOC(DISPCST); 
            GOTO ENDSEQ;
  
SETASCII:                          # SET ASCII COLLATING SEQUENCE      #
            P<CSTVAL> = LOC(ASCCST);
            GOTO ENDSEQ;
  
SETCOBOL:                          # SET COBOL COLLATING SEQUENCE      #
            P<CSTVAL> = LOC(COBCST);
  
ENDSEQ: 
            END 
          LITPTR = PTRDCREC + SCITMCKEXPTR[PTRDCREC]; 
          NAMETYPE = ITEM$NAME; 
          REFDEF = REFERENCED;
          FOR I = 0 STEP 1 UNTIL SCITMNAMLENW[PTRDCREC] - 1 DO
            NAME[I] = SCITEMNAME[PTRDCREC + SCITMNAMEPTR[0] + I]; 
                                               # STORE ITEM NAME,LENGTH#
          NAMELENC = SCITMNAMLENC[PTRDCREC];   # IN CHARACTERS AND WORD#
          NAMELENW = SCITMNAMLENW[PTRDCREC];   # FOR HASH ROUTINE.# 
          NAMEQUAL = 1; 
          FOR I = 0 STEP 1 UNTIL SCRNAMELENW[0] - 1 DO
            QUALNAME[I] = SCRECORDNAME[SCRECNAMEPTR[0]+I];
                                               # STORE QUALIFIER NAME, #
          QUALNAMELENW = SCRNAMELENW[0];       #ITS LENGTH IN CHARACTER#
          QUALNAMELENC = SCRNAMELENC[0];       #& WORDS, IN CASE ITEM  #
          HASHIT;   #NEEDS QUALIFICATION, FOR HASH ROUTINE.            #
          LINNUMBIN = SYMSRCLINEWK[1];
          LINNUMDIS = "          "; 
          FOR I = 24 STEP -6 WHILE LINNUMBIN GR 0 DO
            BEGIN 
            K = LINNUMBIN/10;                  # CONVERT SOURCE LINE   #
            B<I,6>LINNUMDIS = LINNUMBIN - K * 10 + O"33"; # NUMBER TO  #
            LINNUMBIN = K;                     # DISPLAY DECIMAL.      #
            END 
          FOR COMLOOP = 1 WHILE SCITMCKEXNXL[LITPTR] NQ 0 DO
            BEGIN   # BEGIN OF FOR-LOOP--1 #
            FOR I = 0 STEP 1 UNTIL (SCITEMSIZE[PTRDCREC]-1)/10 DO 
              BEGIN 
              CURWORD[I] = BLANKS;
              LITSTOR[I] = BLANKS;
              END 
           FOR I = 0 STEP 1 UNTIL SCITMCKEXLNW[LITPTR]-1 DO 
             CURWORD[I] = SCITMCKEXLIT[LITPTR+I+1]; 
           LITPTR = LITPTR + SCITMCKEXNXL[LITPTR];
           FOR I = 0 STEP 1 UNTIL SCITMCKEXLNW[LITPTR]-1 DO 
             BEGIN
             LITSTOR[I] = SCITMCKEXLIT[LITPTR+I+1]; 
             END
           FOR K = 0 STEP 1 UNTIL (SCITEMSIZE[PTRDCREC]-1)/10 DO
             BEGIN   # BEGIN OF FOR-LOOP--2 # 
             FOR I = 0 STEP 6 UNTIL 54 DO 
               BEGIN  # BEGIN OF FOR-LOOP--3 #
               WORDINDX = B<I,3>CURWORD[K]; 
               BYTEINDX = B<I+3,3>CURWORD[K]*6; 
               B<I,6>CURWORD[K] = B<BYTEINDX,6>COLSEQ[WORDINDX];
               WORDINDX = B<I,3>LITSTOR[K]; 
               BYTEINDX = B<I+3,3>LITSTOR[K]*6; 
               B<I,6>LITSTOR[K] = B<BYTEINDX,6>COLSEQ[WORDINDX];
               IF B<I,6>CURWORD[K] LS B<I,6>LITSTOR[K] THEN 
                 TEST COMLOOP;
               IF B<I,6>CURWORD[K] EQ B<I,6>LITSTOR[K] AND
                    ((K LS (SCITEMSIZE[PTRDCREC]-1)/10) OR
                    (I LS 54)) THEN 
                 TEST;
            B<12,30>D995[5] = B<0,30>LINNUMDIS;  # STORE SOURCE LINE NO#
            DDLPRNT( DIAG995,86 );
               ERRCNTR = ERRCNTR + 1; 
               FATALERR = FATALERR + 1; 
               TEST COMLOOP;
               END  # END OF FOR-LOOP--3 #
             END  # END OF FOR-LOOP--2 #
           END  # END OF FOR-LOOP--1 #
         END
       END
            IF RECCDFLAG EQ 1   # CHECK FOR RECORD CODE ITEM #
              THEN
              IF  SCDCRCCDEBWP [RECCDPTR] EQ SCITEMPBWP [PTRDCREC] AND
                  SCDCRCCDEBCP [RECCDPTR] EQ (SCITEMBBP [PTRDCREC] /6)
                 AND  SCDCRCCDESIZ [RECCDPTR] EQ SCITEMSIZE [PTRDCREC]
                 AND SCDCRCDECLAS [RECCDPTR] EQ SCITEMCLASS [PTRDCREC]
              THEN  # ITEM WITH SAME LOCATION, SIZE, AND CLASS FOUND   #
                    # IN THIS RECORD. NOW CHECK IF CHECK VALUE CLAUSE  #
                    # HAS BEEN SPECIFIED FOR THAT ITEM.                #
                BEGIN 
                RECCDFLAG = 2;
                IF SCITEMCHECKS[PTRDCREC] GR 0 THEN # IF CHECK CLAUSE  #
                  BEGIN  # SPECIFIED, SET POINTER TO START OF CHECK    #
                  LITPTR = PTRDCREC + SCITEMCHECKS[PTRDCREC]; # ENTRY. #
                  IF SCITMCKVALUE[LITPTR] THEN # IF VALUE CLAUSE SPEC- #
                    BEGIN    # IFIED, THEN IF THERE IS MORE THAN ONE   #
                    IF SCITMCKNLIT[LITPTR + 1] GR 1 THEN # LITERAL SP- #
                      RECCDFLAG = 3;  #ECIFIED, INDICATE STATUS IN FLAG#
                    ELSE
                      BEGIN 
                      LITPTR = LITPTR + 2; # SET POINTER TO START OF   #
                                           # CHECK VALUE LITERAL.      #
                      LITRCPTR = RECCDPTR + 
                                 SCDCRCDELITP[RECCDPTR+1+RCLITCTR]; 
                                # SET POINTER TO START OF RECORD CODE  #
                                # LITERAL.                             #
                      FOR I = 0 STEP 1 UNTIL
                                (SCDCRCDELITL[RECCDPTR+2]/10) - 1 DO
                        BEGIN 
                        CURWORD[0] = SCITMCKLIT[LITPTR + I]; # STORE   #
                        LITSTOR[0] = SCDCRCCDELIT[LITRCPTR + I]; # LITS#
                        IF CURWORD[0] NQ LITSTOR[0] THEN #IF LITERALS # 
                          RECCDFLAG = 3; # NOT EQUAL, THEN SET STATUS. #
                        END 
                      END 
                    END 
                  END 
                END 
            K = SCITEMNXTPTR [PTRDCREC];
            PTRDCREC = PTRDCREC + K;
            END 
            IF RECCDFLAG EQ 1     # NO RECORD ITEM FOUND IN THIS REC #
              THEN                # SEND DIAGNOSTIC                  #
              BEGIN 
              D994 [3] = BLANKS;
              D994 [5] = BLANKS;
              FOR I = 0 STEP 6 UNTIL 36 DO
                BEGIN 
                  IF B<I,6>FITLFN[0] NQ 0 
                    THEN B<I,6>D994[5] = B<I,6>FITLFN[0]; 
                IF B<I,6>SCRECORDNAME[SCRECNAMEPTR[0]] NQ 0 
                  THEN B<I,6>D994[3] = B<I,6>SCRECORDNAME 
                                             [SCRECNAMEPTR[0]]; 
                END 
              ERRCNTR = ERRCNTR + 1;
              DDLPRNT (DIAG994, 136); 
              END 
            IF RECCDFLAG EQ 3 THEN
              BEGIN 
              D993[11] = BLANKS;
              D993[13] = BLANKS;
              FOR I = 0 STEP 6 UNTIL 36 DO
                BEGIN 
                  IF B<I,6>FITLFN[0] NQ 0 THEN
                    B<I,6>D993[13] = B<I,6>FITLFN[0]; 
                IF B<I,6>SCRECORDNAME[SCRECNAMEPTR[0]] NQ 0 
                  THEN B<I,6>D993[11] = B<I,6>SCRECORDNAME
                                             [SCRECNAMEPTR[0]]; 
                END 
              ERRCNTR = ERRCNTR + 1;
              DDLPRNT( DIAG993, 138 );
              END 
  
#     CHECK THAT IF THE AREA HAS MULTIPLE RECORD TYPES, THEN AN ITEM   #
#     WITH THE SAME LOCATION, SIZE AND CLASS AS THE KEY ITEM MUST BE   #
#     SPECIFIED IN ALL RECORD TYPES    #
  
            SAVEDBADDR = LOC(SCWORKBUF);  # SAVE BASE ADDRESS          #
            NOKEY = TRUE;                 # SET NO KEY FLAG            #
            PTRDCKEY = SCDCALTRKYPT[0];   # POINTER TO KEY ENTRY IN DC #
            IF SCDCRCENTRYA[PTRDCKEY] NQ PTRDCAREA  #IF NOT 1ST REC TYP#
            THEN
              BEGIN 
              I = 1;                    # FORCE AT LEAST ONCE THRU LOOP#
              FOR I = I                 # STEP THRU ALL KEYS IN D C    #
                WHILE I NQ 0            # CONTROL ENTRY                #
              DO
                BEGIN 
                I = PTRDCKEY + 1;         # POINTER TO 2ND WORD OF KEY #
                NUMITEMS = SCRNUMITEMS[0];  # NUMBER OF ITEMS IN RECORD#
                P<SCWORKBUF> = LOC(SCWORKBUF) + SCRECDITMPTR[0];
                SIZE = 0;              # RESET SIZE                    #
                RCP = 0;               # RELATIVE CHARACTER POSITION   #
                IF SCDCKEYIMBED[I]     # IF KEY IS IMBEDDED            #
                THEN
                  BEGIN 
                  KEYRCP = SCDCKEYBWP[I] * 10 + SCDCKEYBCP[I];
                  FOR JJ = 1 STEP 1    # STEP THRU ALL ITEMS IN RECORD #
                    UNTIL NUMITEMS
                  DO
                    BEGIN 
                    IF (SCITMDATATYP[0] EQ 1      # IF ELEMENTARY ITEM #
                        OR SCITMDATATYP[0] EQ 2   # OR REPEATING GROUP #
                        OR SCITMDATATYP[0] EQ 3)  # OR VECTOR          #
                       AND SCITMDOMORD[0] EQ 0    # NOT WITHIN GROUP   #
                    THEN
                      RCP = SCITEMPBWP[0] * 10 + SCITEMBBP[0] / 6;
                    ELSE
                      RCP = RCP + SCITEMPBWP[0] * 10 + SCITEMBBP[0] / 6;
                    IF RCP EQ KEYRCP   # IF BWP AND BCP MATCH          #
                    THEN
                      BEGIN 
                      RCP = 0;
                      IF SCDCKEYCONCT[I]  # IF CONCATENATED KEY        #
                      THEN
                        BEGIN 
                        ACCUMSIZE = 0;
                        FOR K = 1 STEP 1  # STEP THRU ALL ITEMS IN KEY #
                          UNTIL SCDCKEYCNITN[I+1] 
                        DO
                          BEGIN 
                          ACCUMSIZE = ACCUMSIZE + SCITEMSIZE[0];
                          P<SCWORKBUF> = LOC(SCWORKBUF)+SCITEMNXTPTR[0];
                          END 
                        IF ACCUMSIZE EQ SCDCKEYSIZ[I] 
                        THEN
                          BEGIN 
                          NOKEY = FALSE;  # CLEAR NO KEY FLAG          #
                          JJ = NUMITEMS;  # FORCE END OF LOOP          #
                          TEST JJ;
  
                          END 
                        JJ = JJ + K;
                        END 
                      ELSE             # KEY IS ELEMENTARY IMBEDDED    #
                        BEGIN 
                        IF SCITEMCLASS[0] EQ SCDCKEYCLASS[I+1]
                          AND SCITEMSIZE[0] EQ SCDCKEYSIZ[I] #AND SIZE #
                        THEN
                          BEGIN 
                          NOKEY = FALSE; # CLEAR NO KEY FLAG          # 
                          JJ = NUMITEMS;  # FORCE END OF LOOP          #
                          TEST JJ;
  
                          END 
                        END 
                      END 
                    SIZE = SCITEMSIZE[0]; 
                    P<SCWORKBUF> = LOC(SCWORKBUF) + SCITEMNXTPTR[0];
                    END 
                  IF NOKEY             # IF NO KEY FOUND, ISSUE DIAG   #
                  THEN
                    BEGIN 
                    ERRCNTR = ERRCNTR + 1;  # INCREMENT ERROR COUNTER  #
                    FATALERR = FATALERR + 1; #INCREMENT FATAL ERR CNTR #
                    FOR JJ = 0 STEP 6  # MOVE AREA NAME TO DIAGNOSTIC  #
                      UNTIL 36
                    DO
                      IF B<JJ,6>FITLFN[0] NQ 0
                      THEN B<JJ,6>D991[9] = B<JJ,6>FITLFN[0]; 
                    DDLPRNT (DIAG991, 100); 
                    C<0,10>D991[9] = "          ";
                    END 
                  END 
                P<SCWORKBUF> = SAVEDBADDR;  # RESET BASE ADDRESS       #
                NOKEY = TRUE;          # RESET NO KEYS FLAG            #
                I = SCDCKEYNITM[I];    # PREPARE FOR NEXT KEY          #
                PTRDCKEY = PTRDCKEY + I;
                END 
              END 
            IF FLAG  THEN DDLRTSC ( SCWORKBUF, J, PTRDCAREA );
            IF TEMPMRL  LS  SCRECLENGTH [0] 
              THEN TEMPMRL = SCRECLENGTH [0]; 
            SYMLOC = SYMNEXTREFDF[0]; 
            END 
            ELSE  SYMLOC = 0; 
          END 
#  END OF LOOP THRU SYMBOL TABLE REFERENCES TO AREA  #
        TEMPHL = FITHL[0];
        TEMPTL = FITTL[0];
        TEMPCP = FITCP[0];
        TEMPCL = FITCL[0];
        I = FITMRL[0];
        J = FITMNR[0];                                                   DL3A051
        IF (TEMPHL NQ 0  AND  TFITHL NQ 0  AND  TFITHL NQ TEMPHL) OR
           (TEMPTL NQ 0  AND  TFITTL NQ 0  AND  TFITTL NQ TEMPTL) OR
           (TEMPCP NQ 0  AND  TFITCP NQ 0  AND  TFITCP NQ TEMPCP) OR
           (TEMPCL NQ 0  AND  TFITCL NQ 0  AND  TFITCL NQ TEMPCL) OR
           (TEMPMRL GR I  AND  I NQ 0 ) 
           OR (RECTYPE EQ 1  AND  TEMPMRL NQ I  AND I NQ 0) 
           OR (RECTYPE EQ 1 AND J NQ 0 AND TEMPMRL NQ J)
           OR (RECTYPE EQ 5 AND J NQ 0 AND TEMPMNR NQ J)
          THEN
          BEGIN 
#    SEND WARNING DIAGNOSTIC IF FILE CARD VALUES NQ SCHEMA VALUES # 
          FOR J = 0 STEP 6
            UNTIL 36
          DO
            IF B<J,6>FITLFN[0] NQ 0 
            THEN
              B<J,6>D997[11] = B<J,6>FITLFN[0]; 
          ERRCNTR = ERRCNTR + 1;
          DDLPRNT ( DIAG997, 117 ); 
          D997[11] = BLANKS;
          END 
        IF TFITHL NQ 0 AND TFITTL NQ 0 AND TFITCL NQ 0
          THEN
          BEGIN 
          FITHL[0] = TFITHL;
          FITTL[0] = TFITTL;
          FITCP[0] = TFITCP;
          FITCL[0] = TFITCL;
          END 
        IF TEMPMRL GR FITMRL[0] 
           OR  RECTYPE EQ 1 
          THEN FITMRL[0] = TEMPMRL; 
  # FOR RECTYPE = F  SET MNR = MRL #
        IF RECTYPE EQ 1 
          THEN FITMNR[0] = TEMPMRL; 
# FOR RECTYPE = T, SET MNR = FITHL #                                     DL3A051
        IF RECTYPE EQ 5 THEN                                             DL3A051
          FITMNR[0] = FITHL[0];                                          DL3A051
  
#      ZERO OUT ALL KEY CLASS FIELDS IN THE DATA CONTROL ENTRY BEFORE  #
#      REWRITING THE DATA CONTROL ENTRY TO THE SCHEMA FILE             #
  
        PTRDCKEY = SCDCALTRKYPT[0];    # KEY ENTRY WORD ADDRESS        #
        I = 1;                         # FORCE ONCE THRU LOOP          #
        FOR I = I 
          WHILE I NQ 0
        DO
          BEGIN 
          I = PTRDCKEY + 1;            # POINTER TO 2ND WORD OF KEY    #
          IF SCDCKEYIMBED[I]           # IF KEY IS IMBEDDED            #
            AND NOT SCDCKEYCONCT[I]    # AND NOT CONCATENATED          #
          THEN
            SCDCKEYCLASS[I+1] = 0;     # ZERO OUT CLASS                #
          I = SCDCKEYNITM[I];          # PREPARE FOR NEXT KEY          #
          PTRDCKEY = PTRDCKEY + I;
          END 
        DDLRTSC (SCDCENTRY, SCDCLENG[0], AREAWA); #REWRITE DATA CONTROL#
                                                 # ENTRY.              #
        DDLRDSC(SCWORKBUF, AREAFIXW, CKSWA); #READ IN AREA ENTRY HEADER#
      #****************************************************************#
      # CHECKSUM DATA CONTROL ENTRY JUST WRITTEN TO DIRECTORY, USING   #
      # PREVIOUS AREA CHECKSUM AS BASE, AFTER ERASING DATA CONTROL     #
      # ENTRY WORD ADDRESSES.                                          #
      #****************************************************************#
      IF FATALERR EQ 0 THEN                                              DL3A006
      BEGIN 
      SCDCARSYMADR[0] = 0;             #ERASE WORD ADDRESS             #
      SCDCNXTAREAP[0] = 0;         #ERASE NEXT ENTRY POINTER# 
      SCDCSDAORD[0] = 0;           #ERASE DA PROC ORDINAL#
      CKSPTR = SCDCRECCDPTR[0];    # POINTER TO RECORD CODE ENTRY # 
      IF NOT SCDCRECCDFLG[0] AND NOT SCDCRCDETYP[CKSPTR] THEN 
        BEGIN                      #BY DATANAME#
        SCDCRCDEITMP[CKSPTR] = 0;           #ERASE WORD ADDRESS        #
        CKSPTR = CKSPTR + 2;                #FIRST LITERAL ENTRY       #
        END 
      ELSE
      CKSPTR = CKSPTR + 1;                  #FIRST INTEGER ENTRY       #
      I = CKSPTR;                           #SET I NONZERO             #
      FOR I = I WHILE I NQ 0 DO             #RECORD CODE LOOP          #
        BEGIN 
        IF (SCDCRCDENEXT[CKSPTR]) THEN           #NEXT FLAG SET        #
          I = 1;                                 #SET I                #
        ELSE                                     #FOR                  #
          I = 0;                                 #NEXT PASS            #
        SCDCRCDERECA[CKSPTR] = 0;           #ERASE WORD ADDRESS        #
        CKSPTR = CKSPTR + 1;                #POINT TO NEXT ENTRY       #
        END 
      CKSPTR = SCDCALTRKYPT[0];             #POINT TO KEY ENTRY        #
      I = CKSPTR;                           #SET I NONZERO             #
      FOR I = I WHILE I NQ 0 DO             #KEY LOOP                  #
        BEGIN 
        SCDCRCENTRYA[CKSPTR] = 0;           #ERASE RECORD WA           #
        I = SCDCKEYNITM[CKSPTR+1];          #SET I FOR NEXT PASS       #
        IF SCDCKEYIMBED[CKSPTR+1] THEN      #IMBEDDED KEY              #
          BEGIN 
          SCDCKEYDNADR[CKSPTR+2] = 0;       #ERASE DATANAME WA         #
          IF SCDCKEYCONCT[CKSPTR+1] THEN    #CONCATENATED KEY          #
            BEGIN 
            J = CKSPTR + SCDCKEYCNNMW[CKSPTR+2] + 2;#SET ADR TO DN LIST#
            K = SCDCKEYCNITN[CKSPTR+2] ;    #NUMBER OF ITEMS           #
            FOR L = 1 STEP 1 UNTIL K DO     #DATANAME LOOP             #
              SCDCKEYCNDNA[J+L] = 0;        #ERASE DATANAME WA         #
            END 
          END 
          CKSPTR = CKSPTR + I;     #INDEX TO NEXT KEY#
        END 
      CKSWA = ((SCAREAORD[0]-1) * CKSRECLEN)+1;  #COMPUTE CHECKSUM WA  #
      SCRDCKS(CKSREC,CKSWA);                    #RETRIEVE AREA CHECKSUM#
                                                 #CHECKSUM DC ENTRY    #
      CHECKSUM[0] = CKSUM(CHECKSUM[0],LOC(SCDCENTRY),SCDCLENG[0]);
      SCWRCKS(CKSREC,CKSWA);   #REWRITE AREA CHECKSUM#
      END 
        P<FIT> = LOC(ZDFFIT);   # POINTS TO BUFFER WHERE FIT FROM      #
                                # FILE CARD IS SET.                    #
        END 
  
# SET UP DIRECTORY CONTROL WORDS       #
      SCCWNUMAREAS[SCCWPTR] = TOTALAREAS;                               000740
      SCCWNUMRECDS[SCCWPTR] = TOTALRECORDS;                             000750
      SCCWNUMITEMS[SCCWPTR] = TOTALITEMS;                               000760
      SCCWNMITMPRC[SCCWPTR] = MAXPROCS;                                 000770
      SCCWMAXITEMS[SCCWPTR] = MAXITEMS;                                 000780
      SCCWMAXRECSZ [0] = MAXRECSIZE;
      SCCWMAXKEYL [0] = MAXKEYLG; 
      SCCWSCHTIME[0] = B<6,30>HDR6; 
      SCCWSCHDATE[0] = B<30,30>JULDAT;
      SCCWVERSION [0] = C<7,3> HDR4 ; 
      SCCWCRMVER[0] = C<0,3>CRMLEV;              #CRM VERSION          #
      SCCWBDATE[0] = C<4,5>HDR3A;                #DDL BUILD DATE       #
      SCCWDCADDR [0] = DCPTR; 
      IF FATALERR NQ 0 THEN 
        BEGIN 
        DIAGDL( 296 );
        ABORTDDL; 
        END 
      IF UNIQPROCNMS NQ 0 
        THEN
        BEGIN 
        B<0,12>PROCTBLEPNME [0] = O"30";
        PROCTBLEWC [0] = UNIQPROCNMS; 
        UNIQPROCNMS = UNIQPROCNMS + 1;
        SCCWDBPLENG [SCCWPTR] = UNIQPROCNMS;
        SCCWDBPWRDAR [SCCWPTR] = NEXTPTR; 
        DDLRTSC ( PROCTBLE, UNIQPROCNMS, NEXTPTR ); 
        NEXTPTR = NEXTPTR + UNIQPROCNMS;
        END 
      IF CSDFLAG THEN                                                    FIRST
         LOADOVL( BASE1X, 1, 4 );  # LOAD CONSTRAINT OVERLAY           # FIRST
      LOADOVL( BASE1X, 1, 3 );     # LOAD RELATION OVERLAY.            #
  
  
HASHCKY:     #*********************************************************#
# *******************     H A S H C K Y     ***************************#
#   GET UP PARAMETERS TO CALL HASH ROUTINE FOR KEY(CONCATENATED)       #
#   DEFINITION                                                         #
      NAMETYPE = ITEM$NAME; 
      REFDEF = DEFINED; 
      RECPTR = 0; 
      CONCATFLG = TRUE; 
      CURWORDADDR = DPTR + NEXTPTR; 
      HASHIT; 
      CONCATFLG = FALSE;
      STDNO;
  
HASHRA:       #**************************************************#
# ********************     H A S H R A     **********************#
# SET UP PARAMETERS TO CALL HASH FOR AREA REFERENCE              #
      NAMETYPE = AREA$NAME; 
      GOTO HASHREQ; 
  
  
HASHREQ:   #*********************************************************#
# *************       H A S H R E Q          ************************#
# CALL HASH ROUTINE FOR REFERENCE                                    #
      REFDEF = REFERENCED;
      CURWORDADDR = DPTR + DCPTR;   # *** THIS MAY BE WRONG *** # 
      HASHIT; 
      STDNO;
  
HASHRI:         #************************************************#
# ********************     H A S H R I    ***********************#
# SET UP PARAMETERS TO CALL HASH FOR ITEM REFERENCE             # 
      NAMETYPE = ITEM$NAME; 
      GOTO HASHREQ; 
  
  
HASHRR:        #*************************************************#
# ****************        H A S H R R      **********************#
#  SET UP PARAMETERS TO CALL HASH FOR RECORD REFERENCE           #
      NAMETYPE = RECORD$NAME; 
      GOTO HASHREQ; 
  
  
  
KEYINIT:     #*********************************************************#
#********************     K E Y I N I T     ***************************#
#   INITIALIZE POINTERS FOR CONCATENATED KEY PROCESSING.               #
      NUMDNAMES = 0;
      CKEYSIZE1 = 0;
      CKEYSIZE2 = 0;
      STDNO;
  
LITRCON:   #***************************************************#
#***************************************************************# 
# CONVERT LITERAL TO CONFORM TO ITEM SPECIFICATIONS, CALLING  # 
# ROUTINE CONVERTCKLIT ( IN DL10 ).  ERROR EXIT TO STDNO IF   # 
# ERRORS ON THE CONVERSION, ELSE EXIT TO STDYES.              # 
      ERRCODE = 0;
      IPTR = DCFIXLENG; 
      J = SCITEMCLASS [IPTR]; 
      FLAG = FALSE;     # INITIALIZE DIAGNOSTIC FLAG  # 
      IF J LQ 1 THEN   # FOR ALPHA OR ALPHANUMERIC ITEM # 
        BEGIN          # MUST HAVE NON-NUMERIC LITERAL. # 
          IF CURTYPE NQ 103 THEN
            FLAG = TRUE;  # RETURN WILL BE TO STDNO.    # 
          ELSE
            BEGIN 
              IF CURLENG GR SCITEMSIZE[IPTR] THEN  # IF LENGTH OF LIT. #
                FLAG = TRUE; # GREATER THAN TARGET ITEM, SET FLAG. #
              ELSE
              BEGIN 
              IF J EQ 1 THEN      # IF ITEM ALPHABETIC,                #
                BEGIN 
                  K = 0;          # CHECK TO SEE THAT LITERAL CONTAINS #
                  N = 0;          # ALL ALPHABETIC CHARACTERS OR BLANK.#
                  FOR I = 1 STEP 1 UNTIL CURLENG DO # IF NOT RETURN   # 
                    BEGIN 
                      IF C<K>CURWORD[N] GR O"32" AND
                                    (C<K>CURWORD[N] NQ O"55") THEN
                        BEGIN 
                          FLAG = TRUE;
                          I = CURLENG;
                        END 
                      ELSE
                        BEGIN 
                          K = K + 1;
                          IF K GR 9 
                            THEN
                            BEGIN 
                            K = 0;
                            N = N + 1;
                            END 
                          TEST; 
                        END 
                    END 
                END 
              K = CURLENG;
              FOR I = 0 STEP 1 UNTIL CURLENW-1 DO 
                BEGIN    # BEGIN OF FOR-LOOP #
                   IF K LQ ((I + 1) * 10) 
                     THEN 
                     BEGIN
                     LITWRD = CURWORD [I];
                     CURWORD [I] = BLANKS;
                      K = 10 - ((CURLENW*10)-CURLENG);
                      C<0,K>CURWORD[I] = C<0,K>LITWRD;
                    END 
                 END   # END OF FOR-LOOP #
               END
             END
          FOR I = 0  STEP 1  UNTIL 2  DO
            NAME [I] = CURWORD [I]; 
         END
      ELSE
        BEGIN 
          IF CURTYPE EQ 103 THEN  # IF TARGET ITEM NUMERIC AND LITERAL# 
            FLAG = TRUE;     # NON-NUMERIC, SET FLAG.              #
          ELSE
          BEGIN 
          CONVERTCKLIT;      # CONVERT LITERAL. # 
          END 
        END 
      SCDCRCDELITL [DPTR] = SCITEMSIZE [IPTR];
      IF ERRCODE NQ 0 OR FLAG 
        THEN STDNO; 
       STDYES;
READFIT:       #*************************************************#
# ******************     R E A D F I T    ***********************#
# CALL COMPASS ROUTINE TO DO SETFIT MACRO TO READ FIT FROM ZZZDF #
# ERROR IF ALL REQUIRED PARAMETERS NOT SET IN FIT          #
      RFITZDF;
      FILEORG = FITFO[0]; 
      IF FILEORG EQ WA
        THEN DIAGDL (133);
      IF DFERR NQ 0 
        THEN BEGIN           # SEQUENTIAL FILE - ERROR. # 
        DIAGDL( 210 );
        STDNO;
        END 
      IF FILEORG EQ SQ THEN 
        BEGIN 
        DIAGDL( 294 );
        STDNO;
        END 
      IF FILEORG EQ DA AND FITHMB EQ 0 THEN 
        BEGIN 
        DIAGDL( 223 );
        FITHMB[0] = 512;      # SET DEFAULT VALUE IN FIT #
        END 
      FITORG[0] = TRUE; 
      STDYES; 
  
  
RECINIT:       #*****************************************************#
# ********************      R E C I N I T     ***********************#
# INITIALIZE DATA CONTROL RECORD CODE ENTRY PROCESSING               #
      IF PTRDCREC NQ 0
        THEN STDNO; 
      PTRDCREC = DPTR;
      SEPTR = DPTR;          # SET SUB-ENTRY POINTER #
      LITCTR = 0; 
      STDYES; 
  
  
RECNAME:         #***************************************************#
# *******************      R E C N A M E      ***********************#
# SET UP PARAMETERS FOR RECORD NAME QUALIFIER FOR HASH               #
      NAMEQUAL = 1; 
      QUALFLAG = TRUE;
      FOR I = 0  STEP 1  UNTIL CURLENW - 1  DO
        QUALNAME [I] = CURWORD [I]; 
      QUALNAMELENW = CURLENW; 
      QUALNAMELENC = CURLENG; 
      STDNO;
  
  
SAVNAME:       #****************************************************# 
# **************        S A V N A M E       ************************# 
# SAVE DATANAME FOR KEY NOW IN CASE ITS QUALIFIED                   # 
      NAMELENC = CURLENG; 
      NAMELENW = CURLENW; 
      FOR I = 0  STEP 1  UNTIL CURLENW - 1  DO
        NAME [I] = CURWORD [I]; 
      STDNO;
  
  
SETALTK:          #**************************************************#
# ********************      S E T A L T K      **********************#
# SET ALTERNATE KEY FLAG IN KEY CLAUSE                               #
      IF FILEORG EQ SQ THEN 
        STDNO;
      IF FITXN[0] EQ 0 THEN 
        BEGIN 
        DIAGDL( 220 );
        FITXN[0] = 1; 
        END 
      SCDCKEYPRI [DPTR + 1] = FALSE;
      PRIKEYCT = PRIKEYCT - 1;
      IF PRIKEYCT LQ 0 THEN 
        DIAGDL(149);         # PRIMARY KEY NOT SPECIFIED - ERROR #
      ALTERKY = TRUE; 
      STDYES; 
  
  
SETCDTBL:     #********************************************************#
#*******************        S E T C D T B L         *******************#
#STORE DBP NAME AND FILL IN COMP/DECOMP TABLE                          #
      DBPBUILD; 
      IF SCDCCDTBLPTR[0] NQ 0 AND SCDCCDDBPORD[DPTR-1] EQ UNIQPROCNMS 
      THEN                   # 2ND ENTRY IS IDENTICAL TO 1ST -- MAKE   #
        BEGIN                # ONLY ONE ENTRY.                         #
        SCDCCDCMPFLG[DPTR-1] = COMPFLG; 
        SCDCCDDCMPFG[DPTR-1] = DCMPFLG; 
        END 
      ELSE
        BEGIN                # MAKE NEW ENTRY IN TABLE                 #
        SCDCCDTBLENG[0] = SCDCCDTBLENG[0] + 1;
        J = CURLENG;
        C<0,J>SCDCCDDBPNME[DPTR] = C<0,J>CURWORD[0];
        SCDCCDDBPORD[DPTR] = UNIQPROCNMS; 
        IF SCDCCDTBLPTR[0] EQ 0 THEN        # 1ST ENTRY IN TABLE       #
          BEGIN 
          SCDCCDTBLPTR[0] = DPTR; 
          SCDCCDCMPFLG[DPTR] = COMPFLG; 
          SCDCCDDCMPFG[DPTR] = DCMPFLG; 
          END 
        ELSE                                # 2ND ENTRY IN TABLE       #
          BEGIN 
          SCDCCDCMPFLG[DPTR] = NOT SCDCCDCMPFLG[DPTR-1];
          SCDCCDDCMPFG[DPTR] = NOT SCDCCDDCMPFG[DPTR-1];
          END 
        DPTR = DPTR + 1;
        END 
      STDYES; 
  
  
SETCSTRN:      #*******************************************************# FIRST
# *****************      S E T C S R T N       ************************# FIRST
                                                                         D
      CSDFLAG = TRUE;                                                    FIRST
      STDNO;                                                             FIRST
                                                                         FIRST
                                                                         FIRST
SETRELTN:      #******************************************************# 
# *****************      S E T R E L T N        **********************# 
# SET FLAG TO INDICATE THAT RELATION OVERLAY IS TO BE LOADED.         # 
  
      RELLDFLAG = TRUE; 
      STDNO;
SETSERT:       #*******************************************************#
#******************        S E T S E R T    ***************************#
#   SETS UP THE CALL TO THE ROUTINE THAT COMPUTES THE MAXIMUM SUB-     #
#   ENTRY LENGTH.                                                      #
#**********************************************************************#
      SUBENTLG(SEPTR);
      STDNO;
STARNM:        #******************************************************# 
# *****************        S T A R N M      **************************# 
# STORE AREA NAME IN DATA CONTROL ENTRY.  ERROR IF IT WAS NOT DEFINED # 
# BEFORE.  NAME IS TRUNCATED TO 7 CHARACTERS, HYPHENS IGNORED         # 
      IF REFSTATUS EQ 0 
        THEN STDNO; 
      AREAWA = SYMWRDADDRWK [1];      # SAVE AREA WORD ADDR IN SCHEMA # 
      B<0,42>FITLFN[0] = B<0,42>CURWORD[0]; 
      WRDADRREC = SYMRFWAWK[3];    # STORE RECORD WORD ADDRESS. # 
      MULTRECTY = CTREFAR;
      STDYES; 
  
  
STCDFLAG:        #*****************************************************#
#*********************      S T C D F L A G         *******************#
#SET FLAG TO INDICATE COMP/DECOMP CLAUSE WAS SPECIFIED                 #
      CDFLAG = TRUE;
      STDNO;
  
  
STCMPFG:      #********************************************************#
#**********************       S T C M P F G         *******************#
#SET COMPRESSION FLAG. ERROR IF ALREADY SET                            #
      IF COMPFLG THEN 
        STDNO;
      COMPFLG = TRUE; 
      STDYES; 
  
  
STDCMPFG:     #********************************************************#
#*********************      S T D C M P F G         *******************#
#SET DECOMPRESSION FLAG. ERROR IF ALREADY SET                          #
      IF DCMPFLG THEN 
        STDNO;
      DCMPFLG = TRUE; 
      STDYES; 
  
  
STDNBY:     #*************************************************# 
# ***************       S T D N B Y      *********************# 
# STORE -BY DATANAME - VALUES FOR RECORD.  GET INFORMATION    # 
# FROM SCHEMA ENTRY READ IN DNRDSC.  ERROR IF OCCURS FLAG ON  # 
      IF SCITMDOMORD[0] NQ 0
        THEN STDNO; 
      SCDCRCCDEBWP [PTRDCREC] = SCITEMPBWP [0]; 
      SCDCRCCDEBCP [PTRDCREC] = SCITEMBBP [0]  / 6; 
      SCDCRCCDESIZ [PTRDCREC] = SCITEMSIZE [0]; 
      SCDCRCDEITMP [PTRDCREC] = DIRWA;
      SCDCRCDECLAS [PTRDCREC] = SCITEMCLASS [0];
      SCDCRCDETYP [PTRDCREC] = FALSE; 
      RCDNREC = SCITEMRECA [0]; 
      DPTR = DPTR + 2;
      STDYES; 
  
  
STDUFIR:       #***********************************************#
# ******************    S T D U F I R      ********************#
# STORE DUPLICATES FIRST FLAG FOR KEY                          #
      IF SCDCKEYPRI[TEMPPTR+1]
        THEN STDNO; 
      SCDCKEYFIRST[TEMPPTR+1] = TRUE; 
      STDYES; 
  
  
STDUIND:     #************************************************# 
# *************       S T D U I N D        *******************# 
# STORE DUPLICATES INDEXED FLAG FOR KEY, ERROR IF PRIMARY KEY # 
      IF SCDCKEYPRI[TEMPPTR+1]
        THEN STDNO; 
      SCDCKEYINDEX[TEMPPTR+1] = TRUE; 
      STDYES; 
  
  
STDUNOT:         #*******************************************#
# ****************         S T D U N O T       **************#
# STORE DUPLICATES NOT FLAG FOR KEY                          #
      SCDCKEYNOT[TEMPPTR+1] = TRUE; 
            FITDKI[0] = FALSE;
      STDNO;
  
  
STIMKEY:    #***************************************************# 
# ***************        S T I M K E Y         *****************# 
# STORE THE VALUES FROM SCHEMA ITEM ENTRY FOR THE DATANAME INTO  #
# THE DATA CONTROL KEY ENTRY.  CHECK THAT ITEM ENTRY VALUES      #
# CORRESPOND TO ANY VALUES IN THE FIT SPECIFIED BY A FILE CARD,  #
# IF THIS IS A PRIMARY KEY.  STDNO EXIT IF ITEM ENTRY CONTRADICTS # 
# FIT.  VALUES FROM THE ITEM ENTRY ARE ALWAYS STORED INTO THE FIT.# 
#                                                                      #
  
      WRDITMREC = SYMIRECPTRWK[2];  # WORD ADDRESS OF RECORD THIS ITEM #
                                    # BELONGS TO                       #
      FLAG = TRUE;
      FITEMK[0] = TRUE; 
      TEMPPTR = DPTR; 
      IF SCDCKEYCONCT[DPTR+1] THEN
        GOTO CONBRNCH;
      DIRWA = SYMWRDADDRWK [1]; 
      SCDCKEYDNADR [DPTR + 2] = DIRWA;
      SCDCKEYIMBED [DPTR + 1] = TRUE; 
      DDLRDSC( SCWORKBUF, ITEMFIXW, DIRWA );
      DIRWA = SCITEMRECA [0]; 
      SCDCRCENTRYA [DPTR] = DIRWA;
      SCDCKEYCLASS[DPTR+2] = SCITEMCLASS[0];  # SET CLASS              #
      IF SCITEMCLASS [0]  LS 5
        THEN SCDCKEYTYPE [DPTR] = 0;
        ELSE SCDCKEYTYPE [DPTR] = 1;
      IF SCITMINTVAL [0] NQ 0 
        THEN
        BEGIN 
        SCDCKEYMAXOC [DPTR] = SCITMINTVAL [0];
        IF SCITMDATATYP [0] LQ 4
          THEN SCDCKEYGRPSZ [DPTR] = SCITEMSIZE [0];
        END 
      SCDCKEYBWP [DPTR + 1] = SCITEMPBWP [0]; 
      SCDCKEYBCP [DPTR + 1] = ( SCITEMBBP [0] + 5 )  / 6; 
      SCDCKEYSIZ [DPTR + 1] = SCITEMSIZE [0]; 
      IF SCDCKEYSIZ[DPTR+1] GR DFMAXKL  # IF KL GR MAXIMUM ALLOWED     #
      THEN
        DIAGDL ( 150 );                 # ISSUED DIAGNOSTIC            #
  
CONBRNCH:   #   # 
      IF SCITEMSIZE [0] GR MAXKEYLG 
        THEN MAXKEYLG = SCITEMSIZE [0]; 
      IF SCDCKEYPRI [DPTR + 1]
        THEN
        BEGIN 
        I = FITKP[0]; 
        FITKP[0] = SCITEMBBP[0]/6;
        IF I NQ FITKP[0] AND I NQ 0 
          THEN FLAG = FALSE;
        I = FITKL[0]; 
        IF FILEORG NQ AK     # CHECK KL FOR ALL BUT AK #
          THEN
          BEGIN 
          FITKL[0] = SCITEMSIZE[0]; 
          IF I NQ FITKL[0] AND I NQ 0 
            THEN FLAG = FALSE;
          END 
          K = FITKT[0]; 
          IF FILEORG EQ IS OR FILEORG EQ DA 
          THEN
          BEGIN 
          J = SCITEMCLASS [0];
          IF J LQ 4              # SYMBOLIC KEY TYPE #
              THEN FITKT[0] = 1;
            ELSE
            BEGIN 
          IF J GQ 10 THEN                                                DL3A043
            FITKT[0] = 2;    # FIXED OR FLOATING KEY TYPE #              DL3A043
            END 
            IF K NQ FITKT[0] AND K NQ 0 
            THEN FLAG = FALSE;
          END 
        I = FITRKP[0];
        J = FITRKW[0];
        FITRKP[0] = SCITEMBBP[0]/6; 
        FITRKW[0] = SCITEMPBWP[0];
        IF ( I NQ 0 AND I NQ FITRKP[0] ) OR 
           ( J NQ 0 AND J NQ FITRKW[0] )
        THEN FLAG = FALSE;
        END 
      IF SCITEMCLASS[0] EQ 15 THEN
        DIAGDL( 219 );
      IF FILEORG EQ AK AND SCDCKEYPRI[DPTR+1] THEN   # AK FILE MUST    #
        BEGIN  # HAVE PRIMARY KEY DEFINED AS TYPE FIXED N.             #
        IF (SCITEMCLASS[0] NQ 10 AND SCITEMCLASS[0] NQ 12)
           OR SCITMPICINFO[0] NQ 0 THEN 
          DIAGDL(148);
        END 
      IF FITRT[0] NQ 1 AND FITRT[0] NQ 5 THEN 
        BEGIN    # RECORD TYPE NOT F OR T, COMPUTE MNR FOR CURRENT KEY #
        I = SCDCKEYBWP[DPTR+1]*10 + SCDCKEYBCP[DPTR+1] +
                 SCDCKEYSIZ[DPTR+1] + 
                     (SCDCKEYMAXOC[DPTR]-1) * SCDCKEYGRPSZ[DPTR]; 
        IF I GR MNRLENG THEN
          MNRLENG = I;             # CURRENT MAXIMUM MNR #
        END 
      IF NOT FLAG  THEN STDNO;
      STDYES; 
  
  
  
STIMKT1:   #*****************************************************#
# ******************     S T I M K T 1         ******************#
# FOR IMBEDDED KEY, DNAME MUST NOT BE IN VARIABLE DIMENSN GROUP, #
# ONE LEVEL DOWN IF IN REPEATING GROUP. STDNO EXIT IF NOT, ELSE  #
# STDYES.  ON ENTRY SCWORKBUF CONTAINS ITEM ENTRY. ON EXIT,      #
# SCWORKBUF MAY CONTAIN DOMINANT ITEM ENTRY.                     #
#                                                                      #
  
      IF SCDCKEYIMBED[DPTR+1]            # IF KEY IS IMBEDDED AND DOES #
        AND WRDITMREC NQ WRDADRREC THEN  # NOT BELONG TO FIRST REC TYPE#
        BOOLTEMP = TRUE;                 # SET DIAGNOSTIC 338 FLAG     #
      IF SCDCKEYCONCT[DPTR+1] THEN
        BEGIN 
        DPTR = CONCATPTR; 
        STDYES; 
        END 
      IF SCITMDOMORD[0] NQ 0
        THEN
        BEGIN 
        I = SCDCKEYDNADR[DPTR + 2] - SCITMDOMORD[0];
        DDLRDSC( SCWORKBUF, ITEMFIXW, I );
            IF SCITMDATATYP [0] EQ 3
          THEN STDNO; 
        SCDCKEYGRPSZ [DPTR] = SCITEMSIZE [0]; 
        SCDCKEYMAXOC [DPTR] = SCITMINTVAL [0];
        IF SCITMDIMOCC [0]
          THEN SCDCKEYMAXOC [DPTR] = 0; 
        SCDCKEYBWP [DPTR + 1] = SCDCKEYBWP [DPTR + 1] + SCITEMPBWP [0]; 
        SCDCKEYBCP [DPTR + 1] = SCDCKEYBCP [DPTR + 1] 
              + ( SCITEMBBP [0] + 5) / 6; 
        IF SCDCKEYBCP [DPTR + 1] GQ 10
          THEN
          BEGIN 
          SCDCKEYBCP [DPTR + 1] = SCDCKEYBCP [DPTR + 1] - 10; 
          SCDCKEYBWP [DPTR + 1] = SCDCKEYBWP [DPTR + 1] + 1;
          END 
        END 
      IF SCITMDIMOCC[0] THEN                                             DL3A051
        BEGIN    # VARIABLE DIMENSION GROUP #                            DL3A051
        SCDCKEYMAXOC[DPTR] = 0;                                          DL3A051
        SCDCKEYGRPSZ[DPTR] = SCITEMSIZE[0];                              DL3A051
        END                                                              DL3A051
      DPTR = DPTR + 3;
      STDYES; 
  
  
  
STIMKT2:   #*****************************************************#
#****************        S T I M K T 2         ******************#
# FOR IMBEDDED KEY - TEST THAT DATANAME IS IN A RECORD WHICH IS  #
# WITHIN THIS AREA.  STDNO EXIT IF NOT, ELSE STDYES.  ON ENTRY,  #
# AREAWA CONTAINS THE WORD ADDR OF THE AREA ENTRY IN THE SCHEMA. #
# DIRWA CONTAINS THE WORD ADDR OF THE RECORD ENTRY IN THE SCHEMA.#
      DDLRDSC( SCWORKBUF, RECDFIXW, DIRWA );   # READ RECORD HEADER # 
      IF SCRWITHINA1[0] NQ AREAWA 
      THEN
        BEGIN 
        BOOLTEMP = FALSE;          # CLEAR DIAGNOSTIC 338 FLAG         #
        STDNO;                     # ERROR - RECORD NOT IN THIS AREA   #
  
        END 
      IF BOOLTEMP                  # IF DIAG 338 FLAG SET              #
      THEN
        DIAGDL ( 338 );            # ISSUE DIAGNOSTIC 338              #
  
      BOOLTEMP = FALSE;            # RESET FLAG                        #
      STDYES; 
  
  
STIMKT4:  #**********************************************************#
#**************     S T I M K T 4         ****************************# 
# FOR AK FILES, CHECK KEY LENGTH(KL). IF KL IS EQUAL TO 0 OR GREATER   #
# THAN 8 CHARACTERS, EXIT AS AN ERROR. IF WITHIN RANGE, STORE KEY      #
# POSITION(KP) IN THE FIT AND RETURN TO STDYES.                        #
      IF FILEORG EQ AK
        THEN
        BEGIN 
        I = FITKL[0]; 
        IF I LQ 0 OR I GR 8 THEN STDNO; 
        FITKP[0] = 10 - I;   # STORE KP IN THE FIT #
        FITRKP[0] = FITKP[0];      #STORE RELATIVE KEY POS(RKP) IN FIT# 
        END 
      STDYES; 
  
  
STINTB:   #**************************************************#
# *****************     S T I N T B **********************# 
# STORE INTEGER VALUE FOR RECORD CODE PROCEDURE           # 
# ERROR IF INTEGER NOT IN RANGE 1 TO 1023                              #
      IF CURLENG GR 10
        THEN STDNO; 
      B<0,60>DTEMP = CURWORD[0];
      DISPDECTOBIN; 
      IF ITEMP LS 1  OR  ITEMP GR 1023
        THEN STDNO; 
      SCDCRCDEINTV [DPTR] = ITEMP;
      IF DPTR NQ PTRDCREC+1 
        THEN SCDCRCDENEXT [DPTR - 1] = TRUE;
      DPTR = DPTR + 1;
      STDYES; 
  
  
STKEYNAM:    #*********************************************************#
#**************** ***     S T K E Y N A M     *** *********************#
#   STORE CONCATENATED KEY NAME AND ITS LENGTH IN WORDS AND CHARACTERS #
#   IN DIRECTORY. ALSO SET CONCATENATE FLAG IN KEY TABLE IF KEY NAME   #
#   IS NOT UNIQUE AMONG ITEM AND KEY NAMES, RETURN TO STDNO. ELSE      #
#    RETURN TO STDYES.                                                 #
      IF DUPDEFINE EQ 1 THEN       # IUF NAME NOT UNIQE(FROM HASH ROUT)#
        STDNO;                     # RETURN.                           #
      IF CURLENG GR 30 THEN        # IF NAME LONGER THAN 30 CHARACTERS,#
        BEGIN                      # ISSUE DIAGNOSTIC,AND ADJUST LENGTH#
        DIAGDL(170);               # TO MAXIMUM OF 30 CHARACTERS       #
        CURLENW = 3;
        CURLENG = 30; 
        END 
      CONCATPTR = DPTR + 3;        # VARIABLE POINTER # 
      FOR I = 0 STEP 1 UNTIL CURLENW DO  # STORE KEY NAME # 
        C<0,10>SCDCKEYCNNAM[CONCATPTR+I] = C<0,10>CURWORD[I]; 
      CONCATPTR = CONCATPTR + CURLENW;
      SCDCKEYCONCT[DPTR+1] = TRUE;     # SET FLAG FOR CONCATENATED KEY #
      SCDCKEYCNNMW[DPTR+2] = CURLENW;  # STORE CONCATENATE KEY NAME    #
      SCDCKEYCNNMC[DPTR+2] = CURLENG;  # LENGTH IN WORDS AND CHARS.    #
      STDYES; 
  
STNIKEY:    #******************************************************#
# ***************       S T N I K E Y        **********************#
# STORE NON-IMBEDDED DATANAME AND QUALIFIER NAME FOR KEY           #
# ERROR IF FILE ORGANIZATION IS DIRECT ACCESS OR ALTERNATE KEY     #
      TEMPPTR = DPTR; 
      IF FILEORG EQ DA OR ALTERKY 
        THEN STDNO; 
      SCDCKEYIMBED [DPTR + 1] = FALSE;
      SCDCKEYDNLEN [DPTR + 2] = NAMELENC; 
      J = DPTR + 3; 
      FOR I = 0  STEP 1  UNTIL NAMELENW - 1  DO 
        B<0,60>SCDCKEYDNME [J + I] = NAME [I];
      SCDCKEYDNPTR [DPTR + 2] = 3;
      J = J + NAMELENW; 
      IF QUALFLAG 
        THEN
        BEGIN 
        SCDCKEYDNNXT [DPTR+ 2] = TRUE;
                                           # FOR THE LOG FILE          #
        SCDCKEYRQALL [DPTR + 2] = QUALNAMELENC; 
        FOR I = 0  STEP 1  UNTIL QUALNAMELENW - 1  DO 
          B<0,60>SCDCKEYQALNM [J + I] = QUALNAME [I]; 
        SCDCKEYRQALP [DPTR + 2] = 3 + NAMELENW; 
        J = J + QUALNAMELENW; 
        END 
      DPTR = J; 
      STDYES; 
  
  
STNIK2:   #************************************************************#
# CHECK THAT KL IS SET FROM FILE CARD PARAMETERS FOR   #
# NON-IMBEDDED KEY.  STDNO IF NOT.                     #
# SET NON-IMBEDDED DEFAULT RKP,RKW #
      IF FITKL[0] EQ 0
        THEN STDNO; 
      FITRKP[0] = 10; 
      FITRKW[0] = 0;
      STDYES; 
  
  
STOSEQ:       #********************************************************#
#***************      S T O S E Q       *******************************#
#                                                                      #
#     SET COLLATING SEQUENCE FIELD IN THE DATA CONTROL ENTRY           #
#                                                                      #
#**********************************************************************#
  
      SCDCSEQOPT[PTRDCAREA] = CURP1;
      STDNO;
  
  
STOLITB:       #*********************************************#
# ****************          S T O L I T B      **************#
# STORE LITERAL IN LITSTORE ARRAY.  SAVE LENGTH AND POINTER  #
# IN DC RECORD CODE POINTER WORD.  INCREMENT DPTR, LITCTR.   #
      SCDCRCDELITP [DPTR] = LITCTR; 
      FOR I = 0  STEP 1  UNTIL TEMPSIZE  DO 
        BEGIN 
        IF LITCTR GR 290             # ERROR IF OVERFLOW LITSTORE # 
          THEN STDNO; 
        LITSTOR [LITCTR] = NAME [I];
        LITCTR = LITCTR + 1;
        END 
      IF DPTR NQ PTRDCREC+2 
        THEN SCDCRCDENEXT [DPTR - 1] = TRUE;
      DPTR = DPTR + 1;
      STDYES; 
  
  
STOPRNM:       #**********************************************# 
# *****************        S T O P R N M     *****************# 
# STORE PROCEDURE NAME FOR USING IN KEY CLAUSE.  ERROR IF     # 
# NOT DA OR ALTERNATE KEY SPECIFIED.                         #
      IF FILEORG NQ DA
        THEN STDNO; 
      IF ALTERKY
        THEN STDNO; 
      DBPBUILD; 
      J = CURLENG;
      IF CURLENG GR 7 
        THEN J = 7; 
      C<0,J>SCDCSDAPRCN [PTRDCAREA] = C<0,J>CURWORD [0];
      SCDCSDAORD [PTRDCAREA] = UNIQPROCNMS; 
      STDYES; 
  
  
STORECB:    #************************************************#
#  ******************       S T O R E C B      **************#
# STORE RECORD ADDRESS IN ENTRY FOR THIS VALUE CLAUSE.  USE  #
# WHAT WAS IN SYMBOL TABLE FROM RECORD NAME HASH.  CHECK     #
# THAT RECORD IS IN THE AREA WE ARE LOOKING FOR.             #
      I = SYMWRDADDRWK [1]; 
      SCDCRCDERECA [DPTR] = I;
      DDLRDSC( SCWORKBUF, RECDFIXW, I );     # READ RECORD HEADER # 
      IF SCRWITHINA1[0] NQ AREAWA 
        THEN STDNO; 
      STDYES; 
  
  
STRCBPR:      #**********************************************#
# ***************      S T R C B P R       ******************#
# STORE RECORD CODE PROCEDURE NAME. SET TYPE TO INDICATE     #
# USE OF PROCEDURE. ERROR IF NAME GR 7 CHARACTERS.           #
      IF CURLENG GR 7 
        THEN STDNO; 
      SCDCRCDETYP [DPTR] = TRUE;
      DBPBUILD; 
      SCDCRCDEPROC[DPTR] = B<0,42>CURWORD[0]; 
      DPTR = DPTR + 1;
      STDYES; 
  
  
STSYSFLG:     #********************************************************#
#********************       S T S Y S F L G         *******************#
#SET SYSTEM FLAG AND FIT WORDS.  ERROR IF PROCEDURE WAS SPECIFIED      #
      IF SCDCCDTBLENG[0] NQ 0 THEN    # PROCEDURE PREVIOUSLY SPECIFIED #
        STDNO;
      SCDCCDSYSFLG[0] = TRUE; 
      FITCPA[0] = 1;
      FITDCA[0] = 1;
      STDYES; 
  
  
STVAL:     #*************************************************#
#*******************        S T V A L        ****************#
#   STORE THE COUNT OF THE NUMBER OF  RECORDS FOR WHICH      #
#   RECORD CODE VALUES HAVE BEEN SPECIFIED.                  #
      RCCDVAL = RCCDVAL + 1;
      STDNO;
  
  
TSDUP:    #************************************************#
# **************        T S D U P          ******************#
# CHECK IF DUPLICATES ARE ALLOWED OPTION IS SPECIFIED WITH A PRIMARY   #
# KEY. IF SO, SET DEFAULT OPTION TO NOT ALLOWED. ELSE,SET DUPLICATES  # 
# FLAG IF KEY IS ALTERNATE.                                            #
      SCDCKEYDUPS[TEMPPTR+1] = TRUE;
      IF SCDCKEYPRI[TEMPPTR+1] THEN 
        IF NOT SCDCKEYNOT[TEMPPTR+1] THEN 
          BEGIN 
          SCDCKEYNOT[TEMPPTR+1] = TRUE; 
          STDNO;
          END 
      STDYES; 
  
  
TSBYLIT:   #*********************************************************#
#********************    T S B Y L I T      *************************#
# FOR RECORD CODE BY DATANAME, CHECK THAT ALL LITERALS HAVE UNIQUE   #
# VALUES. STDNO IF NOT, ELSE STDYES.  LITERALS HAVE BEEN MOVED BY    #
# TSBYREC, BUT LITSTOR ARRAY IS USED FOR THIS COMPARISON.  LENGTH OF #
# EACH LITERAL, AFTER CDCS CONVERSION, IS EQUAL, SET IN TEMPSIZE.    #
      TEMPSIZE = TEMPSIZE + 1;
      FOR I = 0 STEP TEMPSIZE UNTIL LITCTR - TEMPSIZE  DO 
        FOR J = I + TEMPSIZE STEP TEMPSIZE UNTIL LITCTR - TEMPSIZE +1 DO
          BEGIN 
          FOR K = 0  STEP 1  UNTIL TEMPSIZE - 1  DO 
            IF LITSTOR [I + K]  NQ  LITSTOR [J + K] 
              THEN TEST J;
            STDNO;
          END 
      STDYES; 
  
  
TSBYPRO:      #******************************************************#
# **************        T S B Y P R O        ************************#
# CHECK THAT ALL INTEGER VALUES ARE UNIQUE FOR RECORDCODE PROCEDURES #
      FOR I = PTRDCREC + 1 STEP 1 WHILE SCDCRCDENEXT[I] DO
        BEGIN 
        FLAG = TRUE;
        FOR J = I + 1  STEP 1  WHILE FLAG  DO 
          BEGIN 
          FLAG = SCDCRCDENEXT [J];
          IF SCDCRCDEINTV [I]  EQ  SCDCRCDEINTV [J] 
            THEN STDNO; 
          END 
        END 
       SCDCRECCDLEN [0] = DPTR - PTRDCREC;
      STDYES; 
  
  
  
TSBYREC:     #*******************************************************#
# **************         T S B Y R E C     *************************# 
# CLEAN UP VALUE PHRASE FOR RECORD-CODE CLAUSE - MOVE LTERALS IN   #
# FROM LITSTORE ARRAY FOR BY DNAME, CHECK DNAME DEFNED IN ONE OF THE #
# RECORDS SPECIFIED FOR BY DATANAME.                               #
      BOOLTEMP = TRUE;
      FLAG = FALSE; 
      K = DPTR - PTRDCREC;
      FOR I = PTRDCREC + 2 STEP 1 WHILE BOOLTEMP DO 
        BEGIN 
        BOOLTEMP = SCDCRCDENEXT[I]; 
        IF SCDCRCDERECA [I] EQ RCDNREC
          THEN FLAG = TRUE; 
          SCDCRCDELITP [I] = SCDCRCDELITP [I] + K;
        END 
      FOR K = 0  STEP 1 UNTIL LITCTR - 1  DO
        BEGIN 
        SCDCRCCDELIT[DPTR] = LITSTOR [K]; 
        DPTR = DPTR + 1;
        END 
       SCDCRECCDLEN [0] = DPTR - PTRDCREC;
      IF FLAG  THEN STDYES;   ELSE STDNO; 
  
  
TSDNLEN:  #*************************************************# 
#****************     T S D N L  E N      *****************#
# STDNO IF SIZE FOR RECORD CODE BY DATANAME IS OVER 240      #
# CHARACTERS, ELSE STDYES EXIT.                              #
      IF SCITEMSIZE [0] GR 240
        THEN STDNO; 
      STDYES; 
  
  
TSKEY:       #******************************************************# 
# ***************       T S K E Y         **************************# 
# EXIT YES IF NO KEY SPECIFIED. ELSE LOOK TO SEE THAT ALL CONDITIONS# 
# ARE MET CORRECTLY FOR KEY.                                        # 
      IF PTRDCKEY EQ 0
        THEN STDYES;
      IF NOT ALTERKY THEN           # IF NO ALTERNATE KEYS SPECIFIED   #
        IF FITXN[0] NQ 0 THEN       # AND XN PARAMETER ON FILE CARD SET#
          BEGIN 
          DIAGDL( 221 );            # ISSUE TRIVIAL DIAGNOSTIC, AND SET#
          FITXN[0] = 0;             # XN VALUE TO 0                    #
          END 
      IF FILEORG EQ SQ THEN        # IF FILE ORGANISATION SEQUENTIAL,  #
        BEGIN 
        IF SORTKEYCNT GR 1 THEN    # AND TOO MANY SORT KEYS, ERROR.    #
          STDNO;
        ELSE
          STDYES; 
        END 
      IF PRIKEYCT NQ 1         # ERR IF TOO MANY (OR NOT ENOUGH)# 
        THEN STDNO;            # PRIMARY KEYS, ONLY SEND ERR ONCE#
      PRIKEYCT = 1; 
      STDYES; 
  
  
TSRECCD:     #*****************************************************#
# **************       T S R E C C D            *******************#
# TEST IF RECORD-CODE SPECIFIED FOR MULTIPLE RECORD TYPES IN       #
# ONE AREA.                                                            #
      IF MULTRECTY GR 1 
        THEN IF PTRDCREC EQ 0 
          THEN
          BEGIN 
          MULTRECTY = 0;
          STDNO;
          END 
      STDYES; 
  
  
TSVAL:      #*****************************************************# 
# ****************          T S V A L         ********************# 
# TEST THAT VALUE PHRASE HAS BEEN SPECIFIED AT LEAST ONCE.        # 
# ERROR IF IT HAS NOT.                                            # 
      IF (DPTR - PTRDCREC) EQ 1 
        THEN STDNO; 
      IF RCCDVAL NQ MULTRECTY THEN
        DIAGDL( 211 );
      STDYES; 
  
  
  PROC CONVLNENBR( LNENBR );
    BEGIN 
      ITEM LNENBR;  # CONTAINS THE BINARY LINE NUMBER TO BE CONVERTED  #
                    # TO DISPLAY CODE.                                 #
      ITEM CONV1;   # SCRATCH ITEM. # 
      ITEM CONV2;   # SCRATCH ITEM. # 
      FOR CONV1 = 9 STEP -1 UNTIL 5 DO
        BEGIN 
        C<CONV1>NBRLINE = LNENBR - CONV2 * 10 + O"33";
        LNENBR = CONV2; 
        END 
    END 
    END 
TERM
