*DECK  CREINIT
USETEXT TAREATB 
USETEXT TCMMDEF 
USETEXT TCRMDEF 
USETEXT TDBPDEF 
USETEXT TFIT
      PROC  CREINIT;
      BEGIN 
  
      XREF PROC  DIAG;             # ISSUE A DIAGNOSTIC                #
      XREF PROC  LOADX0;           # LOAD AN X,0 OVERLAY               #
      XREF PROC  OPENM;            # OPEN THE AREA                     #
      XREF PROC  CALLOWN;          # CALLING INTERFACE TO DATABASE PROC#
      XREF PROC  CLOSEM;
      XREF PROC  RMKDEF;           # DEFINE ALTERNATE FIELDS FOR MIP   #
      XREF ITEM  AREATBLPTR;       # POINTER TO 1ST AREA TABLE         #
      XREF ITEM  IDIRCODE;         # INTEGER VALUE OF DIRECTIVE CODE   #
      XREF ITEM  INDEX;            # ITEM IN COMMON BLOCK BASIC THAT   #
                                   # INDICATES TYPE OF ACTION FOR 5,0  #
      XREF ITEM ATPTR I;           # POSITION OF AREA$TABLE            #
      XREF ITEM  PRIMARY;          # PRIMARY LEVEL OF OVERLAY TO LOAD  #
      XREF ITEM  SECONDARY;        # SECONDARY LEVEL OF OVERLAY TO LOAD#
      XREF ITEM  RA0; 
      ITEM       DUMMY;            # LOCAL ITEM FOR FOR LOOP COUNTER   #
      ITEM       RC;               # RETURN CODE                       #
  
      BASED ARRAY   GIVEA;
        BEGIN 
        ITEM  GIVEITEM    U(00,00,60);
        END 
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#  THIS PROCEDURE CONTINUES THE PROCESSING OF THE -CREATE- DIRECTIVE.  #
#  THE AREA FILE TO BE CREATED IS OPENED NEW.                          #
#  IF MIP FILE (INDEX PRESENT) CALLS TO RMKDEF ARE MADE WITH THE       #
#  THE PARAMETER STRING BUILD BY THE 5-0 OVERLAY -USE-                 #
#                                                                      #
#----------------------------------------------------------------------#
  
        BEGIN 
  
        ITEM NUM        I;         # USED TO CALCULATE SIZE OF WSA     #
  
        P<AREA$TABLE> = AREATBLPTR;   # POSITION TO THE AREA TO        #
        P<AREA$TABLE> = AT$FORWARD;   # BE CREATED,  ALWAYS 2ND ENTRY  #
        P<KEY$TBL> = AT$PKEYDPTR;  # POSITION TO KEY DESC TABLE        #
        P<FIT> = LOC(AT$AFITPOS);                                        CREINIT
        NUM = (FITMRL + 9) / 10;   # SIZE OF WSA                       #
        FITWSA = CMM$ALF(NUM, 0, 0);
        IF FITFO NQ FOSQ           # IF NOT SEQUENTIAL FILE            #
        THEN
          BEGIN 
          FITRKW = KT$WPOS[1];
          FITKA = AT$CURRKEY + P<AREA$TABLE>; 
          IF FITFO EQ FOAK          # IF ACTUAL KEY FILE              # 
          THEN
            BEGIN 
            FITRKP = KT$ACTKEYPOS[1]; 
            FITKP = KT$ACTKEYPOS[1];
            FITKL = KT$ACTKEYLNG[1];
            END 
          ELSE                      # -IS-, -DA- FILES                # 
            BEGIN 
            FITRKP = KT$CPOS[1];
            FITKL = KT$LENGTH[1]; 
            END 
          END 
        FITBBH = TRUE;             # ALLOCATE BUFFER SPACE BELOW HHA   #
        IF AT$DBPSRH THEN          # IF DBP-S PERFORM ALL I/O THIS AREA#
          BEGIN 
          GOTO OWNOPEN;            # BYPASS QU-S OPEN CODE             #
          END 
  
        IF AT$COLSEQ NQ 0                                                CREINIT
          AND AT$FITFO NQ FODA                                           CREINIT
        THEN                                                             CREINIT
                                   # COLLATING SEQ. FOR NON -DA- FILE. #
          BEGIN 
          FITDCT = P<AREA$TABLE> + AT$COLSEQ;  #SET UP DCT ADDRESS     # CREINIT
          END 
        OPENM(FIT, $NEW$, RA0);                                          CREINIT
        IF FITES NQ 0              #IF SOME ERROR PREVENTED OPEN       # CREINIT
        THEN                                                             CREINIT
          BEGIN                                                          CREINIT
          DIAG(903, FITES, FIT);   #DIAGNOSE THE ERROR                 # CREINIT
          INDEX = 0;               # INDEX INTO 5,0 TO ABORT THE USE   #
          PRIMARY = 5;
          SECONDARY = 0;
          LOADX0;                  # LOAD THE 5,0 OVERLAY              #
          END 
  
  
                                   # IF THE FILE IS A  MIP  FILE DO    #
                                   # THE CALLS TO  RMKDEF  TO DEFINE   #
                                   #   FIRST   PRIMARY KEY             #
                                   #   THEN    ALTERNATE KEY(S)        #
        DUMMY = 0;                 # ASSUME SYMBOLIC                   #
        IF KT$TYPE[1] GQ 2         # IF INTEGER, COMP-1, OR FLOATING KY#
          AND KT$TYPE[1] LQ 4 
        THEN
          BEGIN 
          DUMMY = 1;               # SIGNED INTEGER                    #
          END 
  
        IF KT$TYPE[1] EQ 1         # IF NUMERIC                        #
          AND NOT KT$OVERPUN[1]    # IF NO SIGN OVERPUNCH              #
        THEN
          BEGIN 
          DUMMY = 2;               # UNSIGNED BINARY                   #
          END 
  
        IF AT$INDFDB NQ 0 
          AND NOT FITORG
        THEN
          BEGIN 
                                   # MAKE CALL FOR THE PRIMARY KEY     #
          RMKDEF ( FIT,      KT$WPOS[1],
                             KT$CPOS[1],
                             KT$LENGTH[1],
                             0, 
                             DUMMY, 
                             RA0);
          END 
  
                                   # NOW MAKE CALLS FOR THE ALTERNATE  #
                                   # KEY(S) FOR THE FILE               #
        FOR DUMMY = 0  STEP 1  WHILE AT$MIPPTR  NQ  0  DO 
          BEGIN 
          P<GIVEA>    = AT$MIPPTR;    # POSITION TO THE NEXT BLOCK     #
          AT$MIPPTR   = GIVEITEM[9];  # SAVE POINTER TO NEXT BLOCK     #
          RMKDEF ( FIT,     GIVEITEM[0],                                 CREINIT
                            GIVEITEM[1],
                            GIVEITEM[2],
                            GIVEITEM[3],
                            GIVEITEM[4],
                            GIVEITEM[5],
                            GIVEITEM[6],
                            GIVEITEM[7],
                            RA0); 
          END 
  
OWNOPEN:                           # HERE TO BYPASS NORMAL QU OPEN CODE#
        IDIRCODE = DCODE"CREATE";  # THIS DIRECTIVE IS A CREATE.       #
        ATPTR = P<AREA$TABLE>;     # PASS POSITION TO *CALLOWN*        #
        CALLOWN (ON"OPEN", RC);    # TRY CALLING ON"OPEN" DBP          #
        IF AT$MIPID  NQ  0  THEN
          BEGIN 
          CMM$FGR (AT$MIPID);      # RETURN THE CORE USED BY THE STRING#
          AT$MIPID  =0; 
          AT$MIPPTR = 0;           # CLEAR OUT THE POINTER             #
          END 
  
        CALLOWN (ON"CLOSE", RC);   # TRY CALLING ON"CLOSE" DBP         #
        IF NOT AT$DBPSRH THEN      # IF QU CAN PERFORM I/O THIS AREA   #
          BEGIN 
          CLOSEM(FIT, $DET$, RA0);  # CLOSE, RELEASE BUFFER SPACE      #
          END 
  
        END 
      END 
      TERM
