*DECK SORCECL 
USETEXT DNTEXT
USETEXT RPTEXT
PROC SORCECL; 
          BEGIN 
  
          #SOURCE CLAUSE  ROUTINE#
          #*# 
          #THIS ROUTINE#
          #- DOES ANALYSIS ON ONE REPORT GROUP WITH RESPECT TO# 
          #SYNTAX RULES IN SECTION 6.39.3 ON THE SOURCE CLAUSE# 
          #THESE STATE THAT IF IDENTIFIER-1 IS A REPORT SECTION#
          #ITEM IT CAN ONLY BE  PAGE-COUNTER, LINE-COUNTER, OR A# 
          #SUM COUNTER OF THE REPORT WITHIN WHICH THE SOURCE# 
          #CLAUSE APPEARS.ALSO IDENTIFIER-1 MUST BE DEFINED # 
          #SUCH THAT IT CONFORMS# 
          #TO THE RULES FOR SENDING ITEMS IN THE MOVE STATEMENT.# 
  
          XREF   FUNC         MOVECHK;
  
          ITEM   RGDNATPTR, 
                 AUXINDEX , 
                 SAUXINDEX, 
                 SRCEINDEX, 
                 UBDNATPTR, 
                 SENDINGFIELD;
  
          DEF    SUMCTR       #1#;
  
  
          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 DNATVALS
*CALL GETSET
*CALL TABLNAMES 
          CONTROL EJECT;
  
  # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *#
  # * #   EPTRACE("SORCECL")                                       # * #
  # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *#
  
  
  
  
  
          #ROUTINE PROCEDURES#
  
          SENDINGFIELD = 0; 
          #THIS IS AN INDICATOR THAT WILL BE# 
          #USED BELOW IN RULE2TEST  IT WILL BE SET = 1, IF THE# 
          #SOURCE CLAUSE IDENTIFIER IS A LEGAL SUM COUNTER.#
          IF FIRSTF3OR4DE EQ 0 THEN 
              GOTO ENDSRCL; 
          FOR RGDNATPTR = FIRSTF3OR4DE  STEP 1 UNTIL
              LASTRGDNAT DO 
              BEGIN 
              AUXINDEX = RP$AUXPTR(RGDNATPTR);
              $TEMP$ = GETQ(DN$LEVEL,DNAT$,DNATPOINTER);
              IF $TEMP$ GR 1
                  AND 
                  RWGET(RAFORMAT4BIT,AUXINDEX) EQ 1 
                  #IE.- A FORMAT-4 ENTRY# 
                  AND 
                  RWGET(RASOURCEBIT,AUXINDEX) EQ 1
              THEN
                  BEGIN 
                  SAUXINDEX = 1 + AUXINDEX; 
                  IF RWGET(RASRCEIDNAT,SAUXINDEX)  LS 
                      RS1STDNAT 
                  THEN
                      #NOT A REPORT-SECTION ITEM# 
                      GOTO  RULE2TEST;
  
                  #ELSE  -  IF IS A REPORT SECTION ITEM#
  
                  SRCEINDEX =  RWGET(RASRCEIDNAT,SAUXINDEX);
                  IF  GETQ(DN$LEVEL,DNAT$,SRCEINDEX - 1)  EQ  RDDESCR 
                  THEN
                      GOTO  RULE2TEST;
                  #IT IS PAGE-COUNTER#
  
                  IF GETQ(DN$LEVEL,DNAT$,SRCEINDEX - 2) EQ RDDESCR
                  THEN
                      GOTO RULE2TEST; 
                  #IT IS  LINE-COUNTER# 
  
                  #ELSE - DETERMINE IF IT IS A SUM-COUNTER# 
                  #WITHIN THE CURRENT REPORT# 
  
                  $TEMP$ = GETQ(DN$LEVEL,DNAT$,SRCEINDEX);
                  IF $TEMP$ GR 1
                      AND 
                      RWGET(RAFORMAT4BIT,RP$AUXPTR(SRCEINDEX))EQ 1
                      #IE.- A FORMAT-4 ENTRY# 
                      AND 
                      RWGET(RASUMBIT,RP$AUXPTR(SRCEINDEX)) EQ 1 
                  THEN
                      GOTO ISITCURRD; 
  
                  #ELSE  -   ERROR# 
S6392AERR:  
  
                  #DIAGNOSTIC#
                  #IF SOURCE CLAUSE IDENTIFIER IS A REPORT SECTION #
                  #ITEM IT CAN ONLY # 
                  # BE PAGE-COUNTER,  LINE-COUNTER,. OR A SUM COUNTER#
                  #OF REPORT WITHIN WHICH SOURCE CLAUSE APPEARS#
  
                  ANALONLYRGRP = 1; 
                  CALLDDIAG(RGDNATPTR,94);
                  GOTO  SR1STDOEND; 
ISITCURRD:  
                  IF  SRCEINDEX LS  CURRDDNAT 
                  THEN
                      GOTO S6392AERR; 
                  #SUM CLAUSE IS NOT# 
                  #WITHIN CURRENT REPORT# 
  
                  #ELSE IF OK SO FAR -  SEARCH FOR UPPER BOUND OF#
                  #CURRENT RD  AND TEST AGAINST  THAT#
  
                  FOR UBDNATPTR = (CURRDDNAT + 4)  STEP 1 UNTIL 
                      LSTRSDNATIND DO 
                      BEGIN 
                      IF GETQ(DN$LEVEL,DNAT$,UBDNATPTR) EQ RDDESCR
                      THEN
                          GOTO FOUNDUB; 
                      END 
                  IF SRCEINDEX EQ LSTRSDNATIND
                  THEN
                      BEGIN 
                      SENDINGFIELD = SUMCTR;
                      GOTO RULE2TEST; 
                      #IS WITHIN BOUNDS OF# 
                      #CURRENT REPORT#
                      END 
                  ELSE
                      GOTO S6392AERR; 
FOUNDUB:  
                  IF SRCEINDEX  LS UBDNATPTR
                  THEN
                      BEGIN 
                      SENDINGFIELD = SUMCTR;
                      GOTO  RULE2TEST;
                      #IS WITHIN CURRENT# 
                      #REPORT#
                      END 
                  ELSE
                      GOTO S6392AERR; 
RULE2TEST:  
  
                  #SOURCE CLAUSE IDENTIFIER-1 MUST BE DEFINED SUCH# 
                  #THAT IT CONFORMS TO THE RULES FOR SENDING ITEMS# 
                  #IN THE MOVE STATEMENT.#
                  SRCEINDEX = RWGET(RASRCEIDNAT,SAUXINDEX); 
                  IF SENDINGFIELD EQ SUMCTR 
                  THEN
                      BEGIN 
                      #(IF IDENTIFIER-1 IS A SUM COUNTER, ITS DNAT# 
                      #IS NOT SET UP AS A SENDING FIELD ITEM YET)#
                      IF MOVECHK(3,0,RGDNATPTR)       NQ  1 
                      THEN
SILLEGALMOVE: 
                          BEGIN 
                          ANALONLYRGRP = 1; 
                          #DONT WANT TO ISSUE DIAG IF DNAT-TYPE#
                          #OF SENDING OR RECEIVING FIELD = ERROR-TYPE -#
                          #DIAGNOSTIC(S) HAVE ALREADY IDENTIFIED A# 
                          #PROBLEM AREA.# 
                          IF GETQ(DN$TYPE,DNAT$,RGDNATPTR) EQ ERRTYPE 
                          THEN
                              GOTO SR1STDOEND;
                          IF SENDINGFIELD EQ SUMCTR 
                          THEN
                              GOTO ISSUEMD; 
                          IF GETQ(DN$TYPE,DNAT$,SRCEINDEX) EQ ERRTYPE 
                          THEN
                              GOTO SR1STDOEND;
ISSUEMD:  
                          CALLDDIAG(RGDNATPTR,95);
                          GOTO  SR1STDOEND; 
                          END 
  
                      #DIAGNOSTIC  (95)#
                      #SOURCE CLAUSE IDENTIFIER-1 MUST BE DEFINED SUCH #
                      #THAT IT   #
                      #CONFORMS TO THE RULES FOR SENDING ITEMS IN THE#
                      #MOVE STATEMENT.# 
                      END 
                  ELSE
                      IF MOVECHK(1,SRCEINDEX,RGDNATPTR) NQ 1
                      THEN
                          GOTO SILLEGALMOVE;
                  END 
              #END OF CODE FOR "IF SOURCE CLAUSE IN#
              #THIS ITEM"#
SR1STDOEND: 
              END 
ENDSRCL:  
  
  # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *#
  # * #   EXTRACE("SORCECL")                                       # * #
  # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *#
  
          END #SORCECL# 
          TERM
