Using a Custom Subroutine: The MTHNAM Subroutine
 In this section:

This topic discusses the MTHNAM subroutine as an example. The MTHNAM subroutine converts a number representing a month to the full name of that month. The subroutine processes as follows:

1. Receives the input argument from the request as a double-precision number.
2. Adds .000001 to the number which compensates for rounding errors. Rounding errors can occur since floating-point numbers are approximations and may be inaccurate in the last significant digit.
3. Moves the number into an integer field.
4. If the number is less than one or greater than 12, it changes the number to 13.
5. Defines a list containing the names of months and an error message for the number 13.
6. Sets the index of the list equal to the number in the integer field. It then places the corresponding array element into the output argument. If the number is 13, the argument contains the error message.
7. Returns the result as an output field.
 Top of page
Writing the MTHNAM Subroutine
 Reference:

The MTHNAM subroutine can be written in FORTRAN, COBOL, PL/I, BAL Assembler, and C.

 Top of page
Reference: MTHNAM Subroutine Written in FORTRAN

This is a FORTRAN version of the MTHNAM subroutine where:

MTH

Is the double-precision number in the input argument.

MONTH

Is the name of the month. Since the character string 'September' contains nine letters, MONTH is a three element array. The subroutine passes the three elements back to your application which concatenates them into one field.

A

Is a two dimensional, 13 by 3 array, containing the names of the months. The last three elements contain the error message.

IMTH

Is the integer representing the month.

The subroutine is:

```  SUBROUTINE MTHNAM (MTH,MONTH)
REAL*8     MTH
INTEGER*4  MONTH(3),A(13,3),IMTH
DATA
+     A( 1,1)/'JANU'/, A( 1,2)/'ARY '/, A( 1,3)/'    '/,
+     A( 2,1)/'FEBR'/, A( 2,2)/'UARY'/, A( 2,3)/'    '/,
+     A( 3,1)/'MARC'/, A( 3,2)/'H   '/, A( 3,3)/'    '/,
+     A( 4,1)/'APRI'/, A( 4,2)/'L   '/, A( 4,3)/'    '/,
+     A( 5,1)/'MAY '/, A( 5,2)/'    '/, A( 5,3)/'    '/,
+     A( 6,1)/'JUNE'/, A( 6,2)/'    '/, A( 6,3)/'    '/,
+     A( 7,1)/'JULY'/, A( 7,2)/'    '/, A( 7,3)/'    '/,
+     A( 8,1)/'AUGU'/, A( 8,2)/'ST  '/, A( 8,3)/'    '/,
+     A( 9,1)/'SEPT'/, A( 9,2)/'EMBE'/, A( 9,3)/'R   '/,
+     A(10,1)/'OCTO'/, A(10,2)/'BER '/, A(10,3)/'    '/,
+     A(11,1)/'NOVE'/, A(11,2)/'MBER'/, A(11,3)/'    '/,
+     A(12,1)/'DECE'/, A(12,2)/'MBER'/, A(12,3)/'    '/,
+     A(13,1)/'**ER'/, A(13,2)/'ROR*'/, A(13,3)/'*   '/
IMTH=MTH+0.000001
IF (IMTH .LT. 1 .OR. IMTH .GT. 12) IMTH=13
DO 1 I=1,3
1 MONTH(I)=A(IMTH,I)
RETURN
END```
 Top of page
Reference: MTHNAM Subroutine Written in COBOL

This is a COBOL version of the MTHNAM subroutine where:

MONTH-TABLE

Is a field containing the names of the months and the error message.

MLINE

Is a 13-element array that redefines the MONTH-TABLE field. Each element (called A) contains the name of a month; the last element contains the error message.

A

Is one element in the MLINE array.

IX

Is an integer field that indexes MLINE.

IMTH

Is the integer representing the month.

MTH

Is the double-precision number in the input argument.

MONTH

Is the name of the month corresponding to the integer in IMTH.

The subroutine is:

```IDENTIFICATION DIVISION.
PROGRAM-ID. MTHNAM.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-370.
OBJECT-COMPUTER. IBM-370.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 MONTH-TABLE.
05 FILLER PIC X(9) VALUE 'JANUARY  '.
05 FILLER PIC X(9) VALUE 'FEBRUARY '.
05 FILLER PIC X(9) VALUE 'MARCH    '.
05 FILLER PIC X(9) VALUE 'APRIL    '.
05 FILLER PIC X(9) VALUE 'MAY      '.
05 FILLER PIC X(9) VALUE 'JUNE     '.
05 FILLER PIC X(9) VALUE 'JULY     '.
05 FILLER PIC X(9) VALUE 'AUGUST   '.
05 FILLER PIC X(9) VALUE 'SEPTEMBER'.
05 FILLER PIC X(9) VALUE 'OCTOBER  '.
05 FILLER PIC X(9) VALUE 'NOVEMBER '.
05 FILLER PIC X(9) VALUE 'DECEMBER '.
05 FILLER PIC X(9) VALUE '**ERROR**'.
01  MLIST REDEFINES MONTH-TABLE.
05  MLINE OCCURS 13 TIMES INDEXED BY IX.
10 A  PIC X(9).
01  IMTH    PIC S9(5) COMP.
01  MTH     COMP-2.
01  MONTH   PIC X(9).
PROCEDURE DIVISION USING MTH, MONTH.
BEG-1.
MOVE MTH TO IMTH.
IF IMTH < +1 OR > 12
SET IX TO +13
ELSE
SET IX TO IMTH.
MOVE A (IX) TO MONTH.
GOBACK.```
 Top of page
Reference: MTHNAM Subroutine Written in PL/I

This is a PL/I version of the MTHNAM subroutine where:

MTHNUM

Is the double-precision number in the input argument.

FULLMTH

Is the name of the month corresponding to the integer in MONTHNUM.

MONTHNUM

Is the integer representing the month.

MONTH_TABLE

Is a 13-element array containing the names of the months. The last element contains the error message.

The subroutine is:

```MTHNAM:   PROC(MTHNUM,FULLMTH) OPTIONS(COBOL);
DECLARE  MTHNUM  DECIMAL FLOAT (16) ;
DECLARE  FULLMTH CHARACTER (9) ;
DECLARE  MONTHNUM FIXED BIN (15,0)  STATIC ;
DECLARE  MONTH_TABLE(13) CHARACTER (9)   STATIC
INIT  ('JANUARY',
'FEBRUARY',
'MARCH',
'APRIL',
'MAY',
'JUNE',
'JULY',
'AUGUST',
'SEPTEMBER',
'OCTOBER',
'NOVEMBER',
'DECEMBER',
'**ERROR**') ;
MONTHNUM = MTHNUM + 0.00001 ;
IF MONTHNUM < 1 |  MONTHNUM > 12 THEN
MONTHNUM = 13 ; FULLMTH = MONTH_TABLE(MONTHNUM) ;
RETURN;
END MTHNAM;```
 Top of page
Reference: MTHNAM Subroutine Written in BAL Assembler

This is a BAL Assembler version of the MTHNAM subroutine:

```* =====================================================================
*
*   A SIMPLE MAIN ASSEMBLE ROUTINE THAT CALLS THE LE CALLABLE SERVICES
*
* =====================================================================
MTHNAM   CEEENTRY PPA=MAINPPA,AUTO=WORKSIZE,MAIN=NO
USING WORKAREA,13
*
LD       4,=D'0.0'         CLEAR OUT FPR4 AND FPR5
LE       6,0(0,3)          FP NUMBER IN FPR6
LPER     4,6               ABS VALUE IN FPR4
AW       4,DZERO           SHIFT OUT FRACTION
STD      4,FPNUM           MOVE TO MEMORY
L        2,FPNUM+4         INTEGER PART IN R2
TM       0(3),B'10000000'  CHECK SIGN OF ORIGINAL NO
BNO      POS              BRANCH IF POSITIVE
LCR      2,2              COMPLEMENT IF NEGATIVE
*
POS      LR       3,2              COPY MONTH NUMBER INTO R3
C        2,=F'0'          IS IT ZERO OR LESS?
BNP      INVALID          YES. SO INVALID
C        2,=F'12'         IS IT GREATER THAN 12?
BNP      VALID            NO. SO VALID
INVALID  LA       3,13(0,0)        SET R3 TO POINT TO ITEM 13 (ERROR)
*
VALID    SR       2,2               CLEAR OUT R2
M        2,=F'9'           MULTIPLY BY SHIFT IN TABLE
*
LA       6,MTH(3)          GET ADDR OF ITEM IN R6            ```
```          L        4,4(0,1)          GET ADDR OF SECOND ARG IN R4
MVC      0(9,4),0(6)       MOVE IN TEXT
*
*
CEETERM  RC=0
* ====================================================================
*              CONSTANTS
* ====================================================================
DS     0D                  ALIGNMENT
FPNUM    DS     D                   FLOATING POINT NUMBER
DZERO    DC     X'4E00000000000000' SHIFT CONSTANT
MTH      DC     CL9'DUMMYITEM'      MONTH TABLE
DC     CL9'JANUARY'
DC     CL9'FEBRUARY'
DC     CL9'MARCH'
DC     CL9'APRIL'
DC     CL9'MAY'
DC     CL9'JUNE'
DC     CL9'JULY'
DC     CL9'AUGUST'
DC     CL9'SEPTEMBER'
DC     CL9'OCTOBER'
DC     CL9'NOVEMBER'
DC     CL9'DECEMBER'
DC     CL9'**ERROR**'
*
MAINPPA  CEEPPA                   CONSTANTS DESCRIBING THE CODE BLOCK
* ====================================================================
*        THE WORKAREA AND DSA
* ====================================================================
WORKAREA DSECT
ORG    *+CEEDSASZ        LEAVE SPACE FOR THE DSA FIXED PART
PLIST    DS     0D
PARM1    DS     A
PARM2    DS     A
PARM3    DS     A
PARM4    DS     A
PARM5    DS     A
*
FOCPARM1 DS     F                 SAVE FIRST PARAMETER PASSED
FOCPARM2 DS     F                 SAVE SECOND PARAMETER PASSED
*
DS     0D
WORKSIZE EQU    *-WORKAREA
CEEDSA                   MAPPING OF THE DYNAMIC SAVE AREA
CEECAA                   MAPPING OF THE COMMON ANCHOR AREA
*
END   MTHNAM             NOMINATE MTHNAM AS THE ENTRY POINT
/*                                                                   ```
 Top of page
Reference: MTHNAM Subroutine Written in C

This is a C language version of the MTHNAM subroutine:

```void mthnam(double *,char *);
void mthnam(mth,month)
double *mth;
char *month;
{
char *nmonth[13] = {"January  ",
"February ",
"March    ",
"April    ",
"May      ",
"June     ",
"July     ",
"August   ",
"September",
"October  ",
"November ",
"December ",
"**Error**"};
int imth, loop;
imth = *mth + .00001;
imth = (imth < 1 || imth > 12 ? 13 : imth);
for (loop=0;loop < 9;loop++)
month[loop] = nmonth[imth-1][loop];
}```
 Top of page
Calling the MTHNAM Subroutine From a Request

You can call the MTHNAM subroutine from a report request.

 Top of page
Example: Calling the MTHNAM Subroutine

The DEFINE command extracts the month portion of the pay date. The MTHNAM subroutine then converts it into the full name of the month, and stores the name in the PAY_MONTH field. The report request prints the monthly pay of Alfred Stevens.

```DEFINE FILE EMPLOYEE
MONTH_NUM/M = PAY_DATE;
PAY_MONTH/A12 = MTHNAM (MONTH_NUM, PAY_MONTH);
END
TABLE FILE EMPLOYEE
PRINT PAY_MONTH GROSS
BY EMP_ID BY FIRST NAME BY LAST_NAME
BY PAY_DATE
IF LN IS STEVENS
END```

The output is:

```EMP_ID     FIRST NAME   LAST_NAME   PAY_DATE   PAY_MONTH   GROSS
-------    ----------   ---------   --------   ---------   -------
071382660  ALFRED       STEVENS     81/11/30   NOVEMBER    \$833.33
81/12/31   DECEMBER    \$833.33
82/01/29   JANUARY     \$916.67
82/02/26   FEBRUARY    \$916.67
82/03/31   MARCH       \$916.67
82/04/30   APRIL       \$916.67
82/05/28   MAY         \$916.67
82/06/30   JUNE        \$916.67
82/07/30   JULY        \$916.67
82/08/31   AUGUST      \$916.67```
 WebFOCUS