|
* Post Cobclean
000010 ID DIVISION.
000020 PROGRAM-ID. TESTDATE.
000030*DATE-WRITTEN. 07/27/75.
000040 DATE-COMPILED. XX/XX/XX.
000050*AUTHOR. EMBARRASSED.
000060*REMARKS.
000070* THIS SUBROUTINES PURPOSE IS TO TEST THE
000080* VALIDITY OF AN INPUTED DATE
000090*
000100* THE CALL IS: CALL 'TESTDATE' USING
000110* DATE-TO-TEST, ERROR-FLAG.
000120*
000130* ERROR-FLAG IS SPACES OR '*' (IF IN ERROR)
000140*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
000150 ENVIRONMENT DIVISION.
000160*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
000170 CONFIGURATION SECTION.
000180*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
000190 DATA DIVISION.
000200*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
000210 WORKING-STORAGE SECTION.
000220 01 LEAP-TEST PIC 9.
000230 01 DUMMY PIC S99.
000240* -====-
000250 01 WS-DATE.
000260 05 WS-MONTH PIC 99.
000270 05 WS-DAY PIC 99.
000280 05 WS-YEAR PIC 99.
000290* -====-
000300 01 D-01.
000310 05 M-01 PIC 99 VALUE 31.
000320 05 M-02 PIC 99 VALUE 29.
000330 05 M-03 PIC 99 VALUE 31.
000340 05 M-04 PIC 99 VALUE 30.
000350 05 M-05 PIC 99 VALUE 31.
000360 05 M-06 PIC 99 VALUE 30.
000370 05 M-07 PIC 99 VALUE 31.
000380 05 M-08 PIC 99 VALUE 31.
000390 05 M-09 PIC 99 VALUE 30.
000400 05 M-10 PIC 99 VALUE 31.
000410 05 M-11 PIC 99 VALUE 30.
000420 05 M-12 PIC 99 VALUE 31.
000430* -====-
000440 01 DAY-IN-MONTH-TABLE REDEFINES D-01.
000450 05 MAXDAYS OCCURS 12 TIMES PIC 99.
000470*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
000480 LINKAGE SECTION.
000490 01 DATE-TO-TEST PIC X(6).
000500 01 ERROR-FLAG PIC X.
000510*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
000520 PROCEDURE DIVISION USING DATE-TO-TEST ERROR-FLAG.
000530* -====-
000540 0001-CLEAR-ERROR-FLAG.
000550 MOVE ' ' TO ERROR-FLAG.
000560* -====-
000570 0002-IS-DATE-NUMERIC.
000580 IF DATE-TO-TEST NOT NUMERIC
000590 GO TO 0004-RETURN-ERROR.
000600 MOVE DATE-TO-TEST TO WS-DATE.
000610 IF WS-MONTH < 1
000620 OR WS-MONTH > 12
000630 GO TO 0004-RETURN-ERROR.
000640*
000650 IF WS-DAY < 1
000660 OR WS-DAY > MAXDAYS (WS-MONTH)
000670 GO TO 0004-RETURN-ERROR.
000680*
000690 IF WS-MONTH = 2
000700 AND WS-DAY = 29
000710 DIVIDE WS-YEAR BY 4 GIVING DUMMY REMAINDER LEAP-TEST
000720 IF LEAP-TEST NOT = 0
000730 GO TO 0004-RETURN-ERROR.
000740* -====-
000750 0003-RETURN-NORMAL.
000760 GOBACK.
000770* -====-
000780 0004-RETURN-ERROR.
000790 MOVE '*' TO ERROR-FLAG.
000800 GOBACK.
¤ Dauer der Verarbeitung: 0.16 Sekunden
(vorverarbeitet)
¤
|
Haftungshinweis
Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.
Bemerkung:
Die farbliche Syntaxdarstellung ist noch experimentell.
|
