*DECK DDLPRS
USETEXT CCTTEXT 
USETEXT DBTEXT
PROC DDLPRS;
  
CONTROL NOLIST ;
*CALL DEBUGVARS 
*CALL,DBSAT 
*CALL GETSET
*CALL TABLNAMES 
*CALL CTXTVALS
*CALL PLT1
*CALL PLTVALS 
*CALL RW
CONTROL LIST ;
START("NX") 
CONTROL IFNQ CB5$CDCS,"NO"; 
    ITEM OCCWA U;            #SS ADDRESS OF NEXT (ITEM ENTRY) OCCURS WD#
    ITEM MVCT  I  ; # CHAR COUNT WHEN MOVING NAMES #
    ITEM CHRL  I  ;  # NO OF CHARS TO MOVE #
    ITEM ACOLUMN I;          #SOURCE COLUMN NUMBER# 
    ITEM ALINE I;            #SOURCE LINE NUMBER# 
    ITEM LRECLISTWA I;       #SUBSCHEMA RECORDLIST WORD ADDRESS#
    ITEM LRECLISTLEN I;      #RECORDLIST SIZE IN WORDS# 
    ITEM RDRECSIZE I;        #NUMBER OF RECORDLIST WORDS TO BE READ#
  
    ARRAY ITM88LIT [1:1] S(26);  #CONTAINS 88 ITEM LITERAL# 
    BEGIN 
      ITEM LIT88 C(0,0,20); 
    END 
    ITEM LITCHARLGTH U; 
    ITEM LITDECPT U;
    ITEM LITPLTYPE U; 
    ITEM LITPTRLR U;
    ITEM LITPTRNXT B; 
    ITEM LITPTRTHRU B;
    ITEM LITPTRWA U;
    ITEM LITSIGN U; 
    ITEM LITTYPE B; 
    ITEM LITWA U; 
    ITEM LITWORDLGTH U; 
    ITEM TEMP U;
    XREF
    BEGIN 
      ITEM CTYP I;
      ITEM CVALUE I;
      ITEM PLSTNEXT I;
      ITEM PLTNEXT I; 
      PROC DDLCTEXT;
    END 
XDEF  BEGIN 
    PROC NXTASS;
    PROC NXTRSS;
    PROC NXTISS;
    PROC NXTIND;
    PROC NXTRLSS; 
    PROC DATSPACE;
  END 
XREF PROC DDLSS;
XREF  BEGIN 
ITEM CURAREA;                #ORDINAL OF CURRENT SAT ENTRY# 
ITEM NUMRELS I;              #NUMBER OF RELATIONS#
ITEM DNTNEXT U;              #DNT ENTRY POINTER#
END 
XREF  BEGIN 
ITEM DATNAM    C(30) ;   #  DATANAME# 
ITEM DALEV     I     ;   # LEVEL    # 
ITEM DALINE    I     ;   # SSCH LINE NO # 
ITEM DALEN     I     ;   # DATNAM LENGTH #
  
ITEM  OCCPT  I ;  #PTR TO CCCURS INDEX #
ITEM  OCCLR  I ;  # LEFT/RIGHT FALG FOR INDEX ENTRY # 
ITEM  OCCADD I ;  # POINTER TO INDEX NNAME #
ITEM  OCCLEN I ;  # LENGTH OF INDEX NAME #
ITEM  OCCNXT  B ;  # NEXT ENTRY FLAG 1=YES #
END 
  
XREF BASED  ARRAY DATN[1:1];
BEGIN 
ITEM DATNMC  C(0,0,10); 
  ITEM DATNM U(0,0,60);     #  INDEX-NAME AS INTEGER #
END 
  
DEF DIAGNOS(SEV,NUM,LINE,COL) 
         #INTERCEPTOR(COL,LINE,NUM-1000,SEV)#;
DEF ERR1200  #1200#;
DEF ERR1201  #1201#;
DEF ERR1202  #1202#;
DEF ERR1206  #1206#;
DEF ERR1207  #1207#;
DEF ERR1210  #1210#;
  
# 
# 
PROC SSIRDCHK;
START("SSIRDCHK")            #TEST FOR ERROR AFTER ITEM ENTRY -DA$GTSB-#
IF DASTATE NQ 0 
THENB("SS ENTRY READ ERROR")
  DIAGNOS(0,ERR1202,ALINE,ACOLUMN); 
  SETO("ITM$F",ITM$F,1) 
  QUIT
ENDIF 
FINIS("SSIRDCHK") 
# 
# 
PROC DATSPACE ; 
START("DATSPACE") 
        # SPACE FILL THE NAME IN DATNAM  #
FOR MVCT = 0 STEP 1 UNTIL 29 DO 
   BEGIN
  
     IF C<MVCT,1>DATNAM EQ 0
      THEN C<MVCT,1>DATNAM = " " ;
   END
FINIS("DATSPACE") 
# 
# 
PROC RDRECLIST; 
START("RDRECLIST")  #READ (A PORTION OF) THE SUBSCHEMA AREA RECORDLIST# 
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")
    DIAGNOS(0,ERR1200,ALINE,ACOLUMN); 
    QUIT
ENDIF 
SETO("LRECLISTWA",LRECLISTWA,LRECLISTWA + RDRECSIZE)
SETO("LRECLISTLEN",LRECLISTLEN,LRECLISTLEN - RDRECSIZE) 
 CONTROL IFEQ CB5$CDCS,"CDCS1"; 
SETO("RECINAREA",RECINAREA,RDRECSIZE * 2)  #NO. OF RECORDS, +1 PERHAPS# 
SETO("RECLIST/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 RECORDLIST BUFFER# 
FINIS("RDRECLIST")
  CONTROL EJECT  ;
PROC NXTASS;
START("NXTASS") 
  
# 
  
  THIS PROCEDURE IS USED TO PROCESS THE CURRENT AREA NAME 
  IN THE SUB-SCHEMA ACCESS TABLE (SAT) .
  THE AREALIST HAS BEEN READ IN -DDLSS- (WHICH HAS BEEN CALLED FIRST
  THING IN DATA DIVISION PROCESSING). 
  1) SCAN DOWN  THE AREALIST ENTRIES LOKING FOR THE REQUIRED
     AREALIST , TO LOCATE THE POINTER TO THE RECORD LIST(RECLOFFP)
     AND THE RECORD LIST LENGTH (RECLISTLEN*2). 
  
  2) READ THE SELECTED RECORDLIST AND SET UP POINTERS AND 
    INDICATORS FOR THE RECORD READ ROUTINE(NXTRSS) .
  
# 
 NXTASS1: 
  IF CURAREA GR SSNUMAREAS
    THENB("ALL AREAS PROCESSED")
      SETO("AREA$F",AREA$F,1) 
    ELSEB("NEXT SAT ENTRY") 
      SETI("AREALISTPTR",AREALISTPTR,$G(SATPTR,SAT$,CURAREA)) 
  
     CONTROL IFEQ CB5$CDCS,"CDCS2"; 
      DA$GTSB(AREALIST,AREALISTES,SBCWRLMLSTAD[1]+((AREALISTPTR-1)* 
              AREALISTES));  #READ SS AREALIST ENTRY# 
      IF DASTATE NQ 0 
        THENB("ERROR IN READING AREALIST")
          DIAGNOS(0,ERR1207,0,253);  #253 INDICATES ERROR IS SS-RELATED#
          QUIT
      ENDIF 
      SETC("DATNAM",DATNAM,AREANAME[1]) 
     CONTROL FI;
     CONTROL IFEQ CB5$CDCS,"CDCS1"; 
    SETC("DATNAM",DATNAM,AREANAME[AREALISTPTR]) 
     CONTROL FI;
  DATSPACE ;
  SETO("DALEV",DALEV,51)
  SETI("DALINE",DALINE,$G(SATLINE,SAT$,CURAREA))
         #  THE REQUIRED PARAMETERS HAVE BEEN SET UP FOR BUILDDNT#
  
  
  
  
  
   CONTROL IFEQ CB5$CDCS,"CDCS1"; 
    SETO("LRECLISTWA",LRECLISTWA,RECLOFFP[AREALISTPTR] + SBCWHASHADR[1])
    SETO("LRECLISTLEN",LRECLISTLEN,RECLISTLEN[AREALISTPTR]) 
   CONTROL FI;
   CONTROL IFEQ CB5$CDCS,"CDCS2"; 
    SETO("LRECLISTWA",LRECLISTWA,RECLOFFP[1]+SBCWRLMLSTAD[1]) 
    SETO("LRECLISTLEN",LRECLISTLEN,RECLISTLEN[1]) 
   CONTROL FI;
    SETI("ACOLUMN",ACOLUMN,$G(SATCOL,SAT$,CURAREA))  #NAME SOURCE COL#
    SETI("ALINE",ALINE,DALINE)                       #NAME SOURCE LINE# 
    #COMPLETE THE SAT ENTRY 
    # 
   CONTROL IFEQ CB5$CDCS,"CDCS1"; 
    OV$($SET$,"SATSSAADDR",AREAWA[AREALISTPTR]) 
    $S(SATSSAADDR,SAT$,CURAREA,AREAWA[AREALISTPTR]);
   CONTROL FI;
   CONTROL IFEQ CB5$CDCS,"CDCS2"; 
    OV$($SET$,"SATSSAADDR",AREAWA[1]) 
    $S(SATSSAADDR,SAT$,CURAREA,AREAWA[1]);
   CONTROL FI;
    OV$($SET$,"SATSSRLADDR",LRECLISTWA) 
    $S(SATSSRLADDR,SAT$,CURAREA,LRECLISTWA);
    OV$($SET$,"SATSSRLLEN",LRECLISTLEN) 
    $S(SATSSRLLEN,SAT$,CURAREA,LRECLISTLEN);
    IV$($SET$,"SATFDDNATPTR",DNTNEXT) 
    $S(SATFDDNATPTR,SAT$,CURAREA,DNTNEXT);
    SETO("CURAREA",CURAREA,CURAREA+1) 
  
    RDRECLIST;  #READ (A PORTION OF) THE RECORDLIST FOR THIS AREA#
    IF DASTATE NQ 0 
      THENB("IGNORE THIS AREA") 
        GOTO NXTASS1;  #TRY NEXT AREA ENTRY#
    ENDIF 
  
    SETO("AREA$F",AREA$F,0)     # AREA STATUS IS GOOD # 
 ENDIF
  
FINIS("NXTASS") 
CONTROL EJECT  ;
  
PROC NXTRSS;
START("NXTRSS") 
  
  
# 
# 
ITEM RECWA  ;    # ADDR OF RECORD # 
  CONTROL IFEQ CB5$CDCS,"CDCS1";
ITEM RECENTLEN;  # LENGTH OF RECORD # 
  CONTROL FI; 
# 
       THIS PROCEDURE IS USED TO READ IN  A RECORD
        ENTRY AND PREPARE THE WAY FOR INPUT OF AN ITEM .
       1) TAKE THE NEXT POINTER FROM THE RECORD LIST AND
          READ THE INDICATED RECORD ENTRY . 
       2) FIND THE NO. OF ITEMS IN THAT RECORD AND THE
          POINTER TO THE FIRST ITEM.
 #
  
  
 NXTRSS1: 
IF RECINAREA GR 0 
  THENB("MORE RECORDS ")
    SETO("RECINAREA",RECINAREA,RECINAREA-1) 
    SETO("REC$F",REC$F,0) 
                # FIND THE ADDRES AND LENGTH OF NEXT RECORD # 
  CONTROL IFEQ CB5$CDCS,"CDCS1";
   IF RECLISTR EQ 0 
     THENB("LEFT REC")
  CONTROL FI; 
       SETO("RECWA",RECWA,LRECWA[RECLISTPTR]) 
  CONTROL IFEQ CB5$CDCS,"CDCS1";
       SETO("RECENTLEN",RECENTLEN,LRECENTLEN[RECLISTPTR]) 
       SETO("RECLISTR",RECLISTR,1)
    ELSEB("RIGHT REC")
       SETO("RECWA",RECWA,RRECWA[RECLISTPTR]) 
       SETO("RECENTLEN",RECENTLEN,RRECENTLEN[RECLISTPTR]) 
       SETO("RECLISTR",RECLISTR,0)
  CONTROL FI; 
       SETO("RECLISTPTR",RECLISTPTR,RECLISTPTR+1) 
  CONTROL IFEQ CB5$CDCS,"CDCS1";
   ENDIF
  
    IF RECWA EQ 0   AND RECENTLEN  EQ 0 
      THENB("ODD NO. OF RECORDS") 
        SETO("REC$F",REC$F,1) 
        QUIT
    ENDIF 
  CONTROL FI; 
  
  
           # READ FIXED PART OF RECORD  # 
    DA$GTSB(RECA,RECASIZE,RECWA) ;
    IF  DASTATE EQ 1
       THENB("READHEAD ERROR")
  
         DIAGNOS(0,ERR1201,ALINE,ACOLUMN);
         #CANNOT READ THE RECORD HEAD FROM THE DDL LIBRARY #
         GOTO NXTRSS1;  #TRY NEXT RECORD ENTRY# 
    ENDIF 
  
  
          # GET ADDR OF NEXT ITEM  AND NO. OF ITEMS IN THE RECORD # 
    SETO("RNOI",RNOI,SBRECNBRITMS[1]) 
    SETO("RNXTITMWA",RNXTITMWA,RECWA+ SBRECNXITEMP[1])
  
  SETO("DALEV",DALEV,1) 
  SETO("DALINE",DALINE,SBRECSRCLNEN[1]) 
  DATNAM = "                              ";
  
 CONTROL IFEQ CB5$CDCS,"CDCS2"; 
  SETO("P<RECBA>",P<RECBA>,LOC(RECA)+SBRECNAMEPTR[1]) 
  IF SBRECNAMEPTR[1]+SBRECNMELENW[1] GR RECASIZE
    THENB("RECORD NAME NOT IN CORE")
      SETO("P<RECBA>",P<RECBA>,LOC(RECA)+1) 
      DA$GTSB(RECBA,SBRECNMELENW[1],RECWA+SBRECNAMEPTR[1]);  #READ
                                                            RECORD NAME#
      IF DASTATE NQ 0 
        THENB("RECORD READ ERROR")
          DIAGNOS(0,ERR1201,0,253);  #253 INDICATES ERROR IS SS-RELATED#
          GOTO NXTRSS1;      #TRY NEXT RECORD ENTRY#
      ENDIF 
  ENDIF 
 CONTROL FI;
  SETO("MVCT",MVCT,0) 
  STEPLOOP(CHRL,1,1,SBRECNMELENW[1],"MOVERECNAME")
    SETO("DATNM",DATNM[CHRL],C<MVCT,10>SBRECNAME30[1])
    SETO("MVCT",MVCT,MVCT+10) 
  ENDLOOP("RECORD MOVED") 
  DATSPACE ;
  
  ELSEB("TEST FOR MORE RECORDLIST ENTRIES") 
    IF LRECLISTLEN NQ 0 
      THENB("READ ANOTHER RECLIST PORTION") 
        RDRECLIST;
        IF DASTATE EQ 0 
          THENB("MORE RECORDS TO PROCESS")
            GOTO NXTRSS1; 
        ENDIF 
    ENDIF 
    SETO("REC$F",REC$F,1) 
ENDIF 
  
FINIS("NXTRSS") 
  CONTROL  EJECT ;
PROC NXTISS;
START("NXTISS") 
  
  
  
  
  
# 
        READ THE NEXT ITEM IN THE RECORD. 
        EXTRACT THE NAME,LEVEL AND SUB-SCHEMA 
        LINE NUMBER.
        ALSO EXTRACT THE "OCCURRS-POINTER" FOR
        USE AS AN INDICATOR IN THE NXTIND ROUTINE.
# 
IF RNOI NQ 0
  THENB("MORE ITEMS") 
  
     DA$GTSB(ITMA,ITMASIZE,RNXTITMWA) ; 
     SSIRDCHK;               #CHECK FOR SS READ ERROR#
  
  
  
    SETO("RNOI",RNOI,SBITMNEXTP[1]) 
    DATNAM = "                              " ; 
   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#
        SSIRDCHK; 
    ENDIF 
   CONTROL FI;
    SETI("MVCT",MVCT,0) 
    STEPLOOP(CHRL,1,1,SBITMNELENW[1],"MOVEITMNAME") 
      SETC("DATNM",DATNM[CHRL],C<MVCT,10>SBITMNAME30[1])
      SETI("MVCT",MVCT,MVCT+10) 
    ENDLOOP("ITEM NAME MOVED")
    DATSPACE; 
    SETO("DALEV",DALEV,SBITMLEVEL[1]) 
    SETO("DALINE",DALINE,SBITMSRCLNEN[1]) 
  
    SETO("OCCPT",OCCPT,SBITMOCCURP[1])
  
    IF OCCPT NQ 0 
    THENB("POSIBLE DEPENDS")
  
  
    SETO("ITMBA",P<ITMBA>,LOC(ITMA)+OCCPT)
    IF OCCPT GQ ITMASIZE
      THENB("OCCURS WORD NOT IN CORE")
        SETO("P<ITMBA>",P<ITMBA>,LOC(ITMA)+ITMFIXSIZE)
        DA$GTSB(ITMBA,1,RNXTITMWA+OCCPT);  #READ -OCCURS- WORD# 
        SSIRDCHK; 
    ENDIF 
    IF   SBITMOCCKNXT[1]
      THENB("POSSIBLE INDEX-NAME")
        SETO("OCCPT",OCCPT,OCCPT+1) 
        SETO("OCCWA",OCCWA,RNXTITMWA+OCCPT) 
       CONTROL IFEQ CB5$CDCS,"CDCS1"; 
        SETO("OCCLR",OCCLR,0) 
       CONTROL FI;
      ELSEB("NO INDEX-NAME")
        SETO("OCCPT",OCCPT,0) 
    ENDIF 
  
    ENDIF 
    IF DALEV EQ $LEVEL66
    THENB("LEVEL 66 ITEM")
      SETI("DALEV",DALEV,66)
    ENDIF 
    IF DALEV EQ $LEVEL88
    THENB("LEVEL 88 ITEM")
      SETI("DALEV",DALEV,88)
# 
                             THE VALUES ASSOCIATED WITH 88 LEVEL ITEMS
                             ARE ENTERED INTO THE PLT TABLE, AND
                             POINTERS THERETO IN THE CTEXT TABLE
# 
      IF SBITMVALLITP[1] EQ 0 
      THENB("NO 88 VALUE")
        DIAGNOS(0,ERR1210,ALINE,ACOLUMN); 
        SETO("ITM$F",ITM$F,1) 
        QUIT
      ENDIF 
      SETO("CTYP",CTYP,CTDNDEF) 
      SETO("CVALUE",CVALUE,DNTNEXT) 
      DDLCTEXT;              #CTEXT ATOM POINTING TO ITEM DNT ENTRY#
      SETO("P<ITMBA>",P<ITMBA>,LOC(ITMA)+SBITMVALLITP[1]) 
      SETO("LITPTRWA",LITPTRWA,RNXTITMWA+SBITMVALLITP[1]) 
     CONTROL IFEQ CB5$CDCS,"CDCS1"; 
      SETO("LITPTRLR",LITPTRLR,0)  #USE LEFT HALF OF POINTER WORD#
     CONTROL FI;
      LITPTRNXT = TRUE;      #TRUE IF ANOTHER LIT FOLLOWS#
      LITPTRTHRU = FALSE;    #TRUE IF -THRU- IN PROCESS#
      LOOP("WHILE 88 VALUES NOT ALL PROCESSED") 
        IF NOT LITPTRNXT
        THENB("88 VALUES DONE") 
          EXIT
        ENDIF 
        IF P<ITMBA> GR LOC(ITMA)+ITMASIZE-1 
        THENB("88 LITERAL PTR WORD NOT IN CORE")
          SETO("P<ITMBA>",P<ITMBA>,LOC(ITMA)+ITMFIXSIZE)
          DA$GTSB(ITMBA,ITMASIZE-ITMFIXSIZE,LITPTRWA);
          SSIRDCHK;          #CHECK FOR SS READ ERROR#
        ENDIF 
        IF LITPTRTHRU 
        THENB("THRU IN PROCESS")
          SETO("CTYP",CTYP,CTRESERVEDWD)
          SETO("CVALUE",CVALUE,RWTHRU)
          DDLCTEXT;          #CTEXT ATOM FOR RESERVED WORD -THRU-#
        ENDIF 
       CONTROL IFEQ CB5$CDCS,"CDCS1"; 
        IF LITPTRLR EQ 0
        THENB("LEFT HALF OF POINTER WORD")
       CONTROL FI;
          LITPTRNXT = SBITMLNXTLIT[1];
          LITPTRTHRU = SBITMLLITTHU[1]; 
          SETO("LITWA",LITWA,RNXTITMWA+SBITMLLITPTR[1]) 
          SETO("LITWORDLGTH",LITWORDLGTH,SBITMLLTWLEN[1]) 
          SETO("LITCHARLGTH",LITCHARLGTH,SBITMLLITLEN[1]) 
          LITTYPE = SBITMLLITTYP[1];
          SETO("LITSIGN",LITSIGN,SBITMLLITSGN[1]) 
          SETO("LITDECPT",LITDECPT,SBITMLPTLOC[1])
         CONTROL IFEQ CB5$CDCS,"CDCS1"; 
          SETO("LITPTRLR",LITPTRLR,1) 
        ELSEB("RIGHT HALF OF POINTER WORD") 
          LITPTRNXT = SBITMRNXTLIT[1];
          LITPTRTHRU = SBITMRLITTHU[1]; 
          SETO("LITWA",LITWA,RNXTITMWA+SBITMRLITPTR[1]) 
          SETO("LITWORDLGTH",LITWORDLGTH,SBITMRLTWLEN[1]) 
          SETO("LITCHARLGTH",LITCHARLGTH,SBITMRLITLEN[1]) 
          LITTYPE = SBITMRLITTYP[1];
          SETO("LITSIGN",LITSIGN,SBITMMLITSGN[1]) 
          SETO("LITDECPT",LITDECPT,SBITMRPTLOC[1])
          SETO("LITPTRLR",LITPTRLR,0) 
         CONTROL FI;
          SETO("P<ITMBA>",P<ITMBA>,P<ITMBA>+1)
          SETO("LITPTRWA",LITPTRWA,LITPTRWA+1)
       CONTROL IFEQ CB5$CDCS,"CDCS1"; 
        ENDIF 
       CONTROL FI;
        DA$GTSB(ITM88LIT,LITWORDLGTH,LITWA);  #READ THE -VALUE- LITERAL#
        SSIRDCHK;            #CHECK FOR SS READ ERROR#
        SETO("CTYP",CTYP,CTLITERAL) 
        SETO("CVALUE",CVALUE,PLTNEXT) 
        DDLCTEXT;            #CTEXT ATOM FOR PLT -VALUE- LITERAL POINTR#
                             #
                              MAKE PLT ENTRY OF -VALUE- LITERAL 
                             #
        IF NOT LITTYPE
        THENB("NUMERIC LITERAL")
          IF LITSIGN EQ 0 
          THENB("UNSIGNED") 
            SETO("LITPLTYPE",LITPLTYPE,PLTUNSGNILIT)
          ELSEB("SIGNED") 
            IF LITSIGN EQ 1 
            THENB("POSITIVE") 
              SETO("LITPLTYPE",LITPLTYPE,PLTPLUSILIT) 
            ELSEB("NEGATIVE") 
              SETO("LITPLTYPE",LITPLTYPE,PLTMINUSILIT)
            ENDIF 
          ENDIF 
          IF LITDECPT NQ 0
          THENB("NOT INTEGER")
                             #
                              ALLOW FOR DECIMAL POINT AND INSERT IT 
                              INTO THE LITERAL
                             #
            SETI("TEMP",TEMP,LITCHARLGTH-LITDECPT)
            C<TEMP+1,LITDECPT>LIT88 = C<TEMP,LITDECPT>LIT88;
            C<TEMP,1>LIT88 = "."; 
            SETI("LITCHARLGTH",LITCHARLGTH,LITCHARLGTH+1) 
            SETO("LITPLTYPE",LITPLTYPE,LITPLTYPE-PLTINTLIT+PLTNUMLIT) 
          ENDIF 
        ELSEB("NON-NUMERIC LITERAL")
          SETO("LITPLTYPE",LITPLTYPE,PLTQUOTEDLIT)
        ENDIF 
        SETFIELD(PL$LENGTH,PLT$,PLTNEXT,LITCHARLGTH); 
        SETFIELD(PL$TYPE,PLT$,PLTNEXT,LITPLTYPE); 
        SETO("CCTPLSTLEN",CCTPLSTLEN,PLSTNEXT)
        SETPLST(PLTNEXT,LOC(ITM88LIT));  #-VALUE- LITERAL TO PLTSTRING# 
        SETO("PLTNEXT",PLTNEXT,PLTNEXT+1) 
        SETO("PLSTNEXT",PLSTNEXT,CCTPLSTLEN)
      ENDLOOP("88 VALUES DONE") 
    ENDIF 
  
    SETO("ITM$F",ITM$F,0) 
  
    SETO("RNXTITMWA",RNXTITMWA,RNXTITMWA+RNOI)
  ELSEB("NO MOREITEMS") 
    SETO("ITM$F",ITM$F,1) 
  ENDIF 
FINIS("NXTISS") 
  CONTROL EJECT  ;
PROC  NXTIND; 
START("NXTIND") 
  
                   # SEARCH THROUGH THE ITEM ENTRY LOOKING #
                   #FOR THE NEXT POINTER TO AN -INDEX- ENTRY# 
                   # MOVE THE INDEX NAME INTO DATNAM AND THE# 
                   # LEVEL IS SET TO 56.  WHEN THE INDEX LIST#
                   # IS EXHAUTSED, SET THE -OCCURS POINTER-#
                   # TO ZERO.  NXTISS WILL THEN MOVE TO THE NEXT# 
                   # ITEM ENTRY.   #
  
  
  
LOOP("LOOKING FOR OCCURS")
  
  
          #  SET THE BASE OF THE VARIABLE ITEMPART
                ACCORDING TO THE VALUE IN THE INDEX PTR # 
SETO("ITMBA",P<ITMBA>,LOC(ITMA)+OCCPT)
IF OCCPT GQ ITMASIZE-3
  THENB("OCCURS WORD MAY NOT BE IN CORE") 
    SETO("P<ITMBA>",P<ITMBA>,LOC(ITMA)+ITMFIXSIZE)
    SETO("OCCPT",OCCPT,ITMFIXSIZE)
    DA$GTSB(ITMBA,ITMASIZE-ITMFIXSIZE-3,OCCWA);  #READ -OCCURS- WORDS - 
                             ALLOW 3 WORDS FOR POSSIBLE KEY NAME READ#
    SSIRDCHK; 
  ENDIF 
  
  
 CONTROL IFEQ CB5$CDCS,"CDCS1"; 
         # SELECT LEFT OR RIGHT INDEX INFO FIELDS , THEN
           EXTRACT THE INDEX AND LENGTH OF THE INDEX NAME # 
IF OCCLR  EQ 0
   THENB("LEFT INDEX ") 
 CONTROL FI;
     SETO("OCCADD",OCCADD,SBITMOCCLINP[1])
     SETO("OCCLEN",OCCLEN,SBITMOCCLINL[1])
     OCCNXT = SBITMOCCLNXT[1] ; 
 CONTROL IFEQ CB5$CDCS,"CDCS1"; 
     SETO("OCCLR",OCCLR,1)
  ELSEB("RIGHT INDEX")
     SETO("OCCADD",OCCADD,SBITMOCCRINP[1])
     SETO("OCCLEN",OCCLEN,SBITMOCCRINL[1])
     OCCNXT = SBITMOCCRNXT[1] ; 
     SETO("OCCLR",OCCLR,0)
 CONTROL FI;
     SETO("OCCPT",OCCPT,OCCPT+1)
     SETO("OCCWA",OCCWA,OCCWA+1)
 CONTROL IFEQ CB5$CDCS,"CDCS1"; 
ENDIF 
 CONTROL FI;
  
IF NOT OCCNXT 
  THENB("LAST INDEX") 
    SETO("OCCPT",OCCPT,0) 
  ENDIF 
  
EXITIF(SBITMOCCLTYP[1],EQ,1,"INDEX FOUND")
  
ENDLOOP("REPEAT LOOK FOR INDEX")
  
  
         # SET THE BASED ARRAY TO THE NAME ENTRY,THEN MOVE
             THE NAME INTO DATNAM   # 
DATNAM = "                              ";
  
SETO("DALEN",DALEN,OCCLEN)
SETO("OCCLEN",OCCLEN,(OCCLEN+9)/10) 
SETO("P<ITMBA>",P<ITMBA>,LOC(ITMA)+OCCADD)
IF OCCADD+OCCLEN GR ITMASIZE
  THENB("KEY NAME NOT IN CORE") 
    SETO("P<ITMBA>",P<ITMBA>,LOC(ITMA)+ITMASIZE-3)
    DA$GTSB(ITMBA,OCCLEN,RNXTITMWA-RNOI+OCCADD);  #READ KEY NAME# 
    SSIRDCHK; 
ENDIF 
  
STEPLOOP(MVCT,1,1,OCCLEN,"MOVEINDEXNAME") 
  SETO("DATNM",DATNM[MVCT],SBITMINDEXNM[MVCT])
ENDLOOP("INDEXMOVED") 
  
  
DATSPACE ;      # SPACE FILL DATNAM  #
  
SETC("NAME",DATNAM,DATNAM)
SETO("LEVEL",DALEV,56)
  
FINIS("NXTIND") 
 CONTROL EJECT; 
 PROC NXTRLSS;
 START("NXTRLSS") 
 #
  MAKE AN SAT ENTRY FOR A RELATION AND SET UP FOR A DNT ENTRY (FD-TYPE) 
  FOR THE RELATION
 #
 IF NUMRELS EQ SBCWNUMRELS[1] 
   THENB("NO MORE RELATIONS") 
   SETO("REL$F",REL$F,1)
   ELSEB("PROCESS RELATION")
   IF SAT$PTR GR SATIXMAX 
     THENB("SAT OVERFLOW")
     INTERCEPTOR(253,0,ERR1206,0);  #253 INDICATES ERROR SS-RELATED#
     SETO("REL$F",REL$F,1)
     QUIT 
   ENDIF
   SETI("NUMRELS",NUMRELS,NUMRELS+1)
   SETO("AREALISTPTR",AREALISTPTR,SBCWNUMAREAS[1]+NUMRELS)
  CONTROL IFEQ CB5$CDCS,"CDCS2";
   DA$GTSB(AREALIST,AREALISTES,SBCWRLMLSTAD[1]+((AREALISTPTR-1)*
           AREALISTES));     #READ SS AREALIST ENTRY# 
   IF DASTATE NQ 0
     THENB("ERROR IN READING AREALIST") 
       DIAGNOS(0,ERR1207,0,253);   #253 INDICATES ERROR IS SS-RELATED#
       QUIT 
   ENDIF
   SETC("DATNAM",DATNAM,AREANAME[1])
  CONTROL FI; 
  CONTROL IFEQ CB5$CDCS,"CDCS1";
   SETC("DATNAM",DATNAM,AREANAME[AREALISTPTR])
  CONTROL FI; 
   DATSPACE;
   SETO("DALEV",DALEV,51)    #LIKE AN FD# 
   SETO("DALINE",DALINE,0)
  CONTROL IFEQ CB5$CDCS,"CDCS1";
   OV$($SET$,"SATSSAADDR",AREAWA[AREALISTPTR])
   $S(SATSSAADDR,SAT$,SAT$PTR,AREAWA[AREALISTPTR]); 
  CONTROL FI; 
  CONTROL IFEQ CB5$CDCS,"CDCS2";
   OV$($SET$,"SATSSAADDR",RELATIONADR[1]) 
   $S(SATSSAADDR,SAT$,SAT$PTR,RELATIONADR[1]);
  CONTROL FI; 
   $S(SATRELFLAG,SAT$,SAT$PTR,1);  #SET FLAG INDICATING RELATION# 
   IV$($SET$,"SATFDDNATPTR",DNTNEXT)
   $S(SATFDDNATPTR,SAT$,SAT$PTR,DNTNEXT); 
   IV$($SET$,"SATPTR",AREALISTPTR)  #SS AREALIST POINTER# 
   $S(SATPTR,SAT$,SAT$PTR,AREALISTPTR); 
   SETI("SAT$PTR",SAT$PTR,SAT$PTR+1)
   SETO("REL$F",REL$F,0)
 ENDIF
 FINIS("NXTRLSS") 
  
  
# 
# 
CONTROL FI; 
FINIS("DDLPRS") 
  
TERM
