Quellcode-Bibliothek

^© Kompilation durch diese Firma

[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]

Datei: dml170.cob Sprache: Cobol

Original von: verschiedene^©

* 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) ¤

Download des Quellennavigators
Download des sprechenden Kalenders
in der Quellcodebibliothek suchen

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.