*DECK DB$RCHK 
USETEXT CDCSCTX 
      PROC DB$RCHK; 
      BEGIN 
 #
* *   DB$RCHK--CHECK RECORD STATUS               PAGE  1
* *   C O GIMBER                                 3/14/77
* 
* DC  PURPOSE 
* 
*     CHECK RECORD STATUS BEFORE DOING IO.
* 
* DC  ENTRY CONDITIONS
* 
*     ASSUMPTIONS 
* 
*     CSFIXED - POINTER SET.
*     RCB     - POINTER SET. CONTAINS REQUEST PACKET. 
*     RSB     - POINTER SET.
*     TQT     - POINTER SET.
* 
* DC  EXIT CONDITIONS 
* 
*     THE RECORD HAS PASSED ALL OF THE RECORD LEVEL CHECKS, AND, IF A 
*     DBST EXISTS FOR THE RUN-UNIT THAT IS LONG ENOUGH TO INCLUDE THE 
*     AREA NAME, THEN THE AREA NAME HAS BEEN STORED IN THE DBST.
*     ELSE, IF THE RECORD DID NOT PASS ALL OF THE RECORD-LEVEL CHECKS,
*     OR THE AREA IS DOWN 
*     THEN THE REQUEST HAS BEEN ABORTED.
* 
* DC  CALLED ROUTINES 
# 
      XREF PROC DB$ERR;      #CDCS ERROR PROCESSOR# 
      XREF PROC DB$FLOP;     # GENERATE FLOW POINT                     #
      XREF PROC DB$SFIT;     #SET UP FIT FOR IO#
# 
* DC  NON-LOCAL VARIABLES 
* 
*     RSB - RSFCAORD,RSFCRORD,RSARRORD SET. 
 #
  
  
  
      CONTROL NOLIST;        #*CALL CSTRCDCLS#
*CALL CSTRCDCLS 
      CONTROL LIST; 
      CONTROL NOLIST;        #*CALL CSTARDCLS#
*CALL CSTARDCLS 
      CONTROL LIST; 
*CALL DBSTDCLS
#     THE FOLLOWING TWO BASED ARRAYS ARE USED WHEN COPYING THE         #
#     AREA NAME FROM THE CST AREA WORK BLOCK TO THE DBST.              #
  
      BASED ARRAY CSTAREANAME;     # TO BE BASED AT THE AREA NAME IN   #
                                   # THE CST AREA WORK BLOCK           #
        BEGIN 
        ITEM CSTAREAWD  C(00,00,10);
        END 
  
      BASED ARRAY DBAREANAME;      # TO BE BASED AT THE AREA NAME IN   #
                                   # THE DBST                          #
        BEGIN 
        ITEM DBAREAWD   C(00,00,10);
        END 
  
  
      ITEM I;                      # FOR LOOPS                         #
  
  
  
#     B E G I N   D B $ R C H K   E X E C U T A B L E   C O D E .      #
  
 #
* 
* DC  DESCRIPTION 
* 
*     IF ILLEGAL RECORD AREA THEN ERROR.
 #
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("RCHK   "); 
      CONTROL ENDIF;
  
      IF RCPARORD[0] LQ 0 
       OR RCPARORD[0] GR CSFRECNO[0]
       THEN 
         BEGIN
         DB$ERR(27);
         END
 #
*     SET RSFCRORD,P<RSRECBLK>,RSFCAORD,P<RSARBLK>,P<OFT>,P<FKL>,P<FPT>.
 #
      RSFCRORD[0] = RCPARORD[0];
      SETRSRECBLK;
      P<CSRECBLK> = P<CSFIXED>+RSRCCSTP[0]; 
      RSFCAORD[0] = CSRWITHN[0];
      SETRSARBLK; 
      RSARRORD[0] = RCPARORD[0];
      P<OFT> = RSAROFIT[0]; 
      RCOFTLOC[0] = LOC(OFT); 
      P<FKL> = RSFFKLLOC[0];
      IF RSARFPT[0] NQ 0
      THEN
        BEGIN 
        P<FPT> = LOC(FKL) + RSARFPT[0]; 
        END 
 #
*     IF A DBST HAS BEEN ESTABLISHED FOR THE RUN-UNIT THAT IS LONG
*     ENOUGH TO INCLUDE THE AREA NAME, THEN STORE THE AREA NAME 
*     IN THE DBST.
 #
      IF TQDBSTLW[0] GQ DFDBSTAREA
      THEN
        BEGIN 
        P<CSAREBLK> = LOC(CSFIXED) + RSARCSTP[0]; 
                                   # POINT THE CST AREA WORK BLOCK     #
        P<CSTAREANAME> = LOC(CSANAME[0]); 
                                   # POINT TO AREA NAME IN THE CST     #
        P<DBST> = TQDBSTSCP[0];    # POINT TO THE SCP-SIDE DBST        #
        P<DBAREANAME> = LOC(DBAREA[0]); 
                                   # POINT TO THE AREA NAME IN THE DBST#
        FOR I=0 STEP 1             # STORE THE AREA NAME IN THE DBST,  #
                                   # LEFT-JUSTIFIED, BLANK-FILLED      #
          UNTIL 2 
        DO
          BEGIN 
          IF I LS CSANAMLW[0] 
          THEN
            BEGIN 
            DBAREAWD[I] = CSTAREAWD[I]; 
            END 
          ELSE
            BEGIN 
            DBAREAWD[I] = " ";
            END 
          END 
        END 
 #
*     IF AREA IS DOWN CALL ERROR PROCESSOR
 #
      IF OFSTATUS[0] NQ S"UP" AND 
        OFSTATUS[0] NQ S"IDLING"
         THEN 
           BEGIN
           DB$ERR(10);
           END
 #
*     IF AREA NOT OPEN THEN ERROR.
 #
      IF RSARFPT[0] EQ 0 THEN 
        DB$ERR(13); 
      IF FPFITFNF[0]         # CHECK FOR OUTSTANDING ERRORS            #
      THEN
        BEGIN 
        DB$ERR(63); 
        END 
 #
*     SET UP FIT. 
 #
      DB$SFIT;
      END  #DB$RCHK#
      TERM; 
