*DECK CODECL
USETEXT DNTEXT
USETEXT RPTEXT
PROC CODECL;   #CYR34#
          BEGIN 
          ITEM   CURRENTFILE  , 
                 PLTPTR       , 
                 FDRDINDEX    , 
                 FILEINDEX    , 
                 CODEINDEX    , 
                 TWOBLANKS    C(2) = "  ",
                 CODECLPLTENT ; 
  
  
          ITEM   $TEMP$,
                $DUMMY$;
  
          XREF   PROC         INTERCEPT;
          XREF   FUNC         PLTCNVRT I; 
          XREF   PROC         RWSET    ;
          XREF   PROC         RWSET1   ;
          XREF   PROC         GETNEXT  ;
          XREF   FUNC         RP$AUXPTR;
          XREF   FUNC         RWGET    ;
          XREF   FUNC         RWGET1   ;
  
          DEF    GET          #GETFIELD#; 
          DEF    SET          #SETFIELD#; 
          DEF    GETQ         #GETQUICK#; 
  
  
*CALL RPCOMM
*CALL FDRDT1
*CALL GETSET
*CALL PLT1
*CALL PLTVALS 
*CALL TABLNAMES 
  
  
  
          CONTROL EJECT;
  
  
  
  # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *#
  # * #   EPTRACE("CODECL ")                                       # * #
  # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *#
  
          NOCODECLAUSE = 0; 
          ALL4CODELIT = 0;
          CODECLPLTENT = RWGET(CODECLAUSPLT,RP$AUXPTR(DNATPOINTER));
          IF CODECLPLTENT  EQ  0
          THEN
              GOTO NOCODE61732; 
          #IF CODE CLAUSE WAS SPECIFIED CHECK TO SEE IF IT WAS A 2 CHAR#
          #NONNUMERIC LITERAL  - REF. JOD 6.17.3.1# 
  
          PLTPTR  = CODECLPLTENT; 
          IF   RWGET(CODEALLSWTCH,RP$AUXPTR(DNATPOINTER)) EQ 1
          THEN
              ALL4CODELIT = 1;
  
          #ABOVE SWITCH TELLS IRT-RT TO SET ALL BIT ON IN LAT ENTRIES#
          #IT BUILDS WHERE CODE CLAUSE LITERALS ARE INVOLVED# 
  
          #CODE FOLLOWING DETERMINES IF USER USED A FIG-CON#
          #IF SO, KNOW IT IS LEGAL, BUT MUST SET SWITCH SO THAT ALL#
          #BIT GETS SET ON IN ANY ASSOCIATED LAT ENTRIES SO THAT# 
          #FIG-CON GETS EXPANDED FROM 1 CHAR. INTERNAL ASSIGNMENT#
          #TO 2 CHARS.# 
  
  
          IF GETQ(PL$FIGCON,PLT$,PLTPTR) EQ 1 
          THEN
              BEGIN 
              ALL4CODELIT = 1;
              CODELITPLT = CODECLPLTENT;
              #FIG-CON PLT PTR# 
              #FROM RP-AUX-TBL# 
              GOTO YESCODE61732;
              END 
  
          #FOLLOWING CODE EXECUTED IF "LITERAL-1" WAS A LITERAL AND#
          #NOT A FIG-CON# 
  
          IF  GETQ(PL$CODE,PLT$,PLTPTR)  EQ  PLTQUOTEDLIT 
          THEN
              BEGIN 
              IF GETQ(PL$LENGTH,PLT$,PLTPTR)  EQ 2
              THEN
                  GOTO LEGALITERAL; 
              IF GETQ(PL$LENGTH,PLT$,PLTPTR)  EQ  1 
                  AND 
                  ALL4CODELIT  EQ  1
              THEN
                  GOTO  LEGALITERAL;
              END 
          #ELSE VIOLATION OF JOD 6.17.3.1#
  
          CALLTDIAG(DNATPOINTER,004); 
          #DIAGNOSTIC -#
          #CODE CLAUSE LIT MUST BE A 2 CHAR NONNUMERIC LITERAL# 
          #SPACES SUBSTITUTED#
  
          #CONSTRUCT PLT ENTRY OF 2 SPACES #
  
          CODELITPLT = RPPLTOFFSET; 
          SET(PL$LENGTH,PLT$,RPPLTOFFSET,2);
          SET(PL$CODE,PLT$,RPPLTOFFSET,PLTQUOTEDLIT); 
          SET(PL$LINE,PLT$,RPPLTOFFSET,0);
          SET(PL$COLUMN,PLT$,RPPLTOFFSET,0);
          SETPLST(RPPLTOFFSET,LOC(TWOBLANKS));
          RPPLTOFFSET = RPPLTOFFSET + 1;
          ALL4CODELIT = 1;
          GOTO YESCODE61732;
          #NOTE  CODELITPLT IS USED BY IRT-RT WHEN ASSIGNING THE CODE#
          #CLAUSE LITERALS AS A VALUE TO  SPACING-AREA AND# 
          #CODE-CLAUSE-LITERALS#
  
LEGALITERAL:  
          CODELITPLT = CODECLPLTENT;
          #PLT POINTER FROM#
          #RP-AUX-TABLE#
          #GO TO YESCODE61732#
          #YES-CODE AND 6.17.3.2# 
YESCODE61732: 
          FOR FDRDINDEX = 1 STEP 1 UNTIL LASTFDRDNTRY DO
              BEGIN 
              IF GETQ(FR$REPTNAME,FDRDT$,FDRDINDEX) EQ DNATPOINTER
              THEN
                  BEGIN 
                  CURRENTFILE = GETQ(FR$FILENAME,FDRDT$,FDRDINDEX); 
                  GOTO CHKRDCHKBITS;
                  END 
              END 
CHKRDCHKBITS: 
          FOR FILEINDEX = 1 STEP 1 UNTIL LASTFDRDNTRY DO
              BEGIN 
              IF GETQ(FR$FILENAME,FDRDT$,FILEINDEX) EQ CURRENTFILE
                  AND 
                  GETQ(FR$CHECKBIT,FDRDT$,FILEINDEX) EQ 1 
                  AND 
                  GETQ(FR$REPTNAME,FDRDT$,FILEINDEX) NQ DNATPOINTER 
              THEN
                  GOTO NOT1STRDFILE;
              END 
          #IS FIRST (OR ONLY) RD PROCESSED FOR THIS FILE# 
          SET(FR$CODEBIT,FDRDT$,FDRDINDEX,1); 
          GOTO ENDCODECLRT; 
NOT1STRDFILE: 
          FOR CODEINDEX = FILEINDEX STEP 1 UNTIL LASTFDRDNTRY DO
              BEGIN 
              IF GETQ(FR$FILENAME,FDRDT$,CODEINDEX) EQ CURRENTFILE
                  AND 
                  GETQ(FR$CHECKBIT,FDRDT$,CODEINDEX) EQ 1 
                  AND 
                  GETQ(FR$REPTNAME,FDRDT$,CODEINDEX) NQ DNATPOINTER 
                  AND 
                  GETQ(FR$CODEBIT,FDRDT$,CODEINDEX) EQ 1
              THEN
                  GOTO ENDCODECLRT; 
              #ALL OK WRT 6.17.3.2# 
              END 
          #VIOLATION OF 6.17.3.2 -# 
          #CODE CLAUSE IN THIS RD BUT NO CODE CLAUSE IN FIRST RD# 
          #PROCESSED FOR THIS FILE# 
          #COMPILER ACTION FOR ERROR  WILL GO AHEAD + GENERATE REPORT#
          #WITH CODE LITERALS INCLUDED# 
  
          CALLTDIAG(DNATPOINTER,005); 
          #DIAGNOSTIC#
          #CODE CLAUSE MUST BE INCLUDED (OR OMITTED) FOR ALL REPORTS IN#
          #THE SAME FILE# 
  
          GOTO ENDCODECLRT; 
          #NO CODE AND 6.17.9.2#
NOCODE61732:  
  
          #NO CODE-CLAUSE FLAG IS USED BY IRT-RT THAT BUILDS RECORD#
          #AREA FOR RD# 
  
          NOCODECLAUSE = 1; 
          FOR FDRDINDEX = 1 STEP 1 UNTIL LASTFDRDNTRY DO
              BEGIN 
              IF GETQ(FR$REPTNAME,FDRDT$,FDRDINDEX) EQ DNATPOINTER
              THEN
                  BEGIN 
                  CURRENTFILE = GETQ(FR$FILENAME,FDRDT$,FDRDINDEX); 
                  GOTO CKRDCODEBITS;
                  END 
              END 
CKRDCODEBITS: 
          FOR FDRDINDEX = 1 STEP 1 UNTIL LASTFDRDNTRY DO
              BEGIN 
              IF GETQ(FR$FILENAME,FDRDT$,FDRDINDEX) EQ CURRENTFILE
                  AND 
                  GETQ(FR$CHECKBIT,FDRDT$,FDRDINDEX) EQ 1 
                  AND 
                  GETQ(FR$REPTNAME,FDRDT$,FDRDINDEX) NQ DNATPOINTER 
                  AND 
                  GETQ(FR$CODEBIT,FDRDT$,FDRDINDEX) EQ 1
              THEN
                  GOTO VIOLATE61732;
              END 
          GOTO ENDCODECLRT; 
          #ALL OK WRT  6.17.3.2#
  
          #VIOLATION OF 6.17.3.2 -# 
          #NO CODE CLAUSE IN THIS RD BUT WAS CODE CLAUSE IN FIRST RD# 
          #PROCESSED FOR THIS FILE# 
          #COMPILER ACTION FOR ERROR  WILL GO AHEAD AND GENERATE REPORT#
          #WITHOUT CODE CLAUSE LITERALS#
  
VIOLATE61732: 
          CALLTDIAG(DNATPOINTER,005); 
          #DIAGNOSTIC  (SAME)#
          #CODE CLAUSE MUST BE INCLUDED (OR OMITTED) FOR ALL REPORTS IN#
          #THE SAME FILE# 
  
          #GO TO ENDCODECLRT# 
ENDCODECLRT:  
  
  # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *#
  # * #   EXTRACE("CODECL ")                                       # * #
  # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *#
  
          END #CODECL#
          TERM
