CBL LIB,QUOTE
*Module/File Name: IGZTDT4
************************************************************
** **
** CE77DAT - Call the following LE service routines: **
** : CEEDAYS - convert date to Lilian format **
** : CEEDATE - convert Lilian date to date **
** : CEEDYWK - find day of week from Lilian **
** **
** CEEDAYS is passed the calendar date "11/09/92". The **
** date is originally in YYMMDD format and conversion to **
** Lilian format takes place. On return from CEEDAYS, **
** a varying number of days is added to or subtracted **
** from the Lilian date. **
** CEEDATE is then called to convert the Lilian dates to **
** the 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. **
** **
************************************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. CE77DAT.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WEEKDAY PIC S9(9) BINARY.
01 LILIAN PIC S9(9) BINARY.
01 CURRENT-LILIAN PIC S9(9) BINARY.
01 DISPLACED-LILIAN PIC S9(9) BINARY.
01 FC.
02 Condition-Token-Value.
COPY CEEIGZCT.
03 Case-1-Condition-ID.
04 Severity PIC S9(4) BINARY.
04 Msg-No PIC S9(4) BINARY.
03 Case-2-Condition-ID
REDEFINES Case-1-Condition-ID.
04 Class-Code PIC S9(4) BINARY.
04 Cause-Code PIC S9(4) BINARY.
03 Case-Sev-Ctl PIC X.
03 Facility-ID PIC XXX.
02 I-S-Info PIC S9(9) BINARY.
01 INDXX PIC S9(9) BINARY.
01 NUMBER-OF-DAYS.
05 NUMBERS.
10 FILLER PIC S9(9) BINARY VALUE 80.
10 FILLER PIC S9(9) BINARY VALUE 20.
10 FILLER PIC S9(9) BINARY VALUE 10.
10 FILLER PIC S9(9) BINARY VALUE 5.
10 FILLER PIC S9(9) BINARY VALUE 4.
05 NUMBEROFDAYS REDEFINES NUMBERS
PIC S9(9) BINARY OCCURS 5 TIMES.
01 PICSTR.
02 Vstring-length PIC S9(4) BINARY.
02 Vstring-text.
03 Vstring-char PIC X,
OCCURS 0 TO 256 TIMES
DEPENDING ON Vstring-length
of PICSTR.
01 CHRDATE PIC X(80).
01 CURRENT-DATE.
02 Vstring-length PIC S9(4) BINARY.
02 Vstring-text.
03 Vstring-char PIC X
OCCURS 0 TO 256 TIMES
DEPENDING ON Vstring-length
of CURRENT-DATE.
01 INPUT-VARIABLES.
05 DATE-TABLE.
10 FILLER PIC X(9) VALUE "08/21/92".
10 FILLER PIC X(9) VALUE "11/29/92".
10 FILLER PIC X(9) VALUE "11/19/92".
10 FILLER PIC X(9) VALUE "11/04/92".
10 FILLER PIC X(9) VALUE "11/13/92".
05 CHKDATES REDEFINES DATE-TABLE PIC X(9)
OCCURS 5 TIMES.
01 CHK-WEEKDAYS.
05 DAY-TABLE.
10 FILLER PIC S9(9) BINARY VALUE 6.
10 FILLER PIC S9(9) BINARY VALUE 1.
10 FILLER PIC S9(9) BINARY VALUE 5.
10 FILLER PIC S9(9) BINARY VALUE 4.
10 FILLER PIC S9(9) BINARY VALUE 6.
05 CHKWEEKDAY REDEFINES DAY-TABLE PIC S9(9) BINARY
OCCURS 5 TIMES.
PROCEDURE DIVISION.
0001-BEGIN-PROCESSING.
DISPLAY "*** Example CE77DAT in motion"
* *********************************************************
* * The current date is converted to a Lilian date. *
* *********************************************************
MOVE 6 TO Vstring-length of PICSTR.
MOVE "YYMMDD" TO Vstring-text of PICSTR.
MOVE 6 TO Vstring-length of CURRENT-DATE.
MOVE "921109" TO Vstring-text of CURRENT-DATE.
* *********************************************************
* * Call CEEDAYS to return the Lilian days tally for the *
* * date value in the variable CURRENT-DATE. *
* *********************************************************
CALL "CEEDAYS" USING CURRENT-DATE, PICSTR,
CURRENT-LILIAN, FC.
IF NOT CEE000 THEN
DISPLAY "Error " Msg-No of FC
" in converting current date"
END-IF.
* *********************************************************
* * The datestamp mask must be changed for the dates *
* * being entered by the user. *
* *********************************************************
MOVE 8 TO Vstring-length of PICSTR.
MOVE "MM/DD/YY" TO Vstring-text of PICSTR.
* ***********************************************************
* * 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. *
* ***********************************************************
MOVE 1 TO INDXX.
PERFORM UNTIL INDXX = 6
IF (INDXX = 1 OR 4) THEN
COMPUTE DISPLACED-LILIAN =
CURRENT-LILIAN - NUMBEROFDAYS(INDXX)
ELSE
COMPUTE DISPLACED-LILIAN =
CURRENT-LILIAN + NUMBEROFDAYS(INDXX)
END-IF
* ****************************************************
* * Call CEEDATE to convert the Lilian dates to *
* * MM/DD/YY format. *
* ****************************************************
CALL "CEEDATE" USING DISPLACED-LILIAN, PICSTR,
CHRDATE, FC
IF CEE000 THEN
* ************************************************
* * Compare converted date to expected value *
* ************************************************
IF CHRDATE NOT = CHKDATES(INDXX) THEN
DISPLAY "Expecting returned date of "
CHKDATES(INDXX)
" for displacement of " NUMBEROFDAYS(INDXX)
", but got returned date of " CHRDATE
END-IF
* *****************************************************
* * Call CEEDYWK to return a day-of-the week value (1 *
* * thru 7) for each calculated Lilian date. Compare *
* * results to an array of expected values and issue *
* * an error message for any incorrect values. *
* *****************************************************
CALL "CEEDYWK" USING DISPLACED-LILIAN, WEEKDAY, FC
IF CEE000 THEN
IF WEEKDAY NOT = CHKWEEKDAY(INDXX) THEN
DISPLAY "Expecting day of week "
CHKWEEKDAY(INDXX) ", but got " WEEKDAY
" instead for " CHRDATE
END-IF
ELSE
DISPLAY "Error " Msg-No of FC
" in finding day-of-week"
END-IF
ELSE
DISPLAY "Error " Msg-No of FC
" converting date to Lilian date"
END-IF
ADD 1 TO INDXX
END-PERFORM.
DISPLAY "*** Example CE77DAT complete"
STOP RUN.