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
