79 lines
6.2 KiB
COBOL
79 lines
6.2 KiB
COBOL
00001 IDENTIFICATION DIVISION. 08/24/98
|
|
00002 PROGRAM-ID. DTSCU015 DTSCU015
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV006
|
|
00004 DATE-WRITTEN NOVEMBER 1991. DTSCU015
|
|
00005 DATE-COMPILED. DTSCU015
|
|
00006 SKIP3 DTSCU015
|
|
00007 ***** DTSCU015
|
|
00008 * DTSCU015
|
|
00009 * FUNCTION: DATE FROM SCREEN FORMAT/EDIT MODULE. DTSCU015
|
|
00010 * DTSCU015
|
|
00011 * DTSCU015
|
|
00012 * MODIFICATION LOG: DTSCU015
|
|
00013 * DTSCU015
|
|
00014 * 08/04/98 INITIAL DEVELOPMENT. MODIFIED FROM MACCU015. CL**2
|
|
00015 * WORK ORDER: PROGRAMMER: ZL1. CL**2
|
|
00016 * DTSCU015
|
|
00017 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU015
|
|
00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU015
|
|
00019 * WORK ORDER: PROGRAMMER: DTSCU015
|
|
00020 * DTSCU015
|
|
00021 * DTSCU015
|
|
00022 * DESCRIPTION: DTSCU015
|
|
00023 * DTSCU015
|
|
00024 ***** DTSCU015
|
|
00025 SKIP3 DTSCU015
|
|
00026 ENVIRONMENT DIVISION. DTSCU015
|
|
00027 DATA DIVISION. DTSCU015
|
|
00028 SKIP3 DTSCU015
|
|
00029 WORKING-STORAGE SECTION. DTSCU015
|
|
000295 77 PAN-VALET PICTURE X(24) VALUE '006DTSCU015 08/24/98'. DTSCU015
|
|
00030 01 WRK-AREA. DTSCU015
|
|
00031 05 WRK-CAL-6-DATE-X. DTSCU015
|
|
00032 10 WRK-CAL-6-MO PIC X(02). DTSCU015
|
|
00033 10 WRK-CAL-6-DA PIC X(02). DTSCU015
|
|
00034 10 WRK-CAL-6-YR PIC X(02). DTSCU015
|
|
00035 SKIP3 DTSCU015
|
|
00036 01 DTSIL001-COMM-AREA. CL**2
|
|
00037 ++INCLUDE DTSIL001 CL**3
|
|
00038 LINKAGE SECTION. DTSCU015
|
|
00039 01 DFHCOMMAREA. DTSCU015
|
|
00040 ++INCLUDE DTSIL015 CL**4
|
|
00041 PROCEDURE DIVISION. DTSCU015
|
|
00042 SKIP2 DTSCU015
|
|
00043 IF (L015-S-MO = SPACES OR LOW-VALUES) DTSCU015
|
|
00044 AND DTSCU015
|
|
00045 (L015-S-DA = SPACES OR LOW-VALUES) DTSCU015
|
|
00046 AND DTSCU015
|
|
00047 (L015-S-YR = SPACES OR LOW-VALUES) DTSCU015
|
|
00048 MOVE ZERO TO L015-DATE DTSCU015
|
|
00049 SET L015-NO-ENTRY TO TRUE CL**2
|
|
00050 GO TO INIT0199-GO-BACK. DTSCU015
|
|
00051 MOVE L015-S-MO TO WRK-CAL-6-MO. DTSCU015
|
|
00052 MOVE L015-S-DA TO WRK-CAL-6-DA. DTSCU015
|
|
00053 MOVE L015-S-YR TO WRK-CAL-6-YR. DTSCU015
|
|
00054 MOVE WRK-CAL-6-DATE-X TO L001-CAL-6-DATE-X. DTSCU015
|
|
00055 MOVE '4' TO L001-OPTION. DTSCU015
|
|
00056 PERFORM S001-DATE THRU S001-EXIT. DTSCU015
|
|
00057 MOVE L001-FED-8-DATE-9 TO L015-DATE. DTSCU015
|
|
00058 IF L001-INVALID-DATE DTSCU015
|
|
00059 MOVE +0 TO L015-DATE DTSCU015
|
|
00060 SET L015-NOT-VALID TO TRUE CL**2
|
|
00061 ELSE DTSCU015
|
|
00062 MOVE L001-FED-8-DATE-9 TO L015-DATE DTSCU015
|
|
00063 SET L015-VALID TO TRUE. CL**5
|
|
00064 SKIP2 DTSCU015
|
|
00065 INIT0199-GO-BACK. DTSCU015
|
|
00066 EXEC CICS DTSCU015
|
|
00067 RETURN DTSCU015
|
|
00068 END-EXEC. DTSCU015
|
|
00069 GOBACK. DTSCU015
|
|
00070 SKIP2 DTSCU015
|
|
00071 S001-DATE. DTSCU015
|
|
00072 EXEC CICS DTSCU015
|
|
00073 LINK PROGRAM ('DTSCU001') CL**2
|
|
00074 COMMAREA (DTSIL001-COMM-AREA) CL**2
|
|
00075 END-EXEC. DTSCU015
|
|
00076 S001-EXIT. DTSCU015
|
|
00077 EXIT. DTSCU015
|