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