*DECK,DBSLNXREL 
USETEXT CCTTEXT 
USETEXT DBTEXT
USETEXT DNTEXT
PROC NXTREL;
*CALL,AUXT1 
*CALL,AUXTVALS
*CALL,DBRQTENT
*CALL,DBSAT 
*CALL DEBUGVARS 
*CALL,DNATVALS
*CALL NAMET 
*CALL DNT 
*CALL,FNAT1 
*CALL,FNATVALS
*CALL,GETSET
*CALL,HASHTAB 
*CALL,TABLNAMES 
CONTROL IFNQ CB5$CDCS,"NO"; 
 XDEF ITEM DNTNU I; 
 XDEF ITEM DNTPTR I;
 XDEF PROC DNTFIND; 
 XDEF ITEM SSFIRSTIDNAT I;
 XDEF ITEM SSLASTIDNAT I; 
 XREF ITEM SATINDX I;        #INDEX IN SAT# 
 XREF PROC BASIC$F; 
 XREF PROC BUILDFD; 
 XREF PROC IERR$; 
 XREF FUNC HASH U;
 XREF FUNC HASHNM U;
          ITEM AUXTNEXTPTR I; 
          ITEM ENTRYLEN I;
          ITEM FNATFIELD I; 
          ITEM FNATTRAVPTR I; 
          ITEM HASHIX I;
          ITEM IX I;
          ITEM RELENTWA U;
          ITEM RELORD I;
          ITEM RELUFLAG I;
          ITEM RQTATTRWA I; 
          ITEM RQTHDRWA I;
          ITEM RQTPTR I;
          ITEM RQTWA I; 
          ITEM RSTWA I; 
 XDEF ARRAY DN [0:0] S(3);
        BEGIN 
          ITEM DATANAME C(0,0,30);
          ITEM DN1      C(0,0,10);
          ITEM DN2      C(1,0,10);
          ITEM DN3      C(2,0,10);
        END 
# 
# 
 PROC AUXTCHAIN;
                 #ADD AN ENTRY TO THE END OF THE AUXTABLE CHAIN 
                   -CCTAUXTLEN- CONTAINS THE POINTER TO THE ENTRY TO
                                BE ADDED
                   -AUXT$PTR-   CONTAINS THE POINTER TO THE FIRST ENTRY 
                                IN THE CHAIN                           #
 START("AUXTCHAIN") 
 LOOP("TO END OF CHAIN")
   SETI("AUXTNEXTPTR",AUXTNEXTPTR,$G(AX$TNEXTPTR,AUX$,AUXT$PTR))
   EXITIF(AUXTNEXTPTR,EQ,0,"END OF CHAIN")
   SETI("AUXT$PTR",AUXT$PTR,AUXTNEXTPTR)
 ENDLOOP("END OF CHAIN")
 $S(AX$TNEXTPTR,AUX$,AUXT$PTR,CCTAUXTLEN);  #PTR TO NEW END OF CHAIN# 
 FINIS("AUXTCHAIN") 
# 
# 
CONTROL EJECT;
FUNC COMPNAMES B; 
#  THIS FUNCTION COMPARES NAMES IN THE DNT (NAMET) AND DN # 
#  RETURNS TRUE IF =, FALSE IF NOT #
BEGIN 
ITEM NAMETPTR I;
ITEM LENGTH   I;
ITEM REALDNT  I;
  
REALDNT = VIRTUAL(DNT$,DNTPTR); 
NAMETPTR = DNTNAMETPTR[REALDNT];
LENGTH = DNTNBRWORDS[REALDNT];
IF NAMET$CHARS[VIRTUAL(NAMET$,NAMETPTR)] EQ DN1 
THEN
  IF LENGTH GR 1
  THEN
    IF NAMET$CHARS[VIRTUAL(NAMET$,NAMETPTR + 1)] EQ DN2 
    THEN
      IF LENGTH GR 2
      THEN
        IF NAMET$CHARS[VIRTUAL(NAMET$,NAMETPTR + 2)] EQ DN3 
        THEN
          COMPNAMES = TRUE; 
        ELSE
          COMPNAMES = FALSE;
      ELSE
        COMPNAMES = TRUE; 
    ELSE
      COMPNAMES = FALSE;
  ELSE
    COMPNAMES = TRUE; 
ELSE
  COMPNAMES = FALSE;
RETURN; 
END 
CONTROL EJECT;
 PROC DNTFIND(DNTLO,DNTHI);  #FIND DNT (AND DNAT) POINTER OF AN ITEM
                               -DATANAME[0]- CONTAINS THE ITEM NAME 
                               -DNTLO-/-DNTHI- - CONTAIN THE MIN/MAX
                                 BOUNDS WHEREIN THE DNT PTR MUST LIE
                               EXIT WITH -DNTPTR- CONTAINING THE DNT
                                POINTER, OR 0 IF NO DNT ENTRY 
                                    AND 
                                -DNTNU- NON-ZERO IF ITEM NAME IS NON- 
                                UNIQUE WITHIN THE DNT#
  
          ITEM DNTHI I; 
          ITEM DNTLO I; 
          ITEM BIGHASH U; 
  
 START("DNTFIND") 
 HASHIX = HASH(DN);     # HASH TABLE INDEX #
 BIGHASH = HASHNM(DN);   # HASH NAME FOR COMPARE #
 SETI("DNTNU",DNTNU,0)
 SETI("DNTPTR",DNTPTR,DNTHASHPTR[HASHIX])  #DNT PTR OF 1ST IN CHAIN#
 LOOP("TO FIND MATCHING DNT") 
   EXITIF(DNTPTR,EQ,0,"NO MATCHING DNT")
   IF $G(DNTBIGHASH,DNT$,DNTPTR) EQ BIGHASH AND 
      COMPNAMES 
     THENB("MATCHING DNT FOUND")
     IF DNTPTR GQ DNTLO AND DNTPTR LQ DNTHI 
       THENB("POSSIBLE FIND") 
       SETI("LEVEL",ILEVEL,$G(DNTLEVEL,DNT$,DNTPTR))
       IF (ILEVEL GQ 1 AND ILEVEL LQ 50) OR ILEVEL EQ 52
                             #LEVEL IS 1 THRU 49, 77 (50) OR 66 (52)# 
          OR (ILEVEL EQ 0 AND DNTHI EQ CCTDNTLEN) 
                             #LEVEL IS 1 (0) IN W-S AND LINKAGE SECS# 
         THENB("DNT FOUND") 
         IF $G(DNTNOTUNIQUE,DNT$,DNTPTR) NQ 0 
           THENB("NAME IS NOT UNIQUE")
           SETI("DNTNU",DNTNU,1)
         ENDIF
         QUIT 
       ENDIF
     ENDIF
   ENDIF
   SETI("DNTPTR",DNTPTR,$G(DNTLINK,DNT$,DNTPTR))  # NEXT LINK # 
 ENDLOOP("TEST NEXT LINK")
 FINIS("DNTFIND") 
# 
# 
 PROC SERRCHK;
                             #CHECK FOR SUB-SCHEMA ERROR (AFTER 
                              -DA$GTSB-), AND IF SO, ISSUE DIAGNOSTIC 
                              AND ABORT#
 START("SERRCHK") 
 IF DASTATE NQ 0
   THENB("SS READ ERROR") 
   $S(FN$ABORT,FNAT$,FNAT$PTR,1);  #SET ABORT BIT#
   IERR$(L28,ABORT);
 ENDIF
 FINIS("SERRCHK") 
 CONTROL EJECT; 
CONTROL FI; 
 START("NXTREL")
CONTROL IFNQ CB5$CDCS,"NO"; 
 SETI("SATINDX",SATINDX,SATINDX+1)
 IF SATINDX EQ SAT$PTR
   THENB("NO MORE RELATIONS") 
   SETI("REL$F",REL$F,END$STATUS) 
   QUIT 
 ENDIF
 IF $G(SATRELFLAG,SAT$,SATINDX) NQ 1
   THENB("NOT A RELATION")   # SAT AND CTEXT OUT OF SYNC# 
   IERR$(L29,ABORT);
 ENDIF
 IF FNAT$PTR EQ 0 
   THENB("NO SELECTED AREAS") 
   IERR$(L30,ABORT);
 ENDIF
 SETI("RELUFLAG",RELUFLAG,$G(SATRELUFLAG,SAT$,SATINDX)) 
 IF RELUFLAG EQ 0 
   THENB("RELATION NOT USED") 
   IF $G(SATFDL,SAT$,SATINDX) EQ 0
     THENB("NOT FDLT-DEFINED RELATION") 
     QUIT 
   ENDIF
 ENDIF
 SETI("FNAT$PTR",FNAT$PTR,FNAT$PTR+1)  #ALLOCATE AN FNAT ENTRY FOR
                                        RELATION (ALL FIELDS 0)#
 SETI("DNAT$PTR",DNAT$PTR,$G(SATFDDNATPTR,SAT$,SATINDX))
 BUILDFD;                    #CREATE FD DNAT AND LINAGE ITEM FOR RELATN#
 SETO("RELENTWA",RELENTWA,$G(SATSSAADDR,SAT$,SATINDX))
 DA$GTSB(RSTA,RSTFIXSIZE,RELENTWA);  #READ SS RELATION (RST) HEADER#
 SERRCHK;                    #CHECK FOR SS READ ERROR#
 SETI("RSTLEN",ENTRYLEN,RSTHIGHRANK[1])  #RST ENTRY HAS 1 WORD PAIR FOR 
                              1ST AND LAST AREA TRAVERSED (BY RELATION),
                              AND 2 WORD PAIRS FOR EACH INTERVENING AREA
                              TRAVERSED.  THUS, A 2 WORD PAIR GROUPING
                              MAY BE SPLIT PAST THE BUFFER END.#
 SETO("RSTWA",RSTWA,RELENTWA+RSTFIXSIZE+RSTRELNMELW[1])  #SS ADDRESS OF 
                                             1ST AREA PAIR IN RST ENTRY#
 SETO("RQTPTR",RQTPTR,RSTRQTPTR[1]) 
 SETO("RQTHDRWA",RQTHDRWA,RELENTWA+RQTPTR)  #SS ADDRESS OF CORRESPONDING
                                             RQT ENTRY, IF ONE# 
 SETO("RELORD",AORDINAL,RSTRELORD[1])  #RELATION ORDINAL# 
 LOOP("WHILE RST ENTRY NOT ALL READ") 
   EXITIF(ENTRYLEN,EQ,0,"RST AREA PAIRS DONE")
   DA$GTSB(RSTA,RSTASIZE,RSTWA);  #READ BUFFERFUL OF RST AREA PAIRS#
   SERRCHK;                  #CHECK FOR SS READ ERROR#
   SETO("P<RSTBA>",P<RSTBA>,LOC(RSTA))  #SET BASED ARRAY TO 1ST AREA PR#
   LOOP("WHILE RST BUFFER NOT ALL PROCESSED") 
     EXITIF(ENTRYLEN,EQ,0,"RST AREA PAIRS DONE")
     EXITIF(P<RSTBA>+1,GQ,LOC(RSTA)+RSTASIZE,"WORD PAIR NOT IN CORE") 
     SETI("IX",IX,1)
     LOOP("TO FIND IF TRAVERSED AREA SELECTED") 
       EXITIF($G(SATSSAADDR,SAT$,IX),EQ,RSTAREAADR[1],"AREA SELECTED")
       SETO("IX",IX,IX+1) 
       IF IX EQ SSNUMAREAS+1
         THENB("AREA NOT SELECTED") 
         $S(FN$ABORT,FNAT$,FNAT$PTR,1);  #SET ABORT BIT#
         IERR$(L31,ABORT);
       ENDIF
     ENDLOOP("TRAVERSED AREA TEST") 
                             #GENERATE ON AUXTABLE ENTRY IN THE CHAIN 
                              OF FD DNAT POINTERS OF AREAS TRAVERSED BY 
                              THE RELATION# 
     SETI("CCTAUXTLEN",CCTAUXTLEN,CCTAUXTLEN+1)  #ALLOCATE AUXT ENTRY#
     SETI("AUXT$PTR",AUXT$PTR,$G(FN$SSRSTLST,FNAT$,FNAT$PTR)) 
     IF AUXT$PTR EQ 0 
       THENB("FIRST AREAS AUXT ENTRY")
       $S(FN$SSRSTLST,FNAT$,FNAT$PTR,CCTAUXTLEN);  #AUXT PTR INTO FNAT# 
       ELSEB("ADD TO END OF AREAS AUXT CHAIN")
       AUXTCHAIN;            #ADD ENTRY TO END OF AUXTABLE CHAIN# 
     ENDIF
     $S(AX$TTYPE,AUX$,CCTAUXTLEN,AUXRELAREA);  #-RELATION AREA- TYPE# 
     $S(AX$FDPTR,AUX$,CCTAUXTLEN,SATFDDNATPTR[IX]);  #AREA FD DNAT PTR# 
     SETI("FNATTRAVPTR",FNATTRAVPTR,$G(DN$FNATPTR,DNAT$,
      SATFDDNATPTR[IX]))  #FNAT OF AREA TRAVERSED#
     IF RELUFLAG NQ 0 
     THENB("RELATION USED") 
     $S(FN$VREAD,FNAT$,FNATTRAVPTR,1);  #SET -READ- BIT FOR TRAVERSED 
                                         AREA#
     ENDIF
                             #IF FIRST RELATION AREA TRAVERSED, FILL IN 
                              VARIOUS ADDITIONAL RELATION FNAT FIELDS 
                              (SOME OF THESE MAY BE UNNECESSARY)# 
     IF AUXT$PTR EQ 0 
       THENB("FIRST AREA TRAVERSED")
       $S(FN$SSRELATN,FNAT$,FNAT$PTR,1);  #SS -RELATION-# 
       IF RELUFLAG EQ 0 
         THENB("FDLT-DEFINED RELATION") 
         $S(FN$SSFDLT,FNAT$,FNAT$PTR,1);  #FDLT-DEFINED RELATION# 
       ENDIF
       $S(FN$ORG,FNAT$,FNAT$PTR,DIRECT);  #NON-SEQUENTIAL#
       $S(FN$SELECT,FNAT$,FNAT$PTR,1);  #TO AVOID ERROR FROM -DA2-# 
       $S(FN$ASSIGN,FNAT$,FNAT$PTR,1);
       BASIC$F;                          #MORE FNAT FIELDS# 
                             #SET FN$ALTKPTR, FN$DRECPTR, FN$RECPTR 
                              FIELDS OF RELATION FNAT TO THOSE OF -ROOT-
                              AREA FNAT#
       SETI("FN$ALTKPTR",FNATFIELD,$G(FN$ALTKPTR,FNAT$,FNATTRAVPTR))
       $S(FN$ALTKPTR,FNAT$,FNAT$PTR,FNATFIELD); 
       IF FNATFIELD NQ 0
         THENB("ALTERNATE KEY FILE")
         $S(FN$2DASSIGN,FNAT$,FNAT$PTR,1);  #AVOID 4102 DIAG (DANALYZR)#
       ENDIF
       SETI("FN$DRECPTR",FNATFIELD,$G(FN$DRECPTR,FNAT$,FNATTRAVPTR))
       $S(FN$DRECPTR,FNAT$,FNAT$PTR,FNATFIELD); 
       SETI("FN$RECPTR",FNATFIELD,$G(FN$RECPTR,FNAT$,FNATTRAVPTR))
       $S(FN$RECPTR,FNAT$,FNAT$PTR,FNATFIELD);
       SETO("P<RSTBA>",P<RSTBA>,P<RSTBA>+2)  #UPDATE TO NEXT RST ENTRY# 
       SETO("RSTWA",RSTWA,RSTWA+2)
       ELSEB("NOT FIRST AREA TRAVERSED")
       SETO("P<RSTBA>",P<RSTBA>,P<RSTBA>+4) 
       SETO("RSTWA",RSTWA,RSTWA+4)
     ENDIF
     SETO("RSTLEN",ENTRYLEN,ENTRYLEN-1) 
   ENDLOOP("RST BUFFER PROCESSED")
 ENDLOOP("RST ENTRY PROCESSED") 
                             #GENERATE AUXTABLE ENTRIES IN THE CHAIN
                              OF RELATION QUALIFICATIONS (AN ENTRY CON- 
                              TAINING THE DNAT POINTER OF THE SS DBI
                              (DATA BASE IDENTIFIER), AND THE DNAT
                              POINTER OF THE NON-SS ITEM TO WHICH THE SS
                              DBI IS GEING COMPARED)# 
 IF RQTPTR NQ 0 
   THENB("RELATION QUALIFICATION EXISTS") 
   DA$GTSB(RQTA,RQTASIZE,RQTHDRWA);  #READ AN RQT ENTRY BUFFERFUL#
   SERRCHK;                  #CHECK FOR SS READ ERROR#
   SETI("RQTLEN",ENTRYLEN,RQTATTRIBPTR[1]-1)  #NO. RQT STACK ENTRIES# 
   SETO("RQTWA",RQTWA,RQTHDRWA+1) 
   LOOP("WHILE RQT NOT ALL READ") 
     EXITIF(ENTRYLEN,EQ,0,"RQT STACK ENTRIES DONE") 
     DA$GTSB(RQTA,RQTASIZE,RQTWA);  #READ BUFFERFUL OF RQT ENTRY# 
     SERRCHK;                #CHECK FOR SS READ ERROR#
     SETO("P<RQTBA>",P<RQTBA>,LOC(RQTA))  #SET BASED ARRAY TO 1ST STACK 
                                           ENTRY# 
     LOOP("WHILE RQT BUFFER NOT ALL PROCESSED") 
       EXITIF(ENTRYLEN,EQ,0,"RQT STACK ENTRIES DONE") 
       EXITIF(P<RQTBA>,EQ,LOC(RQTA)+RQTASIZE,"RQT BUFFERFUL DONE")
       IF RQTSTACKTYPE[1] EQ RQTTYPEVALUE 
         THENB("DATA-NAME STACK TYPE")
         SETO("RNXTITMWA",RNXTITMWA,RQTHDRWA-RQTITEMPTR[1])  #DBI ADDR# 
         DA$GTSB(ITMA,ITMASIZE,RNXTITMWA);  #READ SS DBI (ITEM) ENTRY#
         SERRCHK;            #CHECK FOR SS READ ERROR#
        CONTROL IFEQ CB5$CDCS,"CDCS2";
         SETO("P<ITMBA>",P<ITMBA>,LOC(ITMA)+SBITMNAMEPTR[1])
         IF SBITMNAMEPTR[1]+SBITMNELENW[1] GR ITMASIZE
           THENB("ITEM NAME MAY NOT BE IN CORE")
           SETO("P<ITMBA>",P<ITMBA>,LOC(ITMA)+ITMFIXSIZE) 
           DA$GTSB(ITMBA,SBITMNELENW[1],RNXTITMWA+SBITMNAMEPTR[1]); 
                                                        #READ ITEM NAME#
           SERRCHK;          #CHECK FOR SS READ ERROR#
         ENDIF
        CONTROL FI; 
         SETC("DATANAME",DATANAME[0],C<0,SBITMNMELENC[1]>SBITMNAME30[1])
                             #DBI NAME BLANK-FILLED#
         DNTFIND(SSFIRSTIDNAT,SSLASTIDNAT);  #DNT/DNAT PTR TO 
                                              -DNTPTR-# 
         IF DNTPTR EQ 0 
           THENB("NO DNT FOR SS DBI") 
           $S(FN$ABORT,FNAT$,FNAT$PTR,1); 
           IERR$(L27,ABORT);
         ENDIF
         SETI("CCTAUXTLEN",CCTAUXTLEN,CCTAUXTLEN+1)  #ALLOCATE AUX NTRY#
         SETI("AUXT$PTR",AUXT$PTR,$G(FN$SSRQTLST,FNAT$,FNAT$PTR)) 
         IF AUXT$PTR EQ 0 
           THENB("FIRST QUAL AUXT ENTRY") 
           $S(FN$SSRQTLST,FNAT$,FNAT$PTR,CCTAUXTLEN);  #AUX PTR TO FNAT#
           ELSEB("ADD TO END OF QUALS AUXT CHAIN")
           AUXTCHAIN;        #ADD ENTRY TO END OF AUXTABLE CHAIN# 
         ENDIF
                             #FILL IN PART (PTR TO DBI QUALIFIER DNAT)
                              OF NEW AUXT ENTRY#
         $S(AX$TTYPE,AUX$,CCTAUXTLEN,AUXRELQUAL); #RELATION QUALIFIER 
                                                   TYPE#
         $S(AX$DNATSSDBI,AUX$,CCTAUXTLEN,DNTPTR);  #SS DBI DNAT PTR#
         SETI("RQTATTRWA",RQTATTRWA,RQTHDRWA+RQTATRIBTEWA[1])  #SS AD-
                                                DRESS OF ATTRIBUTE NTRY#
                             #PROCESS NON-SS RELATION QUALIFIER#
         DA$GTSB(RQTATTR,RQTATTRSIZE,RQTATTRWA);  #READ ATTRIBUTE ENTRY#
         SERRCHK;            #CHECK FOR SS READ ERROR#
         SETC("DATANAME",DATANAME[0],C<0,RQTDATALENC[1]>RQTDATANM30[1]) 
                             #DATA-NAME QUALIFIER BLANK-FILLED# 
         DNTFIND(SSLASTIDNAT,CCTDNTLEN);  #DNT/DNAT PTR TO -DNTPTR-#
         IF DNTPTR EQ 0 OR DNTNU NQ 0 
           THENB("NO OR NON-UNIQUE DNT")
           $S(FN$ABORT,FNAT$,FNAT$PTR,1); 
           IERR$(L32,ABORT);
         ENDIF
         $S(AX$DNATSSDN,AUX$,CCTAUXTLEN,DNTPTR);  #NON-SS REL QUALIFI-
                                                     ER DNAT PTR TO AUX#
       ENDIF
       SETO("P<RQTBA>",P<RQTBA>,P<RQTBA>+1)  #UPDATE TO NEXT RQT STACK
                                              ENTRY#
       SETO("RQTLEN",ENTRYLEN,ENTRYLEN-1) 
     ENDLOOP("RQT BUFFER PROCESSED")
     SETO("RQTWA",RQTWA,RQTWA+RQTASIZE) 
   ENDLOOP("RQT ENTRY PROCESSED") 
 ENDIF
CONTROL FI; 
 FINIS("NXTREL")
 TERM 
