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

x
Writing the MTHNAM Subroutine

Reference:

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



x
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 three 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


x
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.
LINKAGE SECTION.
   01  MTH     COMP-2.
   01  MONTH   PIC X(9).
PROCEDURE DIVISION USING MTH, MONTH.
BEG-1.
      ADD 0.000001 TO MTH.
      MOVE MTH TO IMTH.
      IF IMTH < +1 OR > 12
        SET IX TO +13
      ELSE
        SET IX TO IMTH.
      MOVE A (IX) TO MONTH.
      GOBACK.


x
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;


x
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                                              
*                                                                       
         L        3,0(0,1)          LOAD ADDR OF FIRST ARG  INTO R3     
         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,=D'0.00001'     ADD ROUNDING CONSTANT             
         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                      
*                                                                       
*   TERMINATE THE CEE ENVIRONMENT AND RETURN TO THE CALLER              
*                                                                       
         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 
/*                                                                   


x
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

x
Calling the MTHNAM Subroutine From a Request

You can call the MTHNAM subroutine from a report request.



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