*DECK R$SUBS
USETEXT CCTTEXT 
USETEXT DNTEXT
USETEXT RPTEXT
PROC R$SUBS;
          BEGIN 
*CALL RPCOMM
*CALL DPPPDDATA 
*CALL AUXT1 
*CALL AUXTVALS
*CALL CTEXT 
*CALL CTXTVALS
*CALL DNATVALS
*CALL FDRDT1
*CALL GETSET
*CALL LAT1
*CALL PAT1
*CALL PLT1
*CALL PLTVALS 
*CALL PNAT1 
*CALL TABLNAMES 
          BEGIN 
          # LOCAL DECLARATIONS FOR R$SUBS # 
          # R$SUBS DEFS # 
          DEF    CALL1DIAG(P1,P2) #INTERCEPTOR(BIT8COL,CLINE$,P1,P2)#;
          DEF    CALL2DIAG(P1,P2,P3,P4) #INTERCEPTOR(P4,P3,P1,P2)#; 
          DEF    GETQ        #GETQUICK#;
          DEF    GET         #GETFIELD#;
          DEF    SET         #SETFIELD#;
          DEF    ZERO        #0#; 
          XREF
             BEGIN
             PROC RWSET      ;
             PROC RWSET1      ; 
             PROC SETRPAUXPTR ; 
             PROC INTERCEPTOR ; 
             FUNC RWGET       ; 
             FUNC RWGET1      ; 
             FUNC RP$AUXPTR   ; 
             END
          ITEM   CLINE$;
          ITEM   BIT8COL; 
          ITEM   $TEMP$;
          ITEM   DUPCOL;
          ITEM RWTCNT;
          ITEM   DUPLINE; 
          ITEM   TYPETEMP;
          ITEM   TEMP1; 
          ITEM   STSTEMP1;
          ITEM   STSTEMP2;
          ITEM   ABSRELTEMP;
          ITEM   I; 
          ITEM   CURDNATPTR;
          ITEM   CODEAUXINDEX;
          ITEM   PAGEAUXINDEX;
          ITEM   CNTROLAUXIDX;
          ITEM   LASTCTRLAUXI;
          ITEM   CIDNATINDEX; 
          ITEM   CAINDEX; 
          ITEM   RPAUXINDEX;
          ITEM   FIRSTSICTEXT;
          ITEM   LASTSICTEXT; 
          ITEM   FDRDINDEX; 
          ITEM   SRCEAUXINDEX;
          ITEM   SOURCEIDPTR; 
          ITEM   SUBSCRIPTCNT;
          ITEM   SAVERWT; 
          ITEM   DPTR;
          ITEM   SUMAUXINDEX; 
          ITEM   NUMUPONREFSD;
          ITEM   CTI; 
          ITEM   CCOLNO;
          ITEM   CLINENO; 
          ITEM   PAT$INDEX; 
          # R$SUBS FLAGS #
          ITEM   RPFLAGS; 
          DEF    SIERROR      #B<0,1>RPFLAGS#;
          DEF    ASUBSCRIPT   #B<1,1>RPFLAGS#;
          DEF    ANINDEXNAME  #B<2,1>RPFLAGS#;
          DEF    SUMCLAUSFLAG #B<3,1>RPFLAGS#;
          DEF    SUMIDSYNTAXO #B<4,1>RPFLAGS#;
          DEF    STOREUDETAIL #B<5,1>RPFLAGS#;
          DEF    NOTINDEXNAME #B<6,1>RPFLAGS#;
          DEF    UPON4CURRSUM #B<7,1>RPFLAGS#;
          DEF    SRCENCOUNTRD #B<8,1>RPFLAGS#;
          DEF    SUMENCOUNTRD #B<9,1>RPFLAGS#;
          DEF    VALUNCOUNTRD #B<10,1>RPFLAGS#; 
          # R$SUBS MESSAGE NUMBERS. # 
          DEF    M361        #361#; 
          DEF    M364        #364#; 
          DEF    M365        #365#; 
          DEF    M366        #366#; 
          DEF    M367        #367#; 
          DEF    M368        #368#; 
          DEF    M369        #369#; 
          DEF    M370        #370#; 
          DEF    M371        #371#; 
          DEF    M372        #372#; 
          DEF    M373        #373#; 
          DEF    M374        #374#; 
          DEF    M375        #375#; 
          DEF    M376        #376#; 
          DEF    M377        #377#; 
          DEF    M378        #378#; 
          DEF    M379        #379#; 
          DEF    M380        #380#; 
          DEF    M381        #381#; 
          DEF    M382        #382#; 
          DEF    M383        #383#; 
          DEF    M384        #384#; 
          DEF    M385        #385#; 
          DEF    M386        #386#; 
          DEF    M387        #387#; 
          DEF    M388        #388#; 
          DEF    M389        #389#; 
          DEF    M390        #390#; 
          DEF    M392        #392#; 
          DEF    M393        #393#; 
          DEF    M394        #394#; 
          DEF    M396        #396#; 
          DEF    M400        #400#; 
          DEF    M401        #401#; 
          DEF    M402        #402#; 
          DEF    M403        #403#; 
          DEF    M404        #404#; 
          DEF    M405        #405#; 
          DEF    M406        #406#; 
          DEF    M407        #407#; 
          DEF    M408        #408#; 
     SWITCH CASE   RETURNCASE,
          RPINITIALIZE,    REPSECTIONRT,    TERM$PERIOD,
          RP$EPILOGUE,     SAVELEVEL,       TESTFORTPD, 
          SETUP$RDNAME,    CODE$ALLRT,      CODE$CLAUSRT, 
          CONTROLS$RT,     CONTRL$FINAL,    CONTROL$ITEM, 
          PAGE$RT,         PAGELIMITRT,     LAST$DETAIL,
          HEADINGRT,       FOOTINGRT,       FIRST$DET$RT, 
          SETUPDNAT,       CHKIFTP,         LINE$INT$ABS, 
          LN$NEXTPAGE,     LINE$INT$REL,    NEXTGROUPABS, 
          NEXTGROUPREL,    NG$NEXTPAGE,     TYPERHRT, 
          TYPEPHRT,        TYPEPFRT,        TYPERFRT, 
          TYPEDETAIL,      TYPECHRT,        SAVCONTROLID, 
          TYPECFRT,        SAVCONTROLFI,    SETUSAGERT, 
          SETUP02DNAT,     BLANKZERORT,     COLUMNNO$RT,
          GROUPIND$RT,     JUSTIFIED$RT,    STASHPICTURE, 
          NO$ALLVALUE,     YES$ALLVALUE,    STASHVALUE, 
          STASH$SOURCE,    LC$CURRENTRD,    QUALIFIED$LC, 
          PC$CURRENTRD,    QUALIFIED$PC,    SSSUBSCRIPTS, 
          RWTESTSUBSCR,    RWINIT$FLAGS,    SAV$CTEXTPTR, 
          RWCSUBSCRIPT,    RWC$COUNTLIT,    RWCOUNTDNREF, 
          RWOFFSETDIAG,    RWSCRIPOFSET,    SETSUMCLAUSE, 
          STASHSUMIDEN,    SETUPONCLAUS,    STASHUPONREF, 
          CBLDDUMYUPON,    STRESETFINAL,    STASHRESREF,
          SAVSUMSUBSCR,    FIGZERORT,       SPACEROUTINE, 
          UPPERBOUND,      LOWERBOUND,      HIGHVALUE,
          LOWVALUE,        QUOTEROUTINE,    BADLEVEL, 
          SETTYPE8; 
          ARRAY [0:3] S(1); 
              ITEM SSERRORS U(0,0,60) = [ 
                  M401, 
                  M402, 
                  M403, 
                  M404];
             CONTROL EJECT; 
     PROC BUILDSUBTYPE; 
       BEGIN
       SAVERWT = CCTRWTABLEN; 
       FOR CTI = FIRSTSICTEXT STEP 1 UNTIL LASTSICTEXT DO 
           BEGIN
           TEMP1 = CTI/2; 
           IF CTI-TEMP1*2 EQ 1 THEN 
                BEGIN 
                TYPETEMP = GETQ(CTEXTTYPE1,CTEXT$,TEMP1+1); 
                $TEMP$ = GETQ(CTEXTATOM1,CTEXT$,TEMP1+1); 
                END 
           ELSE 
                BEGIN 
                TYPETEMP = GETQ(CTEXTTYPE2,CTEXT$,TEMP1); 
                $TEMP$ = GETQ(CTEXTATOM2,CTEXT$,TEMP1); 
                END 
           IF TYPETEMP NQ CTDELIMITER 
             THEN 
               BEGIN
               CCTRWTABLEN = CCTRWTABLEN + 1; 
               RWSET(RPAUXENTRY,CCTRWTABLEN,ZERO);
               RWSET(REPTAUXTYPE,CCTRWTABLEN,SUBINDXTYPE);
               RWSET(RASICTEXT,CCTRWTABLEN,$TEMP$); 
               END
           END
       RWSET(RALASTSINTRY,CCTRWTABLEN,1); 
       RETURN;
       END #BUILDSUBTYPE# 
            CONTROL EJECT;
          CLINE$ = LINE$; 
          BIT8COL = COLUMN$;
          GOTO CASE[SUB$];
RPINITIALIZE: 
          GOTO RETURNCASE;
RP$EPILOGUE:  
          LASTDNATINDX = CURDNATPTR;
          GOTO RETURNCASE;
REPSECTIONRT: 
          #RPARSER INITIALIZATION#
          LASTFDRDNTRY = CCTFDRDLEN;
          CURRDDNAT    = 0; 
          DNATPOINTER  = 0; 
          LASTDNATINDX = CCTDNTLEN; 
          RDLBYTOFFSET = 0; 
          NUMCIDTNTRYS = 0; 
          LASTLATINDEX = CCTLATLEN; 
          RPPLTOFFSET = CCTPLTLEN + 1;
          CIDTPTRCURRD = 0; 
          ENDCIDTCURRD = 0; 
          NUMRDCDINTRY = 0; 
          RFLAGS       = 0;    #INITIALIZE ALL COMMON FLAGS TO ZERO    #
          RHFINALLCSET = 0; 
          PFFINALLCSET = 0; 
          LNGTHLONGPLE = 0; 
          SHORTESTPLEN = 999999;
          DUMDTAILDNAT = 0; 
          FSUBT4CURRD  = 0; 
          P<RPWPTRS>   = LOC(RPAUXDUM1);    #REDEFINE POINTERS# 
          LASTPNATINDX = CCTPNATLEN;
          RPDUMSECTION = CCTRPSECTNAM;
  
          #ALLOCATE SPACE IN RWT FOR RPAUXPTR TABLE#
          #VALUE$ IS THE FIRST DNAT IN THE REPORT SECTION,   #
          #CCTDNATLEN IS THE LAST DNAT IN THE REPORT SECTION. # 
  
          TEMP1 = CCTDNTLEN - VALUE$ + 1;    #NUMBER OF REPORT SEC-  #
                                               #TION DNAT ENTRIES.     #
          CCTRWTABLEN = (TEMP1 + 3) / 4;       #4 RPAUXPTR ENTRIES PER #
                                               #WORD- NUMBER OF WORDS  #
                                               #NEEDED FOR RPAUXPTR    #
                                               #TABLE(WORD 0 NOT USED).#
          RWTCNT = 1; 
 #     MUST ALLOCATE RWT TABLE IN SECTIONS OF 100 OR LESS # 
 ALLOLOOP:  
          IF (RWTCNT + 99) LS CCTRWTABLEN THEN
              BEGIN 
              RWTCNT = RWTCNT + 98; 
              RWSET(RPAUXENTRY,RWTCNT,ZERO);
              GOTO ALLOLOOP;
              END 
          ELSE
              RWSET(RPAUXENTRY,CCTRWTABLEN,ZERO); 
  
          #INITIAL ENTRIES OF THE REPORT TABLES WILL BE ALLOCATED      #
          #IN THE INITIALIZATION PART OF RANALYZR, AFTER THE RPAUX     #
          #TABLE IS COMPLETED.                                         #
  
  
          RS1STDNAT = VALUE$; 
          CCTRSDNATPTR = VALUE$;
          CURDNATPTR = VALUE$;
          SET(DN$LEVEL,DNAT$,CURDNATPTR,RDSECTN); 
          SET(DN$TYPE,DNAT$,CURDNATPTR,NONDATA);
          GOTO RETURNCASE;
SETUP$RDNAME: 
          CURDNATPTR = VALUE$;
          SET(DN$LINE,DNAT$,CURDNATPTR,CLINE$); 
          SET(DN$LEVEL,DNAT$,CURDNATPTR,RDDESCR); 
          SET(DN$TYPE,DNAT$,CURDNATPTR,NONDATA);
          CURRDDNAT = CURDNATPTR; 
          #NOTE-# 
          #MUST SAVE LINE$  AND COLUMN=  FOR POSSIBLE DIAGNOSTICS#
          SET(DN$ITMLEN,DNAT$,CURDNATPTR,CLINE$); 
          SET(DN$POINT,DNAT$,CURDNATPTR,BIT8COL); 
          #R-GENERATOR WILL HAVE ACCESS TO THE RD DNAT AND CAN GET# 
          #THIS INFORMATION OUT OF HERE.# 
          LSTRSDNATIND = CURDNATPTR;
          IF DNATPOINTER EQ 0 
          THEN
              DNATPOINTER = CURDNATPTR; 
          #CREATE 3 RP-AUX-TABLE ENTRIES (CODE, PAGE, CONTROL)# 
          CCTRWTABLEN = CCTRWTABLEN + 1;
          RWSET(RPAUXENTRY,CCTRWTABLEN,ZERO); 
          RWSET(REPTAUXTYPE,CCTRWTABLEN,CODETYPE);
          SETRPAUXPTR(CURDNATPTR,CCTRWTABLEN);
          CODEAUXINDEX = CCTRWTABLEN; 
          #2# 
          CCTRWTABLEN = CCTRWTABLEN + 1;
          RWSET(RPAUXENTRY,CCTRWTABLEN,ZERO); 
          RWSET(REPTAUXTYPE,CCTRWTABLEN,PAGETYPE);
          PAGEAUXINDEX = CCTRWTABLEN; 
          #3# 
          CCTRWTABLEN = CCTRWTABLEN + 1;
          RWSET(RPAUXENTRY,CCTRWTABLEN,ZERO); 
          RWSET(REPTAUXTYPE,CCTRWTABLEN,CONTROLTYPE); 
          CNTROLAUXIDX = CCTRWTABLEN; 
          LASTCTRLAUXI = CCTRWTABLEN; 
          GOTO RETURNCASE;
CODE$ALLRT: 
          IF SYNTAXONLY EQ 0
          THEN
              RWSET(CODEALLSWTCH,CODEAUXINDEX,1); 
          GOTO RETURNCASE;
CODE$CLAUSRT: 
          IF RWGET(CODECLAUSPLT,CODEAUXINDEX) 
              NQ  ZERO
          THEN
              GOTO DUPLICATECLA;
          IF SYNTAXONLY EQ ZERO 
          THEN
              RWSET(CODECLAUSPLT,CODEAUXINDEX,VALUE$);
          GOTO RETURNCASE;
CONTROLS$RT:  
          IF RWGET(CONTROLOCURD,CNTROLAUXIDX) EQ 1
          THEN
              BEGIN 
              SYNTAXONLY = 1; 
              GOTO DUPLICATECLA;
              END 
          IF SYNTAXONLY EQ 0
          THEN
              RWSET(CONTROLOCURD,CNTROLAUXIDX,1); 
          GOTO RETURNCASE;
CONTRL$FINAL: 
          IF SYNTAXONLY EQ 0
          THEN
              BEGIN 
              #DNAT-PTR STAYS = 0 TO INDICATE "FINAL"#
              $TEMP$ = RWGET(NUMCONTRLIDS,CNTROLAUXIDX) + 1;
              RWSET(NUMCONTRLIDS,CNTROLAUXIDX,$TEMP$);
              RWSET(RDLINENUM,CNTROLAUXIDX,CLINE$); 
              RWSET(RDCOLUMNUM,CNTROLAUXIDX,BIT8COL); 
              END 
          GOTO RETURNCASE;
CONTROL$ITEM: 
          #FIRST CHECK IF HAVE A "VALID" CONTROL IDENTIFIER#
          #POINT =1#
          IF VALUE$ EQ 0
          THEN
              GOTO RETURNCASE;
          IF VALUE$ GQ DNATPOINTER
          THEN
              GOTO POINT$2; 
          IF GETQ(DN$TYPE,DNAT$,VALUE$) EQ ERRTYPE
          THEN
              CALL1DIAG(M364,PROPAGATED); 
          #DIAG M364# 
          #AN ERROR WAS DETECTED IN THE DESCRIPTION OF THIS ITEM. THE # 
          #ERROR MUST BE CORRECTED BEFORE THIS CLAUSE CAN BE COMPILED.# 
POINT$2:  
          IF VALUE$ GQ DNATPOINTER
          THEN
              CALL1DIAG(M365,DEFINITION); 
          #DIAG M365# 
          #*       CONTROL IDENTIFIER DATA NAME CANNOT BE DEFINED IN #
          #REPORT SECTION. TREATED AS UNDEFINED.                     #
          #POINT$3# 
          #CAN"T BE  FD              CAN BE  01-49# 
          #RD                      50 COMM SEC# 
          #SD                      77#
          #CD                      INDEX NAME#
          #88                      66#
          #SPECIAL NAMES# 
          #MNEMONIC#
          CIDNATINDEX=VALUE$; 
          $TEMP$ = GETQ(DN$LEVEL,DNAT$,CIDNATINDEX);
          IF $TEMP$ LQ 50 
              OR
              $TEMP$ EQ 77
              OR
              $TEMP$ EQ 66
              OR
              $TEMP$ EQ INDXLEVL
          THEN
              GOTO POINT$4; 
          CALL1DIAG(M367,DEFINITION); 
          #DIAG M367# 
          #*       ILLEGAL CONTROL IDENTIFIER DATA NAME.# 
          GOTO RETURNCASE;
POINT$4:  
          FOR CAINDEX = CNTROLAUXIDX STEP 1 UNTIL 
              LASTCTRLAUXI DO 
              BEGIN 
              IF CIDNATINDEX EQ RWGET(CONTIDNATPTR,CAINDEX) 
              THEN
                  BEGIN 
                  CALL1DIAG(M368,DEFINITION); 
                  #DIAG M368# 
                  #*       EACH CONTROL IDENTIFIER DATA NAME MUST BE# 
                  #UNIQUE. THIS DATA-NAME DELETED.                  # 
                  GOTO RETURNCASE;
                  END 
              END 
          #IF REACH HERE, NAME IS VALID (SO FAR).#
          IF SYNTAXONLY EQ 0
          THEN
              BEGIN 
              IF RWGET(NUMCONTRLIDS,CNTROLAUXIDX) EQ ZERO 
              THEN
                  GOTO CI$STOR; 
              CCTRWTABLEN = CCTRWTABLEN + 1;
              RWSET(RPAUXENTRY,CCTRWTABLEN,ZERO); 
              RWSET(REPTAUXTYPE,CCTRWTABLEN,CONTROLTYPE); 
              LASTCTRLAUXI = CCTRWTABLEN; 
CI$STOR:  
              RWSET(CONTIDNATPTR,LASTCTRLAUXI,CIDNATINDEX); 
              RWSET(RDCOLUMNUM,LASTCTRLAUXI,BIT8COL); 
              RWSET(RDLINENUM,LASTCTRLAUXI,CLINE$); 
              $TEMP$ = RWGET(NUMCONTRLIDS,CNTROLAUXIDX) + 1;
              RWSET(NUMCONTRLIDS,CNTROLAUXIDX,$TEMP$);
              END 
          GOTO RETURNCASE;
PAGE$RT:  
          IF RWGET(PAGELIMITBIT,PAGEAUXINDEX) EQ 1
          THEN
              BEGIN 
              SYNTAXONLY = 1; 
              GOTO DUPLICATECLA;
              END 
          GOTO RETURNCASE;
PAGELIMITRT:  
          IF SYNTAXONLY EQ 0
          THEN
              BEGIN 
              RWSET(PAGELIMITBIT,PAGEAUXINDEX,1); 
              RWSET(PAGELIMITPLT,PAGEAUXINDEX,VALUE$);
              END 
          GOTO RETURNCASE;
LAST$DETAIL:  
          IF RWGET(LASTDTAILBIT,PAGEAUXINDEX) EQ 1
          THEN
              GOTO DUPLICATEPHR;
          IF SYNTAXONLY EQ 0
          THEN
              BEGIN 
              RWSET(LASTDTAILBIT,PAGEAUXINDEX,1); 
              RWSET(LASTDTAILPLT,PAGEAUXINDEX,VALUE$);
              END 
          GOTO RETURNCASE;
FIRST$DET$RT: 
          IF RWGET(FIRDETAILBIT,PAGEAUXINDEX) EQ 1
          THEN
              GOTO DUPLICATEPHR;
          IF SYNTAXONLY EQ 0
          THEN
              BEGIN 
              RWSET(FIRDETAILBIT,PAGEAUXINDEX,1); 
              RWSET(F1STDTAILPLT,CODEAUXINDEX,VALUE$);
              END 
          GOTO RETURNCASE;
HEADINGRT:  
          IF RWGET(HEADINGBIT,PAGEAUXINDEX) EQ 1
          THEN
              GOTO DUPLICATEPHR;
          IF SYNTAXONLY EQ 0
          THEN
              BEGIN 
              RWSET(HEADINGBIT,PAGEAUXINDEX,1); 
              RWSET(HEADINGPLT,CODEAUXINDEX,VALUE$);
              END 
          GOTO RETURNCASE;
FOOTINGRT:  
          IF RWGET(FOOTINGBIT,PAGEAUXINDEX) EQ 1
          THEN
              GOTO DUPLICATEPHR;
          IF SYNTAXONLY EQ 0
          THEN
              BEGIN 
              RWSET(FOOTINGBIT,PAGEAUXINDEX,1); 
              RWSET(FOOTINGPLT,PAGEAUXINDEX,VALUE$);
              END 
          GOTO RETURNCASE;
TERM$PERIOD:  
          IF GETQ(DN$TERMPER,DNAT$,CURDNATPTR) EQ 1 
          THEN
              CALL1DIAG(M366,TRIVIAL);
          #DIAG M366# 
          #*       TERMINAL PERIOD FOLLOWS A TERMINAL PERIOD# 
          SET(DN$TERMPER,DNAT$,CURDNATPTR,1); 
          GOTO RETURNCASE;
TESTFORTPD: 
          IF DNATPOINTER  NQ  ZERO
          THEN
              BEGIN 
              #TEST FOR TERMINAL PERIOD IN FORMER DNAT ENTRY# 
              #CURDNATPTR  HAS NOT  BEEN UPDATED YET, SO# 
              #CAN USE IT DIRECTLY# 
              IF GETQ(DN$TERMPER,DNAT$,CURDNATPTR)
                  NQ  1 
              THEN
                  BEGIN 
                  CALL1DIAG(M369,TRIVIAL);
                  #DIAG M369# 
                  #*       THIS CLAUSE WAS NOT PRECEDED BY A TERMINAL#
                  #PERIOD.                                           #
                  END 
              END 
          GOTO RETURNCASE;
CHKIFTP:  
          DUPCOL = BIT8COL; 
          DUPLINE = CLINE$; 
          #(SAVE CURRENT LINE NUMBER AND COLUMN NUMBER IN#
          #CASE OF A DUPLICATE CLAUSE DIAGNOSTIC LATER ON)# 
          IF GETQ(DN$TERMPER,DNAT$,CURDNATPTR) EQ 1 
          THEN
              CALL1DIAG(M370,TRIVIAL);
          #DIAG M370# 
          #*       THIS CLAUSE APPEARS AFTER A TERMINAL PERIOD.#
          GOTO RETURNCASE;
LINE$INT$ABS: 
          ABSRELTEMP = ABSOLUTE;
          GOTO LINE$INT$ALL;
LN$NEXTPAGE:  
          IF SYNTAXONLY EQ 0
          THEN
              RWSET(RAKINDLINENO,RPAUXINDEX,NEXTPAGE);
          GOTO RETURNCASE;
LINE$INT$REL: 
          ABSRELTEMP = RELATEVE;
LINE$INT$ALL: 
          IF RWGET(RALINENUMPLT,RPAUXINDEX) NQ ZERO 
          THEN
              GOTO DUPLICATECLA;
          IF SYNTAXONLY EQ 0
          THEN
              BEGIN 
              RWSET(RALINENUMPLT,RPAUXINDEX,VALUE$);
              RWSET(RAKINDLINENO,RPAUXINDEX,ABSRELTEMP);
              END 
          GOTO RETURNCASE;
NEXTGROUPABS: 
          ABSRELTEMP = ABSOLUTE;
          GOTO NEXTGROUPALL;
NEXTGROUPREL: 
          ABSRELTEMP = RELATEVE;
NEXTGROUPALL: 
          IF RWGET(RANGSPECFIED,RPAUXINDEX) EQ 1
          THEN
              GOTO DUPLICATECLA;
          IF SYNTAXONLY EQ 0
          THEN
              BEGIN 
              RWSET(RANGSPECFIED,RPAUXINDEX,1); 
              CCTRWTABLEN = CCTRWTABLEN + 1;
              RWSET(RPAUXENTRY,CCTRWTABLEN,ZERO); 
              RWSET(REPTAUXTYPE,CCTRWTABLEN,NEXTGR);
              RWSET(RATYPENXTGRP,CCTRWTABLEN,ABSRELTEMP); 
              RWSET(RANGINTPLT,CCTRWTABLEN,VALUE$); 
              END 
          GOTO RETURNCASE;
NG$NEXTPAGE:  
          IF RWGET(RANGSPECFIED,RPAUXINDEX) EQ 1
          THEN
              GOTO DUPLICATECLA;
          IF SYNTAXONLY EQ 0
          THEN
              BEGIN 
              RWSET(RANGSPECFIED,RPAUXINDEX,1); 
              CCTRWTABLEN = CCTRWTABLEN + 1;
              RWSET(RPAUXENTRY,CCTRWTABLEN,ZERO); 
              RWSET(REPTAUXTYPE,CCTRWTABLEN,NEXTGR);
              RWSET(RATYPENXTGRP,CCTRWTABLEN,NEXTPAGE); 
              END 
          GOTO RETURNCASE;
SETTYPE8: 
          IF RWGET(RATYPERGROUP,RPAUXINDEX) 
              NQ ZERO 
          THEN
              GOTO DUPLICATECLA;
          #TO ENABLE R-ANALYZER TO DISTINGUISH# 
          #1) NO TYPE CLAUSE (0)# 
          #2) A TYPE CLAUSE WITH ERROR(S)  (8)# 
          #OR    3) A VALID TYPE CLAUSE (1-7),# 
          #WILL INITIALIZE THE FIELD TO 8 TO INDICATE THAT TYPE#
          #CLAUSE OCCURRED, BUT THAT IT WAS NOT ERROR-FREE# 
          #THEN IF THIS TYPE CLAUSE IS OK, THIS 8 WILL BE#
          #OVERWRITTEN BY A TYPE 1-7.#
          IF SYNTAXONLY EQ 0
          THEN
              RWSET(RATYPERGROUP,RPAUXINDEX,8); 
          GOTO RETURNCASE;
TYPERHRT: 
          TYPETEMP = RH;
          I = 0;
TYPESET:  
          IF SYNTAXONLY EQ 0
          THEN
              RWSET(RATYPERGROUP,RPAUXINDEX,TYPETEMP);
              SET(DN$RGCDI,DNAT$,CURDNATPTR,I); 
              #TO BE USED BY PPARSER IN USE BEFORE REPORTING #
          GOTO RETURNCASE;
TYPEPHRT: 
          TYPETEMP = PH;
          I = 1;
          GOTO TYPESET; 
TYPECHRT: 
          TYPETEMP = CH;
          I = 0;
          GOTO TYPESET; 
TYPEDETAIL: 
          TYPETEMP = DE;
          I = 0;
          GOTO TYPESET; 
TYPECFRT: 
          TYPETEMP = CF;
          I = 2;
          GOTO TYPESET; 
TYPEPFRT: 
          TYPETEMP = PF;
          I = 1;
          GOTO TYPESET; 
TYPERFRT: 
          TYPETEMP = RF;
          I = 2;
          GOTO TYPESET; 
SAVCONTROLID: 
          #DATA-NAME REFERENCE CHECK# 
          IF VALUE$ NQ 0 AND
              SYNTAXONLY EQ 0 AND 
              GETQ(DN$TYPE,DNAT$,VALUE$) NQ ERRTYPE 
          THEN
              RWSET(RACONTRLDNAT,RPAUXINDEX,VALUE$);
          IF VALUE$ NQ 0 AND
              GETQ(DN$TYPE,DNAT$,VALUE$) EQ ERRTYPE 
          THEN
              CALL1DIAG(M364,PROPAGATED); 
          GOTO RETURNCASE;
SAVCONTROLFI: 
          IF SYNTAXONLY EQ 0
          THEN
              RWSET(RACI$FINAL,RPAUXINDEX,1); 
          GOTO RETURNCASE;
SETUSAGERT: 
          IF
              #LEVEL-01-ENTRY.    OR# 
              RWGET(RAUSAGEBIT,RPAUXINDEX) EQ 1 
          THEN
              GOTO DUPLICATECLA;
          IF  SYNTAXONLY EQ  0
          THEN
              RWSET(RAUSAGEBIT,RPAUXINDEX,1); 
          GOTO RETURNCASE;
SETUPDNAT:  
          TYPETEMP = LEV01; 
          GOTO SETUPALL;
SETUP02DNAT:  
          TYPETEMP = FORM34;
SETUPALL: 
          SUMENCOUNTRD = 0; 
          VALUNCOUNTRD = 0; 
          SRCENCOUNTRD = 0; 
          CURDNATPTR = VALUE$;
          SET(DN$LINE,DNAT$,CURDNATPTR,CLINE$); 
          SET(DN$LEVEL,DNAT$,CURDNATPTR,LEVELSAVE); 
          #SEE DRIVER#
          SET(DN$TYPE,DNAT$,CURDNATPTR,NONDATA);
          LSTRSDNATIND = CURDNATPTR;
          IF TYPETEMP EQ LEV01
          THEN
              SET(DN$RDDNAT,DNAT$,CURDNATPTR,CURRDDNAT);
          IF DNATPOINTER EQ 0 
          THEN
              DNATPOINTER = CURDNATPTR; 
          #BUILD A RP-AUX-TABLE.FORMAT-3-4-ENTRY# 
          CCTRWTABLEN = CCTRWTABLEN + 1;
          RPAUXINDEX = CCTRWTABLEN; 
          #FOR LEVEL-01-ENTRY OR# 
          #FORMAT-3-4-ENTRY#
          SETRPAUXPTR(CURDNATPTR,CCTRWTABLEN);
          RWSET(RPAUXENTRY,RPAUXINDEX,ZERO);
          RWSET(REPTAUXTYPE,CCTRWTABLEN,TYPETEMP);
          GOTO RETURNCASE;
BLANKZERORT:  
          IF GETQ(PL$CODE,PLT$,VALUE$) NQ PLTFGCONZERO
          THEN
              BEGIN 
              CALL1DIAG(327,DEFINITION);
              GOTO RETURNCASE;
              END 
          IF RWGET(RABLANKBIT,RPAUXINDEX) EQ 1
          THEN
              GOTO  DUPLICATECLA; 
          IF SYNTAXONLY EQ 0
          THEN
              BEGIN 
              IF RWGET(RAPICBIT,RPAUXINDEX) EQ 1
                  AND 
                 GETQ(DN$TYPE,DNAT$,CURDNATPTR) EQ NUMERICEDIT
                  AND 
                 GETQ(P$CKPROTECT,PAT$,PAT$INDEX) EQ 1
              THEN
                 CALL1DIAG(M408,DEFINITION); #BWZ AND ASTERISK# 
              ELSE
                  BEGIN 
                  RWSET(RABLANKBIT,RPAUXINDEX,1); 
                  RWSET(RAFORMAT4BIT,RPAUXINDEX,1); 
                  END 
              END 
          GOTO RETURNCASE;
COLUMNNO$RT:  
          IF RWGET(RACOLNUMPLT,RPAUXINDEX)
              NQ  ZERO
          THEN
              GOTO DUPLICATECLA;
          IF SYNTAXONLY EQ 0
          THEN
              BEGIN 
              RWSET(RAFORMAT4BIT,RPAUXINDEX,1); 
              RWSET(RACOLNUMPLT,RPAUXINDEX,VALUE$); 
              END 
          GOTO RETURNCASE;
GROUPIND$RT:  
          IF RWGET(RAGROUPBIT,RPAUXINDEX) EQ 1
          THEN
              GOTO DUPLICATECLA;
          IF SYNTAXONLY EQ 0
          THEN
              BEGIN 
              RWSET(RAGROUPBIT,RPAUXINDEX,1); 
              RWSET(RAFORMAT4BIT,RPAUXINDEX,1); 
              END 
          GOTO RETURNCASE;
JUSTIFIED$RT: 
          IF RWGET(RAJUSTFIDBIT,RPAUXINDEX) EQ 1
          THEN
              GOTO DUPLICATECLA;
          IF SYNTAXONLY EQ 0
          THEN
              BEGIN 
              RWSET(RAJUSTFIDBIT,RPAUXINDEX,1); 
              RWSET(RAFORMAT4BIT,RPAUXINDEX,1); 
              END 
          GOTO RETURNCASE;
STASHPICTURE: 
          IF RWGET(RAPICBIT,RPAUXINDEX) EQ 1
          THEN
              GOTO DUPLICATECLA;
          IF SYNTAXONLY EQ 0
          THEN
              BEGIN 
              PAT$INDEX = VALUE$; 
              RWSET(RAPICBIT,RPAUXINDEX,1); 
              RWSET(RAFORMAT4BIT,RPAUXINDEX,1); 
              #FOLLOWING IS TAKEN FROM D-PARSER  (CONCEPTUALLY   #
              #SPEAKING).                                        #
              $TEMP$ = GETQ(P$LENGTH,PAT$,VALUE$);
              SET(DN$ITMLEN,DNAT$,CURDNATPTR,$TEMP$); 
              $TEMP$ = GETQ(P$TYPE,PAT$,VALUE$);
              SET(DN$TYPE,DNAT$,CURDNATPTR,$TEMP$); 
          SWITCH PICTYPE RETURNCASE,RETURNCASE,PATERNOFFSET,RETURNCASE, 
                             PCASE4,PCASE5,PCASE6,PCASE7,PCASE8;
              IF GETQ(DN$TYPE,DNAT$,CURDNATPTR) GQ 9 THEN 
                  GOTO RETURNCASE;
              GOTO PICTYPE[GETQ(DN$TYPE,DNAT$,CURDNATPTR)]; 
                  #CASE 4 - ALPHANUMERIC EDIT#
                  PCASE4: 
                      BEGIN 
                      $TEMP$ = GETQ(P$REPLCNT,PAT$,VALUE$); 
                      SET(DN$REPCOUNT,DNAT$,CURDNATPTR,$TEMP$); 
                      GOTO PATERNOFFSET;
                      END 
                  #CASE 5 - ERROR#
                  PCASE5: 
                      RWSET(RAPICBIT,RPAUXINDEX,0); 
                      GOTO RETURNCASE;
                  #CASE 6 - NUMERIC-EDIT# 
                  PCASE6: 
                      BEGIN 
                      $TEMP$ = GETQ(P$PTLOC,PAT$,VALUE$); 
                      SET(DN$POINT,DNAT$,CURDNATPTR,$TEMP$);
                      $TEMP$ = GETQ(P$NUMLEN,PAT$,VALUE$);
                      SET(DN$NUMLEN,DNAT$,CURDNATPTR,$TEMP$); 
                      IF GETQ(P$CKPROTECT,PAT$,VALUE$) EQ 1 
                           AND
                         RWGET(RABLANKBIT,RPAUXINDEX) EQ 1
                      THEN
                          BEGIN 
                          CALL1DIAG(M408,DEFINITION); #BWZ AND *# 
                          RWSET(RABLANKBIT,RPAUXINDEX,0); 
                          END 
                      GOTO PATERNOFFSET;
                      END 
                  #CASE 7 - NUMERIC#
                  PCASE7: 
                      BEGIN 
                      $TEMP$ = GETQ(P$PTLOC,PAT$,VALUE$); 
                      SET(DN$POINT,DNAT$,CURDNATPTR,$TEMP$);
                      $TEMP$ = GETQ(P$NUMLEN,PAT$,VALUE$);
                      SET(DN$NUMLEN,DNAT$,CURDNATPTR,$TEMP$); 
                      GOTO RETURNCASE;
                      END 
                  #CASE 8 - EXTERNAL FLOAT# 
                  PCASE8: 
                      BEGIN 
                      $TEMP$ = GETQ(P$PTLOC,PAT$,VALUE$); 
                      SET(DN$COEFSCL,DNAT$,CURDNATPTR,$TEMP$);
                      $TEMP$ = GETQ(P$NUMLEN,PAT$,VALUE$);
                      SET(DN$COEFLEN,DNAT$,CURDNATPTR,$TEMP$);
                      $TEMP$ = GETQ(P$EXPLEN,PAT$,VALUE$);
                      SET(DN$EXPLEN,DNAT$,CURDNATPTR,$TEMP$); 
                      $TEMP$ = GETQ(P$COEFFSGN,PAT$,VALUE$);
                      SET(DN$COEFSIGN,DNAT$,CURDNATPTR,$TEMP$); 
                      $TEMP$ = GETQ(P$EXPSIGN,PAT$,VALUE$); 
                      SET(DN$EXPSIGN,DNAT$,CURDNATPTR,$TEMP$);
                      $TEMP$ = GETQ(P$DECPT,PAT$,VALUE$); 
                      SET(DN$DECPOINT,DNAT$,CURDNATPTR,$TEMP$); 
                      GOTO RETURNCASE;
                      END 
PATERNOFFSET: 
                      BEGIN 
                      CCTAUXTLEN = CCTAUXTLEN + 1;
                      #CREATE AUX ENTRY#
                      SET(DN$AUXREF,DNAT$,CURDNATPTR,CCTAUXTLEN); 
                      $TEMP$ = GETQ(P$FXDSGNLFT,PAT$,VALUE$); 
                      SET(AX$TFXDLDSGN,AUX$,CCTAUXTLEN,$TEMP$); 
                      $TEMP$ = GETQ(P$BWZ,PAT$,VALUE$); 
                      SET(AX$TBWZ,AUX$,CCTAUXTLEN,$TEMP$);
                      $TEMP$ = GETQ(P$FXDINSRT,PAT$,VALUE$);
                      SET(AX$TFXDINS,AUX$,CCTAUXTLEN,$TEMP$); 
                      $TEMP$ = GETQ(P$FLTINSRT,PAT$,VALUE$);
                      SET(AX$TFLTINS,AUX$,CCTAUXTLEN,$TEMP$); 
                      $TEMP$ = GETQ(P$ASTRSKFIL,PAT$,VALUE$); 
                      SET(AX$TASTFILL,AUX$,CCTAUXTLEN,$TEMP$);
                      SET(AX$TTYPE,AUX$,CCTAUXTLEN,EDITINFO); 
                      $TEMP$ = GETQ(P$PATTOFF,PAT$,VALUE$); 
                      SET(AX$PATTOFFS,AUX$,CCTAUXTLEN,$TEMP$);
                      IF GETQ(DN$TYPE,DNAT$,CURDNATPTR) EQ NUMERICEDIT
                      THEN
                          BEGIN 
                          IF GETQ(AX$TFXDLDSGN,AUX$,CCTAUXTLEN) EQ 1 OR 
                              GETQ(AX$TFXDINS,AUX$,CCTAUXTLEN) NQ 0 OR
                              GETQ(AX$TFLTINS,AUX$,CCTAUXTLEN) EQ 2 OR
                              GETQ(AX$TFLTINS,AUX$,CCTAUXTLEN) EQ 3 
                          THEN
                              SET(DN$SIGNBIT,DNAT$,CURDNATPTR,1); 
                          END 
                      END 
              END 
          GOTO RETURNCASE;
NO$ALLVALUE:  
          #SET FLAG FOR STASHVALUE# 
          ALLB4VALULIT = 0; 
          GOTO RETURNCASE;
YES$ALLVALUE: 
          #SET FLAG FOR STASHVALUE# 
          ALLB4VALULIT = 1; 
          GOTO RETURNCASE;
STASHVALUE: 
          IF RWGET(RASOURCEBIT,RPAUXINDEX) EQ 1 
              OR
              RWGET(RASUMBIT,RPAUXINDEX) EQ 1 
          THEN
              BEGIN 
              CALL1DIAG(M371,DEFINITION); 
              GOTO RETURNCASE;
              #*      DIAG M371#
              #ALREADY HAVE SOURCE OR SUM CLAUSE FOR THIS ITEM  THIS# 
              #VALUE CLAUSE IGNORED.# 
              END 
          IF RWGET(RAVALUEBIT,RPAUXINDEX) EQ 1
          THEN
              GOTO DUPLICATECLA;
          IF SUMENCOUNTRD EQ 1 OR 
              VALUNCOUNTRD EQ 1 OR
              SRCENCOUNTRD EQ 1 
          THEN
              CALL1DIAG(M390,TRIVIAL);
          VALUNCOUNTRD = 1; 
          IF SYNTAXONLY EQ 0
          THEN
              BEGIN 
              RWSET(RAVALUEBIT,RPAUXINDEX,1); 
              RWSET(RAFORMAT4BIT,RPAUXINDEX,1); 
              #BUILD VALUE-ENTRY# 
              CCTRWTABLEN = CCTRWTABLEN + 1;
              RWSET(RPAUXENTRY,CCTRWTABLEN,ZERO); 
              RWSET(REPTAUXTYPE,CCTRWTABLEN,VALUETYPE); 
              RWSET(RAVALULITPLT,CCTRWTABLEN,VALUE$); 
              IF ALLB4VALULIT EQ  1 
              THEN
                  RWSET(RAVALUALLIND,CCTRWTABLEN,1);
              END 
          GOTO RETURNCASE;
STASH$SOURCE: 
          #SAVE LINE AND COL.NO.FOR USE IN SSSUBSCRIPTS#
          CLINENO = CLINE$; 
          CCOLNO = BIT8COL; 
          SOURCEIDPTR = VALUE$; 
          IF RWGET(RASUMBIT,RPAUXINDEX) EQ 1
              OR
              RWGET(RAVALUEBIT,RPAUXINDEX) EQ 1 
          THEN
              BEGIN 
              SYNTAXONLY = 1; 
              CALL1DIAG(M372,DEFINITION); 
              GOTO RETURNCASE;
              END 
          #DIAG M372# 
          #*       ALREADY HAVE SUM OR VALUE CLAUSE FOR THIS ITEM  THIS#
          #SOURCE CLAUSE IGNORED.#
          IF RWGET(RASOURCEBIT,RPAUXINDEX) EQ 1 
          THEN
              BEGIN 
              SYNTAXONLY = 1; 
              GOTO DUPLICATECLA;
              END 
          IF SUMENCOUNTRD EQ 1 OR 
              VALUNCOUNTRD EQ 1 OR
              SRCENCOUNTRD EQ 1 
          THEN
              CALL1DIAG(M390,TRIVIAL);
          SRCENCOUNTRD = 1; 
          #DATA-NAME REFERENCE CHECK# 
          IF VALUE$ EQ 0
          THEN
              BEGIN 
S$IDENTERROR: 
              SOURCEIDPTR = 0;
              #SUBSCRIPTING-INDEXING ROUTINES#
              #WILL NOT BE ABLE TO DO SOME FURTHER SYNTAX CHECKING# 
              SYNTAXONLY = 1; 
              GOTO RETURNCASE;
              END 
          IF SYNTAXONLY EQ 0
          THEN
              BEGIN 
              RWSET(RAFORMAT4BIT,RPAUXINDEX,1); 
              RWSET(RASOURCEBIT,RPAUXINDEX,1);
              #BUILD RA-SOURCE-ENTRY# 
              CCTRWTABLEN = CCTRWTABLEN + 1;
              RWSET(RPAUXENTRY,CCTRWTABLEN,ZERO); 
              RWSET(REPTAUXTYPE,CCTRWTABLEN,SOURCETYPE);
              RWSET(RASRCEIDNAT,CCTRWTABLEN,VALUE$);
              SRCEAUXINDEX = CCTRWTABLEN; 
              #SAVE WHAT WOULD BE THE POINTER TO THE FIRST CTEXT# 
              #ATOM CONTAIN SUBSCRIPTING/INDEXING INFO., IN CASE# 
              #THERE IS  S/I# 
              FIRSTSICTEXT = CTEXTINDEX - 1;
              END 
          GOTO RETURNCASE;
LC$CURRENTRD: 
          STSTEMP1 = M373;
          GOTO CURRENT$LCPC;
QUALIFIED$LC: 
          STSTEMP1 = M374;
          STSTEMP2 = M375;
          GOTO LCPC$QUAL; 
PC$CURRENTRD: 
          STSTEMP1 = M376;
CURRENT$LCPC: 
          IF RWGET(RASUMBIT,RPAUXINDEX) EQ 1
              OR
              RWGET(RAVALUEBIT,RPAUXINDEX) EQ 1 
          THEN
              BEGIN 
              SYNTAXONLY = 1; 
              CALL1DIAG(M372,DEFINITION); 
              GOTO RETURNCASE;
              END 
          IF RWGET(RASOURCEBIT,RPAUXINDEX) EQ 1 
          THEN
              BEGIN 
              SYNTAXONLY = 1; 
              GOTO DUPLICATECLA;
              END 
          IF CURRDDNAT  EQ 0
          THEN
              BEGIN 
              CALL1DIAG(STSTEMP1,DEFINITION); 
              GOTO RETURNCASE;
              END 
          #DIAG M376/M373#
          #*       AS NO RD WAS SPECIFIED, PAGE-/LINE-COUNTER IS #
          #UNDEFINED. SOURCE CLAUSE IGNORED.# 
          IF SYNTAXONLY EQ 0
          THEN
              BEGIN 
              RWSET(RAFORMAT4BIT,RPAUXINDEX,1); 
              RWSET(RASOURCEBIT,RPAUXINDEX,1);
              #BUILD RA-SOURCE-ENTRY# 
              CCTRWTABLEN = CCTRWTABLEN + 1;
              RWSET(RPAUXENTRY,CCTRWTABLEN,ZERO); 
              RWSET(REPTAUXTYPE,CCTRWTABLEN,SOURCETYPE);
              RWSET(RASRCEIDNAT,CCTRWTABLEN,VALUE$);
              END 
          GOTO RETURNCASE;
QUALIFIED$PC: 
          STSTEMP1 = M377;
          STSTEMP2 = M378;
LCPC$QUAL:  
          IF RWGET(RASUMBIT,RPAUXINDEX) EQ 1
              OR
              RWGET(RAVALUEBIT,RPAUXINDEX) EQ 1 
          THEN
              BEGIN 
              SYNTAXONLY = 1; 
              CALL1DIAG(M372,DEFINITION); 
              GOTO RETURNCASE;
              END 
          IF RWGET(RASOURCEBIT,RPAUXINDEX) EQ 1 
          THEN
              BEGIN 
              SYNTAXONLY = 1; 
              GOTO DUPLICATECLA;
              END 
          #DETERMINE IF THE QUALIFIER IS VALID# 
          IF VALUE$ EQ 0
          THEN
              GOTO RETURNCASE;
          IF VALUE$ LS  CURDNATPTR
              #QUALIFIED BACKWARDS# 
          THEN
              BEGIN 
              IF GETQ(DN$LEVEL,DNAT$,VALUE$) EQ RDDESCR 
              THEN
                  GOTO PQUAL$OK;
              CALL1DIAG(STSTEMP1,DEFINITION); 
              GOTO RETURNCASE;
              END 
          #DIAG M377# 
          #*       QUALIFIER OF PAGE-COUNTER NOT AN RD  SOURCE CLAUSE#
          #IGNORED# 
          #ELSE MUST BE QUALIFIED FORWARD#
          #SO- LOOK IN FDRDTABLE TO FIND OUT IF IT IS AN RD (IE.- ONE # 
          #THAT CAN BE PROCESSED). (IF THE RD NEVER GETS DEFINED, THAT# 
          #ERROR WILL BE CAUGHT IN AFTER-ALL-REPORTS ROUTINE.)        # 
          FOR FDRDINDEX = 1 STEP 1 UNTIL LASTFDRDNTRY DO
              BEGIN 
              IF GETQ(FR$REPTNAME,FDRDT$,FDRDINDEX) EQ VALUE$ 
              THEN
                  GOTO PQUAL$OK;
              END 
          CALL1DIAG(STSTEMP2,PROPAGATED); 
          GOTO RETURNCASE;
          #DIAG M378# 
          #*       PAGE COUNTER QUALIFIER NOT AN RD THAT IS ASSOCIATED# 
          #WITH AN FD. SOURCE CLAUSE IGNORED                          # 
PQUAL$OK: 
          IF SYNTAXONLY EQ 0
          THEN
              BEGIN 
              RWSET(RAFORMAT4BIT,RPAUXINDEX,1); 
              RWSET(RASOURCEBIT,RPAUXINDEX,1);
              #BUILD RA-SOURCE-ENTRY# 
              CCTRWTABLEN = CCTRWTABLEN + 1;
              RWSET(RPAUXENTRY,CCTRWTABLEN,ZERO); 
              RWSET(REPTAUXTYPE,CCTRWTABLEN,SOURCETYPE);
              RWSET(RASRCEIDNAT,CCTRWTABLEN,VALUE$ + 1);
              END 
          GOTO RETURNCASE;
SSSUBSCRIPTS: 
          IF  SIERROR EQ 1
              #NON-TRIVIAL SUBSCRIPTING/INDEXING# 
              #ERROR# 
          THEN
              #WIPE OUT  RA-SOURCE-ENTRY# 
          BEGIN 
              IF RWGET(RASOURCEBIT,RPAUXINDEX) EQ 1 
              THEN
                  BEGIN 
                  RWSET(RASOURCEBIT,RPAUXINDEX,0);
                  CCTRWTABLEN = CCTRWTABLEN - 1;
                  END 
              #ISSUE ADVISORY#
              CALL2DIAG(M392,ADVISORY,CLINENO,CCOLNO);
              #DIAG M392# 
              #*       SOURCE CLAUSE CONSIDERED UNDEFINED AS# 
              #SUBSCRIPTING/INDEXING ERRORS CAUSE THIS IDENTIFIER#
              #TO BE UNDEFINED.#
              GOTO RETURNCASE;
              END 
          IF SYNTAXONLY EQ 0
              AND 
              SIERROR EQ 0
          THEN
              BEGIN 
              RWSET(RASRCESIBIT,SRCEAUXINDEX,1);
              #INDICATES THERE WAS SUBSCRIPTING/INDEXING# 
              BUILDSUBTYPE; 
              END 
          GOTO RETURNCASE;
RWINIT$FLAGS: 
          SUBSCRIPTCNT = 0; 
          ASUBSCRIPT = 0; 
          ANINDEXNAME  = 0; 
          #THE FOLLOWING FLAG WILL GET SET IF ANYTHING IS#
          #FOUND TO BE WRONG (EXCEPT IN THE CASE OF A#
          #TRIVIAL ERROR# 
          SIERROR = 0;
          #NOTE -#
          #A PTR TO THE FIRST  S/I  CTEXT ATOM WAS SAVED IN THE#
          #ROUTINE  STASH$SOURCE# 
          GOTO RETURNCASE;
RWTESTSUBSCR: 
          IF SOURCEIDPTR NQ ZERO
          THEN
              BEGIN 
              #IF IT IS = ZERO THEN DN-REF WAS NOT DEFINED# 
              #AND SO CAN"T DO THIS CHECK.# 
              IF GETQ(DN$SDEPTH,DNAT$,SOURCEIDPTR) EQ 0 
              THEN
                  GOTO RETURNCASE;
              SIERROR = 1;
              $TEMP$ = GETQ(DN$SDEPTH,DNAT$,SOURCEIDPTR); 
              CALL1DIAG(SSERRORS[$TEMP$],DEFINITION); 
              #DIAG M401,M402,M203,M404#
              #SHOULD BE (0,1,2,3) SUBSCRIPTS.# 
              END 
          GOTO RETURNCASE;
SAV$CTEXTPTR: 
          LASTSICTEXT =  CTEXTINDEX - 1;
          GOTO RETURNCASE;
RWCSUBSCRIPT: 
          IF(GETQ(DN$SDEPTH,DNAT$,SOURCEIDPTR) NQ SUBSCRIPTCNT) 
          THEN
              BEGIN 
              SIERROR = 1;
              $TEMP$ = GETQ(DN$SDEPTH,DNAT$,SOURCEIDPTR); 
              CALL1DIAG(SSERRORS[$TEMP$],DEFINITION); 
              END 
          #DIAG M401, M402,M203,M404# 
          #*       ILLEGAL NUMBER OF SUBSCRIPTS. (93)#
          SUBSCRIPTCNT = 0; 
          ASUBSCRIPT = 0; 
          ANINDEXNAME = 0;
          GOTO RETURNCASE;
RWC$COUNTLIT: 
          #THIS SUBROUTINE CHECKS LITERAL ATTRIBUTES  AND#
          #UPDATES SUBSCRIPT COUNT# 
          SUBSCRIPTCNT = SUBSCRIPTCNT + 1;
          #FROM LIT COMMAND#
          I = GETQ(PL$TYPE,PLT$,VALUE$);
          IF I NQ PLTPLUSILIT 
              AND 
              I NQ PLTUNSGNILIT 
          THEN
              BEGIN 
              SIERROR = 1;
              CALL1DIAG(M388,DEFINITION); 
              #DIAG M388# 
              #*       ILLEGAL LITERAL SUBSCRIPT  MUST BE POSITIVE OR#
              #UNSIGNED INTEGER.  (51)# 
              END 
          GOTO RETURNCASE;
RWCOUNTDNREF: 
          #THIS SUBROUTINE  DOES THE FOLLOWING# 
          #CALLS DIAGNOSER IF SUBSCRIPTS ARE ILLEGAL# 
          #CHECKS FOR MIXED SUBSCRIPTS AND INDICES# 
          #INCREMENTS SUBSCRIPT COUNTER#
          #CHECKS SUBSCRIPT ATTRIBUTES# 
          SUBSCRIPTCNT = SUBSCRIPTCNT + 1;
          #JUST FOUND A DN-REF# 
          IF VALUE$ EQ 0
          THEN
              BEGIN 
              SIERROR = 1;
              GOTO RETURNCASE;
              END 
          I = VALUE$; 
          IF  I  GQ  DNATPOINTER
          THEN
              BEGIN 
              CALL1DIAG(M396,DEFINITION); 
              SIERROR = 1;
              GOTO RETURNCASE;
              END 
          #DIAG M396# 
          #*       A SUBSCRIPT MAY NOT BE A REPORT SECTION ITEM.# 
          IF GETQ(DN$TYPE,DNAT$,I) EQ ERRTYPE 
          THEN
              BEGIN 
              CALL1DIAG(M380,DEFINITION); 
              #DIAG M380# 
              #*       SUBSCRIPT NOT AN INTEGER OR INDEX-NAME#
              SIERROR = 1;
              GOTO RETURNCASE;
              END 
          IF GETQ(DN$SDEPTH,DNAT$,I) NQ  0
          THEN
              BEGIN 
              SIERROR = 1;
              CALL1DIAG(M381,DEFINITION); 
              END 
          #DIAG M381# 
          #*       A SUBSCRIPTED IDENTIFIER CANNOT BE A SUBSCRIPT#
          IF SOURCEIDPTR NQ  0
              AND 
              GETQ(DN$TYPE,DNAT$,I) EQ INDXNAME 
          THEN
              BEGIN 
              IF GETQ(DN$FIRIDX,DNAT$,I) GR  SOURCEIDPTR
                  OR
                  GETQ(DN$LASIDX,DNAT$,I) LS  SOURCEIDPTR 
              THEN
                  BEGIN 
                  SIERROR = 1;
                  CALL1DIAG(M382,DEFINITION); 
                  END 
              #DIAG M382# 
              #*       INDEX NOT  ASSOCIATED WITH THIS IDENTIFIER.(52)# 
              IF GETQ(DN$IDXDEP,DNAT$,I) NQ  SUBSCRIPTCNT 
              THEN
                  BEGIN 
                  SIERROR = 1;
                  SWITCH IDXCEP DCASE0,DCASE1,DCASE2,DCASE3;
                  $TEMP$ = GETQ(DN$IDXDEP,DNAT$,I); 
                  GOTO IDXCEP[$TEMP$];
                  DCASE0: 
                      GOTO APCLABEL;
                  DCASE1: 
                      CALL1DIAG(M405,DEFINITION); 
                      GOTO APCLABEL;
                  DCASE2: 
                      CALL1DIAG(M406,DEFINITION); 
                      GOTO APCLABEL;
                  DCASE3: 
                      CALL1DIAG(M407,DEFINITION); 
                      GOTO APCLABEL;
                  END 
              #DIAG M405-M407#
              #*       INDEX-NAME APPEARS IN THE WRONG INDEX POSITION.# 
    APCLABEL: 
              ANINDEXNAME = 1;
              NOTINDEXNAME = 0; 
              END 
          ELSE
              IF GETQ(DN$TYPE,DNAT$,I) NQ INDXNAME
          THEN
              BEGIN 
              NOTINDEXNAME = 1; 
              ASUBSCRIPT = 1; 
              $TEMP$ = GETQ(DN$TYPE,DNAT$,I); 
              IF $TEMP$ NQ INDXDATA AND 
               $TEMP$ NQ COMP4 AND
                 $TEMP$ NQ NUMERIC AND
                 $TEMP$ NQ BINARY OR
                 GETQ(DN$POINT,DNAT$,I) GR 0
              THEN
                  BEGIN 
                  SIERROR = 1;
                  #SUBSCRIPT NOT AN INTEGER OR INDEX-NAME#
                  CALL1DIAG(M380,DEFINITION); 
                  END 
              END 
          IF (ASUBSCRIPT EQ 1  AND ANINDEXNAME EQ 1)
          THEN
              BEGIN 
              SIERROR = 1;
              CALL1DIAG(M384,DEFINITION); 
              END 
          #DIAG M384# 
          #*       MIXED SUBSCRIPTS AND INDICES.(53)# 
          GOTO RETURNCASE;
RWOFFSETDIAG: 
          IF NOTINDEXNAME EQ 1
          THEN
              CALL1DIAG(M385,TRIVIAL);
          #TRIVIAL# 
          #DIAG M385# 
          #*       SUBSCRIPT SHOULD NOT BE OFFSET. (57)#
          GOTO RETURNCASE;
RWSCRIPOFSET: 
          #THIS SUBROUTINE CHECKS LITERAL ATTRIBUTES# 
          IF GETQ(PL$TYPE,PLT$,VALUE$)  NQ PLTUNSGNILIT 
          THEN
              BEGIN 
              SIERROR = 1;
              CALL1DIAG(M386,DEFINITION); 
              END 
          #DIAG M386# 
          #*       ILLEGAL LITERAL  OFFSET. (56)# 
          GOTO RETURNCASE;
SETSUMCLAUSE: 
          IF RWGET(RASOURCEBIT,RPAUXINDEX) EQ 1 
              OR
              RWGET(RAVALUEBIT,RPAUXINDEX) EQ 1 
          THEN
              BEGIN 
              SYNTAXONLY = 1; 
              CALL1DIAG(M389,DEFINITION); 
              GOTO RETURNCASE;
              END 
          #DIAG M389# 
          #*       ALREADY HAVE SOURCE OR VALUE CLAUSE FOR THIS ITEM, # 
          #THIS SUM CLAUSE IGNORED.                                   # 
          IF RWGET(RASUMBIT,RPAUXINDEX) EQ 1
          THEN
              BEGIN 
              SYNTAXONLY = 1; 
              GOTO DUPLICATECLA;
              END 
          #ON THE BASIS THAT THE WORD "SUM" HAS BEEN ENCOUNTERED,#
          #WILL#
          #SET FORMAT-3-4-ENTRY.RA-SUM-COUNTER BIT  = 1#
          #R-ANALYZER WILL LATER# 
          #SET UP DNAT TO REFLECT  A NUMERIC DATA ITEM# 
          #WITH AN OPERATIONAL SIGN  (SECTION 6.39A.4/JOD)# 
          #SO THAT THIS#
          #ITEM CAN BE USED AS AN IDENTIFIER IN OTHER SUM CLAUSES#
          #- EVEN IF ALL THE IDENTIFIERS ASSOCIATED WITH THIS#
          #SUM COUNTER ARE NOT VALID. (PROVIDING USER HAD VALID      #
          #PIC CLAUS SO R-ANAL. WILL KNOW WHAT LENGTH TO SET IN DNAT)#
          RWSET(RASUMCNTRBIT,RPAUXINDEX,1); 
          IF SUMENCOUNTRD EQ 1 OR 
              VALUNCOUNTRD EQ 1 OR
              SRCENCOUNTRD EQ 1 
          THEN
              CALL1DIAG(M390,TRIVIAL);
          #DIAG M390# 
          #*       ONLY ONE OF SOURCE, SUM, OR VALUE CLAUSE#
          #MAY APPEAR FOR AN ITEM.                         #
          SUMENCOUNTRD = 1; 
          #SET THE FOLLOWING FLAG FOR STASHSUMIDEN  RT# 
          SUMCLAUSFLAG =  1;
          #NOTE#
          #WHEN STASHSUMIDEN FINDS SUMCLAUSFLAG = 1#
          #AND HAS A DN-REF THAT IS  VALID SO-FAR ,#
          #IT WILL SET# 
          #RA-FORMAT-4-BIT# 
          #+    RA-SUM-CLAUSE-BIT#
          #IN THE FORMAT-3-4-ENTRY BOTH = 1.# 
          #-AND THEN SET SUMCLAUSFLAG = 0.  # 
          SUMIDSYNTAXO = 1; 
          #NOTE-# 
          #IF STASHSUMIDEN BUILDS AN RA-SUM-IDENT ENTRY(WHICH#
          #MAY LATER BE FOUND TO HAVE AN SIERROR AND THUS WILL# 
          #NEVER APPEAR IN A REPORT TABLE) IT WILL SET# 
          #SUMIDSYNTAXO = 0  -SO THAT UPON OR RESET ENTRIES#
          #CAN BE BUILT.(THE UPON RT WILL RESET IT = 1  TO INSURE#
          #A DEFINED IDENTIFIER APPEARS PRIOR TO ANOTHER UPON#
          #CLAUSE).#
          UPON4CURRSUM = 0; 
          GOTO RETURNCASE;
STASHSUMIDEN: 
          SOURCEIDPTR 
          #DNAT PTR OF SUM IDENTIFIER#
          = VALUE$; 
          IF VALUE$ EQ 0
          THEN
              BEGIN 
SUMIDENTERR:  
              SYNTAXONLY = 1; 
              SOURCEIDPTR = 0;
              #SUBSCRIPTING-INDEXING ROUTINES#
              #WILL NOT BE ABLE TO DO SOME FURTHER SYNTAX CHECKING# 
              GOTO RETURNCASE;
              END 
          IF SYNTAXONLY EQ 0
          THEN
              BEGIN 
              IF SUMCLAUSFLAG EQ  0 
                  #IE.- THIS WILL NOT BE THE FIRST RA-SUM-IDENT#
                  #ENTRY.#
              THEN
                  BEGIN 
                  IF RWGET(REPTAUXTYPE,CCTRWTABLEN) 
                      EQ SUBINDXTYPE THEN 
                      RWSET(RASLASTAUXEN,SAVERWT,0);
                  ELSE
                  RWSET(RASLASTAUXEN,CCTRWTABLEN,ZERO); 
                  END 
              #BUILD RA-SUM-IDENT  ENTRY# 
              CCTRWTABLEN = CCTRWTABLEN + 1;
              RWSET(RPAUXENTRY,CCTRWTABLEN,ZERO); 
              RWSET(REPTAUXTYPE,CCTRWTABLEN,SUMIDTYPE); 
              SUMAUXINDEX = CCTRWTABLEN;
              RWSET(RASLASTAUXEN,SUMAUXINDEX,1);
              RWSET(RASUMIDTYPE,SUMAUXINDEX,1); 
              RWSET(RASUMID1DNAT,SUMAUXINDEX,VALUE$); 
              SUMIDSYNTAXO = 0; 
              #SAYS THAT# 
              #AT LEAST ONE IDENTIFIER(DEFINED) WAS ENCOUNTERED -#
              #SO WILL BE OK TO SAVE SUBSCRIPTING/INDEXING,#
              #UPON, OR RESET INFORMATION.# 
              IF SUMCLAUSFLAG EQ 1
              THEN
                  BEGIN 
                  RWSET(RAFORMAT4BIT,RPAUXINDEX,1); 
                  RWSET(RASUMBIT,RPAUXINDEX,1); 
                  SUMCLAUSFLAG = 0; 
                  END 
              FIRSTSICTEXT = CTEXTINDEX - 1;
              END 
          GOTO RETURNCASE;
SETUPONCLAUS: 
          #SET  -#
          NUMUPONREFSD  =  3; 
          #TO FORCE BUILDING OF A NEW AUX ENTRY.# 
          IF SUMIDSYNTAXO EQ 1
          THEN
              BEGIN 
              STOREUDETAIL = 0; 
              CALL1DIAG(M394,DEFINITION); 
              END 
          #DIAG M394# 
          #*       THIS ENTIRE UPON PHRASE WILL BE IGNORED  IS EITHER A#
          #DUPLICATE PHRASE OR ELSE WAS NO DEFINED SUM IDENTIFIER#
          #PRECEDING IT#
          IF SUMIDSYNTAXO EQ 0
          THEN
              BEGIN 
              STOREUDETAIL = 1; 
              #RESET TO 1#
              SUMIDSYNTAXO = 1; 
              END 
          GOTO RETURNCASE;
STASHUPONREF: 
          IF (VALUE$) EQ  ZERO
          THEN
              GOTO RETURNCASE;
          IF STOREUDETAIL EQ 1
              AND 
              SYNTAXONLY EQ ZERO
          THEN
              BEGIN 
              IF NUMUPONREFSD EQ 3
              THEN
                  BEGIN 
                  IF RWGET(REPTAUXTYPE,CCTRWTABLEN) 
                       EQ SUBINDXTYPE THEN
                      RWSET(RASLASTAUXEN,SAVERWT,0);
                  ELSE
                  RWSET(RASLASTAUXEN,CCTRWTABLEN,0);
                  #OR "U-LAST-AUX-ENTRY"# 
                  #BUILD NEW ENTRY  RA-UPON-DETAIL# 
                  CCTRWTABLEN = CCTRWTABLEN + 1;
                  RWSET(RPAUXENTRY,CCTRWTABLEN,ZERO); 
                  RWSET(REPTAUXTYPE,CCTRWTABLEN,UPONDETTYPE); 
                  RWSET(RAUPONTYPBIT,CCTRWTABLEN,1);
                  RWSET(RAULASTAUX,CCTRWTABLEN,1);
                  #RESET TO 0#
                  NUMUPONREFSD  = 0;
                  END 
              IF NUMUPONREFSD EQ 0
              THEN
                  RWSET(RAUPNDETAIL1,CCTRWTABLEN,VALUE$); 
              IF NUMUPONREFSD EQ 1
              THEN
                  RWSET(RAUPNDETAIL2,CCTRWTABLEN,VALUE$); 
              IF NUMUPONREFSD EQ 2
              THEN
                  RWSET(RAUPNDETAIL3,CCTRWTABLEN,VALUE$); 
              NUMUPONREFSD= NUMUPONREFSD + 1; 
              UPON4CURRSUM = 1; 
              END 
          GOTO RETURNCASE;
STASHRESREF:  
          IF (VALUE$) EQ ZERO 
          THEN
              GOTO RETURNCASE;
          IF GETQ(DN$TYPE,DNAT$,VALUE$) EQ ERRTYPE
          THEN
              BEGIN 
              CALL1DIAG(M364,PROPAGATED); 
              GOTO RETURNCASE;
              END 
          IF RWGET(REPTAUXTYPE,CCTRWTABLEN) EQ SUBINDXTYPE THEN 
              RWSET(RASLASTAUXEN,SAVERWT,0);
          ELSE
          RWSET(RASLASTAUXEN,CCTRWTABLEN,0);
          CCTRWTABLEN = CCTRWTABLEN + 1;
          RWSET(RPAUXENTRY,CCTRWTABLEN,ZERO); 
          RWSET(REPTAUXTYPE,CCTRWTABLEN,RESETTYPE); 
          RWSET(RARESETYPE,CCTRWTABLEN,1);
          RWSET(RARLASTAUX,CCTRWTABLEN,1);
          RWSET(RARESETDNAT,CCTRWTABLEN,VALUE$);
          GOTO RETURNCASE;
STRESETFINAL: 
          IF RWGET(REPTAUXTYPE,CCTRWTABLEN) EQ SUBINDXTYPE THEN 
              RWSET(RASLASTAUXEN,SAVERWT,0);
          ELSE
          RWSET(RASLASTAUXEN,CCTRWTABLEN,0);
          #BUILD NEW ENTRY  RA-RESET-PHRASE#
          CCTRWTABLEN = CCTRWTABLEN + 1;
          RWSET(RPAUXENTRY,CCTRWTABLEN,ZERO); 
          RWSET(REPTAUXTYPE,CCTRWTABLEN,RESETTYPE); 
          RWSET(RARESETYPE,CCTRWTABLEN,1);
          RWSET(RARLASTAUX,CCTRWTABLEN,1);
          RWSET(RARESETFINAL,CCTRWTABLEN,1);
          GOTO RETURNCASE;
SAVSUMSUBSCR: 
          IF SYNTAXONLY EQ 0
          THEN
              BEGIN 
              IF SIERROR EQ 1 
              THEN
                  BEGIN 
                  RWSET(RASUMSIERROR,SUMAUXINDEX,1);
                  #INDICATES THIS ITEM SHOULD NOT BE INCLUDED#
                  #IN A REPORT TABLE# 
                  GOTO RETURNCASE;
                  END 
              IF SIERROR EQ 0 
              THEN
                  RWSET(RASUMSITBLPT,SUMAUXINDEX,CCTRWTABLEN+1);
                  BUILDSUBTYPE; 
              END 
          GOTO RETURNCASE;
CBLDDUMYUPON: 
          IF UPON4CURRSUM EQ 1
          THEN
              BEGIN 
              UPON4CURRSUM = 0; 
              GOTO RETURNCASE;
              END 
          #ELSE IF NO UPON ENTRY BUILT FOR THIS PARTICULAR SUM CLAUSE#
          #ASSOCIATED WITH THE CURRENT SUM COUNTER, THEN IT IS# 
          #NECESSARY TO BUILD A DUMMY FOR USE BY R-ANALYZER SECTION.# 
          IF RWGET(REPTAUXTYPE,CCTRWTABLEN) EQ SUBINDXTYPE THEN 
              RWSET(RASLASTAUXEN,SAVERWT,0);
          ELSE
          RWSET(RASLASTAUXEN,CCTRWTABLEN,0);
          CCTRWTABLEN = CCTRWTABLEN + 1;
          RWSET(RPAUXENTRY,CCTRWTABLEN,ZERO); 
          RWSET(REPTAUXTYPE,CCTRWTABLEN,UPONDETTYPE); 
          RWSET(RAUPONTYPBIT,CCTRWTABLEN,1);
          RWSET(RADUMMYUPON,CCTRWTABLEN,1); 
          RWSET(RAULASTAUX,CCTRWTABLEN,1);
          GOTO RETURNCASE;
FIGZERORT:  
          GOTO RETURNCASE;
SPACEROUTINE: 
          GOTO RETURNCASE;
UPPERBOUND: 
          GOTO RETURNCASE;
LOWERBOUND: 
          GOTO RETURNCASE;
HIGHVALUE:  
          GOTO RETURNCASE;
LOWVALUE: 
          GOTO RETURNCASE;
QUOTEROUTINE: 
          GOTO RETURNCASE;
SAVELEVEL:  
          LEVELSAVE = VALUE$; 
          GOTO RETURNCASE;
BADLEVEL: 
          CURDNATPTR = VALUE$;
          SET(DN$LINE,DNAT$,CURDNATPTR,CLINE$); 
          SET(DN$LEVEL,DNAT$,CURDNATPTR,LEVELSAVE); 
          LSTRSDNATIND = CURDNATPTR;
          IF DNATPOINTER EQ 0 
          THEN
              DNATPOINTER = CURDNATPTR; 
          GOTO RETURNCASE;
DUPLICATEPHR: 
          CALL1DIAG(M400,TRIVIAL);
          GOTO RETURNCASE;
DUPLICATECLA: 
          BEGIN 
              CALL2DIAG(M361,TRIVIAL,DUPLINE,DUPCOL); 
              #DUPLINE AND DUPCOL WERE SET UP IN THE R-SUB# 
              #CHKIFTP# 
              END 
          #DIAG M400# 
          #DUPLICATE CLAUSE    NOT  ACCEPTED.#
     RETURNCASE:  
            RETURN; 
          END 
          END #R$SUBS#
          TERM
