Chapter 10: Control breaks processing


Chapter 10: Control breaks processing
 Types of reports:
Detail or Transaction report: One or more lines of output each line of input. Since they are detailed, detail reports take relatively longer time to produce.
Exception reports: Report where in instead of printing complete report we print only the records that don’t meet a specific criteria.
Summary reports: Also called as group report summarizes instead of itemize


Example:
A disk file contains the 3 input files: department number, sales person name and amount of sales.
The input file is in sequence by the department number.
The output should print not only the detail row but also the sum of sales each department.
Thus we need to print detail lines along with summary lines.
To be able to print the summary lines and then total per department the input file should be sorted by the department id.
Detail lines print in the usual way, after each input record is read and processed. Also, after each input record is read, the amount of sales in that record is added to a DEPT total. This department total will be printed whenever a change in DEPT occurs. Since a change in DEPT triggers the printing of a department total, we call DEPT the control field.
Thus, all salesperson records for DEPT 01 will be read and printed, and a DEPT total will be accumulated. This processing continues until a salesperson record is read that contains a DEPT different from the previous one. When a record with a different DEPT is read, then the total for the previous department will be printed.
Since totals are printed after a change occurs in DEPT, which is the control field, we call this type of group processing control break processing.
***************************** Top of Data ******************************
       IDENTIFICATION DIVISION.                                        
       PROGRAM-ID. CNTLBRK1.                                           
       AUTHOR. SUKUL                                                   
       ENVIRONMENT DIVISION.                                           
       CONFIGURATION SECTION.                                           
       SOURCE-COMPUTER. IBM-370.                                       
       OBJECT-COMPUTER. IBM-370.                                       
       INPUT-OUTPUT SECTION.                                           
       FILE-CONTROL.                                                   
             SELECT INPUT-FILE ASSIGN TO INPUT01                       
             ORGANIZATION IS SEQUENTIAL                                
             FILE STATUS IS WS-INPUT-FILE-STATUS.                      
             SELECT OUTPUT-FILE ASSIGN TO OUTPUT01                     
             ORGANIZATION IS SEQUENTIAL                                
             FILE STATUS IS WS-OUTPUT-FILE-STATUS.                     
       DATA DIVISION.                                                  
       FILE SECTION.                                                   
      *DATA DIVISION HAS ALL THE PLACES FROM                           
      *WHERE PROGRAM CAN GET INPUT.                                     
      *FIRST PLACE IS FROM FILE, HENCE FILE                            
      *SECTION                                                          
       FD INPUT-FILE                                                   
            RECORDING MODE IS F                                        
            LABEL RECORDS ARE STANDARD                                 
            BLOCK CONTAINS 0 RECORDS                                   
            RECORD CONTAINS 80 CHARACTERS.                             
       01 INPUT-FILE-REC.                                              
            05 IN-DEPT-NO PIC XX.                                      
            05 IN-NAME PIC X(30).                                      
            05 IN-SALES PIC 9(4)V99.                                   
       FD OUTPUT-FILE                                                  
            RECORDING MODE IS F                                        
            LABEL RECORDS ARE STANDARD                                  
            BLOCK CONTAINS 0 RECORDS                                   
            RECORD CONTAINS 80 CHARACTERS.                             
       01 OUTPUT-FILE-REC.                                             
      *NOTE THAT GROUP LEVEL ELEMENT ALSO SHOULD HAVE A PERIOD         
            05 OUT-REC-01 PIC X(80).                                   
       WORKING-STORAGE SECTION.                                        
       01 WS-DEPT-HOLD-AREA PIC XX VALUE HIGH-VALUES.                  
       01 WS-LINE-CNTR PIC 9999 VALUE ZEROS.                           
       01 WS-PAGE-CNTR PIC 9999 VALUE ZEROS.                           
       01 WS-DEPT-SALES-TOT PIC 9(5)V99 VALUE ZEROS.                   
      * WHEN CREATING REPORTS ITS ADVISABLE TO CREATE SUCH             
      * WORKING STORAGE FIELDS, WHICH CAN BE REUSED MULTIPLE TIMES     
      * INSTEAD OF TYING SAME TEXT AGAIN AND AGAIN.                    
       01 WS-HEADING1.                                                 
           05 FILLER PIC X(30) VALUE SPACES.                           
           05 FILLER PIC X(22) VALUE 'MONTHLY STATUS REPORT.'.         
      *IF THE VALUE PRVIDED BY THE VALUE CLAUSE IS GREATER THAN PIC    
      * DEFINITION THEN COMPILER ISSUES A ERROR.                       
           05 FILLER PIC X(09) VALUE SPACES.                           
           05 FILLER PIC X(5) VALUE 'PAGE '.                           
      * EACH FIELD DEFINITION SHOULD END WITH PERIOD.                   
           05 H1-PAGE-NO PIC 9999 VALUE 0001.                          
           05 FILLER PIC X(10) VALUE SPACES.                           
       01 WS-TOTAL-LINE1.                                               
           05 FILLER PIC X(30) VALUE SPACES.                           
           05 FILLER PIC X(19) VALUE 'TOTAL FOR DEPT NO :'.            
           05 DEPT-NO PIC X(2).                                        
           05 FILLER PIC X(4) VALUE ' IS '.                            
           05 ACCUMULATED-TOT PIC 9(5).99.                             
           05 FILLER PIC X(18) VALUE SPACES.                           
       01 WS-FILE-STATUS.                                               
           05 WS-INPUT-FILE-STATUS PIC XX.                             
           05 WS-OUTPUT-FILE-STATUS PIC XX.                            
       01 WS-EOF-FLAGS.                                                
           05 WS-INPUT-FILE-EOF PIC X.                                 
           05 WS-OUTPUT-FILE-EOF PIC X.                                
       PROCEDURE DIVISION.                                             
        100-MAIN-MODULE.                                               
           PERFORM 200-INITIALIZATION                                  
           PERFORM 300-READ-INPUT                                      
           MOVE WS-HEADING1 TO OUTPUT-FILE-REC                         
            COMPUTE WS-PAGE-CNTR = WS-PAGE-CNTR + 1                    
            MOVE  WS-PAGE-CNTR TO H1-PAGE-NO                           
           COMPUTE WS-LINE-CNTR = WS-LINE-CNTR + 1                     
           WRITE OUTPUT-FILE-REC                                       
           PERFORM UNTIL WS-INPUT-FILE-EOF = 'Y'                       
                                                                       
             IF WS-DEPT-HOLD-AREA NOT = IN-DEPT-NO                     
             AND WS-DEPT-HOLD-AREA NOT = HIGH-VALUES                   
      ** DEPT-NO IS THE FIELD THAT DETERMINES WHEN THE BREAK HAS TO    
      * HAPPEN AND HENCE CALLED AS CONTROL FIELD.                      
      *************************************************
      *CONTROL BREAK WILL HAPPEN IF THE CURRENT DEPT-NO IS NOT SAME AS
     * AS THE HELD DEPT NO. THIS WILL WORK FINE EVERY TIME EXCEPT THE FIRST TIME    BECAUSE THE VALUE IN HOLD VARIABLE WILL NOT BE EQUAL TO THE DEPT-NO.
WE WOULD NOT WANT CONTROL BREAK TO OCCUR AT THE 1ST RECORD ITSELF.
HENCE WE HAVE ADDED A CONDITION OF  WS-DEPT-HOLD-AREA NOT = HIGH-VALUES.
FOR 1ST RECORD THIS VALUE WOULD BE HIGH-VALUES AND HENCE CONTROL BREAK
PARA WILL NOT BE EXECUTED ON THE 1ST RECORD.
ANOTHER WAY TO RESOLVE THIS ISSUE IS THAT WE SET A FLAG SAY ‘FIRST-RECORD’ TO
INITIAL VALUE OF ‘YES’. WHEN THIS FLAG IS SET THE COMPARISION BETWEEN THE CURRENT DEPT NO AND THE HOLD AREA WILL NOT BE PERFORMED.
AFTER THE 1ST RECORD IS READ THE FLAG BE SET TO ‘NO’ FOR THE REST PART OF THE
PROGRAM AND THUS FOR ALL OTHER RECORDS TO COMPARISON WOULD BE DONE.
THUS THE INITIAL VALUE OF ‘YES’ WOULD INDICATE THAT FIRST RECORD NEEDS SPECIAL
PROCESSING AND WE WOULD NOT PERFORM COMPARISON FOR THE 1ST RECORD.
             THEN                                                      
             PERFORM 500-CONTROL-BRK                                   
             ELSE                                                      
             COMPUTE WS-LINE-CNTR = WS-LINE-CNTR + 1                   
             END-IF                                                    
             MOVE IN-DEPT-NO TO WS-DEPT-HOLD-AREA                      
*WHEN THE 1ST RECORD IS READ THE  HOLD AREA WOULD HAVE HIGH VALUES.
*AFTER THE 1ST RECORD iS PRINTED, WE SHOULD MOVE THE CURRENT DEPT NO
* TO HOLD AREA SO THAT IT CAN BE COMPARED WITH THE DEPT NO FROM NEXT
* RECORD.
             COMPUTE WS-DEPT-SALES-TOT =                               
                WS-DEPT-SALES-TOT + IN-SALES                       
*WE KEEP ACCUMULATING SALES QTY SO THAT IT CAN BE PRINTED WHEN THE
* BREAK OCCURS. THE PRINTING WOULD BE DONE IN 500-CONTROL-BRK PARA.
* ALSO WE WOULD BE REINITIALIZE THE VALUE OF ACCUMULATED TOTAL TO 0 AFTER
* IT PRINTED.   
             MOVE INPUT-FILE-REC TO OUTPUT-FILE-REC                    
             WRITE OUTPUT-FILE-REC                                     
*NOTE THAT REGARDLESSS OF WHETHER CONTROL BRK OCCURS OR NOT WE
* WOULD PRINT THE CURRENT RECORD.
             PERFORM 300-READ-INPUT                                     
      *READ NEXT RECORD                                                 
              END-PERFORM                                              
*WHEN WE REACH THE END OF THE FILE THERE WONT BE NEXT RECORD TO TRIGGER
* A CONTROL BREAK AND THUS THE TOTAL FROM THE LAST GROUP OF RECORDS WILL
*BE ACCUMULATED BUT WILL NOT BE PRINTED.
*HENCE AFTER THE LOOP IS OVER WE USE THE BELOW 3 LINES TO FORCE THE PRINTING *OF THE LAST ACCUMULATED TOTAL.                  
             IF WS-INPUT-FILE-EOF = 'Y'                                
               PERFORM 500-CONTROL-BRK                                 
             END-IF                                                    
              STOP RUN.                                                
         500-CONTROL-BRK.                                              
            MOVE WS-DEPT-HOLD-AREA TO DEPT-NO.                         
            MOVE WS-DEPT-SALES-TOT TO ACCUMULATED-TOT.                 
      *ACCUMULATED-TOT is a NUMERIC EDITED FIELD. NUMERIC EDITED FIELDS
      * ARE GOOD FOR DISPLAY PURPOSE. BUT NOTE THAT EDITED FIELDS CAN ONLY
      * BE RECEIVING FIELDS. NOT SENDING FIELDS. WE CAN MOVE FROM A NUMERIC
      * FIELD TO A NUMERIC EDITED ONE.
      * IF WE WANT A NUMERIC EDITED FIELD TO BE A SENDING ONE THEN WE CAN USE THE
      * FUNCTION -NUMVAL
            MOVE WS-TOTAL-LINE1 TO OUTPUT-FILE-REC.                    
            WRITE OUTPUT-FILE-REC AFTER ADVANCING 2 LINES              
      * ADVANCING 2 FILES ALLOWS US TO SKIP TWO LINES AND THEN PRINT   
      * AFTER THE CONTROL BREAK OCCURS WE GO TO A NEW PAGE AND
     * DISPLAY THE HEADING AND THE PAGE NUMBER.
            COMPUTE WS-PAGE-CNTR = WS-PAGE-CNTR + 1                    
            MOVE  WS-PAGE-CNTR TO H1-PAGE-NO                           
            MOVE WS-HEADING1 TO OUTPUT-FILE-REC                        
            WRITE OUTPUT-FILE-REC                                      
            INITIALIZE WS-DEPT-SALES-TOT                               
       *BEFORE WE START WORKING WITH NEW DEPT NO WE RESET THE TOTAL
             COMPUTE WS-LINE-CNTR = WS-LINE-CNTR + 2.                  
         300-READ-INPUT.                                               
            READ INPUT-FILE                                            
            AT END                                                     
            MOVE 'Y' TO WS-INPUT-FILE-EOF.                             
         200-INITIALIZATION.                                           
             OPEN INPUT INPUT-FILE                                     
             OPEN OUTPUT OUTPUT-FILE.                                  
**************************** Bottom of Data ****************************

JCL:
***************************** Top of Data ***********************
//TESTJCL4 JOB (EWDS),'TEST JCL',NOTIFY=&SYSUID                 
//DWJ030C0 EXEC PGM=CNTLBRK1                                     
//STEPLIB DD DSN=CMN.EDWS.STGO.#001621.LOD,DISP=SHR             
//INPUT01 DD DSN=SM017R.CNTLBRK.INPUT,DISP=(SHR)                
//OUTPUT01 DD DSN=SM017R.CNTLBRK.OUTPU3,DISP=(NEW,CATLG,DELETE),
//            DCB=(LRECL=80,RECFM=FB,BLKSIZE=0)                  
//SYSOUT DD SYSOUT=*                                            
**************************** Bottom of Data *********************

Input:
***************************** Top of Data *************
01SUKUL MAHADIK                 124422                
01SUNTUL MAHADIK                276000                
01KUSUM MAHADIK                 123509                
02DUSHYANT JADHAV               232321                
02BHAVIN MALAVYIA               092902                
03RAHUL KUMAR                   122344                
03MAHENDRA GAREWAL              909090                
**************************** Bottom of Data ***********

Output:
***************************** Top of Data ******************************
                               MONTHLY STATUS REPORT.         PAGE 0001 
  1SUKUL MAHADIK                 124422                                 
  1SUNTUL MAHADIK                276000                                 
  1KUSUM MAHADIK                 123509                                 
 0                             TOTAL FOR DEPT NO :01 IS 05239.31        
                               MONTHLY STATUS REPORT.         PAGE 0002 
  2DUSHYANT JADHAV               232321                                  
  2BHAVIN MALAVYIA               092902                                 
 0                             TOTAL FOR DEPT NO :02 IS 03252.23        
                               MONTHLY STATUS REPORT.         PAGE 0003 
  3RAHUL KUMAR                   122344                                 
  3MAHENDRA GAREWAL              909090                                 
 0                             TOTAL FOR DEPT NO :03 IS 10314.34        
                               MONTHLY STATUS REPORT.         PAGE 0004 
 **************************** Bottom of Data ****************************

Printing Total Sales for all the departments:
It may be required that we print a final line that would contain the total for all departments.
There are two ways to accomplish this.
1)     Adding to final total at each transaction.
Create a variable WS-FINAL-TOTAL and add the sales value to it when we add to the WS-DEPT-SALES-TOT
COMPUTE WS-DEPT-SALES-TOT = WS-DEPT-SALES-TOT + IN-SALES                       
COMPUTE WS-FINAL-TOTAL = WS-FINAL-TOT + IN-SALES                       
Only difference would be that we would be resetting the value for WS-DEPT-SALES-TOT at each break, but the value of Ws-FINAL-TOTAL will keep on accumulating.

2)     Adding to final total only at the control break.
With this the final amount will be accumulated ,not for each detail record, but only when the control brk occurs.
This method is efficient that first because in a case where we have 10000 records but only 20 departments we would perform the addition 10000 times using the 1st approach and only 20 times using the 2nd approach.
Thus the number of time the addition is performed decreases.

01 WS-FINAL-TOT-AMT PIC 99999V99 VALUE ZEROS.      

01 WS-FINAL-TOTAL-LINE1.                                   
     05 FILLER PIC X(30) VALUE SPACES.                       
     05 FILLER PIC X(21) VALUE 'FINAL TOTAL AMOUNT:'.       
     05 FILLER PIC X(4) VALUE ' IS '.                       
     05 ACCUMULATED-TOT-FIN PIC 9(5).99.                    
     05 FILLER PIC X(18) VALUE SPACES.                      

* AFTER THE END OF THE FILE                                 
       IF WS-INPUT-FILE-EOF = 'Y'                           
         PERFORM 500-CONTROL-BRK                            
       END-IF                                               
* PRINT FINAL TOTAL                                         
       MOVE WS-FINAL-TOT-AMT  TO ACCUMULATED-TOT-FIN        
       WRITE OUTPUT-FILE-REC FROM WS-FINAL-TOTAL-LINE1      
        STOP RUN.                                           

       COMPUTE WS-FINAL-TOT-AMT = WS-DEPT-SALES-TOT +     
       WS-FINAL-TOT-AMT                                   

(Note that we are adding the sum of dept sales to the final total)

Output from the program:
***************************** Top of Data ******************************
                              MONTHLY STATUS REPORT.         PAGE 0001 
 1SUKUL MAHADIK                 124422                                 
 1SUNTUL MAHADIK                276000                                 
 1KUSUM MAHADIK                 123509                                  
0                             TOTAL FOR DEPT NO :01 IS 05239.31        
                              MONTHLY STATUS REPORT.         PAGE 0002 
 2DUSHYANT JADHAV               232321                                 
 2BHAVIN MALAVYIA               092902                                 
0                             TOTAL FOR DEPT NO :02 IS 03252.23        
                              MONTHLY STATUS REPORT.         PAGE 0003 
 3RAHUL KUMAR                   122344                                  
 3MAHENDRA GAREWAL              909090                                 
0                             TOTAL FOR DEPT NO :03 IS 10314.34        
                              MONTHLY STATUS REPORT.         PAGE 0004 
                              FINAL TOTAL AMOUNT:   IS 18805.88        
**************************** Bottom of Data ****************************



Multiple control level breaks: (Imp)

Earlier we saw an example of single level break.
The input file had only one record for each sales person.
However in real life a sales person would perform multiple sales in a day and hence could have multiple records in a  file.

With this file as input we need to print the sum of sales per sales person and also sum of sales per Dept and final total also.

To work with such a file we would require that the file be sorted 1st on dept number and then on the sales person .
DEPT_NO would be major sort sequence and SALES-ID would be minor sort sequence. Thus DEPT_NO be called the major control field and SALESID as the minor control fields.

We call these as control fields as we would want a break to occur when either of these two values change from its previous record so that special processing for printing the total and resetting totals could take place.

Since we have two control fields we would require two IF Statements as follows:

             IF WS-DEPT-HOLD-AREA NOT = IN-DEPT-NO                     
             AND WS-DEPT-HOLD-AREA NOT = HIGH-VALUES
                PERFORM 400-DEPT-BREAK
            ELSE
            IF WS-SALESID-HOLD-AREA NOT = IN-SALES-ID                     
                   AND WS-SALESID-HOLD-AREA NOT = HIGH-VALUES
                    PERFORM 300-SLS-BREAK
                END-IF        
             END-IF
                                     
When using the multi control breaks, its important that the a major control break routine should begin by forcing a minor control break.
That is, the first thing we do when there is a change in DEPT-IN is to process the last salesperson's total for the previous department.
The assumption here is that each salesperson is employed by only one department. Thus, the first instruction at 400-DEPT-BREAK would be to PERFORM 300-SLS-BREAK.
Since a sales person would be employed only to a single department would also mean that there are no more records for that sales person.

Example of Dept control brk para:

400-DEPT-BREAK. --> When there is a change in DEPT-IN, this is considered a major control break.
    PERFORM 300-SLS-BREAK  --> This means that the major-level control routine must begin by forcing a minor-level control-break.
    MOVE WS-DEPT-TOTAL TO DL-DEPT-TOTAL
    WRITE REPORT-REC-OUT FROM DL-DEPT-LINE AFTER
          ADVANCING 2 LINES
    IF  MORE-RECORDS
        MOVE ZEROS TO WS-DEPT-TOTAL
        MOVE DEPT-IN TO WS-HOLD-DEPT
        PERFORM 500-HEADING-RTN
    END-IF.
           
Note that as shown in the above IF ELSE logic the test for change in Salesid is performed if the check for change in deptno fails. This is necessary when the salesid changes without even change in the deptno. This would force the minor control break.
Thus note that there are two ways for the minor control break para to execute:
1) When the deptno changes we force a minor control break also
2) Also from the IF logic, which checks for change in sales id even if the Dept no has not changed.
Just as with single-level control break processing, we must force a break at this point so that we print the last SLSNO-IN total and the last DEPT-IN total. To accomplish this, we perform 400-DEPT-BREAK from the main module after all records have been processed.(the Dept control break para also forces the salesid break para and hence its not necessary to call the salesid break para separately to print the accumulated total for last sales person.

True or False:

If multiple control breaks are used in a program, the routine for producing the major-level control break would always begin by performing _______.
Answer: Minor level control break.. this applies irrespective of how deep the nesting is.

(T or F) When a double-level control break is used, input data must be in sequence by major fields within minor fields.
Answer: False. Should be sorted by monir fields within major fields.

(T or F) Records must be in sequence by the control field in order for control break processing to be performed correctly.
Answer: very true

(T or F) Detail reports include an itemization for each input record read.
Answr: true

(T or F) An exception report lists only those records that meet (or fail to meet) certain criteria.
Answer: True

(T or F) A group report summarizes rather than itemizes.
Answer: True

(T or F) It is often useful to have each department's data begin on a new page.
Answer: True

(T or F) To accumulate the final total, it is more efficient to add the group totals than to add the amounts from each input record.                             
Answer: Yes. It saves the number of time arithmetic operation is performed.

Key learning:
When we want report to having sum of sales by two different fields(say deptno and salesid), we need the file to be sorted in the sequence of major control field and then the monir control fields( .ie sorted 1st by dept no and then by sales no)
1st we check if the dept has changed (by comparing dept no to previous record dept no).
Ø  If it has changed then we perform the control brk processing wherein we write the Dept total, reinitialize accumulated sums for dept. However note that change in dept no also indicates that the last record for the current salesid is also read(because a salesid can belong to only one department) and hence before we do any control break processing for dept no, we need to call para for salesid control break so as to print totals for a particular salesid and also reinitialize accumulated totals for the given salesid.

Ø  If the dept no has not changes still we perform a check to see if the salesid has changed. Each dept could have multiple sales person. If the sales id has changed without change in deptno then we just perform the salesid control break and print totals for current salesid.

Ø  Also in case of both ‘single level break’ and ‘multiple level break’ when the end of input file is reached the final accumulated totals don’t get written to the output and hence we should be explicitly calling the control break paras to that the accumulated total gets printed. We can just call the para for major control break field.
It will have a call for the minor control break para.

4 comments:

  1. Here is the simplest way to control break in COBOL.
    http://www.totemconsulting.ca/control_break.html

    ReplyDelete
  2. Nice and good article. It is very useful for me to learn and understand easily. Thanks for sharing your valuable information and time. Please keep updatingmulesoft online training Hyderabad

    ReplyDelete
  3. How to change page after every 5 5 records with trailer and header on every page ?

    ReplyDelete