Figure 4b: COBOL version of the code

* CRTCBLPGM PGM(XXX/DATEPGMCBL) SRCFILE(XXX/QLBLSRC)
*

*========================================================

PROCESS XREF MAP QUOTE.
IDENTIFICATION DIVISION.
PROGRAM-ID. DATEPGMCBL.
AUTHOR. MARIO MARTINEZ.
DATE-WRITTEN. 01/21/98.
**

* Documentation on how to setup and use this API
* using RPG was printed in the issue of
* Midrange Computing. The article was written by Craig Pelkie.
* In February 1998 another article covering the changes to
* QWCCVTDT was published by MC magazine. The article was written
* by Mario Martinez.

*

* The example code to the article was written in RPG. This
* program is written in Cobol and functions like it's RPG
* counterpart.

*

* This OPM COBOL/400 program will call the "QWCCVTDT"
* OS/400 API, which was developed by IBM to change
* dates from one format to another. This API has been
* further enhanced to provide the dates with the
* actual century value.

*

* After the API is called, the results will be displayed
* on the console.

*

* The program will retrieve the current date in several
* different formats - using the actual century value.

*

* After the QWCCVTDT API will be used to change the format
* of the date 02/29/2000, which is a leap year,
* to the long Julian format. The same operation will be performed
* on the invalid date 02/29/2001, which is not a leap year.

* This is to demonstrate how invalid date error
* can be trapped using this API.

*

* Summary of program functions using OPM Cobol/400 :
*

* 1.) Retrieve the actual century value in different formats,
* using QWCCVTDT.

*

* 2.) Convert a date value to another format,
* using QWCCVTDT.

*

* 3.) Trap an invalid date error
* using a standard OPM OS/400 error data structure.
*

* 4.) Use the DOSGetDateTime data structure to retrieve date/time
* information including the Day of the Week numeric value.

*

* Numeric Value - 0 1 2 3 4 5 6
* Text Value - Sun Mon Tues Wed Thurs Fri Sat
*

* 5.) Maintain "Year 2000" compliance at all times.
*========================================================

* Program Output :

* call datepgmcbl
* The resulting date value is :19980121
* The resulting date value is :1998021
* The resulting date value is :2000060
* Error in Date Conversion, Message ID is :CPF1060
* The resulting date value is :
* DOSGetDateTime values :
* Hours = 0011
* Minutes = 0001
* Seconds = 0042
* Hundreths of Seconds = 0060
* Day of Month = 0021
* Month = 0001
* Year = 1998
* Time Zone = 0360

* Day of Week = 0003
*========================================================

*

*-

ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.

**

* These terms are exactly the same as Craig Pelkie
* usedinFig.4ofhisMay1993MCarticle.

*

* APIERR - Standard OPM OS/400 API error data structure
* AEBYPR - Bytes provided for error information
* AEBYAV - Bytes of error information available
* AEEXID - Exception ID of Error
* AERESV - Reserved
* AEEXDT - Exception Data
*-

01 APIERR.

05 AEBYPR PIC S9(9) COMP-4 VALUE 116.
05 AEBYAV PIC S9(9) COMP-4.
05 AEEXID PIC X(7).
05 AERESV PIC X(1).
05 AEEXDT PIC X(100).

** Values used to retreive, convert and display date conversion
* results.

*

01 date-conversion-values.

05 valid-date PIC X(08) VALUE "02292000".
05 invalid-date PIC X(08) VALUE "02292001".
05 error-message PIC X(41)

VALUE "Error in Date Conversion, Message ID is :".
05 result-message PIC X(41)

VALUE "The resulting date value is :".

01 API-PARMS.

05 input-date-format PIC X(10) VALUE SPACES.
05 output-date-format PIC X(10) VALUE SPACES.
05 input-date-api-info.

10 date-value PIC X(8).
10 time-hhmmss-value PIC X(6).
10 milleseconds-value PIC X(3).
05 output-date-api-info.

10 date-value PIC X(8).
10 time-hhmmss-value PIC X(6).
10 milleseconds-value PIC X(3).

** Parameters used when
* the DOSGetDateTime function is executed.
*

01 DOS-api-parms.

05 DOS-input-date-format PIC X(10) VALUE "*CURRENT".
05 DOS-output-date-format PIC X(10) VALUE "*DOS".
05 DOS-input-date-filler PIC X(01).

** Under the QWCCVTDT documentation this
* is known as "DOSGetDateTime" structure.
*-

01 DOS-date-time-value.

05 DOS-hours PIC X.
05 DOS-minutes PIC X.
05 DOS-seconds PIC X.
05 DOS-hundredths-of-secs PIC X.
05 DOS-day PIC X.
05 DOS-month PIC X.
05 DOS-year PIC 9(4) BINARY.

05 DOS-time-zone PIC 9(4) BINARY.
05 DOS-day-of-week PIC X.

** This working storage data structure will be used
* be used to display the retrieved DOSGetDateTime information in
* a usefull fashion.
*-

01 binary-conversion-values.

05 two-binary-bytes-value PIC 9(4) BINARY VALUE ZERO.
05 binary-conversion-value

REDEFINES two-binary-bytes-value.
10 FILLER PIC X.
10 one-byte-binary-value PIC X.

*-

PROCEDURE DIVISION.

main-process.

PERFORM setup-yyyymmdd-date-format.

PERFORM setup-longjul-date-format.

PERFORM convert-valid-date-format.

PERFORM convert-invalid-date-format.

PERFORM retrieve-dsplay-DOSGetDateTime.

GOBACK.

*-

setup-yyyymmdd-date-format.

MOVE "*CURRENT" TO input-date-format.
MOVE "*YYMD" TO output-date-format.

PERFORM call-date-api-17char.

PERFORM display-date-api-output.

*-

setup-longjul-date-format.

MOVE "*CURRENT" TO input-date-format.
MOVE "*LONGJUL" TO output-date-format.

PERFORM call-date-api-17char.

PERFORM display-date-api-output.

*-

convert-valid-date-format.

INITIALIZE API-PARMS.

MOVE valid-date

TO date-value OF input-date-api-info.

MOVE "*MDYY" TO input-date-format.
MOVE "*LONGJUL" TO output-date-format.

PERFORM call-date-api-17char.

PERFORM display-date-api-output.

*-

convert-invalid-date-format.

INITIALIZE API-PARMS.

MOVE invalid-date

TO date-value OF input-date-api-info.

MOVE "*MDYY" TO input-date-format.
MOVE "*LONGJUL" TO output-date-format.

PERFORM call-date-api-17char.

PERFORM display-date-api-output.

**

* Routine to call the QWCCVTDT API using
* the 17 Character Date and Time Value Structure
*

call-date-api-17char.

CALL "QWCCVTDT" USING

input-date-format,
input-date-api-info,
output-date-format,
output-date-api-info,
APIERR.

*-

display-date-api-output.
*

* IfAEBYAVisnotequaltozerothismeanstherewas
* error when the QWCCVTDT was called. The variable
* AEEXID will contain the OS/400 Message ID of the
* specific error encountered.

*

*

* Code to display other returned information on console
*

DISPLAY result-message date-value OF output-date-api-info.

retrieve-dsplay-DOSGetDateTime.
** Code to access and display returned information
* for the DOSGetDateTime data structure.

*

* Setup and call QWCCVTDT API
*

INITIALIZE API-PARMS.

CALL "QWCCVTDT" USING DOS-input-date-format
DOS-input-date-filler
DOS-output-date-format
DOS-date-time-value
APIERR.

IF (AEBYAV IS NOT EQUAL TO ZERO)

DISPLAY error-message AEEXID

END-IF.

*

* Display all DOSGetDateTime values upon console
*

DISPLAY "DOSGetDateTime values : "

INITIALIZE binary-conversion-values.

MOVE DOS-hours TO one-byte-binary-value.
DISPLAY "Hours = " two-binary-bytes-value.

INITIALIZE binary-conversion-values.

MOVE DOS-minutes TO one-byte-binary-value.

DISPLAY "Minutes = " two-binary-bytes-value.

INITIALIZE binary-conversion-values.

MOVE DOS-seconds TO one-byte-binary-value.
DISPLAY "Seconds = " two-binary-bytes-value.

INITIALIZE binary-conversion-values.

MOVE DOS-hundredths-of-secs TO one-byte-binary-value.
DISPLAY "Hundreths of Seconds = " two-binary-bytes-value.

INITIALIZE binary-conversion-values.

MOVE DOS-day TO one-byte-binary-value.
DISPLAY "Day of Month = " two-binary-bytes-value.

INITIALIZE binary-conversion-values.

MOVE DOS-month TO one-byte-binary-value.
DISPLAY "Month = " two-binary-bytes-value.

DISPLAY "Year = " DOS-year.

DISPLAY "Time Zone = " DOS-time-zone

INITIALIZE binary-conversion-values.

MOVE DOS-day-of-week TO one-byte-binary-value.
DISPLAY "Day of Week = " two-binary-bytes-value.

DSPLY The resulting date value is : 19971209
DSPLY The resulting date value is : 1997343
DSPLY The resulting date value is : 2000060
DSPLY Error in Date Conversion, Message ID is : CPF1060
DSPLY The resulting date value is :
DSPLY DOSGetDateTime Values :
DSPLY Year = 1997
DSPLY Time Zone = 0360
DSPLY Day of Week = 0002