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