Search code examples
cobolgnucobolnetcobol

Could you reference a column in DECLARATIVES section when the column is used with SUM clause in COBOL REPORT WRITER Module?


Aside from the specific platform and the compiler, suppose you have this defined in a COBOL program using Report Writer Module:

01 CF-MM TYPE CONTROL FOOTING WS-MM.
             02 LINE PLUS 1.
                03 COLUMN 1             VALUE "* CF MONTH: ".
                03 COLUMN PLUS 1        PIC 99 SOURCE WS-MM.
                03 S-MM COLUMN PLUS 5   PIC S9(4)V99 SUM WS-TUTION-PAY. 
                03 VAL-NN COLUMN PLUS 5 PIC S9(4)V99 SOURCE S-MM.
      <...>
       PROCEDURE DIVISION.
       DECLARATIVES.  
           
        SEC2 SECTION.
            USE BEFORE REPORTING 
            CF-MM.
            DISPLAY "SUM MM LEVEL:" S-MM   
           .

Furthermore, suppose that the program reported 3 lines where SUM WS-TUTION-PAY resulted in 126.

What would be the value resulting from the statement in SEC2 SECTION that displays S-MM value? I guess it should be 126 but I am getting ZERO displayed. This maybe because the value 126 was not yet moved to S-MM, but I am not sure.

What is the value that "should" be displayed in the declaratives section for S-MM


Solution

  • Q: Could you reference a column in DECLARATIVES section when the column is used with SUM clause in COBOL REPORT WRITER Module?

    03 S-MM COLUMN PLUS 5   PIC S9(4)V99 SUM WS-TUTION-PAY. 
    

    S-MM is a data-name format of the entry-name clause. Quoting from the 2002 COBOL standard, Report group description entry, 13.13.2 Syntax rules:

    7) The data-name format of the entry-name clause shall be specified when the data-name is referenced in a GENERATE statement, a USE BEFORE REPORTING statement, as a qualifier for a SUM counter, in the UPON phrase of the SUM clause, or as an operand in a SUM clause. The data-name shall not be referenced in any other way.

    Given that S-MM qualifies, it may be referenced "as a qualifier for a SUM counter".

    [The COBOL 74 and 85 standards stated, "Data-name-1 is optional but may be specified in any entry. Data-name-1, however, may be referenced only if the entry defines a sum counter."]

    The compiler I used for the following code is Micro Focus COBOL 85.


    Code:

       program-id. rw-test.
       environment division.
       input-output section.
           select report-file assign "rpt.txt"
               organization line sequential.
       data division.
       fd report-file
           report is report-1.
       working-storage section.
       01 n comp pic 99 value 0.
       01 test-table.
         02 test-data.
           03 pic 9999 value 1001.
           03 pic 9999 value 1002.
           03 pic 9999 value 1003.
           03 pic 9999 value 2004.
           03 pic 9999 value 2005.
           03 pic 9999 value 2006.
         02 test-entry redefines test-data pic 9999 occurs 6.
       01 report-entry.
           03 test-group pic 9.
           03 test-value pic 999.
       report section.
       rd report-1
        control is test-group.
       01 rw-detail type de.
         02 line plus 1.
           03 grp column 1 pic 9 source test-group.
           03 val column 4 pic zz9 source test-value.
       01 rw-foot type cf test-group.
         02 line plus 1.
           03 column 1 pic x(6) value "-  ---".
         02 line plus 1.
           03 column 1 pic 9 source test-group.
           03 s-mm column 4 pic zz9        *> s.mm defined
               sum test-value
               reset test-group.
         02 line plus 1 pic x value space.
       procedure division.
       declaratives.
       decl-rpt section.
           use before reporting rw-foot.
               display s-mm.               *> s.mm referenced
       end declaratives.
       main-line section.
           open output report-file.
           initiate report-1
           perform varying n from 1 by 1
           until n > 6
               move test-entry (n) to report-entry
               generate rw-detail
           end-perform
           terminate report-1
           close report-file
           stop run.
       end program rw-test.
    

    Report:

    1    1
    1    2
    1    3
    -  ---
    1    6
    
    2    4
    2    5
    2    6
    -  ---
    2   15
    

    Display:

    006
    015