MTHNAME COBOL Implementation

Note:

This sample is stored in hlq.HOME.ETC(MTHNAMCB) for PDS deployment and as home/etc/src3gl/mthname.cbl on all other platforms.
GENCPGM for COBOL is supported on OpenVMS, z/OS and i/OS (not UNIX/Linux) and the sample on disk is only provided for reference for all other platforms.
On PDS deployment use "-o mthname" to build using alternate source name of MTHNAMCB.
COBOL generally requires small changes depending on platform as outlined in the notes with the sample.
Some compilers ignore line numbers and some have compiler switches to ignore. GENCPGM on OpenVMS can use the -ansi switch to ignore the numbers or (alternately) the COBOL command can be redefined to be COBOL /ANSI in the environment.

Source:

000100*
000200 IDENTIFICATION DIVISION.
000300*
000400* MTHNAME: Sample User Written Routine in Cobol
000500*
000600* Notes:
000700*
000800*  1. This sample is based on the original mainframe
000900*     sample with a PROGRAM-ID of MTHNAM. This has been
001000*     changed to have a uniquely sourced version that
001100*     more closely matches the C version and has these
001200*     comments. The samples are otherwise the same.
001300*
001400*  2. Original mainframe sample had a GOBACK as the
001500*     last statement. OpenVMS Cobol seems to object
001600*     to this, so commented it out as noted below.
001700*     Unix compiler support for GOBACK may also vary
001800*     by vendor and untested at this time (5/1/2003).
001900*
002000*  3. OpenVMS compiled and was found, but initial
002100*     always returned the error case. This was
002200*     actually a GENCPGM.COM error that the Cobol
002300*     needed the /FLOAT=G_FLOAT switch, so be sure
002400*     that you are using a GENCPGM.COM from 5.2.3
002500*     or higher where this is fixed.
002600*

002700*  4. The PROGRAM-ID name may also needed some
002800*     special handling depending on the platform.
002900*     The reason for this is that iWay routines
003000*     are searched for in lower case and there
003100*     seems to be some case sensitivity problems
003200*     for the platforms tested so far. OpenVMS
003300*     doesn't seem to care if name is lower or
003400*     upper case.  i5/OS Cobol is not only case
003500*     sensitive but requires explicit lower case
003600*     values to be in single quotes, but also
003700*     needs the compiler option *NOMONOPRC to
003800*     respect the coded value. So, depending
003900*     on your platform, the PROGRAM-ID value may
004000*     need editing as per notes below.
004100*
004800*
004900* ID Usage for Mainframe and OpenVMS ...
005000*PROGRAM-ID. MTHNAME.
005100* ID Usage for Unix and Windows ...
005200*PROGRAM-ID. mthname.
005300* ID Usage for i5/OS ...
005400*PROGRAM-ID. 'mthname'.
005500*
005600* ID Usage for this run ...
005700 PROGRAM-ID. mthname.
005800*

005900 ENVIRONMENT DIVISION.
006000 CONFIGURATION SECTION.
006100 DATA DIVISION.
006200 WORKING-STORAGE SECTION.
006300    01 MONTH-TABLE.
006400      05 FILLER PIC X(9) VALUE 'January  '.
006500      05 FILLER PIC X(9) VALUE 'February '.
006600      05 FILLER PIC X(9) VALUE 'March    '.
006700      05 FILLER PIC X(9) VALUE 'April    '.
006800      05 FILLER PIC X(9) VALUE 'May      '.
006900      05 FILLER PIC X(9) VALUE 'June     '.
007000      05 FILLER PIC X(9) VALUE 'July     '.
007100      05 FILLER PIC X(9) VALUE 'August   '.
007200      05 FILLER PIC X(9) VALUE 'September'.
007300      05 FILLER PIC X(9) VALUE 'October  '.
007400      05 FILLER PIC X(9) VALUE 'November '.
007500      05 FILLER PIC X(9) VALUE 'December '.
007600      05 FILLER PIC X(9) VALUE '**ERROR**'.
007700    01  MLIST REDEFINES MONTH-TABLE.
007800      05  MLINE OCCURS 13 TIMES INDEXED BY IX.
007900          10 A  PIC X(9).
008000    01  IMTH    PIC S9(5) COMP.
008100 LINKAGE SECTION.
008200    01  MTH     COMP-2.
008300    01  MONTH   PIC X(9).
008400 PROCEDURE DIVISION USING MTH, MONTH.
008500 BEG-1.
008600       ADD 0.000001 TO MTH.
008700       MOVE MTH TO IMTH.
008800       IF IMTH < +1 OR > 12
008900         SET IX TO +13
009000       ELSE
009100         SET IX TO IMTH.
009200       MOVE A (IX) TO MONTH.
009300*
009400* On OpenVMS ... Comment out the GOBACK.
009500*
009600       GOBACK.

iWay Software