*DECK CBCKREC 
USETEXT TSBP2CM                                                         005970
      PROC CBCKREC; 
      BEGIN 
  
# EXTERNAL REFERENCES#
      XREF PROC CBCKBUF;      #MEMORY MANAGER PROC# 
      XREF PROC CBCKITM;      #PROC TO CHECK ITEM#
      XREF PROC CBCKSCM;     #ADD ITEM DBP S TO DBP LIST# 
      XREF FUNC CBSCITM;     #RETURN ADDR OF SC ITEM, NEG IF NOT FOUND# 
      XREF PROC READSC;      #DA ROUTINE TO READ SCHEMA GIVEN ADDRESS#
      XREF PROC DE$NMSC;     #DA ROUTINE TO READ SCHEMA GIVEN NAME# 
      XREF PROC CBDBPBD;    #ADD DBP TO DBP TABLE#
      XREF PROC CBERROR;       #ERROR HANDLER PROC# 
      XREF ITEM ABORTFLAG;   #SET, IF THERE ARE FATAL ERRORS# 
      XREF PROC CBSTBCK;     #SET MAPPING BLOCKS# 
  
# DECLARATIONS BETWEEN $BEGIN AND $END BLOCKS ARE SATISFIED BY SYMPL   #005990
# TEXTS AS INDICATED IN THE USETEXT DIRECTIVE.                         #006000
                                                                        006010
      $BEGIN     # SYMPL TEXT * TSBP2CM * USED #                        006020
                                                                        006030
*CALL CBPASS2CM 
                                                                        006050
      $END                                                              006060
                                                                        006070
      ITEM SSITMADD;         #FIRST SS ITEM ENTRY IN RECORD            #
      CONTROL EJECT;
# LOOK AT FIRST RECORD ENTRY IN SUBSCHEMA#
      RECOFFSET = SBCWFRSTRECA[0];
      IF RECOFFSET EQ 0 THEN RETURN;   #RETURN IF SBSCH IN ERROR# 
RECORDLOOP: 
# SET MAPPING FLAG FOR RECORD FALSE#
      RECMAPPING = FALSE; 
      SBRECNOMAP[RECOFFSET] = TRUE; 
# LOCATE RECORD ENTRY IN SCHEMA#
      IF SBRECALIASLW[RECOFFSET] EQ 0 THEN
        BEGIN 
        NAME = SBRECNAME30[RECOFFSET+SBRECNAMEPTR[RECOFFSET]];
        NAMEL = SBRECNMELENW[RECOFFSET];
        NAMELC = SBRECNMELENC[RECOFFSET]; 
        END 
      ELSE
        BEGIN 
        NAME = SBRECALIAS30[RECOFFSET+SBRECALIASP[RECOFFSET]];
        NAMEL = SBRECALIASLW[RECOFFSET];
        NAMELC = SBRECALIASLC[RECOFFSET]; 
        END 
      DE$NMSC(DITSC,1,NAME,NAMEL,SCHEMAL,SCHEMA); 
      IF DASTATE[0] NQ 0 THEN 
        BEGIN                # RECORD ENTRY NOT FOUND IN SCHEMA#
        CBERROR(300,FALSE,NAME,NAMELC); 
        RETURN; 
        END 
# SAVE WA OF RECORD IN SCHEMA#
      SCRECADDR = DAENTAD[0]; 
# UPDATE SCH-SBSCH RECORD ADDR TABLE# 
      RECADTL = RECADTL+1;   #INCREASE SIZE BY 1# 
      CBCKBUF(P<RECADT>,RECADTL+1); 
      SCRECADRS[RECADTL] = SCRECADDR;  #STORE SC REC ADDR#
      SSRECADRS[RECADTL] = RECOFFSET;  #STORE SS REC ADDR#
# MAKE SURE ENTIRE RECORD READ# 
      IF SCRECENTLEN[0] GR SCHEMAL THEN 
        BEGIN 
        SCHEMAL = SCRECENTLEN[0]; 
        CBCKBUF (P<SCHEMA>,SCHEMAL);
        READSC(SCHEMA,SCHEMAL,DAENTAD[0]);
        END 
# BUILD DBP LIST FOR RECORD ENTRY#
      IF SCRECONLIST[0] NQ 0 THEN 
        BEGIN 
        ADDRESS = SCRECONLIST[0]-1; 
RCDBPLST: 
        ADDRESS = ADDRESS+1;
        CBDBPBD(SCRECONPROCN[ADDRESS]); 
        IF SCRECNEXTON[ADDRESS] THEN GOTO RCDBPLST; 
        END 
# CHECK FOR ITEM LEVEL DATABASE PROCEDURES IN SCHEMA.                  #
      CBCKSCM;
# SET NEXT ITEM POINTER FOR SCHEMA# 
      SCNEXTPTR = SCRECDITMPTR[0];
# GET FIRST ITEM ENTRY IN SUBSCHEMA#
      IF SBRECNXITEMP[RECOFFSET] EQ 0 THEN
        GOTO ITEMLOOPEND; 
      SSITEMOFFSET = RECOFFSET+SBRECNXITEMP[RECOFFSET]; 
      SSITMADD=SSITEMOFFSET; #SAVE FIRST SS ITEM ENTRY                 #
      IDENTICAL[0] = TRUE;
      CURRENT = 0;
      LEVEL[0] = -1;
ITEMLOOP: 
      CURRENT = CURRENT+1;
      IDENTICAL[CURRENT] = TRUE;
      ITEMPTR[CURRENT] = SSITEMOFFSET;
      LEVEL[CURRENT] = SBITMLEVEL[SSITEMOFFSET];
# ZERO OUT SAME NAME ADDRESSES-ESPECIALLY IMPORTANT FOR ITEMS NOT IN   #000722
# THE SCHEMA BECAUSE THE SAME FIELD IS USED FOR THE RELATIVE POSITION  #000723
# OF THAT ITEM IN THE SCHEMA AND SHOULD BE ZERO.                       #000724
      SBITMSAMENME[SSITEMOFFSET] = 0;                                   000725
# NEW GROUP ITEMS ARE HANDLED DIFFERENTLY THAN OTHER ITEMS             #
      IF SBITMTYPE[SSITEMOFFSET] EQ 0 THEN
# THE BEGGINNING WORD AND BIT POSITION FOR ITEMS SUBORDINATE TO A NEW  #
# GROUP ITEM ARE RELATIVE TO THE FIRST DOMINANT ITEM WHICH IS NOT      #
# A NEW GROUP. TO HANDLE THIS, THE BEGINNING POSITION OF THE DOMINANT  #
# ITEM FOR A NEW GROUP IS STORED FOR THE BEGINNING POSITION OF A NEW   #
# GROUP IN THE ARRAY TO KEEP TRACK OF ITEM INFORMATION.                #
# MAKE SURE NEW GROUP NAME DOES NOT APPEAR IN SCHEMA.                  #
        BEGIN 
        SCPOINTER[CURRENT] = SCPOINTER[CURRENT-1];
        SCOCCURS[CURRENT] = SCOCCURS[CURRENT-1];
        SSOCCURS[CURRENT] = SSOCCURS[CURRENT-1];
        SSBEGWORD[CURRENT] = SSBEGWORD[CURRENT-1];
        SSBEGBIT[CURRENT] = SSBEGBIT[CURRENT-1];
        SCBEGWORD[CURRENT] = SCBEGWORD[CURRENT-1];
        SCBEGBIT[CURRENT] = SCBEGBIT[CURRENT-1];
      SBITMNEWGRP[SSITEMOFFSET] = TRUE; # SET FLAG TO INDICATE THAT THE#
                  # CURRENT ITEM ENTRY IS A NEW GROUP ENTRY.           #
        IF CBSCITM(SSITEMOFFSET) GR 0 THEN
          CBERROR(311,TRUE);
        END 
      ELSE
# SET BEGINNING POSITION IN RECORD FOR ALL ITEMS WHICH ARE NOT NEW    # 
# GROUP. CALL CBCKITM TO CHECK THESE ITEMS.                           # 
# CALL CBCKITM FOR THE ITEM.                                           #
        BEGIN 
        SSBEGWORD[CURRENT]= SSBEGWORD[CURRENT-1]+SBITMBWP[SSITEMOFFSET];
        SSBEGBIT[CURRENT] = SSBEGBIT[CURRENT-1]+SBITMBBP[SSITEMOFFSET]; 
        IF SSBEGBIT[CURRENT] GQ 60 THEN 
          BEGIN 
          SSBEGWORD[CURRENT] = SSBEGWORD[CURRENT]+1;
          SSBEGBIT[CURRENT] = SSBEGBIT[CURRENT]-60; 
          END 
        CBCKITM;
      IF SCITEMOFFSET GR 0 THEN 
        SBITMSCPTR[SSITEMOFFSET] = SCITEMOFFSET; # OFFSET TO SCHEMA    #
                                                 # ENTRY.              #
        END 
# GET NEXT ITEM ENTRY#
#   IGNORE THE ITEM IF THE ITEM IGNORE BIT IS SET#
ITEMNEXT: 
      IF SBITMNEXTP[SSITEMOFFSET] NQ 0 THEN 
        BEGIN 
        SSITEMOFFSET = SSITEMOFFSET+ SBITMNEXTP[SSITEMOFFSET];
        IF SBITMREDEFFG[SSITEMOFFSET] THEN
          GOTO ITEMNEXT;
        LEVELT = SBITMLEVEL[SSITEMOFFSET];
        END 
      ELSE
        LEVELT = 0; 
# LOOP BACKWARDS SETTING IDENTICAL FLAGS# 
      FOR CURRENT = CURRENT STEP -1 WHILE 
      LEVELT LQ LEVEL[CURRENT] DO 
        BEGIN 
        SBITMIDNTICL[ITEMPTR[CURRENT]] = IDENTICAL[CURRENT];
        IDENTICAL[CURRENT-1]
          = IDENTICAL[CURRENT-1] AND IDENTICAL[CURRENT];
        END 
# IF MORE ITEM ENTRIES THEN CONTINUE LOOP#
      IF LEVELT NQ 0 THEN GOTO ITEMLOOP;
ITEMLOOPEND:  
# SET IDENTICAL FLAG IN RECORD ENTRY# 
      IF SCNEXTPTR EQ 0 THEN
        BEGIN 
        SBRECIDNTICL[RECOFFSET] = IDENTICAL[0]; 
        IF NOT IDENTICAL[0] THEN
          BEGIN 
          OM$NOTIDENT = TRUE; 
          RECMAPPING = TRUE;
          END 
        END 
      ELSE
        BEGIN 
        SBRECIDNTICL[RECOFFSET] = FALSE;
        OM$NOTIDENT = TRUE;  #SCH AND SBSCH NOT IDENTICAL#
          RECMAPPING = TRUE;
        END 
# CHECK IF ANOTHER RECORD ENTRY#
# IF MAPPING FOR RECORD CLEAR NO MAP BIT FOR RECORD AND ASSOCIATED AREA#
      IF RECMAPPING THEN
        BEGIN 
        AREAOFFSET = SBRECRLMADR[RECOFFSET];
        SBARNOMAPIND[AREAOFFSET] = FALSE; 
        END 
        SBRECNOMAP[RECOFFSET] = FALSE;
      IF ABORTFLAG EQ 0 THEN #NO ERROR# 
        CBSTBCK(SSITMADD);   #CALL PROC TO SET MAPPING BLOCKS  #
      IF SBRECORDINAL[RECOFFSET] NQ SBCWNUMBERCS[0] THEN
        BEGIN 
        RECOFFSET = RECOFFSET+SBRECNXRECP[RECOFFSET]; 
        GOTO RECORDLOOP;
        END 
      END 
      TERM; 
