*DECK     DB$FPOS 
USETEXT CDCSCTX 
      PROC DB$FPOS; 
      BEGIN 
 #
* *   DB$FPOS -- RESTORE FILE POSITION           PAGE  1
* *   R L MCALLESTER                             DATE  08/08/86 
* *   R L MCALLESTER                             DATE  03/14/88 
* 
* DC  PURPOSE 
* 
*     RESTORE THE FILE POSITION THAT IS ASSOCIATED WITH THE USER TQT
*     THAT IS ABOUT TO PERFORM A SEQUENTIAL OPERATION ON THE FILE.
*     THIS ROUTINE IS ONLY CALLED WHEN THE FIT HAS BEEN USED BY SOME
*     OTHER TQT.
* 
* DC  ENTRY CONDITIONS
* 
*     P<RSB> IS SET.               RUN-UNIT STATUS BLOCK. 
*     P<RSARBLK> IS SET.           RUN-UNIT STATUS BLOCK AREA CONTROL 
*                                  BLOCK. 
*     P<FKL> IS SET.               FILE KEY LIST. 
*     P<FPT> IS SET.               FILE PARAMETER TABLE.
*     P<OFT> IS SET.               OPEN FILE TABLE. 
*     P<UFT> IS SET.               USER FILE TABLE. 
* 
* DC  EXIT CONDITIONS 
* 
*     IF NO KEYS HAVE BEEN STORED IN THE FKL, A REWIND IS DONE. 
*     IF KEYS HAVE BEEN SAVED THEY ARE RESTORED TO THE FIAT AND 
*     THE ALTPOS FLAG IS SET TO WARN AAM TO REPOSITION. 
*     FPCFPOS IS SET FALSE SO DB$FPOS WILL NOT BE CALLED AGAIN
*     UNTIL IT IS REQUIRED. 
* 
* DC  CALLING ROUTINES
* 
*     DB$GETN    A SEQUENTIAL READ
*     DB$SKF$    SKIP FORWARD 
* 
* DC  CALLED ROUTINES 
# 
      XREF PROC DB$FLOP;           # IDENTIFY FLOW POINT               #
      XREF PROC DB$FTEX;           # FIT ERROR EXIT ROUTINE            #
      XREF PROC DB$RA0;            # PARAMETER LIST TERMINATOR         #
      XREF PROC GET;               # AAM GET ROUTINE                   #
      XREF PROC REWND;             # REWIND                            #
# 
*     NON-LOCAL VARIABLES 
# 
*CALL FIATDCLS
 #
*     LOCAL VARIABLES 
# 
      ITEM MKL   I;                # SAVE MKL                          #
      ITEM XA    I;                # LOOP INDEX                        #
      ITEM PKL   I;                # PRIMARY KEY LENGTH                #
  
      BASED ARRAY FIT;;            # DUMMY FIT FOR CRM CALL            #
  
      BASED ARRAY SARRAY;          # ARRAY FOR SOURCE OF MOVE          #
        BEGIN 
        ITEM SW  I(00,00,60);      # FULL WORD                         #
        ITEM SKL I(00,19,08);      # KEY LENGTH OF ALTERNATE KEY       #
        END 
  
      BASED ARRAY TARRAY;          # ARRAY FOR TARGET OF MOVE          #
        BEGIN 
        ITEM TW  I(00,00,60);      # FULL WORD                         #
        ITEM TST I(00,00,08);      # CURPTR, QFR, QLR, QEI FROM PTREE  #
        END 
  
  
  
#     B E G I N   D B $ F P O S   E X E C U T A B L E   C O D E .      #
  
 #
* 
* DC  DESCRIPTION 
* 
 #
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("FPOS");
      CONTROL ENDIF;
  
      FPCFPOS[0] = FALSE; 
 #
*     IF NO POSITION HAS BEEN SAVED FOR THE FILE, REWIND IT.
 #
      IF RSARPKO[0] EQ 0
      THEN
        BEGIN 
        P<FIT> = LOC(UFFIT[0]); 
        REWND(FIT,DB$RA0);
        RETURN; 
  
        END 
 #
* 
*     RESTORE THE PRIMARY KEY TO THE FIAT.
 #
      P<FIAT> = UFFITFIAT[0]; 
      P<TARRAY> = FIPRIKA[0]; 
      P<SARRAY> = LOC(FKL) + RSARPKO[0];
  
      PKL = (OFPRIKL[0] + 9) / 10;
      FOR XA = PKL -1 STEP -1 UNTIL 0 
      DO
        BEGIN 
        TW[XA] = SW[XA];
        END 
      FISEEK1[0] = 0; 
 #
*     REPLACE THE FP (FILE POSITION) FIELD IN THE FIAT AND UFT. 
*     REPLACE THE CURPTR, QFR, QLR AND QEI
*     IN THE PTREE OF THE DATA FILE.
 #
      FIFP[0] = FPFIFP[0];
      UFFITFP[0] = FPFIFP[0]; 
      P<TARRAY> = FIPTR5[0];
      TST[0] = FPFIPST[0];
 #
*     IF A PTREE HAS BEEN SAVED, RESTORE IT.
 #
      P<SARRAY> = P<SARRAY> + PKL;
      FOR XA = RSARPKL - PKL -1 STEP -1 UNTIL 0 
      DO
        BEGIN 
        TW[XA] = SW[XA];
        END 
 #
* 
*     IF AN ALTERNATE KEY HAS BEEN SAVED, 
*     RESTORE THE ALTERNATE KEY TO THE FIAT.
*     THE MOVE ROUTINE ALSO RESTORES "POSKEY1" WHICH IS THE 
*     WORD BEFORE THE ALTERNATE KEY.
 #
      IF RSARAKO[0] NQ 0
      THEN
        BEGIN 
  
        CONTROL IFGR DFFLOP,0;
          DB$FLOP("FPOS-AL"); 
        CONTROL ENDIF;
  
        P<TARRAY> = FIALTKA[0] - 1; 
        P<SARRAY> = LOC(FKL) + RSARAKO[0];
  
        FOR XA = (SKL[0] + 9) / 10  STEP -1 UNTIL 0 
        DO
          BEGIN 
          TW[XA] = SW[XA];
          END 
  
 #
*       REPLACE THE ALTERNATE KEY DEFINITION IN THE FPT.
 #
        FPFITRKW[0] = FIPKRKW[0]; 
        FPFITRKP[0] = FIPKP[0]; 
        FPFITKL[0]  = FIPKRKL[0]; 
        END 
      ELSE
 #
* 
*       IF PROCESSING BY PRIMARY KEY -
*         IF NOT AN INDEX SEQUENTIAL FILE 
*           PERFORM A "GET" TO RESTORE FILE POSITION. 
*         ELSE
*           CLEAR "POSKEY1" AND REPLACE THE PRIMARY KEY DEFINITION
*           IN THE PFT. 
 #
        BEGIN 
        IF UFFITFO[0] NQ DFFITFOIS
        THEN
          BEGIN 
          UFFITKA[0] = LOC(FKL) + RSARPKO[0]; 
          FPFTEX[0] = DFFTEX0;     # NEGATE ERROR EXIT PROCESSING      #
          P<FIT> = LOC(UFFIT[0]); 
          MKL = UFFITMKL[0];
          GET(FIT,DB$RA0);         # REPOSITION THE FILE               #
          UFFITMKL[0] = MKL;
          UFFITKA[0] = FPFITKA[0];
          FPFTEX[0] = DFFTEX1;
          IF UFFITES[0] EQ O"445"  # IGNORE A "KEY NOT FOUND" ERROR    #
          THEN
            BEGIN 
            UFFITES[0] = 0; 
            END 
          IF UFFITES[0] NQ 0
          THEN                     # CALL DB$FTEX FOR ANY OTHER ERROR  #
            BEGIN 
            DB$FTEX;
            END 
          RETURN; 
  
          END 
        FIPOSK1[0] = 0; 
        FPFITKEYD[0] = OFPRIKEY[0]; 
        END 
  
      UFFITKEYD[0] = FPFITKEYD[0];
 #
*     SET "ALTPOS" TRUE SO THAT AAM WILL NOT ATTEMPT TO 
*     USE THE EXISTING PTREE. 
*     RESTORE THE "XFER" BIT SO AAM WILL KNOW TO POSITION BEFORE
*     OR AFTER THE SPECIFIED KEY. 
 #
      FIALTPOS[0] = TRUE; 
      FIXFER[0] = FPFIATX[0]; 
      FISKLAST[0] = FALSE;
      RETURN; 
  
      END 
      TERM
