IDENTIFICATION DIVISION.
PROGRAM-ID. DATETEST.
AUTHOR. MARTIN O SULLIVAN
INSTALLATION. MOYLISH.
DATE-WRITTEN. SEPTEMBER 1998.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBMAS400.
OBJECT-COMPUTER. IBMAS400.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 FULL-DATE-IN.
03 DAY-IN PIC X(2).
03 DELIM-1 PIC X.
88 VALID-DELIM-1 VALUE "/" ":".
03 MONTH-IN PIC X(2).
03 DELIM-2 PIC X.
88 VALID-DELIM-2 VALUE "/" ":".
03 YEAR-IN PIC X(4).
01 NUMERIC-DATE-IN REDEFINES FULL-DATE-IN.
03 N-DAY PIC 9(2).
03 FILLER PIC X.
03 N-MONTH PIC 9(2).
03 FILLER PIC X.
03 N-YEAR.
05 N-CENTURY PIC 9(2).
05 N-TENS-PART PIC 9(2).
88 CENTURY-YEAR VALUE 0.
01 SCRATCH-PAD.
03 QUOTIENT PIC 9(3).
03 LEAP PIC 9.
88 LEAP-YEAR VALUE 0.
03 MONTH-SUB PIC 9(2).
01 MESSAGES-ETC.
03 PROMPT-MESSAGE-00 PIC X(58)
VALUE " :*:*:*:*: DATE VALIDATION - PRESS ENTER TO RUN ".
03 PROMPT-MESSAGE-01 PIC X(58)
VALUE " OR - PRESS E OR e TO END".
03 PROMPT-MESSAGE-1 PIC X(58)
VALUE "PLEASE KEY IN A DATE IN THE FORM DD/MM/CCYY".
03 PROMPT-MESSAGE-2.
04 FILLER PIC X(19) VALUE SPACES.
04 FILLER PIC X(39)
VALUE "OR IN THE FORM DD:MM:CCYY".
03 VALID-DATE-MSG PIC X(58)
VALUE "STRING KEYED IS A VALID DATE".
03 DATE-NOT-VALID-MSG-1 PIC X(58)
VALUE "STRING IS NOT A VALID DATE".
03 DATE-NOT-VALID-MSG-2 PIC X(58)
VALUE "SEE PREVIOUS MESSAGES".
01 ERROR-MESSAGES.
03 NON-NUMERIC-ERROR PIC X(58)
VALUE "NON NUMERIC DATA INPUT.".
03 DELIM-ERROR PIC X(58)
VALUE "SEPARATOR CHARACTERS NOT VALID.".
03 MONTH-NUMBER-ERROR PIC X(58)
VALUE "MONTH NUMBER EXCEEDS 12 OR EQUALS ZERO.".
03 DAY-NUMBER-ERROR PIC X(58) VALUE
"NUMBER OF DAYS > VALID NUMBER OF DAYS OR EQUALS ZERO".
01 TABLES-FOR-CALC.
03 MONTH-DAY-VALUES.
05 FILLER PIC X(24)
VALUE "312831303130313130313031".
03 FILLER REDEFINES MONTH-DAY-VALUES.
05 DAYS-IN-MONTH PIC 9(2) OCCURS 12 TIMES.
01 FLAGS-ETC.
02 DATE-VALID-FLAG PIC X.
88 DATE-VALID VALUE "Y".
88 DATE-NOT-VALID VALUE "N".
02 OTHER-FLAGS.
03 NUMERIC-FLAG PIC X.
88 DATE-NUMERIC VALUE "Y".
88 DATE-NOT-NUMERIC VALUE "N".
03 MONTH-FLAG PIC X.
88 MONTH-VALID VALUE "Y".
88 MONTH-NOT-VALID VALUE "N".
03 DELIM-FLAG PIC X.
88 DELIMS-VALID VALUE "Y".
88 DELIMS-NOT-VALID VALUE "N".
03 DAY-FLAG PIC X.
88 DAY-VALID VALUE "Y".
88 DAY-NOT-VALID VALUE "N".
01 MISCELLANEOUS-FLAGS.
03 SCREEN-RESPONSE PIC X.
88 END-PROGRAM VALUE "E", "e".
PROCEDURE DIVISION.
TOP-CONTROL.
PERFORM START-UP.
PERFORM ASK-GO.
PERFORM WORK-ON-DATES.
PERFORM CLOSE-DOWN.
STOP RUN.
START-UP.
DISPLAY "GREETINGS - WELCOME TO DATE1 - PRESS ENTER".
ASK-GO.
DISPLAY PROMPT-MESSAGE-00.
DISPLAY PROMPT-MESSAGE-01.
ACCEPT SCREEN-RESPONSE.
WORK-ON-DATES.
PERFORM WORK-1-ASK-MORE
UNTIL END-PROGRAM.
CLOSE-DOWN.
DISPLAY "SIGNING OFF NOW....BYE PRESS ENTER".
WORK-1-ASK-MORE.
PERFORM INITIALISE-LOOP.
PERFORM WORK-1.
PERFORM ASK-GO.
INITIALISE-LOOP.
MOVE 28 TO DAYS-IN-MONTH(2).
SET DATE-VALID TO TRUE.
MOVE SPACES TO OTHER-FLAGS.
WORK-1.
PERFORM GET-DATE.
PERFORM VALIDATE-DATE.
PERFORM DISPLAY-OUTCOME.
GET-DATE.
DISPLAY PROMPT-MESSAGE-1, PROMPT-MESSAGE-2.
ACCEPT FULL-DATE-IN.
VALIDATE-DATE.
PERFORM VALIDATE-DELIMITERS.
PERFORM POSS-CHECK-NUMERIC-ETC.
DISPLAY-OUTCOME.
IF DATE-VALID
DISPLAY VALID-DATE-MSG
ELSE
DISPLAY DATE-NOT-VALID-MSG-1, DATE-NOT-VALID-MSG-2.
VALIDATE-DELIMITERS.
IF DELIM-1 = DELIM-2
IF VALID-DELIM-1 AND VALID-DELIM-2
SET DELIMS-VALID TO TRUE
ELSE
SET DELIMS-NOT-VALID TO TRUE
ELSE
SET DELIMS-NOT-VALID TO TRUE.
POSS-CHECK-NUMERIC-ETC.
IF DELIMS-VALID
PERFORM CHECK-NUMERIC-VALIDATE-MTH-DAY
ELSE
SET DATE-NOT-VALID TO TRUE
DISPLAY DELIM-ERROR.
CHECK-NUMERIC-VALIDATE-MTH-DAY.
PERFORM CHECK-FOR-NUMERIC.
PERFORM POSS-VALIDATE-MONTH-DAY.
CHECK-FOR-NUMERIC.
IF DAY-IN NOT NUMERIC
OR MONTH-IN NOT NUMERIC
OR YEAR-IN NOT NUMERIC
THEN
SET DATE-NOT-NUMERIC TO TRUE
ELSE
SET DATE-NUMERIC TO TRUE.
POSS-VALIDATE-MONTH-DAY.
IF DATE-NUMERIC
PERFORM VALIDATE-MONTH-DAY
ELSE
SET DATE-NOT-VALID TO TRUE
DISPLAY NON-NUMERIC-ERROR.
VALIDATE-MONTH-DAY.
PERFORM VALIDATE-MONTH.
PERFORM POSS-VALIDATE-DAY.
VALIDATE-MONTH.
IF N-MONTH > 12 OR = ZERO
SET MONTH-NOT-VALID TO TRUE
ELSE
SET MONTH-VALID TO TRUE.
POSS-VALIDATE-DAY.
IF MONTH-VALID
PERFORM CHECK-LEAP-VALIDATE-DAY
ELSE
SET DATE-NOT-VALID TO TRUE
DISPLAY MONTH-NUMBER-ERROR.
CHECK-LEAP-VALIDATE-DAY.
PERFORM LEAP-YEAR-CALCS.
PERFORM POSS-LEAP-YEAR.
PERFORM VALIDATE-DAY.
PERFORM POSS-VALID-DATE.
LEAP-YEAR-CALCS.
IF CENTURY-YEAR
PERFORM CENTURY-LEAP-CALCS
ELSE
PERFORM YEAR-LEAP-CALCS.
CENTURY-LEAP-CALCS.
DIVIDE N-CENTURY BY 4
GIVING QUOTIENT REMAINDER LEAP.
YEAR-LEAP-CALCS.
DIVIDE N-TENS-PART BY 4
GIVING QUOTIENT REMAINDER LEAP.
POSS-LEAP-YEAR.
IF LEAP-YEAR
MOVE 29 TO DAYS-IN-MONTH(2).
VALIDATE-DAY.
IF N-DAY > DAYS-IN-MONTH(N-MONTH)
OR N-DAY = ZERO
SET DAY-NOT-VALID TO TRUE
ELSE
SET DAY-VALID TO TRUE.
POSS-VALID-DATE.
IF DAY-VALID
SET DATE-VALID TO TRUE
ELSE
SET DATE-NOT-VALID TO TRUE
DISPLAY DAY-NUMBER-ERROR.
Link back to cobol page