*DECK USECRM
USETEXT TAREATB 
USETEXT TCLFN 
USETEXT TCRMDEF 
USETEXT TCYBDEF 
USETEXT TDBPDEF 
USETEXT TENVIRN 
USETEXT TEXPRES 
USETEXT TFIT
USETEXT TOPTION 
USETEXT TPFMDEF 
USETEXT TRELTBL 
USETEXT TREPORT 
USETEXT TXSTD 
      PROC USECRM;
      BEGIN 
  
#----------------------------------------------------------------------#
#                                                                      #
#     U S E C R M                                                      #
#                                                                      #
#     *USECRM*, WHICH RESIDES IN THE (5,2) OVERLAY, PROCESSES          #
#     -CREATE-, -USE-, -INVOKE-, OR -VERSION- DIRECTIVES WHENEVER      #
#     THE SUBSCHEMA SPECIFIED IS A QU/CRM SUBSCHEMA, OR IF THE         #
#     -VERSION- DIRECTIVE SPECIFIED EITHER A CRM OR THE                #
#     DEFAULT CATALOG FILE.                                            #
#                                                                      #
#     THE FOLLOWING ROUTINES HAVE BEEN LIFTED FROM THE *USE* DECK      #
#     OF VERSION 3.2, WITH VARIOUS CHANGES MADE PRIMARILY SO AS TO     #
#     ADHERE TO THE CODING CONVENTIONS:                                #
#                                                                      #
#         - BLDINDX                                                    #
#         - BUILDTABLE                                                 #
#         - COMPWDS                                                    #
#         - FINDAREA                                                   #
#         - FILERELA                                                   #
#         - PROCRELENTRY                                               #
#         - ZEROUNUSED                                                 #
#         - ZERO2BLANK                                                 #
#         - PARTS OF MAIN ROUTINE                                      #
#                                                                      #
#----------------------------------------------------------------------#
  
  
  
#----------------------------------------------------------------------#
#   S T A R T   O F   X D E F S                                        #
#                                                                      #
#   NOTE - IN ADDITION, THE FOLLOWING XDEFS APPEAR AMONG THE           #
#          SUBROUTINES IN THIS LISTING:                                #
#                                                                      #
#                       ABORTUSE                                       #
#                       AUTOPSY                                        #
  
      XDEF ITEM  SBLFN C(10);      # LFN OF SUBSCHEMA LIBRARY FILE     #
  
  
#----------------------------------------------------------------------#
#   S T A R T   O F   X R E F S                                        #
  
      XREF ITEM  ABORTED B;        # TRUE IF REPRIEVED                 #
      XREF ITEM  AREATBLPTR I;     # POINTER TO FIRST AREA TABLE       #
      XREF ITEM  CATBLPTR I;       # POINTER TO CATALOG TABLE          #
      XREF ITEM  CDCSCAT B;        # TRUE IF CDCS VERSION              #
      XREF ITEM  CDCSDBM B;        # TRUE IF CDCS USE/CREATE/INVOKE    #
      XREF ITEM  CDCSUP B;         # TRUE IF ACTUALLY USING CDCS       #
      XREF ITEM  COBCOL I;         # DEFAULT COBOL COLL SEQ LOC        #
      XREF ITEM  DBP$FWA I;        # FWA OF LOADED DBP-S, ELSE ZERO    #
      XREF ITEM  DIAGLEV B;        # DIAGS FULL/PART FLAG              #
      XREF ITEM  DUMMY I;          # SCRATCH VARIABLE                  #
      XREF ITEM  FORTCOL I;        # DEFAULT FORTRAN COLL SEQ LOC      #
      XREF ITEM  INDEX I;          # FLAG TO CONTROL OTHER OVERLAYS    #
      XREF ITEM  INDEX$PFP B;      # PF PARAMS GIVEN WITH INDEX NAME   #
      XREF ITEM  INTERIN B;        # SET TRUE BY *MODPFP* TO PREVENT   #
                                   # USER INPUT FROM BEING COPIED TO   #
                                   # TERMINAL                          #
      XREF ITEM  INVOKED B;        # TRUE IF AN -INVOKE- IN EFFECT     #
      XREF ITEM  IOFLAG I;         # 0 - SUBSCHEMA BEING READ BY CRM   #
                                   # 1 - SUBSCHEMA BEING READ BY       #
                                   #     DIRECTORY ACCESS ROUTINES     #
      XREF ITEM  MODCAT B;         # TRUE IF CATALOG MODIFIED          #
      XREF ITEM  MODIFYFLAG B;     # -MODIFY- OR -PW- FOUND            #
      XREF ITEM  MXTRNLG I;        # MAX TRANS LENGTH                  #
      XREF ITEM  NEWATBL I;        # AREA TBL PTR FOR SUBSCHEMA DURING #
                                   # ACCESS BEFORE RETURNING OLD ONE   #
      XREF ITEM  NEWFILE I;        # PRU COUNT RETURNED BY *DDLOPSB*   #
      XREF ITEM  PFPTR I;          # POINTER TO 1ST *PFTABLE* ENTRY    #
      XREF ITEM  PRINT B;          # TRUE IF INPUT SHOULD GO TO TRACE  #
      XREF ITEM  RA0 I;            # ZERO TERMINATOR FOR PARAMS        #
      XREF ITEM  RELATBLPTR I;     # POINTER TO FIRST RELATION TABLE   #
      XREF ITEM  SAMELFN B;        # TRUE IF LFN OF NEW SUBSCHEMA FILE #
                                   # SAME AS PREVIOUS (NOS ONLY) - IF  #
                                   # SO, PREVIOUS WAS RETURNED WHEN    #
                                   # NEW WAS ATTACHED                  #
      XREF ITEM  SBSCADD I;        # WA OF SUBSCHEMA WITHIN SBSCH LIB  #
      XREF ITEM  SBSCHG B;         # TRUE IF PICKING UP DIFFERENT SUBSC#
      XREF ITEM  SCFIT I;          # DUMMY FIT FOR SUBSCHEMA FILE      #
      XREF ITEM  SCSIZE I;         # SIZE OF THE DUMMY FIT             #
      XREF ITEM  SCTLPTR I;        # POINTER TO SUBSCHEMA CONTROL INFO #
      XREF ITEM  TAREA1 I;         # POINTER TO THE AREA FDB           #
      XREF ITEM  TAREA2 I;         # POINTER TO THE INDEX FDB          #
      XREF ITEM  TAREA3 I;         # POINTER TO THE SUBSCHEMA FDB      #
      XREF ITEM  TAREA4 I;         # POINTER TO THE RELATION STRING    #
      XREF ITEM  TAREA4X I;        # POINTER TO CURRENT BLOCK          #
      XREF ITEM  TARGETAREA I;     # P<AREA$TABLE> OF AREA TO BE       #
                                   # UPDATED IF UPDATE AREA IN EFFECT  #
      XREF ITEM  UPDATEAREA B;     # TRUE IF UPDATE AREA IN EFFECT     #
      XREF ITEM  USEDIR B;         # TRUE IF USE OR INVOKE             #
      XREF ITEM  VERAREATBL I;     # ADDRESS OF AREA TABLE WITH ACTIVE #
                                   # VERIFY LIST                       #
      XREF ITEM  VERDIR B;         # TRUE IF -VERSION- DIRECTIVE       #
      XREF ITEM  VERSBSCHPTR I;    # POINTER TO 1ST AREA TABLE (SUBSC) #
                                   # IF IN CDCS CATALOG MODE           #
      XREF ITEM  VIAPOINT I;       # PTR TO RELATION TABLE ENTRY       #
                                   # WITH VIA SPECIFIED NAME           #
  
      XREF FUNC  CMM$AGR;          # ACTIVATE GROUP-ID                 #
      XREF FUNC  CMM$ALF;          # ALLOCATE FIXED BLOCK              #
  
      XREF PROC  BGTABLE;          # BUILD BACKGROUND TABLE            #
      XREF PROC  CHGFDB;           # CHANGE PF PARAMS IN FDB           #
      XREF PROC  CLOSEM;           # CRM CALL TO CLOSE FILE            #
      XREF PROC  CLSESB;           # DDL CALL TO CLOSE SUBSCHEMA       #
      XREF PROC  CLSEDET;          # CLOSE/DETACH BAD SUBSCHEMA        #
      XREF PROC  CMM$FGR;          # FREE BLOCK GROUP                  #
      XREF PROC  CMM$FRF;          # FREE FIXED BLOCK                  #
      XREF PROC  CMM$SLF;          # SHRINK FIXED BLOCK AT LWA         #
      XREF PROC  DBP$LOD;          # LOAD DATABASE PROCEDURES          #
      XREF PROC  DB$CLS;           # CDCS CALL TO CLOSE FILE           #
      XREF PROC  DB$END;           # CDCS TERMINATE                    #
      XREF PROC  DDLOPSB;          # DDL CALL TO OPEN SUBSCHEMA FILE   #
                                   # AND RETURN WA OF EOI              #
      XREF PROC  DDLRDSB;          # DDL CALL TO READ SUBSCHEMA FILE   #
      XREF PROC  DIAG;             # ISSUE DIAGNOSTIC                  #
      XREF PROC  GET;              # CRM CALL TO READ FILE             #
      XREF PROC  LOADOVL;          # LOAD QU OVERLAY                   #
      XREF PROC  OPENM;            # CRM CALL TO OPEN FILE             #
      XREF PROC  OPNCAT;           # OPEN CATALOG FILE                 #
      XREF PROC  REQPF;            # REQUEST PERMANENT FILE DEVICE     #
      XREF PROC  RETURNM;          # RETURN FILE                       #
  
      XREF BASED ARRAY  DBSTAT;;   # DATABASE STATUS BLOCK             #
  
      XREF
*CALL SCHEMAFIT 
  
  
  
  
#----------------------------------------------------------------------#
#  S T A R T   O F   D E F S                                           #
  
  
      DEF PRU          #64#;       # SIZE OF PRU                       #
      DEF SCTLSZ       #26#;       # SIZE OF SUBSCHEMA CONTROL INFO    #
      DEF $BLANKS$     #O"55555555555555555555"#; 
                                   # VALUE OF EOF MARKER ON SUBSCH LIB #
      DEF $EOFMARK$    #"ENDOFSSFIL"#;
      DEF $HIGHVALUE$  #O"77777777777777770000"#; 
  
  
  
  
#----------------------------------------------------------------------#
#   S T A R T   O F   L O C A L   I T E M S                            #
  
        ITEM  AINDXLNG I;          # AREA INDEX ENTRY LENGTH           #
        ITEM  BIT I;               # STARTING BIT POSITION             #
        ITEM  CHANGINGFDB I;       # LOCATION OF THE FDB BEING         #
                                   # *MODIFIED* BY ROUTINE *CHANGE*.   #
        ITEM  CHAR I;              # ONE 6 BIT CHARACTER               #
        ITEM  CURPATHCNT I;        # PATH COUNTER                      #
        ITEM  CURPATHFLG I;        # CURRENT PATH BIT FLAG             #
        ITEM  DBPLFN I;            # DATA BASE USER LIBRARY LFN        #
        ITEM  DUMMY1 I;            # TEMP ITEM                         #
        ITEM  DUMMY2 I;            # TEMP ITEM                         #
        ITEM  HASHSIZE I;          # LENGTH OF HASH TABLE              #
        ITEM  HIGH I;              # 3 HIGH BITS FROM CHARACTER        #
        ITEM  HYPHENS B;           # TRUE IF HYPHENS IN CURWORD (SET BY#
                                   # CHKHYPHENS).                      #
        ITEM  LASTENTRY I;         # LAST AREA TABLE ADDRESS DURING SCA#
        ITEM  LOOPDONE I;          # LIMIT FOR A FOR LOOP              #
        ITEM  LOW I;               # 3 LOW  BITS FROM CHARACTER        #
        ITEM  MORE B;              # MORE INFORMATION FLAG             #
        ITEM  MUST40X B;           # MUST LOAD THE 40-X OVERLAY TO OPEN#
        ITEM  NBRAREAS I;          # NBR OF AREAS IN USE AT ONE TIME   #
        ITEM  NBRRELS I;           # NO OF RELATIONS IN USE AT ONE TIME#
        ITEM  NOCHARS I;           # NUMBER OF CHARS FOR READ          #
        ITEM  RC I;                # RETURN CODE                       #
        ITEM  RDLOOP I;            # READ SUB-SCHEMA LOOP VALUE READS  #
        ITEM  RELOOP I;            # LOOP COUNTER FOR RELATION NAMES   #
        ITEM  RGROUPID I;          # RELATION GROUP ID                 #
        ITEM  SAVEPOS I;           # SAVE POSITION OF ARRAY            #
        ITEM  SIZE I;              # TEMP STORAGE ITEM                 #
        ITEM  TEMPBUFPTR I;        # POINTER TO A TEMP INPUT BUFFER    #
        ITEM  TEMPCHAR I;          # CHAR FOR MOVING                   #
        ITEM  TEMPWA I;            # RETURNED WORD ADDRESS FROM SEARCH #
        ITEM  TGROUPID I;          # TEMP CMM GROUP ID                 #
        ITEM  THISENTRY I;         # ADDRESS OF CURRENT TABLE BEING PRO#
        ITEM  TOTALWDS I;          # TOTAL WORDS READ FOR SEARCH       #
        ITEM  UNIT I;              # TEMP FOR UNIT NUMBER              #
        ITEM  WAKEY I;             # WORD ADDRESS FOR GETS             #
        ITEM  WAKEY2 I;            # WORD ADDRESS FOR GETS             #
        ITEM  WORD I;              # WORD INDEX VALUE                  #
CONTROL EJECT;
#----------------------------------------------------------------------#
#   S T A R T   O F   L O C A L   A R R A Y S                          #
  
                                   # ARRAY TO HOLD NAMES               #
      ARRAY   AREANAMEA   [0:3]  S (1); 
        BEGIN 
        ITEM  AREANAME    U(00,00,60);
        END 
  
  
                                   # THIS ARRAY IS TO RECEIVE THE      #
                                   # AREA HEADER INFORMANTION          #
      ARRAY   SAREAHEAD  [0:7]   S (1); 
        BEGIN 
        ITEM  SAHTYPE       U(00,00,06);    # DATA TYPE PARAMETERS (8) #
        ITEM  SAHAFDBWAR    U(00,06,12);    # REL WA OF RECORD FDB     #
        ITEM  SAHIFDBWAR    U(00,18,12);    # REL WA OF INDEX FDB      #
        ITEM  SAHMIBIT      B(00,35,01);    # TRUE MULTIPLY INDEXED    #
        ITEM  SAHHASHWAR    U(00,48,12);    # REL WA OF HASH TABLE     #
        ITEM  SAHNAMELNG    U(01,06,06);    # AREA NAME LENGTH         #
        ITEM  SAHSDAWAR     U(01,24,12);    # REL WA OF SDA PROCEDURES #
        ITEM  SAHDUPS       U(01,36,02);    # DUPLICATE KEY POS INFO   #
                                            #  1 = FIRST               #
                                            #  2 = LAST, ALLOWED       #
                                            #  3 = NOT ALLOWED         #
        ITEM  SAHSORTSEQ    B(01,38,01);    # SORTED SEQUENTIAL FILE   #
        ITEM  SAHSSQDESC    B(01,39,01);    # SSQ DESCENDING FLAG      #
        ITEM  SAHFTNCOL     B(01,40,01);    # TRUE FORTRAN COL SEQ     #
        ITEM  SAHTEMPAREA   B(01,41,01);    # TRUE TEMPORARY-AREA      #
        ITEM  SAHRECWA      U(01,42,18);    # RECORD ENTRY ADDRESS     #
        ITEM  SAHCOLWAR     U(02,00,12);    # REL WA OF COLLATE TABLE  #
        ITEM  SAHONWAR      U(02,12,12);    # REL WA OF ON CALL  PROC  #
        ITEM  SAHLOGWAR     U(02,24,12);    # REL WA OF LOG AREA INFO  #
        ITEM  SAHFITWAR     U(02,36,12);    # REL WA OF AREA FIT       #
        ITEM  SAHNAME       C(03,00,10);    # AREA NAME   3 WORDS LONG #
        END 
  
  
                                   # THIS ARRAY IS TO RECEIVE THE      #
                                   # AREA INDEX INFORMATION            #
      ARRAY   SAREAINDX   [0:3]  S (1); 
        BEGIN 
        ITEM  SANAMELNG   U(00,00,06);  # AREA NAME LENGTH             #
        ITEM  SAWORDADD   U(00,30,30);  # WORD ADDRESS OF AREA ENTRY   #
        ITEM  SANAME      C(00,00,10);  # AREA NAME  LEFT JUST  BLANKS #
        END 
  
  
                                   # HOLDS CONTROL WORD OF SUBSC LIB   #
      ARRAY  SBLBCTLWD [0:0] S(1);
        BEGIN 
        ITEM  SBLBCOUNT     I(00,00,12);    # NO. OF ACTIVE SUBSCHEMAS #
        ITEM  SBLBINDWA     I(00,12,48);    # WA OF START OF INDEX TBL #
        END 
  
  
                                   # HOLDS ONE INDEX TABLE ENTRY       #
                                   # FROM SUBSCHEMA LIBRARY            #
      ARRAY  SBLBINDEX [0:0] S(4);
        BEGIN 
        ITEM  SBLBSBSNAME   C(00,00,30);    # SUBSCHEMA NAME           #
        ITEM  SBLBSSWA      I(03,00,30);    # WA OF START OF SUBSCHEMA #
        ITEM  SBLBSSLENG    I(03,30,30);    # SUBSCHEMA LENGTH         #
        END 
  
  
                                   # THIS ARRAY IS TO RECEIVE THE      #
                                   # USER DEFINED COLLATING SEQUENCE   #
      ARRAY   SCOLINFO   [0:10];
        BEGIN 
        ITEM  SCOLSIZE      U(00,00,06);    # NUMBER OF CHARACTERS     #
                                            # ZERO IF SCOLSIZE = 64    #
        ITEM  SCOLWORDS     U(00,06,06);    # NUMBER OF WORDS          #
        ITEM  SCOLCHARS     C(00,00,10);    # UP TO 64 CHARACTERS      #
        END 
  
  
                                   # THIS ARRAY IS TO RECEIVE THE      #
                                   # DATA BASE PROCEDURE INFORMATION   #
      ARRAY   SDBPINFO   [0:10];
        BEGIN 
        ITEM  SDBPNAME      C(00,00,07);    # PROCEDURE NAME           #
        ITEM  SDBPDIS       B(00,49,01);    # DISPLAY FLAG             #
        ITEM  SDBPMAT       B(00,50,01);    # MATCH FLAG               #
        ITEM  SDBPMIS       B(00,51,01);    # MISMATCH FLAG            #
        ITEM  SDBPOPN       B(00,53,01);    # OPEN FLAG                #
        ITEM  SDBPCLS       B(00,54,01);    # CLOSE FLAG               #
        ITEM SDBPRET        B(00,55,01);    # RETRIEVAL FLAG           #
        ITEM  SDBPUPD       B(00,56,01);    # UPDATE FLAG              #
        ITEM  SDBPSCH       B(00,57,01);    # SEARCH FLAG              #
        ITEM  SDBPMORE      B(00,52,01);    # ANOTHER ENTRY FOLLOWS    #
        END 
  
  
                                   # THIS ARRAY IS TO RECEIVE THE      #
                                   # ITEM ENTRY INFORMATION            #
      ARRAY   SITEMENTY  [0:3]   S (1); 
        BEGIN 
        ITEM  SIETYPE       U(00,00,06);    # TYPE OF ENTRY            #
        ITEM  SIEDOMPTR     U(00,24,12);    # DOMINANT POINTER         #
        ITEM  SIENEXT       U(00,48,12);    # NEXT POINTER RELATIVE    #
        ITEM  SIECLASS      U(01,12,06);    # CLASS OF DATA            #
        ITEM  SIENAMEL      U(01,06,06);    # NAME LENGTH IN WORDS     #
        ITEM  SIEBWP        U(01,18,18);    # BEGINNING WORD POSITION  #
        ITEM  SIEBBP        U(01,36,06);    # BEGINNING BIT POSITION   #
        ITEM  SIESIZE       U(01,42,18);    # LENGTH OF ITEM           #
        ITEM  SIEKEYFLAG    B(02,00,01);    # TRUE IF ITEM IS A KEY    #
        ITEM  SIEINOCC      B(02,01,01);    # TRUE IF ITEM IS WITHIN AN#
                                            # OCCURRING GROUP, DOMINANT#
                                            # ENTRY MUST BE ACCESSED   #
        ITEM  SIEOCCDIM     B(02,02,01);    # TRUE IF ITEM DIMENSIONED #
                                            # OCCURRENCE.  EXAMPLE:    #
                                            # 02  A1 OCCURS 3 TIMES    #
                                            #     03  A11 PIC XX       #
                                            #     03  A12 PIC XX       #
                                            # SIEINOCC TRUE FOR A11,A12#
                                            # SIEOCCDIM TRUE FOR A1    #
        ITEM  SIESIGN       B(02,15,01);    # SIGNED/UNSIGNED          #
        ITEM  SIEALTKEYF    B(02,16,01);    # ALTERNATE KEY FLAG       #
        ITEM  SIEALTFIRST   B(02,17,01);
        ITEM  SIEALTDUP     B(02,18,01);    # IF ALTERNATE KEY, TRUE   #
                                            # IF DUPLICATES ALLOWED    #
        ITEM  SIEMAJKFLG    B(02,18,01);    # IF NOT ALTERNATE KEY,    #
                                            # TRUE IF MAJOR KEY        #
        END 
  
  
                                   # THIS AREA IS USED TO HOLD THE     #
                                   # OPTIONAL OCCURANCE WORD OF AN     #
                                   # ITEM ENTRY.                       #
      ARRAY   SITEMOCC    [0:1]  S (1); 
        BEGIN 
        ITEM  SITDEPFLG   B(00,01,01);      # DEPENDING ON FLAG        #
        ITEM  SITMAXOCC   U(00,06,18);      # MAX OCCURANCE COUNT      #
        ITEM  SITDEPMIN   U(00,24,18);  # DEPENDING ON MIN OCCURANCE   #
        ITEM  SITDEPPTR   U(00,42,18);  # DEPENDING ON POINTER         #
        END 
  
  
                                   # THIS ARRAY IS TO RECEIVE THE      #
                                   # AREA LOGFILE INFORMATION          #
      ARRAY   SLOGINFO   [0:12]  S (1); 
        BEGIN 
        ITEM  SLOGWORD      U(00,00,60);
        ITEM  SLOGNAMELNG   U(00,00,06);    # LENGTH OF NAME           #
        ITEM  SLOGBEF       B(00,57,01);    # LOG BEFORE FLAG          #
        ITEM  SLOGAFT       B(00,58,01);    # LOG AFTER  FLAG          #
        ITEM  SLOGTRN       B(00,59,01);    # LOG TRANS  FLAG          #
        ITEM  SLOGNAME      U(01,00,60);    # LOG FILE                 #
        END 
  
  
                                   # THIS ARRAY IS TO RECEIVE THE      #
                                   # RELATION INDEX INFORMATION        #
      ARRAY   SRELATINDX  [0:3]  S (1); 
        BEGIN 
        ITEM  SRNAMELNG   U(00,00,06);  # RELATION NAME LENGTH         #
        ITEM  SRWORDADD   U(00,30,30);  # WORD ADDRESS OF RELATION     #
        ITEM  SRNAME      C(00,00,10);  # RELATION NAME  LEFT JUST     #
        END 
  
  
                                   # THIS ARRAY IS TO RECEIVE THE      #
                                   # FIRST WORD OF THE RELATION ENTRY  #
      ARRAY   SRELHEAD   [0:1]   S (1); 
        BEGIN 
        ITEM  SRELRANKS     U(00,00,06);    # NUMBER OF RANKS          #
        ITEM  SRELRESTNO    U(00,06,06);    # NUMBER OF RESTRICTS      #
        ITEM  SRELRESTWA    U(00,42,18);    # WORD ADDRESS OF RESTRICT #
        END 
  
  
                                   # THIS ARRAY IS TO RECEIVE THE      #
                                   # FIRST WORD OF THE RESTRICT ENTRY  #
      ARRAY   SRESTENTY  [0:1]  S (1);
        BEGIN 
        ITEM  SRESTMORE     B(00,00,01);    # ANOTHER ENTRY FOLLOWS    #
        ITEM  SRESTLNG      U(00,01,08);    # LENGTH IN WORDS OF       #
                                            # THIS RESTRICT ENTRY      #
        ITEM  SRESTRECWA    U(00,42,18);    # WORD ADDRESS OF RECORD   #
                                            # ENTRY IN THE SU-SCHEMA   #
        END 
  
  
                                   # ARRAY TO RECEIVE A NAME THAT      #
                                   # WILL BE LEFT JUSTIFIED BLANK FILL #
      ARRAY   THISNAMEA   [0:3]  S (1); 
        BEGIN 
        ITEM  THISNAME    C(00,00,10);
        ITEM  THISNAME30  C(00,00,30);      # ALL 30 CHARS             #
        ITEM  THISNAI     U(00,00,60);
        END 
CONTROL EJECT;
#----------------------------------------------------------------------#
#   S T A R T   O F   L O C A L   B A S E D   A R R A Y S              #
  
                                   # ARRAY TO BE USED IN UPDATING      #
                                   # THE FDB IN THE AREA TABLE STRINGS #
      BASED ARRAY  CHANGES; 
        BEGIN 
        ITEM  PRAMWORD      U(00,00,60);    # WHOLE WORD               #
        ITEM  PRAMVALUE     U(00,00,54);    # PARAMETER VALUE          #
        ITEM  PRAMKEY       U(00,54,06);    # PRAM KEYWORD CODE        #
        END 
  
  
                                   # ARRAYS FOR MOVING THINGS IN CORE  #
      BASED ARRAY   GETA; 
        BEGIN 
        ITEM  GETITEM     U(00,00,60);
        ITEM  GETITEMX    U(00,42,18);    # LOW 18 BITS FOR ADDRESS    #
        ITEM  GETITEMN    C(00,00,07);    # FIRST 7 CHARACTERS         #
        END 
  
      BASED ARRAY   GIVEA;
        BEGIN 
        ITEM  GIVEITEM    U(00,00,60);
        ITEM  GIVEITEMN   C(00,00,07);
        ITEM  GIVECHAR    C(00,00,64);
        END 
  
  
                                   # ARRAY TO BE USED IN SCANING THE   #
                                   # LIST OF REQUESTED RELATION NAMES  #
      BASED ARRAY   RELNAMES; 
        BEGIN 
        ITEM  RELNAMEX      U(00,00,60);
        END 
  
  
                                   # BUFFER USED TO SEARCH SUBSCHEMA   #
                                   # LIBRARY FOR THE DESIRED SUBSCHEMA #
      BASED ARRAY  SBSBUF;
        BEGIN 
        ITEM  SBSBUFI       I(00,00,60);
        END 
  
  
      BASED ARRAY   SCHEMAFDB;
        BEGIN 
        ITEM  SCHFDBITEM  U(00,00,60);
        END 
  
  
                                   # ARRAY CONTAINING SUBSCHEMA        #
                                   # CONTROL INFORMATION               #
      BASED ARRAY  SCONTROL;
        BEGIN 
        ITEM  SNAME       C(00,00,10);  # SUB-SCHEMA NAME   0 - 2      #
        ITEM  SAREAWA     U(03,30,30);  # WORD ADDRESS OF AREA INDEXES #
        ITEM  SAREALNG    U(03,00,30);  # LENGTH OF AREA INDEX         #
        ITEM  SRELWA      U(04,30,30);  # ADDRESS OF RELATION INDEXES  #
        ITEM  SRELALNG    U(04,06,24);  # LENGTH OF RELATION INDEXES   #
        ITEM  SDBPFLAG    B(04,01,01);  # DATA BASE LIBRARY FLAG       #
        ITEM  SCTIME      C(05,00,05);  # SS COMPILE TIME -- HH.MM     #
        ITEM  SCDATE      C(05,30,05);  # SS COMPILE JDATE -- YYDDD    #
        ITEM  SDDLVER     C(06,12,03);  # DDL VERSION NUMBER -- N.N    #
        ITEM  SCRMVER     C(06,42,03);  # CRM VERSION NUMBER -- N.N    #
        ITEM  SBDATE      C(07,00,05);  # DDL BUILD DATE -- YYDDD      #
        ITEM  SDBPFDB     U(09,00,60);  # DATA BASE LIBRARY FDB POS    #
        END 
  
  
                                   # ARRAY TO BE USED IN SCANING THE   #
                                   # SUB-SCHEMA RELATION ENTRIES       #
      BASED ARRAY   SRELENTY; 
        BEGIN 
        ITEM  SRELAWA       U(00,00,18);    # WORD ADDR OF AREA ENTRY  #
        ITEM  SRELIWA       U(00,18,18);    # WORD ADDR OF ITEM ENTRY  #
        ITEM  SRELANYFLG    B(00,37,01);    # SUBSCRIPT ANY USED       #
        ITEM  SRELBCP       U(00,38,04);    # BEGIN CHAR POSITION      #
        ITEM  SRELBWP       U(00,42,18);    # BEGIN WORD POSITION      #
        END 
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     A B O R T U S E                                                  #
#                                                                      #
#     THIS PROC IS CALLED WHENEVER A CREATE/INVOKE/USE/VERSION         #
#     DIRECTIVE IS ABORTED IN EITHER THE (5,1) OR (5,2) OVERLAY.       #
#     IT IS ALSO CALLED BY THE (5,2) *AUTOPSY* IN CASE OF A JOB ABORT. #
#     IT DOES THE FOLLOWING:                                           #
#                                                                      #
#     --- FREES ALL SCRATCH TABLES.                                    #
#     --- RETURNS THE DATA BASE PROCEDURE LIBRARY FILE, IF PRESENT.    #
#     --- CLOSES AND RETURNS THE NEW SUBSCHEMA LIBRARY FILE,           #
#         AND FREES ITS NEW AREA TABLE.                                #
#     --- FREES THE ACTIVE VERIFY LIST, IF PRESENT.                    #
#     --- CLOSES PREVIOUS SUBSCHEMA LIBRARY FILE.  RETURNS IT          #
#         IF NOT IN CDCS CATALOG MODE.                                 #
#     --- FREES ALL AREA AND RELATION TABLES.  KEEPS THE FIRST         #
#         AREA TABLE IF IN CDCS CATALOG MODE.                          #
#     --- ISSUES A CDCS -TERMINATE- IF AN -INVOKE- IS IN EFFECT.       #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC  ABORTUSE;
      PROC       ABORTUSE;
        BEGIN 
        IF VERDIR                  # IF PROCESSING *VERSION* DIRECTIVE #
        THEN
          BEGIN 
          DIAG (914);              # FATAL - USER CATALOG UNUSABLE     #
          CLOSECAT;                # CLOSE CATALOG AND CLEAR FLAGS     #
          END 
        ELSE                       # IF USE, INVOKE, OR CREATE         #
          BEGIN 
          DIAG (869);              # FATAL - DIRECTIVE REJECTED        #
          END 
                                   # FREE ALL *TAREA* TABLES           #
        IF TAREA1 NQ 0
        THEN
          BEGIN 
          CMM$FRF  (TAREA1);
          TAREA1 = 0; 
          END 
  
        IF TAREA2 NQ 0
        THEN
          BEGIN 
          CMM$FRF  (TAREA2);
          TAREA2 = 0; 
          END 
  
        IF TAREA3 NQ 0
        THEN
          BEGIN 
          CMM$FRF  (TAREA3);
          TAREA3 = 0; 
          END 
  
        IF TAREA4 NQ 0
        THEN
          BEGIN 
          CMM$FRF  (TAREA4);
          TAREA4  = 0;
          TAREA4X = 0;
          END 
  
        P<PFTABLE> = PFPTR;        # FREE TABLE OF PF PARAM CHANGES    #
        PFPTR = 0;
        FOR DUMMY1 = DUMMY1 
          WHILE P<PFTABLE> NQ 0 
        DO
          BEGIN 
          CMM$FRF (P<PFTABLE>); 
          P<PFTABLE> = PFFWD[0];
          END 
  
        IF P<SBSBUF> NQ 0 
        THEN                       # FREE PRU BUFFER                   #
          BEGIN 
          CMM$FRF (P<SBSBUF>);
          P<SBSBUF> = 0;
          END 
  
        IF SCTLPTR NQ 0 
        THEN                       # FREE ARRAY WITH SUBSCH CTL INFO   #
          BEGIN 
          CMM$FRF (SCTLPTR);
          SCTLPTR = 0;
          END 
  
        IF DBPLFN NQ 0             # IF DBP LIBRARY IS ATTACHED        #
        THEN
          BEGIN 
          RETURNM (DBPLFN, RA0);   # RETURN THE DBP LIBRARY FILE       #
          DBPLFN = 0;              # CLEAR INDICATOR FOR ATTACHED LIB  #
          END 
  
                                   #-----------------------------------#
                                   # RETURN NEW SUBSCHEMA AND FREE     #
                                   # ITS NEW AREA TABLE                #
  
        IF NEWATBL NQ 0 
        THEN                       # IF NEW SUBSCHEMA EXISTS           #
          BEGIN 
          P<AREA$TABLE> = NEWATBL; # POINT TO NEW SUBSCHEMA TABLE      #
          P<FIT> = LOC (AT$AFITPOS[0]); 
  
          IF FITOC EQ OC$OPEN      # IF THE FILE IS OPEN               #
          THEN
            BEGIN 
            CLOSEM (FIT, $DET$, RA0);  # CLOSE SUBSCHEMA               #
            END 
          IF (NOT CDCSCAT)
            OR SBSCHG 
          THEN                     # NOT THE CDCS CATALOG FILE         #
            BEGIN 
            RETURNM (FIT, RA0);    # RETURN SUBSCHEMA FILE             #
            END 
  
          CMM$FGR (AT$GROUPID[0]);  # FREE NEW SUBSCH AREA TABLE       #
          NEWATBL = 0;
          END 
  
        IF AREATBLPTR NQ 0
        THEN                       # IF AREA TABLES PRESENT            #
          BEGIN 
  
                                   #-----------------------------------#
                                   # FREE VERIFY TABLE, IF PRESENT     #
  
          IF VERAREATBL NQ 0
          THEN                     # IF ACTIVE VERIFY LIST             #
            BEGIN 
            P<AREA$TABLE> = VERAREATBL; 
            CMM$FGR (AT$VERGRPID[0]);  # RELEASE VERIFY CM             #
            VERAREATBL = 0;        # INDICATE NO ACTIVE VERIFY LIST    #
            END 
  
          P<AREA$TABLE> = AREATBLPTR; 
  
                                   #-----------------------------------#
                                   # CLOSE AND RETURN SUBSCHEMA FILE   #
  
          P<FIT> = LOC (AT$AFITPOS[0]); 
  
          IF FITOC EQ OC$OPEN      # IF THE FILE IS OPEN               #
          THEN
            BEGIN 
            IF IOFLAG EQ 1
            THEN                   # USING DIRECTORY ACCESS ROUTINES   #
              BEGIN 
              CLSESB;              # CLOSE SUBSCHEMA VIA DDL ROUTINE   #
              END 
  
            ELSE                   # WAS READING IT WITH CRM           #
              BEGIN 
              CLOSEM (FIT, $DET$, RA0); 
              END 
            END 
  
          IF NOT CDCSCAT
          THEN                     # IF NOT THE CDCS CATALOG FILE      #
            BEGIN 
            RETURNM (FIT, RA0);    # RETURN SUBSCHEMA FILE             #
            END 
  
                                   #-----------------------------------#
                                   # FREE AREA TABLES                  #
  
          IF CDCSCAT
          THEN                     # PREVIOUSLY IN CDCS CATALOG MODE   #
            BEGIN 
            THISENTRY = AT$FORWARD[0];  # SET TO KEEP ONLY THE 1ST     #
            AT$FORWARD[0] = 0;     # AREA TBL (I.E., THE SUBSCHEMA)    #
            FRARTBL (THISENTRY);   # FREE AREA AND RELATION TABLES     #
            AREATBLPTR = 0;        # -VERSBSCHPTR- STILL POINTS TO IT  #
            END 
  
          ELSE                     # NOT IN CDCS CATALOG MODE          #
            BEGIN 
            FRSUBTBL;              # FREE SUBSCHEMA TABLE              #
            FRARTBL (THISENTRY);   # FREE AREA AND RELATION TABLES     #
            END 
          END 
  
        IF INVOKED
        THEN                       # -INVOKE- IS IN EFFECT             #
          BEGIN 
IF CDCSUP THEN
          DB$END;                  # ISSUE THE -TERMINATE-             #
          INVOKED = FALSE;         # INDICATE -INVOKE- NOT IN EFFECT   #
          IF P<DBSTAT> NQ 0 
          THEN                     # FREE CDCS STATUS BLOCK            #
            BEGIN 
            CMM$FRF (P<DBSTAT>);
            P<DBSTAT> = 0;
            END 
          END 
  
        CDCSDBM = FALSE;           # TURN OFF CDCS DATABASE MODE       #
        END                        # --- ABORTUSE ---                  #
*CALL  ATTACHF
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     A U T O P S Y                                                    #
#                                                                      #
#     THIS PROC IS CALLED WHENEVER A JOB ABORT OCCURS FROM EITHER THE  #
#     (5,1) OR THE (5,2) OVERLAYS.  *ABORTUSE* IS CALLED TO CLEAN UP.  #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC  AUTOPSY; 
      PROC       AUTOPSY; 
        BEGIN 
        ABORTUSE;                  # CLOSE FILES                       #
        RETURN; 
        END                        # --- AUTOPSY ---                   #
 CONTROL EJECT; 
#----------------------------------------------------------------------#
#                                                                      #
#     B L D I N D E X                                                  #
#                                                                      #
#  THIS PROCEDURE IS USED FOR A MULTI-INDEXED FILE.                    #
#  IT WILL BUILD A STRING OF ALTERNATE KEY POSITIONS.  IF DATANAM HAS  #
#  A MAJOR ALTERNATE KEY, IT WILL USE THIS LIST TO DETERMINE THE       #
#  LENGTH OF THE ALTERNATE KEY.                                        #
#                                                                      #
#  ON A CREATE THIS PROC WILL BUILD A STRING OF ALTERNATE KEY ITEMS TO #
#  PASS TO THE PROC *CREINIT* IN THE (40-X) OVERLAYS.                  #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC  BLDINDEX; 
        BEGIN 
        ITEM DUMMY1 I;             # INDEX WITHIN LIST OF ALT KEYS     #
        ITEM THISENTRY I;          # RELATIVE POSITION OF NEXT ITEM    #
                                   # PLACE INDEX LFN INTO AREA FIT     #
        P<GIVEA>   = LOC (AREA$TABLE) + AT$INDFDB + 4;
        P<FIT> = LOC(AT$AFITPOS); 
        C<0,7>FITXN = GIVEITEMN[0]; 
        WAKEY     = AT$RECWA;      # GET ADDRESS OF FIRST ITEM ENTRY   #
        THISENTRY = 1;             # SET VALUE FOR LOOP                #
  
                                   # READ ALL OF THE ITEM ENTRIES FOR  #
                                   # THIS AREA LOOKING FOR ALTERNATE   #
                                   # KEY ITEMS                         #
        FOR DUMMY = 0  STEP 1  WHILE  THISENTRY  NQ  0  DO
          BEGIN 
          GETSB (SITEMENTY, 4, WAKEY);
          THISENTRY = SIENEXT[0];  # SAVE RELATIVE POSITION TO NEXT ONE#
  
          IF SIEALTKEYF[0]  THEN   # IS THIS ITEM AN ALTERNATE KEY     #
            BEGIN 
            IF NOT USEDIR          # IF CREATE                         #
              AND NOT RECORDFLAG   # IF NOT RECORDING                  #
            THEN
            BEGIN 
                                   # YES IT IS AN ALTERNATE KEY ITEM   #
                                   # START BUILDING THE TABLE ENTRIES  #
            IF AT$MIPPTR  EQ  0  THEN  # TEST TO SEE IF FIRST TIME     #
              BEGIN 
                                       # YES, SO INITIALIZE CMM CALLS  #
              AT$MIPID  = CMM$AGR (0); # GET THE GROUP ID AND CORE     #
              AT$MIPPTR = CMM$ALF (10, 0, AT$MIPID);
              P<GETA>   = AT$MIPPTR;   # POSITION RECEIVING ARRAY      #
              END 
            ELSE
              BEGIN 
                                       # NOT THE FIRST TIME SO LINK    #
                                       # IN THE NEXT BLOCK OF THE STR  #
              GETITEM[9] = CMM$ALF (10, 0, AT$MIPID); 
              P<GETA>    = GETITEM[9]; # POSITION TO THE NEW BLOCK     #
              END 
            GETITEM[0] = SIEBWP[0];    # BEGINING WORD POSITION        #
            GETITEM[1] = SIEBBP[0] / 6;# BEGINING CHAR POSITION        #
            GETITEM[2] = SIESIZE[0];   # SIZE OF THE ITEM              #
  
                                   # NOW WORK ON TYPE FIELD            #
            GETITEM[4] = 0;        # ASSUME SYMBOLIC                   #
            IF SIECLASS[0] GQ DT$INTEGER  # IF INT, COMP-1, FLOAT      #
              AND SIECLASS[0] LQ DT$FLOAT 
            THEN
              BEGIN 
              GETITEM[4] = 1;      # SIGNED BINARY                     #
              END 
  
            IF SIECLASS[0] EQ DT$NUM  # IF NUMERIC                     #
              AND NOT SIESIGN[0]   # IF NO SIGN OVERPUNCH              #
            THEN
              BEGIN 
              GETITEM[4] = 2;      # UNSIGNED BINARY                   #
              END 
  
                                   # NOW WORK ON INDEX SUBSTRUCTURE    #
            IF SIEALTDUP[0]  THEN  # ARE DUPLICATES ALLOWED            #
              BEGIN 
                                   # YES THEY ARE ALLOWED              #
              IF SIEALTFIRST[0]  THEN 
                BEGIN 
                GETITEM[5] = $F$;  #DUPLICATES ARE FIRST               #
                END 
              ELSE
                BEGIN 
                GETITEM[5] = $I$;  #DUPLICATES ARE INDEXED             #
                END 
              END 
            ELSE
              BEGIN 
              GETITEM[5] = $U$;    #DUPLICATES ARE UNIQUE              #
              END 
  
            IF SIEOCCDIM[0]        # IF KEY IS A DIMENSIONED OCCURRENCE#
            THEN
              BEGIN 
                                   # READ IN THE OCCURANCE WORD        #
              GETSB (SITEMOCC, 1, WAKEY + 4 + SIENAMEL[0]); 
              IF SIETYPE[0] EQ 2   # IF REPEATING GROUP                #
              THEN
                BEGIN 
                GETITEM[2] = SIESIZE[0] / SITMAXOCC[0];  # SIZE OF ITEM#
                END 
              GETITEM[6] = GETITEM[2];  # REPEATING GROUP SIZE         #
              IF SITDEPFLG[0]      # IF OCCURRENCES ARE *DEPENDING ON* #
              THEN
                BEGIN 
                GETITEM[7] = 0;    # ZERO OCCURRENCE COUNT             #
                END 
  
              ELSE
                BEGIN 
                GETITEM[7] = SITMAXOCC[0];  # SET MAX OCCURRENCE COUNT #
                END 
              END 
  
            IF SIEINOCC[0]         # IF ITEM WITHIN OCCURRING GROUP    #
            THEN
              BEGIN 
                                   # YES IT WAS FOUND                  #
                                   # READ IN THE DOMINANT ENTRY        #
              GETITEM[6] = WAKEY - SIEDOMPTR[0];  # TEMP WA OF DOM ENTY#
  
              GETSB (SITEMENTY, 4, GETITEM[6]); 
                                   # READ IN THE OCCURANCE WORD        #
              GETSB (SITEMOCC, 1, GETITEM[6] + 4 + SIENAMEL[0]);
              GETITEM[6] = SIESIZE[0] / SITMAXOCC[0]; 
              IF SITDEPFLG[0]      # IF OCCURRENCES ARE *DEPENDING ON* #
              THEN
                BEGIN 
                GETITEM[7] = 0;    # ZERO OCCURRENCE COUNT             #
                END 
  
              ELSE
                BEGIN 
                GETITEM[7] = SITMAXOCC[0];  # SET MAX OCCURRENCE COUNT #
                END 
                                   # REREAD DATA ENTRY                 #
              GETSB (SITEMENTY, 4, WAKEY);
              END 
            END 
            IF SIECLASS[0] NQ 2    # IF SYMBOLIC ALTERNATE KEY         #
            THEN
              BEGIN 
              IF AT$AKEYPPTR EQ 0  # IF FIRST SYMBOLIC ALTERNATE KEY   #
              THEN
                BEGIN 
                P<ALTKEYPOS> = CMM$ALF(10,0,AT$GROUPID);  # REQUEST    #
                                                          # 1ST BLOCK  #
                AT$AKEYPPTR = P<ALTKEYPOS>;  # SAVE PTR IN AREA TABLE  #
                DUMMY1 = 0;        # FIRST ENTRY                       #
                END 
              ELSE
                BEGIN 
                DUMMY1 = DUMMY1 + 1;  # POSITION TO NEXT ENTRY         #
                IF DUMMY1 EQ 9     # IF LAST ENTRY IN BLOCK            #
                THEN
                  BEGIN 
                  AK$FULLWORD[9] =  # REQUEST NEXT BLOCK               #
                      CMM$ALF(10, 0, AT$GROUPID); 
                  P<ALTKEYPOS> = AK$FULLWORD[9];  #POSITION TO NEXT BLK#
                  DUMMY1 = 0;      # FIRST ENTRY                       #
                  END 
                END 
              AK$BWP[DUMMY1] = SIEBWP[0];  # SAVE WORD POSITION        #
              AK$BCP[DUMMY1] = SIEBBP[0] / 6;  # SAVE CHARACTER POS    #
            IF SIEOCCDIM[0]        # IF DIMENSIONED OCCURRENCE         #
              THEN
                BEGIN 
                                   # READ OCCURRENCE WORD              #
                GETSB (SITEMOCC, 1, WAKEY + 4 + SIENAMEL[0]); 
                AK$SIZE[DUMMY1] = SIESIZE[0] / SITMAXOCC[0];  # SIZE OF#
                                                              # ITEM   #
                END 
              ELSE
                BEGIN 
                AK$SIZE[DUMMY1] = SIESIZE[0];  # SAVE SIZE OF ALT KEY  #
                END 
              END 
            END 
          WAKEY = WAKEY + THISENTRY;  # UPDATE TO NEXT ENTRY IN STRING #
          END 
        END                        # --- BLDINDEX ---                  #
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     B U I L D T A B L E                                              #
#                                                                      #
#     THIS PROC BUILDS ONE AREA TABLE ENTRY AND ADDS IT TO THE         #
#     AREA TABLE CHAIN.  IF A TABLE ALREADY EXISTS FOR THIS AREA,      #
#     ANOTHER ONE IS NOT BUILT.                                        #
#                                                                      #
#     INPUT: TEMPWA = WORD ADDRESS OF AREA ENTRY.                      #
#                                                                      #
#     OUTPUT: RC = 0 IF EVERYTHING WENT OK.                            #
#                " 0 IF AN ERROR OCCURRED.                             #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC  BUILDTABLE; 
        BEGIN 
        RC = 0;                    # SET THE RETURN CODE TO O.K.       #
        WAKEY = TEMPWA;            # SET KEY TO CORRECT POSITION       #
                                   # READ THE AREA HEADER              #
        GETSB (SAREAHEAD, 6, WAKEY);
                                   # TEST TO SEE IF AREA ALREADY IN    #
                                   # THE STRING OF AREAS               #
        P<AREA$TABLE> = AREATBLPTR; 
        LASTENTRY = AT$FORWARD;    # INITIALIZE  LOOP FORWARD PTR      #
        FOR DUMMY = 0  WHILE LASTENTRY  NQ  0  DO 
          BEGIN 
          LASTENTRY = AT$FORWARD;  # UPDATE FOR LOOP FORWARD PTR       #
                                   # TEST TO SEE IF AN ENTRY FOR THIS  #
                                   # AREA HAS ALREADY BEEN BUILT       #
          IF  AT$AREAWA  EQ  WAKEY  THEN
            BEGIN 
                                   # AREA IS ALREADY IN THE STRING     #
                                   # SET THIS PATH BIT IN ITS ENTRY    #
            AT$PATHFLAGS = AT$PATHFLAGS  LOR  CURPATHFLG; 
                                   # SET POINTER TO THE ENTRY          #
            THISENTRY    = P<AREA$TABLE>; 
            RETURN; 
            END 
  
          P<AREA$TABLE> = AT$FORWARD;    # TEST THE NEXT ENTRY         #
          END 
CONTROL EJECT;   #  B U I L D T A B L E   # 
  
        NBRAREAS = NBRAREAS + 1;   # ONE MORE AREA IN USE              #
        IF NBRAREAS GR NBRAREASALLD  # IF TOO MANY AREAS               #
        THEN
          BEGIN 
          DIAG (372);              # TOO MANY AREAS IN USE             #
          RC = 1; 
          RETURN; 
          END 
                                   # GET THE CORE FOR THIS AREA ENTRY  #
        TGROUPID  = CMM$AGR (0);   # GET GROUP ID OF THIS AREA         #
        THISENTRY = CMM$ALF (MAXATBLSIZE, 2, TGROUPID); 
                                   # NOW SCAN DOWN THE LIST OF AREA    #
                                   # TABLE ENTRIES TO LINK THIS ONE    #
                                   # AT THE END OF THE LIST.           #
                                   # POSITION TO THE FIRST ENTRY IN    #
                                   # THE STRING                        #
        P<AREA$TABLE> = AREATBLPTR; 
                                   # SCAN DOWN THE STRING TILL LAST ONE#
        FOR DUMMY = 0  WHILE AT$FORWARD  NQ  0   DO 
          BEGIN 
          P<AREA$TABLE> = AT$FORWARD; 
          END 
  
                                   # HAVE FOUND THE LAST ENTRY OF THE  #
                                   # CURRENT STRING                    #
        AT$FORWARD = THISENTRY;    # LINK IN THIS ENTRY                #
        LASTENTRY = P<AREA$TABLE>;  # SAVE POSITION FOR BACK POINTER   #
        P<AREA$TABLE> = THISENTRY; # POSITION TO THE NEW ENTRY         #
        AT$BACKWARD   = LASTENTRY; # PLACE BACK POINTER IN TABLE       #
        AT$GROUPID    = TGROUPID;  # SAVE THE GROUP ID                 #
        AT$NEXTFREE = MINATBLSIZE; #POINT TO END OF MIN AREA TABLE     #
        AT$RECWA = SAHRECWA[0];    # SET RECORD INFO WORD ADDRESS      #
                                   # SET THE FLAG BIT FOR THIS RELATION#
        AT$PATHFLAGS = AT$PATHFLAGS + CURPATHFLG; 
        AT$AREAWA = TEMPWA;        # SAVE WA OF AREA ENTRY             #
CONTROL EJECT;   #  B U I L D T A B L E   # 
                                   #-----------------------------------#
                                   # NOW START MOVING INFORMATION INTO #
                                   # THE NEW AREA TABLE ENTRY          #
                                   # CHECK TO SEE IF THE AREA IS A     #
                                   # TEMPORARY ONE                     #
        IF SAHTEMPAREA[0]   THEN
          BEGIN 
          AT$TEMPA = TRUE;         # SET THE TEMPORART BIT FLAG        #
          END 
  
        IF SAHDUPS[0] EQ 1 THEN    # IF *DUPLICATES ARE FIRST*         #
          BEGIN 
          AT$DUPFIRST = TRUE;      # *DUPLICATES ARE FIRST*            #
          END 
  
        AT$SORTSEQ = SAHSORTSEQ[0];  # SET SORT SEQUENTIAL FLAG        #
        AT$SSQDESC = SAHSSQDESC[0];  # SET SORT SEQ. DESCENDING FLAG   #
                                   # MOVE THE FDB OF THE AREA          #
        P<GIVEA> = TAREA1;         # POSITION THE ARRAYS               #
        P<GETA > = LOC(AT$AFDBPOS); 
                                   # TEST TO SEE IF AN AREA            #
                                   # WITH  OR  WITHOUT PERMANENT  FILE #
                                   # PARAMETERS   OR  RELATION  GIVEN  #
        IF   TAREA1       NQ  0 
         AND GIVEITEM[4]  NQ  0   THEN
          BEGIN 
                                   # IT WAS A USE AREA REQUEST         #
                                   # GET THE INFORMATION FROM THE      #
                                   # TABLE THAT WAS BUILT BY OVERLAY 15#
            IF  AT$TEMPA   THEN 
              BEGIN 
              LOOPDONE = 4;        # TEMP AREA MOVE NAME AND LFN ONLY  #
              END 
            ELSE
              BEGIN 
              LOOPDONE = FDBSIZE - 1;  # PERM. AREA   MOVE ENTIRE FDB  #
              END 
  
                                   # MOVE THE INFORMATION TO THE NEW   #
                                   # AREA TABLE ENTRY                  #
            FOR DUMMY = 0  STEP 1  UNTIL LOOPDONE  DO 
              BEGIN 
              GETITEM[DUMMY] = GIVEITEM[DUMMY]; 
              END 
          END 
        ELSE
          BEGIN 
                                   # NOT TEMPORARY AND USER DID NOT    #
                                   # GIVE ANY PERMANENT FILE PARAMETER #
                                   # THEREFORE THEY MUST BE IN THE     #
                                   # SUB-SCHEMA -- IF NOT, THE SYSTEM  #
                                   # DEFAULTS WILL BE USED             #
          IF SAHAFDBWAR[0]  EQ  0  THEN 
            BEGIN 
                                   # POSITION TO AREA NAME IN SUBSCHEMA#
            P<GIVEA> = LOC(SAHNAME[0]); 
                                   # BUILD FDB CONTAINING AREA NAME ONL#
                                   # MOVE AREA PF NAME INTO TABLE      #
            FOR DUMMY = 0 STEP 1 UNTIL SAHNAMELNG[0] -1 DO
              BEGIN 
              GETITEM[DUMMY] = GIVEITEM[DUMMY]; 
              END 
                                   # REPLACE BLANK WITH 0 IN LAST WORD #
            FOR DUMMY = 0 STEP 6 UNTIL 54 DO
              BEGIN 
              IF B<DUMMY,6>GETITEM[SAHNAMELNG[0]-1] EQ O"55" THEN 
                BEGIN 
                B<DUMMY,6>GETITEM[SAHNAMELNG[0]-1] = 0; 
                END 
              END 
                                   # INSERT LOCAL FILE NAME            #
            B<0,42>GETITEM[4] = B<0,42>GETITEM[0];
            P<GIVEA> = LOC(AT$AFDBPOS);  # POSITION GIVEITEM[4] TO LFN #
            END 
          ELSE
          BEGIN 
                                   # COMPUTE WORD ADDRESS OF THE FDB   #
          WAKEY = TEMPWA + SAHAFDBWAR[0]; 
                                   # READ THE PERMANENT FILE PRAMS     #
          GETSB (GETA, 15, WAKEY);
          P<GIVEA> = LOC(AT$AFDBPOS); 
          P<CHANGES> = P<GIVEA>;   # SET POINTER TO THE FDB            #
          ZEROUNUSED;              # ZERO OUT UNUSED WORDS IN FDB      #
  
 CONTROL IFEQ OS$NAME,NOS;
  
          NOS$FORMAT;              # PUT PF PARAMS IN SPECIAL NOS      #
                                   # FDB FORMAT                        #
  
 CONTROL ENDIF; 
  
          END 
          END 
CONTROL EJECT;   #  B U I L D T A B L E   # 
                                   #-----------------------------------#
                                   # NOW READ THE FIT FROM THE         #
                                   # SUB-SCHEMA INTO THE NEW AREA TBL  #
        P<GETA > = LOC(AT$AFITPOS); # POSITION ARRAY TO READ WITH      #
                                   # COMPUTE WORD ADDRESS OF THE FIT   #
        WAKEY = TEMPWA + SAHFITWAR[0];
                                   # READ THE FIT                      #
        GETSB (GETA, LFIT, WAKEY);
                                   # NOW PLACE THE LFN INTO THE FIT    #
        P<GETA>           = LOC (AT$AFITPOS); 
        B<0,42>GETITEM[0] = B<0,42>GIVEITEM[4];   # PICK UP LFN        #
CONTROL EJECT;   #  B U I L D T A B L E   # 
                                   #-----------------------------------#
                                   # NOW START WORK ON THE INDEX FILE  #
        IF TAREA2  NQ  0           # TEST TO SEE IF EATHER INDEX GIVEN #
        OR SAHMIBIT[0]   THEN      # OR INDEX FILE REQUIRED            #
          BEGIN 
                                   # YES, SOMETHING TO DO WITH INDEX   #
          IF NOT SAHMIBIT[0]  THEN # TEST TO SEE IF SUB-SCHEMA HAS IT  #
            BEGIN 
                                   # USER TYPED ONE IN, BUT            #
            DIAG (226);            # THE SUB-SCHEMA DOES NOT HAVE      #
            RETURN; 
            END 
  
                                   # IF INDEX GIVEN IN USE OR CREATE,  #
                                   # THEN WE DONT GO TO THE SUBSCHEMA  #
                                   # TO GET PF PARAMS FOR INDEX IF:    #
                                   #   1)  THIS IS A CREATE...OR       #
                                   #   2)  THIS IS A USE WITH A PF     #
                                   #       PARAM LIST SPECIFIED, WHICH #
                                   #       MAY BE EMPTY.               #
          IF TAREA2 NQ 0
            AND ((NOT USEDIR)      # IF CREATE                         #
              OR (USEDIR AND INDEX$PFP)  # IF USE, PF PARAM LIST       #
              OR (USEDIR AND AT$TEMPA))  # IF USE OF TEMPORARY AREA    #
          THEN
            BEGIN 
            IF AT$TEMPA  THEN 
              BEGIN 
              LOOPDONE = 4;        # IF TEMP AREA ONLY MOVE NAME + LFN #
              END 
            ELSE
              BEGIN 
              LOOPDONE = FDBSIZE - 1;  # PERM. AREA   MOVE ENTIRE FDB  #
              END 
                                   # COMPUTE POSITION OF FDB IN TABLE  #
            AT$INDFDB = AT$NEXTFREE;  # SET POINTER TO INDEX FDB       #
                                   # UPDATE NEXTFREE POINTER           #
            AT$NEXTFREE = AT$NEXTFREE + LOOPDONE + 1; 
                                   # NOW MOVE THE FDB FROM USER INPUT  #
            P<GETA > = LOC(AREA$TABLE) + AT$INDFDB; 
            P<GIVEA> = TAREA2;
            FOR DUMMY = 0  STEP 1  UNTIL LOOPDONE  DO 
              BEGIN 
              GETITEM[DUMMY] = GIVEITEM[DUMMY]; 
              END 
            CMM$FRF (TAREA2);      # GIVE BACK THE CORE OF THE TEMP TBL#
            TAREA2 = 0; 
            END 
          ELSE
            BEGIN 
                                   # GET THE FDB FROM THE SUB-SCHEMA   #
                                   # GET THE WORD ADDRESS OF THE FDB   #
            IF SAHIFDBWAR[0] EQ 0 THEN  # IF NO FDB IN SUBSCHEMA       #
              BEGIN 
              DIAG(852);           # INDEX FILE NOT SPECIFIED          #
              RC = 1; 
              RETURN; 
              END 
            WAKEY = TEMPWA + SAHIFDBWAR[0]; 
                                   # COMPUTE POSITION IN THE NEW TABLE #
            AT$INDFDB = AT$NEXTFREE;  # SET POINTER TO INDEX FDB       #
                                   # UPDATE THE NEXTFREE POINTER       #
            AT$NEXTFREE = AT$NEXTFREE + FDBSIZE;
            P<GETA > = LOC(AREA$TABLE) + AT$INDFDB; 
                                   # READ FROM THE SUB-SCHEMA THE FDB  #
            GETSB (GETA, 15, WAKEY);
            P<CHANGES> = P<GETA>;  # ZERO OUT THE UNUSED WORDS         #
            ZEROUNUSED;            # IN THE 15 WORD FDB                #
  
 CONTROL IFEQ OS$NAME,NOS;
  
            NOS$FORMAT;            # PUT PF PARAMS IN SPECIAL NOS      #
                                   # FDB FORMAT                        #
  
 CONTROL ENDIF; 
  
            END 
          END 
CONTROL EJECT;   #  B U I L D T A B L E   # 
                                   #-----------------------------------#
                                   # NOW WORK ON THE LOGFILE           #
                                   # SET LOG FLAGS TO NOT PRESENT      #
        AT$LOGB = FALSE;
        AT$LOGA = FALSE;
        AT$LOGT = FALSE;
                                   # TEST TO SEE IF A LOG FILE IS      #
                                   # REQUIRED                          #
        IF SAHLOGWAR[0]  NQ  0  THEN
          BEGIN 
                                   # YES THERE IS A LOG FILE           #
                                   # IN THE SUBSCHEMA                  #
          P<GETA> = CMM$ALF(LFIT, 0, AT$GROUPID); 
          AT$FITLOG = P<GETA>;
          P<GIVEA> = LOC(AT$AFITPOS); 
          FOR WORD = 0 STEP 1 
             UNTIL LFIT - 1 
          DO
            BEGIN 
            GETITEM[WORD] = GIVEITEM[WORD];  # COPY FIT FOR LOGGING    #
            END 
          P<FIT> = P<GETA>; 
          FITPD = PD$IO;           # SET PROCESSING DIRECTION TO I-O   #
          AT$LOGFDB = AT$NEXTFREE; # SET POINTER TO ITS POSITION       #
                                   # UPDATE THE NEXTFREE POINTER       #
          AT$NEXTFREE = AT$NEXTFREE + FDBSIZE;
                                   # NOW READ THE LOGFILE INFO         #
          WAKEY = TEMPWA + SAHLOGWAR[0];
          GETSB (SLOGINFO, 12, WAKEY);
          AT$LOGB = SLOGBEF[0];    # NOW SET THE FLAGS IN THE          #
          AT$LOGA = SLOGAFT[0];    # NEW AREA TABLE                    #
          AT$LOGT = SLOGTRN[0]; 
  
                                   # NOW WORK TO BUILD THE FDB         #
          P<GETA > = LOC(AREA$TABLE) + AT$LOGFDB; 
          P<GIVEA> = LOC(SLOGNAME[0]);
          FOR  WORD  = 0  STEP 1  UNTIL SLOGNAMELNG[0] - 1  DO
            BEGIN 
            FOR BIT = 0  STEP 6  UNTIL  54  DO
              BEGIN 
              IF B<BIT,6> GIVEITEM[WORD]  NQ  O"55"  THEN 
                BEGIN 
                B<BIT,6>GETITEM[WORD] = B<BIT,6>GIVEITEM[WORD]; 
                END 
              ELSE
                BEGIN 
                                   # FIRST BLANK FOUND EXIT FROM MOVES #
                WORD = WORD + 1;
                TEST WORD;
                END 
              END 
            END 
  
                                   # NOW MOVE THE LFN                  #
          B<0,42>GETITEM[4] = B<0,42>GETITEM[0];
                                   # NOW WORK ON THE PASS WORDS        #
          P<GIVEA> = P<GIVEA> + SLOGNAMELNG[0]; 
          P<CHANGES> = P<GETA>;    # START OF LOG FDB                  #
          P<GETA > = P<GETA > + 5;
          FOR WORD = 0  STEP 1  WHILE  GIVEITEM[WORD]  NQ  0  DO
            BEGIN 
            GETITEM[WORD] = GIVEITEM[WORD]; 
            END 
  
 CONTROL IFEQ OS$NAME,NOS;
  
          NOS$FORMAT;              # PUT PF PARAMS IN SPECIAL NOS      #
                                   # FDB FORMAT                        #
  
 CONTROL ENDIF; 
  
          END 
CONTROL EJECT;   #  B U I L D T A B L E   # 
                                   #-----------------------------------#
                                   # NOW PROCESS THE DATA BASE         #
                                   # PROCEDURES IF PRESENT             #
                                   # ALSO SDA HASH OWNCODES            #
        IF SAHONWAR[0] NQ 0        # IF DBP-S EXIST                    #
          OR SAHSDAWAR[0] NQ 0     # OR SDA HASH OWNCODES EXIST        #
        THEN
          BEGIN 
          AT$DBPROC = AT$NEXTFREE; # SET POINTER TO ITS POSITION       #
                                   # UPDATE THE NEXTFREE POINTER       #
          AT$NEXTFREE = AT$NEXTFREE + ON"ENDLIST" + 1;
          P<GETA > = LOC(AREA$TABLE) + AT$DBPROC; 
          GETITEM[0] = DBPLFN;     # INSERT LFN OF LIBRARY             #
  
  
                                   # DATA BASE PROCEDURES ARE PRESENT  #
                                   # BUILD THE LIST OF NAMES           #
        IF SAHONWAR[0] NQ 0        # IF DBP-S EXIST                    #
        THEN
          BEGIN 
                                   # NOW READ THE DATA BASE PROC INFO  #
          WAKEY = TEMPWA + SAHONWAR[0]; 
          GETSB (SDBPINFO, 7, WAKEY); 
                                   # NOW MOVE AND POSITION THE NAMES   #
                                   # INTO THE NEW TABLE                #
          MORE = TRUE;             # SET THE FLAG TO TRUE              #
          FOR WORD = 0  STEP 1  WHILE MORE  DO
            BEGIN 
            MORE = SDBPMORE[WORD]; # MORE INFORMATION FLAG             #
                                   # TEST THE FLAGS IN EACH ENTRY TO   #
                                   # FIND ITS POSITION IN THE NEW TBL  #
            IF SDBPDIS[WORD]  THEN
              BEGIN 
              GETITEMN[ON"DISPLAY"]  = SDBPNAME[WORD];
              END 
  
            IF SDBPMAT[WORD]  THEN
              BEGIN 
              GETITEMN[ON"MATCH"]    = SDBPNAME[WORD];
              END 
  
            IF SDBPMIS[WORD]  THEN
              BEGIN 
              GETITEMN[ON"MISMATCH"] = SDBPNAME[WORD];
              END 
  
            IF SDBPRET[WORD] THEN 
              BEGIN 
              GETITEMN[ON"RETRIEVAL"] = SDBPNAME[WORD]; 
              END 
  
            IF SDBPOPN[WORD]  THEN
              BEGIN 
              GETITEMN[ON"OPEN"]     = SDBPNAME[WORD];
              END 
  
            IF SDBPCLS[WORD]  THEN
              BEGIN 
              GETITEMN[ON"CLOSE"]    = SDBPNAME[WORD];
              END 
  
            IF SDBPUPD[WORD]  THEN
              BEGIN 
              GETITEMN[ON"UPDATE"]   = SDBPNAME[WORD];
              AT$DBPUPD = TRUE;    # FLAG FOR EXISTENCE OF UPDATE EXIT #
              END 
  
            IF SDBPSCH[WORD]  THEN
              BEGIN 
              GETITEMN[ON"SEARCH"]   = SDBPNAME[WORD];
              AT$DBPSRH = TRUE;    # FLAG FOR EXISTENCE OF SEARCH EXIT #
              END 
          END 
            END 
                                   # NOW CHECK FOR SDAHASH ROUTINES    #
                                   # TO BE LOADED                      #
            IF SAHSDAWAR[0]  NQ  0  THEN
              BEGIN 
                                   # YES, FETCH THE NAME               #
              WAKEY = TEMPWA + SAHSDAWAR[0];
              GETSB (SDBPINFO, 1, WAKEY); 
                                   # PLACE THE NAME IN THE LIST        #
              GETITEMN[ON"SDAHASH"] = SDBPNAME[0];
            END 
          END 
CONTROL EJECT;   #  B U I L D T A B L E   # 
                                   # NOW WORK ON THE COLLATING SEQUENCE#
                                   # IT IS A REQUIRED PART OF THE TABLE#
        AT$COLSEQ = AT$NEXTFREE;
        AT$NEXTFREE = AT$NEXTFREE + 8;
        P<GETA > = LOC(AREA$TABLE) + AT$COLSEQ; 
                                   # TEST TO SEE IF ONE OF THE DEFAULT #
                                   # COLLATING SEQUENCES SHOULD BE USED#
        IF SAHCOLWAR[0]  EQ  0  THEN
          BEGIN 
                                   # YES A DEFAULT IS TO BE USED       #
          IF SAHFTNCOL[0]  THEN 
            BEGIN 
            P<GIVEA> = LOC(FORTCOL); # USE DEFAULT FORTRAN             #
            END 
          ELSE
            BEGIN 
            P<GIVEA> = LOC(COBCOL); # USE DEFAULT COBOL                #
            END 
  
                                   # MOVE THE COLLATING TABLE TO AREA  #
          FOR DUMMY = 0  STEP 1  UNTIL 7  DO
            BEGIN 
            GETITEM[DUMMY] = GIVEITEM[DUMMY]; 
            END 
          END 
        ELSE
                                   # TO BE USED BY THIS AREA           #
                                   # THE SUB-SCHEMA HAS THE SEQUENCE   #
          BEGIN 
          WAKEY = TEMPWA + SAHCOLWAR[0];
          GETSB (SCOLINFO, 8, WAKEY); 
          FOR DUMMY = 0  STEP 1  UNTIL 7  DO
            BEGIN 
            GETITEM[DUMMY] = $HIGHVALUE$; 
            END 
                                   # POSITION TO CHARACTER STRING      #
          P<GIVEA> = LOC(SCOLINFO) + 1; 
#                                                                      #
#              NOW BUILD THE COLLATING SEQUENCE TABLE                  #
#           FORMATTED BY DISPLAY CODE VALUE POSITIONING                #
#                                                                      #
          IF SCOLSIZE[0] EQ 0      # KLUGE TO DETERMINE IF 64 CHAR     #
            AND SCOLWORDS[0] EQ 7  # COLLATING SEQUENCE SUBMITTED      #
          THEN
            BEGIN 
            SCOLSIZE[0] = 63;      # SET CHARACTER COUNT TO 64         #
            END 
          ELSE
            BEGIN 
            SCOLSIZE[0] = SCOLSIZE[0] - 1; # SET CHARACTER COUNT       #
            END 
          FOR DUMMY = 0 STEP 1
            UNTIL SCOLSIZE[0] 
          DO
            BEGIN 
            CHAR = C<DUMMY,1>GIVECHAR;
            HIGH = B<54,3>CHAR; 
            LOW  = B<57,3>CHAR; 
            C<LOW,1>GETITEM[HIGH] = DUMMY;
            END 
          END 
CONTROL EJECT;   #  B U I L D T A B L E   # 
                                   #-----------------------------------#
                                   # NOW READ IN THE HASH TABLE        #
                                   # COMPUTE THE WA OF HASH TABLE IN   #
                                   # THE SU-SCHEMA                     #
  
        WAKEY = TEMPWA + SAHHASHWAR[0]; 
                                   # READ IN THE FIRST WORD OF THE     #
                                   # HASH TABLE WHICH IS THE LENGTH    #
        GETSB (THISNAMEA, 1, WAKEY);
        HASHSIZE = THISNAI[0] + 10;  # HASH TBL HAS 10 EXTRA WORDS     #
                                   # NOW GET THE CORE  AND SET THE     #
                                   # POINTER TO IT                     #
        AT$HASHLOC = CMM$ALF (HASHSIZE, 0, AT$GROUPID); 
        P<GETA> = AT$HASHLOC;      # POSITION ARRAY TO READ INTO       #
        SIZE = 51;                 # MAXIMUM READ SIZE                 #
                                   # READ IN THE HASH TABLE IN         #
                                   # 51 WORD BLOCKS                    #
        FOR HASHSIZE = HASHSIZE STEP -51
          WHILE HASHSIZE GR 0 
        DO
          BEGIN 
          IF HASHSIZE LS SIZE 
          THEN                     # SET SIZE OF LAST READ             #
            BEGIN 
            SIZE = HASHSIZE;
            END 
  
          GETSB (GETA, SIZE, WAKEY);
                                   # UPDATE THE POINTERS FOR THE       #
          WAKEY = WAKEY + 51;      # NEXT READ OF THE SUB-SCHEMA       #
          P<GETA> = P<GETA> + 51; 
          END 
  
CONTROL EJECT;   # B U I L D T A B L E   #
        IF AT$INDFDB NQ 0          # IF MIP FILE                       #
        THEN
          BEGIN 
          BLDINDEX;                # BUILD STRING OF ALTERNATE KEY     #
                                   # POSITIONS.  IF CREATE AND NOT     #
                                   # RECORDING, BUILD RMKDEF STRING    #
          END 
        IF NOT USEDIR AND          # IF A CREATE AND                   #
           NOT RECORDFLAG THEN     # IF NOT RECORDING                  #
          BEGIN 
                                   # YES -CREATE- IS THE CURRENT DIREC #
          MUST40X = TRUE;          # MUST EXIT THRU THE 40-X OVERLAYS  #
  
                                   # IF OPERATING SYSTEM IS SCOPE      #
                                   # REQUEST FILES TO PERMANENT DEVICES#
CONTROL IFEQ  OS$NAME,SCOPE;
                                   # POSITION TO PICK UP LFN OF AREA   #
          P<SCHEMAFDB> = LOC (AT$AFDBPOS) + 4;
          REQPF (SCHEMAFDB, DUMMY); 
CONTROL ENDIF;
  
                                   # NOW TEST FOR A MIP FILE           #
                                   # INDEX FILE PRESENT                #
          IF AT$INDFDB  NQ  0  THEN 
            BEGIN 
  
CONTROL IFEQ  OS$NAME,SCOPE;
                                   # INDEX FILE SO MAKE REQPF REQUEST  #
            P<SCHEMAFDB> = LOC (AREA$TABLE) + AT$INDFDB + 4;
            REQPF (SCHEMAFDB, DUMMY); 
CONTROL ENDIF;
  
            END 
          END 
  
        P<FIT> = LOC(AT$AFITPOS);  # LOCATE FIT TO CORRECT DDL DEFAULTS#
        FITEFC = 3;                # ERRORS AND NOTES TO ERROR FILE    #
  
        IF FITFO EQ FOSQ           # IF A SEQUENTIAL FILE              #
          AND FITBFS EQ 0          # IF WE SHOULD USE DEFAULT          #
        THEN
          BEGIN 
          FITBFS = O"1001";        # USE 101B INSTEAD OF DEFAULT OF 101#
          END 
        END                        # ---- BUILDTABLE ---               #
*CALL CLCAT 
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     C L O S E C A T                                                  #
#                                                                      #
#     *CLOSECAT* IS CALLED TO ENSURE THE INTEGRITY OF THE CRM CATALOG  #
#     FILE BEFORE PROCESSING A NEW *VERSION* DIRECTIVE (*UNCUV*) OR    #
#     DURING CLEAN-UP OF AN ERROR ON A *VERSION* (*ABORTUSE*).  IT     #
#     CALLS *CLCAT* TO CLOSE THE CATALOG FILE AND CLEARS OUT ALL FLAGS #
#     AND FIT FIELDS PERTAINING TO THE CATALOG FILE.                   #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC CLOSECAT;
      BEGIN 
        CLCAT;                     # CLOSE OLD CATALOG FILE            #
        MODCAT = FALSE;            # CATALOG NOT MODIFIED SINCE CLOSE  #
        IF PFCATAL
        THEN                       # IF CATALOG FILE PERMANENT         #
          BEGIN 
          RETURNM (CATAFIT, RA0);  # RETURN OLD CATALOG FILE           #
          PFCATAL = FALSE;         # INDICATE NOT PERMANENT            #
          END 
  
        P<FIT> = LOC (CATAFIT);    # POINT TO CATALOG FIT              #
        FITES = 0;                 # CLEAR ERROR STATUS                #
        FITFNF = FALSE;            # CLEAR FATAL ERROR FLAG            #
        FITOC = 0;                 # NEVER OPENED                      #
        FITPD = 0;                 # PROCESSING DIRECTION              #
        FITBN = 0;                 # BLOCK NUMBER                      #
        FITFP = 0;                 # FILE POSITION                     #
        FITLOP = 0;                # LAST OPERATION                    #
        FITCDT = 0;                # COLLATING TO DISPLAY TABLE        #
        FITDCT = 0;                # DISPLAY TO COLLATING TABLE        #
        FITHRL = 0;                # HASHING ROUTINE ADDRESS           #
      END 
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     C O M P W D S                                                    #
#                                                                      #
#     THIS PROC COMPARES TWO NAMES THAT ARE THREE WORDS LONG,          #
#     LEFT JUSTIFIED, BLANK FILLED.                                    #
#                                                                      #
#     INPUT: ARRAYS *THISNAME* AND *GIVEA* CONTAIN THE 2 NAMES.        #
#                                                                      #
#     OUTPUT: RC = 0 IF NAMES MATCH.                                   #
#             RC " 0 IF NAMES DO NOT MATCH.                            #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC  COMPWDS;
  
        BEGIN 
        RC = 0;                    # SET GOOD COMPARE FLAG             #
        FOR DUMMY = 0 STEP 1
          UNTIL 2 
        DO
          BEGIN 
          IF THISNAME[DUMMY]  NQ  GIVEITEM[DUMMY] 
          THEN
            BEGIN 
            RC = 1;                # SET BAD COMPARE FLAG              #
            RETURN; 
            END 
          END 
        END                        # --- COMPWDS ---                   #
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     E N D U S E                                                      #
#                                                                      #
#     THIS IS CALLED AT THE END OF THE MAIN FLOW OF *USECRM* TO DO     #
#     THOSE THINGS THAT ARE THE SAME FOR ALL CASES:                    #
#                                                                      #
#     -- CALL *CHGFDB* TO PROCESS ANY PF PARAM CHANGES.                #
#     -- LOAD DATABASE PROCEDURES, IF ANY.                             #
#     -- CLOSE THE SUBSCHEMA FILE VIA THE DIRECTORY ACCESS             #
#        ROUTINES, AND RE-OPEN IT USING *SCHEMAFIT*.                   #
#     -- CALL *BGTABLE* FOR EACH AREA FILE.                            #
#     -- SHRINK THE AREA TABLE TO THE MINIMUM SIZE NEEDED.             #
#     -- CLOSE THE SUBSCHEMA.                                          #
#     -- FREE UNNEEDED BLOCKS.                                         #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC ENDUSE;
      BEGIN 
      IF PFPTR NQ 0 
      THEN                         # MAKE CHANGES TO PF PARAMS         #
        BEGIN 
        P<PFTABLE> = PFPTR;        # POINT TO 1ST *PFTABLE*            #
        FOR DUMMY1 = DUMMY1        # LOOP THROUGH ALL ENTRIES          #
          WHILE P<PFTABLE> NQ 0 
        DO
          BEGIN 
                                   # CHANGE PARAMETERS FOR THIS ENTRY  #
          CHGFDB (P<PFTABLE>, AREATBLPTR, RC);
          IF RC NQ 0
          THEN                     # ERROR OCCURRED                    #
            BEGIN 
            RETURN; 
            END 
  
          P<PFTABLE> = PFFWD[0];   # ADVANCE TO NEXT ENTRY             #
          END 
  
        P<PFTABLE> = PFPTR;        # DONE - FREE ALL ENTRIES           #
        FOR DUMMY1 = DUMMY1 
          WHILE P<PFTABLE> NQ 0 
        DO
          BEGIN 
          PFPTR = PFFWD[0];        # GET POINTER TO NEXT ENTRY         #
          CMM$FRF (P<PFTABLE>);    # FREE SPACE FOR THIS ENTRY         #
          P<PFTABLE> = PFPTR;      # SET POINTER TO NEXT               #
          END 
  
        END 
  
      DBP$LOD (RC);                # LOAD DATABASE PROCEDURES          #
      IF DBPLFN NQ 0
      THEN                         # IF DBP LIBRARY IS ATTACHED        #
        BEGIN 
        RETURNM (DBPLFN, RA0);     # RETURN IT                         #
        DBPLFN = 0;                # INDICATE IT AS RETURNED           #
        END 
  
      IF RC NQ 0
      THEN                         # IF UNSUCCESSFUL DBP LOAD          #
        BEGIN 
        RETURN; 
        END 
  
      CLSESB;                      # CLOSE SUBSCHEMA LIBRARY FILE      #
                                   # OPEN IT USING *SCHEMAFIT*         #
      OPENM (SCHEMAFIT, $INPUT$, RA0);
      RC = SCHFITES[0];            # CHECK RETURN CODE                 #
      IF RC NQ 0
      THEN
        BEGIN 
        DIAG (903, RC, SCHEMAFIT);
        RETURN; 
        END 
  
      P<AREA$TABLE> = AREATBLPTR;  # SUBSCHEMA AREA TABLE              #
      FOR DUMMY1 = 0               # LOOP THRU ALL REMAINING AREA TBLS #
        WHILE AT$FORWARD[0] NQ 0
      DO
        BEGIN 
        P<AREA$TABLE> = AT$FORWARD[0];  # NEXT AREA TABLE              #
        TAREA4X = P<AREA$TABLE>;   # SET POINTER USED BY *BGTABLE*     #
        BGTABLE;                   # BUILD BACKGROUND TABLE            #
                                   # SHRINK AREA TABLE TO SIZE NEEDED  #
        CMM$SLF (P<AREA$TABLE>, MAXATBLSIZE - AT$NEXTFREE[0]);
        END 
  
                                   # CLOSE SUBSCHEMA LIBRARY FILE      #
      CLOSEM (SCHEMAFIT, $DET$, RA0); 
      CMM$FRF (SCTLPTR);           # FREE BLOCK WITH SUBSCH CTL INFO   #
      SCTLPTR = 0;
      RETURN;                      # ALL DONE                          #
      END                          # --- ENDUSE ---                    #
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     F I N D A R E A                                                  #
#                                                                      #
#     THIS PROC SEARCHES THE SUBSCHEMA FOR A GIVEN AREA NAME.          #
#                                                                      #
#     INPUT: *TAREA1* CONTAINS THE NAME OF THE AREA.                   #
#                                                                      #
#     OUTPUT: TEMPWA = WA OF AREA ENTRY.                               #
#                    = 0 IF AREA NOT FOUND.                            #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC  FINDAREA; 
        BEGIN 
        P<GIVEA> = TAREA1;         # FIRST CONVERT NAME TO BLANK FILL  #
        ZERO2BLANK;                # FROM ZERO FILL                    #
  
                                   # READ THE AREA INDEX(S) ONE AT A   #
                                   # TIME AND COMPARE TO THE REQUESTED #
                                   # AREA NAME.                        #
        WAKEY = SAREAWA[0];        # SET WA TO FIRST ENTRY IN LIST     #
  
        FOR TOTALWDS = 0
          WHILE TOTALWDS LS SAREALNG[0] 
        DO
          BEGIN 
          IF (SAREALNG[0] - TOTALWDS) GQ 4  # IF AT LEAST 4 WORDS LEFT #
          THEN
            BEGIN 
            AINDXLNG= 4;           # READ 4 WORDS                      #
            END 
          ELSE                     # LESS THAN 4 WORDS LEFT            #
            BEGIN 
                                   # READ REMAINING WORDS              #
            AINDXLNG = SAREALNG[0] - TOTALWDS;
            END 
                                   # READ AREA INDEX ENTRY             #
          GETSB (SAREAINDX, AINDXLNG, WAKEY); 
                                   # READ WAS GOOD, COMPARE THE NAME   #
          FOR DUMMY = 1  STEP 1  UNTIL SANAMELNG[0]   DO
            BEGIN 
            IF SANAME[DUMMY]  NQ  THISNAME[DUMMY-1]   THEN
              BEGIN 
                                   # NAMES DO NOT MATCH                #
                                   # SET UP TO READ NEXT ENTRY         #
                                   # POINT TO NEXT ENTRY IN LIST       #
              WAKEY = WAKEY+SANAMELNG[0]+1; 
                                   # UPDATE THE NUMBER OF WORDS READ   #
              TOTALWDS = TOTALWDS + SANAMELNG[0] + 1; 
              TEST TOTALWDS;       # DO ANOTHER READ IF MORE INFO LEFT #
              END 
            END 
                                   # THE AREA NAME HAS BEEN FOUND      #
          TEMPWA = SAWORDADD[0];   # SAVE WORD ADD OF THE AREA ENTRY   #
          RETURN; 
  
          END 
                                   # NO MATCH FOUND IN THE SUB-SCHEMA  #
        TEMPWA = 0;                # SET TO ZERO  - NO MATCH -         #
        END                        # --- FINDAREA ---                  #
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     F I N D R E L A                                                  #
#                                                                      #
#     THIS PROC SEARCHES THE SUBSCHEMA FOR A GIVEN RELATION NAME.      #
#                                                                      #
#     INPUT: TAREA4X = POINTER TO RELATION NAME.                       #
#                                                                      #
#     OUTPUT: TEMPWA = WA OF RELATION IN SUBSCHEMA.                    #
#                    = 0 IF RELATION NOT FOUND.                        #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC  FINDRELA; 
        BEGIN 
        P<GIVEA> = TAREA4X;        # FIRST CONVERT NAME TO BLANK FILL  #
        ZERO2BLANK;                # FROM ZERO FILL                    #
  
                                   # READ THE AREA INDEX(S) ONE AT A   #
                                   # TIME AND COMPARE TO THE REQUESTED #
                                   # AREA NAME.                        #
        WAKEY = SRELWA[0];         # SET WA TO FIRST ENTRY IN LIST     #
  
        FOR TOTALWDS = 0  WHILE TOTALWDS  LQ  SRELALNG[0]  DO 
          BEGIN 
                                   # READ 40 CHARACTERS OF INFO        #
          GETSB (SRELATINDX, 4, WAKEY); 
                                   # READ WAS GOOD, COMPARE THE NAME   #
          FOR DUMMY = 1  STEP 1  UNTIL SRNAMELNG[0]   DO
            BEGIN 
            IF SRNAME[DUMMY]  NQ  THISNAME[DUMMY-1]   THEN
              BEGIN 
                                   # NAMES DO NOT MATCH                #
                                   # SET UP TO READ NEXT ENTRY         #
                                   # POINT TO NEXT ENTRY IN LIST       #
              WAKEY = WAKEY+SRNAMELNG[0]+1; 
                                   # UPDATE THE NUMBER OF WORDS READ   #
              TOTALWDS = WAKEY - SRELWA[0] + 1; 
              TEST TOTALWDS;       # DO ANOTHER READ IF MORE INFO LEFT #
              END 
            END 
                                   # THE AREA NAME HAS BEEN FOUND      #
  
          TEMPWA = SRWORDADD[0];   # SAVE WORD ADD OF RELATION ENTRY   #
          RETURN; 
  
          END 
                                   # NO MATCH FOUND IN THE SUB-SCHEMA  #
        TEMPWA = 0;                # SET TO ZERO  NO MATCH FOUND       #
        END                        # --- FINDRELA ---                  #
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     F R A R T B L                                                    #
#                                                                      #
#     THIS PROC FREES THE REMAINING AREA TABLES POINTED TO BY          #
#     *FWDPTR*.  THEN IT FREES ANY RELATION TABLES PRESENT.            #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC FRARTBL (FWDPTR);
        BEGIN 
        ITEM  FWDPTR U; 
  
        FOR DUMMY = 0 
          WHILE FWDPTR NQ 0 
        DO                         # STEP THRU AREA TABLES             #
          BEGIN 
          P<AREA$TABLE> = FWDPTR;  # POSITION TO TABLE                 #
          FWDPTR = AT$FORWARD;     # SAVE POINTER TO NEXT TABLE        #
          P<FIT> = LOC (AT$AFITPOS);
          IF CDCSDBM
            AND FITOC EQ OC$OPEN
            AND NOT ABORTED 
          THEN                     # IF AREA WAS LEFT OPEN (BY CDCS)   #
            BEGIN 
IF CDCSUP THEN
                                   # CDCS CLOSE FILE                   #
            DB$CLS (FIT, AT$AREAORD[0]);
            END 
  
          IF AT$MIPID NQ 0
          THEN                     # IF A MIP ALTERNATE KEY INFO       #
                                   # STRING WAS ALLOCATED              #
            BEGIN 
            CMM$FGR (AT$MIPID);    # FREE IT                           #
            END 
  
          CMM$FGR (AT$GROUPID);    # FREE AREA TABLE                   #
          END 
  
        FWDPTR = RELATBLPTR;       # FREE ALL RELATION TABLES          #
        RELATBLPTR = 0; 
        VIAPOINT = 0;              # RESET LAST -VIA-                  #
        FOR DUMMY = 0 
          WHILE FWDPTR NQ 0 
        DO                         # STEP THRU RELATION TABLES         #
          BEGIN 
          P<REL$TABLE> = FWDPTR;   # POSITION TO TABLE                 #
          FWDPTR = RT$FORWARD;     # SAVE POINTER TO NEXT TABLE        #
          LASTENTRY = P<REL$TABLE>;  # SAVE ADR OF LAST REL TABLE      #
          CMM$FGR (RT$GROUPID);    # FREE RELATION TABLE               #
          END 
  
        RETURN; 
        END                        # --- FRARTBL ---                   #
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     F R S U B T B L                                                  #
#                                                                      #
#     THIS PROC FREES THE FIRST AREATABLE IN THE CHAIN, WHICH          #
#     IS THE TABLE FOR THE SUBSCHEMA.                                  #
#                                                                      #
#     INPUT:  P<AREA$TABLE> SET TO SUBSCHEMA AREA TABLE.               #
#                                                                      #
#     OUTPUT:  *THISENTRY* POINTS TO NEXT AREA TABLE AFTER             #
#              SUBSCHEMA (MAY = 0).                                    #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC FRSUBTBL;
        BEGIN 
        THISENTRY = AT$FORWARD;    # SAVE FORWARD POINTER              #
        CMM$FGR (AT$GROUPID);      # FREE SUBSCHEMA ENTRY              #
        AREATBLPTR = 0;            # DO THIS ONLY TO KEEP IT CLEAN     #
        UPDATEAREA = FALSE;        # DISCARD LAST UPDATE AREA          #
        TARGETAREA = 0; 
        VIAPOINT = 0;              # DISCARD LAST VIA                  #
        RETURN; 
        END                        # --- FRSUBTBL ---                  #
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     G E T S B                                                        #
#                                                                      #
#     *GETSB* IS CALLED TO READ WORDS FROM A SUBSCHEMA WHICH MAY       #
#     BE EITHER PART OF A CRM SUBSCHEMA LIBRARY OR A SINGLE SUBSCHEMA. #
#                                                                      #
#     INPUT: SBSCADD - BEGINNING WA OF SUBSCHEMA.                      #
#            PARAMETERS TO BE PASSED DIRECTLY TO *DDLRDSB*.            #
#                                                                      #
#     OUTPUT: *DDLRDSB* HAS BEEN CALLED AND DATA IS IN WSA.            #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC GETSB (WSA, WDCT, WA); 
      BEGIN 
      ITEM  WA I;                  # WORD ADDRESS OF READ              #
      ITEM  WDCT I;                # NUMBER OF WORDS TO READ           #
      ITEM  WSA I;                 # WORKING STORAGE ADDRESS           #
  
      ITEM  WATEMP I;              # TEMPORARY                         #
  
      WATEMP = WA + SBSCADD;       # ABSOLUTE WA                       #
      DDLRDSB (WSA, WDCT, WATEMP); # READ SUBSCHEMA DATA               #
      RETURN; 
      END                          # --- GETSB ---                     #
CONTROL EJECT;
CONTROL IFEQ OS$NAME,NOS; 
  
#----------------------------------------------------------------------#
#                                                                      #
#     N O S $ F O R M A T                                              #
#                                                                      #
#     THIS PROC CONVERTS THE PF PARAMS PROVIDED BY DDL IN THE FDB      #
#     TO THE FORMAT USED BY NOS.                                       #
#                                                                      #
#     INPUT:   P<CHANGES> = LOC (FDB)                                  #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC      NOS$FORMAT; 
      BEGIN 
  
      XREF FUNC LJUST U;     # LEFT JUSTIFY FDB PF PARAMETER           #
      ITEM TEMP$UN;                # TO HOLD USER NUMBER PF PARAM WORD #
      ITEM TEMP$PW;                # TO HOLD PASSWORD    PF PARAM WORD #
      ITEM TEMP$M;                 # TO HOLD MODE        PF PARAM WORD #
      ITEM TEMP$PN;                # TO HOLD PACKNAME    PF PARAM WORD #
      ITEM TEMP$R;                 # TO HOLD R           PF PARAM WORD #
  
                                   # ZERO OUT TEMP. PF PARAM. WORDS    #
      TEMP$UN = 0;
      TEMP$PW = 0;
      TEMP$M  = 0;
      TEMP$PN = 0;
      TEMP$R = 0; 
  
                                   # STEP THRU FDB PARAM LIST (WHICH   #
                                   # IS NOW IN NOS/BE FORMAT) AND PICK #
                                   # UP PF PARAMS.                     #
      FOR DUMMY2 = 5 STEP 1        # FOR EACH FDB PARAMETER WORD       #
      WHILE DUMMY2 LS FDBSIZE - 1  # WHILE NOT AT END OF FDB           #
        AND PRAMWORD[DUMMY2] NQ 0  # AND NOT PAST LAST PARAMETER       #
      DO
        BEGIN 
        WORD = PRAMKEY[DUMMY2];    # MOVE TO TEMP. ITEM TO AVOID       #
                                   # REPEATED EXTRACTIONS              #
        IF WORD EQ $DDLUN$ THEN    # IF USER NUMBER...                 #
          BEGIN 
          TEMP$UN = PRAMWORD[DUMMY2];  # SAVE USER NUMBER              #
          END 
        IF WORD LQ $DDLPWH$ AND WORD GQ $DDLPWL$ THEN  # IF PASSWORD...#
          BEGIN 
          TEMP$PW = PRAMWORD[DUMMY2];  # SAVE PASS WORD                #
          END 
        IF WORD EQ $DDLM$ THEN     # IF MODE...                        #
          BEGIN 
          TEMP$M  = PRAMWORD[DUMMY2];  # SAVE MODE                     #
          END 
        IF WORD EQ $DDLPN$ THEN    # IF PACK NAME...                   #
          BEGIN 
          TEMP$PN = PRAMWORD[DUMMY2];  # SAVE PACK NAME                #
          END 
        IF WORD EQ $DDLR$ THEN     # IF R . . .                        #
          BEGIN 
          TEMP$R = PRAMWORD[DUMMY2]; # SAVE R PARAMETER                #
          END 
        END 
                                   # REFORMAT FDB PF PARAM LIST INTO   #
                                   # SPECIAL NOS FORMAT.               #
      PRAMWORD[$FDBUN$] = LJUST(TEMP$UN);  # RESTORE USER NUMBER LEFT  #
                                           # JUSTIFIED                 #
      PRAMWORD[$FDBPW$] = LJUST(TEMP$PW);  # RESTORE PASS WORD LEFT    #
                                           # JUSTIFIED                 #
      PRAMWORD[$FDBM$]  = TEMP$M;  # RESTORE MODE                      #
      IF TEMP$M NQ 0 THEN          # IF MODE GIVEN . . .               #
        BEGIN 
                                   # BIAS NEEDED FOR ATTACH TO WORK    #
        PRAMVALUE[$FDBM$] = PRAMVALUE[$FDBM$] + O"40";
        END 
      PRAMWORD[$FDBPN$] = TEMP$PN; # RESTORE PACK NAME                 #
      PRAMWORD[$FDBR$] = TEMP$R;   # RESTORE R PARAMETER               #
  
      END                          # --- NOS$FORMAT ---                #
  
CONTROL ENDIF;
*CALL  PFDIAG 
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     P R O C R E L E N T R Y                                          #
#                                                                      #
#     THIS PROC BUILDS A RELATION TABLE AND ALSO CALLS                 #
#     *BUILDTABLE* TO BUILD THE ASSOCIATED AREA TABLES, IF NECESSARY.  #
#                                                                      #
#     INPUT: TEMPWA = WA OF THE SUBSCHEMA RELATION ENTRY.              #
#                                                                      #
#     OUTPUT: RC = 0 IF ALL WENT OK.                                   #
#                " 0 IF ERROR OCCURRED.                                #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC  PROCRELENTRY; 
        BEGIN 
        ITEM M I;                  # INDEX WITHIN LIST OF SYMBOLIC     #
                                   # ALTERNATE KEYS                    #
        ITEM LOOPCON B;            # LOOP CONTROL                      #
        RC = 0;                    # SET RETURN CODE TO GOOD BUILD     #
        NBRRELS = NBRRELS + 1;     # ONE MORE RELATION IN USE          #
        IF NBRRELS GR 59           # IF MORE THAN 59 RELATIONS         #
        THEN
          BEGIN 
          DIAG (373);              # MOVE THAN 59 RELATIONS IN USE     #
          RC = 1; 
          RETURN; 
          END 
        WAKEY = TEMPWA;            # WA OF RELATION ENTRY              #
                                   # READ THE SUB-SCHEMA ENTRY FOR     #
                                   # LENGTH OF ENTRY                   #
        GETSB (SRELHEAD, 1, WAKEY); 
                                   # NOW COMPUTE CORE SIZE FOR TABLES  #
                                   # AND TEMP INPUT BUFFER             #
        SIZE = SRELRANKS[0] * 2 * RANKSIZE + 9; 
        RGROUPID = CMM$AGR(0);     # ALLOCATE GROUP ID FOR RELATION    #
        IF RELATBLPTR  EQ  0  THEN # TEST TO SEE IF FIRST ENTRY OF TBL #
          BEGIN 
                                   # YES THIS IS THE FIRST ONE         #
          RELATBLPTR = CMM$ALF(SIZE, 0, RGROUPID);
          P<REL$TABLE> = RELATBLPTR;
          END 
        ELSE
          BEGIN 
                                   # THIS IS NOT THE FIRST TIME SO     #
                                   # PLACE THIS ENTRY AT THE END OF    #
                                   # THE CURRENT STRING                #
          P<REL$TABLE> = RELATBLPTR;
          FOR DUMMY = 0  WHILE  RT$FORWARD  NQ  0  DO 
            BEGIN 
            P<REL$TABLE> = RT$FORWARD;   # POSITION TO NEXT ENTRY      #
            END 
  
          THISENTRY = CMM$ALF(SIZE, 0, RGROUPID); 
          RT$FORWARD = THISENTRY;     # UPDATE FORWARD PTR TO NEW ENTRY#
          LASTENTRY  = P<REL$TABLE>;  # SAVE POSITION OF PREVIOUS ENTRY#
          P<REL$TABLE> = THISENTRY;    # POSITION TO THE NEW ENTRY     #
          RT$BACKWARD  = LASTENTRY;   # PLACE LINK TO THE PREVIOUS ENTY#
          END 
  
                                   # NOW COMPUTE CORE SIZE TO READ THE #
                                   # RELATION ENTRY INTO               #
                                   # COMPUTE SIZE OF NEW RELATION TABLE#
        SIZE = SRELRANKS[0] * 2 + 1;
                                   # GET THE CORE FOR THIS ENTRY       #
        TEMPBUFPTR = CMM$ALF (SIZE, 0, 0);
        P<SRELENTY>= TEMPBUFPTR;
                                   # READ THE SUB-SCHEMA RELATION ENTRY#
        GETSB (SRELENTY, SIZE, WAKEY);
                                   # NOW START BUILDING THE RELATION TB#
        RT$PATHBIT = CURPATHCNT;   # SET IN THIS PATH BIT NUMBER       #
        RT$NORANKS = SRELRANKS[0]; # SET IN NUMBER OF RANKS            #
        RT$NOREST  = SRELRESTNO[0]; # SET IN NUMBER OF RESTRICT CLAUSES#
        RT$GROUPID = RGROUPID;     # CMM GROUP ID                      #
  
                                   # NOW WORK ON THE NAME              #
                                   # BLANK OUT ALL FOUR WORDS FIRST    #
        P<GETA> = LOC(RT$RELNAME); # POSITION TO THE RELATION NAME AREA#
        FOR DUMMY = 0  STEP 1  UNTIL 3  DO
          BEGIN 
          GETITEM[DUMMY] = $BLANKS$;
          END 
                                   # NOW MOVE THE RELATION NAME        #
        FOR DUMMY = 1  STEP 1  UNTIL  SRNAMELNG[0]   DO 
          BEGIN 
          GETITEM[DUMMY-1] = SRNAME[DUMMY]; 
          END 
  
        P<SRELENTY> = P<SRELENTY> + 1; # POINT TO 1ST WORD OF RANK INFO#
        P<REL$RANKINFO> = LOC(RT$RANKPOS);
  
                                   # NOW STEP THRU THE SUB-SCHEMA      #
                                   # RELATION ENTRIES BUILDING THE     #
                                   # NEW JOIN TABLE                    #
        FOR DUMMY1 = 0  STEP 1  UNTIL  SRELRANKS[0] * 2 - 1  DO 
          BEGIN 
          TEMPWA = SRELAWA[0];     # GET WORD ADDRESS OF AREA ENTRY    #
          BUILDTABLE;              # BUILD THE AREA TABLE ENTRY        #
          IF RC  NQ  0  THEN
            BEGIN 
            RETURN; 
            END 
  
                                   # BUILD OF TABLE WAS GOOD           #
          RR$AREAPTR = THISENTRY;  # SET POINTER TO AREA TABLE         #
          WAKEY = SRELIWA;         # SET TO READ ITEM INFO             #
          GETSB (SITEMENTY, 4, WAKEY);
                                   # HAVE THE JOIN ITEM SUB-SCHEMA     #
                                   # INFORMATION IN CORE.  MOVE SOME   #
                                   # SELECTED FIELDS TO NEW TABLE      #
          RR$ITEMWA = SRELIWA[0];  # MOVE ITEM WORD ADDRESS            #
          RR$KEY    = SIEKEYFLAG[0];   # MOVE ITEM KEY FLAG            #
          RR$ALTKEY = SIEALTKEYF[0];   # MOVE ITEM ALT KEY             #
          RR$ALTDUP = SIEALTDUP[0];    # MOVE ALT DUPS ALLOWED         #
          RR$ALT1ST = SIEALTFIRST[0];  # MOVE 1ST ALT KEY              #
          RR$ANYFLG = SRELANYFLG[0];   # MOVE SUBSCRIPT ANY            #
          RR$CLASS  = SIECLASS[0];     # MOVE ITEM CLASS/TYPE          #
          RR$BCP    = SRELBCP[0];      # MOVE ITEM BEGIN CHAR POSITION #
          RR$BWP    = SRELBWP[0];      # MOVE ITEM BEGIN WORD POSITION #
          IF SIEOCCDIM[0]          # IF A DIMENSIONED OCCURRENCE       #
            AND (SIETYPE[0] EQ 2   # REPEATING GROUP                   #
              OR SIETYPE[0] EQ 3)  # REPEAT GROUP WITHIN REPEAT GROUP  #
          THEN
            BEGIN 
                                   # READ OCCURRENCE WORD              #
            GETSB (SITEMOCC, 1, WAKEY + 4 + SIENAMEL[0]); 
            RR$LENGTH = SIESIZE[0] / SITMAXOCC[0];  # SIZE OF ITEM     #
            END 
          ELSE
            BEGIN 
            RR$LENGTH = SIESIZE[0];  # MOVE ITEM LENGTH IN CHARS       #
            END 
  
          IF NOT SIEALTKEYF[0]     # IF NOT ALTERNATE KEY              #
            AND SIEMAJKFLG[0]      # IF MAJOR KEY                      #
          THEN
            BEGIN 
            P<FIT> = LOC(AT$AFITPOS);  # POSN TO FIT FOR THIS AREA     #
            IF AT$FITFO EQ FOIS    # IF *IS* FILE                      #
              AND FITKT LQ 1       # IF SYMBOLIC KEY                   #
              AND SIEBWP[0] EQ FITRKW    # IF SAME WORD                #
              AND SIEBBP[0]/6 EQ FITRKP  # IF SAME CHARACTER           #
            THEN
              BEGIN 
              IF SIESIZE[0] EQ FITKL   # IF SAME LENGTH                #
              THEN
                BEGIN 
                RR$KEY = TRUE;     # MAJOR KEY IS REALLY PRIMARY KEY   #
                END 
              ELSE
                BEGIN 
                RR$PMAJKEY = 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; 
                    END 
  
                  IF SIEBWP[0] EQ AK$BWP[M]  # IF SAME WORD            #
                    AND SIEBBP[0] / 6 EQ AK$BCP[M]  # IF SAME CHARACTER#
                  THEN
                    BEGIN 
                    RR$AMAJKEY = TRUE;  # MAJOR ALTERNATE KEY          #
                    RR$AKSIZE = AK$SIZE[M];  # SAVE SIZE OF ALT KEY    #
                    LOOPCON = FALSE;  # EXIT LOOP                      #
                    END 
                  ELSE             # IF NOT MAJOR OF THIS ALT 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 
  
          IF RR$ALTKEY             # IF ALTERNATE KEY                  #
            OR RR$AMAJKEY          # IF ALTERNATE MAJOR KEY            #
          THEN
            BEGIN 
            RR$AKBWP = SIEBWP[0];  # BEG WORD POSITION OF ITEM(1), IN  #
                                   # CASE THIS IS SUBSCRIPTED ITEM     #
            RR$AKBCP = SIEBBP[0] / 6;  # BEG CHAR POSITION OF ITEM(1)  #
            LOOPCON = TRUE;        # LOOP CONTROL                      #
            FOR DUMMY = DUMMY 
              WHILE LOOPCON 
            DO
              BEGIN 
              IF SIEINOCC[0]       # IF WITHIN AN OCCURRING GROUP      #
                OR SIEOCCDIM[0]    # IF A DIMENSIONED OCCURRENCE       #
              THEN
                BEGIN 
                RR$AKSUBN = TRUE;  # JOINED ON ITEM(N) OR ITEM(ANY)    #
                LOOPCON = FALSE;   # EXIT LOOP                         #
                TEST DUMMY; 
                END 
  
              WAKEY = WAKEY - SIEDOMPTR[0];  # ADDR OF DOMINANT ENTRY  #
              GETSB (SITEMENTY, 4, WAKEY);
              IF SIETYPE[0] EQ 7   # IF RECORD ENTRY                   #
              THEN
                BEGIN 
                LOOPCON = FALSE;   # END OF SEARCH, EXIT LOOP          #
                END 
              END 
            END 
  
  
                                   # THIS ENTRY HAS BEEN BUILD         #
                                   # UPDATE TO NEXT RANK INFO          #
          P<SRELENTY>     = P<SRELENTY> + 1;
          P<REL$RANKINFO> = P<REL$RANKINFO> + RANKSIZE; 
          END 
  
        CMM$FRF (TEMPBUFPTR);      # GIVE BACK THE CORE USED AS        #
                                   # A TEMPORARY INPUT BUFFER          #
  
  
                                   # NOW WORK ON THE RESTRICT CLAUSE   #
                                   # IF IT IS PRESENT                  #
        IF SRELRESTWA[0]  NQ  0  THEN 
          BEGIN 
                                   # THERE IS A RESTRICT CLAUSE PRESENT#
                                   # SET UP TO READ EACH RESTRICT      #
                                   # ENTRY TO COMPUTE THE NUMBER       #
                                   # OF WORD REQUIRED TO READ ALL ENTYS#
          SIZE  = 0;               # CLEAR TOTAL WORD                  #
          WAKEY = SRELRESTWA[0];   # BEGINNING WA OF RESTRICTS         #
          FOR DUMMY = 0 STEP 1
          UNTIL SRELRESTNO[0] - 1 
          DO
            BEGIN 
                                   # READ ONLY THE FIRST WORD OF EACH  #
                                   # RESTRICT ENTRY                    #
            GETSB (SRESTENTY, 1, WAKEY);
                                   # UPDATE TOTAL WORDS REQUIRED       #
            SIZE  = SIZE + SRESTLNG[0] + 1; 
                                   # UPDATE THE WORD ADDRESS KEY       #
            WAKEY = WAKEY + SRESTLNG[0] + 1;
            END 
  
                                   # GET CORE FOR THE ENTIRE RESTRICT  #
          RT$RESTPTR = CMM$ALF(SIZE, 0, RGROUPID);
          P<GETA>    = RT$RESTPTR;     # POSITION ARRAY FOR INPUT      #
          WAKEY = SRELRESTWA[0];   # RESET TO FIRST ENTRY              #
                                   # READ ENTIRE RESTRICT ENTRY        #
          GETSB (GETA, SIZE, WAKEY);
          END 
        END                        # --- PROCRELENTRY ---              #
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     U N C U V                                                        #
#                                                                      #
#     THIS PROC CLEANS UP THE PREVIOUS CREATE/INVOKE/USE/VERSION       #
#     BY THE FOLLOWING STEPS:                                          #
#                                                                      #
#     IF THE NEW DIRECTIVE IS OTHER THAN -VERSION-:                    #
#                                                                      #
#     --- ISSUES ERROR IF IN CDCS CATALOG MODE, SINCE TO DO            #
#         OTHERWISE IMPLIES A DIFFERENT SUBSCHEMA, WHICH IS ILLEGAL.   #
#     --- FREES ACTIVE VERIFY LIST, IF PRESENT.                        #
#     --- CLOSES AND RETURNS PREVIOUS SUBSCHEMA LIBRARY FILE,          #
#         IF DIFFERENT THAN THE NEW ONE.                               #
#     --- FREES ALL AREA AND RELATION TABLES.                          #
#     --- ISSUES A CDCS -TERMINATE- IF AN -INVOKE- IS IN EFFECT.       #
#                                                                      #
#     IF THE NEW DIRECTIVE IS -VERSION-:                               #
#                                                                      #
#     --- IF CDCS CATALOG MODE, BUT NOT CDCS DATABASE MODE,            #
#         THE SUBSCHEMA LIBRARY FILE IS CLOSED AND RETURNED,           #
#         A -TERMINATE- IS ISSUED TO CDCS, AND THE CATALOG             #
#         TABLE IS FREED.                                              #
#     --- IF CRM CATALOG MODE, THE CATALOG FILE IS CLOSED              #
#         (VIA *CLCAT*), AND RETURNED.                                 #
#     --- FIELDS IN THE CATALOG FILE FIT ARE RE-INITIALIZED.           #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC UNCUV; 
      BEGIN 
      RC = 0;                      # INDICATE NO ERROR                 #
      IF NOT VERDIR 
      THEN                         # -CREATE-, -INVOKE-, OR -USE-      #
        BEGIN 
        IF CDCSCAT
        THEN                       # CDCS CATALOG IN EFFECT - ERROR    #
          BEGIN 
                                   # NEED SUBSCHEMA NAME FOR DIAG      #
          P<AREA$TABLE> = NEWATBL;
          P<GIVEA> = P<AREA$TABLE> + AT$SBSCNAME[0];
          DIAG (406, GIVEITEM[0]);
          RC = 1;                  # SET ERROR RETURN                  #
          RETURN; 
          END 
  
        IF VERAREATBL NQ 0         # IF ACTIVE VERIFY LIST             #
        THEN
          BEGIN 
          P<AREA$TABLE> = VERAREATBL;  # POSITION AREATABLE            #
          CMM$FGR(AT$VERGRPID);    # RELEASE VERIFY CM                 #
          VERAREATBL = 0;          # INDICATE NO ACTIVE VERIFY LIST    #
          END 
  
        IF AREATBLPTR NQ 0
        THEN                       # IF A USE IS IN EFFECT             #
          BEGIN 
          P<AREA$TABLE> = AREATBLPTR;  # POSITION TO SUBSCHEMA FIT     #
          P<FIT> = LOC(AT$AFITPOS); 
          IF CDCSDBM
            OR (SBSCHG             # IF DIFFERENT SUBSCHEMA FILE       #
              AND NOT SAMELFN)     # AND OLD FILE NOT ALREADY RETURNED #
          THEN                     # EITHER ANY CDCS USE OR A CRM USE  #
                                   # WITH A DIFFERENT SUBSCHEMA        #
            BEGIN 
            IF FITOC EQ OC$OPEN 
            THEN                   # IF SUBSCHEMA OPEN                 #
              BEGIN 
              CLOSEM (FIT, $DET$, RA0);  # CLOSE, RELEASE BUFFERS      #
              END 
  
            RETURNM (FIT, RA0);    # RETURN SUBSCHEMA FILE             #
            END 
  
          FRSUBTBL;                # FREE SUBSCHEMA TABLE              #
          FRARTBL (THISENTRY);     # FREE AREA AND RELATION TABLES     #
          END 
  
        IF CDCSDBM
        THEN                       # CDCS USE IN EFFECT                #
          BEGIN 
          IF INVOKED
          THEN                     # -INVOKE- IS IN EFFECT             #
            BEGIN 
IF CDCSUP THEN
            DB$END;                # CDCS -TERMINATE-                  #
            INVOKED = FALSE;       # INDICATE NO -INVOKE- IN EFFECT    #
            IF P<DBSTAT> NQ 0 
            THEN                   # FREE CDCS STATUS BLOCK            #
              BEGIN 
              CMM$FRF (P<DBSTAT>);
              P<DBSTAT> = 0;
              END 
            END 
          END 
  
        IF DBP$FWA NQ 0 
        THEN                       # IF DATABASE PROCEDURES IN CORE    #
          BEGIN 
          CMM$FRF (DBP$FWA);       # FREE THE LOADED AREA.             #
          DBP$FWA = 0;             # CLEAR THE POINTER TO LOADED DBP-S #
          END 
        END 
  
      ELSE                         # -VERSION- DIRECTIVE               #
        BEGIN 
        IF CDCSCAT
        THEN                       # IF CDCS -VERSION-                 #
          BEGIN 
          IF NOT CDCSDBM
          THEN                     # IF NOT CDCS DATABASE MODE         #
            BEGIN 
            P<AREA$TABLE> = VERSBSCHPTR;
            P<FIT> = LOC (AT$AFITPOS);
            IF FITOC EQ OC$OPEN 
            THEN                   # CLOSE SUBSCHEMA FILE              #
              BEGIN 
              CLOSEM (FIT, $DET$, RA0); 
              END 
  
            RETURNM (FIT, RA0);    # RETURN SUBSCHEMA FILE             #
            IF INVOKED
            THEN                   # -INVOKE- IS IN EFFECT             #
              BEGIN 
IF CDCSUP THEN
              DB$END;              # ISSUE -TERMINATE-                 #
              INVOKED = FALSE;
              IF P<DBSTAT> NQ 0 
              THEN                 # FREE DATABASE STATUS BLOCK        #
                BEGIN 
                CMM$FRF (P<DBSTAT>);
                P<DBSTAT> = 0;
                END 
              END 
  
            FRSUBTBL;              # FREE SUBSCHEMA TABLE              #
            END 
  
          VERSBSCHPTR = 0;         # INDICATE NO CATALOG SUBSCH TABLE  #
          CMM$FRF (CATBLPTR);      # FREE CATALOG TABLE                #
          CATBLPTR = 0; 
          RETURN; 
          END 
  
                                   # CRM -VERSION-                     #
        CLOSECAT;                  # CLOSE OLD CATALOG FILE AND CLEAR  #
                                   # CATALOG AND FIT FLAGS             #
        END 
  
      RETURN;                      # ALL DONE                          #
      END                          # --- UNCUV ---                     #
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     V E R S E X                                                      #
#                                                                      #
#     THIS PROC GETS THE CATALOG FILE FOR A CRM -VERSION-              #
#     DIRECTIVE.  IT CONSISTS OF THE *OPENDEF* AND *VERSEX*            #
#     ROUTINES THAT WERE PREVIOUSLY IN *CUVSYN*.  NOTE THAT            #
#     *CLOSECAT* IS NOT CALLED HERE BECAUSE THE CLEANING UP OF THE     #
#     PREVIOUS CATALOG FILE HAS ALREADY BEEN HANDLED IN *UNCUV*.       #
#                                                                      #
#     INPUT: TAREA1 NZ - CONTAINS FDB FOR THE CATALOG FILE.            #
#            TAREA1 ZR - VERSION IS DEFAULT.                           #
#                                                                      #
#     OUTPUT: RC = ZR IF NO ERROR OCCURRED.                            #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC  VERSEX; 
      BEGIN 
      RC = 0;                      # SET FOR ERROR-FREE RETURN         #
      CDCSCAT = FALSE;             # SET CRM CATALOG MODE              #
      P<FIT> = LOC (CATAFIT); 
      IF TAREA1 EQ 0
      THEN                         # VERSION IS DEFAULT                #
        BEGIN 
        C<0,7>FITLFN = "ZZZZZQ2";  # SET DEFAULT FILE NAME             #
        FITOC = 0;                 # NEVER OPENED                      #
        FITORG = TRUE;             # ORG = NEW                         #
        FITPD[0] = 0;              # PROCESSING DIRECTION              #
        PERMI = TRUE;              # DEFAULT ALWAYS HAS PERMISSIONS    #
        VERSTL = MXTRNLG;          # SET TL TO MAXIMUM                 #
        PFCATAL = FALSE;           # CATALOG FILE NOT PERMANENT        #
        END 
  
      ELSE                         # CRM -VERSION-                     #
        BEGIN 
        P<GIVEA> = TAREA1;         # POINT TO CATALOG FILE FDB         #
                                   # ATTACH THE CATALOG FILE           #
        ATTACHF (GIVEA, FALSE, RC); 
        IF RC NQ 0
        THEN                       # ERROR ON ATTACH                   #
          BEGIN 
          RETURN; 
          END 
  
                                   # CHECK PERMISSION BITS             #
        IF B<48,2>GIVEITEM[4] EQ 3
        THEN                       # HAVE PERMISSIONS                  #
          BEGIN 
          PERMI = TRUE; 
          END 
  
        ELSE                       # DO NOT HAVE PERMISSIONS           #
          BEGIN 
          PERMI = FALSE;
          END 
  
        C<0,7>FITLFN = "ZZZZZQ3";  # SET CATALOG LFN                   #
        PFCATAL = TRUE;            # CATALOG FILE IS PERMANENT         #
        CMM$FRF (TAREA1);          # RETURN THE CATALOG FDB            #
        TAREA1 = 0; 
        FITOC[0] = 0;              # INDICATE NEVER OPENED             #
        FITORG = TRUE;             # FORCE ORG = NEW                   #
        FITPD[0] = 0;              # PROCESSING DIRECTION              #
        OPNCAT (FIT, PD$INPUT, RC);  # TRY TO OPEN WITH ORG = NEW      #
                                   # AND PD = I/O, BUT PASS PD$INPUT   #
                                   # IN CASE CATALOG MUST BE OPENED    #
                                   # WITH ORG = OLD AND PD = INPUT     #
                                   # RC SET NZ IF CATALOG NOT OPENED   #
        END 
  
      RETURN; 
      END                          # --- VERSEX ---                    #
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     Z E R O U N U S E D                                              #
#                                                                      #
#     THIS PROC ZEROES OUT THE UNUSED WORDS IN AN FDB.                 #
#                                                                      #
#     INPUT: P<CHANGES> = LOC FDB                                      #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC      ZEROUNUSED; 
        BEGIN 
        MORE = TRUE;               # SET MORE INFORMATION FLAG         #
        FOR DUMMY2 = 5 STEP 1      # FOR EACH FDB PARAMETER WORD       #
        UNTIL FDBSIZE - 1          # UNTIL END OF FDB                  #
        DO
          BEGIN 
          IF MORE  THEN            # HAS THE LAST GOOD PARAMETER       #
                                   # BEEN FOUND YET                    #
            BEGIN 
            IF PRAMKEY[DUMMY2]  EQ  0  THEN   # TEST TO SEE IF END OF  #
                                              # THE PARAMETER LIST     #
              BEGIN 
              MORE = FALSE;        # YES, THIS IS LAST ENTRY           #
              PRAMWORD[DUMMY2] = 0;  # ZERO OUT THE LAST ENTRY FIRST   #
              END 
            END 
          ELSE
            BEGIN 
            PRAMWORD[DUMMY2] = 0;    # END OF LIST WAS FOUND           #
                                     # ZERO OUT THE REST OF THE 15 WORD#
            END 
          END 
        END                        # --- ZEROUNUSED ---                #
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     Z E R O 2 B L A N K                                              #
#                                                                      #
#     THIS PROC BLANK FILLS A NAME.                                    #
#                                                                      #
#     INPUT: GIVEA = NAME.                                             #
#     OUTPUT: THISNAME = NAME WITH BLANK FILL.                         #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC  ZERO2BLANK; 
        BEGIN 
                                   # FIRST PLACE BLANKS IN THE WORDS   #
        FOR DUMMY = 0  STEP 1  UNTIL 3  DO
          BEGIN 
          THISNAME[DUMMY] = $BLANKS$; 
          END 
  
                                   # NOW MOVE THE NAME UNTIL A         #
                                   # CHARACTER OF ZERO IS FOUND (00B)  #
        FOR DUMMY = 0  STEP 1  UNTIL 2  DO
          BEGIN 
          FOR BIT = 0  STEP 6  UNTIL 54  DO 
            BEGIN 
                                   # FETCH THE NEXT CHARACTER          #
            TEMPCHAR = B<BIT,6>GIVEITEM[DUMMY]; 
                                   # TEST TO SEE IF IT IS ZERO         #
            IF TEMPCHAR  EQ  0  THEN
              BEGIN 
              RETURN;              # FINISHED WITH THE MOVE            #
              END 
                                   # MOVE THE NON-ZERO CHARACTER       #
            B<BIT,6>THISNAME[DUMMY] = TEMPCHAR; 
            END 
          END 
        END                        # --- ZERO2BLANK ---                #
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     U S E C R M   -   MAIN ROUTINE.                                  #
#                                                                      #
#     INPUT CONDITIONS ARE THE SAME AS DESCRIBED FOR THE MAIN          #
#     ROUTINE OF *USECDCS*.  THE FOLLOWING IS DONE:                    #
#                                                                      #
#     --- *UNCUV* IS CALLED TO CLEAN UP THE PREVIOUS CONDITIONS.       #
#     --- IF THIS IS A -VERSION- DIRECTIVE, *VERSEX* IS CALLED         #
#         TO PROCESS IT.  THE REMAINING STEPS APPLY ONLY TO A          #
#         CREATE/INVOKE/USE.                                           #
#     --- THE SUBSCHEMA IS CLOSED WITH CRM AND RE-OPENED USING THE DDL #
#         DIRECTORY ACCESS ROUTINE *DDLOPSB*.  IT THE VERSION NUMBER   #
#         IN THE CONTROL INFORMATION CONTAINS -3.2-, THE FILE IS       #
#         OF SUBSCHEMA LIBRARY FORMAT WITH ONE OR MORE SUBSCHEMAS      #
#         IN IT.  OLDER DDL VERSIONS PRODUCE SINGLE-SUBSCHEMA FILES.   #
#         IF IT IS A SUBSCHEMA LIBRARY:                                #
#         --- THE EOI MARKER IS THE FIRST THING ON THE FILE THAT MUST  #
#             BE FOUND.  SINCE MANY ONE-WORD READS OF A WA FILE IS     #
#             SLOW, THE READING SHALL BE DONE BY USING A PRU-SIZED     #
#             WSA, READING A PRU AT A TIME, SEARCHING THRU             #
#             THAT DATA, AND READING MORE PRUS AS NECESSARY.           #
#             THIS TYPE OF READ IS A SPECIAL CASE TO CRM, AND THE      #
#             DATA IS READ DIRECTLY INTO THE WSA.                      #
#         --- WHEN THE DESIRED SUBSCHEMA IS FOUND, THE LOW-CORE        #
#             ENTRY POINT *SBSCADD* IS SET TO THE STARTING WA          #
#             OF THE SUBSCHEMA.  THIS IS USED BY SUBSEQUENT QU         #
#             ROUTINES THAT ACCESS THE SUBSCHEMA.  FOR THE FIRST       #
#             (OR ONLY) SUBSCHEMA ON THE FILE, THIS VALUE IS = 1,      #
#             NOT 0, AS THE FIRST WORD OF THE FILE.                    #
#     --- IF A DATA BASE PROCEDURE LIBRARY IS SPECIFIED, ITS           #
#         FDB IS MOVED INTO THE AREA TABLE, AND THE LIBRARY            #
#         IS ATTACHED.                                                 #
#     --- THERE ARE THREE (3) CASES FOR BUILDING THE AREA TABLES:      #
#         --- IF AN AREA NAME WAS SPECIFIED (-USE- OR -CREATE-         #
#             DIRECTIVE), *FINDAREA* IS CALLED TO FIND THAT            #
#             AREA ENTRY IN THE SUBSCHEMA, AND, IF FOUND,              #
#             *BUILDTABLE* IS CALLED TO BUILD THE AREA TABLE.          #
#             IF NOT FOUND, IT IS AN ERROR IF THIS IS A -CREATE-, BUT  #
#             IF A -USE-, THE NAME MAY BE A RELATION NAME,             #
#             INSTEAD OF AN AREA NAME, AND CASE 2 IS ENTERED BELOW.    #
#         --- IF ONE OR MORE RELATIONS WERE SPECIFIED, *FINDRELA* IS   #
#             CALLED TO FIND EACH NAME, AND, IF FOUND, *PROCRELENTRY*  #
#             IS CALLED TO BUILD THE RELATION TABLES.  IT              #
#             CALLS *BUILDTABLE* FOR ANY AREA TABLES NOT YET BUILT.    #
#         --- IF ONLY THE SUBSCHEMA NAME IS SPECIFIED (THE ONLY CASE   #
#             FOR THE -INVOKE- DIRECTIVE, THEN *BUILDTABLE* IS CALLED  #
#             FOR EACH AREA ENTRY IN THE SUBSCHEMA, AND THEN           #
#             *PROCRELENTRY* IS CALLED FOR EACH RELATION.              #
#     --- *ENDUSE* IS CALLED TO DO THINGS COMMON FOR ALL THREE         #
#         CASES, AND THEN PROCESSING IS DONE.                          #
#                                                                      #
#----------------------------------------------------------------------#
  
      NBRAREAS = 0;                # INITIALIZE NO. OF AREAS TO ZERO   #
      NBRRELS = 0;                 # INITIALIZE NO. RELATIONS TO ZERO  #
      P<SBSBUF> = 0;               # INDICATE THIS BLOCK NOT PRESENT   #
      UNCUV;                       # CLEAN UP PREVIOUS USE, IF ANY     #
      IF RC NQ 0
      THEN                         # ERROR IN *UNCUV*                  #
        BEGIN 
        ABORTUSE; 
        RETURN; 
        END 
  
      IF VERDIR 
      THEN                         # IF -VERSION- DIRECTIVE            #
        BEGIN 
        VERSEX;                    # PROCESS NEW CATALOG FILE          #
        IF RC NQ 0
        THEN                       # IF ERROR RETURN                   #
          BEGIN 
          ABORTUSE; 
          END 
  
        RETURN; 
        END 
  
      CDCSDBM = FALSE;             # SET CRM DATA BASE MODE            #
                                   # MOVE POINTERS FROM NEWATBL TO     #
                                   # STANDARD AREA TABLE (AREATBLPTR)  #
      AREATBLPTR = NEWATBL;        # POINT TO NEW AREA TABLE           #
      P<AREA$TABLE> = AREATBLPTR; 
      P<SCONTROL> = SCTLPTR;       # POINT TO SUBSCH CONTROL INFO      #
                                   # SAVE POSITION OF PERMANENT FIT    #
      P<SCHEMAFIT> = LOC (AT$AFITPOS);
                                   # CLOSE SUBSCHEMA FILE SO IT CAN BE #
                                   # RE-OPENED BY THE DIRECTORY ACCESS #
                                   # ROUTINES USING A DIFFERENT FIT    #
      CLOSEM (SCHEMAFIT, $DET$, RA0); 
      SBSCADD = 1;                 # SET FOR SINGLE SUBSCHEMA FILE     #
      P<GIVEA> = LOC (AT$AFDBPOS) + 4;
                                   # MOVE SUBSCHEMA LFN TO CELL USED   #
                                   # BY DIRECTORY ACCESS ROUTINES      #
      SBLFN = 0;
      C<0,7>SBLFN = C<0,7>GIVEITEMN[0]; 
      DDLOPSB;                     # OPEN SUBSCH USING D-A ROUTINES    #
      IF SDDLVER[0] EQ "3.2"
      THEN                         # IF A CRM SUBSCHEMA LIBRARY        #
                                   # WITH AN EOI MARKER                #
        BEGIN 
  
                                   # ALLOC. A PRU-SIZE BLOCK FOR A WSA #
        P<SBSBUF> = CMM$ALF (PRU + 1, 0, 0);
        WAKEY2 = 0;                # INDICATE EOI MARKER NOT FOUND     #
                                   # STARTING WORD ADDRESS TO READ     #
        WAKEY = ((NEWFILE - 1) * PRU) + 1;
        WORD = PRU;                # SET LENGTH OF EACH READ           #
  
                                   # SEARCH BACKWARDS FOR EOI MARKER   #
                                   # BY READING ON PRU BOUNDARIES      #
                                   # STARTING WITH THE LAST PRU.  WITH #
                                   # THIS METHOD, CRM DOES THE READ    #
                                   # FASTER THAN IF THERE ARE MANY     #
                                   # RANDOM READS THAT ARE NOT ON      #
                                   # PRU BOUNDARIES.                   #
        FOR DUMMY = 0 
          WHILE WAKEY GR 0
        DO
          BEGIN 
                                   # READ PRU                          #
          DDLRDSB (SBSBUF, WORD, WAKEY);
          MORE = TRUE;             # INDICATE STILL SEARCHING THIS PRU #
                                   # SEARCH THIS PRU BACKWARDS         #
          FOR DUMMY1 = WORD - 1 STEP -1 
            WHILE MORE
          DO
            BEGIN 
            IF SBSBUFI[DUMMY1] NQ $EOFMARK$ 
            THEN                   # THIS WORD IS NOT IT               #
              BEGIN 
              IF DUMMY1 EQ 0
              THEN                 # IF THIS PRU EXHAUSTED             #
                BEGIN 
                MORE = FALSE; 
                END 
  
              TEST DUMMY1;         # REPEAT LOOP                       #
              END 
  
                                   # SET WA OF CONTROL WORD            #
            WAKEY2 = WAKEY + DUMMY1 - 1;
            MORE = FALSE;          # INDICATE SEARCH DONE              #
            END 
  
          IF WAKEY2 EQ 0
          THEN                     # IF EOI MARKER HAS NOT BEEN FOUND  #
            BEGIN 
            WAKEY = WAKEY - PRU;   # READ NEXT-LOWER PRU               #
            TEST DUMMY;            # REPEAT MAIN LOOP                  #
            END 
  
                                   # READ CONTROL WORD, WHICH IS JUST  #
                                   # BEFORE THE EOF MARKER             #
          DDLRDSB (SBLBCTLWD, 1, WAKEY2); 
          MORE = TRUE;             # INDICATE SEARCH TO CONTINUE       #
                                   # SET POINTER TO SUBSCHEMA NAME     #
          P<GIVEA> = P<AREA$TABLE> + AT$SBSCNAME[0];
          ZERO2BLANK;              # SET UP BLANK-FILLED NAME          #
          DUMMY1 = SBLBINDWA[0];   # SET WA OF 1ST INDEX TABLE         #
          FOR DUMMY2 = 0 STEP 1 
            WHILE MORE
          DO
            BEGIN 
                                   # READ INDEX TABLE ENTRY            #
            DDLRDSB (SBLBINDEX, 4, DUMMY1); 
            IF C<0,30>THISNAME30[0] EQ SBLBSBSNAME[0] 
            THEN                   # DESIRED SUBSCHEMA FOUND           #
              BEGIN 
              MORE = FALSE;        # INDICATE NO MORE SEARCHING TO DO  #
              SBSCADD = SBLBSSWA[0]; # SET STARTING WA OF SUBSCHEMA    #
              WAKEY = 0;           # FORCE EXIT FROM OUTER LOOP        #
              TEST DUMMY2;         # GET OUT OF THIS LOOP              #
              END 
  
            IF DUMMY2 EQ SBLBCOUNT[0] - 1 
            THEN                   # IF SUBSCHEMA NOT IN THIS LIBRARY  #
              BEGIN 
                                   # SUBSCHEMA NOT FOUND               #
              DIAG (803, GIVEITEM[0], SBLFN); 
              ABORTUSE; 
              RETURN; 
              END 
  
            DUMMY1 = DUMMY1 + 4;   # ADVANCE WA TO NEXT INDEX ENTRY    #
            END 
          END 
  
        IF SBSCADD NQ 1 
        THEN                       # IF DESIRED SUBSCHEMA IS NOT THE   #
                                   # FIRST ONE IN THE FILE             #
          BEGIN 
                                   # READ CONTROL INFO FOR SUBSCHEMA   #
          DDLRDSB (SCONTROL, SCTLSZ, SBSCADD);
          END 
  
        CMM$FRF (P<SBSBUF>);       # FREE PRU BUFFER                   #
        P<SBSBUF> = 0;
        END 
  
                                   # NOW CHECK THE SUB-SCHEMA NAME     #
                                   # TO INSURE IT IS THE REQUIRED ONE  #
      P<GIVEA> = P<AREA$TABLE> + AT$SBSCNAME[0];
      ZERO2BLANK;                  # CONVERT ZEROS TO BLANKS IN        #
                                   # THE ARRAY THISNAME.               #
      P<GIVEA> = LOC(SCONTROL); 
      COMPWDS;                     # COMPARE THE NAMES                 #
      IF RC  NQ  0  THEN           # ARE THE NAMES THE SAME            #
        BEGIN 
        DIAG (861);                # NO  NOT THE SAME.  ISSUE DIAG     #
        CLSEDET;                   # CLOSE AND DETACH THE ERRONEOUS    #
                                   #   SUBSCHEMA FILE.                 #
        ABORTUSE;                  # CLEAN UP THIS USE                 #
        RETURN; 
        END 
  
                                   # CHECK IF SUB-SCHEMA WAS COMPILED  #
                                   # WITH A COMPATIBLE DDL -- NEW FITS.#
      IF SCRMVER[0] NQ CRMLEVEL15 
      THEN
        BEGIN 
        DIAG(309);                 # BAD VERSION MEANS OLD FITS        #
        ABORTUSE; 
        RETURN; 
        END 
CONTROL EJECT;
                                   # THIS IS THE CORRECT SUB-SCHENA    #
  
      IF SDBPFLAG[0]  THEN         # TEST FOR USER DATA BASE LIBRARY   #
        BEGIN 
                                   # YES THERE IS ONE                  #
        AT$DBPROC   = AT$NEXTFREE; # POINT TO THE FDB POSITION         #
                                   # UPDATE LENGTH OF THE BLOCK        #
        AT$NEXTFREE = AT$NEXTFREE + FDBSIZE;
                                   # MOVE THE DATA BASE USER LIBRARY   #
                                   # FDB TO THE CORRECT POSITION       #
                                   # IN THE SUB-SCHEMA AREA ENTRY      #
        P<GETA >    = LOC (AREA$TABLE) + AT$DBPROC; 
        P<GIVEA>    = LOC(SDBPFDB[0]);
        FOR DUMMY = 0  STEP 1  UNTIL 14  DO 
          BEGIN 
          GETITEM[DUMMY] = GIVEITEM[DUMMY]; 
          END 
  
        P<CHANGES>  = P<GETA>;     # ZERO OUT THE UNUSED               #
        ZEROUNUSED;                # WORDS AT THE END OF THE FDB       #
        DBPLFN      = PRAMWORD[4]; # SAVE THE LFN OF THE LIBRARY FILE  #
                                   # ATTACH THE DATA BASE LIBRARY FILE #
                                   # IT MUST BE PRESENT IN ORDER TO    #
                                   # CONTINUE THE -USE- DIRECTIVE      #
CONTROL IFEQ OS$NAME,NOS; 
  
        NOS$FORMAT;                # PUT PF PARAMS IN SPECIAL NOS FDB  #
                                   # FORMAT.                           #
CONTROL ENDIF;
        ATTACHF (GETA, TRUE, RC); 
        IF RC  NQ  0  THEN
          BEGIN 
          DIAG (343); 
          ABORTUSE; 
          RETURN; 
          END 
  
        END 
  
                                   # NOW SHRINK THE END OF THE BLOCK   #
      SIZE = MAXATBLSIZE - AT$NEXTFREE;  # AMT OF UNUSED SPACE         #
      SAVEPOS = LOC (AREA$TABLE); 
      CMM$SLF (SAVEPOS, SIZE);     # AND SHRINK THE BLOCK              #
  
                                   # TEST TO SEE IF AN AREA NAME WAS   #
                                   # GIVEN IN THE DIRECTIVE            #
      IF TAREA1  NQ  0  THEN
        BEGIN 
                                   # YES, AN AREA NAME WAS FOUND       #
        FINDAREA;                  # SEARCH THE SUB-SCHEMA FOR THE NAME#
        IF TEMPWA  NQ  0  THEN     # TEST TO SEE IF FOUND IN AREA INDEX#
          BEGIN 
                                   # YES, THE AREA WAS FOUND           #
          BUILDTABLE;              # BUILD THE AREA TABLE ENTRY        #
          IF RC  NQ  0  THEN
            BEGIN 
            ABORTUSE;              # IF PROBLEMS ABORT THE USE PROCESS #
            RETURN; 
            END 
          CMM$FRF (TAREA1);        # RETURN THE CORE FROM 1,5          #
          TAREA1 = 0;              # ZERO OUT THE POINTER              #
          ENDUSE;                  # COMPLETE USE PROCESSING           #
          IF RC NQ 0
          THEN                     # ERROR OCCURRED IN *ENDUSE*        #
            BEGIN 
            ABORTUSE; 
            RETURN; 
            END 
  
                                   # CHECK TO SEE IF A LOAD OF THE     #
                                   # 40-X OVERLAYS IS REQUIRED         #
          IF MUST40X  THEN
            BEGIN 
                                   # MUST LOAD THE 40-X OVERLAY        #
            INDEX     = 1;         # SET TO USE OPEN INDEX             #
            LOADOVL(BASEX0,O"40",0);  # LOAD UPDATE OVERLAY            #
            END 
  
          RETURN;                  # ALL REQUIRED TABLES HAVE          #
                                   # BEEN PRODUCED.                    #
          END 
  
                                   # IF THIS IS A CREATE DIRECTIVE     #
                                   # THE NAME MUST BE AN AREA NAME     #
        IF NOT USEDIR  THEN        # IS THE CURRENT DIRECTIVE CREATE   #
          BEGIN 
          P<GETA> = TAREA1;        # POSITION TO THE FDB FOR THE NAME  #
          DIAG (862, GETA);        # COULD NOT FIND AREA IN SUBSCHEMA  #
          ABORTUSE;                # ABORT THIS CREATE DIRECTIVE       #
          RETURN; 
          END 
  
                                   # THE NAME COULD BE THAT OF A       #
                                   # SINGLE RELATION                   #
        TAREA4     = TAREA1;       # SET UP THE POINTERS TO LOOK LIKE  #
        TAREA1     = 0;            # A RELATION TYPE IN                #
        P<GETA>    = TAREA4;
        GETITEM[3] = 0; 
        END 
CONTROL EJECT;
                                   # CHECK TO SEE IF RELATION NAME(S)  #
                                   # WERE GIVEN                        #
        IF TAREA4  NQ  0  THEN
          BEGIN 
                                   # YES. RELATION NAMES GIVEN         #
          CURPATHCNT       = 1;    # INITIALIZE THE PATH COUNTER       #
          B<1,1>CURPATHFLG = 1;    # INITIALIZE THE PATH BIT FLAG      #
          P<RELNAMES> = TAREA4;    # POSITION TO THE LIST OF NAMES     #
                                   # NOW SCAN DOWN THE LIST            #
          FOR RELOOP = 0  STEP 4  WHILE RELNAMEX[RELOOP]  NQ  0  DO 
            BEGIN 
  
                                   # TEST FOR THE END OF THIS          #
                                   # BLOCK OF 41 WORDS                 #
                                   # WORD 41 POINTS TO THE NEXT BLOCK  #
            IF RELOOP  EQ  40  THEN 
              BEGIN 
                                   # POSITION TO THE NEXT BLOCK        #
              P<RELNAMES> = RELNAMEX[RELOOP]; 
              RELOOP  = 0;         # RESET THE INDEX VALUE             #
              TEST RELOOP;         # LOOP BACK ON THIS BLOCK           #
              END 
  
                                   # POSITION TO START OF RELATION NAME#
            TAREA4X = LOC(RELNAMEX[RELOOP]);
            FINDRELA;              # CHECK RELATION NAME INDEX IN SUB  #
            IF TEMPWA  EQ  0  THEN
              BEGIN 
                                   # COULD NOT FIND THE REQUIRED       #
              P<GIVEA> = LOC (RELNAMEX[RELOOP]);
              DIAG (862, GIVEA);   # NAME IN THIS SUB-SCHEMA           #
              ABORTUSE; 
              RETURN; 
              END 
  
                                   # HAVE FOUND THE WORD ADDRESS OF    #
                                   # THE RELATION ENTRY                #
            PROCRELENTRY;          # GO PROCESS THIS LIST OF AREAS     #
                                   # TEST TO SEE IF BUILD OF THE       #
                                   # REQUIRED TABLES WAS ERROR FREE    #
            IF RC  NQ  0  THEN
              BEGIN 
              ABORTUSE;            # ABORT THIS USE DIRECTIVE          #
              RETURN; 
              END 
  
  
                                   # UPDATE THE PATH FLAG AND COUNTER  #
            CURPATHCNT = CURPATHCNT + 1;   # UPDATE BIT NUMBER         #
            CURPATHFLG = 0;        # CLEAR LAST PATH FLAG              #
            B<CURPATHCNT,1>CURPATHFLG = 1; # SET THE NEW PATH FLAG     #
            END 
  
  
          CMM$FRF (TAREA4);        # RETURN THE CORE GOTTEN BY 1,5     #
          TAREA4 = 0;              # ZERO OUT THE POINTER              #
  
          ENDUSE;                  # COMPLETE USE PROCESSING           #
          IF RC NQ 0
          THEN                     # ERROR OCCURRED IN *ENDUSE*        #
            BEGIN 
            ABORTUSE; 
            RETURN; 
            END 
  
          RETURN;                  # ALL REQUIRED TABLES BUILT  RETURN #
          END 
 CONTROL EJECT; 
                                   #-----------------------------------#
                                   # THE USER HAS GIVEN ONLY THE       #
                                   # SUB-SCHEMA,  SO USE ALL THE       #
                                   # AREAS AND RELATIONS IN IT         #
  
                                   # READ ALL THE AREA INDEX ENTRIES   #
      WAKEY2 = SAREAWA[0];         # SET TO READ FIRST AREA INDEX      #
      FOR TOTALWDS = 0  WHILE TOTALWDS  LS  SAREALNG[0]  DO 
        BEGIN 
        IF (SAREALNG[0] - TOTALWDS) GQ 4  # IF AT LEAST 4 MORE WORDS   #
        THEN
          BEGIN 
          AINDXLNG = 4;            # READ 4 WORDS                      #
          END 
        ELSE                       # LESS THAN 4 WORDS LEFT            #
          BEGIN 
                                   # READ NUMBER OF WORDS LEFT         #
          AINDXLNG = SAREALNG[0] - TOTALWDS;
                                                     # MANY WORDS AS   #
                                                     # ARE LEFT        #
          END 
                                   # READ THE AREA INDEX ENTRY         #
        GETSB (SAREAINDX, AINDXLNG, WAKEY2);
        TEMPWA = SAWORDADD[0];     # SAVE WORD ADDRESS OF AREA ENTRY   #
        BUILDTABLE;                # BUILD THE AREA TABLE ENTRY        #
        IF RC  NQ  0  THEN         # TEST FOR A BAD TABLE BUILD        #
          BEGIN 
          ABORTUSE;                # TABLE BUILD WAS NO GOOD           #
          RETURN; 
          END 
  
                                   # UPDATE THE TOTAL WORDS READ COUNT #
        TOTALWDS = TOTALWDS + SANAMELNG[0] + 1; 
                                   # UPDATE THE KEY TO THE NEXT ENTRY  #
        WAKEY2   = WAKEY2 + SANAMELNG[0] + 1; 
        END 
  
  
                                   #-----------------------------------#
                                   # NOW BUILD ENTRIES FOR ALL THE     #
                                   # RELATIONS IN THE SUB-SCHEMA       #
      CURPATHCNT       = 1;        # INITIALIZE THE PATH COUNTER       #
      B<1,1>CURPATHFLG = 1;        # INITIALIZE THE PATH BIT FLAG      #
        WAKEY2 = SRELWA[0];        # SET TO READ 1ST RELATION ENTRY    #
      FOR TOTALWDS = 0  WHILE TOTALWDS  LS  SRELALNG[0]  DO 
        BEGIN 
                                   # READ THE RELATION INDEX           #
        GETSB (SRELATINDX, 4, WAKEY2);
        TEMPWA = SRWORDADD[0];     # SAVE WORD ADDRESS OF RELATION     #
        PROCRELENTRY;              # GO BUILD THE TABLES FOR RELATION  #
        IF RC  NQ  0  THEN         # TEST FOR A BAD TABLE BUILD        #
          BEGIN 
          ABORTUSE;                # TABLE BUILD DID NOT WORK          #
          RETURN; 
          END 
  
                                   # UPDATE THE PATH FLAG AND COUNTER  #
        CURPATHCNT = CURPATHCNT + 1;   # UPDATE THE BIT NUMBER         #
        CURPATHFLG = 0;                # CLEAR LAST PATH BIT FLAG      #
        B<CURPATHCNT,1>CURPATHFLG = 1; # SET THE NEXT FLAG BIT         #
                                   # UPDATE THE TOTAL WORD COUNTER     #
        TOTALWDS = TOTALWDS + SRNAMELNG[0] + 1; 
                                   # UPDATE THE KEY TO THE NEXT INDEX  #
        WAKEY2   = WAKEY2 + SRNAMELNG[0] + 1; 
        END 
  
      ENDUSE;                      # COMPLETE USE PROCESSING           #
      IF RC NQ 0
      THEN                         # ERROR OCCURRED IN *ENDUSE*        #
        BEGIN 
        ABORTUSE; 
        RETURN; 
        END 
  
      RETURN; 
      END                          # --- USECRM ---                    #
      TERM
