*DECK DBINDEX 
USETEXT DBTEXT
USETEXT DNTEXT
PROC INDEX; 
*CALL DEBUGVARS 
*CALL GETSET
*CALL TABLNAMES 
*CALL DNATVALS
XREF BEGIN
PROC IERR$; 
PROC NXTKI; 
END 
START("INDEX")
 CONTROL IFNQ CB5$CDCS,"NO";
#THIS PROCEDURE PEFORMS THE FOLLOWING FUNCTIONS :-
  A. IF THE BASE ADDRESS FOR ACCESSING THE KEY/INDEX ATOMS IS 
    ZERO THE PROCEDURE EXITS IMMEDIATELY. 
  B. IF THE ATOM TYPE IS NOT INDEX, AN ERROR MESSAGE IS OUTPUT. 
  C. A NEW DNAT ENTRY IS BUILT WITH DNAT$LEVEL SET TO INDEX 
    FOR EACH INDEX ATOM. NO OTHER FIELDS ARE SET. 
# 
INDEXNXT: 
IF KEYINDEXBASE EQ 0
  OR
  IKITYPE EQ $KIEND 
  THENB ("NO INDEX ATOMS")
  QUIT
ENDIF 
IF IKITYPE NQ $INDX 
  THENB ("ATOM NOT INDEX")
  IERR$(L16,ABORT); 
ENDIF 
IF $G(DN$LEVEL,DNAT$,DNAT$PTR) NQ INDXLEVL
  THENB("GRP ITEM NEEDS INDEXED BIT SET") 
  $S(DN$INDEXED,DNAT$,DNAT$PTR,1);
ENDIF 
SETI("DNAT$PTR",DNAT$PTR,DNAT$PTR+1)
                   #UPDATE DNAT PTR TO NEXT DNAT ITEM#
$S(DN$LEVEL,DNAT$,DNAT$PTR,INDXLEVL); #SET LEVEL TO INDEX#
IF IKINXT NQ 0
  THENB ("MORE ATOMS REMAIN") 
  NXTKI;  #GET NEXT KEY/INDEX ATOM# 
  GOTO INDEXNXT;
ENDIF 
 CONTROL FI;
FINIS("INDEX")
TERM
