Note:
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 |