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