*DECK CRMNAME 
USETEXT TOPTION 
USETEXT TAREATB 
USETEXT TEXPRES 
USETEXT TCMMDEF 
USETEXT TCRMDEF 
USETEXT TFIT
USETEXT TINDTBL 
USETEXT TSBASIC 
USETEXT TENVIRN 
USETEXT TXSTD 
      PROC CRMNAME; 
      BEGIN 
  
  
      XREF PROC DDIAG;             # ISSUE DIAGNOSTIC WITH DATA NAME   #
      XREF PROC DIAG; 
      XREF FUNC DHASH I;           # FUNCTION TO HASH A DATANAME AND   #
                                   # RETURN WORD ADDRESS WITHIN        #
                                   # SUBSCHEMA OF ITS ATTRIBUTE TABLE  #
      XREF PROC GET;
      XREF PROC OPENM;
      XREF ITEM AREATBLPTR I; 
      XREF ITEM DUMMY;
      XREF ITEM FIELDNAMELG I;     # LEVEL OF QUALIFICATIONS           #
      XREF ITEM RA0 I;
      XREF ITEM SM$GROUPID I;      # CMM GROUP ID                      #
      XREF ITEM TARGETAREA I;      # AREA TO BE UPDATED                #
      XREF ITEM TEMPTBLPTR;        # ADDRESS OF AREA TABLE IN WHICH    #
                                   # ITEM WAS LOCATED                  #
      XREF ITEM UPDATEAREA B;      # TRUE IF -UPDATE AREANAME- WAS DONE#
      XREF ITEM UPDATING B;        # TRUE IF UPDATE OPERATION          #
      XREF BASED ARRAY SCHEMAFIT;;
      XREF ARRAY FIELDN[1:FIELDNAMEMAX] S(4); 
              ITEM FN       C(0,0,10), #FIELD NAME# 
                   FN1      C(1,0,10),
                   FN2      C(2,0,10),
               FNWA U(3,0,18),  #TO SAVE THE DIRECTORY WORD ADDRESS#
                   FNINDICE I(3,42,18), #LOCATION OR VALUE OF INDICE# 
                   FNLG     I(3,24,18), #FIELD NAME LENGTH# 
                   FNINDFG  I(3,18,6);  #0-CONSTANT INDICE
                                      1-ANY, 2-ALL, 4-LAST, 8-NEXT
                                      16-INTEGER ITEM INDEX#
  
  
      ITEM AREANUM I;              # ORDINAL FOR REFERENCING AREA TABLE#
      ITEM DEPENDBIT B;            # TRUE IF -DEPENDING ON-            #
      ITEM HIT B;                  # TRUE IF ITEM FOUND                #
      ITEM I I;                    # SCRATCH VARIABLE                  #
      ITEM K I;                    # SCRATCH VARIABLE                  #
      ITEM M I;                    # SCRATCH VARIABLE                  #
      ITEM MULTAREA B;             # TRUE IF MULTIPLE AREAS ARE IN USE #
      ITEM NAMELG I;               # NO OF WORDS IN NAME               #
      ITEM LOOPCON B;              # LOOP CONTROL VARIABLE             #
      ITEM OCCURBIT B;             # TRUE IF -OCCURS-                  #
      ITEM SAVEADDR I;             # SAVE WRDADDR                      #
      ITEM SAVEAREATBL I;          # SAVE P<AREA$TABLE>                #
      ITEM SAVEDEPEND I;           # ADDRESS IN SUBSCHEMA OF DEPEND ITM#
      ITEM SAVENUM I;              # SAVE AREANUM                      #
      ITEM SAVEOCCUR I;            # NO OF TIMES ITEM OCCURS           #
      ITEM TIMESTHRU I;            # FLAG WHICH CONTROLS SEARCH FOR    #
                                   # UNIQUE DATA-NAME WITHIN FILES IN  #
                                   # USE.                              #
                                   # =0 FIRST SEARCH FOR DATANAME      #
                                   # =1 FOUND TO BE NONUNIQUE. SEARCH  #
                                   #    OTHER AREAS IN USE TO SEE IF   #
                                   #    DATANAME ALSO IN ONE OF THOSE  #
                                   #    AREAS.                         #
                                   # =2 NOT UNIQUE IN SUBSCHEMA, BUT   #
                                   #    UNIQUE AMONG AREAS IN USE.     #
                                   #    GO THROUGH LOOP AGAIN TO REHASH#
                                   #    NAME AND USE IT WITHOUT        #
                                   #    QUALIFICATION.                 #
      ITEM WRDADDR I;              # ADDRESS OF SUBSCHEMA (WA FILE)    #
  
  
      BASED ARRAY BFN;
        BEGIN 
        ITEM HASHNAM       I(00,00,60); 
        END 
      BASED ARRAY HASHTBL;
        BEGIN 
        ITEM IHASH         I(00,00,60); 
        END 
      BASED ARRAY SAVA;            # SCRATCH BASED ARRAY               #
        BEGIN 
        ITEM SAVAS         I(00,00,60); 
        END 
  
  
  
      IF AREATBLPTR EQ 0 THEN      # IF NO AREA TABLES, NO AREA ITEMS. #
        BEGIN 
        RETURN;                    # RETURN TO -GETNAME- TO SEARCH     #
                                   # REMAINING SOURCES                 #
        END 
      P<AREA$TABLE> = AREATBLPTR;  # POINT TO SUBSCHEMA TABLE          #
      P<AREA$TABLE> = AT$FORWARD;  # POINT TO FIRST AREA TABLE         #
      IF AT$FORWARD NQ 0           # IF 2ND AREA TABLE EXISTS          #
      THEN
        BEGIN 
        MULTAREA = TRUE;           # MULTIPLE AREAS ARE IN USE         #
        END 
  
      ELSE
        BEGIN 
        MULTAREA = FALSE;          # ONLY ONE AREA IN USE              #
        END 
  
      P<AREA$TABLE> = AREATBLPTR;  # POINT TO SUBSCHEMA AREA TABLE.    #
      P<FIT> = P<SCHEMAFIT>;
      OCCURBIT = FALSE; 
      DEPENDBIT = FALSE;
      P<INDTBL> = CMM$ALF(FIELDNAMELG + 1, 0, SM$GROUPID);
      INDCTBLOC = P<INDTBL>;
      IF FITOC NQ OC$OPEN          # IF SUBSCHEMA NOT OPEN             #
      THEN
        BEGIN 
        FITBBH = FALSE;            # ALLOCATE BUFFERS ABOVE HHA        #
        OPENM(SCHEMAFIT, $INPUT$, RA0); 
        END 
        IF UPDATING AND UPDATEAREA AND
           TARGETAREA NQ 0 THEN 
                                   # UPDATE AREANAME HAS BEEN PRO-     #
                                   # CESSED. LOCATE THE TARGETAREA IN  #
                                   # THE CHAIN.                        #
          BEGIN 
          LOOPCON = TRUE; 
          AREANUM = -1; 
          FOR DUMMY = DUMMY WHILE LOOPCON DO
            BEGIN 
            IF AT$FORWARD[0] EQ 0 THEN
              BEGIN 
              DIAG (341);          # CANNOT FIND TARGET AREA.          #
              STDNO;
              END 
            P<AREA$TABLE> = AT$FORWARD;   #MOVE TO NEXT TABLE IN CHAIN.#
            AREANUM = AREANUM + 1;
            IF P<AREA$TABLE> EQ TARGETAREA THEN  # FOUND TARGETAREA    #
              BEGIN 
              LOOPCON = FALSE;
              TEST DUMMY; 
              END 
            END 
          END 
        ELSE
          BEGIN 
          P<AREA$TABLE> = AT$FORWARD; 
          AREANUM = 0;
          END 
        LOOPCON = TRUE; 
        IF P<AREA$TABLE> EQ 0 THEN   # NO AREA TABLES AT ALL.          #
          BEGIN 
          LOOPCON = FALSE;
          HIT = FALSE;
          END 
        TIMESTHRU = 0;             # FIRST SEARCH FOR DATANAME         #
        FOR DUMMY = DUMMY WHILE LOOPCON DO
          BEGIN                        # GET ADDRESS OF HASH TABLE     #
          AREANUM = AREANUM + 1;
          P<HASHTBL> = AT$HASHLOC;
          FOR K = FIELDNAMELG STEP -1 UNTIL 1 DO
            BEGIN                      # LOOK FOR A MATCHING NAME IN   #
            HIT = TRUE;                # HASH TABLE FOR THIS AREA.     #
            P<BFN> = LOC(FIELDN[K]);
            NAMELG = FNLG[K]; 
            NAMELG = (NAMELG + 9)/10; 
            WRDADDR = DHASH (BFN, NAMELG, HASHTBL); 
            IF WRDADDR EQ 0 THEN       # NO MATCH IN THIS AREA.        #
              BEGIN                    # END LOOP AND MOVE TO NEXT AREA#
              HIT = FALSE;
              K = 0;
              TEST K; 
              END 
            ELSE
              BEGIN 
              FNWA[K] = WRDADDR;
GETT: 
              GET (SCHEMAFIT, DIRECTENTRY, WRDADDR, 0, 0, 90, RA0); 
              FOR I = 0 STEP 1 UNTIL NAMELG-1 DO
                BEGIN 
                IF HASHNAM[I] NQ ITEMNAME[I + 1] THEN 
                  BEGIN 
                  IF SYNONYMPTR[0] EQ 0  # IF NO MORE ENTRIES WITH SAME#
                                         # HASH ID                     #
                  THEN
                    BEGIN 
                    HIT = FALSE;   # EXIT LOOP                         #
                    K = 0;
                    TEST K;        # MOVE TO NEXT AREA TABLE           #
                    END 
                  ELSE
                    BEGIN 
                    WRDADDR = SYNONYMPTR[0];  # ADDR OF NEXT ENTRY WITH#
                                              # SAME HASH ID           #
                    FNWA[K] = WRDADDR;
                    GOTO GETT;     # READ NEXT ITEM ENTRY              #
  
                    END 
                  END 
                END 
              IF K EQ FIELDNAMELG AND SAMENAME[0] NQ 0
                AND DIRLEXID NQ O"107" THEN 
                BEGIN 
                DDIAG (184);       # NAME NOT QUALIFIED ENOUGH.        #
                STDNO;
                END 
              IF K EQ FIELDNAMELG AND NOT UNIQUENAME[0] AND 
                RCTYPE[0] NQ 7     # NOT RECORD ENTRY                  #
                AND NOT (UPDATEAREA  # UPDATE AREA IN USE              #
                  AND UPDATING)    # PROCESSING SOME SORT OF UPDATE    #
              THEN
                                   # THIS ITEM IS NOT UNIQUE IN THE    #
                                   # SUBSCHEMA. CHECK TO SEE IF ONLY   #
                                   # ONE AREA IS AVAILABLE. IF SO,     #
                                   # ASSUME THAT THIS NAME IS OK. IF   #
                                   # NOT, DIAGNOSE MISSING QUALIFICA-  #
                                   # TION AND RETURN.                  #
                BEGIN 
                IF MULTAREA        # IF MULTIPLE AREAS IN USE          #
                THEN
                  BEGIN 
                  IF TIMESTHRU EQ 0  # IF FIRST SEARCH FOR DATANAME    #
                  THEN
                    BEGIN 
                    SAVENUM = AREANUM;  # SAVE AREANUM                 #
                    SAVEAREATBL = P<AREA$TABLE>;  # SAVE P<AREA$TABLE> #
                    TIMESTHRU = 1; # SEARCH FOR NAME IN OTHER AREAS    #
                    HIT = FALSE;   # EXIT LOOP                         #
                    K = 0;
                    TEST K;        # MOVE TO NEXT AREA TABLE           #
                    END 
                  IF TIMESTHRU EQ 1  # IF SEARCH IN OTHER AREAS        #
                  THEN
                    BEGIN 
                    DDIAG (184);   # FURTHER QUALIFICATION REQUIRED    #
                    STDNO;
                    END 
                  END 
                END 
              IF K NQ FIELDNAMELG AND FNWA[K] LS FNWA[K + 1] THEN 
                BEGIN 
                IF SAMENAME[0] EQ 0 THEN
                  BEGIN            # THIS IS NOT THE RIGHT FIELD.  THE #
                  HIT = FALSE;     # SAME NAME PTR IS ZERO, SO         #
                  K = 0;           # MOVE TO THE NEXT TABLE IN CHAIN.  #
                  TEST K; 
                  END 
                ELSE
                  BEGIN                        # GO TO SAME NAME PTR.  #
                  WRDADDR = SAMENAME[0];       # THIS MAY BE THE COR-  #
                  FNWA[K] = WRDADDR;           # RECT NAME.            #
                  GOTO GETT;
                  END 
                END 
           M=1+NAMELGW[0];
           I=FIELDNAMELG-K; 
           DEPNDFG[I] = FALSE;
           INTESUB[I] = FALSE;
           NEXTFG[I]  = FALSE;
           LASTFG[I]  = FALSE;
           ALLFG[I]   = FALSE;
           ANYFG[I]   = FALSE;
           TBLGS[I] = 0;
           CONSUB[I] = FALSE; 
           INDCE[I] = 0;
           IF OCCURS[0] THEN BEGIN UPBND[I] = OCCURCOUNT[M];
          IF RCTYPE[0] EQ 2 OR RCTYPE[0] EQ 3 OR RCTYPE[0] EQ 7 THEN
          USESIZE[0] = USESIZE[0] / OCCURCOUNT[M];
           OCCURBIT = TRUE; END 
           ELSE UPBND[I] = 0; 
          ENTYLG[I] = USESIZE[0]; 
           IF FNINDFG[K] EQ 1  THEN 
           IF NOT CONDIT THEN BEGIN DIAG(936); STDNO; END 
           ELSE BEGIN ANYFG[I] = TRUE; FANY = TRUE; END 
           IF FNINDFG[K] EQ 2  THEN 
           BEGIN ALLFG[I] = TRUE; FALL = TRUE; END
           IF FNINDFG[K] EQ 4  THEN 
                 BEGIN LASTFG[I] = TRUE; FLAST = TRUE; END
           IF FNINDFG[K] EQ 8  THEN 
          BEGIN NEXTFG[I] = TRUE; FNEXT = TRUE; END 
           SAVEADDR = WRDADDR;
           IF FNINDFG[K] EQ 16 THEN INTESUB[I] = TRUE;
          IF OCCURS[0] THEN 
                 IF DEPENDING[M] THEN BEGIN 
          DEPNDFG[I] = TRUE;
                                      DEPENDBIT = TRUE; 
                 SAVEDEPEND = WRDADDR - DEPENDNAME[M];
                                      END 
           INDCE[I] = FNINDICE[K];
          IF FNINDFG[K] EQ 0       # NEITHER FIGURATIVE NOR ITEM INDEX #
            AND FNINDICE[K] EQ 0   # NOT CONSTANT INTEGER SUBSCRIPT    #
          THEN
            BEGIN 
            INDCE[I] = 1;          # DEFAULT INDEX IS 1                #
            IF DIRLEXID NQ O"112"  # IF NOT *IF*                       #
              OR (NOT ALTERKEYFLG     # IF NOT ALTERNATE KEY           #
                AND NOT MAJORKEYFLG)  # IF NOT MAJOR KEY               #
                                   # ALTERNATE KEY-S ELEMENTARY ENTRY  #
                                   # MUST HAVE ENTRY TYPE 4 SO BLP IS  #
                                   # CALLED BECAUSE READING SEQUENTIALY#
                                   # BY REPEATING ALTERNATE KEY COULD  #
                                   # RESULT IN ONE RECORD READ MORE    #
                                   # THAN ONCE                         #
            THEN
              BEGIN 
              TEST K;              # TREAT AS NON-SUBSCRIPTED ITEM     #
              END 
            END 
  
           SAVEOCCUR = OCCURCOUNT[M]; 
          IF RCTYPE[0] NQ 7 THEN   # IF NOT A RECORD-NAME              #
           IF NOT OCCURS[0] THEN
           BEGIN
       CKOCCUR: 
           WRDADDR = WRDADDR - DOMINANTPTR[0];
           GET(SCHEMAFIT,DIRECTENTRY,WRDADDR,0,0,90,RA0); 
           IF NOT OCCURS[0] THEN
             BEGIN
             IF RCTYPE[0] EQ 7 THEN 
               BEGIN
               IF FNINDFG[K] EQ 0 AND FNINDICE[K] EQ 0 THEN 
                 BEGIN
                 TEST K;
                 END
               ELSE 
                 BEGIN
                 DDIAG (933); 
                 STDNO; 
                 END
               END
             ELSE 
               BEGIN
               GOTO CKOCCUR;
               END
             END
           IF FNINDFG[K] EQ 0 AND  FNINDICE[K] EQ 0 THEN INDCE[I] = 1;
           M = 1 + NAMELGW[0];
           OCCURBIT = TRUE; 
           IF DEPENDING[M] THEN BEGIN 
                                DEPENDBIT = TRUE; 
          DEPNDFG[I] = TRUE;
           SAVEDEPEND = WRDADDR - DEPENDNAME[M];
                                END 
           SAVEOCCUR = OCCURCOUNT[M]; 
          ENTYLG[I] = USESIZE[0] / SAVEOCCUR; 
           GET(SCHEMAFIT,DIRECTENTRY,SAVEADDR,0,0,90,RA0);
           WRDADDR = SAVEADDR;
           END
           UPBND[I] = SAVEOCCUR;
           IF FNINDFG[K] EQ 0 THEN BEGIN
           IF FNINDICE[K] GR SAVEOCCUR THEN 
          BEGIN DDIAG(177); STDNO; END
           CONSUB[I] = TRUE; END
           END        # END OF K LOOP#
         END
          IF HIT                   # FOUND A MATCH IN THIS AREA        #
          THEN
            BEGIN 
            LOOPCON = FALSE;
            TEST DUMMY; 
            END 
          ELSE
                                   # NO MATCH WAS FOUND. IF NOT        #
                                   # UPDATING, MOVE TO THE NEXT AREA   #
                                   # TABLE IN THE CHAIN AND CONTINUE   #
                                   # LOOPING. IF THERE ARE NO MORE     #
                                   # TABLES, END PROCESSING. IF        #
                                   # UPDATING AND UPDATE AREA HAS BEEN #
                                   # PROCESSED, DIAGNOSE AND EXIT.     #
            BEGIN 
            IF UPDATING AND UPDATEAREA THEN 
              BEGIN 
              DIAG (339); 
              STDNO;
              END 
            ELSE
              BEGIN 
              IF TIMESTHRU EQ 0    # IF FIRST SEARCH FOR DATANAME      #
              THEN
              BEGIN 
              IF AT$FORWARD NQ 0 THEN 
                BEGIN 
                P<AREA$TABLE> = AT$FORWARD; 
                TEST DUMMY; 
                END 
              ELSE
                BEGIN 
                LOOPCON = FALSE;
                TEST DUMMY; 
                END 
              END 
              IF TIMESTHRU EQ 1    # IF SEARCH FOR NAME IN OTHER AREAS #
              THEN
                BEGIN 
                IF AT$FORWARD NQ 0  # IF MORE AREAS                    #
                THEN
                  BEGIN 
                  P<AREA$TABLE> = AT$FORWARD; 
                  TEST DUMMY; 
                  END 
                ELSE               # NAME NOT FOUND IN ANY OTHER AREA  #
                  BEGIN 
                  TIMESTHRU = 2;   # REHASH NAME IN CORRECT AREA       #
                  P<AREA$TABLE> = SAVEAREATBL;  # RESTORE P<AREA$TABLE>#
                  AREANUM = SAVENUM - 1;  # RESTORE AREANUM            #
                  TEST DUMMY; 
                  END 
                END 
              END 
            END 
          END                      # END OF -DUMMY- LOOP.            #
  
          IF NOT HIT               # NO MATCH FOUND IN ANY AREA        #
          THEN
            BEGIN 
            RETURN;                # RETURN TO -GETNAME- TO SEARCH     #
                                   # REMAINING SOURCES                 #
            END 
          TEMPTBLPTR = P<AREA$TABLE>;   # STORE PTR TO AREA TABLE.     #
           WRDADDR = SAVEADDR;
           GET(SCHEMAFIT,DIRECTENTRY,WRDADDR,0,0,90,RA0); 
           PROGSTACKLEN = -1; 
          IF NOT DEPENDBIT THEN 
          BEGIN IF FNEXT THEN BEGIN DIAG(934); STDNO; END 
                IF FLAST THEN 
          BEGIN DIAG(935); STDNO; END 
          END 
           AREAITM = TRUE;
           RESULTSLOC = BWP[0]; 
           DATATYPE = CLASS[0]; 
           RESULTUSAGE = CLASS[0];
           IF CLASS[0] EQ 7 THEN LOGICALRESLT = TRUE; ELSE
           LOGICALRESLT = FALSE;
           DATALENG = USESIZE[0]; 
           DATARECDORD = 1; 
           FIGLITDATA = 5;
           DATANAMEUSE = CLASS[0];
           DATAWORDADDR = BWP[0]; 
           DATACHARPOS = BBP[0] / 6;
           ABSADDRESS = FALSE;
           IF PTRMURAL[0] NQ 0 THEN DATANAMEPIC = TRUE; ELSE
           DATANAMEPIC = FALSE; 
      DATANAMEPTR = LOC(DIRECTENTRY); 
           IF NOT RECORDFLAG THEN 
           IFFROMFLAG = TRUE; 
           DATANAMEBASE = AREANUM;     # AREA IN WHICH THIS ITEM WAS   #
                                       # FOUND. THIS WILL BE REPLACED  #
                                       # EVENTUALLY WITH WSA ADDRESS.  #
           IF KEYFLAG[0] THEN AKEYITEM = TRUE; ELSE 
           AKEYITEM = FALSE;
                                   # CHECK IF KEY IS SIGN OVERPUNCH.   #
                                   # IF SO, TURN ON -SIGNATERKEY- TO   #
                                   # INDICATE IT. THIS WILL GO INTO THE#
                                   # PROGRAMSTACK IN -EXPANAL-.        #
          IF SIGN[0] THEN 
            BEGIN 
            SIGNATERKEY = TRUE; 
            MAJORKEYFLG[0] = FALSE;    # IF MAJ KEY SIGNED, TREAT LIKE #
                                       # NORMAL DATANAME               #
            END 
          ELSE
            BEGIN 
            SIGNATERKEY = FALSE;
            END 
          IF ALTERKEYFLG[0]        # IF ALTERNATE KEY                  #
          THEN
            BEGIN 
            ALTKEYITEM = TRUE;     # FLAG SAYS ALTERNATE KEY ITEM      #
            END 
          ELSE                     # IF NOT ALTERNATE KEY              #
            BEGIN 
            IF MAJORKEYFLG[0]      # IF MAJOR KEY                      #
            THEN
              BEGIN 
              P<KEY$TBL> = AT$PKEYDPTR;  # POSITION TO KEY DESC TABLE  #
              IF AT$FITFO EQ FOIS  # IF *IS* FILE                      #
                AND KT$TYPE[1] LQ 1  # IF SYMBOLIC KEY                 #
                AND DATAWORDADDR EQ KT$WPOS[1]  # IF SAME WORD         #
                AND DATACHARPOS  EQ KT$CPOS[1]  # IF SAME CHARACTER    #
              THEN
                BEGIN 
                IF DATALENG EQ KT$LENGTH[1]  # IF SAME LENGTH          #
                THEN
                  BEGIN 
                  AKEYITEM = TRUE;  # MAJOR KEY IS REALLY PRIMARY KEY  #
                  END 
                ELSE
                  BEGIN 
                  PMAJKEYITEM = TRUE;  # MAJOR PRIMARY KEY             #
                  END 
                END 
              ELSE                 # IF NOT PRIMARY MAJOR KEY          #
                BEGIN 
                IF AT$AKEYPPTR NQ 0  # IF SYMBOLIC ALTERNATE KEYS      #
                THEN
                  BEGIN 
                  P<ALTKEYPOS> = AT$AKEYPPTR;  # POSITION TO LIST OF   #
                                               # SYMBOLIC ALT KEYS     #
                  LOOPCON = TRUE; 
                  M = 0;
                  FOR DUMMY = DUMMY 
                    WHILE LOOPCON 
                  DO
                    BEGIN 
                    IF AK$FULLWORD EQ 0  # IF END OF LIST              #
                    THEN
                      BEGIN 
                      LOOPCON = FALSE;  # EXIT, NOT MAJ ALT KEY        #
                      TEST DUMMY; 
                      END 
  
                    IF DATAWORDADDR EQ AK$BWP[M]  # IF SAME WORD       #
                      AND DATACHARPOS EQ AK$BCP[M]  # IF SAME CHARACTER#
                    THEN
                      BEGIN 
                      AMAJKEYITEM = TRUE;  # MAJOR ALT KEY             #
                      SIZEALTKEY = AK$SIZE[M];  # SAVE SIZE OF ALT KEY #
                      LOOPCON = FALSE;  # EXIT LOOP                    #
                      END 
                    ELSE           # IF NOT MAJOR OF THIS KEY          #
                      BEGIN 
                      M = M + 1;   # POSITION TO NEXT ENTRY            #
                      IF M EQ 9    # IF LAST ENTRY OF BLOCK            #
                      THEN
                        BEGIN 
                        IF AK$FULLWORD[M] EQ 0  # IF END OF LIST       #
                          THEN
                          BEGIN 
                          LOOPCON = FALSE;  # EXIT, NOT MAJ ALT KEY    #
                          END 
                        ELSE       # NOT END OF LIST                   #
                          BEGIN 
                          P<ALTKEYPOS> = AK$FULLWORD[M];  # POSITION TO#
                                                          # NEXT BLOCK #
                          M = 0;   # FIRST ENTRY OF BLOCK              #
                          END 
                        END 
                      END 
                    END            # END OF DUMMY LOOP                 #
                  END 
                END 
              END 
            END 
           IF AT$KEYEXCL           # IF EXCLUDED KEY                   #
             AND ITEMNAME[1] EQ "KEY-FIELD "
           THEN 
             BEGIN
             AKEYITEM = TRUE;      # PRIMARY KEY                       #
             EXCLKEYITEM = TRUE;   # EXCLUDED KEY                      #
             END
           IF OCCURBIT THEN BEGIN 
           OCCURS[0] = TRUE;
           INDICED = TRUE;
           END
          ELSE
            BEGIN 
            IF SM$GROUPID EQ 0     # IF INDTBL NOT ALLOCATED BY GRP ID #
            THEN
              BEGIN 
              CMM$FRF(P<INDTBL>); 
              END 
            INDICED = FALSE;
            INDCTBLOC = 0;
            END 
      IF TYPEALOW EQ 6  THEN TYPEALOW = 4;
           DIRWORDADDR = WRDADDR; 
       RECORDNAM: 
           IF AT$KEYEXCL           # IF EXCLUDED KEY                   #
             AND ITEMNAME[1] EQ "KEY-FIELD "
           THEN 
             BEGIN
             EXCLKEYITEM = TRUE;   # EXCLUDED KEY                      #
             END
           IF RCTYPE[0] EQ 7 THEN DOMRECORDWA = WRDADDR;
           ELSE BEGIN 
           WRDADDR = WRDADDR - DOMINANTPTR[0];
           GET(SCHEMAFIT,DIRECTENTRY,WRDADDR,0,0,90,RA0); 
           GOTO RECORDNAM;
           END
          IF UPBND[0] EQ 0 THEN 
           FOR M = 1 STEP 1 UNTIL I DO
            IF UPBND[M] NQ 0 THEN BEGIN UPBND[0]=UPBND[M];
                GOTO BADDORM; END 
          BADDORM: # #
           IF DEPENDBIT THEN BEGIN
           I=I+1; 
           WRDADDR = SAVEDEPEND;
           GET(SCHEMAFIT,DIRECTENTRY,WRDADDR,0,0,90,RA0); 
           INDTBLWD[I] = 0; 
           DPTYPE[I] = CLASS[0];
           TBLGS[I] = BBP[0] / 6; 
          ENTYLG[I] = USESIZE[0]; 
           INDCE[I] = BWP[0]; 
           END
       MOVETBL: 
           GET(SCHEMAFIT,DIRECTENTRY,DIRWORDADDR,0,0,90,RA0); 
           M= 1 + NAMELGW[0]; 
           TBLGS[0] = I + 1;
          IF OCCURS[0] THEN 
          BEGIN OCCURWORD[0] = OCCURWORD[M];
          IF RCTYPE[0] EQ 2 OR RCTYPE[0] EQ 3 OR RCTYPE[0] EQ 7 THEN
                DATALENG = DATALENG / OCCURCOUNT[0];
                USESIZE[0] = DATALENG;
          END 
           ELSE BEGIN 
           FOR M = 0 STEP 1 UNTIL NAMELGW[0] DO 
           OCCURWORD[M] = OCCURWORD[M+1];  END
            IF DATALENG GR O"7777" # IF GREATER THAN 4095 CHARACTERS   #
                                   # THIS CAN ONLY OCCUR IF ITEM IS    #
                                   # GROUP OR RECORD ENTRY             #
            THEN
              BEGIN 
              DDIAG (371);         # -NAME- TRUNCATED TO 4095 CHARS    #
              DATALENG = O"7777";  # TRUNCATE TO 4095 CHARACTERS       #
              END 
            IF PTRMURAL[0] NQ 0    # IF THERE IS A MURAL               #
            THEN
              BEGIN 
              M = PTRMURAL[0];     # SAVE REL LOC OF FIRST WORD OF MUR #
              I = B<55,5>OCCURWORD[M-3];  # LENGTH OF MURAL            #
              PTRMURAL[0] = CMM$ALF(I,0,SM$GROUPID);
              P<SAVA> = PTRMURAL[0];  # BLOCK FWA FOR MURAL            #
              GET(SCHEMAFIT,SAVA,DIRWORDADDR+M,0,0,I*10,RA0); 
              END 
          IF RCTYPE[0] NQ ET$ITEM          # NOT ELEMENTARY ITEM       #
            AND RCTYPE[0] NQ ET$VECTOR     # NOT VECTOR                #
            AND RCTYPE[0] NQ ET$RPTVECTOR  # NOT VECTOR IN REPEAT GRP  #
          THEN
          BEGIN CLASS[0] = 0; 
                IF DIRLEXID EQ O"104" THEN DIAG(209); 
          END 
          IF RCTYPE[0] EQ 0        # GROUP                             #
            OR RCTYPE[0] EQ 2      # REPEATING GROUP                   #
            OR RCTYPE[0] EQ 3      # REPEAT GROUP WITHIN REPEAT GROUP  #
            OR RCTYPE[0] EQ 7      # RECORD                            #
          THEN
          BEGIN 
             INCPICSIZE[0] = DATALENG;
             EXPICSIZE[0] = DATALENG; 
          END 
          IF DATATYPE EQ 6 THEN BEGIN 
             INCPICSIZE[0] = INCPICSIZE[0]*2+1; 
          END 
          RESULTSIZE = INCPICSIZE[0]; 
          JUSTRGHT[0] = FALSE;     # CRM ITEMS ALWAYS LEFT JUSTIFIED   #
           STDYES;
      END 
      TERM
