*PROCESS MACRO;
/*Module/File Name: IBMDT4
/************************************************************/
/* */
/* Function : CEEDAYS - convert date to Lilian date */
/* : CEEDATE - convert Lilian Date to date */
/* : CEEDYWK - find day-of-week from Lilian */
/* */
/* CEEDAYS is passed the calander date "11/09/92". The */
/* date is originally in YYMMD format and conversion to */
/* Lilian format takes place. On return, a varying number */
/* of days is added to or subtracted from the Lilian date. */
/* CEEDATE is called to convert the Lilian dates to the */
/* calendar format "MM/DD/YY". CEEDYWK is called to */
/* return the day of the week for each derived Lilian date. */
/* */
/* The results are tested for accuracy. */
/* */
/************************************************************/
CE77DAT: PROC OPTIONS(MAIN);
%INCLUDE CEEIBMAW;
%INCLUDE CEEIBMCT;
DCL CHRDATE CHAR(80);
DCL CURRENT_DATE CHAR(255) VARYING;
DCL PICSTR CHAR(255) VARYING;
DCL Lilian REAL FIXED BINARY(31,0);
DCL ii REAL FIXED BINARY(31,0);
DCL NumberOfDays (5) REAL FIXED BINARY(31,0)
INIT( 80, 20, 10, 5, 4);
DCL ChkWeekDay (5) REAL FIXED BINARY(31,0)
INIT( 6, 1, 5, 4, 6);
DCL CURRENT_LILIAN REAL FIXED BINARY(31,0);
DCL DISPLACED_LILIAN REAL FIXED BINARY(31,0);
DCL WEEKDAY REAL FIXED BINARY(31,0);
DCL 01 FC, /* Feedback token */
03 MsgSev REAL FIXED BINARY(15,0),
03 MsgNo REAL FIXED BINARY(15,0),
03 Flags,
05 Case BIT(2),
05 Severity BIT(3),
05 Control BIT(3),
03 FacID CHAR(3), /* Facility ID */
03 ISI /* Instance-Specific Information */
REAL FIXED BINARY(31,0);
DCL ChkDates (5) CHAR(8) INIT(
'08/21/92',
'11/29/92',
'11/19/92',
'11/04/92',
'11/13/92');
PUT SKIP LIST( '>>> Example CE77DAT in motion');
/**********************************************************/
/* Set current date to 11/09/92 in YYMMDD format */
/**********************************************************/
Picstr = 'YYMMDD';
Current_Date = '921109';
/**********************************************************/
/* Call CEEDAYS to convert the date in Current_Date to */
/* its corresponding Lilian date format. */
/**********************************************************/
Call CEEDAYS ( Current_Date, Picstr, Current_Lilian, FC );
IF ^ FBCHECK( FC, CEE000) THEN DO;
PUT SKIP LIST( 'Error in converting Current Date');
END;
/***********************************************************/
/* The date picstr must be adjusted to fit the current */
/* date format. */
/***********************************************************/
Picstr = 'MM/DD/YY';
/*************************************************************/
/* In the following loop, add or subtract the number */
/* of days in each element of the NumberOfDays array to the */
/* Lilian date. Determine the day of the week for each */
/* Lilian date and convert each date back to "MM/DD/YY" */
/* format. Issue a message if anything goes wrong. */
/*************************************************************/
DO ii = 1 TO 5;
IF ( ii= 1 | ii= 4 ) THEN DO;
Displaced_Lilian = Current_Lilian - NumberOfDays(ii);
END;
ELSE DO;
Displaced_Lilian = Current_Lilian + NumberOfDays(ii);
END;
/**********************************************************/
/* Call CEEDATE to convert the Lilian dates to MM/DD/YY */
/* format. */
/**********************************************************/
Call CEEDATE ( Displaced_Lilian, Picstr, ChrDate, FC );
IF FBCHECK( FC, CEE000) THEN DO;
/***********************************************************/
/* Compare the dates to an array of expected values. */
/* Issue an error message if any conversion is incorrect. */
/***********************************************************/
IF ChrDate ^= ChkDates(ii) THEN DO;
PUT SKIP EDIT( 'Error in returned date ', Chrdate,
' for number of days ', NumberOfDays(i) )
( (3) a, f(6) );
END;
END;
ELSE DO;
PUT SKIP LIST( 'Error ' || FC.MsgNo
|| ' converting Date to Lilian Date' );
END;
/*********************************************************/
/* Call CEEDYWK to return the day-of-the-week value */
/* (1 thru 7) for each calculated Lilian date. Compare */
/* results to an array of expected returned values and */
/* issue an error message for any incorrect values. */
/*********************************************************/
Call CEEDYWK ( Displaced_Lilian, WeekDay, FC );
IF FBCHECK( FC, CEE000) THEN DO;
IF WeekDay ^= ChkWeekDay(ii) THEN DO;
PUT SKIP EDIT( 'Error in day of the week for ', ChrDate)
( a, a );
END;
END;
ELSE DO;
PUT SKIP LIST( 'Error finding Day-of-Week');
END;
END;
PUT SKIP LIST( '<<< Example CE77DAT complete');
END CE77DAT;