Created On: 22 December 2011
Problem:
Customer is converting from RM COBOL to Visual COBOL and runs into the following compatibility issue:
In some programs RM / COBOL, we use the word PROGRAM-ID to know the name of the current program.
But in Visual COBOL it gives the error "invalid operand". Why is this?
In some programs RM / COBOL, we use the word PROGRAM-ID to know the name of the current program.
IDENTIFICATION DIVISION.
PROGRAM-ID. BASE0006.
...
PROCEDURE DIVISION.
PROGRAMA SECTION.
PROGRAMA-INI.
...
DISPLAY "PROGRAM NAME: ", PROGRAM-ID.
But in Visual COBOL it gives the error "invalid operand". Why is this?
Resolution:
Visual COBOL has its own set of Library routines that can be found in the documentation under Reference > Library Routines.
An example of how to return program information about the current program and other program in the run-unit is as follows: (please see entry for CBL_GET_PROGRAM_INFO for more detailed information)
An example of how to return program information about the current program and other program in the run-unit is as follows: (please see entry for CBL_GET_PROGRAM_INFO for more detailed information)
program-id. testProgram.
data division.
working-storage section.
01 wsfunction pic x(4) comp-5.
01 param-block.
05 cblte-gpi-size pic x(4) comp-5.
05 cblte-gpi-flags pic x(4) comp-5.
05 cblte-gpi-handle usage pointer.
05 cblte-gpi-prog-id usage pointer.
05 cblte-gpi-attrs pic x(4) comp-5.
01 return-buf pic x(100).
01 return-buf-len pic x(4) comp-5 value 100.
01 status-code pic x(4) comp-5 value 0.
procedure division.
move length of param-block to cblte-gpi-size
move length of return-buf to return-buf-len
*> Establish the current program and return handle
move 0 to wsfunction
perform 100-call-program-info
display "program name = " return-buf
*> Get first entry point in program
move 4 to wsfunction
perform 100-call-program-info
display "entry point = " return-buf
*> Close the handle that was established
move 6 to wsfunction
perform 100-call-program-info
stop run.
100-call-program-info.
call "CBL_GET_PROGRAM_INFO"
using
by value wsfunction
by reference param-block
by reference return-buf
by reference return-buf-len
returning status-code
end-call.