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