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:
Reference: |
The MTHNAM subroutine can be written in FORTRAN, COBOL, PL/I, BAL Assembler, and C.
This is a FORTRAN version of the MTHNAM subroutine where:
Is the double-precision number in the input argument.
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.
Is a two dimensional, 13 by three array containing the names of the months. The last three elements contain the error message.
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
The following example compiles and linkedits the FORTRAN version of MTHNAM:
//COMPILE EXEC PGM=FORTVS2,
// PARM='LANGLVL(66),NODECK,NOLIST,OPT(0)'
//* PARM='NODECK,NOLIST,OPT(0)'
//STEPLIB DD DSN=VSF2.VSF2COMP,DISP=SHR
//SYSLIB DD DSN=CEE.SCEESAMP,DISP=SHR
//SYSPRINT DD SYSOUT=*,DCB=BLKSIZE=3429
//SYSTERM DD SYSOUT=*
//SYSPUNCH DD SYSOUT=B,DCB=BLKSIZE=3440
//SYSLIN DD DSN=&&LOADSET,DISP=(MOD,PASS),UNIT=SYSD
// SPACE=(3200,(25,6)),DCB=BLKSIZE=3200
//SYSIN DD *
/*
/* The subroutine source code goes here.
/* Alternatively, your DD statement can point to the data set
/* containing the source code.
//*
// COND=(0,NE)
//SYSUT1 DD DSN=&&LOADSET,DISP=(OLD,PASS)
//SYSUT2 DD SYSOUT=*
//SYSPRINT DD DUMMY
//SYSIN DD DUMMY
//*
//LINKEDIT EXEC PGM=HEWL,
// PARM='MAP,LIST,XREF,SIZE=(500K,65K),RMODE(ANY),AMODE(31)',
// COND=(0,NE)
//SYSPRINT DD SYSOUT=*
//SYSLIB DD DSN=CEE.SAFHFORT,DISP=SHR
// DD DSN=CEE.SCEELKED,DISP=SHR
//SCEESAMP DD DSN=CEE.SCEESAMP,DISP=SHR
//SYSUT1 DD UNIT=SYSDA,SPACE=(1024,(200,20))
//SYSLMOD DD DSN=prefix.TSO.LOAD,DISP=SHR
//OBJECT DD DSN=&&LOADSET,DISP=(OLD,DELETE)
//* DD DDNAME=SYSIN
//SYSLIN DD *
INCLUDE OBJECT
INCLUDE SYSLIB(CEESG007)
NAME MTHNAM(R)
/*
//*
where:
Is the high-level qualifier for your production FOCUS data sets.
This is a COBOL version of the MTHNAM subroutine where:
Is a field containing the names of the months and the error message.
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.
Is one element in the MLINE array.
Is an integer field that indexes MLINE.
Is the integer representing the month.
Is the double-precision number in the input argument.
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.
The following example compiles and linkedits the COBOL version of MTHNAM:
//COMPILE EXEC PGM=IGYCRCTL,
// PARM='APOST,RES,RENT'
//STEPLIB DD DSN=IGY.V1R2M0.SIGYCOMP,DISP=SHR
//SYSPRINT DD SYSOUT=*
//SYSLIN DD DSNAME=&&LOADSET,UNIT=SYSDA,DISP=(MOD,PASS),
// SPACE=(TRK,(3,3))
//SYSUT1 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
//SYSUT2 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
//SYSUT3 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
//SYSUT4 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
//SYSUT5 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
//SYSUT6 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
//SYSUT7 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
//SYSIN DD *
/*
/* The subroutine source code goes here
/* Alternatively, your DD statement can point to a data set
/* that contains the source code.
/*
//*
//LINKEDIT EXEC PGM=IEWL,
// PARM='REUS,MAP,LIST'
//STEPLIB DD DSN=CEE.SCEELKED,DISP=SHR
//OBJECT DD DSNAME=&&LOADSET,DISP=(OLD,DELETE)
// DD DDNAME=SYSIN
//SYSLIB DD DSN=CEE.SCEELKED,DISP=SHR
//SYSUT1 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
//SYSPRINT DD SYSOUT=*
//SYSLMOD DD DSN=prefix.TSO.LOAD,DISP=SHR
//SYSLIN DD *
MODE AMODE(31),RMODE(ANY)
INCLUDE OBJECT
ENTRY MTHNAM
NAME MTHNAM(R)
/*
//*
where:
Is the high-level qualifier for your production FOCUS data sets.
Note:
This is a PL/I version of the MTHNAM subroutine where:
Is the double-precision number in the input argument.
Is the name of the month corresponding to the integer in MONTHNUM.
Is the integer representing the month.
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;
This example includes the following steps for compiling, linkediting, and calling the PL/I version of MTHNAM:
//* Step 1 - compile the COBOL stub
//*
//COBSTUB EXEC IGYWCL,
// PARM.COBOL='APOST,DYNAM,RENT',
// PARM.LKED='LIST,MAP,SIZE=2046K'
//COBOL.SYSIN DD *
IDENTIFICATION DIVISION.
PROGRAM-ID. COBSTUB.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-370.
OBJECT-COMPUTER. IBM-370.
DATA DIVISION.
WORKING-STORAGE SECTION.
LINKAGE SECTION.
01 DUMMY-IO PIC X(99).
PROCEDURE DIVISION USING DUMMY-IO.
MAIN SECTION.
CALL 'MTHNAM' USING DUMMY-IO.
MAIN-EXIT. EXIT.
GOBACK.
/*
//*
//LKED.SYSIN DD *
MODE AMODE(31),RMODE(ANY)
ENTRY COBSTUB
NAME COBSTUB(R)
/*
//LKED.SYSLMOD DD DSN=prefix.TSO.LOAD,DISP=SHR
//*
//* Step 2 - compile the PLI program
//*
//COMPILE EXEC IEL1CL,
// PARM.PLI='OBJECT,NODECK',
// PARM.LKED='XREF,LIST'
//*
//PLI.SYSIN DD *
/*
/* The subroutine source code goes here.
/* Alternatively, your DD statement can point to the data set
/* containing the source code.
/*
//*
//LKED.SYSLMOD DD DSN=prefix.TSO.LOAD,DISP=SHR
//LKED.SYSIN DD *
ENTRY MTHNAM
NAME MTHNAM(R)
/*
//*
//FOCUS EXEC PGM=FOCUS,COND=(0,NE) //STEPLIB DD DSN=CEE.SCEERUN,DISP=SHR // DD DSN=prefix.TSO.LOAD,DISP=SHR // DD DSN=prefix.FOCLIB.LOAD,DISP=SHR // DD DSN=prefix.FUSELIB.LOAD,DISP=SHR //USERLIB DD DSN=prefix.FOCLIB.LOAD,DISP=SHR //ERRORS DD DSN=prefix.ERRORS.DATA,DISP=SHR //MASTER DD DSN=prefix.MASTER.DATA,DISP=SHR //FOCEXEC DD DSN=prefix.FOCEXEC.DATA,DISP=SHR //EMPLOYEE DD DSN=prefix.EMPLOYEE.FOCUS,DISP=SHR //SYSOUT DD SYSOUT=* //SYSPRINT DD SYSOUT=* //FSTRACE DD SYSOUT=* //OUT DD SYSOUT=*,DCB=BLKSIZE=121 //OFFLINE DD SYSOUT=* //*SYSUDUMP DD DUMMY //SYSIN DD * SET PRINT = OFFLINE DEFINE FILE EMPLOYEE MONTH_NUM/M = PAY_DATE; PAY_MONTH/A12 = MTHNAM (MONTH_NUM, PAY_MONTH); END TABLE FILE EMPLOYEE HEADING " " "FOCUS RELEASE - &FOCREL PUT LEVEL - " &PUTLEVEL "SUBROUTINE - MTHNAM " " " PRINT PAY_MONTH GROSS BY EMP_ID BY FIRST_NAME BY LAST_NAME BY PAY_DATE IF LAST_NAME IS STEVENS END FIN /* //
where:
Is the high-level qualifier for your production FOCUS data sets.
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 /*
The following example assembles and linkedits the Assembler version of MTHNAM:
//ASSEMBLE EXEC PGM=ASMA90,
// PARM='OBJECT,LIST,ESD,NODECK'
//SYSLIB DD DSN=CEE.SCEEMAC,DISP=SHR
//SYSUT1 DD UNIT=SYSDA,SPACE=(TRK,(45,15))
//SYSUT2 DD UNIT=SYSDA,SPACE=(TRK,(45,15))
//SYSUT3 DD UNIT=SYSDA,SPACE=(TRK,(45,15))
//SYSPUNCH DD DUMMY
//SYSPRINT DD SYSOUT=*
//SYSLIN DD DSNAME=&&LINKSET,UNIT=SYSDA,DISP=(MOD,PASS),
// SPACE=(TRK,(3,3))
//SYSIN DD *
/*
/* The subroutine source code goes here.
/* Alternatively, the DD statement can point to a data set that contains
/* the source code.
/*
//*
//IEBGENER EXEC PGM=IEBGENER,
// COND=(0,NE)
//SYSUT1 DD DSN=&&LINKSET,DISP=(OLD,PASS)
//SYSUT2 DD SYSOUT=*
//SYSPRINT DD DUMMY
//SYSIN DD DUMMY
//*
//LINKEDIT EXEC PGM=IEWL,
// PARM='LIST,XREF,LET,REUS',
// COND=(0,NE)
//SYSLIB DD DSN=CEE.SCEELKED,DISP=SHR
//SYSUT1 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
//SYSLMOD DD DSN=prefix.TSO.LOAD(MTHNAM),DISP=SHR
//SYSPRINT DD SYSOUT=*
//SYSLIN DD DSNAME=&&LINKSET,DISP=(OLD,PASS)
// DD DDNAME=SYSIN
/*
//SYSIN DD *
ENTRY MTHNAM
NAME MTHNAM(R)
/*
//*
where:
Is the high-level qualifier for your production FOCUS data sets.
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]; }
The following example compiles and linkedits the C version of MTHNAM:
//CBG EXEC PROC=EDCCL //COMPILE.SYSPRINT DD SYSOUT=*, // DCB=(RECFM=FB,LRECL=3200,BLKSIZE=12800) //COMPILE.SYSIN DD *,DLM=XX /* #INCLUDE <STDIO.H> */ /* /* The subroutine source code goes here. /* Alternatively, the DD statement can point to a data set that contains /* the source code. /* XX //LKED.SYSPRINT DD SYSOUT=* //LKED.SYSLMOD DD DSN=prefix.LOADLIB,DISP=SHR //LKED.SYSIN DD * NAME MTHNAM(R) //* /*
where:
Is the high-level qualifier for your production FOCUS data sets.
Note:
You can call the MTHNAM subroutine from a report request.
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
Information Builders |