CALL Statement


A CALL statement statement is used to transfer the control from one program to another. It is always coded in the calling program or main program, and the program name in the CALL statement is called program or subprogram.

The calling program execution is on hold until the subprogram execution is completed.

Generally, subprograms are designed to complete a common task that is performed in many places. We can avoid code redundancy (Coding the same piece of code in multiple places) by calling the subprogram from the place where the task needs to be completed.

To understand the concept, let us assume we have a main program (MAINPROG) and a subprogram (SUBPROG) are coded as different programs. The MAINPROG calls the SUBPROG using the CALL statement.

Syntax -

CALL subprogram
    [USING variable1, variable2, ...]
    [RETURNING variableA, variableB, ...]
    [ON EXCEPTION statements-block1]
    [NOT ON EXCEPTION statements-block2]
[END-CALL].
Note! All statements coded in [ ] are optional.

CALL Types -


CALLs are two types based on how the subprogram is called from main program -

  • Static Call
  • Dynamic call

STATIC CALL -


CALL statement with SUBPROG name in quotes makes the call as STATIC CALL.

When we compile SUBPROG, its load module stores individually like all other standard-alone programs, but when we compile the MAINPROG that has STATIC CALL, the SUBPROG load module is attached to the MAINPROG load module and stored together.

Syntax without parameters -

CALL "subprogram-name"

Syntax with parameters -

CALL "SUBPROG" USING WS-INP1, WS-INP2, ...

Notes to Remember -

  • subprogram-name should be in quotes, and the compiler option should be NODYNAM to make the call static.
  • If SUBPROG is modified, the SUBPROG should compile first. MAINPROG should compile next to update the load module with new SUBPROG changes. If MAINPROG is modified, compiling MAINPROG alone is sufficient.
  • MAINPROG load module using STATIC CALL occupies more space when compared to MAINPROG using DYNAMIC CALL.
  • STATIC CALL execution is faster when compared with DYNAMIC CALL.

DYNAMIC CALL -


CALL statement with a WORKING-STORAGE variable (WS-SUBPROG) that has SUBPROG name in it makes the call as DYNAMIC CALL.

When we compile MAINPROG and SUBPROG, their load modules are stored separately, and the load modules are not linked to each other.

Syntax without parameters -

 05 WS-SUBPROG     PIC X(08) VALUE SPACES.
 ...
 MOVE "SUBPROG"  TO WS-SUBPROG.
 CALL WS-SUBPROG

Syntax with parameters -

 05 WS-SUBPROG     PIC X(08) VALUE SPACES.
 ...
 MOVE "SUBPROG"  TO WS-SUBPROG.
 CALL WS-SUBPROG USING WS-INP1, WS-INP2, ...

Notes to Remember -

  • WS-SUBPROG is a WORKING-STORAGE SECTION variable and should have a subprogram name in it.
  • Compiler option should be NODYNAM to make the call is static.
  • If SUBPROG is modified, compiling MAINPROG alone is sufficient.
  • DYNAMIC CALL execution is a little slower when compared with STATIC CALL.
  • DYNAMIC CALL is the most used call nowadays.

USING phrase -


  • USING phrase is used to pass the parameters in MAINPROG (CALL...USING) and to receive the parameter values in SUBPROG (PROCEDURE DIVISION USING...).
  • If one program coded with a USING phrase, the other should code with a USING.
  • The sequence of the parameters in the CALL statement USING phrase should match the called SUBPROG PROCEDURE DIVISION USING phrase sequence.
  • The parameters declaration in both MAINPROG and SUBPROG should be the same.

USING in MAINPROG -

CALL WS-SUBPROG USING WS-INP1, WS-INP2.

USING in SUBPROG -

PROCEDURE DIVISION USING LK-INP1, LK-INP2.

Passing Parameters -


There are three ways of passing parameters from MAINPROG to SUBPROG, and those are -

RETURNING phrase -


The RETURNING phrase is used to return a result value from SUBPROG to the MAINPROG. It is coded with PROCEDURE DIVISION in SUBPROG. The MAINPROG should code with a variable to receive the result if the RETURNING phrase is coded in SUBPROG.

MAINPROG -

CALL WS-SUBPROG USING WS-INP1, WS-INP2, WS-RESULT.

RETURNING in SUBPROG -

PROCEDURE DIVISION USING LK-INP1, LK-INP2
                   RETURNING LK-RESULT.

Error Handling -


ON OVERFLOW | ON EXCEPTION phrase -

An exception condition occurs when the SUBPROG is not available to run. If the ON EXCEPTION phrase is coded, control is transferred to a set of statements coded with it, and then execution continues.

NOT ON EXCEPTION phrase -

If an exception condition does not occur, control is transferred to the SUBPROG. Once the SUBPROG execution is completed, control is transferred to a set of statements coded with it, and then execution continues.

END-CALL -


The END-CALL is used to end the scope of the CALL statement. It is not required when the CALL statement ends with a period.

Practical Example -


Scenario - Static Call from MAINPROG to SUBPROG and receiving the result back from SUBPROG.

Main Program -

----+----1----+----2----+----3----+----4----+----5----+
       IDENTIFICATION DIVISION.
       PROGRAM-ID. MAINPROG.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01 WS-VAR.
          05 WS-INP1      PIC 9(02) VALUE 47. *> Input1
          05 WS-INP2      PIC 9(02) VALUE 25. *> Input2
          05 WS-RESULT    PIC 9(04).          *> Result Variable

	   PROCEDURE DIVISION. 

	  * Calling subprogram staically with two inputs 
      * and receiving the result from SUBPROG
           CALL "SUBPROG" USING WS-INP1, WS-INP2, WS-RESULT.

           DISPLAY "INPUTS:  " WS-INP1 ", " WS-INP2.
           DISPLAY "RESULTS: " WS-RESULT.

           STOP RUN. 

Sub Program -

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

       DATA DIVISION.
       LINKAGE SECTION.
       01 LK-INP1      PIC 9(02).  *> To receive input1 from MAINPROG
       01 LK-INP2      PIC 9(02).  *> To receive input2 from MAINPROG
       01 LK-RESULT    PIC 9(04).  *> To send result to MAINPROG

	  *Receiving data from main program CALL statement
       PROCEDURE DIVISION USING LK-INP1, LK-INP2, LK-RESULT. 

           COMPUTE LK-RESULT = LK-INP1 * LK-INP2.
           GOBACK.

JCL -

//MATEPKRJ JOB MSGLEVEL=(1,1),NOTIFY=&SYSUID     
//***********************************************
//*  RUN A COBOL PROGRAM                         
//***********************************************
//STEP01  EXEC PGM=MAINPROG                      
//STEPLIB  DD  DSN=MATEPK.COBOL.LOADLIB,DISP=SHR 
//SYSOUT   DD  SYSOUT=*

Output -

INPUTS:  47, 25
RESULTS:  1175

Explaining Example -

In the above example:

  • MAINPROG is the main program, and SUBPROG is the subprogram.
  • WS-INP1 and WS-INP2 are the inputs passed from MAINPROG to the SUBPROG. SUBPROG receives the data into LK-INP1, LK-INP2 from MAINPROG, multiplies those values, and places the result into LK-RESULT.
  • SUBPROG returns the output in LK-RESULT, and MAINPROG displays the result received from SUBPROG.