INSPECT CONVERTING Statement


INSPECT...CONVERTING performs character conversion in a variable. It's a way to convert all instances of certain characters with other characters. It works on individual characters in the group of characters.

Syntax -

INSPECT ws-input-string 
	CONVERTING ws-char-1 .... char-n
	TO char-a ... char-z
	[[BEFORE | AFTER] [INITIAL] {ws-delimeter | delimeter-literal}].
Note! All statements coded in [ ] are optional.

Parameters -

  • ws-input-string - The data item that will be inspected for replacements. It should be alphanumeric variable declared with usage DISPLAY.
  • char-1 ... char-n - The character(s) we're searching for in ws-variable.
  • char-a ... char-z - The character(s) that will convert the characters char-1 ... char-n.
  • BEFORE ws-delimeter - Specifies replacing begins at the leftmost character position and continues till the first occurrence of the delimiter. If no delimiter is found, replacing continues until the last character of the string.
  • AFTER ws-delimeter - Specifies replacing 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 replacement takes place.
  • INITIAL - Specifies the first occurrence of a delimeter.
  • ws-delimeter | delimeter-literal - Specifies the delimeter alphanumeric variable or literal.

Examples -


Scenario1 - Conveting all uppercase characters to lowercase.

Input-        WS-DATA = "MAINFRAMES"

Declaration-  05 WS-DATA      PIC X(10) VALUE "MAINFRAMES".

Code-         INSPECT WS-DATA CONVERTING 
              "ABCDEFGHIJKLMNOPQRSTUVWXYZ" TO
			  "abcdefghijklmnopqrstuvwxyz". 
			  
Result-       WS-DATA = "mainframes"

The first character 'M' converts to its equal character 'm'. In the second iteration, the second character 'A' converts to its equal character 'a'. Similarly, every character converted with its equal characters. The result is 'mainframes'.

Scenario2 - Conveting all uppercase characters to lowercase before "R".

Input-        WS-DATA = "MAINFRAMES"

Declaration-  05 WS-DATA      PIC X(10) VALUE "MAINFRAMES".

Code-         INSPECT WS-DATA CONVERTING 
              "ABCDEFGHIJKLMNOPQRSTUVWXYZ" TO
			  "abcdefghijklmnopqrstuvwxyz" BEFORE "R". 
			  
Result-       WS-DATA = "mainfRAMES"

In the above case, it converts all uppercase characters to lowercase characters before "R".

Scenario3 - Conveting all uppercase characters to lowercase after "F" The result is "mainfRAMES".

Input-        WS-DATA = "MAINFRAMES"

Declaration-  05 WS-DATA      PIC X(10) VALUE "MAINFRAMES".

Code-         INSPECT WS-DATA CONVERTING 
              "ABCDEFGHIJKLMNOPQRSTUVWXYZ" TO
			  "abcdefghijklmnopqrstuvwxyz" AFTER "F". 
			  
Result-       WS-DATA = "MAINFrames"

In the above case, it converts all uppercase characters to lowercase characters after "F". The result is "MAINFrames".

Practical Example -


Scenario - INSPECT CONVERTING statement coding in COBOL programming.

Code -

----+----1----+----2----+----3----+----4----+----5----+
       IDENTIFICATION DIVISION.
       PROGRAM-ID. INSPECTC.
       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-SOURCE  PIC X(26) VALUE 
             "ABCDEFGHIJKLMNOPQRSTUVWXYZ".
          05 WS-TARGET  PIC X(26) VALUE 
             "abcdefghijklmnopqrstuvwxyz".
 
       PROCEDURE DIVISION.

           INSPECT WS-DATA
                   CONVERTING WS-SOURCE TO ws-target
                         BEFORE "IS".

           DISPLAY "WS-DATA AFTER CONVERSION:     " WS-DATA.
           STOP RUN.

Output -

INSPECT CONVERTING program Output

Explaining Example -

In the above case, all the uppercase characters before "IS" is converted lowecase characters. The output is "cobol language IS A HIGH LEVEL LANGUAGE ".