INSPECT TALLYING Statement


INSPECT TALLYING counts the occurrences of the specific characters in the input string. It's an efficient way to decide how many times a particular character appears within a string.

Syntax -

* Tallying all characters
INSPECT   ws-input-string
TALLYING  ws-tally-count 
          FOR CHARACTERS

* Tallying all characters with BEFORE|AFTER|INITIAL
INSPECT   ws-input-string
TALLYING  ws-tally-count 
          FOR CHARACTERS
          [[BEFORE|AFTER] [INITIAL] 
		  ws-tally-delimeter1|delimeter-literal1]

* Tallying specific occurrences of characters
INSPECT   ws-input-string
TALLYING  ws-tally-count  
          FOR [ALL|LEADING] {ws-tally-chars|tally-literal}

* Tallying specific occurrences of characters
* with BEFORE|AFTER|INITIAL
INSPECT   ws-input-string
TALLYING  ws-tally-count 
          FOR [ALL|LEADING] {ws-tally-chars|tally-literal}
          [[BEFORE|AFTER] [INITIAL] 
		  ws-tally-delimeter1|delimeter-literal1]
Note! All statements coded in [ ] are optional.

Parameters -

  • ws-input-string - The data item that will be inspected for replacements. It should be an alphanumeric variable declared with usage DISPLAY.
  • ws-tally-count - A numeric variable where the count is stored.
  • ws-tally-char|tally-literal - The character(s) we're searching for in ws-input-string to count.
  • FOR CHARACTERS -
    • Each character is counted when CHARACTERS BY alone coded (without BEFORE or AFTER phrases).
    • If the BEFORE or AFTER is coded, the counting happens depending on BEFORE or AFTER ws-delimeter.
  • ALL -
    • Each occurrence of ws-tally-char is counted when ALL alone coded (without BEFORE or AFTER phrases).
    • If the BEFORE or AFTER is coded along with ALL, the counting happens depending on BEFORE or AFTER ws-delimeter.
  • LEADING -
    • The leftmost occurrence of ws-tally-chars is counted when LEADING alone coded (without BEFORE or AFTER phrases).
    • If the BEFORE or AFTER is coded along with LEADING, the counting happens depending on BEFORE or AFTER ws-delimeter.
  • ws-tally-delimeter1|delimeter-literal1 - Specifies the delimeter alphanumeric variable or literal.
  • INITIAL - Specifies the first occurrence of a delimeter.
  • BEFORE ws-tally-delimeter1|delimeter-literal1 - Specifies tallying begins at the leftmost character position and continues till the first occurrence of the delimiter. If no delimiter is found, tallying continues to count until the last character of the string.
  • AFTER ws-tally-delimeter1|delimeter-literal1 - Specifies tallying begins at the first character to the right of delimiter and continues until the last character of the string. If no delimiter is found, no counting takes place.

Examples -


Scenario1 - Counting for ALL character "A".

Input-      WS-DATA = "MAINFRAMES"

Declaration-  05 WS-DATA       PIC X(10) VALUE "MAINFRAMES".
              05 WS-CNT        PIC 9(02).
			  
Code-       INSPECT WS-DATA 
                    TALLYING WS-CNT FOR ALL "A". 

Result-     WS-CNT = 2

Scenario2 - Counting for characters.

Input-      WS-DATA = "MAINFRAMES"

Declaration-  05 WS-DATA       PIC X(10) VALUE "MAINFRAMES".
              05 WS-CNT        PIC 9(02).
			  
Code-       INSPECT WS-DATA 
                    TALLYING WS-CNT FOR CHARACTERS.
   
Result-     WS-CNT = 10

In the above case, WS-DATA has 10 characters. So the result is 10.

Scenario3 - Counting for characters before "R".

Input-      WS-DATA = "MAINFRAMES"

Declaration-  05 WS-DATA       PIC X(10) VALUE "MAINFRAMES".
              05 WS-CNT        PIC 9(02).
			  
Code-       INSPECT WS-DATA 
                    TALLYING WS-CNT FOR CHARACTERS 
                    BEFORE "R".   
					  
Result-     WS-CNT = 05

In the above case, WS-DATA has 5 characters before "R". So the result is 5.

Scenario4 - Counting for characters after "R".

Input-      WS-DATA = "MAINFRAMES"

Declaration-  05 WS-DATA       PIC X(10) VALUE "MAINFRAMES".
              05 WS-CNT        PIC 9(02).
			  
Code-       INSPECT WS-DATA 
                    TALLYING WS-CNT FOR CHARACTERS 
                    AFTER "R".  
					  
Result-     WS-CNT = 4

In the above case, WS-DATA has 4 characters after "R". So the result is 4.

Scenario5 - Counting for LEADING "M".

Input-      WS-DATA = "MAINFRAMES"

Declaration-  05 WS-DATA       PIC X(10) VALUE "MAINFRAMES".
              05 WS-CNT        PIC 9(02).
			  
Code-       INSPECT WS-DATA 
                    TALLYING WS-CNT FOR LEADING "M".
  
Result-     WS-CNT = 1

In the above case, WS-DATA has 1 occurrence of leading "M". So the result is 1.

Practical Example -


Scenario - INSPECT TALLYING statement used for multiple conditions in COBOL programming.

Code -

----+----1----+----2----+----3----+----4----+----5----+
       IDENTIFICATION DIVISION.
       PROGRAM-ID. INSPECTS.
       AUTHOR. MTH. 

       DATA DIVISION.
       WORKING-STORAGE SECTION. 

       01 WS-VAR.
          05 WS-DATA    PIC X(40) VALUE 
             "COBOL LANGUAGE IS A HIGH LEVEL LANGUAGE".
          05 WS-CNT1    PIC 9(02).
          05 WS-CNT2    PIC 9(02).
          05 WS-CNT3    PIC 9(02).

       PROCEDURE DIVISION.

           INSPECT WS-DATA TALLYING
                   WS-CNT1 FOR ALL SPACES BEFORE "HIGH" 
                   WS-CNT2 FOR ALL "A" AFTER "IS"
                   WS-CNT3 FOR LEADING "C".
           DISPLAY "WS-CNT1:     " WS-CNT1.
           DISPLAY "WS-CNT2:     " WS-CNT2.
           DISPLAY "WS-CNT3:     " WS-CNT3.
           STOP RUN.

Output -

INSPECT TALLYING program Output

Explaining Example -

In the above case,

  • SPACES before "HIGH" has 4 occurrences.
  • "A" has 3 occurrences before "IS".
  • "C" has only one occurrence of leading.

After counting, the results are WS-CNT1 = 04, WS-CNT2 = 03 and WS-CNT3 = 01.