00001  IDENTIFICATION DIVISION.                                         10/06/99
00002  PROGRAM-ID.             DTSCU007                                 DTSCU007
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV005
00004  DATE-WRITTEN            NOVEMBER 1991.                           DTSCU007
00005  DATE-COMPILED.                                                   DTSCU007
00006      SKIP3                                                        DTSCU007
00007 *****                                                             DTSCU007
00008 *                                                                 DTSCU007
00009 *    FUNCTION:   AUDIT YEAR / EDIT CONVERSION                     DTSCU007
00010 *                                                                 DTSCU007
00011 *                                                                 DTSCU007
00012 *    MODIFICATION LOG:                                            DTSCU007
00013 *                                                                 DTSCU007
00014 *    08/03/98    INITIAL DEVELOPMENT. MODIFIED FROM MACCU007.        CL**2
00015 *                WORK ORDER:                 PROGRAMMER: ZL1.        CL**2
00016 *                                                                 DTSCU007
00017 *                                                                 DTSCU007
00018 *    XX/XX/XX    XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX     DTSCU007
00019 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX     DTSCU007
00020 *                WORK ORDER:                 PROGRAMMER:          DTSCU007
00021 *                                                                 DTSCU007
00022 *                                                                 DTSCU007
00023 *    DESCRIPTION:                                                 DTSCU007
00024 *                                                                 DTSCU007
00025 *****                                                             DTSCU007
00026  SKIP3                                                            DTSCU007
00027  ENVIRONMENT DIVISION.                                            DTSCU007
00028  DATA DIVISION.                                                   DTSCU007
00029  SKIP3                                                            DTSCU007
00030  WORKING-STORAGE SECTION.                                         DTSCU007
000305 77  PAN-VALET PICTURE X(24) VALUE '005DTSCU007  10/06/99'.       DTSCU007
00031  01  WRK-AREA.                                                    DTSCU007
00032      05  WS-ABEND-CODE                       PIC  X(04)           DTSCU007
00033                                                  VALUE 'U007'.    DTSCU007
00034      05  WS-YEAR-APART.                                              CL**3
00035          10  WS-CENTURY                      PIC  9(02).          DTSCU007
00036          10  WS-YR                           PIC  9(02).          DTSCU007
00037      05  WS-START-YRQ-X.                                          DTSCU007
00038          10  WS-START-YR                     PIC  9(04).          DTSCU007
00039          10  WS-START-Q                      PIC  9(01)           DTSCU007
00040                                                  VALUE 1.         DTSCU007
00041      05  WS-START-YRQ-9 REDEFINES WS-START-YRQ-X                  DTSCU007
00042                                              PIC  9(05).          DTSCU007
00043      05  WS-END-YRQ-X.                                            DTSCU007
00044          10  WS-END-YR                       PIC  9(04).          DTSCU007
00045          10  WS-END-Q                        PIC  9(01)           DTSCU007
00046                                                  VALUE 4.         DTSCU007
00047      05  WS-END-YRQ-9 REDEFINES WS-END-YRQ-X                      DTSCU007
00048                                              PIC  9(05).          DTSCU007
00049  LINKAGE SECTION.                                                 DTSCU007
00050  01  DFHCOMMAREA.                                                 DTSCU007
00051  ++INCLUDE DTSIL007                                                  CL**2
00052  PROCEDURE DIVISION.                                              DTSCU007
00053      SKIP2                                                        DTSCU007
00054      SET L007-VALID-YR TO TRUE.                                      CL**5
00055      SKIP2                                                           CL**5
00056      IF L007-FROM-YR-4                                            DTSCU007
00057          PERFORM PROC100-FROM-YR-4 THRU                              CL**3
00058                  PROC100-FROM-YR-4-EXIT                              CL**3
00059      ELSE                                                         DTSCU007
00060      IF L007-FROM-YR-2                                            DTSCU007
00061          PERFORM PROC200-FROM-YR-2 THRU                              CL**3
00062                  PROC200-FROM-YR-2-EXIT                              CL**3
00063      ELSE                                                         DTSCU007
00064        EXEC CICS ABEND ABCODE (WS-ABEND-CODE) END-EXEC.              CL**3
00065                                                                      CL**4
00066      IF L007-NOT-VALID-YR                                            CL**4
00067         GO TO INIT0199-GOBACK.                                       CL**4
00068                                                                      CL**4
00069      MOVE L007-YR-4-9 TO                                             CL**4
00070                       WS-START-YR                                    CL**4
00071                       WS-END-YR                                      CL**4
00072      MOVE WS-START-YRQ-9 TO L007-START-YRQ                           CL**4
00073      MOVE WS-END-YRQ-9 TO L007-END-YRQ                               CL**4
00074      SET L007-VALID-YR TO TRUE.                                      CL**4
00075  INIT0199-GOBACK.                                                 DTSCU007
00076      EXEC CICS                                                    DTSCU007
00077          RETURN                                                   DTSCU007
00078      END-EXEC.                                                    DTSCU007
00079  PROC100-FROM-YR-4.                                               DTSCU007
00080      IF L007-YR-4-9 NOT NUMERIC  OR                                  CL**3
00081         L007-YR-4-9 < 1930 OR                                        CL**3
00082         L007-YR-4-9 > 2029                                           CL**3
00083         SET L007-NOT-VALID-YR TO TRUE                                CL**3
00084         GO TO PROC100-FROM-YR-4-EXIT.                                CL**3
00085      SKIP2                                                        DTSCU007
00086      MOVE L007-YR-4-9 TO WS-YEAR-APART.                           DTSCU007
00087      MOVE WS-YR TO L007-YR-2-9.                                   DTSCU007
00088  PROC100-FROM-YR-4-EXIT.  EXIT.                                      CL**3
00089      SKIP2                                                        DTSCU007
00090  PROC200-FROM-YR-2.                                               DTSCU007
00091      IF L007-YR-2-9 NOT NUMERIC                                   DTSCU007
00092          SET L007-NOT-VALID-YR TO TRUE                               CL**3
00093          GO TO PROC200-FROM-YR-2-EXIT.                               CL**3
00094      IF L007-YR-2-9 < 30                                          DTSCU007
00095          ADD L007-YR-2-9 2000 GIVING L007-YR-4-9                  DTSCU007
00096      ELSE                                                         DTSCU007
00097          ADD L007-YR-2-9 1900 GIVING L007-YR-4-9.                 DTSCU007
00098  PROC200-FROM-YR-2-EXIT.  EXIT.                                      CL**3
