*DECK DBSLNXRKY 
USETEXT DBTEXT
USETEXT CCTTEXT 
PROC NXTRKEY; 
*CALL DEBUGVARS 
*CALL FNAT1 
*CALL GETSET
*CALL TABLNAMES 
ITEM KNPTR I; 
ITEM SAVEDCBA I;
XREF PROC DNTFIND;
XREF PROC IERR$;
XREF ARRAY DN [0:0] S(3); 
       ITEM DATANAME C(0,0,30); 
# 
# 
PROC SERRCHK;                #CHECK FOR SUB-SCHEMA ERROR (AFTER 
                              -DA$GTSB-), AND IF SO, ISSUE DIAGNOSTIC 
                              AND ABORT#
START("SERRCHK")
 CONTROL IFNQ CB5$CDCS,"NO";
IF DASTATE NQ 0 
  THENB("SS READ ERROR")
  $S(FN$ABORT,FNAT$,FNAT$PTR,1);  #SET ABORT BIT# 
  IERR$(L2,ABORT);
ENDIF 
 CONTROL FI;
FINIS("SERRCHK")
CONTROL EJECT;
START("NXTRKEY")
CONTROL IFNQ CB5$CDCS,"NO"; 
#THIS PROCEDURE PERFORMS THE FOLLOWING FUNCTIONS :- 
  A. UNPACKS THE NEXT RECORD KEY ENTRY IN THE DATA CONTROL
     ENTRY. 
* 
NOTE: THE CALLING ROUTINE MUST AVOID CALLING THIS PROCEDURE 
WHEN NOMORE KEYS REMAIN TO BE PROCESSED 
 THE KEY ENTRY LENGTH VARIES BUT IS AT LEAST 3 WORDS LONG.  IT IS THESE 
 FIRST 3 WORDS WHICH ARE OF INTEREST HERE.
# 
IF DRKNXTPTR EQ 0 
  THENB ("SET BASED ARRAY TO FIRST KEY")
  SETO("P<DCBA>",P<DCBA>,LOC(DCA) + DKPTR)
  ELSEB ("FOLLOW CHAIN OF ATOMS") 
  SETO("P<DCBA>",P<DCBA>,P<DCBA> + DRKNXTPTR) 
ENDIF 
# ENSURE THAT FIRST 3 WORDS OF KEY ENTRY ARE IN CORE (CONTIGUOUSLY).
# 
IF P<DCBA>+3 GR LOC(DCA)+DCASIZE
  THENB("KEY ENTRY NOT IN CORE")
  SETO("AWADCE",AWADCE,AWADCE+P<DCBA>-LOC(DCA))  #SS ADDRESS OF CURRENT 
                                                  KEY ENTRY#
  DA$GTSB(DCA,DCASIZE,AWADCE);  #READ KEY ENTRY(S)# 
  SERRCHK;                   #CHECK FOR SS READ ERROR#
  SETO("P<DCBA>",P<DCBA>,LOC(DCA))
ENDIF 
SETO("DRKWA",DRKWA,SBDCRCENTRYA[1])  #REC ENTRY ADDRESS#
SETI("DRKTYPE",DRKTYPE,SBDCKEYTYPE[1])  #KEY TYPE#
SETI("DRKSZRGRP",DRKSZRGRP,SBDCKEYGRPSZ[1])  #GROUP SIZE# 
SETI("DRKMAXOCC",DRKMAXOCC,SBDCKEYMAXOC[1])  #MAX OCCURS# 
SETI("DRKBWP",DRKBWP,SBDCKEYBWP[1]) #BEGINNING WORD POSN# 
SETI("DRKBCP",DRKBCP,SBDCKEYBCP[1]) #BEGINNING CHAR POSN# 
SETI("DRKSIZE",DRKSIZE,SBDCKEYSIZ[1])  #KEY SIZE# 
SETO("DRKNXTPTR",DRKNXTPTR,SBDCKEYNITM[1])  #NEXT KEY POINTER#
IF SBDCKEYOMIT[1] 
THEN
  BEGIN 
    DRKOMIT=1;
    SETI("FN$SSMIPFIL",FN$SSMIPFIL[FNAT$PTR],1); #SET MIP FILE FLAG#
    CCTMIPOO = TRUE;   #SET GLOBAL CDCS MIP FLAG# 
  END 
ELSE
  DRKOMIT=0;    #NO ALT. KEYS OMITTED FOR THIS FILE#
IF SBDCKEYIMBED[1] THEN DRKIMBED=1; ELSE DRKIMBED=0;
IF SBDCKEYPRI[1] THEN DRKPRIMARY=1; ELSE DRKPRIMARY=0;
      IV$($SET$,"DRKIMBED",DRKIMBED)
                     IV$($SET$,"DRKPRIMARY",DRKPRIMARY) 
IF DRKIMBED EQ 0
  THENB ("KEY IS NON IMBEDDED") 
  SETI("DRKNAMLEN",DRKNAMLEN,SBDCKEYDNLEN[1]) 
  SETO("KNPTR",KNPTR,P<DCBA>+SBDCKEYDNPTR[1]) 
  IF KNPTR+((DRKNAMLEN+9)/10) GR LOC(DCA)+DCASIZE 
    THENB("KEY NAME NOT IN CORE") 
    DA$GTSB(DN,3,AWADCE+KNPTR);  #READ (NON-IMBEDDED) KEY NAME# 
    SERRCHK;                 #CHECK FOR SS READ ERROR#
    SETC("DATANAME",DATANAME[0],C<0,DRKNAMLEN>DATANAME[0])  #KEY NAME 
                                                           BLANK-FILLED#
    ELSEB("KEY NAME IN CORE") 
    SAVEDCBA = P<DCBA>; 
    SETO("P<DCBA>",P<DCBA>,KNPTR)  #SET TO KEY NAME#
    SETC("DATANAME",DATANAME[0],C<0,DRKNAMLEN>SBDCKEYDNME[1])  #KEY NAME
                                                           BLANK-FILLED#
    P<DCBA> = SAVEDCBA; 
  ENDIF 
  DNTFIND(DNTFIRST,CCTDNTLEN);  #KEY DNAT POINTER TO -DNTPTR-#
  IF SBDCKEYDNNXT[1] THEN DRKNXT=1;  ELSE DRKNXT=0;  #1 IF QUAL FOLLOWS#
      IV$($SET$,"DRKNXT",DRKNXT)
  ELSEB ("KEY IS EMBEDDED") 
  SETO("DRKWA",DRKWA,SBDCKEYDNADR[1])  #WORD ADDR OF KEY# 
ENDIF 
CONTROL FI; 
FINIS("NXTRKEY")
TERM
