00001 IDENTIFICATION DIVISION. 08/05/98 00002 PROGRAM-ID. DTSBU002. DTSBU002 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV003 00004 DATE-WRITTEN. NOVEMBER 1991. DTSBU002 00005 DATE-COMPILED. DTSBU002 00006 SKIP3 DTSBU002 00007 ***** DTSBU002 00008 * DTSBU002 00009 * FUNCTION: DISPLAY DATE IN TEXT FORMAT. DTSBU002 00010 * DTSBU002 00011 * DTSBU002 00012 * MODIFICATION LOG: DTSBU002 00013 * DTSBU002 00014 * 08/04/98 CLONED FROM MACCU002. CL**2 00015 * WORK ORDER: PROGRAMMER: ZL1 CL**2 00016 * DTSBU002 00017 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU002 00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU002 00019 * WORK ORDER: PROGRAMMER: DTSBU002 00020 * DTSBU002 00021 * DTSBU002 00022 * DESCRIPTION: DTSBU002 00023 * DTSBU002 00024 * DTSBU002 IS PASSED L002-OPTION, AND L002-DATE. DTSBU002 CL**2 00025 * RETURNS L002-LONG-TEXT-CNT, L002-LONG-TEXT-AREA, DTSBU002 00026 * L002-SHORT-TEXT-CNT, AND L002-SHORT-TEXT-AREA. DTSBU002 00027 * DTSBU002 00028 * IF L002-OPTION IS NOT A VALID OPTION OR L002-DATE IS NOT A DTSBU002 00029 * VALID DATE, THEN ABEND DTSBU002 WITH ABEND CODE +002. CL**2 00030 * DTSBU002 00031 * EXAMPLE OF USE: DTSBU002 00032 * DTSBU002 00033 * IF L002-UPPER-CASE AND L002-DATE = 19911203, THEN DTSBU002 00034 * RETURN L002-LONG-TEXT-CNT = 16 AND L002-LONG-TEXT-AREA = DTSBU002 00035 * 'DECEMBER 3, 1991' AND L002-SHORT-TEXT-CNT = 11 AND DTSBU002 00036 * L002-SHORT-TEXT-AREA = 'DEC 3, 1991' DTSBU002 00037 * DTSBU002 00038 * SET THE SPF EDITOR TO "CAPS OFF" AND THE SCREEN DISPLAY TO DTSBU002 00039 * MIXED MODE ("Aa") WHEN EDITING THIS MODULE. DTSBU002 00040 ***** DTSBU002 00041 SKIP3 DTSBU002 00042 ENVIRONMENT DIVISION. DTSBU002 00043 SKIP3 DTSBU002 00044 DATA DIVISION. DTSBU002 00045 SKIP3 DTSBU002 00046 WORKING-STORAGE SECTION. DTSBU002 000465 77 PAN-VALET PICTURE X(24) VALUE '003DTSBU002 08/05/98'. DTSBU002 00047 SKIP3 DTSBU002 00048 01 WRK-AREA. DTSBU002 00049 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +002. DTSBU002 00050 05 LONG-SUB PIC S9(04) COMP. DTSBU002 00051 05 SHORT-SUB PIC S9(04) COMP. DTSBU002 00052 05 WRK-DAY. DTSBU002 00053 10 WRK-DAY-1 PIC X(01). DTSBU002 00054 10 WRK-DAY-2 PIC X(01). DTSBU002 00055 01 LONG-DATE PIC X(18). DTSBU002 00056 01 SHORT-DATE PIC X(12). DTSBU002 00057 SKIP1 DTSBU002 00058 01 MONTH-TABLE-1. DTSBU002 00059 05 FILLER PIC X(09) VALUE 'JANUARY '. DTSBU002 00060 05 FILLER PIC X(09) VALUE 'FEBRUARY '. DTSBU002 00061 05 FILLER PIC X(09) VALUE 'MARCH '. DTSBU002 00062 05 FILLER PIC X(09) VALUE 'APRIL '. DTSBU002 00063 05 FILLER PIC X(09) VALUE 'MAY '. DTSBU002 00064 05 FILLER PIC X(09) VALUE 'JUNE '. DTSBU002 00065 05 FILLER PIC X(09) VALUE 'JULY '. DTSBU002 00066 05 FILLER PIC X(09) VALUE 'AUGUST '. DTSBU002 00067 05 FILLER PIC X(09) VALUE 'SEPTEMBER'. DTSBU002 00068 05 FILLER PIC X(09) VALUE 'OCTOBER '. DTSBU002 00069 05 FILLER PIC X(09) VALUE 'NOVEMBER '. DTSBU002 00070 05 FILLER PIC X(09) VALUE 'DECEMBER '. DTSBU002 00071 01 FILLER REDEFINES MONTH-TABLE-1. DTSBU002 00072 05 FILLER OCCURS 12. DTSBU002 00073 10 MONTH-NAME-1. DTSBU002 00074 15 MONTH-NAME-1-SHORT PIC X(03). DTSBU002 00075 15 FILLER PIC X(06). DTSBU002 00076 SKIP1 DTSBU002 00077 01 MONTH-TABLE-2. DTSBU002 00078 05 FILLER PIC X(09) VALUE 'January '. DTSBU002 00079 05 FILLER PIC X(09) VALUE 'February '. DTSBU002 00080 05 FILLER PIC X(09) VALUE 'March '. DTSBU002 00081 05 FILLER PIC X(09) VALUE 'April '. DTSBU002 00082 05 FILLER PIC X(09) VALUE 'May '. DTSBU002 00083 05 FILLER PIC X(09) VALUE 'June '. DTSBU002 00084 05 FILLER PIC X(09) VALUE 'July '. DTSBU002 00085 05 FILLER PIC X(09) VALUE 'August '. DTSBU002 00086 05 FILLER PIC X(09) VALUE 'September'. DTSBU002 00087 05 FILLER PIC X(09) VALUE 'October '. DTSBU002 00088 05 FILLER PIC X(09) VALUE 'November '. DTSBU002 00089 05 FILLER PIC X(09) VALUE 'December '. DTSBU002 00090 01 FILLER REDEFINES MONTH-TABLE-2. DTSBU002 00091 05 FILLER OCCURS 12. DTSBU002 00092 10 MONTH-NAME-2. DTSBU002 00093 15 MONTH-NAME-2-SHORT PIC X(03). DTSBU002 00094 15 FILLER PIC X(06). DTSBU002 00095 SKIP1 DTSBU002 00096 01 MONTH-TABLE-LENGTH. DTSBU002 00097 05 LENGTH-JANUARY PIC S9(04) COMP VALUE +7. DTSBU002 00098 05 LENGTH-FEBRUARY PIC S9(04) COMP VALUE +8. DTSBU002 00099 05 LENGTH-MARCH PIC S9(04) COMP VALUE +5. DTSBU002 00100 05 LENGTH-APRIL PIC S9(04) COMP VALUE +5. DTSBU002 00101 05 LENGTH-MAY PIC S9(04) COMP VALUE +3. DTSBU002 00102 05 LENGTH-JUNE PIC S9(04) COMP VALUE +4. DTSBU002 00103 05 LENGTH-JULY PIC S9(04) COMP VALUE +4. DTSBU002 00104 05 LENGTH-AUGUST PIC S9(04) COMP VALUE +6. DTSBU002 00105 05 LENGTH-SEPTEMBER PIC S9(04) COMP VALUE +9. DTSBU002 00106 05 LENGTH-OCTOBER PIC S9(04) COMP VALUE +7. DTSBU002 00107 05 LENGTH-NOVEMBER PIC S9(04) COMP VALUE +8. DTSBU002 00108 05 LENGTH-DECEMBER PIC S9(04) COMP VALUE +8. DTSBU002 00109 01 FILLER REDEFINES MONTH-TABLE-LENGTH. DTSBU002 00110 05 MONTH-NAME-LENGTH OCCURS 12 TIMES PIC S9(04) COMP. DTSBU002 00111 EJECT DTSBU002 00112 01 L001-LINK-AREA. DTSBU002 00113 ++INCLUDE DTSIL001 CL**3 00114 EJECT DTSBU002 00115 LINKAGE SECTION. DTSBU002 00116 SKIP3 DTSBU002 00117 01 L002-LINK-AREA. DTSBU002 00118 ++INCLUDE DTSIL002 CL**3 00119 EJECT DTSBU002 00120 PROCEDURE DIVISION DTSBU002 00121 USING L002-LINK-AREA. DTSBU002 00122 SKIP2 DTSBU002 00123 PERFORM P1000-PROCESS THRU CL**2 00124 P1000-PROCESS-EXIT. CL**2 00125 SKIP2 DTSBU002 00126 GOBACK. DTSBU002 00127 EJECT DTSBU002 00128 P1000-PROCESS. DTSBU002 00129 SKIP1 DTSBU002 00130 MOVE '1' TO L001-OPTION. DTSBU002 00131 MOVE L002-DATE TO L001-FED-8-DATE-9. DTSBU002 00132 PERFORM S001-LINK-DATE THRU CL**2 00133 S001-LINK-DATE-EXIT. CL**2 00134 IF L001-INVALID-DATE DTSBU002 00135 PERFORM S999-ABEND THRU S999-ABEND-EXIT. CL**2 00136 SKIP1 DTSBU002 00137 IF L002-UPPER-CASE DTSBU002 00138 MOVE MONTH-NAME-1 (L001-FED-8-MO) TO LONG-DATE DTSBU002 00139 MOVE MONTH-NAME-1-SHORT (L001-FED-8-MO) TO SHORT-DATE DTSBU002 00140 ELSE DTSBU002 00141 IF L002-MIXED-CASE DTSBU002 00142 MOVE MONTH-NAME-2 (L001-FED-8-MO) TO LONG-DATE DTSBU002 00143 MOVE MONTH-NAME-2-SHORT (L001-FED-8-MO) TO SHORT-DATE DTSBU002 00144 ELSE DTSBU002 00145 PERFORM S999-ABEND THRU S999-ABEND-EXIT. CL**2 00146 SKIP1 DTSBU002 00147 PERFORM P1100-DAY-AND-YEAR THRU CL**2 00148 P1100-DAY-AND-YEAR-EXIT. CL**2 00149 SKIP1 DTSBU002 00150 MOVE LONG-DATE TO L002-LONG-TEXT-AREA. DTSBU002 00151 ADD LONG-SUB, 5 GIVING L002-LONG-TEXT-CNT. DTSBU002 00152 MOVE SHORT-DATE TO L002-SHORT-TEXT-AREA. DTSBU002 00153 ADD SHORT-SUB, 5 GIVING L002-SHORT-TEXT-CNT. DTSBU002 00154 SKIP1 DTSBU002 00155 P1000-PROCESS-EXIT. CL**2 00156 EXIT. DTSBU002 00157 EJECT DTSBU002 00158 P1100-DAY-AND-YEAR. DTSBU002 00159 ADD MONTH-NAME-LENGTH (L001-FED-8-MO), 2 GIVING LONG-SUB. DTSBU002 00160 MOVE +5 TO SHORT-SUB. DTSBU002 00161 SKIP1 DTSBU002 00162 MOVE L001-FED-8-DA TO WRK-DAY. DTSBU002 00163 IF WRK-DAY-1 NOT = '0' DTSBU002 00164 MOVE WRK-DAY-1 TO LONG-DATE (LONG-SUB : 1) DTSBU002 00165 SHORT-DATE (SHORT-SUB : 1) DTSBU002 00166 ADD +1 TO LONG-SUB DTSBU002 00167 SHORT-SUB. DTSBU002 00168 MOVE WRK-DAY-2 TO LONG-DATE (LONG-SUB : 1) DTSBU002 00169 SHORT-DATE (SHORT-SUB : 1) DTSBU002 00170 SKIP1 DTSBU002 00171 ADD +1 TO LONG-SUB DTSBU002 00172 SHORT-SUB. DTSBU002 00173 MOVE ',' TO LONG-DATE (LONG-SUB : 1) DTSBU002 00174 SHORT-DATE (SHORT-SUB : 1). DTSBU002 00175 MOVE L001-FED-8-YR TO LONG-DATE (LONG-SUB + 2 : 4) DTSBU002 00176 SHORT-DATE (SHORT-SUB + 2 : 4). DTSBU002 00177 SKIP1 DTSBU002 00178 P1100-DAY-AND-YEAR-EXIT. EXIT. CL**2 00179 EJECT DTSBU002 00180 S001-LINK-DATE. DTSBU002 00181 SKIP1 DTSBU002 00182 CALL 'DTSBU001' CL**2 00183 USING L001-LINK-AREA. DTSBU002 00184 SKIP1 DTSBU002 00185 S001-LINK-DATE-EXIT. EXIT. CL**2 00186 EJECT DTSBU002 00187 S999-ABEND. DTSBU002 00188 SKIP1 DTSBU002 00189 CALL 'DTSBU999' CL**2 00190 USING WRK-ABEND-CD. DTSBU002 00191 SKIP1 DTSBU002 00192 S999-ABEND-EXIT. EXIT. CL**2