*DECK CDCSNAM 
USETEXT TAREATB 
USETEXT TCMMDEF 
USETEXT TCRMDEF 
USETEXT TDESATT 
USETEXT TENVIRN 
USETEXT TEXPRES 
USETEXT TFIT
USETEXT TINDTBL 
USETEXT TOPTION 
USETEXT TSBASIC 
USETEXT TXSTD 
      PROC CDCSNAM; 
      BEGIN 
*CALL COMHDRLEN 
      XREF PROC CMOVE;             # CHARACTER MOVE PROCEDURE          #
      XREF PROC DDIAG;             # ISSUE DIAGNOSTIC WITH DATA NAME   #
      XREF FUNC DHASH;             # HASH NAME AND RETURN SUBSCHEMA    #
                                   # ADDR WHERE NAME FOUND             #
      XREF PROC DIAG;              # ISSUE DIAGNOSTIC                  #
      XREF PROC GET;               # CRM READ FROM FILE                #
      XREF PROC OPENM;             # CRM OPEN FILE                     #
  
      XREF ITEM AREATBLPTR I;      # ADDR OF FIRST AREA TABLE IN CHAIN #
      XREF ITEM DUMMY I;
      XREF ITEM FIELDNAMELG I;     # LEVEL OF QUALIFICATIONS           #
      XREF ITEM RA0 I;             # ITS ADDRESS IS ALWAYS ZERO.  IT IS#
                                   # USED TO TERMINATE PARAMETER LISTS #
      XREF ITEM SM$GROUPID;        # CMM GROUP ID FOR DIRECTIVE        #
      XREF ITEM TARGETAREA I;      # AREA TO BE UPDATED                #
      XREF ITEM TEMPTBLPTR;        # PTR TO AREA TABLE IN WHICH AN ITEM#
                                   # WAS LOCATED                       #
      XREF ITEM UPDATEAREA B;      # TRUE IF -UPDATE AREANAME- WAS DONE#
      XREF ITEM UPDATING B;        # TRUE IF UPDATE OPERATION          #
  
      XREF ARRAY FIELDN[1:FIELDNAMEMAX] S(4); 
        BEGIN 
        ITEM FN         C(00,00,10);        # 1ST WORD OF NAME         #
        ITEM FN1        C(01,00,10);        # 2ND WORD OF NAME         #
        ITEM FN2        C(02,00,10);        # 3RD WORD OF NAME         #
        ITEM FNWA       U(03,00,18);        # WORD ADDR WHERE DBI FOUND#
        ITEM FNINDFG    I(03,18,06);        # 0- CONSTANT INDEX        #
                                            # 1-ANY, 2-ALL, 4-LAST     #
                                            # 8-NEXT,16-INTEGER ITEM   #
                                            # INDEX                    #
        ITEM FNLG       I(03,24,18);        # FIELD NAME LENGTH        #
        ITEM FNINDICE   I(03,42,18);        # LOCATION OR VALUE OF INDX#
        END 
      XREF BASED ARRAY SCHEMAFIT;;
  
      ITEM AREANUM I;              # ORDINAL FOR REFERENCING AREA TABLE#
      ITEM BITPOSITION I;          # RELATIVE BIT POSITION WITHIN RECD #
                                   # ARRAY TO CONVERT FROM CDCS DBMS   #
                                   # CLASS TO CRM CLASS                #
      ITEM CLASSCVT = O"0001 1000 0020 3456 7770";
      ITEM DCSAMENAME I;           # SUBSCHEMA SAME NAME POINTER       #
      ITEM DCSYNONYM I;            # SUBSCHEMA SYNONYM POINTER         #
      ITEM DCUNIQUEFLG B;          # SUBSCHEMA UNIQUE FLAG             #
      ITEM DEPENDBIT B;            # TRUE IF DEPENDING ON ITEM FOUND   #
      ITEM DOMINANTORD I;          # DOMINANT ITEM ORDINAL             #
                                   # WILL ONLY BE NONZERO IF A         #
                                   # DOMINANT ITEM REPEATS             #
      ITEM DUMMY1 I;               # LOOP COUNTER                      #
      ITEM DUMMY2 I;               # LOOP COUNTER                      #
      ITEM DUMMY4 I;               # LOOP COUNTER                      #
      ITEM HIT B;                  # TRUE IF ITEM HAS BEEN FOUND       #
      ITEM I I;                    # SCRATCH VARIABLE                  #
      ITEM K I;                    # SCRATCH VARIABLE                  #
      ITEM LOOPCON B;              # LOOP CONTROL VARIABLE             #
      ITEM LOOPCON1 B;             # LOOP CONTROL VARIABLE             #
      ITEM LOOPCON2 B;             # LOOP CONTROL VARIABLE             #
      ITEM LOOPCON4 B;             # LOOP CONTROL VARIABLE             #
      ITEM MAJORKEYFLAG B;         # TRUE IF MAJOR KEY                 #
      ITEM MULTAREA B;             # TRUE IF MULTIPLE AREAS ARE IN USE #
      ITEM NAMELG I;               # NUMBER OF WORDS IN NAME           #
      ITEM NAMEOFFSET I;           # OFFSET FROM START OF DBI ENTRY    #
                                   # TO ITEM NAME                      #
      ITEM NONUNIKFLG B;           # TRUE IF NON-UNIQUE NAME FOUND     #
      ITEM NUMRECS I;              # NUMBER OF RECORDS IN AREA         #
      ITEM OCCURADR I;             # SUBSCHEMA WA ADDR OF OCCURRING    #
                                   # DBI ENTRY                         #
      ITEM OCCURBIT B;             # TRUE IF OCCURRING ITEM FOUND      #
      ITEM SAVEDEPEND I;           # SUBSCHEMA WA ADDR OF DEPENDING    #
                                   # ARRAY TO CONVERT FROM CDCS TYPE   #
                                   # TO CRM TYPE                       #
      ITEM TYPECVT = O"0123 4524 0000 0000 0000"; 
      ITEM WRDADDR I;              # WA ADDR OF SUBSCHEMA DBI ENTRY    #
      ITEM WRECADDR I;             # WA ADDR OF SUBSCHEMA RECORD LIST  #
                                   # ENTRY WITHIN REALM/RELATION TABLE #
  
      ARRAY DBIENTRY [0:0] S(DFSBITMLG);; # 1ST ARRAY TO READ DBI ENTRY#
      ARRAY DBIENTRY1 [0:0] S(DFSBITMLG);; #2ND ARRAY TO READ DBI ENTRY#
      ARRAY DBINAMEA [0:2] S(1);   # ARRAY TO READ DBI NAME            #
        BEGIN 
        ITEM DBINAME      I(0, 0,60); 
        END 
  
      ARRAY MURALARRAY [0:0] S(1);  # 1ST WORD OF MURAL                #
        BEGIN 
        ITEM MURALENGTH   U(0,55, 5);  # LENGTH OF MURAL IN WORDS      #
        END 
  
      ARRAY OCCURARRAY [0:0] S(DFSBOCCLG);;  # ARRAY TO READ OCCURRING #
                                             # PART OF DBI ENTRY       #
  
      ARRAY BLANKS [0:2];          # THREE WORDS OF BLANK              #
        BEGIN 
        ITEM BLANKWORD C(0, 0, 10) = [" ", " ", " "]; 
        END 
  
      ARRAY ZEROES [0:2];          # THREE WORDS OF ZERO               #
        BEGIN 
        ITEM ZEROWORD I(0, 0, 60) = [0, 0, 0];
        END 
  
      BASED ARRAY BFN;             # ARRAY FOR ITEM NAME               #
        BEGIN 
        ITEM HASHNAM    I(00,00,60);
        END 
      BASED ARRAY SBITEMENTRY;     # DESCRIPTION OF ITEM ENTRY         #
          BEGIN 
*CALL SBIHDDCLS 
          END 
      BASED ARRAY SBITEMOCCURA;    # DESCRIPTION OF OCCURRING PART     #
                                   # OF ITEM ENTRY                     #
          BEGIN 
*CALL SBIOCDCLS 
          END 
      BASED ARRAY SBRECENTRY;      # DESCRIPTION OF RECORD ENTRY       #
          BEGIN 
*CALL SBRHDDCLS 
          END 
  
      BASED ARRAY HASHTBL;;        # POINTER TO HASH TABLE             #
  
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     BUILDINDTBL                                                      #
#                                                                      #
#     BUILD INDEX TABLE ENTRY FOR THIS ITEM WITHIN FIELDN ARRAY        #
#                                                                      #
#     ON ENTRY                                                         #
#     K = INDEX WITHIN FIELDN ARRAY                                    #
#                                                                      #
#----------------------------------------------------------------------#
  
  
      PROC BUILDINDTBL; 
      BEGIN 
      I = FIELDNAMELG - K;         # INDEX INTO INDTBL                 #
      INDTBLWD[I] = 0;             # INITIALIZE WHOLE INDTBL WORD TO 0 #
      IF FNINDFG[K] EQ 1           # IF -ANY-                          #
      THEN
        BEGIN 
        IF NOT CONDIT              # IF NOT -IF- CONDITION             #
        THEN
          BEGIN 
          DIAG (936);              # -ANY- IS FOR CONDITION ONLY       #
          STDNO;                   # ERROR EXIT                        #
          END 
        ELSE
          BEGIN 
          ANYFG[I] = TRUE;         # SET ANY FLAGS                     #
          FANY = TRUE;
          END 
        END 
  
      IF FNINDFG[K] EQ 2           # IF -ALL-                          #
      THEN
        BEGIN 
        ALLFG[I] = TRUE;           # SET ALL FLAGS                     #
        FALL = TRUE;
        END 
  
      IF FNINDFG[K] EQ 4           # IF -LAST-                         #
      THEN
        BEGIN 
        LASTFG[I] = TRUE;          # SET LAST FLAGS                    #
        FLAST = TRUE; 
        END 
  
      IF FNINDFG[K] EQ 8           # IF -NEXT-                         #
      THEN
        BEGIN 
        NEXTFG[I] = TRUE;          # SET NEXT FLAGS                    #
        FNEXT = TRUE; 
        END 
  
      IF FNINDFG[K] EQ 16          # IF ITEM SUBSCRIPT                 #
      THEN
        BEGIN 
        INTESUB[I] = TRUE;         # SET ITEM SUBSCRIPT FLAGS          #
        END 
  
      INDCE[I] = FNINDICE[K];      # VALUE OF SUBSCRIPT                #
      P<SBITEMENTRY> = LOC(DBIENTRY);  # POSITION TO DBI ITEM ENTRY    #
      IF SBITMENTRY EQ SE$ITEM     # IF ITEM ENTRY                     #
      THEN
        BEGIN 
        ENTYLG[I] = SBITMUSESIZE;  # INTERNAL SIZE OF DATA IN CHARS    #
        END 
      ELSE                         # IF ENTRY IS RECORD ENTRY          #
        BEGIN 
        P<SBRECENTRY> = LOC(DBIENTRY);  # POSITION TO RECORD ENTRY     #
        ENTYLG[I] = SBRECLENGTH;   # INTERNAL SIZE OF DATA IN CHARS    #
        END 
  
      IF FNINDFG[K] EQ 0           # NEITHER FIGURATIVE NOR ITEM INDEX #
        AND FNINDICE[K] EQ 0       # NOT CONSTANT INTEGER SUBSCRIPT    #
      THEN
        BEGIN 
        INDCE[I] = 1; 
        RETURN; 
        END 
  
      IF (SBITMOCCURP EQ 0         # THIS ITEM IS NOT OCCURRING ITEM   #
          AND SBITMDOMORD EQ 0)    # NO DOMINANT ITEM IS OCCURRING ITEM#
        OR SBITMENTRY EQ SE$RECORD  # IF RECORD ENTRY                  #
      THEN
        BEGIN 
        DDIAG (933);               # SINGLE ITEM CANNOT BE SUBSCRIPTED #
        STDNO;
        END 
  
      LOOPCON4 = TRUE;
      IF SBITMOCCURP NQ 0          # IF THIS ITEM IS OCCURRING ITEM    #
      THEN
        BEGIN 
        OCCURADR = WRDADDR; 
        LOOPCON4 = FALSE;          # NO SEARCH FOR DOMINANT OCCUR ITEM #
        END 
  
      FOR DUMMY4 = DUMMY4          # SEARCH FOR DOMINANT OCCURRING ITEM#
        WHILE LOOPCON4
      DO
        BEGIN 
        OCCURADR = SBITMDOMADR;    # WA ADDR OF DOMINANT ITEM          #
        GET (SCHEMAFIT, DBIENTRY1, OCCURADR, 0, 0, DFSBITMLG * 10, RA0);
        P<SBITEMENTRY> = LOC(DBIENTRY1);
        IF SBITMOCCURP NQ 0        # OCCURRING ITEM FOUND              #
        THEN
          BEGIN 
          LOOPCON4 = FALSE; 
          END 
        END 
  
      OCCURBIT = TRUE;             # OCCURRING ITEM HAS BEEN FOUND     #
                                   # READ OCCURRING PART OF DBI ENTRY  #
      GET (SCHEMAFIT, OCCURARRAY, OCCURADR + SBITMOCCURP, 0, 0, 
           DFSBOCCLG * 10, RA0);
      P<SBITEMOCCURA> = LOC(OCCURARRAY);
      ENTYLG[I] = SBITMUSESIZE;    # INTERNAL SIZE OF DATA IN CHARS    #
      UPBND[I] = SBITMHIBNDS;      # UPPER BOUND IS MAX OCCURRENCES    #
      IF SBITMDEPNDON              # IF DEPENDS ON ANOTHER ITEM        #
      THEN
        BEGIN 
        DEPNDFG[I] = TRUE;         # SET DEPEND ON FLAG                #
        DEPENDBIT = TRUE; 
        SAVEDEPEND = SBITMOCCLDNA[1];  # ADDR OF DEPENDING DBI         #
        END 
  
      IF FNINDFG[K] EQ 0           # NEITHER FIGURATIVE NOR ITEM INDEX #
      THEN
        BEGIN 
        CONSUB[I] = TRUE;          # CONSTANT INDEX                    #
        END 
      RETURN; 
      END                          # END PROC B U I L D I N D T B L    #
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     S E T R E C D O R D                                              #
#                                                                      #
#     GIVEN THE RECORD ORDINAL IN THE SUBSCHEMA, SET DATARECDORD TO THE#
#     CORRESPONDING INDEX INTO KEY$TBL BY SEARCHING FOR A MATCH ON     #
#     SUBSCHEMA RECORD ORDINALS.  SUBSCHEMA ORDINALS ARE NUMBERED 1 TO #
#     N FOR ENTIRE SUBSCHEMA.  KEY$TBL INDICES ARE NUMBERED 1 TO M FOR #
#     EACH AREA.                                                       #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC SETRECDORD;
      BEGIN 
      P<KEY$TBL> = AT$PKEYDPTR; 
      I = SBRECORDINAL;            # SUBSCHEMA RECORD ORDINAL          #
      FOR DATARECDORD = 1 STEP 1   # LOOP THROUGH KEY$TBL              #
        WHILE TRUE
      DO
        BEGIN 
        IF I EQ KT$SBRCDORD[DATARECDORD]  # IF SAME SUBSCHEMA REC ORDNL#
        THEN
          BEGIN 
          RETURN;                  # EXIT WITH DATARECDORD SET TO      #
                                   # KEY$TBL INDEX                     #
          END 
        END 
      END                          # END PROC    S E T R E C D O R D   #
CONTROL EJECT;
*CALL TRNSDBI 
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     C D C S N A M                                                    #
#                                                                      #
#     SEARCH CDCS SUBSCHEMA FOR DATA BASE ITEM ENTRY OF ITEM NAMED IN  #
#     ARRAY *FIELDN*.  TRANSFORM CDCS DBI ENTRY INTO CRM FORMAT IN     #
#     ARRAY *DIRECTENTRY*.  BUILD INDEX TABLE FROM ARRAY *FIELDN* AND  #
#     SUBSCHEMA DBI ENTRY.  STORE DESCRIPTION OF ITEM IN COMMON BLOCK  #
#     *CEXPRES*.                                                       #
#                                                                      #
#----------------------------------------------------------------------#
  
  
      IF AREATBLPTR EQ 0           # IF NO AREA TABLES, NO AREA ITEMS  #
      THEN
        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                  # PROCESSING UPDATE DIRECTIVE       #
        AND UPDATEAREA             # UPDATE AREA HAS BEEN PROCESSED    #
        AND TARGETAREA NQ 0 
      THEN
        BEGIN 
        LOOPCON = TRUE; 
        AREANUM = -1; 
        FOR DUMMY = DUMMY          # SEARCH FOR CORRECT AREATABLE      #
          WHILE LOOPCON 
        DO
          BEGIN 
          IF AT$FORWARD[0] EQ 0    # IF NO MORE AREA TABLES            #
          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  # IF FOUND CORRECT AREATABLE #
          THEN
            BEGIN 
            LOOPCON = FALSE;       # EXIT LOOP                         #
            TEST DUMMY; 
  
            END 
          END 
        END 
  
                                   # IF NO -UPDATE AREANAME            #
      ELSE
        BEGIN 
        P<AREA$TABLE> = AT$FORWARD; 
        AREANUM = 0;               # START WITH FIRST AREATABLE        #
        END 
  
      LOOPCON = TRUE; 
      IF P<AREA$TABLE> EQ 0        # NO AREA TABLES AT ALL             #
      THEN
        BEGIN 
        LOOPCON = FALSE;
        HIT = FALSE;
        END 
  
      FOR K = 1 STEP 1             # EXAMINE ALL NAMES IN FIELDN ARRAY #
        UNTIL FIELDNAMELG 
      DO
        BEGIN 
        NAMELG = FNLG[K];          # LENGTH OF NAME IN CHARACTERS      #
        IF NAMELG LS 30            # IF THERE ARE TRAILING BLANKS      #
        THEN
          BEGIN 
                                   # REPLACE TRAILING BLANKS WITH 0-S  #
          CMOVE (ZEROES, 0, 30 - NAMELG, FIELDN[K], NAMELG);
          END 
        END 
  
      NONUNIKFLG = FALSE;          # INITIAL ASSUMPTION                #
      FOR DUMMY = DUMMY            # LOOP THROUGH AREA TABLES          #
        WHILE LOOPCON 
      DO
        BEGIN 
        AREANUM = AREANUM + 1;     # INCREMENT TO NEXT AREA            #
        P<HASHTBL> = AT$HASHLOC;   # POSITION TO HASH TABLE            #
        FOR K = FIELDNAMELG STEP -1  # LOOP THROUGH *FIELDN* ARRAY     #
          UNTIL 1 
        DO
          BEGIN 
          HIT = TRUE;              # INITIAL ASSUMPTION NAME FOUND     #
          P<BFN> = LOC(FIELDN[K]);  # POSITION TO NAME                 #
          NAMELG = (FNLG[K] + 9) / 10;  # LENGTH OF NAME IN WORDS      #
                                   # HASH NAME AND RETURN SUBSCHEMA    #
                                   # ADDR WHERE NAME IS FOUND          #
          WRDADDR = DHASH (BFN, NAMELG, HASHTBL); 
          IF WRDADDR EQ 0          # IF NAME NOT IN THIS AREA          #
          THEN
            BEGIN 
            HIT = FALSE;
            K = 0;                 # EXIT K LOOP                       #
            TEST K; 
            END 
  
                                   # NAME FOUND IN THIS SUBSCHEMA      #
          FNWA[K] = WRDADDR;       # SAVE SUBSCHEMA ADDRESS            #
          LOOPCON1 = TRUE;
          FOR DUMMY1 = DUMMY1      # LOOP THROUGH SAMENAME AND         #
                                   # SYNONYM CHAIN                     #
            WHILE LOOPCON1
          DO
            BEGIN 
            FOR I = 0 STEP 1
              UNTIL 2 
            DO
              BEGIN 
              DBINAME[I] = 0;      # ZERO DBI NAME ARRAY               #
              END 
  
                                   # READ DBI ENTRY                    #
            GET (SCHEMAFIT, DBIENTRY, WRDADDR, 0, 0, DFSBITMLG *10,RA0);
            P<SBITEMENTRY> = LOC(DBIENTRY); 
            IF SBITMENTRY EQ SE$ITEM  # IF ITEM ENTRY                  #
            THEN
              BEGIN 
              DCSAMENAME  = SBITMSAMEPTR;  # SAME NAME ADDRESS         #
              DCSYNONYM   = SBITMSYNADDR;  # SYNONYM ADDRESS           #
              DCUNIQUEFLG = SBITMUNIQFLG;  # TRUE IF UNIQUE            #
              GET (SCHEMAFIT, DBINAMEA, WRDADDR + SBITMNAMEPTR, 0, 0, 
                   SBITMNMELENC, RA0);  # READ NAME                    #
              END 
  
            ELSE                   # IF RECORD ENTRY                   #
              BEGIN 
              P<SBRECENTRY> = LOC(DBIENTRY);
              DCSAMENAME  = SBRECSMENMEA;  # SAME NAME ADDRESS         #
              DCSYNONYM   = SBRECSYNADR;   # SYNONYM ADDRESS           #
              DCUNIQUEFLG = TRUE; 
              GET (SCHEMAFIT, DBINAMEA, WRDADDR + SBRECNAMEPTR, 0, 0, 
                   SBRECNMELENC, RA0);
              END 
  
            FOR I = 0 STEP 1       # COMPARE ALL WORDS OF NAME         #
              UNTIL 2 
            DO
              BEGIN 
              IF HASHNAM[I] NQ DBINAME[I]  # IF DIFFERENT NAME         #
              THEN
                BEGIN 
                IF DCSYNONYM EQ 0  # IF NO MORE SYNONYMS (DIFFERENT    #
                                   # NAMES WITH SAME HASH ID-S         #
                THEN
                  BEGIN 
                  HIT = FALSE;
                  K = 0;
                  TEST K;          # EXIT K LOOP                       #
                  END 
  
                ELSE
                  BEGIN 
                  WRDADDR = DCSYNONYM;  # GET NEXT SYNONYM             #
                  FNWA[K] = WRDADDR;
                  TEST DUMMY1;
                  END 
                END 
              END                  # END I LOOP                        #
  
                                   # CORRECT NAME HAS BEEN FOUND       #
  
            IF K EQ FIELDNAMELG    # IF FINAL QUALIFICATION, HENCE IT  #
                                   # MUST BE UNIQUE                    #
            THEN
              BEGIN 
              IF DCSAMENAME NQ 0   # IF SAME NAME WITHIN SAME AREA     #
              THEN
                BEGIN 
                IF DIRLEXID NQ O"107"  # IF NOT EXHIBIT                #
                                   # EXHIBIT LOOPS THROUGH SAME NAME   #
                                   # CHAIN, HENCE IT NEED NOT BE UNIQUE#
  
                  OR SBITMENTRY EQ SE$ITEM  # IF ITEM                  #
                                   # IF RECORD NAME IS ALSO AN ITEM    #
                                   # NAME, WHEN USED AS FINAL QUALIFI- #
                                   # CATION, QU MUST ASSUME RECORD NAME#
                                   # SINCE RECORD NAME CANNOT BE       #
                                   # FURTHER QUALIFIED                 #
                THEN
                  BEGIN 
                  DDIAG (184);     # NOT FULLY QUALIFIED               #
                  STDNO;           # ERROR EXIT                        #
                  END 
                END 
  
              IF NOT DCUNIQUEFLG   # IF NAME IS NOT UNIQUE             #
              THEN
                BEGIN 
                IF MULTAREA        # IF MULTIPLE AREAS IN USE          #
                  AND NOT (UPDATEAREA  # *UPDATE AREA* IS NOT ACTIVE   #
                    AND UPDATING)  # THIS DIRECTIVE IS NOT AN UPDATE   #
                THEN
                  BEGIN 
                  NONUNIKFLG = TRUE;  # NON-UNIQUE NAME HAS BEEN FOUND #
                                   # CONTINUE TO SEARCH IN OTHER AREAS #
                                   # BECAUSE ANOTHER OCCURRENCE OF THE #
                                   # NAME MAY BE A RECORD NAME WHICH   #
                                   # WOULD BE USED EVEN THOUGH NON-    #
                                   # UNIQUE BECAUSE A RECORD NAME CANT #
                                   # BE FURTHER QUALIFIED              #
                  HIT = FALSE;     # CORRECT NAME NOT FOUND YET        #
                  K = 0;           # EXIT K LOOP                       #
                  TEST K; 
                  END 
                END 
              END 
  
            IF K NQ FIELDNAMELG    # IF NOT FINAL QUALIFICATION        #
            THEN
              BEGIN 
              LOOPCON2 = TRUE;
              FOR DUMMY2 = DUMMY2  # FOLLOW DOMINANT CHAIN TO SEE THAT #
                                   # THAT ITEM(K+1) IS SUBORDINATE TO  #
                                   # ITEM(K)                           #
                WHILE LOOPCON2
              DO
                BEGIN 
                IF SBITMENTRY EQ SE$RECORD
                                   # NOTE THAT SBITMENTRY " SE$RECORD  #
                                   # THE FIRST TIME THROUGH LOOP BECAUS#
                                   # RECORD MUST BE FINAL QUALIFICATION#
  
                                   # IF WE-VE FOLLOWED THE CHAIN ALL   #
                                   # THE WAY WITHOUT FINDING A MATCH   #
                THEN               # THEN WE DONT HAVE THE RIGHT DBI   #
                  BEGIN 
                  IF DCSAMENAME EQ 0  # NO MORE DBIS WITH SAME NAME    #
                  THEN
                    BEGIN 
                    HIT = FALSE;   # HAVE NOT FOUND NAME               #
                    K = 0;
                    TEST K; 
                    END 
  
                  ELSE             # ANOTHER DBI WITH SAME NAME        #
                    BEGIN 
                    WRDADDR = DCSAMENAME;  # LOOP BACK TO TRY NEXT DBI #
                    FNWA[K] = WRDADDR;
                    TEST DUMMY1;
                    END 
                  END 
  
                IF FNWA[K + 1] EQ SBITMDOMADR  # IF ITEM(K+1) SUBORDINT#
                                               # TO ITEM(K)            #
                THEN
                  BEGIN 
                  LOOPCON2 = FALSE; 
                  TEST DUMMY2;     # EXIT LOOP WITH CORRECT DBI        #
                  END 
  
                GET (SCHEMAFIT,DBIENTRY,  # READ DOMINANT ITEM ENTRY   #
                    SBITMDOMADR, 0, 0, DFSBITMLG * 10, RA0);
                END                # END DUMMY2 LOOP                   #
              GET (SCHEMAFIT, DBIENTRY,  # REREAD ITEM ENTRY           #
                   WRDADDR, 0, 0, DFSBITMLG * 10, RA0); 
              END 
  
            BUILDINDTBL;           # BUILD INDEX TABLE ENTRY           #
            LOOPCON1 = FALSE; 
            TEST DUMMY1;
            END                    # END DUMMY1 LOOP                   #
          END                      # END K LOOP                        #
  
        IF HIT                     # FOUND A MATCH IN THIS AREA        #
        THEN
          BEGIN 
          LOOPCON = FALSE;
          TEST DUMMY;              # EXIT DUMMY LOOP                   #
          END 
  
                                   # 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.     #
  
        IF UPDATEAREA              # IF *UPDATE AREA* IS ACTIVE        #
          AND UPDATING             # THIS DIRECTIVE IS AN UPDATE       #
        THEN
          BEGIN 
          DIAG (339);              # AREA TO BE UPDATED IS NOT THE     #
                                   # CURRENT TARGET AREA               #
          STDNO;
          END 
  
        IF AT$FORWARD NQ 0         # IF MORE AREAS TO SEARCH           #
        THEN
          BEGIN 
          P<AREA$TABLE> = AT$FORWARD;  # POSITION TO NEXT AREA TABLE   #
          TEST DUMMY;              # LOOP BACK FOR NEXT AREA           #
          END 
  
        LOOPCON = FALSE;           # NO MORE AREAS SO EXIT LOOP        #
        TEST DUMMY; 
        END                        # END DUMMY LOOP                    #
  
      IF NOT HIT                   # NAME NOT FOUND IN ANY AREA        #
      THEN
        BEGIN 
        IF NONUNIKFLG              # IF NON-UNIQUE NAME WAS FOUND      #
        THEN
          BEGIN 
          DDIAG (184);             # -C- NOT FULLY QUALIFIED           #
          STDNO;                   # ERROR EXIT                        #
          END 
  
        ELSE
          BEGIN 
          FOR K = 1 STEP 1         # RESTORE -FIELDN- TO BLANK-FILLED  #
            UNTIL FIELDNAMELG 
          DO
            BEGIN 
            NAMELG = FNLG[K];      # LENGTH OF NAME IN CHARACTERS      #
            IF NAMELG LS 30        # IF THERE ARE TRAILING ZEROES      #
            THEN
              BEGIN 
                                   # REPLACE TRAILING 0-S WITH BLANKS  #
              CMOVE (BLANKS, 0, 30 - NAMELG, FIELDN[K], NAMELG);
              END 
            END 
  
          RETURN;                  # RETURN TO -GETNAME- TO SEARCH     #
                                   # REMAINING SOURCES                 #
          END 
        END 
  
                                   # DBI ENTRY HAS BEEN FOUND          #
  
      WRDADDR = FNWA[1];           # REREAD DBI ENTRY                  #
      GET (SCHEMAFIT, DBIENTRY, WRDADDR, 0, 0, DFSBITMLG * 10, RA0);
                                   # TRANSFORM CDCS DBI ENTRY INTO CRM #
                                   # DBI ENTRY                         #
      TRNSDBI (DBIENTRY, DIRECTENTRY, WRDADDR); 
      IF DECLSLG GR O"7777"        # IF WONT FIT IN CRM FIELD          #
      THEN
        BEGIN 
        DDIAG (371);               # -C- TRUNCATED TO 4095 CHARS       #
        END 
  
      IF NOT DEPENDBIT             # IF NO DEPENDING ON ITEM           #
      THEN
        BEGIN 
        IF FNEXT                   # IF NEXT                           #
        THEN
          BEGIN 
          DIAG (934);              # NEXT FOR DEPEND ON ITEM ONLY      #
          STDNO;                   # ERROR EXIT                        #
          END 
  
        IF FLAST                   # IF LAST                           #
        THEN
          BEGIN 
          DIAG (935);              # LAST FOR DEPEND ON ITEM ONLY      #
          STDNO;                   # ERROR EXIT                        #
          END 
        END 
  
      IF KEYITEM                   # IF PRIMARY KEY                    #
      THEN
        BEGIN 
        AKEYITEM = TRUE;           # SET PRIMARY KEY FLAG              #
        END 
      ELSE
        BEGIN 
        AKEYITEM = FALSE; 
        END 
  
      IF DOVERPUN                  # IF SIGN OVERPUNCH                 #
      THEN
        BEGIN 
        SIGNATERKEY = TRUE;        # SET SIGN OVERPUNCH FLAG           #
        END 
      ELSE
        BEGIN 
        SIGNATERKEY = FALSE;
        END 
  
      IF DALTKEYFLAG               # IF ALTERNATE KEY                  #
      THEN
        BEGIN 
        ALTKEYITEM = TRUE;         # SET ALTERNATE KEY FLAG            #
        END 
  
      P<BFN> = LOC(DDATNAM);       # SQUEEZE OUT SAME NAME WORD        #
      FOR I = 0 STEP 1
        UNTIL DEWNLG
      DO
        BEGIN 
        HASHNAM[I] = HASHNAM[I + 1];
        END 
  
      DATALENG = DECLSLG;          # INTERNAL LENGTH IN CHARACTERS     #
      MAJORKEYFLAG = DMAJKEYFLAG;  # TRUE IF MAJOR KEY                 #
      DATAITEMORD = SBITMORDINAL;  # ITEM ORDINAL                      #
      DOMINANTORD = SBITMDOMORD;   # DOMINANT ITEM ORDINAL             #
      BITPOSITION = DEWPOS * 60 + DBITPOS;  # CALCULATE BIT POSITION   #
  
                                   # SEARCH DOMINANT STRING BACKWARDS  #
                                   # TO RECORD ENTRY IN ORDER TO       #
                                   # 1) RESET BEGINNING BIT AND WORD   #
                                   # RELATIVE TO START OF RECORD INSTD #
                                   # OF RELATIVE TO DOMINANT REPEATING #
                                   # GROUP.                            #
                                   # 2) IF MAJOR KEY, DETERMINE WHAT   #
                                   # KEY IT IS MAJOR PART OF AND SET   #
                                   # DATAITEMORD TO ORDINAL OF KEY     #
                                   # 3) SET DATARECDORD TO RECORD ORDNL#
  
      LOOPCON = TRUE; 
      IF SBITMENTRY EQ SE$RECORD   # IF RECORD ENTRY                   #
      THEN
        BEGIN 
        LOOPCON = FALSE;           # NO SEARCH FOR RECORD ENTRY        #
        P<SBRECENTRY> = LOC(DBIENTRY);  # POSITION TO RECORD ENTRY     #
        SETRECDORD;                # SET *DATARECDORD*                 #
        END 
  
      FOR DUMMY = DUMMY              # FIND RECORD ORDINAL BY FOLLOWING#
                                     # DOMINANT POINTER BACKWARDS TO   #
                                     # RECORD ENTRY                    #
        WHILE LOOPCON 
      DO
        BEGIN 
        DOMRECORDWA = SBITMDOMADR;  # READ DOMINANT ITEM               #
        GET (SCHEMAFIT, DBIENTRY1, DOMRECORDWA, 0, 0, DFSBITMLG * 10, 
             RA0);
        P<SBITEMENTRY> = LOC(DBIENTRY1);
        IF SBITMENTRY EQ SE$RECORD  # IF RECORD ENTRY                  #
        THEN
          BEGIN 
          P<SBRECENTRY> = LOC(DBIENTRY1);  # POSITION TO RECORD ENTRY  #
          SETRECDORD;              # SET *DATARECDORD*                 #
          LOOPCON = FALSE;         # TERMINATE SCAN                    #
          TEST DUMMY; 
  
          END 
        IF MAJORKEYFLAG            # IF MAJOR KEY                      #
        THEN
          BEGIN 
          IF SBITMKEYFLG           # IF MAJOR PART OF PRIMARY KEY      #
          THEN
            BEGIN 
            IF DATALENG EQ SBITMUSESIZE  # IF SAME ITEM                #
            THEN
              BEGIN 
              AKEYITEM = TRUE;     # SET PRIMARY KEY FLAG              #
              END 
  
            ELSE
              BEGIN 
              IF AT$FITFO EQ FOIS  # IF *IS* FILE                      #
                AND SBITMDBCLASS LQ 4  # IF CHARACTER KEY              #
              THEN
                BEGIN 
                PMAJKEYITEM = TRUE;  # MAJOR PART OF PRIMARY KEY       #
                END 
              END 
  
            DATAITEMORD = SBITMORDINAL;  #RESET ITEM ORDINAL TO ORDINAL#
                                         #OF PRIMARY KEY               #
            END 
  
          IF SBITMALTKEYF          # IF MAJOR PART OF ALTERNATE KEY    #
          THEN
            BEGIN 
            IF DATALENG EQ SBITMUSESIZE  # IF SAME SIZE, HENCE SAME ITM#
            THEN
              BEGIN 
              ALTKEYITEM = TRUE;   # ALTERNATE KEY                     #
              END 
            ELSE
              BEGIN 
               IF AT$FITFO EQ FOIS      # IF *IS* FILE                 #
                 AND SBITMDBCLASS LQ 4  # CHARACTER KEY                #
               THEN 
                 BEGIN
                 AMAJKEYITEM = TRUE;    # INDICATE MAJ ALT KEY         #
                 SIZEALTKEY = SBITMUSESIZE;  # SET SIZE OF ALT KEY     #
                 END
              END 
  
            DATAITEMORD = SBITMORDINAL;  # RESET ITEM ORDINAL          #
            END 
          END 
  
        IF DOMINANTORD NQ 0        # IF BIT POSITION RELATIVE TO THIS  #
                                   # GROUP                             #
        THEN
          BEGIN 
          BITPOSITION = BITPOSITION + SBITMBWP * 60 + SBITMBBP; 
                                   # ADD BEGINNING BIT POSITION OF GRP #
          END 
  
        DOMINANTORD = SBITMDOMORD; # RESET DOMINANT ORDINAL            #
        END                        # END DUMMY LOOP                    #
  
                                   # SET COMMON BLOCK ITEMS            #
  
      TEMPTBLPTR = P<AREA$TABLE>;  # AREA TBL ADDR WHERE ITEM WAS FOUND#
      PROGSTACKLEN = -1;           # JUST AN ITEM, NOT AN EXPRESSION   #
      RESULTSLOC = BITPOSITION / 60;  # CALCULATE BEGINNING WORD POS   #
      DEWPOS = RESULTSLOC;
      DATAWORDADDR = RESULTSLOC;
      DBITPOS = BITPOSITION - (RESULTSLOC * 60);  # BEGINNING BIT POS  #
      DATACHARPOS = DBITPOS / 6;   # BEGINNING CHARACTER POSITION      #
      AREAITM = TRUE;              # AREA ITEM                         #
      DATATYPE = DECLASS;          # CLASS OF DATA (INTEGER, FLOAT ETC)#
      RESULTUSAGE = DATATYPE; 
      DATANAMEUSE = DATATYPE; 
      IF DATATYPE EQ DT$LOGICAL    # IF LOGICAL                        #
      THEN
        BEGIN 
        LOGICALRESLT = TRUE;
        END 
      ELSE
        BEGIN 
        LOGICALRESLT = FALSE; 
        END 
  
      RESULTSIZE = DPICSIZ;        # SIZE OF PICTURE INCLUDING INSERTS #
      FIGLITDATA = 5;              # AREA ITEM                         #
      ABSADDRESS = FALSE;          # RESULTSLOC IS RELATIVE TO RECORD  #
      P<SBITEMENTRY> = LOC(DBIENTRY); 
      IF SBITMENTRY EQ SE$ITEM     # IF ITEM ENTRY                     #
        AND SBITMURALPTR NQ 0      # IF MURAL EXISTS                   #
      THEN
        BEGIN 
                                   # READ FIRST WORD OF MURAL          #
        GET (SCHEMAFIT, MURALARRAY, WRDADDR + SBITMURALPTR, 0,0,10,RA0);
        I = MURALENGTH;            # LENGTH OF MURAL IN WORDS          #
                                   # GET CM FOR ENTIRE MURAL           #
        P<BFN> = CMM$ALF (I, 0, SM$GROUPID);
        MURALPTR = P<BFN>;         # SAVE ABSOLUTE ADDRESS OF MURAL    #
                                   # READ ENTIRE MURAL                 #
        GET (SCHEMAFIT, BFN, WRDADDR + SBITMURALPTR, 0, 0, I * 10, RA0);
        END 
  
      ELSE
        BEGIN 
        MURALPTR = 0;              # NO MURAL EXISTS                   #
        DATANAMEPIC = FALSE;
        END 
      DATANAMEPTR = LOC(DIRECTENTRY);  # ADDRESS OF ATTRIBUTE TABLE    #
      IF NOT RECORDFLAG            # IF NOT RECORDING                  #
      THEN
        BEGIN 
        IFFROMFLAG = TRUE;
        END 
  
      DATANAMEBASE = AREANUM;      # ORDINAL WITHIN AREATABLE CHAIN    #
                                   # WILL BE STORED IN ELEMENTARY ENTRY#
                                   # BY VARIOUS SYNTAX ROUTINES AND    #
                                   # MODIFIED BY STKSCAN TO FITWSA OF  #
                                   # THAT AREA                         #
      IF TYPEALOW EQ 6             # ALLOWED TYPES OF DATA ARE         #
                                   # (AREA XOR DESCRIBE) DEFINE SPECIFY#
      THEN
        BEGIN 
        TYPEALOW = 4;              # SINCE AREA ITEM HAS BEEN FOUND    #
                                   # ALLOWED TYPES OF DATA ARE NOW     #
                                   # AREA, DEFINE, SPECIFY             #
        END 
  
      DIRWORDADDR = WRDADDR;       # SUBSCHEMA WA ADDR OF DBI ENTRY    #
  
                                   # COMPLETE INDEX TABLE BY STORING   #
                                   # UPPER BOUND AND DEPENDING INFO    #
  
      IF UPBND[0] EQ 0             # IF NO UPPER BOUND                 #
      THEN
        BEGIN 
        LOOPCON = TRUE; 
        FOR I = 1 STEP 1           # FIND FIRST NONZERO UPPER BOUND    #
          WHILE LOOPCON 
        DO
          BEGIN 
          IF UPBND[I] NQ 0         # IF NONZERO UPPER BOUND            #
          THEN
            BEGIN 
            UPBND[0] = UPBND[I];   # SAVE 1ST NONZERO UPPER BOUND      #
            LOOPCON = FALSE;       # TERMINATE SCAN                    #
            END 
  
          IF I GQ FIELDNAMELG - 1  # IF SCANNED ENTIRE TABLE           #
          THEN
            BEGIN 
            LOOPCON = FALSE;       # TERMINATE SCAN                    #
            END 
          END                      # END OF I LOOP                     #
        END 
  
      FOR I = 0 STEP 1
        UNTIL FIELDNAMELG - 1 
      DO
        BEGIN 
        IF CONSUB[I]
          AND INDCE[I] GR UPBND[I]  # CONSTANT INDEX GR UPPER BOUND    #
        THEN
          BEGIN 
          DDIAG (177);             # SUBSCRIPT OUT OF BOUNDS           #
          STDNO;
          END 
        END 
  
      IF DEPENDBIT                 # IF DEPENDING ITEM FOUND           #
      THEN
        BEGIN                      # PREPARE DEPENDING WORD IN INDTBL  #
        GET (SCHEMAFIT, DBIENTRY1, SAVEDEPEND, 0, 0, DFSBITMLG * 10,
             RA0);                 # READ DEPENDING DBI ENTRY          #
        INDTBLWD[FIELDNAMELG] = 0;  # INITIALIZE WHOLE WORD TO 0       #
        P<SBITEMENTRY> = LOC(DBIENTRY1);
                                   # CONVERT DATA CLASS                #
        DPTYPE[FIELDNAMELG] = B<SBITMDBCLASS*3,3>CLASSCVT;
        TBLGS[FIELDNAMELG] = SBITMBBP / 6;  # CHARACTER POSITION       #
        INDCE[FIELDNAMELG] = SBITMBWP;  # WORD POSITION                #
        ENTYLG[FIELDNAMELG] = SBITMUSESIZE;  # INTERNAL SIZE IN CHARS  #
        I = FIELDNAMELG + 1;
        END 
  
      ELSE
        BEGIN 
        I = FIELDNAMELG;
        END 
  
      TBLGS[0] = I;                # NUMBER OF WORDS IN INDEX TABLE    #
  
      IF OCCURBIT                  # IF OCCURRING ITEM FOUND           #
      THEN
        BEGIN 
        IF NOT OCCURS[0]           # IF WITHIN OCCURRING GROUP, BUT NOT#
                                   # ACTUALLY OCCURRING ITSELF         #
        THEN
          BEGIN 
                                   # MOVE NAME DOWN ONE WORD TO ALLOW  #
                                   # FOR OCCURRING WORD WHICH OCCURS   #
                                   # FLAG SAYS IS THERE.  THE OCCURRING#
                                   # WORD HAS NO USEFUL INFORMATION.   #
                                   # ALL ACTUAL OCCURRING INFORMATION  #
                                   # IS IN THE INDEX TABLE             #
          P<BFN> = LOC(ITEMNAME[0]);
          FOR I = NAMELGW[0] -1 STEP -1  # ALL WORDS OF NAME           #
            UNTIL 0 
          DO
            BEGIN 
            HASHNAM[I+1] = HASHNAM[I];  # MOVE NAME DOWN ONE WORD      #
            END 
          END 
  
        INDICED = TRUE;            # SET OCCURRING FLAG                #
        OCCURS[0] = TRUE;          # SET OCCURRING FLAG                #
        END 
  
      ELSE
        BEGIN 
        IF SM$GROUPID EQ 0         # IF INDTBL NOT ALLOCATED BY GRP ID #
        THEN
          BEGIN 
          CMM$FRF (P<INDTBL>);     # FREE UNUSED INDTBL                #
          END 
  
        INDICED = FALSE;
        INDCTBLOC = 0;
        END 
  
      IF DFORMAT NQ ET$ITEM          # IF NOT ELEMENTARY ITEM          #
        AND DFORMAT NQ ET$VECTOR     # IF NOT VECTOR                   #
        AND DFORMAT NQ ET$RPTVECTOR  # IF NOT VECTOR WITHIN REPEAT GRP #
      THEN
        BEGIN 
        DECLASS = DT$CHAR;         # GROUP IS CHARACTER CLASS          #
        IF DIRLEXID EQ O"104"      # IF DISPLAY DIRECTIVE              #
        THEN
          BEGIN 
          DIAG (209);              # DATA MAY NOT BE IN DISPLAY FORMAT #
          END 
        END 
  
      FOR K = 1 STEP 1             # RESTORE -FIELDN- TO BLANK-FILLED  #
        UNTIL FIELDNAMELG 
      DO
        BEGIN 
        NAMELG = FNLG[K];          # LENGTH OF NAME IN CHARS           #
        IF NAMELG LS 30            # IF TRAILING 0-S EXIST             #
        THEN
          BEGIN 
                                   # REPLACE THEM WITH BLANKS          #
          CMOVE (BLANKS, 0, 30-NAMELG, FIELDN[K], NAMELG);
          END 
        END                        # END -K- LOOP                      #
  
      STDYES; 
      END                          # END PROC    C D C S N A M         #
      TERM
