00001 IDENTIFICATION DIVISION. 09/29/98 00002 PROGRAM-ID. DTSBU008. DTSBU008 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV005 00004 DATE-WRITTEN. JULY 1994. DTSBU008 00005 DATE-COMPILED. DTSBU008 00006 SKIP3 DTSBU008 00007 ***** DTSBU008 00008 * DTSBU008 00009 * FUNCTION: DISPLAY QUARTER IN TEXT FORMAT. DTSBU008 00010 * DTSBU008 00011 * DTSBU008 00012 * MODIFICATION LOG: DTSBU008 00013 * DTSBU008 00014 * 08/04/98 CLONED FROM MACCU008. CL**2 00015 * WORK ORDER: PROGRAMMER: ZL1 CL**2 00016 * DTSBU008 00017 * DTSBU008 00018 * DESCRIPTION: DTSBU008 00019 * DTSBU008 00020 * DTSBU008 IS PASSED L008-OPTION, AND L008-YRQ. DTSBU008 CL**2 00021 * RETURNS L008-LONG-MONTHS, L008-SHORT-MONTHS, AND L008-YEAR. DTSBU008 00022 * DTSBU008 00023 * IF L008-OPTION IS NOT A VALID OPTION OR L008-YRQ IS NOT A DTSBU008 00024 * VALID QUARTER, THEN ABEND DTSBU008 WITH ABEND CODE 'U008'. CL**2 00025 * DTSBU008 00026 * EXAMPLE OF USE: SEE COMMENTS IN DTSIL008. CL**2 00027 * DTSBU008 00028 * ---------------------------------------------------------- DTSBU008 00029 * SET THE SPF EDITOR TO "CAPS OFF" AND THE SCREEN DISPLAY TO DTSBU008 00030 * MIXED MODE ("Aa") WHEN EDITING THIS MODULE. DTSBU008 00031 * ---------------------------------------------------------- DTSBU008 00032 * DTSBU008 00033 ***** DTSBU008 00034 SKIP3 DTSBU008 00035 ENVIRONMENT DIVISION. DTSBU008 00036 SKIP3 DTSBU008 00037 DATA DIVISION. DTSBU008 00038 SKIP3 DTSBU008 00039 WORKING-STORAGE SECTION. DTSBU008 000395 77 PAN-VALET PICTURE X(24) VALUE '005DTSBU008 09/29/98'. DTSBU008 00040 SKIP3 DTSBU008 00041 01 WRK-AREA. DTSBU008 00042 05 WRK-ABEND-CD PIC S9(04) COMP DTSBU008 00043 VALUE +008. DTSBU008 00044 CL**5 00045 05 MONTH-SUB PIC S9(04) COMP. DTSBU008 00046 CL**4 00047 01 MONTH-TABLE-1. DTSBU008 00048 05 FILLER PIC X(09) VALUE 'JANUARY '. DTSBU008 00049 05 FILLER PIC X(09) VALUE 'FEBRUARY '. DTSBU008 00050 05 FILLER PIC X(09) VALUE 'MARCH '. DTSBU008 00051 05 FILLER PIC X(09) VALUE 'APRIL '. DTSBU008 00052 05 FILLER PIC X(09) VALUE 'MAY '. DTSBU008 00053 05 FILLER PIC X(09) VALUE 'JUNE '. DTSBU008 00054 05 FILLER PIC X(09) VALUE 'JULY '. DTSBU008 00055 05 FILLER PIC X(09) VALUE 'AUGUST '. DTSBU008 00056 05 FILLER PIC X(09) VALUE 'SEPTEMBER'. DTSBU008 00057 05 FILLER PIC X(09) VALUE 'OCTOBER '. DTSBU008 00058 05 FILLER PIC X(09) VALUE 'NOVEMBER '. DTSBU008 00059 05 FILLER PIC X(09) VALUE 'DECEMBER '. DTSBU008 00060 01 FILLER REDEFINES MONTH-TABLE-1. DTSBU008 00061 05 FILLER OCCURS 12. DTSBU008 00062 10 MONTH-NAME-1. DTSBU008 00063 15 MONTH-NAME-1-SHORT PIC X(03). DTSBU008 00064 15 FILLER PIC X(06). DTSBU008 00065 CL**4 00066 01 MONTH-TABLE-2. DTSBU008 00067 05 FILLER PIC X(09) VALUE 'January '. CL**4 00068 05 FILLER PIC X(09) VALUE 'February '. DTSBU008 00069 05 FILLER PIC X(09) VALUE 'March '. DTSBU008 00070 05 FILLER PIC X(09) VALUE 'April '. DTSBU008 00071 05 FILLER PIC X(09) VALUE 'May '. DTSBU008 00072 05 FILLER PIC X(09) VALUE 'June '. DTSBU008 00073 05 FILLER PIC X(09) VALUE 'July '. DTSBU008 00074 05 FILLER PIC X(09) VALUE 'August '. DTSBU008 00075 05 FILLER PIC X(09) VALUE 'September'. DTSBU008 00076 05 FILLER PIC X(09) VALUE 'October '. DTSBU008 00077 05 FILLER PIC X(09) VALUE 'November '. DTSBU008 00078 05 FILLER PIC X(09) VALUE 'December '. DTSBU008 00079 01 FILLER REDEFINES MONTH-TABLE-2. DTSBU008 00080 05 FILLER OCCURS 12. DTSBU008 00081 10 MONTH-NAME-2. DTSBU008 00082 15 MONTH-NAME-2-SHORT PIC X(03). DTSBU008 00083 15 FILLER PIC X(06). DTSBU008 00084 CL**4 00085 01 DSCR-TABLE-1. DTSBU008 00086 05 FILLER PIC X(09) VALUE '1STFIRST '. DTSBU008 00087 05 FILLER PIC X(09) VALUE '2NDSECOND'. DTSBU008 00088 05 FILLER PIC X(09) VALUE '3RDTHIRD '. DTSBU008 00089 05 FILLER PIC X(09) VALUE '4THFOURTH'. DTSBU008 00090 01 FILLER REDEFINES DSCR-TABLE-1. DTSBU008 00091 05 FILLER OCCURS 4. DTSBU008 00092 10 SHORT-DSCR-1 PIC X(03). DTSBU008 00093 10 LONG-DSCR-1 PIC X(06). DTSBU008 00094 CL**4 00095 01 DSCR-TABLE-2. DTSBU008 00096 05 FILLER PIC X(09) VALUE '1stFirst '. DTSBU008 00097 05 FILLER PIC X(09) VALUE '2ndSecond'. DTSBU008 00098 05 FILLER PIC X(09) VALUE '3rdThird '. DTSBU008 00099 05 FILLER PIC X(09) VALUE '4thFourth'. DTSBU008 00100 01 FILLER REDEFINES DSCR-TABLE-2. DTSBU008 00101 05 FILLER OCCURS 4. DTSBU008 00102 10 SHORT-DSCR-2 PIC X(03). DTSBU008 00103 10 LONG-DSCR-2 PIC X(06). DTSBU008 00104 CL**4 00105 01 L004-LINK-AREA. DTSBU008 00106 ++INCLUDE DTSIL004 CL**3 00107 EJECT DTSBU008 00108 LINKAGE SECTION. DTSBU008 00109 SKIP3 DTSBU008 00110 01 L008-LINK-AREA. DTSBU008 00111 ++INCLUDE DTSIL008 CL**3 00112 EJECT DTSBU008 00113 PROCEDURE DIVISION DTSBU008 00114 USING L008-LINK-AREA. DTSBU008 00115 SKIP2 DTSBU008 00116 PERFORM P1000-PROCESS THRU P1000-PROCESS-EXIT. CL**2 00117 SKIP2 DTSBU008 00118 GOBACK. DTSBU008 00119 EJECT DTSBU008 00120 P1000-PROCESS. DTSBU008 00121 CL**4 00122 SET L004-FROM-5 TO TRUE. DTSBU008 00123 MOVE L008-YRQ TO L004-QTR-5-9. DTSBU008 00124 PERFORM S004-LINK-QUARTER THRU CL**2 00125 S004-LINK-QUARTER-EXIT. CL**2 00126 IF L004-INVALID-QTR DTSBU008 00127 PERFORM S999-ABEND THRU S999-ABEND-EXIT. CL**2 00128 CL**4 00129 COMPUTE MONTH-SUB = (L004-QTR-5-Q * 3) - 2 DTSBU008 00130 CL**4 00131 IF L008-UPPER-CASE DTSBU008 00132 MOVE MONTH-NAME-1 (MONTH-SUB) TO L008-LONG-MONTH-1 DTSBU008 00133 MOVE MONTH-NAME-1-SHORT (MONTH-SUB) TO L008-SHORT-MONTH-1DTSBU008 00134 ADD +1 TO MONTH-SUB DTSBU008 00135 MOVE MONTH-NAME-1 (MONTH-SUB) TO L008-LONG-MONTH-2 DTSBU008 00136 MOVE MONTH-NAME-1-SHORT (MONTH-SUB) TO L008-SHORT-MONTH-2DTSBU008 00137 ADD +1 TO MONTH-SUB DTSBU008 00138 MOVE MONTH-NAME-1 (MONTH-SUB) TO L008-LONG-MONTH-3 DTSBU008 00139 MOVE MONTH-NAME-1-SHORT (MONTH-SUB) TO L008-SHORT-MONTH-3DTSBU008 00140 MOVE SHORT-DSCR-1 (L004-QTR-5-Q) TO L008-SHORT-DSCR DTSBU008 00141 MOVE LONG-DSCR-1 (L004-QTR-5-Q) TO L008-LONG-DSCR DTSBU008 00142 ELSE DTSBU008 00143 IF L008-MIXED-CASE DTSBU008 00144 MOVE MONTH-NAME-2 (MONTH-SUB) TO L008-LONG-MONTH-1 DTSBU008 00145 MOVE MONTH-NAME-2-SHORT (MONTH-SUB) TO L008-SHORT-MONTH-1DTSBU008 00146 ADD +1 TO MONTH-SUB DTSBU008 00147 MOVE MONTH-NAME-2 (MONTH-SUB) TO L008-LONG-MONTH-2 DTSBU008 00148 MOVE MONTH-NAME-2-SHORT (MONTH-SUB) TO L008-SHORT-MONTH-2DTSBU008 00149 ADD +1 TO MONTH-SUB DTSBU008 00150 MOVE MONTH-NAME-2 (MONTH-SUB) TO L008-LONG-MONTH-3 DTSBU008 00151 MOVE MONTH-NAME-2-SHORT (MONTH-SUB) TO L008-SHORT-MONTH-3DTSBU008 00152 MOVE SHORT-DSCR-2 (L004-QTR-5-Q) TO L008-SHORT-DSCR DTSBU008 00153 MOVE LONG-DSCR-2 (L004-QTR-5-Q) TO L008-LONG-DSCR DTSBU008 00154 ELSE DTSBU008 00155 PERFORM S999-ABEND THRU S999-ABEND-EXIT. CL**2 00156 CL**4 00157 MOVE L004-QTR-5-YR TO L008-YEAR. DTSBU008 00158 P1000-PROCESS-EXIT. CL**2 00159 EXIT. DTSBU008 00160 EJECT DTSBU008 00161 S004-LINK-QUARTER. DTSBU008 00162 CL**4 00163 CALL 'DTSBU004' CL**2 00164 USING L004-LINK-AREA. DTSBU008 00165 CL**4 00166 S004-LINK-QUARTER-EXIT. EXIT. CL**2 00167 SKIP3 DTSBU008 00168 S999-ABEND. DTSBU008 00169 CL**4 00170 CALL 'DTSBU999' CL**2 00171 USING WRK-ABEND-CD. DTSBU008 00172 CL**4 00173 S999-ABEND-EXIT. EXIT. CL**2