*DECK DBSLNXREC 
USETEXT DBTEXT
PROC NXTREC;
*CALL DEBUGVARS 
*CALL,DBSAT 
*CALL GETSET
*CALL TABLNAMES 
XREF PROC IERR$;
START("NXTREC") 
CONTROL IFNQ CB5$CDCS,"NO"; 
#THIS PROCEDURE PERFORMS THE FOLLOWING FUNCTIONS :- 
  A. IF MORE RECORDS REMAIN TO BE PROCESSED (ACCORDING
     TO THE COUNT IN THE AREA LIST ENTRY) THEN THE
     RECORD LIST WILL BE ACCESSED TO GET THE WORD ADDRESS 
     AND LENGTH OF THE NEXT RECORD ENTRY. THIS ENTRY IS 
     THEN READ IN AND UNPACKED. 
  B. IF NO MORE RECORDS ARE TO BE PROCESSED THE MODULE
     FLAG REC$F WILL BE SET TO END$STATUS.
# 
ITEM RECWA;   #RECORD ENTRY WORD ADDRESS# 
ITEM RECENTLEN;  #RECORD ENTRY LENGTH#
  
XREF ITEM SATINDX I;         #INDEX IN SAT# 
  
ITEM LRECLISTLEN I;  #RECORDLIST SIZE IN WORDS# 
ITEM LRECLISTWA I;   #RECORDLIST SS WORD ADDRESS# 
ITEM RDRECSIZE I;    #NUMBER OF RECORDLIST WORDS TO BE READ#
# 
# 
IF RECLISTPTR EQ 0
  THENB("FIRST RECORD OF AREA") 
    SETO("LRECLISTWA",LRECLISTWA,$G(SATSSRLADDR,SAT$,SATINDX))
    SETI("LRECLISTLEN",LRECLISTLEN,$G(SATSSRLLEN,SAT$,SATINDX)) 
    SETO("RECINAREA",RECINAREA,0) 
ENDIF 
IF RECINAREA EQ 0 
  THENB("TEST FOR MORE RECORDLIST ENTRIES") 
    IF LRECLISTLEN EQ 0 
      THENB("NO MORE RECORDS")
        GOTO NXTRECX; 
    ENDIF 
    IF LRECLISTLEN LQ RECLISTSIZE 
      THENB("RECLIST FITS IN BUFFER") 
        SETO("RDRECSIZE",RDRECSIZE,LRECLISTLEN) 
      ELSEB("RECLIST EXCEEDS BUFFER") 
        SETO("RDRECSIZE",RDRECSIZE,RECLISTSIZE) 
    ENDIF 
    DA$GTSB(RECLIST,RDRECSIZE,LRECLISTWA);
    IF DASTATE NQ 0 
      THENB("RECORDLIST READ ERROR")
        IERR$(L6,ABORT);
    ENDIF 
    SETO("LRECLISTWA",LRECLISTWA,LRECLISTWA + RDRECSIZE)
    SETO("LRECLISTLEN",LRECLISTLEN,LRECLISTLEN - RDRECSIZE) 
   CONTROL IFEQ CB5$CDCS,"CDCS1"; 
    SETO("RECINAREA",RECINAREA,RDRECSIZE * 2)  #NO. OF RECS, +1 PERHAPS#
    SETO("RECLISTL/R",RECLISTR,0)  #ACCESS LEFT HALF OF RECLIST WORD# 
   CONTROL FI;
   CONTROL IFEQ CB5$CDCS,"CDCS2"; 
    SETO("RECINAREA",RECINAREA,RDRECSIZE)  #NUMBER OF RECORDS#
   CONTROL FI;
    SETO("RECLISTPTR",RECLISTPTR,1)  #INDEX INTO RECLIST BUFFER#
CONTROL IFEQ CB5$CDCS,"CDCS2";
ELSEB("MORE RECORDS") 
  SETO("RECLISTPTR",RECLISTPTR,RECLISTPTR + 1); 
CONTROL FI; 
ENDIF 
  SETI("RECINAREA",RECINAREA,RECINAREA-1) #COUNTDOWN NO OF RECS#
 CONTROL IFEQ CB5$CDCS,"CDCS1"; 
  IF RECLISTR NQ 0
    THENB ("SELECT RIGHT HAND FIELDS")
    SETO("RECWA",RECWA,RRECWA[RECLISTPTR]) #WORD ADDRESS# 
    SETI("RECENTLEN",RECENTLEN,RRECENTLEN[RECLISTPTR]) #LENGTH# 
    SETI("RECLISTR",RECLISTR,0)  #FORCE EXTRACT OF LEFT ATOM# 
    SETO("RECLISTPTR",RECLISTPTR,RECLISTPTR+1) #NEXT WORD OF RECLIST# 
    ELSEB ("SELECT LEFT HAND FIELDS") 
 CONTROL FI;
    SETO("RECWA",RECWA,LRECWA[RECLISTPTR])  #WORD ADDRESS#
 CONTROL IFEQ CB5$CDCS,"CDCS1"; 
    SETI("RECENTLEN",RECENTLEN,LRECENTLEN[RECLISTPTR]) #LENGTH# 
    SETI("RECLISTR",RECLISTR,1)  #FORCE EXTRACT OF RIGHT ATOM#
  ENDIF 
  IF RECWA EQ 0 
    AND 
    RECENTLEN EQ 0
    THENB ("ASSUME ODD NO OF RECS IN AREA") 
    GOTO NXTRECX; #SET MOD FLAG TO END$STATUS#
  ENDIF 
 CONTROL FI;
DA$GTSB(RECA,RECASIZE,RECWA); #READ FIRST CHUNK OF RECD ENT#
  IF DASTATE EQ 1 
    THENB ("ATTEMPT TO READ OUTSIDE FILE")
    IERR$(L8,ABORT);
  ENDIF 
  #UNPACK RECORD ENTRY# 
  SETI("INXTITMPTR",INXTITMPTR,SBRECNBRITMS[1])  #SET NON-ZERO FOR USE
                                                  IN -NXTITM-#
 CONTROL IFEQ CB5$CDCS,"CDCS1"; 
  IF SBRECNOKEY[1] THEN RKNOTINREC=1; ELSE RKNOTINREC=0;
      IV$($SET$,"RKNOTINREC",RKNOTINREC)
 CONTROL FI;
  SETI("RLENGTH",RLENGTH,SBRECLENGTH[1])  #REC LEN IN CHARS AS STORED#
  SETI("RORDINAL",RORDINAL,SBRECORDINAL[1]) 
  SETI("RSOURCELINE",RSOURCELINE,SBRECSRCLNEN[1])  #DDL SOURCE LINE#
  SETI("ISOURCELINE",ISOURCELINE,RSOURCELINE)  #IN CASE OF ERROR DIAG#
  SETO("RNXTITMWA",RNXTITMWA,SBRECNXITEMP[1] + RECWA) 
                   #COMPUTE NXT ITM WA# 
  QUIT
NXTRECX:  
  SETI("REC$F",REC$F,END$STATUS)
CONTROL FI; 
FINIS("NXTREC") 
TERM
