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
