CEEQCEN: query the century window

CEEQCEN queries the century window, which is a two-digit year value.

When you want to change the century window, use CEEQCEN to get the setting and then use CEESCEN to save and restore the current setting.

CALL CEEQCEN syntax

Read syntax diagramSkip visual syntax diagramCALL"CEEQCEN"USINGcentury_start,fc.
century_start (output)
An integer between 0 and 100 that indicates the year on which the century window is based.

For example, if the date and time callable services default is in effect, all two-digit years lie within the 100-year window that starts 80 years before the system date. CEEQCEN then returns the value 80. For example, in the year 2010, 80 indicates that all two-digit years lie within the 100-year window between 1930 and 2029, inclusive.

fc (output)
A 12-byte feedback code (optional) that indicates the result of this service.
Table 1. CEEQCEN symbolic conditions
Symbolic feedback code Severity Message number Message text
CEE000 0 -- The service completed successfully.

Example


*************************************************
**                                             **
** Function: Call CEEQCEN to query the         **
**           date and time callable services   **
**           century window                    **
**                                             **
** In this example, CEEQCEN is called to query **
** the date at which the century window starts **
** The century window is the 100-year window   **
** within which the date and time callable     **
** services assume all two-digit years lie.    **
**                                             **
*************************************************
 IDENTIFICATION DIVISION.
 PROGRAM-ID. CBLQCEN.

 DATA DIVISION.
 WORKING-STORAGE SECTION.
 01  STARTCW                 PIC S9(9) BINARY.
 01  FC.
     02  Condition-Token-Value.
     COPY  CEEIGZCT.
         03  Case-1-Condition-ID.
             04  Severity    PIC S9(4) COMP.
             04  Msg-No      PIC S9(4) COMP.
         03  Case-2-Condition-ID
                   REDEFINES Case-1-Condition-ID.
             04  Class-Code  PIC S9(4) COMP.
             04  Cause-Code  PIC S9(4) COMP.
         03  Case-Sev-Ctl    PIC X.
         03  Facility-ID     PIC XXX.
     02  I-S-Info            PIC S9(9) COMP.
 PROCEDURE DIVISION.

 PARA-CBLQCEN.
*************************************************
** Call CEEQCEN to return the start of the     **
**     century window                          **
*************************************************

     CALL 'CEEQCEN' USING STARTCW, FC.
*************************************************
** CEEQCEN has no nonzero feedback codes to    **
**     check, so just display result.          **
*************************************************
     IF CEE000 of FC  THEN
         DISPLAY 'The start of the century '
             'window is: ' STARTCW
     ELSE
         DISPLAY 'CEEQCEN failed with msg '
             Msg-No of FC UPON CONSOLE
         STOP RUN
     END-IF.

     GOBACK.