*DECK E$SUBS
USETEXT CCTTEXT 
USETEXT DNTEXT
PROC E$SUBS;
         BEGIN
# 
  E$SUBS CONTAINS THE SUBROUTINES CALLED BY ETABLES 
# 
  
# 
  DIAGNOSTICS ISSUED BY E$SUBS
# 
         DEF DIAG3054 #54#; 
         DEF DIAG3057 #57#; 
         DEF DIAG3058 #58#; 
  
  
*CALL WORKTABS
*CALL TABLNAMES 
*CALL GETSET
*CALL DPPPDDATA 
*CALL AUXT1 
*CALL AUXTVALS
*CALL DNATVALS
*CALL PLT1
*CALL PLTVALS 
*CALL FNAT1 
*CALL FNATVALS
*CALL LAT1
         ITEM ALPHABETDNAT; 
         ITEM AUXINDEX; 
         ITEM AUXTLENGTH; 
         ITEM CHAIN$HEAD; 
         ITEM CLOCK$UNITS;
         ITEM CMFN C(6);
         ITEM COLLSQCOL;
         ITEM COLLSQLINE; 
         ITEM FNLINE; 
         ITEM FNCOLUMN; 
          ITEM DNATINDEX  I=0;
         ITEM FILE$COUNT; 
         ITEM FNATINDEX;
         ITEM I;
         ITEM J;
         ITEM L;
         ITEM REG1; 
         ITEM REG2; 
         ITEM REG3; 
         ITEM WORD; 
         ITEM DATANAMETEMP; 
         ITEM AUXENTRYTEMP; 
         ITEM LATLENGTH;
         ITEM MFN C(6); 
          ITEM NBRMFFILES;
          ITEM NULLSUPPAUX; 
         ITEM ONOFF;
         ITEM OPTIONAL; 
         ITEM ORGANIZATION; 
         ITEM RERUN$COUNT;
         ITEM R1; 
         ITEM R2; 
         ITEM SAME$A$TYPE;
         ITEM SIGNCONTROL B;
         ITEM SUM;
         ITEM SVD$FNAT$PTR; 
         ITEM SVD$PLT$PTR;
         ITEM SWITCH$ORD; 
         ITEM SWITCHFLAG B; 
         ITEM T$REG;
         ITEM VERBCOLUMN; 
         ITEM VERBLINE; 
         ITEM ORG;
         ITEM POSITIONPLST; 
         ITEM COUNT;
         ITEM LASTCLAUSE; 
         ITEM LASTPERIOD; 
         ITEM PMSG; 
         ITEM PCOLUMN;
         ITEM PLINE;
         ARRAY BEAD$BASE[0] S(26);
         BEGIN
         ITEM B C(0,0,10);
         END
         DEF GET #GETQUICK#;
         DEF SET #SETFIELD#;
         DEF GETDNAT($1) #GETQUICK($1,DNAT$,DNATINDEX)#;
         DEF SETDNAT($1,$2) #SETFIELD($1,DNAT$,DNATINDEX,$2)#;
         DEF GETFNAT($1) #GETQUICK($1,FNAT$,FNATINDEX)#;
         DEF SETFNAT($1,$2) #SETFIELD($1,FNAT$,FNATINDEX,$2)#;
         DEF GETAUX($1) #GETQUICK($1,AUX$,AUXINDEX)#; 
         DEF SETAUX($1,$2) #SETFIELD($1,AUX$,AUXINDEX,$2)#; 
         XREF PROC INTERCEPTOR; 
         XREF FUNC DECR;
         COMMON FIPSCOM;
         BEGIN
         ITEM W3; 
         END
PROC BUGS(P1,P2,P3,P4); 
         BEGIN
         ITEM P1,P2,P3,P4,MESS; 
         MESS = 0;
         IF F41 EQ 1 THEN MESS = P1;
         IF F42 EQ 1 THEN MESS = P2;
         IF F43 EQ 1 THEN MESS = P3;
         IF F44 EQ 1 THEN MESS = P4;
         IF MESS NQ 0 
         THEN BEGIN 
              INTERCEPTOR(VERBCOLUMN,VERBLINE,MESS,1);
              INTERCEPTOR(VERBCOLUMN,VERBLINE,341,1); 
              END 
         END #BUGS# 
PROC INT$OR$DIAG(DIAG$NO);
         BEGIN
         ITEM DIAG$NO;
         ITEM TEMP; 
         ITEM COUNT;
         ITEM BASE; 
         IF GET(PL$TYPE,PLT$,VALUE$) NQ PLTUNSGNILIT
         THEN BEGIN 
              ERROR(DIAG$NO); 
              T$REG = 1;
              RETURN; 
              END 
ENTRY PROC GET$INT; 
         BEGIN
         GETPLST(VALUE$,LOC(BEAD$BASE));
         T$REG = 0; 
         BASE = "0";
         FOR COUNT = 0 STEP 1 
         UNTIL GET(PL$LENGTH,PLT$,VALUE$) - 1 
         DO BEGIN 
            TEMP = C<COUNT,1>B[0];
            T$REG = T$REG * 10 + TEMP - BASE; 
            END 
         END #GET$INT#
         END #INT$OR$DIAG#
PROC SETUPALPHBET (TYPE); 
         BEGIN
         ITEM TYPE; 
         DNATINDEX = ALPHABETDNAT;
         SET(DN$LINE,DNAT$,DNATINDEX,LINE$);
         SETDNAT(DN$LEVEL,ALPHNAME);
         SETDNAT(DN$TYPE,NONDATA);
         SETDNAT(DN$ANTYPE,TYPE); 
         IF CCTFIRSTAN EQ 0 
         THEN BEGIN 
              CCTFIRSTAN = DNATINDEX; 
              END 
         CCTLASTAN = DNATINDEX; 
         RETURN;
         END #SETUPALPHBET# 
FUNC ADDNEWAUXENT (AUX);
         BEGIN
         ITEM AUX;
         AUXTLENGTH = AUXTLENGTH + 1; 
         SET(AX$TNEXTPTR,AUX$,AUXTLENGTH,AUX);
         ADDNEWAUXENT = AUXTLENGTH; 
         END #ADDNEWAUXENT# 
PROC ERROR(NUMBER); 
         BEGIN
         ITEM NUMBER; 
         INTERCEPTOR(COLUMN$,LINE$,NUMBER,1); 
         END #ERROR#
PROC ACCESS (P1); 
         BEGIN
         ITEM P1; 
         IF SYNTAXONLY EQ 1 OR DNATINDEX EQ 0 THEN RETURN;
         IF GETDNAT(DN$ACC) EQ 0
         THEN BEGIN 
              SETDNAT(DN$ACC,1);
              SETFNAT(FN$ACCESS,P1);
              END 
         ELSE BEGIN 
              ERROR(321); 
              END 
         RETURN;
         END #ACCESS# 
PROC PROCESSLIT(P1);
         BEGIN
         ITEM P1; 
         LATLENGTH = LATLENGTH + 1; 
         SET(L$DNAT,LAT$,LATLENGTH,DNATINDEX);
         SET(L$PLT,LAT$,LATLENGTH,VALUE$);
         ATTACHAUX(DNATINDEX);
         SET(AX$ANPLTPTR,AUX$,AUXTLENGTH,VALUE$); 
         SET(AX$TTYPE,AUX$,AUXTLENGTH,P1);
         RETURN;
         END #PROCESSLIT# 
PROC ATTACHAUX (P1);
         BEGIN
         ITEM P1; 
         AUXTLENGTH = AUXTLENGTH + 1; 
         I = GET(DN$AUXREF,DNAT$,P1); 
         SET(DN$AUXREF,DNAT$,P1,AUXTLENGTH);
         SET(AX$TNEXTPTR,AUX$,AUXTLENGTH,I);
         RETURN;
         END #ATTACHAUX#
PROC SETUPPLT(LENGTH,STRING); 
         BEGIN
         ITEM LENGTH; 
         ITEM STRING C(10); 
         CCTPLTLEN = CCTPLTLEN + 1; 
         CCTPLSTLEN = CCTPLSTLEN + 1; 
         SET(PL$CODE,PLT$,CCTPLTLEN,PLTQUOTEDLIT);
         SET(PL$LENGTH,PLT$,CCTPLTLEN,LENGTH);
         SET(PL$STRINGPTR,PLT$,CCTPLTLEN,CCTPLSTLEN); 
         SET(PLT$CHAR,PLTSTR$,CCTPLSTLEN,STRING); 
         VALUE$ = CCTPLTLEN;
         END
PROC FIPSLOG (P1,P2,P3);
         BEGIN
         # P1 DIAGNOSTIC NUMBER # 
         # P2 ORGANIZATION #
         # P3 FIPS LEVEL #
         ITEM P1; 
         ITEM P2; 
         ITEM P3; 
         IF CCTFIPSLEVEL LS P3
         THEN BEGIN 
              W3 = W3 + 1;
              SET(W3$FIPSDIAG,WORK3$,W3,P1);
              SET(W3$FIPSLINE,WORK3$,W3,VERBLINE);
              SET(W3$FIPSCOL,WORK3$,W3,VERBCOLUMN); 
              SET(W3$FIPSFNAT,WORK3$,W3,FNATINDEX); 
              SET(W3$FIPSORG,WORK3$,W3,P2); 
              END 
         END
PROC PERIODCHECK(P1); 
         BEGIN
         ITEM P1; 
         IF LASTCLAUSE GR LASTPERIOD AND PMSG NQ 0
         THEN BEGIN 
              # THE CLAUSES IN THE SOURCE-COMPUTER PARAGRAPH #
              # MUST BE TERMINATED BY A PERIOD. # 
  
              # THE CLAUSES IN THE OBJECT-COMPUTER PARAGRAPH #
              # MUST BE TERMINATED BY A PERIOD #
  
              # THE CLAUSES IN THE SPECIAL-NAMES PARAGRAPH #
              # MUST BE TERMINATED BY A PERIOD #
  
              # THE CLAUSES IN A FILE-CONTROL ENTRY MUST #
              # BE TERMINATED BY A PERIOD # 
  
              # THE CLAUSES IN THE I-O-CONTROL PARAGRAPH #
              # MUST BE TERMINATED BY A PERIOD #
  
              INTERCEPTOR(PCOLUMN,PLINE,PMSG,1);
              END 
         COUNT = -1;
         LASTCLAUSE = 0;
         LASTPERIOD = 0;
         PMSG = P1; 
         PCOLUMN = COLUMN$; 
         PLINE = LINE$; 
         RETURN;
         END   #PERIODCHECK#
SWITCH SUB #SUB0#,
SUB1 , SUB2 , SUB3 , SUB4 , SUB5 , SUB6 , SUB7 , SUB8 , SUB9 , SUB10, 
SUB11, SUB12, SUB13, SUB14, SUB15, SUB16, SUB17, SUB18, SUB19, SUB20, 
SUB21, SUB22, SUB23, SUB24, SUB25, SUB26, SUB27, SUB28, SUB29, SUB30, 
SUB31, SUB32, SUB33, SUB34, SUB35, SUB36, SUB37, SUB38, SUB39, SUB40, 
SUB41, SUB42, SUB43, SUB44, SUB45, SUB46, SUB47, SUB48, SUB49, SUB50, 
SUB51, SUB52, SUB53, SUB54, SUB55, SUB56, SUB57, SUB58, SUB59, SUB60, 
SUB61, SUB62, SUB63, SUB64, SUB65, SUB66, SUB67, SUB68, SUB69, SUB70, 
SUB71, SUB72, SUB73, SUB74, SUB75, SUB76, SUB77, SUB78, SUB79, SUB80, 
SUB81, SUB82, SUB83, SUB84, SUB85, SUB86, SUB87, SUB88, SUB89, SUB90; 
         GOTO SUB[SUB$];
SUB1: 
# ENVIRONMENT DIVISION PROLOGUE # 
         AUXTLENGTH = CCTAUXTLEN; 
         LATLENGTH = CCTLATLEN; 
         CCTSIGNLEAD = FALSE; 
         CCTSIGNSEPAR = FALSE;
         PMSG = 0;
         PERIODCHECK(0);
         RETURN;
SUB2: 
# ENVIRONMENT DIVISION EPILOGUE # 
         PERIODCHECK(0);
         CCTAUXTLEN = AUXTLENGTH; 
         CCTLATLEN = LATLENGTH; 
         CCTLATDDLNGT = CCTLATLEN;
         IF CCTCOLLSEQ NQ 0 
         THEN BEGIN 
              IF GET(DN$LEVEL,DNAT$,CCTCOLLSEQ) NQ ALPHNAME 
              THEN BEGIN
                   LINE$ = COLLSQLINE;
                   COLUMN$ = COLLSQCOL; 
                   ERROR(231);
                   END
              END 
         CCTCLOCKUNIT = CLOCK$UNITS;
              IF F46 EQ 0 
              THEN BEGIN
                   #OMISSION OF THE SOURCE-COMPUTER PARAGRAPH#
                   # IS NON-STANDARD COBOL# 
                   INTERCEPTOR(8,CCTEDLINENUM,728,6); 
                   END
              IF F47 EQ 0 
              THEN BEGIN
                   #OMISSION OF THE OBJECT COMPUTER PARAGRAPH#
                   #IS NON-STANDARD COBOL#
                   INTERCEPTOR(8,CCTEDLINENUM,729,6); 
                   END
              IF F48 EQ 0 
              THEN BEGIN
                   #OMISSION OF THE CONFIGURATION SECTION#
                   #IS NON-STANDARD COBOL#
                   INTERCEPTOR(8,CCTEDLINENUM,730,6); 
                   END
              IF F50 EQ 1 AND F49 EQ 0
              THEN BEGIN
                   #OMISSION OF THE FILE-CONTROL PARAGRAPH# 
                   #FROM THE INPUT-OUTPUT SECTION IS NON-STANDARD COBOL#
                   INTERCEPTOR(8,CCTEDLINENUM,731,6); 
                   END
         IF CCTFIPSLEVEL NQ 5 
         THEN BEGIN 
              FOR I = 1 STEP 1 UNTIL W3 
              DO BEGIN
                 REG1 = GET(W3$FIPSFNAT,WORK3$,I);
                 REG2 = GET(FN$ORG,FNAT$,REG1); 
                 REG3 = GET(W3$FIPSORG,WORK3$,I); 
                 IF REG2 NQ REG3
                 THEN BEGIN 
                      TEST I; 
                      END 
                 REG1 = GET(W3$FIPSLINE,WORK3$,I);
                 REG2 = GET(W3$FIPSCOL,WORK3$,I); 
                 REG3 = GET(W3$FIPSDIAG,WORK3$,I);
                 INTERCEPTOR(REG2,REG1,REG3,1); 
                 END
              END 
         RETURN;
SUB3: 
# QUOTE ROUTINE # 
         TRUEFALSE = GET(PL$FIGQUOTE,PLT$,VALUE$);
         RETURN;
SUB4: 
# FN$ABORT ROUTINE #
         SETFNAT(FN$ABORT,1); 
         RETURN;
SUB5: 
# ACCESS MODE SEQUENTIAL #
         ACCESS(SEQACCESS); 
         # FIPS=2 SUPPORTS ACCESS MODE IS SEQUENTIAL #
         # FOR RELATIVE FILES # 
         FIPSLOG(769,RELATIVE,2); 
         # FIPS=4 SUPPORTS ACCESS MODE IS SEQUENTIAL #
         # FOR INDEXED FILES #
         FIPSLOG(770,INDEXED,4);
         RETURN;
SUB6: 
# ACCESS MODE RANDOM #
         ACCESS(RANDOM);
         # FIPS=2 SUPPORTS ACCESS MODE IS RANDOM FOR RELATIVE FILES#
         FIPSLOG(771,RELATIVE,2); 
         # FIPS=4 SUPPORTS ACCESS MODE IS RANDOM FOR INDEXED FILES #
         FIPSLOG(772,INDEXED,4);
         RETURN;
SUB7: 
# ACCESS MODE DYNAMIC # 
         ACCESS(DYNAMIC); 
         # FIPS=3 SUPPORTS ACCESS MODE IS DYNAMIC FOR RELATIVE FILES #
         FIPSLOG(773,RELATIVE,3); 
         # FIPS=4 SUPPORTS ACCESS MODE IS DYNAMIC FOR INDEXED FILES # 
         FIPSLOG(774,INDEXED,4);
         RETURN;
SUB8: 
# ACCESS MODE ABORT ROUTINE # 
         IF SYNTAXONLY EQ 1 THEN RETURN;
         SETFNAT(FN$ACCESS,ACCESSERR);
         SETFNAT(FN$ABORT,1); 
         RETURN;
SUB9: 
# ALPHABET-NAME ROUTINE # 
         ALPHABETDNAT = VALUE$; 
         RETURN;
SUB10:  
# ***** AVAILABLE # 
         RETURN;
SUB11:  
# ***** AVAILABLE # 
         RETURN;
SUB12:  
# ALPHABET-NAME IS IMPLEMENTOR-NAME # 
         GOTO SUB14;
SUB13:  
# ALPHABET-NAME ABORT ROUTINE # 
         SETDNAT(DN$TYPE,ERRTYPE);
         RETURN;
SUB14:  
# CDC-64 ASCII-64 EBCDIC UNI ROUTINE #
         TRUEFALSE = 1; 
         GETPLST(VALUE$,LOC(BEAD$BASE));
         I = GET(PL$LENGTH,PLT$,VALUE$);
         IF I EQ 6 AND C<0,6>B EQ "CDC-64"
         THEN BEGIN 
              SETUPALPHBET(ANCDC64);
              RETURN; 
              END 
         IF I EQ 8 AND C<0,8>B EQ "ASCII-64"
         THEN BEGIN 
              SETUPALPHBET(ANASCII64);
              RETURN; 
              END 
         IF I EQ 6 AND C<0,6>B EQ "EBCDIC"
         THEN BEGIN 
              SETUPALPHBET(ANEBCDIC); 
              RETURN; 
              END 
         IF I EQ 3 AND C<0,3>B EQ "UNI" 
         THEN BEGIN 
              SETUPALPHBET(ANUNI);
              RETURN; 
              END 
         TRUEFALSE = 0; 
         RETURN;
SUB15:  
# ALPHABET-NAME IS STANDARD-1 # 
         SETUPALPHBET(ANSTANDARD1); 
         RETURN;
SUB16:  
# ALPHABET-NAME IS NATIVE # 
         SETUPALPHBET(ANNATIVE);
         RETURN;
SUB17:  
# ALPHABET-NAME IS LITERAL #
         PROCESSLIT(AUXANLITERAL);
         RETURN;
SUB18:  
# ALPHABET-NAME IS LITERAL THRU LITERAL # 
         PROCESSLIT(AUXANTHRU); 
         RETURN;
SUB19:  
# ALPHABET-NAME ALSO LITERAL ROUTINE #
         PROCESSLIT(AUXANALSO); 
         CCTANALSO = TRUE;
         RETURN;
SUB20:  
# ALPHABET-NAME STILL MORE LITERALS # 
         PROCESSLIT(AUXANLITERAL);
         RETURN;
SUB21:  
# ALPHABET-NAME LITERAL PROLOGUE #
         SETUPALPHBET(ANLITERAL); 
         RETURN;
SUB22:  
# ALTERNATE RECORD KEY ROUTINE #
         IF SYNTAXONLY EQ 1 OR
            DNATINDEX EQ 0 OR 
            VALUE$ EQ 0 
         THEN RETURN; 
         I = GETFNAT(FN$ORG); 
         IF I EQ SEQUENTIAL OR
            I EQ RELATIVE OR
            I EQ WORD$ADDR
         THEN BEGIN 
              SYNTAXONLY = 1; 
              ERROR(249); 
              SETFNAT(FN$ABORT,1);
              RETURN; 
              END 
         AUXTLENGTH = AUXTLENGTH + 1; 
          NULLSUPPAUX = AUXTLENGTH; # ZERO OR SPACE SUPPRESSION ENTRY # 
         I = GETFNAT(FN$ALTKPTR); 
         SETFNAT(FN$ALTKPTR,AUXTLENGTH);
         SET(AX$TNEXTPTR,AUX$,AUXTLENGTH,I);
         SET(AX$TTYPE,AUX$,AUXTLENGTH,ALTKEYNAME);
         SET(AX$ALTKEY,AUX$,AUXTLENGTH,VALUE$); 
         SET(AX$DUPLFLG,AUX$,AUXTLENGTH,0); 
         RETURN;
SUB23:  
# ALTERNATE RECORD KEY DUPLICATES # 
         IF SYNTAXONLY EQ 1 OR DNATINDEX EQ 0 THEN RETURN;
         SET(AX$DUPLFLG,AUX$,AUXTLENGTH,1); 
         RETURN;
SUB24:  
# ALTERNATE RECORD KEY DUPLICATES ASCENDING # 
         IF SYNTAXONLY EQ 1 OR DNATINDEX EQ 0 
         THEN RETURN; 
         SET(AX$DUPLASC,AUX$,AUXTLENGTH,1); 
         RETURN;
SUB25:  
# APPLY TECHNIQUE ON FILE-NAME #
         #WE NO LONGER DIAGNOSE DUPLICATE APPLY CLAUSES # 
         # WE CAN APPLY TWO TECHNIQUES JUST AS EASILY # 
         # AS WE CAN APPLY ONE TECHNIQUE #
         RETURN;
SUB26:  
# SELECT ASSIGN PROLOGUE #
         # FIPS=2 SUPPORTS THE SELECT ASSIGN CLAUSE # 
         # FOR RELATIVE FILES # 
         FIPSLOG(767,RELATIVE,2); 
         # FIPS=4 SUPPORTS THE SELECT ASSIGN CLAUSE # 
         # FOR INDEXED FILES #
         FIPSLOG(768,INDEXED,4);
         RETURN;
SUB27:  
# SELECT ASSIGN TO IMPLEMENTOR-NAME # 
         IF SYNTAXONLY EQ 1 OR DNATINDEX EQ 0 THEN RETURN;
         IF GETFNAT(FN$DVCEPTR) EQ 0
         THEN BEGIN 
              SETFNAT(FN$ASSIGN,1); 
              SETFNAT(FN$DVCEPTR,VALUE$); 
              END 
         ELSE BEGIN 
              IF GETFNAT(FN$2DPLTPTR) EQ 0
              THEN BEGIN
                   SETFNAT(FN$2DASSIGN,1);
                   SETFNAT(FN$2DPLTPTR,VALUE$); 
                   END
              ELSE BEGIN
                   ERROR(275);      # MORE THAN TWO FILES ASSIGNED #
                   SYNTAXONLY = 1 ;  # FILES IGNORED #
                   END
              END 
         RETURN;
SUB28:  
# SELECT ASSIGN TO DEFINED-NAME # 
         # TO BE WRITTEN #
         RETURN;
SUB29:  
# SELECT ASSIGN TO INPUT #
         SETUPPLT(5,"INPUT     ");
         RETURN;
SUB30:  
# SELECT ASSIGN TO OUTPUT # 
         SETUPPLT(6,"OUTPUT    ");
         RETURN;
SUB31:  
# SELECT ASSIGN TO LITERAL #
         IF GET(PL$TYPE,PLT$,VALUE$) NQ PLTQUOTEDLIT
         THEN BEGIN 
              ERROR(406); 
              SYNTAXONLY = 1; 
              END 
         RETURN;
SUB32:  
# BLOCK COUNT IS DATA-NAME #
         IF SYNTAXONLY EQ 1 THEN RETURN;
         IF GETFNAT(FN$DBLCT) EQ 0
         THEN BEGIN 
              SETFNAT(FN$DBLCT,1);
              SETFNAT(FN$DBLCTPTR,VALUE$);
              END 
         ELSE BEGIN 
              ERROR(247); 
              END 
         RETURN;
SUB33:  
# BLOCK COUNT IS LITERAL #
         IF SYNTAXONLY EQ 1 THEN RETURN;
         IF GETFNAT(FN$DBLCT) EQ 0
         THEN BEGIN 
              SETFNAT(FN$DBLCT,1);
              GET$INT;
              SETFNAT(FN$DBLCTVAL,T$REG); 
              END 
         ELSE BEGIN 
              ERROR(247); 
              END 
         RETURN;
SUB34:  
# CURRENCY SIGN IS LITERAL #
         IF GET(PL$6BITTYPE,PLT$,VALUE$) NQ PLTQUOTEDLIT
         OR GET(PL$LENGTH,PLT$,VALUE$) NQ 1 
         THEN BEGIN 
              ERROR(325); 
              END 
         RETURN;
SUB35:  
# SOURCE/OBJECT COMPUTER LITERAL #
         IF GET(PL$CODE,PLT$,VALUE$) EQ PLTQUOTEDLIT
         THEN RETURN; 
         IF GET(PL$TYPE,PLT$,VALUE$) EQ PLTUNSGNILIT
         THEN RETURN; 
         # SC AND OC LITERAL MAY BE NUMERIC OR NONNUMERIC # 
         # IF NUMERIC, THEY MUST BE UNSIGNED INTEGER #
         ERROR(556);
         RETURN;
SUB36:  
# MULTIPLE FILE CONTAINS PROLOGUE # 
         FILE$COUNT = 1;
         NBRMFFILES=0;
         RETURN;
SUB37:  
# MULTIPLE FILE CONTAINS FILE-NAME #
         SVD$FNAT$PTR = GET(DN$FNATPTR,DNAT$,VALUE$); 
         # SAVE FNAT POINTER AND LINES AND COL FOR CHECKING MFNS       #
         NBRMFFILES = NBRMFFILES + 1; 
         I = VIRTUAL(WORK2$,NBRMFFILES);
         WORK2$FNAT[I] = SVD$FNAT$PTR;
         WORK2$COL[I] = COLUMN$;
         WORK2$LINE[I] = LINE$; 
         IF GET(FN$MFILPOS,FNAT$,SVD$FNAT$PTR) NQ 0 
         THEN BEGIN 
              ERROR(302); 
              SYNTAXONLY = 1; 
              RETURN; 
              END 
         CCTPLTLEN = CCTPLTLEN + 1; 
         CCTPLSTLEN = CCTPLSTLEN + 1; 
         POSITIONPLST = CCTPLSTLEN; 
         I = VIRTUAL(PLT$,CCTPLTLEN); 
         PL$CODE[I] = PLTINTLIT;
         PL$LENGTH[I] = 4;
         PL$STRINGPTR[I] = CCTPLSTLEN;
         J = VIRTUAL(FNAT$,SVD$FNAT$PTR); 
         FN$LABLPTR4[J] = CCTPLTLEN;
         FN$LABLLIT4[J] = 1;
         I = DECR(FILE$COUNT+10000);
         SET(PLT$CHAR,PLTSTR$,CCTPLSTLEN,C<6,4>I);
         SET(FN$MFILPOS,FNAT$,SVD$FNAT$PTR,FILE$COUNT); 
         FILE$COUNT = FILE$COUNT + 1; 
         I = GET(FN$LABLPTR2,FNAT$,SVD$FNAT$PTR) ;  #GET FILE-SET-ID# 
         IF I EQ 0
         THEN BEGIN 
              # IF FILE-SET-ID IS NOT SPECIFIED IN THE LABEL CLAUSE # 
              # THEN USE MFN FOR IT # 
              CCTPLTLEN = CCTPLTLEN + 1 ; 
              CCTPLSTLEN = CCTPLSTLEN + 1;
              I = VIRTUAL(PLT$,CCTPLTLEN);
              PL$CODE[I] = PLTQUOTEDLIT;
              PL$LENGTH[I] = 6; 
              PL$STRINGPTR[I] = CCTPLSTLEN; 
              J = VIRTUAL(FNAT$,SVD$FNAT$PTR);
              FN$LABLPTR2[J] = CCTPLTLEN; 
              FN$LABLLIT2[J] = 1; 
              J = VIRTUAL(PLT$,FN$DVCEPTR[J]);
              J = VIRTUAL(PLTSTR$,PL$STRINGPTR[J]); 
              SET(PLT$CHAR,PLTSTR$,CCTPLSTLEN,C<0,6>PLT$CHAR[J]); 
              END 
         SYNTAXONLY = 0;
         RETURN;
SUB88:  
# PSEUDO-FILE-NAME ROUTINE #
         FILE$COUNT = FILE$COUNT + 1; 
         RETURN;
SUB90:  
# PSEUDO-FILE-NAME POSITION ROUTINE # 
         IF SYNTAXONLY EQ 1 THEN RETURN;
         INT$OR$DIAG(304);
         FILE$COUNT = T$REG + 1;
         RETURN;
SUB38:  
# MULTIPLE FILE POSITION INTEGER #
         IF SYNTAXONLY EQ 1 THEN RETURN;
         INT$OR$DIAG(304);
         I = DECR(T$REG + 10000); 
         SET(PLT$CHAR,PLTSTR$,POSITIONPLST,C<6,4>I);
         SET(FN$MFILPOS,FNAT$,SVD$FNAT$PTR,T$REG);
         FILE$COUNT = T$REG + 1;
         RETURN;
SUB89:  
# MULTIPLE FILE CONTAINS EPILOGUE # 
# CHECK MFNS (MULTI-FILE NAMES) FOR VALIDITY #
         MFN = "      ";
         FOR I = 1 STEP 1 UNTIL NBRMFFILES DO 
              BEGIN 
              J = VIRTUAL(WORK2$,I);
              SVD$FNAT$PTR = VIRTUAL(FNAT$,WORK2$FNAT[J]);
              IF SVD$FNAT$PTR EQ 0
               THEN 
                  TEST;  # BAD OR UNDEFINED FNAT - IGNORE # 
              FNLINE = WORK2$LINE[J]; 
              FNCOLUMN = WORK2$COL[J];
              IF CCTOSISNOS 
              THEN BEGIN
                   J = FN$DVCEPTR[SVD$FNAT$PTR];
                   END
              ELSE BEGIN
                   IF FN$LABLLIT2[SVD$FNAT$PTR] NQ 1
                   THEN 
                        RETURN;  #MFN NOT KNOWN IF FILE-SET-ID IS DN #
                   J = FN$LABLPTR2[SVD$FNAT$PTR]; 
                   END
              L = PL$STRINGPTR[VIRTUAL(PLT$,J)];
              CMFN = C<0,6>PLT$CHAR[VIRTUAL(PLTSTR$,L)];
              #TEST THE MFN TO SEE IF IT IS VALID - 1ST CHAR LETTER ETC#
              FOR L = 0 STEP 6 UNTIL 30 DO
                   BEGIN
                   J = B<L,6>CMFN;
                   IF (L EQ 0 AND J GR O"32") 
                   OR (J NQ O"55" AND J GR O"44") 
                   OR J EQ 0
                   THEN BEGIN 
                        INTERCEPTOR(FNCOLUMN,FNLINE,DIAG3054,1);
                        TEST I; 
                        END 
                   END
              IF MFN EQ "       " 
              THEN
                   MFN = CMFN;
              ELSE BEGIN
                   IF MFN NQ CMFN 
                   THEN BEGIN 
                        INTERCEPTOR(FNCOLUMN,FNLINE,DIAG3057,1);
                        RETURN; 
                        END 
                   END
              IF NOT CCTOSISNOS 
              THEN BEGIN
                   # FOR NOS/BE, THE MFN CANNOT = THE LFN # 
                   J = FN$DVCEPTR[SVD$FNAT$PTR];
                   J = PL$STRINGPTR[VIRTUAL(PLT$,J)]; 
                   IF MFN EQ C<0,7>PLT$CHAR[VIRTUAL(PLTSTR$,J)] 
                   THEN BEGIN 
                        INTERCEPTOR(FNCOLUMN,FNLINE,DIAG3058,1);
                        RETURN; 
                        END 
                   END
              END 
         RETURN;
SUB39:  
# ORGANIZATION IS SEQUENTIAL #
         ORGANIZATION = SEQUENTIAL; 
         GOTO ORGANCOMMON;
SUB40:  
# ORGANIZATION IS RELATIVE #
         ORGANIZATION = RELATIVE; 
         IF CCTFIPSLEVEL LS 2 
         THEN ERROR(706); 
         GOTO ORGANCOMMON;
SUB41:  
# ORGANIZATION IS INDEXED # 
         ORGANIZATION = INDEXED;
         IF CCTFIPSLEVEL LS 4 
         THEN ERROR(707); 
         GOTO ORGANCOMMON;
SUB42:  
# ORGANIZATION IS DIRECT #
         ORGANIZATION = DIRECT; 
         GOTO ORGANCOMMON;
SUB43:  
# ORGANIZATION IS ACTUAL-KEY #
         ORGANIZATION = ACTUAL$KEY; 
         GOTO ORGANCOMMON;
SUB44:  
# ORGANIZATION IS WORD-ADDRESS #
         ORGANIZATION = WORD$ADDR;
         #FALLING THRU# 
         ORGANCOMMON: 
         IF SYNTAXONLY EQ 1 OR DNATINDEX EQ 0 
         THEN RETURN; 
         IF GETDNAT(DN$ORG) EQ 0
         THEN BEGIN 
              SETDNAT(DN$ORG,1);
              SETFNAT(FN$ORG,ORGANIZATION); 
              END 
         ELSE BEGIN 
              ERROR(324); 
              END 
         RETURN;
SUB45:  
# ORGANIZATION IS NONE OF THE ABOVE # 
         ERROR(135);
         IF SYNTAXONLY EQ 0 
         THEN BEGIN 
              SETFNAT(FN$ORG,ORGERR); 
              SETFNAT(FN$ABORT,1);
              END 
         RETURN;
SUB46:  
# RECORD KEY IS DATA-NAME # 
         IF SYNTAXONLY EQ 1 THEN RETURN;
         IF DNATINDEX EQ 0 THEN RETURN; 
         IF GETDNAT(DN$RECKEY) EQ 0 
         THEN BEGIN 
              SETDNAT(DN$RECKEY,1); 
              SETFNAT(FN$RECPTR,VALUE$);
              END 
         ELSE BEGIN 
              ERROR(323); 
              END 
         RETURN;
SUB47:  
# RELATIVE KEY IS DATA-NAME # 
         IF SYNTAXONLY EQ 1 THEN RETURN;
         IF DNATINDEX EQ 0 THEN RETURN; 
         IF GETDNAT(DN$RELKEY) EQ 0 
         THEN BEGIN 
              SETDNAT(DN$RELKEY,1); 
              SETFNAT(FN$RELKPTR,VALUE$); 
              END 
         ELSE BEGIN 
              ERROR(322); 
              END 
         # FIPS=2 SUPPORTS RELATIVE KEY IS DATA-NAME #
         FIPSLOG(775,RELATIVE,2); 
         RETURN;
SUB48:  
# RERUN END OF REEL OF FILE # 
         IF SYNTAXONLY EQ 0 
         THEN BEGIN 
              IF GET(DN$LEVEL,DNAT$,VALUE$) EQ FDDESCR OR 
                 GET(DN$LEVEL,DNAT$,VALUE$) EQ SDDESCR
              THEN BEGIN
                   FNATINDEX = GET(DN$FNATPTR,DNAT$,VALUE$);
                   IF GETFNAT(FN$RRUNEOR) EQ 1
                   THEN BEGIN 
                        ERROR(310); 
                        END 
                   ELSE BEGIN 
                        SETFNAT(FN$RRUNEOR,1);
                        END 
                   END
              ELSE BEGIN
                   ERROR(311);
                   END
              END 
         BUGS(342,0,346,349); 
         RETURN;
SUB49:  
# RERUN INTEGER RECORDS # 
         INT$OR$DIAG(312);
         RERUN$COUNT = T$REG; 
         RETURN;
SUB50:  
# RERUN INTEGER RECORDS OF FILE-NAME #
         IF SYNTAXONLY EQ 0 
         THEN BEGIN 
              IF GET(DN$LEVEL,DNAT$,VALUE$) EQ FDDESCR
              OR GET(DN$LEVEL,DNAT$,VALUE$) EQ SDDESCR
              THEN BEGIN
                   FNATINDEX = GET(DN$FNATPTR,DNAT$,VALUE$);
                   IF GETFNAT(FN$RRUNREC) EQ 0
                   THEN BEGIN 
                        SETFNAT(FN$RRUNREC,RERUN$COUNT);
                        END 
                   ELSE BEGIN 
                        ERROR(310); 
                        END 
                   # FIPS=2 SUPPORTS RERUN INTEGER RECORDS OF # 
                   # RELATIVE FILE-NAME # 
                   FIPSLOG(778,RELATIVE,2); 
                   # FIPS=4 SUPPORTS RERUN INTEGER RECORDS OF # 
                   # INDEXED FILE-NAME #
                   FIPSLOG(779,INDEXED,4);
                   END
              ELSE BEGIN
                   ERROR(311);
                   END
              END 
         BUGS(343,0,347,349); 
         RETURN;
SUB51:  
# RERUN INTEGER CLOCK UNITS # 
         IF SYNTAXONLY EQ 0 
         THEN BEGIN 
              IF CLOCK$UNITS EQ 0 
              THEN CLOCK$UNITS = RERUN$COUNT; 
              ELSE BEGIN
                   ERROR(313);
                   END
              END 
         BUGS(345,345,345,349); 
         RETURN;
SUB52:  
# RERUN EVERY CONDITION # 
         IF GET(DN$LEVEL,DNAT$,VALUE$) NQ 88
         THEN BEGIN 
              ERROR(316); 
              RETURN; 
              END 
         #CCTRERUNCOND CONTAINS A 12 BIT MASK#
         #BITS 0-47 ARE ZERO# 
         #48 OFF SWITCH-6#
         #49 OFF SWITCH-5#
         #50 OFF SWITCH-4#
         #51 OFF SWITCH-3#
         #52 OFF SWITCH-2#
         #53 OFF SWITCH-1#
         #54 ON SWITCH-6# 
         #55 ON  SWITCH-5#
         #56 ON  SWITCH-4#
         #57 ON  SWITCH-3#
         #58 ON  SWITCH-2#
         #59 ON  SWITCH-1#
         #NOTE- MORE THAN ONE RERUN CLAUSE CAN REFERENCE# 
         #       THE SAME SWITCH# 
         #DN$BYTEOFFS CONTAINS THE SWITCH NUMBER# 
         R1 = GET(DN$BYTEOFFS,DNAT$,VALUE$);
         R2 = 0;
         IF GET(DN$ONSTAT,DNAT$,VALUE$) EQ 1
         THEN R2 = 60 - R1; 
         IF GET(DN$OFFSTAT,DNAT$,VALUE$) EQ 1 
         THEN R2 = 54 - R1; 
         IF R2 NQ 0 
         THEN B<R2> CCTRERUNCOND = 1; 
         ELSE ERROR(350); 
         BUGS(344,0,348,349); 
         RETURN;
SUB53:  
# LINE AND COLUMN # 
         VERBLINE = LINE$;
         VERBCOLUMN = COLUMN$;
         RETURN;
SUB54:  
# FILE NAME ROUTINE # 
         TRUEFALSE = 0; 
         R1 = GET(DN$LEVEL,DNAT$,VALUE$); 
         IF R1 EQ FDDESCR OR R1 EQ SDDESCR
         THEN TRUEFALSE = 1;
         RETURN;
SUB55:  
# RESERVE INTEGER AREAS # 
         IF SYNTAXONLY EQ 0 AND DNATINDEX NQ 0
         THEN BEGIN 
              INT$OR$DIAG(319); 
              IF GETFNAT(FN$RESAREA) EQ 0 
              THEN BEGIN
                   SETFNAT(FN$RESAREA,T$REG); 
                   END
              ELSE BEGIN
                   ERROR(320);
                   END
              # FIPS=3 SUPPORTS RESERVE INTEGER AREAS # 
              FIPSLOG(793,SEQUENTIAL,3);
              FIPSLOG(793,RELATIVE,3);
              # FIPS=4 SUPPORTS RESERVE INTEGER AREAS # 
              FIPSLOG(794,INDEXED,4); 
              END 
         RETURN;
SUB56:  
# SAME RECORD AREA #
         SAME$A$TYPE = 0; 
         CHAIN$HEAD = AUXTLENGTH + 1; 
         AUXINDEX = 0;
         RETURN;
SUB57:  
# SAME SORT/SORT-MERGE AREA # 
         SAME$A$TYPE = 1; 
         CHAIN$HEAD = AUXTLENGTH + 1; 
         AUXINDEX = 0;
         ERROR(307);
         RETURN;
SUB58:  
# SAME AREA ROUTINE # 
         SAME$A$TYPE = 2; 
         CHAIN$HEAD = AUXTLENGTH + 1; 
         AUXINDEX = 0;
         ERROR(307);
         RETURN;
SUB59:  
# SAME AREA FILE-NAME ROUTINE # 
         IF SYNTAXONLY EQ 1 THEN RETURN;
         I = GET(DN$LEVEL,DNAT$,VALUE$);
         IF I NQ FDDESCR AND I NQ SDDESCR 
         THEN BEGIN 
              ERROR(308); 
              RETURN; 
              END 
         IF I EQ SDDESCR AND SAME$A$TYPE EQ 2 
         THEN BEGIN 
              ERROR(332); 
              RETURN; 
              END 
         FNATINDEX = GET(DN$FNATPTR,DNAT$,VALUE$);
         ORG = GETFNAT(FN$ORG); 
         IF SAME$A$TYPE EQ 0
         THEN BEGIN 
              IF CCTFIPSLEVEL LS 3 AND ORG EQ SEQUENTIAL
              THEN BEGIN
                   #FIPS = 3 SUPPORTS SAME RECORD AREA CLAUSE#
                   #FOR SEQUENTIAL FILES# 
                   ERROR(719);
                   END
              IF CCTFIPSLEVEL LS 3 AND ORG EQ RELATIVE
              THEN BEGIN
                   #FIPS = 3 SUPPORTS SAME RECORD AREA# 
                   #CLAUSE FOR RELATIVE FILES # 
                   ERROR(720);
                   IF CCTFIPSLEVEL LS 2 
                   THEN BEGIN 
                        # FIPS = 2 SUPPORTS SAME AREA CLAUSE FOR
                          RELATIVE FILES #
                        ERROR(723); 
                        END 
                   END
              IF CCTFIPSLEVEL LS 4 AND ORG EQ INDEXED 
              THEN BEGIN
                   #FIPS = 4 SUPPORTS SAME RECORD AREA# 
                   #CLAUSE FOR INDEXED FILES# 
                   ERROR(721);
                   END
              IF CCTFIPSLEVEL LS 4 AND
                 GETQUICK(DN$LEVEL,DNAT$,VALUE$) EQ SDDESCR 
              THEN BEGIN
                   #FIPS = 4 SUPPORTS SAME RECORD#
                   #AREA CLAUSE FOR SORT FILES# 
                   ERROR(722);
                   END
              IF GETFNAT(FN$SRECPTR) NQ 0 
              THEN BEGIN
                   ERROR(329);
                   RETURN;
                   END
              IF AUXINDEX NQ 0
              THEN BEGIN
                   SET(AX$TNEXTPTR,AUX$,AUXINDEX,AUXTLENGTH+1); 
                   END
              AUXINDEX = ADDNEWAUXENT(0); 
              SETAUX(AX$TTYPE,SAMRECNAME);
              SET(AX$SAMRECNAM,AUX$,AUXINDEX,VALUE$); 
              SETFNAT(FN$SRECPTR,CHAIN$HEAD); 
              RETURN; 
              END 
         IF SAME$A$TYPE EQ 1
         THEN BEGIN 
              IF GETFNAT(FN$SSORTPTR) NQ 0
              THEN BEGIN
                   ERROR(330);
                   RETURN;
                   END
              IF AUXINDEX NQ 0
              THEN BEGIN
                   SETAUX(AX$TNEXTPTR,AUXTLENGTH+1);
                   END
              AUXINDEX = ADDNEWAUXENT(0); 
              SETAUX(AX$TTYPE,SAMSORTNAM);
              SETAUX(AX$SAMSRTNAM,VALUE$);
              SETFNAT(FN$SSORTPTR,CHAIN$HEAD);
              RETURN; 
              END 
         IF SAME$A$TYPE EQ 2
         THEN BEGIN 
              IF CCTFIPSLEVEL LS 2 AND ORG EQ RELATIVE
              THEN BEGIN
                   #FIPS = 2 SUPPORTS THE SAME AREA#
                   #CLAUSE FOR RELATIVE FILES#
                   ERROR(723);
                   END
              IF CCTFIPSLEVEL LS 4 AND ORG EQ INDEXED 
              THEN BEGIN
                   #FIPS = 4 SUPPORTS THE SAME AREA#
                   #CLAUSE FOR INDEXED FILES# 
                   ERROR(724);
                   END
              IF GETFNAT(FN$SAREAPTR) NQ 0
              THEN BEGIN
                   ERROR(331);
                   RETURN;
                   END
              IF AUXINDEX NQ 0
              THEN BEGIN
                   SETAUX(AX$TNEXTPTR,AUXTLENGTH+1);
                   END
              AUXINDEX = ADDNEWAUXENT(0); 
              SETAUX(AX$TTYPE,SAMAREANAM);
              SETAUX(AX$SAMARANAM,VALUE$);
              SETFNAT(FN$SAREAPTR,CHAIN$HEAD);
              RETURN; 
              END 
         RETURN;
SUB60:  
# SEGMENT-LIMIT ROUTINE # 
         IF GET(PL$TYPE,PLT$,VALUE$) NQ PLTUNSGNILIT
         THEN BEGIN 
              ERROR(300); 
              END 
         ELSE BEGIN 
              GET$INT;
              IF T$REG LQ 0 OR T$REG GQ 50
              THEN BEGIN
                   ERROR(240);
                   END
              ELSE BEGIN
                   CCTSEGLIMIT = T$REG; 
                   END
              END 
         RETURN;
SUB61:  
# SELECT OPTIONAL ROUTINE # 
         OPTIONAL = TRUEFALSE;
         IF CCTFIPSLEVEL LS 3 AND OPTIONAL EQ 1 
         THEN ERROR(704); 
         RETURN;
SUB62:  
# SELECT FILE-NAME ROUTINE #
         DATANAMETEMP = 0;
         IF GET(DN$LEVEL,DNAT$,VALUE$) EQ FDDESCR OR
            GET(DN$LEVEL,DNAT$,VALUE$) EQ SDDESCR 
         THEN BEGIN 
              FNATINDEX = GET(DN$FNATPTR,DNAT$,VALUE$); 
              IF GETFNAT(FN$SELECT) EQ 1
              THEN BEGIN
                   ERROR(306);
                   SYNTAXONLY = 1;
                   DNATINDEX = 0; 
                   FNATINDEX = 0; 
                   GOTO L1; 
                   END
              # FIPS=2 SUPPORTS THE SELECT CLAUSE FOR RELATIVE FILES #
              FIPSLOG(765,RELATIVE,2);
              # FIPS=4 SUPPORTS THE SELECT CLAUSE FOR INDEXED FILES # 
              FIPSLOG(766,INDEXED,4); 
              DNATINDEX = VALUE$; 
              SETFNAT(FN$LINE,LINE$); 
              SETFNAT(FN$SELECT,1); 
              SETFNAT(FN$OPTIONAL,OPTIONAL);
              L1: 
              IF GET(DN$LEVEL,DNAT$,VALUE$) EQ FDDESCR
              THEN BEGIN
                   TRUEFALSE = 0; 
                   END
              END 
         ELSE BEGIN 
              ERROR(177); 
              SYNTAXONLY = 1; 
              DNATINDEX = 0;
              FNATINDEX = 0;
              END 
         RETURN;
SUB63:  
# PROGRAM COLLATING SEQUENCE #
         CCTCOLLSEQ = VALUE$; 
         COLLSQLINE = LINE$;
         COLLSQCOL = COLUMN$; 
         RETURN;
SUB64:  
# SIGN CONTROL LEADING #
         IF SYNTAXONLY EQ 1 THEN RETURN;
         IF SIGNCONTROL 
         THEN BEGIN 
              # THIS DUPLICATE SIGN CONTROL # 
              # CLAUSE IS IGNORED # 
              ERROR(309); 
              END 
         ELSE BEGIN 
              SIGNCONTROL = TRUE; 
              CCTSIGNLEAD = TRUE; 
              END 
         RETURN;
SUB65:  
# SIGN CONTROL TRAILING # 
         IF SYNTAXONLY EQ 1 THEN RETURN;
         IF SIGNCONTROL 
         THEN BEGIN 
              # THIS DUPLICATE SIGN CONTROL # 
              # CLAUSE IS IGNORED # 
              ERROR(309); 
              END 
         ELSE BEGIN 
              SIGNCONTROL = TRUE; 
              END 
         RETURN;
SUB66:  
# SIGN CONTROL SEPARATE # 
         IF SYNTAXONLY EQ 0 
         THEN CCTSIGNSEPAR = TRUE;
         RETURN;
SUB67:  
# FILE STATUS ROUTINE # 
         IF SYNTAXONLY EQ 1 THEN RETURN;
         IF GETFNAT(FN$STATPTR) EQ 0
         THEN SETFNAT(FN$STATPTR,VALUE$); 
         ELSE BEGIN 
              ERROR(301); 
              END 
         # FIPS=2 SUPPORTS FILE STATUS IS DATA-NAME # 
         # FOR RELATIVE FILES # 
         FIPSLOG(776,RELATIVE,2); 
         # FIPS=4 SUPPORTS FILE STATUS IS DATA-NAME # 
         # FOR INDEXED FILES #
         FIPSLOG(777,INDEXED,4);
         RETURN;
SUB68:  
# USE LITERAL ROUTINE # 
          IF GETFNAT(FN$USLITPTR) EQ 0
          THEN SETFNAT(FN$USLITPTR,VALUE$); 
          ELSE
              ERROR(326); 
         RETURN;
SUB69:  
# WORD-ADDRESS KEY ROUTINE #
         IF SYNTAXONLY EQ 1 THEN RETURN;
         IF GETFNAT(FN$ORG) EQ WORD$ADDR
         THEN BEGIN 
              SETFNAT(FN$WAKPTR,VALUE$);
              END 
         ELSE BEGIN 
              ERROR(248); 
              SETFNAT(FN$ABORT,1);
              END 
         RETURN;
SUB70:  
# SWITCH-N ROUTINE #
         SVD$PLT$PTR = VALUE$;
         ALPHABETDNAT = VALUE$; 
         SWITCHFLAG = FALSE;
         SET(PL$COLUMN,PLT$,VALUE$,COLUMN$);
         I = GET(PL$LENGTH,PLT$,VALUE$);
         IF I LS 8 OR I GR 10 THEN RETURN;
         GETPLST(VALUE$,LOC(BEAD$BASE));
         IF C<0,7>B NQ "SWITCH-" THEN RETURN; 
         SUM = 0; 
         FOR J = 7 STEP 1 UNTIL I - 1 
         DO BEGIN 
            IF C<J>B LS "0" OR C<J>B GR "9" 
            THEN RETURN;
            SUM = 10*SUM + C<J>B - "0"; 
            END 
         IF SUM NQ 0 AND SUM LQ 126 
         THEN BEGIN 
              SWITCH$ORD = SUM; 
              SWITCHFLAG = TRUE;
              END 
         RETURN;
SUB71:  
# ON STATUS IS CONDITION-NAME # 
         ONOFF = 1; 
         GOTO ONOFFCOMMON;
SUB72:  
# OFF STATUS IS CONDITION-NAME #
         ONOFF = 2; 
         # FALLING THROUGH #
         ONOFFCOMMON: 
         DNATINDEX = VALUE$;
         IF NOT SWITCHFLAG
         THEN BEGIN 
              ERROR(241); 
              SETDNAT(DN$TYPE,ERRTYPE); 
              RETURN; 
              END 
         SET(DN$LINE,DNAT$,DNATINDEX,LINE$);
         SETDNAT(DN$LEVEL,88);
         SETDNAT(DN$TYPE,NONDATA);
         SETDNAT(DN$BYTEOFFS,SWITCH$ORD); 
         IF ONOFF EQ 1
         THEN SETDNAT(DN$ONSTAT,1); 
         ELSE SETDNAT(DN$OFFSTAT,1);
         RETURN;
SUB73:  
# IMPLEMENTOR-NAME IS MNEMONIC NAME # 
         DNATINDEX = VALUE$;
         SET(DN$LINE,DNAT$,DNATINDEX,LINE$);
         SETDNAT(DN$LEVEL,MNEMNAME);
         SETDNAT(DN$TYPE,NONDATA);
         IF SWITCHFLAG
         THEN BEGIN 
              SETDNAT(DN$SWITCH,1); 
              SETDNAT(DN$BYTEOFFS,SWITCH$ORD);
              END 
         ELSE BEGIN 
              SETDNAT(DN$IMPLPTR,SVD$PLT$PTR);
              I = GET(PL$LENGTH,PLT$,SVD$PLT$PTR);
              SETDNAT(DN$ITMLEN,I); 
              END 
         RETURN;
SUB74:  
# ALTERNATE KEY OMITTED WHEN ROUTINE #
         SET(AX$OMITTED,AUX$,AUXTLENGTH,1); 
         RETURN;
SUB75:  
# WHEN KEY IS SPACES OR ZEROES #
         IF SYNTAXONLY EQ 1 THEN RETURN;
         IF GET(PL$FIGSPACE,PLT$,VALUE$) EQ 1 
         THEN BEGIN 
               SET(AX$KEYSPACES,AUX$,NULLSUPPAUX,1);
              RETURN; 
              END 
         IF GET(PL$FIGZERO,PLT$,VALUE$) EQ 1
         THEN BEGIN 
               SET(AX$KEYZEROES,AUX$,NULLSUPPAUX,1);
              RETURN; 
              END 
         # THE FIGURATIVE CONSTANT ZEROES OR #
         # THE FIGURATIVE CONSTANT SPACES IS REQUIRED HERE #
         ERROR(757);
         SETFNAT(FN$ABORT,1); 
         RETURN;
SUB76:  
# ALTERNATE KEY WHEN DATA-NAME ROUTINE #
         IF SYNTAXONLY EQ 1 THEN RETURN;
         IF VALUE$ EQ 0 THEN RETURN;
         AUXENTRYTEMP = AUXTLENGTH; 
         IF DATANAMETEMP EQ 0 
         THEN BEGIN 
              AUXTLENGTH = AUXTLENGTH + 1;
              I = GETFNAT(FN$ALTKPTR);
              SETFNAT(FN$ALTKPTR,AUXTLENGTH); 
              SET(AX$TNEXTPTR,AUX$,AUXTLENGTH,I); 
              SET(AX$TTYPE,AUX$,AUXTLENGTH,AUXALTKEYDN2); 
              SET(AX$AKDN2DNAT,AUX$,AUXTLENGTH,VALUE$); 
              DATANAMETEMP = VALUE$;
              # D-ANALYZER WILL CHECK THAT DATA-NAME-2 IS # 
              # SINGLE CHARACTER ALPHANUMERIC AND IN THE RECORD # 
              RETURN; 
              END 
         IF DATANAMETEMP NQ VALUE$
         THEN BEGIN 
              # WHEN THE PHRASE,DATA-NAME CONTAINS #
              # CHARACTER FROM LITERAL, APPEARS IN #
              # MORE THAN ONE ALTERNATE RECORD KEY #
              # CLAUSE FOR THE SAME FILE, THE SAME #
              # DATA-NAME MUST BE USED EACH TIME #
              ERROR(761); 
              SETFNAT(FN$ABORT,1);
              END 
         RETURN;
SUB77:  
# ALTERNATE KEY LITERAL ROUTINE # 
         L = GET(PL$LENGTH,PLT$,VALUE$);
         I = GET(PL$TYPE,PLT$,VALUE$);
         IF I NQ PLTQUOTEDLIT OR L GR 36
         THEN GOTO L77; 
         WORD = 0;
         GETPLST(VALUE$,LOC(BEAD$BASE));
         FOR J = 0 STEP 6 UNTIL 6 * L - 6 
         DO BEGIN 
            I = B<J,6>B;
            IF I GQ 1 AND 
               I LQ 36 AND
               B<I>WORD EQ 0
            THEN BEGIN
                 B<I>WORD = 1;
                 END
            ELSE BEGIN
                 GOTO L77;
                 END
            END 
         SET(AX$ALTKEYLIT,AUX$,AUXENTRYTEMP,VALUE$);
         RETURN;
  
         L77: 
         # A QUOTED LITERAL CONTAINING ONLY THE # 
         # CHARACTERS 1-9, A-Z AND NOT MORE # 
         # THAN ONE OCCURRENCE OF EACH, # 
         # IS REQUIRED HERE # 
         ERROR(760);
         SETFNAT(FN$ABORT,1); 
         RETURN;
SUB78:  
# CLAUSE COUNT ROUTINE #
         COUNT = COUNT + 1; 
         LASTCLAUSE = COUNT;
         RETURN;
SUB79:  
# SOURCE-COMPUTER ROUTINE # 
         PERIODCHECK(659);
         RETURN;
SUB80:  
# OBJECT-COMPUTER ROUTINE # 
         PERIODCHECK(654);
         RETURN;
SUB81:  
# SPECIAL-NAMES ROUTINE # 
         PERIODCHECK(655);
         RETURN;
SUB82:  
# INPUT-OUTPUT SECTION ROUTINE #
         PERIODCHECK(0);
         RETURN;
SUB83:  
# FILE-CONTROL ROUTINE #
         PERIODCHECK(0);
         RETURN;
SUB84:  
# I-O-CONTROL ROUTINE # 
         PERIODCHECK(656);
         RETURN;
SUB85:  
# FILE-CONTROL ENTRY ROUTINE #
         PERIODCHECK(657);
         RETURN;
SUB86:  
# CONFIGURATION SECTION ROUTINE # 
         PERIODCHECK(0);
         RETURN;
SUB87:  
# PERIOD ROUTINE #
         IF LASTPERIOD NQ 0 
         THEN BEGIN 
              # DUPLICATE PERIOD #
              ERROR(658); 
              END 
         COUNT = COUNT + 1; 
         LASTPERIOD = COUNT;
         RETURN;
         END #E$SUBS# 
         TERM 
