*DECK CALLBLP 
USETEXT TAREATB 
USETEXT TBASCTB 
USETEXT TCMMDEF 
USETEXT TCOMMON 
USETEXT TCRMDEF 
USETEXT TDTABLE 
USETEXT TENVIRN 
USETEXT TFIT
USETEXT TOPTION 
USETEXT TSBASIC 
      PROC CALLBLP; 
  
          #  THIS PROC PERFORMS THE FOLLOWING FUNCTIONS:               #
          #  1.  OPEN THE AREA WHILE TELLING -CRM- THAT WE INTEND TO   #
          #       READ THE INDEX-FILE ONLY, NOT THE AREA.              #
          #  2.  CALL RM$BLP.                                          #
          #  3.  INTERPRET THE BLP RESULTS BEFORE LOADING OVERLAY 4X-0.#
  
  
      BEGIN 
                                                                         CALLBLP
      XREF PROC  CLOSEM;
      XREF PROC RETURNM;
      XREF PROC  DIAG;
                                                                         CALLBLP
      XREF PROC  LOADOVL; 
      XREF PROC  OPENM; 
      XREF PROC READ; 
      XREF PROC  RM$BLP;
      XREF PROC WAIT; 
  
      BASED ARRAY BIMAGE;;         # POINTER FOR USE BY *RELEASESPACE* #
      BASED ARRAY RELENTRIES;;     # POINTER FOR USE BY *RELEASESPACE* #
      BASED ARRAY RUSLIST;;        # POINTER FOR USE BY *RELEASESPACE* #
      XREF BASED ARRAY ORDSAVE;;   # POINTER FOR USE BY *RELEASESPACE* #
      BASED ARRAY KEYIN;; 
      BASED ARRAY DKIKEY;;
      XREF BASED ARRAY SAVDAREA;   # INFO ABOUT AREAS IN USE.          #
            BEGIN 
            ITEM AREASAVE  U(0,42,18);
            ITEM AREASAVEWD U(0,0,60);
            ITEM AREAINUSE  B(0,0,1); 
            END 
      XREF ARRAY BLPTBLE;    #1ST BLP PARAMETER: INPUT TABLE           #
          BEGIN 
            ITEM KEYFWA  U(0,6,18);  #ADDRESS OF BLOCK WHERE BLP       #
                                     # RETURNS THE LIST OF KEYS.       #
          END 
      XREF ARRAY BLPRC;      #2ND BLP PARAMETER: RETURN INFORMATION    #
          BEGIN 
            ITEM RC         U(0, 0, 6); 
            ITEM NUMREC     U(0,18,24); 
            ITEM LFNKEYLIST U(0, 0,60); 
          END 
  
      XREF ITEM ABORTED B;         # TRUE IF QU WAS REPRIEVED          #
      XREF ITEM AFPROCESSED B;     # TRUE IF UPDATED UNCLOSED FILE IS  #
                                   # ACCEPTABLE                        #
      XREF ITEM IPROCESSED B;      # FALSE IF INTERACTIVE              #
      XREF ITEM CURRELLOC;         #   CURRENT RELATION TABLE.         #
XDEF ITEM ALKEYLOC; 
      XREF ITEM UPDATING B;        # TRUE--UPDATING AN AREA.           #
      XREF ITEM UPDTEMP B;
      XREF ITEM CURRELATION;
      XREF ITEM TARGETAREA;        # PTR TO AREA TABLE TO BE UPDATED.  #
      XREF ITEM CURRENTLFPTR; 
      XREF ITEM FROMKEYINFIT I;    # ADDRESS OF *FROM* OR *KEY IN* FIT #
      XREF ITEM RA0;
      XREF ITEM USEDIR B; 
      XREF ITEM AKGRPID;           # GROUP ID OF CM CONTAINING LITERAL #
                                   # VALUES OF ALT KEYS WITH UNIVERSAL #
                                   # CHARACTER OR MAJOR ALT KEYS PADDED#
                                   # WITH HIGH OR LOW CHARACTER        #
      XREF ITEM DUMMY;                                                   CALLBLP
  
      DEF UPDATED # O"52" #;       # CRM ERROR CODE INDICATING FILE NOT#
                                   # CLOSED SINCE LAST UPDATE          #
  
       BASED ARRAY AA;
       BEGIN
       ITEM INDWD  C(0,0,7);
       END
  
      ITEM AFANSWER C(1);          # ANSWER TO WHETHER TO ACCEPT       #
                                   # UPDATED UNCLOSED FILE             #
      ITEM J;                # SCRATCH ITEM FOR CALLBLP # 
      ITEM I;                # SCRATCH ITEM FOR ATTACHF # 
      ITEM SAVEMRL; 
      ITEM READ$ONLY B; 
      ITEM TEMP I;                 # DUMMY VARIABLE FOR *READ* CALL    #
  
CONTROL NOLIST;     # *CALL ATTACHF FOLLOWS # 
*CALL ATTACHF 
CONTROL LIST; 
CONTROL NOLIST;     # *CALL PFDIAG FOLLOWS #
*CALL PFDIAG
CONTROL LIST; 
  
  
  
  
      P<AREA$TABLE> = AREALOC;
      P<KEY$TBL> = AT$PKEYDPTR;    # POSITION TO KEY DESC TABLE        #
      P<AA> = P<AREA$TABLE> + AT$INDFDB[0]; 
  
          IF NOT AT$TEMPA[0] AND USEDIR THEN  # NOT A TEMPORARY AREA.  #
          BEGIN 
            READ$ONLY = (REFERFILE EQ 1); 
            J = 0;                                                       CALLBLP
            ATTACHF(AA, READ$ONLY, J);
            IF J NQ 0 THEN
            BEGIN 
              IF AKGRPID NQ 0      # IF GROUP ID ALLOCATED             #
              THEN
                BEGIN 
                CMM$FGR(AKGRPID);  # FREE CM WITH THIS GROUP ID        #
                AKGRPID = 0;       # INDICATE THAT CM FREED            #
                END 
              LOADOVL(0, 1, 0); 
              #--------------------#
            END 
          END 
  
          P<FIT> = LOC(AT$AFITPOS);                                      CALLBLP
          FITNDX = TRUE;           #TELL CRM TO READ INDEX FILE ONLY   # CALLBLP
          C<0,7>FITXN = INDWD[4];  #SET LFN FOR INDEX FILE             # CALLBLP
          IF FITFO EQ FOAK         # IF FILE ORGANIZATION IS ACTUAL KEY#
          THEN
            BEGIN 
            FITKL = KT$ACTKEYLNG[1];  # MOVE AK KEY LENGTH TO FIT      #
            END 
          ELSE
            BEGIN 
            FITKL = KT$LENGTH[1];  # MOVE KEY LENGTH TO FIT            #
            END 
          FITBBH = TRUE;           # ALLOCATE BUFFERS BELOW HHA        #
          OPENM(FIT, $INPUT$, RA0); 
  
          IF FITES EQ UPDATED      # FILE NOT CLOSED SINCE LAST UPDATE #
          THEN
            BEGIN 
            DIAG (821, FITLFNC);   # INFORM THAT ERROR OCCURRED        #
            IF AFPROCESSED         # USER CHOSE TO ACCEPT FILE         #
            THEN
              BEGIN 
              DIAG (1017);         # INFORM THAT FILE ACCEPTED         #
              FITES = 0;           # OVERRIDE THE ERROR                #
              END 
            ELSE
              BEGIN 
              IF NOT IPROCESSED    # IF INTERACTIVE AND *AF* NOT CHOSEN#
              THEN
                BEGIN 
                DIAG (1016);       # ASK IF SHOULD ACCEPT FILE         #
                READ (AFANSWER, TEMP, 1, TEMP); 
                IF AFANSWER EQ "Y" # IF ANSWER IS YES                  #
                THEN
                  BEGIN 
                  FITES = 0;       # CLEAR THE ERROR                   #
                  END              # OTHERWISE WILL BE PROCESSED AS    #
                END                # ANY OTHER ERROR                   #
              END 
            END 
  
          IF FITES NQ 0            # IF SOME ERROR OCCURRED            #
          THEN
            BEGIN 
            IF FITES NQ UPDATED    # DIAG FOR 52B ALREADY GIVEN        #
            THEN
              BEGIN 
              DIAG (903, FITES, FITLFNC);  # DIAGNOSE CRM ERROR CODE   #
              END 
            AUTOPSY;               # GENERAL FILE CLOSING AND RETURNING#
            RELEASESPACE;          # FREE SPACE FROM THIS DIRECTIVE    #
            LOADOVL(BASEX0, 1, 0);  # LOAD 1,0 TO RESTART SYNTAX...    #
            END 
  
  
          LFNKEYLIST[0] = 0;
          LFNKEYLIST[1] = 0;
          SAVEMRL = FITMRL;        #SAVE CURRENT MRL                   # CALLBLP
          RM$BLP(BLPTBLE, BLPRC);                                        CALLBLP
          FITREL = 0;              # RESET TO *NO RELATION IN EFFECT*  #
          FITRL = 0;
          FITMRL = SAVEMRL;        #RESTORE MRL                        # CALLBLP
                                                                         CALLBLP
          AUTOPSY;                 # GENERAL FILE CLOSING AND RETURNING#
          IF FITFO EQ FOAK         # IF FILE ORGANIZATION IS ACTUAL KEY#
          THEN
            BEGIN 
            FITKL = KT$ACTKEYLNG[1];  # MOVE AK KEY LENGTH TO FIT      #
            END 
          ELSE
            BEGIN 
            FITKL = KT$LENGTH[1];  # MOVE KEY LENGTH TO FIT            #
            END 
                 #BELOW, INTERPRET RESULTS RETURNED BY BLP.            #
          INDEX = 0;  # TELL 30-0 OR 4X-0 TO CALL CTL30 OR CTL40       #
          J = RC[0];
          IF J EQ 2 AND NUMREC[0] EQ 0 THEN  # NO RECORD QUALIFIED     #
            BEGIN 
                 DIAG(1009);
                 RELEASESPACE;     # RELEASE SPACE FOR THIS DIRECTIVE  #
                 LOADOVL(BASEX0,1,0);  # START UP SYNTAX PROCESSING    #
            END 
  
          IF J EQ 1 THEN     # THE AREA MUST BE PASSED                 #
            BEGIN 
                 SCANALLAREA = TRUE;
                 CMM$FRF(KEYFWA[0]);
            END 
          ELSE               #THE AREA IS ACCESSED VIA LIST OF KEYS    #
            BEGIN 
                 KEYLIST = KEYFWA[0]; 
                 KEYFILE = LFNKEYLIST[1]; 
            END 
  
          IF AKGRPID NQ 0          # IF GROUP ID ALLOCATED             #
          THEN
            BEGIN 
            CMM$FGR(AKGRPID);      # FREE CM WITH THIS GROUP ID        #
            AKGRPID = 0;           # INDICATE THAT CM FREED            #
            END 
          IF REFERFILE EQ O"77" THEN        # AREA MUST BE UPDATED     #
            BEGIN 
            LOADOVL(BASEX0,O"40",0);  # LOAD UPDATE OVERLAY            #
            END 
          ELSE                              # AREA(S) MUST BE QUERIED. #
                 LOADOVL(0, O"30", 0);
          #----------------------------------#
  
  
      XDEF PROC AUTOPSY;
                 #  THIS PROCEDURE IS AUTOMATICALLY ENTERED IF AN      #
                 #  ABORT OCCURS WHILE WE ARE IN THIS OVERLAY.         #
                 #  ALL FILE CLOSING AND CLEAN-UP ACTIONS TAKE PLACE   #
                 #  HERE BEFORE ENDING -QU- ABNORMALY.                 #
      PROC AUTOPSY; 
          BEGIN 
          IF ABORTED               # IF QU WAS REPRIEVED               #
          THEN
            BEGIN 
            RELEASESPACE;          # RELEASE SPACE FOR THIS DIRECTIVE  #
            END 
          P<FIT> = LOC(AT$AFITPOS);  # POSITION TO AREA FIT            #
          IF FITOC EQ OC$OPEN      # IF AREA WAS LEFT OPEN             #
          THEN
            BEGIN 
            FITNDX = TRUE;         # ENSURE STILL HAVE INDEX-ONLY      #
            CLOSEM(FIT, $DET$, RA0);  # CLOSE, RELEASE BUFFER SPACE    #
            FITNDX = FALSE;        # NO MORE INDEX-ONLY WORK FOR NOW   #
            END 
  
          IF USEDIR                # IF USE                            #
            AND NOT AT$TEMPA[0]    # IF NOT A TEMPORARY AREA           #
          THEN
            BEGIN 
            RETURNM(C<0,7>FITXN, RA0);  #RETURN INDEX FILE             # CALLBLP
            RETURNM(FIT, RA0);     # RETURN THE EMPTY LFN CRM CREATED  #
            END 
  
          FITWSA = 0;              # IN CASE STILL POINTING TO BLP WSA #
          RETURN; 
          END 
*CALL RELSPACE
      END 
      TERM
