*DECK CBBLDDC 
USETEXT TSBP2CM                                                         006220
      PROC CBBLDDC; 
      BEGIN 
# LOCAL FILEORG DEF # 
      DEF FITFO #B<39,3>SBDCARFITWRD[DCOFFSET+11]#; 
      DEF AK #6#; 
  
# LOCAL KEYMESSAGE DEF                                                 #
      DEF DFBUFSIZE    #99#;           # MAXIMUM MESSAGE LENGTH        #
      DEF DFCONTLINE   #28#;           # START POS OF CONTINUATION LINE#
      DEF DFINSERTKEY  #27#;           # START POS OF KEYNAME          #
  
# EXTERNAL REFERENCES#
      XREF PROC CBCKBUF;      #MEMORY MANAGER PROC# 
      XREF PROC READSC;      #DA ROUTINE TO READ SCHEMA GIVEN ADDRESS#
      XREF PROC CBDBPBD;    #PROC TO A DBP TO DBP TABLE#
      XREF PROC DDLPRNT;     #PROC TO PRINT LINE TO DDL LISTING#
      XREF PROC CBERROR;       #ERROR HANDLER PROC# 
      XREF FUNC CBSSITA;     #FUNC RTNS SBSCH ADDR GIVEN SCH NAME#
      XREF FUNC CBSSRCA;     #FUNC RTNS SBSCH REC ADDR GIVEN SCH NAME#
      XREF ITEM MAXSELENG;   #CONTAINS THE MAXIMUM SUB-ENTRY LENGTH#
  
# LOCAL SCRATCH ITEMS#
      ITEM TEMP1; 
      ITEM TEMP2; 
      ITEM CONCATADR;                  # CONTAINS THE SUB-SCHEMA WORD  #
                                       # ADDRESS OF THE ITEM ENTRY THAT#
                                       # IS DEFINED HAS A CONCATENATED #
                                       # KEY.                          #
      ITEM CONCATCNTR;                 # CONTAINS THE NUMBER OF ITEM   #
                                       # ENTRIES SUBORDINATE TO THE GRP#
                                       # DEFINED HAS A CONCATINATED KEY#
                                       # NEW GROUP ITEMS ARE EXCLUDED  #
                                       # IN THE COUNT.                 #
      ITEM CONCATPTR;                  # POINTS TO THE ITEM ADDRESSES  #
                                       # (DESIGNATED AS CONCATENATED   #
                                       # KEYS) IN THE KEY ENTRY IN THE #
                                       # DATA CONTROL ENTRY.           #
      ITEM LASTKEYADR;                 # WORD ADDRESS OF THE LAST ITEM #
                                       # ENTRY SUBORDINATE TO THE ITEM #
                                       # ENTRY DEFINED AS A CONCAT KEY.#
      ITEM TEMPITMOFSET;       # CONTAINS THE WORD ADDRESS OF THE CONCA#
                               # ATENATED                              #
                               # TENATED ENTRY (SUB-SCHEMA). LATER TO  #
                               # BE USED TO RESTORE THE ORIGINAL VALUE #
                               # BACK INTO SSITEMOFFSET.               #
# DECLARATIONS BETWEEN $BEGIN AND $END BLOCKS ARE SATISFIED BY SYMPL   #006240
# TEXTS AS INDICATED IN THE USETEXT DIRECTIVE.                         #006250
                                                                        006260
      $BEGIN     # SYMPL TEXT * TSBP2CM * USED #                        006270
                                                                        006280
*CALL CBPASS2CM 
                                                                        006300
      $END                                                              006310
      CONTROL EJECT;
# SET DC OFFSET, INCREASE SUBSCHEMA SIZE FOR DATACONTROL ENTRY# 
      DCOFFSET = SBCWSBLENG[0]; 
      SBCWSBLENG[0] = SBCWSBLENG[0]+SCAREADCLENG[0];
      CBCKBUF(P<SUBSCHEMA>,SBCWSBLENG[0]);
# SET NEXT DC OFFSET POINTER IN LAST DC PROCESSED#
      IF LASTDATACONT NQ 0 THEN 
        SBDCNXTAREAP[LASTDATACONT] = DCOFFSET-LASTDATACONT; 
      LASTDATACONT = DCOFFSET;
# READ DATA-CONTROL ENTRY FROM SCHEMA INTO SUBSCHEMA# 
      P<DATACONT> = LOC(SUBSCHEMA)+DCOFFSET;
      READSC(DATACONT,SCAREADCLENG[0],SCAREADCNTLA[0]); 
# ZERO NEXT DATA-CONTROL OFFSET POINTER IN DATACONTROL ENTRY# 
      SBDCNXTAREAP[DCOFFSET] = 0; 
# IF SDA PROC ADD TO DBP LIST AND PUT ORDINAL INTO SUBSCHEMA ENTRY# 
      IF SCDCSDAPRCN[DCOFFSET] NQ 0 THEN
        BEGIN 
        CBDBPBD(SCDCSDAPRCN[DCOFFSET]); 
        SBDCSDAORD [DCOFFSET] = DBPINDEX + 1; 
        END 
      ELSE
        SBDCSDAORD[DCOFFSET] = 0; 
# IF COMP/DCMP PROC ADD TO DBP LIST, PUT ORDINAL INTO SUBSCHEMA ENTRY  #000836
      CDTBLOFFSET = DCOFFSET + SBDCCDTBLPTR[DCOFFSET];                  000837
      IF SBDCCDTBLPTR[DCOFFSET] NQ 0 THEN                               000838
        BEGIN                                                           000839
        FOR TEMP1 = 0 STEP 1 UNTIL SBDCCDTBLENG[DCOFFSET]-1 DO          000840
          BEGIN                                                         000841
          CBDBPBD(SCDCCDDBPNME[CDTBLOFFSET + TEMP1]);                   000842
          SBDCCDDBPORD[CDTBLOFFSET + TEMP1] = DBPINDEX + 1;             000843
          END                                                           000844
        END                                                             000845
# RECORD CODE ENTRY#
      RCOFFSET = DCOFFSET+SBDCRECCDPTR[DCOFFSET]; 
      IF SBDCRECCDPTR[DCOFFSET] NQ 0 THEN 
        BEGIN 
# CHECK RECORD CODE SUB-ENTRY LENGTH AGAINST THE MAXIMUM# 
        IF SBDCRECCDLEN[DCOFFSET] GR MAXSELENG THEN 
          MAXSELENG = SBDCRECCDLEN[DCOFFSET]; 
# IF TYPE DB PROC THEN CBDBPBD AND PUT ORDINAL INTO ENTRY#
        IF SBDCRCDETYP[RCOFFSET] THEN 
          BEGIN 
          CBDBPBD(SCDCRCDEPROC[RCOFFSET]);
          SBDCRCDEPRCO [RCOFFSET] = DBPINDEX + 1; 
          END 
        ELSE
          IF NOT SBDCRECCDFLG[DCOFFSET] THEN
            BEGIN 
            SCDCRCDEITMP[RCOFFSET] = 0; 
            RCOFFSET = RCOFFSET + 1;
            END 
# LOOP THRU LITERAL WORDS REPLACING RECORD ADDRESS WITH RECORD ORDINAL# 
RCLOOP: 
        RCOFFSET = RCOFFSET+1;
        INDEX = CBSSRCA(SCDCRCDERECA[RCOFFSET]);
      SCDCRCDERECA[RCOFFSET] = 0; 
      IF INDEX EQ 0 THEN
        SBDCRCDERECO[RCOFFSET] = 0; 
      ELSE
        BEGIN 
        SBDCRCDERECO[RCOFFSET]
          = SBRECORDINAL[INDEX];
        END 
        IF SBDCRCDENEXT[RCOFFSET] THEN GOTO RCLOOP; 
        END 
      CONTROL EJECT;
# PROCESS KEY TABLE FROM DATA CONTROL ENTRY#
      IF SBDCALTRKYPT[DCOFFSET] NQ 0 THEN 
        BEGIN 
        KEYOFFSET = DCOFFSET+SBDCALTRKYPT[DCOFFSET];
KEYLOOP:  
# **IF ALTERNATE KEY IN SCHEMA, THEN SET FLAG TO FALSE.                #
        IF NOT SCDCKEYPRI[KEYOFFSET+1] THEN    #THIS IS AN ALT KEY.    #
          SBCWALTKEY[0] = FALSE;     #ALT KEYS EXIST. # 
# **GET ADDRESS OF SUB-SCHEMA RECORD# 
        RECOFFSET = CBSSRCA(SCDCRCENTRYA[KEYOFFSET]); 
        SCDCRCENTRYA[KEYOFFSET] = 0;
        SBDCRCENTRYA[KEYOFFSET] = RECOFFSET;
# **IF IMBEDDED KEY UPDATE DATA NAME ADDRESS AND RECORD ORDINAL#
# **FOR NON-IMBEDDED KEY DONT CHANGE INFO FROM SCHEMA#
      IF SCDCKEYIMBED[KEYOFFSET+1] THEN 
          BEGIN 
# **IF RECORD NOT IN SUBSCHEMA AND PRIMARY KEY THEN ERROR#
          IF RECOFFSET EQ 0 THEN
            BEGIN 
            IF SCDCKEYPRI[KEYOFFSET+1] THEN 
          CBERROR(304,FALSE,SBARNAME30[AREAOFFSET+SBARNAMEPTR 
                 [AREAOFFSET]],SBARLENGCHAR[AREAOFFSET]); 
              GOTO KEYLOOPNEXT; 
            END 
# ****IF PRIMARY KEY ITEM NOT IN SUBSCHEMA THEN ERROR#
          IF SBDCCONCTFG[KEYOFFSET+1] THEN # CHECK FOR CONCATENATED KEY#
            CONCTKY;                       # ENTRY.                    #
           ELSE 
          SSITEMOFFSET = CBSSITA(SCDCKEYDNADR[KEYOFFSET+2]);
  
          SBDCKEYDNADR[KEYOFFSET+2] = SSITEMOFFSET; 
          SBDCRECORD[KEYOFFSET+2] = SBRECORDINAL[RECOFFSET];
        IF SSITEMOFFSET EQ 0 AND SCDCKEYPRI[KEYOFFSET+1] THEN 
          CBERROR(304,FALSE,SBARNAME30[AREAOFFSET+SBARNAMEPTR 
                  [AREAOFFSET]],SBARLENGCHAR[AREAOFFSET]);
# ****SET KEY FLAG IN SUBSCHEMA ITEM ENTRY# 
        IF SSITEMOFFSET NQ 0 THEN 
        BEGIN 
        IF SCDCKEYPRI[KEYOFFSET+1] THEN 
          SBITMKEYFLG[SSITEMOFFSET] = TRUE; 
        ELSE
          SBITMALTKEYF[SSITEMOFFSET] = TRUE;
# ****IF RT=AK AND IMBEDDED PRIMARY KEY NOT IDENTICAL THEN ERROR# 
          IF FITFO EQ AK
          AND SBDCKEYPRI[KEYOFFSET+1] 
        AND (SBITMDBCLASS[SSITEMOFFSET] NQ 10 OR
                             SBITMPTINFO[SSITEMOFFSET] NQ 0) THEN 
          CBERROR(305,TRUE,SBARNAME30[AREAOFFSET+SBARNAMEPTR
                  [AREAOFFSET]],SBARLENGCHAR[AREAOFFSET]);
        END 
# ****IF ALTERNATE KEY AND ITEM NOT IN SUBSCH SET FLAG IN KEY ENTRY#
          IF SSITEMOFFSET EQ 0 AND NOT SCDCKEYPRI[KEYOFFSET] THEN 
            BEGIN 
            SBDCKEYOMIT[KEYOFFSET+1] = TRUE;
            GOTO KEYLOOPNEXT; 
            END 
# ****NO QUALIFIER NECESSARY IN SUBSCHEMA#
          SBDCKEYNXT[KEYOFFSET+2] = FALSE;
  
# ****IF CONCATENATED KEY, DO NOT PRINT OUTPUT LISTING                 #
  
      IF SBDCCONCTFG[KEYOFFSET+1] 
      THEN
        BEGIN 
        GOTO KEYLOOPNEXT; 
        END 
      KEYMESSAGE = " "; 
# ****PRINT IMBEDDED KEY TO OUTPUT LISTING# 
          IF SBDCKEYPRI[KEYOFFSET+1] THEN 
            C<1,14>KEYMESSAGE = "PRIMARY KEY";
          ELSE
        IF SBDCKEYSORT[KEYOFFSET+1] THEN
          C<1,14>KEYMESSAGE = "SEQ SORT KEY"; 
        ELSE
            C<1,14>KEYMESSAGE = "ALTERNATE KEY";
          TEMP1 = SBITMSRCLNEN[SSITEMOFFSET]; 
          FOR INDEX=19 STEP -1 UNTIL 15 DO
            BEGIN 
            TEMP2 = TEMP1/10; 
            C<INDEX>KEYMESSAGE = TEMP1-10*TEMP2+"0";
            TEMP1 = TEMP2;
            END 
          C<DFINSERTKEY,SBITMNMELENC[SSITEMOFFSET]>KEYMESSAGE 
          = SBITMNAME30[SSITEMOFFSET+SBITMNAMEPTR[SSITEMOFFSET]]; 
          INDEX = DFINSERTKEY + SBITMNMELENC[SSITEMOFFSET]; 
          C<INDEX,10>KEYMESSAGE = " FOR AREA "; 
          INDEX = INDEX+10; 
          C<INDEX,SBARLENGCHAR[AREAOFFSET]>KEYMESSAGE 
          = SBARNAME30[AREAOFFSET+SBARNAMEPTR[AREAOFFSET]]; 
          INDEX = INDEX+SBARLENGCHAR[AREAOFFSET]; 
          DDLPRNT(KEYMESSAGE,INDEX+1);
          END 
        ELSE
# ****PRINT NON-IMBEDDED KEYS TO OUTPUT LISTING#
          BEGIN 
          C<1,26>KEYMESSAGE = "NON-IMBEDDED KEY"; 
          C<DFINSERTKEY,SBDCKEYDNLEN[KEYOFFSET+2]>KEYMESSAGE
            = SBDCKEYDNM30[KEYOFFSET+SBDCKEYDNPTR[KEYOFFSET+2]];
          INDEX = DFINSERTKEY + SBDCKEYDNLEN[KEYOFFSET+2];
          C<INDEX,10>KEYMESSAGE = " FOR AREA "; 
          INDEX = INDEX+10; 
          C<INDEX,SBARLENGCHAR[AREAOFFSET]>KEYMESSAGE 
          = SBARNAME30[AREAOFFSET+SBARNAMEPTR[AREAOFFSET]]; 
          INDEX = INDEX+SBARLENGCHAR[AREAOFFSET]; 
          DDLPRNT(KEYMESSAGE,INDEX+1);
          END 
KEYLOOPNEXT:  
        IF SBDCKEYNITM[KEYOFFSET+1] NQ 0 THEN 
          BEGIN 
        IF SBDCKEYNITM[KEYOFFSET+1] GR MAXSELENG THEN 
          MAXSELENG = SBDCKEYNITM[KEYOFFSET+1]; 
          KEYOFFSET = KEYOFFSET+SBDCKEYNITM[KEYOFFSET+1]; 
          GOTO KEYLOOP; 
          END 
# CALCULATE LENGTH OF LAST KEY ITEM IF IT IS A CONCATENATED KEY AND    #
# COMPARE AGAINST MAXIMUM SUB-ENTRY LENGTH. OTHER TYPES OF KEYS ARE    #
# NOT CONSIDERED BECAUSE THEIR LENGTHS WILL BE LESS THAN THE MINIMUM   #
# SUB-ENTRY LENGTH FOR FORSEEABLE FUTURE IMPLEMENTATIONS.              #
      IF SBDCCONCTFG[KEYOFFSET+1] THEN
        BEGIN 
        TEMP1 = 2+SBDCCNNMELW[KEYOFFSET+2]+SBDCCNNBRITM[KEYOFFSET+2]; 
        IF TEMP1 GR MAXSELENG THEN
          MAXSELENG = TEMP1;
        END 
        END 
      RETURN; 
  
  
      PROC CONCTKY; 
      BEGIN 
# 
* *   CONCTKY - VERIFY CONCATENATED KEY ITEMS IN SUBSCHEMA
* *   A S ESPERANZA                              DATE  03/18/83 
* 
*     PURPOSE 
* 
*     CONCTKY VERIFIES THAT ALL ELEMENTS OF A CONCATENATED KEY APPEAR 
*     IN THE SUBSCHEMA AND ENFORCES THAT THE ORDER, SIZE, AND TYPE OF 
*     THE CONCATENATED KEY ITEMS IN THE SUBSCHEMA MUST BE IDENTICAL TO
*     THAT IN THE SCHEMA.  ALSO, THE CONCATENATED KEYNAME ALONG WITH
*     THE CONSTITUENT ITEMS ARE FORMATTED AND PRINTED TO OUTPUT.
* 
*     ENTRY CONDITIONS
* 
*     THIS ROUTINE IS CALLED FROM CBBLDDC WHEN A CONCATENATED KEY ITEM
*     IS DETECTED DURING THE PROCESSING OF THE DATA CONTROL ENTRY IN
*     THE FORTRAN SUBSCHEMA.
* 
*     ASSUMPTIONS 
* 
*     THE SUBSCHEMA RECORD ENTRY POINTER(RECOFFSET), THE DATA CONTROL 
*     KEY ENTRY POINTER(KEYOFFSET), AND THE AREA ENTRY POINTER
*     (AREAOFFSET) ARE SET. 
* 
*     EXIT CONDITIONS 
* 
*     NORMAL  : UPON COMPLETION OF PROCESSING A VALID CONCATENATED KEY
*     ABNORMAL: ERROR 313 - ITEM DOES NOT QUALIFY AS A VALID CONCAT-
*               ENATED KEY
*             : ERROR 316 - PRIMARY CONCATENATED KEY ITEM NOT FOUND 
*               IN SUBSCHEMA
*             : ALTERNATE KEY ITEMS NOT FOUND IN SUBSCHEMA
* 
*     DESCRIPTION 
* 
*     GET THE FIRST CONSTITUENT ITEM OF THE CONCATENATED KEY FROM THE 
*     KEY ENTRY IN THE DATA CONTROL.  CONVERT ITS ADDRESS TO A SUB- 
*     SCHEMA ADDRESS.  IF A MATCH IS FOUND, VERIFY THAT BOTH ITEMS ARE
*     IDENTICAL IN SIZE AND TYPE.  SET BOTH THE BWP AND THE BCP IN THE
*     KEY ENTRY TO THE BWP AND BCP OF THE MATCHED ITEM IN THE SUBSCHEMA 
*     LIST.  NEXT, CHECK FOR CONTIGUITY OF THE REST OF THE CONSTITUENT
*     ITEMS BY GETTING THE NEXT ITEM IN THE KEYLIST AND SEE IF IT 
*     MATCHES THE NEXT ITEM IN THE SUBSCHEMA LIST.  VERIFY THAT THE 
*     ITEMS ARE IDENTICAL AND REPLACE THE DBI WORD ADDRESS WITH ITS 
*     ITS SUBSCHEMA WORD ADDRESS. 
* 
*     LASTLY, FORMAT THE SUBSCHEMA OUTPUT TO PRINT THE CONCATENATED KEY 
*     NAME AND ITS CONSTITUENT ITEMS. 
* 
# 
  
  
#     LOCAL DECLARATIONS                                               #
  
        ITEM NEXT I;               # CONTAINS THE SUBSCHEMA WORD ADDR  #
                                   # OF THE DBI IN THE KEY ENTRY       #
  
                                   # INITIALIZE COUNTERS               #
        CONCATCNTR = 0; 
        NEXT = 0; 
  
                                   # ADJUST PTR TO THE DBI WORD ADDR   #
                                   # IN THE KEY ENTRY                  #
        CONCATPTR = KEYOFFSET + 3 + SBDCCNNMELW[KEYOFFSET + 2]; 
  
  
                                   # CONVERT SCHEMA WORD ADDRESS TO    #
                                   # SUBSCHEMA WORD ADDRESS            #
        SBDCCNDBIS[CONCATPTR] = CBSSITA(SBDCCNDBIS[CONCATPTR]); 
  
        SSITEMOFFSET = SBDCCNDBIS[CONCATPTR]; 
        NEXT = SSITEMOFFSET;
  
# ****CHECK IF SCHEMA ITEM IS IN SUBSCHEMA                             #
  
        IF SBDCCNDBIS[CONCATPTR] EQ 0 
        THEN
          BEGIN 
          IF SBDCKEYPRI[KEYOFFSET+1]
          THEN
            BEGIN 
            GOTO DIAG316;          # SCHEMA ITEM NOT FOUND IN SUBSCHEMA#
            END 
  
          ELSE                     # IF ALTERNATE KEY ITEM NOT FOUND,  #
            BEGIN                  # ASSUME THAT IT IS NOT GOING TO BE #
            RETURN;                # USED, RETURN                      #
            END 
  
          END 
  
# ****VERIFY ITEM TYPE                                                 #
  
        IF NOT SBITMIDNTICL[SSITEMOFFSET] 
        THEN
          BEGIN 
          IF SBDCKEYPRI[KEYOFFSET+1]
          THEN
            BEGIN 
            GOTO DIAG313;          # DATA TYPES DONT MATCH             #
            END 
  
          ELSE
            BEGIN                  # IF ALTERNATE KEY ITEM, ASSUME THAT#
            SSITEMOFFSET = 0;      # IT WILL NOT BE USED AS KEY ITEM,  #
            RETURN;                # RETURN                            #
            END 
  
          END 
  
                                   # SAVE WA OF FIRST ITEM MATCH       #
        TEMPITMOFSET = SSITEMOFFSET;
  
                                   # SET BWP IN KEY ENTRY OF DC        #
        SBDCKEYBWP[KEYOFFSET+1] = SBITMBWP[SSITEMOFFSET]; 
  
                                   # SET BCP IN KEY ENTRY OF DC        #
        SBDCKEYBCP[KEYOFFSET+1] = SBITMBBP[SSITEMOFFSET]/6; 
  
                                   # STEP THRU THE DBI ENTRIES         #
        FOR TEMP1 = 1 STEP 1 UNTIL SBDCCNNBRITM[KEYOFFSET+2] - 1
        DO
          BEGIN 
  
                                   # GET WORD ADDRESS OF THE NEXT ITEM #
                                   # ENTRY                             #
          NEXT = NEXT + SBITMNEXTP[NEXT]; 
  
                                   #CONVERT SCHEMA WORD ADDRESS        #
          SSITEMOFFSET = CBSSITA(SBDCCNDBIS[CONCATPTR + TEMP1]);
  
# ****CHECK IF THE ITEM IS IN THE SUBSCHEMA                            #
  
          IF SSITEMOFFSET EQ 0
          THEN
            BEGIN 
            IF SBDCKEYPRI[KEYOFFSET+1]
            THEN
              BEGIN 
              GOTO DIAG316;        # SCHEMA ITEM NOT FOUND IN SUBSCHEMA#
              END 
  
            ELSE
              BEGIN                # IF ALTERNATE KEY ITEM NOT FOUND,  #
                                   # ASSUME THAT IT IS NOT GOING TO BE #
                                   # USED, RETURN                      #
              RETURN; 
              END 
  
            END 
  
# ****VERIFY CONTIGUITY OF ITEMS                                       #
  
          IF NEXT NQ SSITEMOFFSET 
          THEN
            BEGIN 
            IF SBDCKEYPRI[KEYOFFSET+1]
            THEN
              BEGIN 
              GOTO DIAG313;        # ITEM NOT CONTIGUOUS IN SUBSCHEMA  #
              END 
  
            ELSE
              BEGIN                # ALT KEY ITEM, ASSUME NOT TO BE    #
                                   # USED AS PART OF A KEY, RETURN     #
              SSITEMOFFSET = 0; 
              RETURN; 
              END 
  
            END 
  
# ****VERIFY THAT THE ITEMS ARE IDENTICAL                              #
  
          IF NOT SBITMIDNTICL[SSITEMOFFSET] 
          THEN
            BEGIN                  # DATA TYPES DONT MATCH             #
            IF SBDCKEYPRI[KEYOFFSET+1]
            THEN
              BEGIN 
              GOTO DIAG313; 
              END 
  
            ELSE
              BEGIN                # ALT KEY, ASSUME WILL NOT BE USED  #
                                   # AS KEY ITEM, RETURN               #
              SSITEMOFFSET = 0; 
              RETURN; 
              END 
  
            END 
  
                                   # REPLACE WITH CONVERTED ADDRESS    #
          SBDCCNDBIS[CONCATPTR+TEMP1] = SSITEMOFFSET; 
          END 
  
# ****PRINT CONCATENATED KEYS TO OUTPUT LISTING                        #
  
        KEYMESSAGE = " ";          # INITIALIZE TO BLANK               #
  
                                   # RESTORE THE WORD ADDRESS OF THE   #
                                   # KEY ENTRY IN THE SUBSCHEMA        #
        SSITEMOFFSET = TEMPITMOFSET;
        IF SBDCKEYPRI[KEYOFFSET+1]
        THEN
          BEGIN 
          C<1,14>KEYMESSAGE = "PRIMARY KEY";
          END 
  
        ELSE
          BEGIN 
          C<1,14>KEYMESSAGE = "ALTERNATE KEY";
          END 
  
        C<15,5>KEYMESSAGE = "*****";
  
                                   # INSERT KEYNAME                    #
        C<DFINSERTKEY,SBDCCNNMELC[KEYOFFSET+2]>KEYMESSAGE 
        = SBDCCNNME30[KEYOFFSET+3]; 
        INDEX = DFINSERTKEY + SBDCCNNMELC[KEYOFFSET+2]; 
        C<INDEX,1>KEYMESSAGE = "("; 
        INDEX = INDEX + 1;
  
# ****INSERT ALL KEY ITEMS EXCEPT THE LAST KEY ITEM                    #
  
        FOR TEMP1 = 1 STEP 1 UNTIL SBDCCNNBRITM[KEYOFFSET+2] - 1
        DO
          BEGIN                    # INSERT KEYLIST IN SUBSCHEMA OUTPUT#
          C<INDEX,SBITMNMELENC[SSITEMOFFSET]>KEYMESSAGE 
          = SBITMNAME30[SSITEMOFFSET + SBITMNAMEPTR[SSITEMOFFSET]]; 
          INDEX = INDEX + SBITMNMELENC[SSITEMOFFSET]; 
  
          C<INDEX,1>KEYMESSAGE = ","; 
          INDEX = INDEX + 1;
  
                                   # GET WORD ADDR OF NEXT ITEM ENTRY  #
          SSITEMOFFSET = SSITEMOFFSET + SBITMNEXTP[SSITEMOFFSET]; 
  
                                   # CHECK IF THERE IS SPACE FOR ITEM  #
                                   # NAME IN MESSAGE BUFFER            #
          IF (INDEX + SBITMNMELENC[SSITEMOFFSET] + 1) GQ DFBUFSIZE
          THEN
            BEGIN 
            DDLPRNT(KEYMESSAGE,INDEX+1);
            KEYMESSAGE = " "; 
            INDEX = DFCONTLINE + SBDCCNNMELC[KEYOFFSET+2];
            END 
  
          END 
  
        IF (INDEX+SBITMNMELENC[SSITEMOFFSET]+11) GQ DFBUFSIZE 
        THEN
          BEGIN 
          DDLPRNT(KEYMESSAGE,INDEX+1);
          KEYMESSAGE = " "; 
          INDEX = DFCONTLINE + SBDCCNNMELC[KEYOFFSET+2];
          END 
  
                                   # INSERT LAST KEY ITEM              #
        C<INDEX,SBITMNMELENC[SSITEMOFFSET]>KEYMESSAGE 
        = SBITMNAME30[SSITEMOFFSET+SBITMNAMEPTR[SSITEMOFFSET]]; 
        INDEX = INDEX + SBITMNMELENC[SSITEMOFFSET]; 
  
        C<INDEX,11>KEYMESSAGE = ") FOR AREA ";
        INDEX = INDEX + 11; 
  
        IF (INDEX + SBARLENGCHAR[AREAOFFSET]) GQ DFBUFSIZE
        THEN
          BEGIN 
          DDLPRNT(KEYMESSAGE,INDEX+1);
          KEYMESSAGE = " "; 
          INDEX = DFCONTLINE + SBDCCNNMELC[KEYOFFSET+2];
          END 
  
                                   # INSERT AREA NAME                  #
        C<INDEX,SBARLENGCHAR[AREAOFFSET]>KEYMESSAGE 
        = SBARNAME30[AREAOFFSET + SBARNAMEPTR[AREAOFFSET]]; 
        INDEX = INDEX + SBARLENGCHAR[AREAOFFSET]; 
        DDLPRNT(KEYMESSAGE,INDEX+1);
  
                                   # RESTORE THE WORD ADDRESS OF THE   #
                                   # KEY ENTRY IN THE SUBSCHEMA        #
        SSITEMOFFSET = TEMPITMOFSET;
        RETURN; 
  
DIAG313:  
        CBERROR(313,TRUE,SBITMNAME30[NEXT+SBITMNAMEPTR[NEXT]],
                SBITMNMELENC[NEXT]);
        RETURN; 
  
DIAG316:  
        CBERROR(316,FALSE,SCITMNAM30[SCITMNAMEPTR[0]],
                SCITMNAMLENC[0]); 
        RETURN; 
  
      END 
  
  
   PROC CHKMAJK;
#**********************************************************************#
#                            C H K M A J K                             #
#   PURPOSE:                                                           #
#         TO FLAG MAJOR KEYS, BOTH PRIMARY AND ALTERNATE, IN THE       #
#         COBOL SUB-SCHEMA.                                            #
#                                                                      #
#   ENTRY CONDITIONS:                                                  #
#         THIS ROUTINE IS CALLED FROM CBBLDDC WHEN A KEY ITEM IS       #
#         DETECTED DURING THE PROCESSING OF THE DATA CONTROL ENTRY     #
#         IN THE COBOL SUB-SCHEMA.                                     #
#         THE SUB-SCHEMA IS IN CORE AND THE WORD ADDRESS OF THE KEY    #
#         ITEM IS KNOWN(SSITEMOFFSET).                                 #
#                                                                      #
#   EXIT CONDITIONS:                                                   #
#         MAJOR KEY FLAGS SET IN THE KEY ITEM ENTRY IN THE COBOL       #
#         SUB-SCHEMA.                                                  #
#                                                                      #
#   DESCRIPTION:                                                       #
#         IF THE KEY ITEM IS THE LAST ITEM IN THE RECORD OR IF THE     #
#         NEXT ITEM IS A LEVEL-66 ITEM, CONTROL IS TRANSFERRED TO THE  #
#         CALLING ROUTINE. IF NOT, THE PROCESSING IS DONE IN TWO       #
#         PHASES.                                                      #
#         1) PROCESSING ONLY FOR GROUP KEY ITEMS.                      #
#         2) PROCESSING WHEN THE KEY ITEM IS REDEFINED BY A REDEFINES  #
#         ITEM.                                                        #
#         IN THE FIRST PHASE, A CHECK IS MADE FOR AN ITEM THAT IS      #
#         DIRECTLY SUBORDINATE TO A DESIGNATED PRIMARY OR ALTERNATE    #
#         KEY ITEM, AND IS SHORTER THAN THE KEY ITEM. IF ONE IS FOUND, #
#         THE MAJOR KEY FLAG IS SET IN ITS ENTRY IN THE SUB-SCHEMA.    #
#         DIRECTORY.                                                   #
#         IN THE SECOND PHASE, A CHECK IS MADE FOR AN ITEM THAT IS     #
#         DIRECTLY SUBORDINATE TO ITEMS THAT REDEFINE A KEY ITEM, AND  #
#         IS SHORTER THAN THE KEY ITEM. IF ONE IS FOUND, THE MAJOR KEY #
#         FLAG IS SET IN ITS ENTRY.                                    #
#**********************************************************************#
    BEGIN 
      ITEM I1,I2,I3;               # SCRATCH VARIABLES. # 
  
      I1 = SSITEMOFFSET;     # WORD ADDRESS OF CURRENT(KEY) ITEM #
#   COMPUTE WORD ADDRESS OF THE ITEM FOLLOWING THE KEY ITEM. #
      I2 = SSITEMOFFSET + SBITMNEXTP[SSITEMOFFSET]; 
  
#   PROCESS MAJOR KEYS OF GROUP KEY ITEMS # 
      FOR I2 = I2 STEP SBITMNEXTP[I2] WHILE 
                             SBITMLEVEL[I2] GR SBITMLEVEL[I1] AND 
                             SBITMLEVEL[I2] NQ LEVEL88 DO 
        BEGIN    # SEARCH FOR IMMEDIATE SUBORDINATES #
        IF SBITMLEVEL[I2] EQ LEVEL66 THEN 
          RETURN;            # LEVEL-66 ITEM. # 
        IF SBITMUSESIZE[I2] LS SBITMUSESIZE[SSITEMOFFSET] THEN
          SBITMMAJKEYF[I2] = TRUE;   # MAJOR KEY FOUND---SET FLAG. #
        I1 = I2;             # NEXT ITEM BECOMES CURRENT ITEM. #
        END 
  
#   PROCESS MAJOR KEYS OF REDEFINED KEY ITEMS # 
      I2 = SSITEMOFFSET + SBITMNEXTP[SSITEMOFFSET]; # NEXT ITEM ADDR.  #
  LOOPMK: 
      FOR I3 = I3 WHILE SBITMLEVEL[I2] GR SBITMLEVEL[SSITEMOFFSET] DO 
        BEGIN    # SKIP TO ITEM AT SAME LEVEL AS KEY ITEM # 
        IF SBITMNEXTP[I2] EQ 0 OR SBITMLEVEL[I2] EQ LEVEL66 THEN
          RETURN;  # END OF RECORD OR LEVEL-66 ITEM. #
        I2 = I2 + SBITMNEXTP[I2];  # WORD ADDRESS OF NEXT ITEM. # 
        END 
  
      IF SBITMLEVEL[I2] LS SBITMLEVEL[SSITEMOFFSET] THEN
        RETURN;        # ITEM AT HIGHER LEVEL THAN KEY ITEM # 
  
      FOR I3 = I3 WHILE SBITMREDEFFG[I2] DO 
        BEGIN 
        I3 = I2 + SBITMNEXTP[I2];  # WORD ADDR. OF SUBORDINATE ITEM,IF #
                                   # ANY. ELSE, ADDRESS SAME AS CURRENT#
                                   # ITEM.                             #
        FOR I3 = I3 STEP SBITMNEXTP[I3] WHILE 
                                   SBITMLEVEL[I3] GR SBITMLEVEL[I2] DO
          BEGIN  # CHECK SUBORDINATE ITEMS FOR POSSIBLE MAJOR KEYS. # 
          IF SBITMLEVEL[I3] EQ LEVEL66 THEN 
            RETURN;          # LEVEL-66 ITEM. # 
          IF SBITMUSESIZE[I3] LS SBITMUSESIZE[SSITEMOFFSET] THEN
            SBITMMAJKEYF[I3] = TRUE;   # MAJOR KEY FOUND---SET FLAG. #
          I2 = I3;           # NEXT ITEM BECOMES CURRENT ITEM. #
          END 
        GOTO LOOPMK;
        END 
      RETURN; 
    END          # END OF PROC #
      END 
      TERM; 
