00001  IDENTIFICATION DIVISION.                                         08/17/05
00002  PROGRAM-ID.             DTSBU004                                 DTSBU004
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV011
00004  DATE-WRITTEN            JULY 1994.                               DTSBU004
00005  DATE-COMPILED.                                                   DTSBU004
00006      SKIP3                                                        DTSBU004
00007 *****                                                             DTSBU004
00008 *                                                                 DTSBU004
00009 *    FUNCTION:   QUARTER EDIT/CONVERSION MODULE                   DTSBU004
00010 *                                                                 DTSBU004
00011 *                                                                 DTSBU004
00012 *    MODIFICATION LOG:                                            DTSBU004
00013 *                                                                 DTSBU004
00014 *    08/04/98    CLONED FROM MACCU004.                            DTSBU004
00015 *                WORK ORDER:                 PROGRAMMER: ZL1.     DTSBU004
00016 *                                                                 DTSBU004
00017 *    09/29/1998  ADDED L004-SLASH-5-QTR RELATED CODE.             DTSBU004
00018 *                REFERENCE: DC DEVELOPMENT   PROGRAMMER: EHH      DTSBU004
00019 *                                                                 DTSBU004
00020 *    08/16/2005  MODIFIED P0100: GO TO EXIT IF YEAR IS INVALID.   DTSBU004
00021 *                REFERENCE:                  PROGRAMMER: GD       DTSBU004
00022 *                                                                 DTSBU004
00023 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX      DTSBU004
00024 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX      DTSBU004
00025 *                REFERENCE: XXXXXXXXXXXXXXX  PROGRAMMER: XXX      DTSBU004
00026 *                                                                 DTSBU004
00027 *                                                                 DTSBU004
00028 *    DESCRIPTION:                                                 DTSBU004
00029 *                                                                 DTSBU004
00030 *        THE FUNCTION OF DTSBU004 IS TO VALIDATE QUARTER DATES    DTSBU004
00031 *        AND CONVERT AMONG VARIOUS QUARTER REPRESENTATIONS.       DTSBU004
00032 *                                                                 DTSBU004
00033 *        EVERY CALL RETURNS THE FOLLOWING.                        DTSBU004
00034 *                                                                 DTSBU004
00035 *        1.  QUARTER DATE - YYYY Q                                DTSBU004
00036 *        2.  QUARTER DATE - YY Q                                  DTSBU004
00037 *        3.  NINES COMPLEMENT OF QUARTER DATE 1                   DTSBU004
00038 *        4.  ABSOLUTE QUARTERS SINCE 1930                         DTSBU004
00039 *        5.  QUARTER START DATE - YYYYMMDD                        DTSBU004
00040 *        6.  QUARTER END DATE - YYYYMMDD                          DTSBU004
00041 *        7.  DEFAULT REPORT DUE DATE - YYYYMMDD                   DTSBU004
00042 *                                                                 DTSBU004
00043 *****                                                             DTSBU004
00044  SKIP3                                                            DTSBU004
00045  ENVIRONMENT DIVISION.                                            DTSBU004
00046  DATA DIVISION.                                                   DTSBU004
00047  SKIP3                                                            DTSBU004
00048  WORKING-STORAGE SECTION.                                         DTSBU004
000485 77  PAN-VALET PICTURE X(24) VALUE '011DTSBU004  08/17/05'.       DTSBU004
00049  01  WRK-AREA.                                                    DTSBU004
00050      05  WRK-ABEND-CD                        PIC S9(04)  COMP     DTSBU004
00051                                                  VALUE +004.      DTSBU004
00052      05  WS-QTR-YEAR.                                             DTSBU004
00053          10  WS-QTR-CENTURY                  PIC  9(02).          DTSBU004
00054          10  WS-QTR-YR                       PIC  9(02).          DTSBU004
00055      05  WS-STARTING-DATE-X.                                      DTSBU004
00056          10  WS-STARTING-YR                  PIC  9(04).          DTSBU004
00057          10  WS-STARTING-MO                  PIC  9(02).          DTSBU004
00058          10  WS-STARTING-DA                  PIC  9(02)           DTSBU004
00059                                                 VALUE 01.         DTSBU004
00060      05  WS-STARTING-DATE-9 REDEFINES WS-STARTING-DATE-X          DTSBU004
00061                                              PIC  9(08).          DTSBU004
00062      05  WS-END-DATE-X.                                           DTSBU004
00063          10  WS-END-YR                       PIC  9(04).          DTSBU004
00064          10  WS-END-MO                       PIC  9(02).          DTSBU004
00065          10  WS-END-DA                       PIC  9(02).          DTSBU004
00066      05  WS-END-DATE-9 REDEFINES WS-END-DATE-X                    DTSBU004
00067                                              PIC  9(08).          DTSBU004
00068      05  WS-DUE-DATE-X.                                           DTSBU004
00069          10  WS-DUE-YR                       PIC  9(04).          DTSBU004
00070          10  WS-DUE-MO                       PIC  9(02).          DTSBU004
00071          10  WS-DUE-DA                       PIC  9(02).          DTSBU004
00072      05  WS-DUE-DATE-9 REDEFINES WS-DUE-DATE-X                    DTSBU004
00073                                              PIC  9(08).          DTSBU004
00074      05  WS-ANN-DUE-DATE-X.                                       DTSBU004
00075          10  WS-ANN-DUE-YR                   PIC  9(04).          DTSBU004
00076          10  WS-ANN-DUE-MO                   PIC  9(02).          DTSBU004
00077          10  WS-ANN-DUE-DA                   PIC  9(02).          DTSBU004
00078      05  WS-ANN-DUE-DATE-9 REDEFINES WS-ANN-DUE-DATE-X            DTSBU004
00079                                              PIC  9(08).          DTSBU004
00080  01  L001-LINK-AREA.                                              DTSBU004
00081  ++INCLUDE DTSIL001                                               DTSBU004
00082                                                                   DTSBU004
00083  LINKAGE SECTION.                                                 DTSBU004
00084  01  L004-LINK-AREA.                                              DTSBU004
00085  ++INCLUDE DTSIL004                                               DTSBU004
00086  PROCEDURE DIVISION                                               DTSBU004
00087      USING L004-LINK-AREA.                                        DTSBU004
00088      SKIP3                                                        DTSBU004
00089      MOVE '0' TO L004-RETURN-CODE.                                DTSBU004
00090      IF L004-FROM-5                                               DTSBU004
00091          PERFORM P0100-FROM-5 THRU P0100-FROM-5-EXIT              DTSBU004
00092      ELSE                                                         DTSBU004
00093      IF L004-FROM-3                                               DTSBU004
00094          PERFORM P0200-FROM-3 THRU P0200-FROM-3-EXIT              DTSBU004
00095      ELSE                                                         DTSBU004
00096      IF L004-FROM-ABS                                             DTSBU004
00097          PERFORM P0300-FROM-ABS THRU P0300-FROM-ABS-EXIT          DTSBU004
00098      ELSE                                                         DTSBU004
00099      IF L004-FROM-DATE                                            DTSBU004
00100          PERFORM P0400-FROM-DATE THRU P0400-FROM-DATE-EXIT        DTSBU004
00101      ELSE                                                         DTSBU004
00102      IF L004-FROM-NINES-COMPLEMENT                                DTSBU004
00103          PERFORM P0500-FROM-COMP THRU P0500-FROM-COMP-EXIT        DTSBU004
00104      ELSE                                                         DTSBU004
00105          PERFORM S999-ABEND THRU S999-ABEND-EXIT.                 DTSBU004
00106  INIT0199-GO-BACK.                                                DTSBU004
00107      GOBACK.                                                      DTSBU004
00108      SKIP3                                                        DTSBU004
00109  P0100-FROM-5.                                                    DTSBU004
00110      IF L004-QTR-5-X NOT NUMERIC                                  DTSBU004
00111          PERFORM P0600-INVALID-ENTRY THRU                         DTSBU004
00112                  P0600-INVALID-ENTRY-EXIT                         DTSBU004
00113          GO TO P0100-FROM-5-EXIT.                                 DTSBU004
00114                                                                   DTSBU004
00115      IF L004-QTR-5-Q < 1 OR                                       DTSBU004
00116         L004-QTR-5-Q > 4                                          DTSBU004
00117           PERFORM P0600-INVALID-ENTRY THRU                        DTSBU004
00118                   P0600-INVALID-ENTRY-EXIT                        DTSBU004
00119          GO TO P0100-FROM-5-EXIT.                                 DTSBU004
00120                                                                   DTSBU004
00121      PERFORM P0700-CHECK-YR THRU                                  DTSBU004
00122              P0700-CHECK-YR-EXIT.                                 DTSBU004
00123      IF L004-RETURN-CODE = '1'                                    DTSBU004
00124          GO TO P0100-FROM-5-EXIT.                                 DTSBU004
00125                                                                   DTSBU004
00126      MOVE L004-QTR-5-YR TO WS-QTR-YEAR.                           DTSBU004
00127      MOVE WS-QTR-YR     TO L004-QTR-3-YR.                         DTSBU004
00128      MOVE L004-QTR-5-Q  TO L004-QTR-3-Q.                          DTSBU004
00129      PERFORM P2000-CAL-COMP THRU                                  DTSBU004
00130              P2000-CAL-COMP-EXIT.                                 DTSBU004
00131      PERFORM P3000-CAL-ABS THRU                                   DTSBU004
00132              P3000-CAL-ABS-EXIT.                                  DTSBU004
00133      PERFORM P4000-SLASH-QTR THRU                                 DTSBU004
00134              P4000-SLASH-QTR-EXIT.                                DTSBU004
00135      PERFORM P5000-START-END-DATES THRU                           DTSBU004
00136              P5000-START-END-DATES-EXIT.                          DTSBU004
00137                                                                   DTSBU004
00138      MOVE WS-STARTING-DATE-9 TO L004-QTR-START-DATE.              DTSBU004
00139      MOVE WS-END-DATE-9 TO L004-QTR-END-DATE.                     DTSBU004
00140      MOVE WS-DUE-DATE-9 TO L004-QTR-DEFAULT-DUE-DATE.             DTSBU004
00141      MOVE WS-ANN-DUE-DATE-9 TO L004-ANN-DEFAULT-DUE-DATE.         DTSBU004
00142  P0100-FROM-5-EXIT.  EXIT.                                        DTSBU004
00143      SKIP3.                                                       DTSBU004
00144  P0200-FROM-3.                                                    DTSBU004
00145      IF L004-QTR-3-X NOT NUMERIC                                  DTSBU004
00146          PERFORM P0600-INVALID-ENTRY THRU                         DTSBU004
00147                  P0600-INVALID-ENTRY-EXIT                         DTSBU004
00148          GO TO P0200-FROM-3-EXIT.                                 DTSBU004
00149                                                                   DTSBU004
00150      IF L004-QTR-3-Q < 1 OR                                       DTSBU004
00151         L004-QTR-3-Q > 4                                          DTSBU004
00152          PERFORM P0600-INVALID-ENTRY THRU                         DTSBU004
00153                  P0600-INVALID-ENTRY-EXIT                         DTSBU004
00154          GO TO P0200-FROM-3-EXIT.                                 DTSBU004
00155      MOVE L004-QTR-3-Q TO L004-QTR-5-Q.                           DTSBU004
00156                                                                   DTSBU004
00157      IF L004-QTR-3-YR < 30                                        DTSBU004
00158          ADD L004-QTR-3-YR 2000 GIVING L004-QTR-5-YR              DTSBU004
00159      ELSE                                                         DTSBU004
00160          ADD L004-QTR-3-YR 1900 GIVING L004-QTR-5-YR.             DTSBU004
00161                                                                   DTSBU004
00162      PERFORM P2000-CAL-COMP THRU                                  DTSBU004
00163              P2000-CAL-COMP-EXIT.                                 DTSBU004
00164      PERFORM P3000-CAL-ABS THRU                                   DTSBU004
00165              P3000-CAL-ABS-EXIT.                                  DTSBU004
00166      PERFORM P4000-SLASH-QTR THRU                                 DTSBU004
00167              P4000-SLASH-QTR-EXIT.                                DTSBU004
00168      PERFORM P5000-START-END-DATES THRU                           DTSBU004
00169              P5000-START-END-DATES-EXIT.                          DTSBU004
00170                                                                   DTSBU004
00171      MOVE WS-STARTING-DATE-9 TO L004-QTR-START-DATE.              DTSBU004
00172      MOVE WS-END-DATE-9      TO L004-QTR-END-DATE.                DTSBU004
00173      MOVE WS-DUE-DATE-9      TO L004-QTR-DEFAULT-DUE-DATE.        DTSBU004
00174      MOVE WS-ANN-DUE-DATE-9 TO L004-ANN-DEFAULT-DUE-DATE.         DTSBU004
00175  P0200-FROM-3-EXIT. EXIT.                                         DTSBU004
00176      SKIP3.                                                       DTSBU004
00177  P0300-FROM-ABS.                                                  DTSBU004
00178      IF (L004-ABS-QTR < +1) OR                                    DTSBU004
00179         (L004-ABS-QTR > +400)                                     DTSBU004
00180          PERFORM P0600-INVALID-ENTRY THRU                         DTSBU004
00181                  P0600-INVALID-ENTRY-EXIT                         DTSBU004
00182          GO TO P0300-FROM-ABS-EXIT.                               DTSBU004
00183                                                                   DTSBU004
00184      DIVIDE 4 INTO L004-ABS-QTR GIVING WS-END-YR                  DTSBU004
00185        REMAINDER L004-QTR-5-Q.                                    DTSBU004
00186      ADD WS-END-YR 1930 GIVING L004-QTR-5-YR.                     DTSBU004
00187                                                                   DTSBU004
00188      IF L004-QTR-5-Q = 0                                          DTSBU004
00189          MOVE 4 TO L004-QTR-5-Q                                   DTSBU004
00190          SUBTRACT 1 FROM L004-QTR-5-YR.                           DTSBU004
00191      PERFORM P0100-FROM-5 THRU                                    DTSBU004
00192              P0100-FROM-5-EXIT.                                   DTSBU004
00193  P0300-FROM-ABS-EXIT. EXIT.                                       DTSBU004
00194      SKIP3                                                        DTSBU004
00195  P0400-FROM-DATE.                                                 DTSBU004
00196      MOVE L004-DATE TO WS-DUE-DATE-9.                             DTSBU004
00197      MOVE WS-DUE-YR TO L004-QTR-5-YR.                             DTSBU004
00198      IF WS-DUE-MO < 04                                            DTSBU004
00199          MOVE 1 TO L004-QTR-5-Q                                   DTSBU004
00200      ELSE                                                         DTSBU004
00201      IF WS-DUE-MO < 07                                            DTSBU004
00202          MOVE 2 TO L004-QTR-5-Q                                   DTSBU004
00203      ELSE                                                         DTSBU004
00204      IF WS-DUE-MO < 10                                            DTSBU004
00205          MOVE 3 TO L004-QTR-5-Q                                   DTSBU004
00206      ELSE                                                         DTSBU004
00207          MOVE 4 TO L004-QTR-5-Q.                                  DTSBU004
00208      PERFORM P0100-FROM-5 THRU                                    DTSBU004
00209              P0100-FROM-5-EXIT.                                   DTSBU004
00210  P0400-FROM-DATE-EXIT.  EXIT.                                     DTSBU004
00211      SKIP3                                                        DTSBU004
00212  P0500-FROM-COMP.                                                 DTSBU004
00213      IF (L004-NINES-COMPLEMENT-QTR NOT NUMERIC) OR                DTSBU004
00214         (L004-NINES-COMPLEMENT-QTR NOT > 0)                       DTSBU004
00215            PERFORM P0600-INVALID-ENTRY THRU                       DTSBU004
00216                    P0600-INVALID-ENTRY-EXIT                       DTSBU004
00217            GO TO P0500-FROM-COMP-EXIT.                            DTSBU004
00218                                                                   DTSBU004
00219      COMPUTE L004-QTR-5-9                                         DTSBU004
00220         = 99999 - L004-NINES-COMPLEMENT-QTR.                      DTSBU004
00221      PERFORM P0100-FROM-5 THRU                                    DTSBU004
00222              P0100-FROM-5-EXIT.                                   DTSBU004
00223                                                                   DTSBU004
00224  P0500-FROM-COMP-EXIT.  EXIT.                                     DTSBU004
00225      SKIP3                                                        DTSBU004
00226  P0600-INVALID-ENTRY.                                             DTSBU004
00227      MOVE '1' TO L004-RETURN-CODE.                                DTSBU004
00228      MOVE ZERO TO                                                 DTSBU004
00229              L004-NINES-COMPLEMENT-QTR                            DTSBU004
00230              L004-ABS-QTR                                         DTSBU004
00231              L004-DATE                                            DTSBU004
00232              L004-QTR-START-DATE                                  DTSBU004
00233              L004-QTR-END-DATE                                    DTSBU004
00234              L004-QTR-DEFAULT-DUE-DATE                            DTSBU004
00235              L004-ANN-DEFAULT-DUE-DATE.                           DTSBU004
00236  P0600-INVALID-ENTRY-EXIT.  EXIT.                                 DTSBU004
00237      SKIP3                                                        DTSBU004
00238  P0700-CHECK-YR.                                                  DTSBU004
00239      IF L004-QTR-5-YR < 1930 OR                                   DTSBU004
00240         L004-QTR-5-YR > 2029                                      DTSBU004
00241           PERFORM P0600-INVALID-ENTRY THRU                        DTSBU004
00242                   P0600-INVALID-ENTRY-EXIT.                       DTSBU004
00243  P0700-CHECK-YR-EXIT.  EXIT.                                      DTSBU004
00244      SKIP3                                                        DTSBU004
00245  P2000-CAL-COMP.                                                  DTSBU004
00246      COMPUTE L004-NINES-COMPLEMENT-QTR                            DTSBU004
00247          = 99999 - L004-QTR-5-9.                                  DTSBU004
00248  P2000-CAL-COMP-EXIT.  EXIT.                                      DTSBU004
00249      SKIP3                                                        DTSBU004
00250  P3000-CAL-ABS.                                                   DTSBU004
00251      COMPUTE L004-ABS-QTR =                                       DTSBU004
00252         ((L004-QTR-5-YR - 1930) * 4) + L004-QTR-5-Q.              DTSBU004
00253  P3000-CAL-ABS-EXIT.  EXIT.                                       DTSBU004
00254      SKIP3                                                        DTSBU004
00255  P4000-SLASH-QTR.                                                 DTSBU004
00256      MOVE '/' TO L004-SLASH-LIT.                                  DTSBU004
00257      MOVE L004-QTR-3-Q TO L004-SLASH-Q.                           DTSBU004
00258      MOVE L004-QTR-3-YR TO L004-SLASH-YR.                         DTSBU004
00259                                                                   DTSBU004
00260      MOVE '/' TO L004-SLASH-5-LIT.                                DTSBU004
00261      MOVE L004-QTR-5-Q TO L004-SLASH-5-Q.                         DTSBU004
00262      MOVE L004-QTR-5-YR TO L004-SLASH-5-YR.                       DTSBU004
00263  P4000-SLASH-QTR-EXIT.  EXIT.                                     DTSBU004
00264      SKIP3                                                        DTSBU004
00265  P5000-START-END-DATES.                                           DTSBU004
00266      MOVE L004-QTR-5-YR TO                                        DTSBU004
00267                  WS-STARTING-YR                                   DTSBU004
00268                  WS-END-YR                                        DTSBU004
00269                  WS-DUE-YR.                                       DTSBU004
00270      IF L004-QTR-5-Q = 1                                          DTSBU004
00271          MOVE 01 TO WS-STARTING-MO                                DTSBU004
00272          MOVE 03 TO WS-END-MO                                     DTSBU004
00273          MOVE 04 TO WS-DUE-MO                                     DTSBU004
00274          MOVE 31 TO WS-END-DA                                     DTSBU004
00275          MOVE 30 TO WS-DUE-DA                                     DTSBU004
00276      ELSE                                                         DTSBU004
00277      IF L004-QTR-5-Q = 2                                          DTSBU004
00278          MOVE 04 TO WS-STARTING-MO                                DTSBU004
00279          MOVE 06 TO WS-END-MO                                     DTSBU004
00280          MOVE 07 TO WS-DUE-MO                                     DTSBU004
00281          MOVE 30 TO WS-END-DA                                     DTSBU004
00282          MOVE 31 TO WS-DUE-DA                                     DTSBU004
00283      ELSE                                                         DTSBU004
00284      IF L004-QTR-5-Q = 3                                          DTSBU004
00285          MOVE 07 TO WS-STARTING-MO                                DTSBU004
00286          MOVE 09 TO WS-END-MO                                     DTSBU004
00287          MOVE 10 TO WS-DUE-MO                                     DTSBU004
00288          MOVE 30 TO WS-END-DA                                     DTSBU004
00289          MOVE 31 TO WS-DUE-DA                                     DTSBU004
00290      ELSE                                                         DTSBU004
00291          MOVE 10 TO WS-STARTING-MO                                DTSBU004
00292          MOVE 12 TO WS-END-MO                                     DTSBU004
00293          MOVE 01 TO WS-DUE-MO                                     DTSBU004
00294          MOVE 31 TO WS-END-DA                                     DTSBU004
00295          MOVE 31 TO WS-DUE-DA                                     DTSBU004
00296      ADD +1 TO WS-DUE-YR.                                         DTSBU004
00297                                                                   DTSBU004
00298      COMPUTE WS-ANN-DUE-YR = (L004-QTR-5-YR + 1).                 DTSBU004
00299      MOVE 04 TO WS-ANN-DUE-MO.                                    DTSBU004
00300      MOVE 15 TO WS-ANN-DUE-DA.                                    DTSBU004
00301                                                                   DTSBU004
00302      MOVE WS-ANN-DUE-DATE-9   TO L001-FED-8-DATE-X.               DTSBU004
00303      PERFORM S001-FROM-FED-8  THRU S001-EXIT.                     DTSBU004
00304      IF L001-INVALID-DATE                                         DTSBU004
00305         PERFORM S999-ABEND    THRU S999-ABEND-EXIT                DTSBU004
00306      ELSE                                                         DTSBU004
00307         IF L001-SUNDAY                                            DTSBU004
00308            ADD +1             TO L001-JUL-ABS-DAY                 DTSBU004
00309            PERFORM S001-FROM-ABS-DAY  THRU S001-EXIT              DTSBU004
00310            MOVE L001-FED-8-DATE-X  TO WS-ANN-DUE-DATE-X.          DTSBU004
00311  P5000-START-END-DATES-EXIT.  EXIT.                               DTSBU004
00312      SKIP3.                                                       DTSBU004
00313  S001-FROM-FED-8.                                                 DTSBU004
00314      SET L001-FROM-FED-8 TO TRUE.                                 DTSBU004
00315      GO TO S001-DATE.                                             DTSBU004
00316                                                                   DTSBU004
00317  S001-FROM-ABS-DAY.                                               DTSBU004
00318      SET L001-FROM-ABS-DAY TO TRUE.                               DTSBU004
00319      GO TO S001-DATE.                                             DTSBU004
00320                                                                   DTSBU004
00321  S001-DATE.                                                       DTSBU004
00322      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBU004
00323  S001-EXIT.                                                       DTSBU004
00324      EXIT.                                                        DTSBU004
00325                                                                   DTSBU004
00326  S999-ABEND.                                                      DTSBU004
00327      SKIP1                                                        DTSBU004
00328      CALL 'DTSBU999'                                              DTSBU004
00329          USING WRK-ABEND-CD.                                      DTSBU004
00330      SKIP1                                                        DTSBU004
00331  S999-ABEND-EXIT.  EXIT.                                          DTSBU004
