00001  IDENTIFICATION DIVISION.                                         08/24/98
00002  PROGRAM-ID.             DTSCU016                                 DTSCU016
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV004
00004  DATE-WRITTEN            NOVEMBER 1991.                           DTSCU016
00005  DATE-COMPILED.                                                   DTSCU016
00006      SKIP3                                                        DTSCU016
00007 *****                                                             DTSCU016
00008 *                                                                 DTSCU016
00009 *    FUNCTION:   YEAR/QUARTER FROM SCREEN FORMAT/EDIT             DTSCU016
00010 *                                                                 DTSCU016
00011 *                                                                 DTSCU016
00012 *    MODIFICATION LOG:                                            DTSCU016
00013 *                                                                 DTSCU016
00014 *    08/04/98    INITIAL DEVELOPMENT.  MODIFIED FROM MACCU016.       CL**2
00015 *                WORK ORDER:                 PROGRAMMER: ZL1.        CL**2
00016 *    XX/XX/XX    XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX     DTSCU016
00017 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX     DTSCU016
00018 *                WORK ORDER:                 PROGRAMMER:          DTSCU016
00019 *                                                                 DTSCU016
00020 *                                                                 DTSCU016
00021 *    DESCRIPTION:                                                 DTSCU016
00022 *                                                                 DTSCU016
00023 *****                                                             DTSCU016
00024  SKIP3                                                            DTSCU016
00025  ENVIRONMENT DIVISION.                                            DTSCU016
00026  DATA DIVISION.                                                   DTSCU016
00027  SKIP3                                                            DTSCU016
00028  WORKING-STORAGE SECTION.                                         DTSCU016
000285 77  PAN-VALET PICTURE X(24) VALUE '004DTSCU016  08/24/98'.       DTSCU016
00029  01  WRK-AREA.                                                    DTSCU016
00030      05  WRK-QTR-3-X.                                             DTSCU016
00031          10  WRK-QTR-3-YR                PIC  X(02).              DTSCU016
00032          10  WRK-QTR-3-Q                 PIC  X(01).              DTSCU016
00033  01  DTSIL004-COMM-AREA.                                             CL**2
00034  ++INCLUDE DTSIL004                                                  CL**3
00035  LINKAGE SECTION.                                                 DTSCU016
00036  01  DFHCOMMAREA.                                                 DTSCU016
00037  ++INCLUDE DTSIL016                                                  CL**3
00038  PROCEDURE DIVISION.                                              DTSCU016
00039      SKIP2                                                        DTSCU016
00040      IF L016-S-Q = SPACES OR LOW-VALUES                           DTSCU016
00041              AND                                                  DTSCU016
00042          L016-S-YR = SPACES OR LOW-VALUES                         DTSCU016
00043              SET L016-NO-ENTRY TO TRUE                               CL**2
00044              MOVE ZERO TO L016-YRQ                                DTSCU016
00045              GO TO INIT0199-GO-BACK.                              DTSCU016
00046      MOVE L016-S-Q TO WRK-QTR-3-Q.                                DTSCU016
00047      MOVE L016-S-YR TO WRK-QTR-3-YR.                              DTSCU016
00048      MOVE WRK-QTR-3-X TO L004-QTR-3-X.                            DTSCU016
00049      MOVE '2' TO L004-OPTION.                                     DTSCU016
00050      PERFORM S001-QTR THRU S001-EXIT.                             DTSCU016
00051      IF L004-VALID-QTR                                            DTSCU016
00052          MOVE L004-QTR-5-9 TO L016-YRQ                            DTSCU016
00053          SET L016-VALID TO TRUE                                      CL**2
00054      ELSE                                                         DTSCU016
00055          MOVE +0 TO L016-YRQ                                      DTSCU016
00056          SET L016-NOT-VALID TO TRUE.                                 CL**2
00057  INIT0199-GO-BACK.                                                DTSCU016
00058      EXEC CICS                                                    DTSCU016
00059          RETURN                                                   DTSCU016
00060      END-EXEC.                                                    DTSCU016
00061      GOBACK.                                                      DTSCU016
00062  S001-QTR.                                                        DTSCU016
00063      EXEC CICS                                                    DTSCU016
00064          LINK PROGRAM ('DTSCU004')                                   CL**2
00065          COMMAREA (DTSIL004-COMM-AREA)                               CL**2
00066      END-EXEC.                                                    DTSCU016
00067  S001-EXIT.                                                       DTSCU016
00068      EXIT.                                                        DTSCU016