00001  IDENTIFICATION DIVISION.                                         07/09/04
00002  PROGRAM-ID.             DTSBR751.                                DTSBR751
00003  AUTHOR.                 TRW.                                        LV022
00004  DATE-WRITTEN.           NOVEMBER  2002.                          DTSBR751
00005  DATE-COMPILED.                                                   DTSBR751
00006      SKIP3                                                        DTSBR751
00007 *****                                                             DTSBR751
00008 *                                                                 DTSBR751
00009 *    CALLING SEQUENCE:  DTSCS7D CREATES BR751 RECORDS DIRECTLY.   DTSBR751
00010 *                                                                 DTSBR751
00011 *    FUNCTION:  PRINT EMPLOYER WAGE REQUEST NOTICE.               DTSBR751
00012 *                                                                 DTSBR751
00013 *                                                                 DTSBR751
00014 *    MODIFICATION HISTORY:                                        DTSBR751
00015 *                                                                 DTSBR751
00016 * MM-DD-YY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  DTSBR751
00017 *          XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  DTSBR751
00018 *          REFERENCE RFP #****            AUTHOR OF CHANGE - XXX  DTSBR751
00019 *                                                                 DTSBR751
00020 *                                                                 DTSBR751
00021 *    DESCRIPTION:                                                 DTSBR751
00022 *                                                                 DTSBR751
00023 *      THIS MODULE PRINTS A NOTICE TO AN EMPLOYER REQUESTING      DTSBR751
00024 *      THE WAGES PAID TO A UI BENEFIT CLAIMANT.                   DTSBR751
00025 *                                                                 DTSBR751
00026 *    RECORDS READ:                                                DTSBR751
00027 *                                                                 DTSBR751
00028 *        NONE.                                                    DTSBR751
00029 *                                                                 DTSBR751
00030 *                                                                 DTSBR751
00031 *    PRINTED OUTPUTS:                                             DTSBR751
00032 *                                                                 DTSBR751
00033 *        751R1  EMPLOYER WAGE REQUEST NOTICE (XEROX FORM).        DTSBR751
00034 *                                                                 DTSBR751
00035 *                                                                 DTSBR751
00036 *    RECORDS WRITTEN:                                             DTSBR751
00037 *                                                                 DTSBR751
00038 *        NONE.                                                    DTSBR751
00039 *                                                                 DTSBR751
00040 *                                                                 DTSBR751
00041 *    MODULES CALLED:                                              DTSBR751
00042 *                                                                 DTSBR751
00043 *        DTSBU001  DATE CONVERSION                                DTSBR751
00044 *        DTSBU002  MIXED CASE CONVERSION                          DTSBR751
00045 *                                                                 DTSBR751
00046 *****                                                             DTSBR751
00047      EJECT                                                        DTSBR751
00048  ENVIRONMENT DIVISION.                                            DTSBR751
00049                                                                   DTSBR751
00050  CONFIGURATION SECTION.                                           DTSBR751
00051  SPECIAL-NAMES. C01 IS TOP-PAGE.                                  DTSBR751
00052                                                                   DTSBR751
00053  INPUT-OUTPUT SECTION.                                            DTSBR751
00054                                                                   DTSBR751
00055  FILE-CONTROL.                                                    DTSBR751
00056      SELECT PRT-FILE ASSIGN TO RPT751R1.                          DTSBR751
00057                                                                   DTSBR751
00058  DATA DIVISION.                                                   DTSBR751
00059                                                                   DTSBR751
00060  FILE SECTION.                                                    DTSBR751
00061                                                                   DTSBR751
00062  FD  PRT-FILE                                                     DTSBR751
00063      RECORDING MODE IS F                                          DTSBR751
00064      BLOCK CONTAINS 0 RECORDS                                     DTSBR751
00065      LABEL RECORDS ARE OMITTED.                                   DTSBR751
00066                                                                   DTSBR751
00067  01  PRINT-RECORD                    PIC X(133).                  DTSBR751
00068      EJECT                                                        DTSBR751
00069  WORKING-STORAGE SECTION.                                         DTSBR751
000695 77  PAN-VALET PICTURE X(24) VALUE '022DTSBR751  07/09/04'.       DTSBR751
00070                                                                   DTSBR751
00071  01  WRK-AREA.                                                    DTSBR751
00072      05  SUB1                        PIC S9(04)  COMP  VALUE +0.  DTSBR751
00073      05  SUB2                        PIC S9(04)  COMP  VALUE +0.  DTSBR751
00074      05  SUB3                        PIC S9(04)  COMP  VALUE +0.  DTSBR751
00075      05  SPACER                      PIC X(01)  VALUE SPACE.      DTSBR751
00076      05  PROGRAM-ESP902D             PIC X(08)  VALUE 'ESP902D'.  DTSBR751
00077                                                                   DTSBR751
00078      05  ESP902-WORK-NAME.                                        DTSBR751
00079          10  ESP902-NAME-FORMAT           PIC 9(1).               DTSBR751
00080              88  ESP902-FIRST-NAME-FIRST      VALUE 1.            DTSBR751
00081              88  ESP902-LAST-NAME-FIRST       VALUE 2.            DTSBR751
00082          10  ESP902-NAME-RETURN           PIC 9(1).               DTSBR751
00083              88  ESP902-NAME-CONVERTED        VALUE 0.            DTSBR751
00084              88  ESP902-NAME-INVALID          VALUE 8.            DTSBR751
00085              88  ESP902-INVALID-FORMAT-CODE   VALUE 9.            DTSBR751
00086          10  ESP902-NAM.                                          DTSBR751
00087              15  ESP902-NAME                                      DTSBR751
00088                      OCCURS 32 TIMES      PIC X(1)  VALUE SPACE.  DTSBR751
00089          10  ESP902-NAME-SEGMENT.                                 DTSBR751
00090              15  ESP902-NAME-FIRST        PIC X(32) VALUE SPACE.  DTSBR751
00091              15  ESP902-NAME-LAST         PIC X(32) VALUE SPACE.  DTSBR751
00092                                                                   DTSBR751
00093      05  FIRST-TIME-IND              PIC X(01)  VALUE 'Y'.        DTSBR751
00094                                                                   DTSBR751
00095      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +751.DTSBR751
00096      05  ABEND-MSG                   PIC  X(60).                  DTSBR751
00097                                                                   DTSBR751
00098      05  WRK-HOLD-YRQ                PIC 9(5).                    DTSBR751
00099      05  WRK-HOLD-EMP-NO             PIC 9(6).                    DTSBR751
00100      05  WRK-HOLD-OP-NAME            PIC X(32) VALUE SPACES.      DTSBR751
00101      05  WRK-MONTH-LITERAL-TO-USE    PIC 9(1).                    DTSBR751
00102                                                                   DTSBR751
00103      05  WRK-DATE.                                                DTSBR751
00104          10  WRK-DATE-YEAR           PIC 9(04).                   DTSBR751
00105          10  FILLER                  PIC X(04) VALUE '0301'.      DTSBR751
00106      05  WRK-DATE-RE REDEFINES WRK-DATE   PIC 9(08).              DTSBR751
00107                                                                   DTSBR751
00108      05  WRK-FORMAT-QUARTER.                                      DTSBR751
00109          10  WRK-FQ-QTR              PIC X(04).                   DTSBR751
00110          10  FILLER                  PIC X(08) VALUE 'QUARTER'.   DTSBR751
00111          10  WRK-FQ-YEAR             PIC X(04).                   DTSBR751
00112                                                                   DTSBR751
00113      05  WRK-QTR-BEGIN-DATE          PIC 9(08).                   DTSBR751
00114      05  WRK-PREV-QTR-END-DAY        PIC 9(02).                   DTSBR751
00115      05  WRK-QTR-BEGIN-DAY           PIC 9(01).                   DTSBR751
00116      05  WRK-DAYS-IN-MONTH.                                       DTSBR751
00117          10  WRK-MONTH1-DAYS         PIC 9(02).                   DTSBR751
00118          10  WRK-MONTH2-DAYS         PIC 9(02).                   DTSBR751
00119          10  WRK-MONTH3-DAYS         PIC 9(02).                   DTSBR751
00120      05  WRK-MONTH-LITERAL.                                       DTSBR751
00121          10  WRK-MONTH1-LITERAL.                                  DTSBR751
00122              15  WRK-MTH1-ALPHA      PIC X(04).                   DTSBR751
00123              15  WRK-MTH1-ALPHA-YR   PIC X(02).                   DTSBR751
00124          10  WRK-MONTH2-LITERAL.                                  DTSBR751
00125              15  WRK-MTH2-ALPHA      PIC X(04).                   DTSBR751
00126              15  WRK-MTH2-ALPHA-YR   PIC X(02).                   DTSBR751
00127          10  WRK-MONTH3-LITERAL.                                  DTSBR751
00128              15  WRK-MTH3-ALPHA      PIC X(04).                   DTSBR751
00129              15  WRK-MTH3-ALPHA-YR   PIC X(02).                   DTSBR751
00130                                                                   DTSBR751
00131      05  WRK-FORMAT-SSN.                                          DTSBR751
00132          10  WRK-FS-SSN1             PIC X(03).                   DTSBR751
00133          10  FILLER                  PIC X(01) VALUE '-'.         DTSBR751
00134          10  WRK-FS-SSN2             PIC X(02).                   DTSBR751
00135          10  FILLER                  PIC X(01) VALUE '-'.         DTSBR751
00136          10  WRK-FS-SSN3             PIC X(04).                   DTSBR751
00137                                                                   DTSBR751
00138      05  WRK-QUARTER-ARRAY.                                       DTSBR751
00139          10  WRK-QTR-DAY OCCURS 91 TIMES PIC 9(02).               DTSBR751
00140                                                                   DTSBR751
00141      05  RPT-LINE-1.                                              DTSBR751
00142          10  FILLER                  PIC  X(58) VALUE SPACES.     DTSBR751
00143          10  RPT-MAIL-DATE           PIC  X(20) JUSTIFIED RIGHT.  DTSBR751
00144                                                                   DTSBR751
00145      05  RPT-LINE-2.                                              DTSBR751
00146 *        10  FILLER                  PIC  X(01) VALUE SPACES.     DTSBR751
00147          10  RPT-EMP-ACCT            PIC  X(07).                  DTSBR751
00148          10  FILLER                  PIC  X(01) VALUE SPACES.     DTSBR751
00149          10  RPT-EMP-NAME            PIC  X(40).                  DTSBR751
00150          10  FILLER                  PIC  X(08) VALUE SPACES.     DTSBR751
00151          10  RPT-YRQ                 PIC  X(16).                  DTSBR751
00152                                                                   DTSBR751
00153      05  RPT-LINE-3.                                              DTSBR751
00154          10  FILLER                  PIC  X(18) VALUE SPACES.     DTSBR751
00155          10  RPT-CLAIMANT-NAME       PIC  X(28).                  DTSBR751
00156          10  FILLER                  PIC  X(15) VALUE SPACES.     DTSBR751
00157          10  RPT-SSN                 PIC  X(11).                  DTSBR751
00158                                                                   DTSBR751
00159      05  RPT-LINE-4.                                              DTSBR751
00160          10  FILLER                  PIC  X(08) VALUE SPACES.     DTSBR751
00161          10  RPT-DAY OCCURS 7 TIMES  PIC  X(05).                  DTSBR751
00162          10  RPT-ALPHA-MTH           PIC  X(06).                  DTSBR751
00163                                                                   DTSBR751
00164  01  L001-LINK-AREA.                                              DTSBR751
00165  ++INCLUDE DTSIL001                                               DTSBR751
00166                                                                   DTSBR751
00167  01  L002-LINK-AREA.                                              DTSBR751
00168  ++INCLUDE DTSIL002                                               DTSBR751
00169                                                                   DTSBR751
00170  ++INCLUDE DTSXL751                                               DTSBR751
00171                                                                   DTSBR751
00172  LINKAGE SECTION.                                                 DTSBR751
00173  01  LRCM-LINK-AREA.                                              DTSBR751
00174  ++INCLUDE DTSILRCM                                               DTSBR751
00175                                                                   DTSBR751
00176  01  R751-REC.                                                    DTSBR751
00177  ++INCLUDE DTSIR751                                               DTSBR751
00178      EJECT                                                        DTSBR751
00179  PROCEDURE DIVISION USING LRCM-LINK-AREA,                         DTSBR751
00180                           R751-REC.                               DTSBR751
00181                                                                   DTSBR751
00182      IF FIRST-TIME-IND = 'Y'                                      DTSBR751
00183          PERFORM I1000-INITIATE THRU I1000-EXIT                   DTSBR751
00184          MOVE 'N' TO FIRST-TIME-IND.                              DTSBR751
00185                                                                   DTSBR751
00186      IF LRCM-EOR-88                                               DTSBR751
00187          PERFORM T1000-TERMINATE THRU T1000-EXIT                  DTSBR751
00188      ELSE                                                         DTSBR751
00189          PERFORM P1000-PROCESS THRU P1000-EXIT.                   DTSBR751
00190                                                                   DTSBR751
00191      GOBACK.                                                      DTSBR751
00192                                                                   DTSBR751
00193  I1000-INITIATE.                                                  DTSBR751
00194      OPEN OUTPUT PRT-FILE.                                        DTSBR751
00195      WRITE PRINT-RECORD FROM XEROX-CNTL-LINE  AFTER TOP-PAGE.     DTSBR751
00196 **   WRITE PRINT-RECORD FROM XEROX-CNTL-LINE2 AFTER 1.            DTSBR751
00197  I1000-EXIT.                                                      DTSBR751
00198      EXIT.                                                        DTSBR751
00199                                                                   DTSBR751
00200  P1000-PROCESS.                                                   DTSBR751
00201      IF R751-OP-NAME NOT EQUAL WRK-HOLD-OP-NAME                   DTSBR751
00202         MOVE R751-OP-NAME TO WRK-HOLD-OP-NAME,                    DTSBR751
00203                              ROUTE-OP-NAME                        DTSBR751
00204         WRITE PRINT-RECORD     FROM SPACER AFTER TOP-PAGE         DTSBR751
00205         WRITE PRINT-RECORD     FROM SPACER AFTER ADVANCING 4      DTSBR751
00206         WRITE PRINT-RECORD     FROM ROUTE-INFO-LINE1              DTSBR751
00207         WRITE PRINT-RECORD     FROM ROUTE-INFO-LINE2              DTSBR751
00208         WRITE PRINT-RECORD     FROM ROUTE-INFO-LINE3              DTSBR751
00209         WRITE PRINT-RECORD     FROM ROUTE-INFO-LINE4              DTSBR751
00210         WRITE PRINT-RECORD     FROM ROUTE-INFO-LINE5.             DTSBR751
00211                                                                   DTSBR751
00212      MOVE R751-MAIL-DATE         TO L002-DATE.                    DTSBR751
00213      PERFORM S002-MIXED-CASE THRU S002-EXIT.                      DTSBR751
00214      MOVE L002-LONG-TEXT-AREA    TO RPT-MAIL-DATE.                DTSBR751
00215                                                                   DTSBR751
00216      IF R751-EMP-NO GREATER ZEROS                                 DTSBR751
00217         MOVE R751-EMP-NO           TO WRK-HOLD-EMP-NO             DTSBR751
00218         MOVE WRK-HOLD-EMP-NO (1:3) TO RPT-EMP-ACCT (1:3)          DTSBR751
00219         MOVE '-'                   TO RPT-EMP-ACCT (4:1)          DTSBR751
00220         MOVE WRK-HOLD-EMP-NO (4:3) TO RPT-EMP-ACCT (5:3)          DTSBR751
00221      ELSE                                                         DTSBR751
00222         MOVE SPACES                TO RPT-EMP-ACCT.               DTSBR751
00223                                                                   DTSBR751
00224      MOVE R751-CLAIMANT-NAME    TO RPT-CLAIMANT-NAME.             DTSBR751
00225      MOVE R751-EMP-PRIMARY-NAME TO RPT-EMP-NAME.                  DTSBR751
00226                                                                   DTSBR751
00227      PERFORM P1100-FORMAT-DATA THRU P1100-EXIT.                   DTSBR751
00228      MOVE WRK-FORMAT-QUARTER TO RPT-YRQ.                          DTSBR751
00229      MOVE WRK-FORMAT-SSN     TO RPT-SSN.                          DTSBR751
00230                                                                   DTSBR751
00231      MOVE WRK-QTR-BEGIN-DATE TO L001-FED-8-DATE-9.                DTSBR751
00232      PERFORM S001-FROM-FED-8 THRU S001-EXIT.                      DTSBR751
00233      MOVE L001-DAY-OF-WEEK TO WRK-QTR-BEGIN-DAY.                  DTSBR751
00234                                                                   DTSBR751
00235      PERFORM P1300-SET-QUARTER-ARRAY THRU P1300-EXIT.             DTSBR751
00236                                                                   DTSBR751
00237      MOVE ZERO TO SUB3.                                           DTSBR751
00238      MOVE 1    TO WRK-MONTH-LITERAL-TO-USE.                       DTSBR751
00239      WRITE PRINT-RECORD FROM SPACER     AFTER TOP-PAGE.           DTSBR751
00240      WRITE PRINT-RECORD FROM RPT-LINE-1 AFTER 3.                  DTSBR751
00241      WRITE PRINT-RECORD FROM RPT-LINE-2 AFTER 2.                  DTSBR751
00242      WRITE PRINT-RECORD FROM RPT-LINE-3 AFTER 3.                  DTSBR751
00243      WRITE PRINT-RECORD FROM SPACER     AFTER 14.                 DTSBR751
00244                                                                   DTSBR751
00245      PERFORM P1400-PRINT-QTR-ARRAY   THRU P1400-EXIT              DTSBR751
00246              VARYING SUB1 FROM 1 BY 1                             DTSBR751
00247                UNTIL SUB1 GREATER 13.                             DTSBR751
00248                                                                   DTSBR751
00249  P1000-EXIT.                                                      DTSBR751
00250      EXIT.                                                        DTSBR751
00251                                                                   DTSBR751
00252  P1100-FORMAT-DATA.                                               DTSBR751
00253      MOVE R751-YRQ           TO WRK-HOLD-YRQ.                     DTSBR751
00254      MOVE WRK-HOLD-YRQ (1:4) TO WRK-FQ-YEAR,                      DTSBR751
00255                                 WRK-QTR-BEGIN-DATE (1:4),         DTSBR751
00256                                 WRK-DATE-YEAR.                    DTSBR751
00257                                                                   DTSBR751
00258      MOVE WRK-HOLD-YRQ (3:2) TO WRK-MTH1-ALPHA-YR,                DTSBR751
00259                                 WRK-MTH2-ALPHA-YR,                DTSBR751
00260                                 WRK-MTH3-ALPHA-YR.                DTSBR751
00261                                                                   DTSBR751
00262      IF WRK-HOLD-YRQ (5:1) EQUAL 1                                DTSBR751
00263         MOVE '1ST'  TO WRK-FQ-QTR                                 DTSBR751
00264         MOVE 'JAN-' TO WRK-MTH1-ALPHA                             DTSBR751
00265         MOVE 'FEB-' TO WRK-MTH2-ALPHA                             DTSBR751
00266         MOVE 'MAR-' TO WRK-MTH3-ALPHA                             DTSBR751
00267         MOVE 0101   TO WRK-QTR-BEGIN-DATE (5:4)                   DTSBR751
00268         MOVE 31     TO WRK-MONTH1-DAYS                            DTSBR751
00269         PERFORM P1200-GET-FEB-DAYS THRU P1200-EXIT                DTSBR751
00270         MOVE 31     TO WRK-MONTH3-DAYS                            DTSBR751
00271         MOVE 31     TO WRK-PREV-QTR-END-DAY                       DTSBR751
00272      ELSE                                                         DTSBR751
00273      IF WRK-HOLD-YRQ (5:1) EQUAL 2                                DTSBR751
00274         MOVE '2ND'  TO WRK-FQ-QTR                                 DTSBR751
00275         MOVE 'APR-' TO WRK-MTH1-ALPHA                             DTSBR751
00276         MOVE 'MAY-' TO WRK-MTH2-ALPHA                             DTSBR751
00277         MOVE 'JUN-' TO WRK-MTH3-ALPHA                             DTSBR751
00278         MOVE 0401   TO WRK-QTR-BEGIN-DATE (5:4)                   DTSBR751
00279         MOVE 30     TO WRK-MONTH1-DAYS                            DTSBR751
00280         MOVE 31     TO WRK-MONTH2-DAYS                            DTSBR751
00281         MOVE 30     TO WRK-MONTH3-DAYS                            DTSBR751
00282         MOVE 31     TO WRK-PREV-QTR-END-DAY                       DTSBR751
00283      ELSE                                                         DTSBR751
00284      IF WRK-HOLD-YRQ (5:1) EQUAL 3                                DTSBR751
00285         MOVE '3RD'  TO WRK-FQ-QTR                                 DTSBR751
00286         MOVE 'JUL-' TO WRK-MTH1-ALPHA                             DTSBR751
00287         MOVE 'AUG-' TO WRK-MTH2-ALPHA                             DTSBR751
00288         MOVE 'SEP-' TO WRK-MTH3-ALPHA                             DTSBR751
00289         MOVE 0701   TO WRK-QTR-BEGIN-DATE (5:4)                   DTSBR751
00290         MOVE 31     TO WRK-MONTH1-DAYS                            DTSBR751
00291         MOVE 31     TO WRK-MONTH2-DAYS                            DTSBR751
00292         MOVE 30     TO WRK-MONTH3-DAYS                            DTSBR751
00293         MOVE 30     TO WRK-PREV-QTR-END-DAY                       DTSBR751
00294      ELSE                                                         DTSBR751
00295         MOVE '4TH'  TO WRK-FQ-QTR                                 DTSBR751
00296         MOVE 'OCT-' TO WRK-MTH1-ALPHA                             DTSBR751
00297         MOVE 'NOV-' TO WRK-MTH2-ALPHA                             DTSBR751
00298         MOVE 'DEC-' TO WRK-MTH3-ALPHA                             DTSBR751
00299         MOVE 1001   TO WRK-QTR-BEGIN-DATE (5:4)                   DTSBR751
00300         MOVE 31     TO WRK-MONTH1-DAYS                            DTSBR751
00301         MOVE 30     TO WRK-MONTH2-DAYS                            DTSBR751
00302         MOVE 31     TO WRK-MONTH3-DAYS                            DTSBR751
00303         MOVE 30     TO WRK-PREV-QTR-END-DAY.                      DTSBR751
00304                                                                   DTSBR751
00305      MOVE R751-SSN (1:3) TO WRK-FS-SSN1.                          DTSBR751
00306      MOVE R751-SSN (4:2) TO WRK-FS-SSN2.                          DTSBR751
00307      MOVE R751-SSN (6:4) TO WRK-FS-SSN3.                          DTSBR751
00308                                                                   DTSBR751
00309  P1100-EXIT.                                                      DTSBR751
00310      EXIT.                                                        DTSBR751
00311                                                                   DTSBR751
00312  P1200-GET-FEB-DAYS.                                              DTSBR751
00313 ****************************************************************  DTSBR751
00314 *  WRK-DATE CONTAINS THE 1ST OF MARCH DATE FOR CURRENT YEAR.      DTSBR751
00315 *  USING THIS DATE IN A CALL TO THE DATE ROUTINE, YOU CAN         DTSBR751
00316 *  DETERMINE THE NUMBER OF DAYS IN FEBRUARY BY SUBTRACTING        DTSBR751
00317 *  1 FROM THE ABSOLUTE DATE, THEN CALL THE DATE ROUTINE AGAIN.    DTSBR751
00318 ***************************************************************   DTSBR751
00319                                                                   DTSBR751
00320      MOVE WRK-DATE TO L001-FED-8-DATE-9.                          DTSBR751
00321      PERFORM S001-FROM-FED-8 THRU S001-EXIT.                      DTSBR751
00322      SUBTRACT 1 FROM L001-JUL-ABS-DAY.                            DTSBR751
00323      PERFORM S001-FROM-ABS-DAY THRU S001-EXIT.                    DTSBR751
00324      MOVE L001-SLASH-8-DA  TO WRK-MONTH2-DAYS.                    DTSBR751
00325  P1200-EXIT.                                                      DTSBR751
00326      EXIT.                                                        DTSBR751
00327                                                                   DTSBR751
00328  P1300-SET-QUARTER-ARRAY.                                         DTSBR751
00329      SUBTRACT 1 FROM WRK-QTR-BEGIN-DAY GIVING SUB1.               DTSBR751
00330      PERFORM P1310-SQA THRU P1310-EXIT                            DTSBR751
00331              VARYING SUB1 FROM SUB1 BY -1                         DTSBR751
00332                UNTIL SUB1 EQUAL ZERO.                             DTSBR751
00333                                                                   DTSBR751
00334      MOVE WRK-QTR-BEGIN-DAY TO SUB1.                              DTSBR751
00335      MOVE ZEROS             TO SUB2.                              DTSBR751
00336      PERFORM P1320-SQA THRU P1320-EXIT                            DTSBR751
00337              VARYING SUB1 FROM SUB1 BY +1                         DTSBR751
00338                UNTIL SUB2 EQUAL WRK-MONTH1-DAYS.                  DTSBR751
00339                                                                   DTSBR751
00340      MOVE ZEROS             TO SUB2.                              DTSBR751
00341      PERFORM P1320-SQA THRU P1320-EXIT                            DTSBR751
00342              VARYING SUB1 FROM SUB1 BY +1                         DTSBR751
00343                UNTIL SUB2 EQUAL WRK-MONTH2-DAYS.                  DTSBR751
00344                                                                   DTSBR751
00345      MOVE ZEROS             TO SUB2.                              DTSBR751
00346      PERFORM P1320-SQA THRU P1320-EXIT                            DTSBR751
00347              VARYING SUB1 FROM SUB1 BY +1                         DTSBR751
00348                UNTIL SUB1 GREATER 91.                             DTSBR751
00349  P1300-EXIT.                                                      DTSBR751
00350      EXIT.                                                        DTSBR751
00351                                                                   DTSBR751
00352  P1310-SQA.                                                       DTSBR751
00353      MOVE WRK-PREV-QTR-END-DAY TO WRK-QTR-DAY (SUB1).             DTSBR751
00354      SUBTRACT 1 FROM WRK-PREV-QTR-END-DAY.                        DTSBR751
00355  P1310-EXIT.                                                      DTSBR751
00356      EXIT.                                                        DTSBR751
00357                                                                   DTSBR751
00358  P1320-SQA.                                                       DTSBR751
00359      ADD 1 TO SUB2.                                               DTSBR751
00360      MOVE SUB2 TO WRK-QTR-DAY (SUB1).                             DTSBR751
00361  P1320-EXIT.                                                      DTSBR751
00362      EXIT.                                                        DTSBR751
00363                                                                   DTSBR751
00364  P1400-PRINT-QTR-ARRAY.                                           DTSBR751
00365      PERFORM P1410-PQA THRU P1410-EXIT                            DTSBR751
00366              VARYING SUB2 FROM 1 BY 1                             DTSBR751
00367                UNTIL SUB2 GREATER 7.                              DTSBR751
00368                                                                   DTSBR751
00369      IF WRK-MONTH-LITERAL-TO-USE EQUAL 1                          DTSBR751
00370         MOVE WRK-MONTH1-LITERAL TO RPT-ALPHA-MTH                  DTSBR751
00371      ELSE                                                         DTSBR751
00372      IF WRK-MONTH-LITERAL-TO-USE EQUAL 2                          DTSBR751
00373         MOVE WRK-MONTH2-LITERAL TO RPT-ALPHA-MTH                  DTSBR751
00374      ELSE                                                         DTSBR751
00375         MOVE WRK-MONTH3-LITERAL TO RPT-ALPHA-MTH.                 DTSBR751
00376                                                                   DTSBR751
00377      WRITE PRINT-RECORD FROM SPACER     AFTER 1.                  DTSBR751
00378      WRITE PRINT-RECORD FROM RPT-LINE-4 AFTER 1.                  DTSBR751
00379  P1400-EXIT.                                                      DTSBR751
00380      EXIT.                                                        DTSBR751
00381                                                                   DTSBR751
00382  P1410-PQA.                                                       DTSBR751
00383      ADD 1 TO SUB3.                                               DTSBR751
00384      IF SUB3 GREATER 7                                            DTSBR751
00385         IF WRK-QTR-DAY (SUB3) LESS WRK-QTR-DAY (SUB3 - 1)         DTSBR751
00386            ADD 1 TO WRK-MONTH-LITERAL-TO-USE.                     DTSBR751
00387      MOVE WRK-QTR-DAY (SUB3) TO RPT-DAY (SUB2).                   DTSBR751
00388  P1410-EXIT.                                                      DTSBR751
00389      EXIT.                                                        DTSBR751
00390                                                                   DTSBR751
00391  T1000-TERMINATE.                                                 DTSBR751
00392      CLOSE PRT-FILE.                                              DTSBR751
00393  T1000-EXIT.                                                      DTSBR751
00394      EXIT.                                                        DTSBR751
00395                                                                   DTSBR751
00396  S001-FROM-FED-8.                                                 DTSBR751
00397      SET L001-FROM-FED-8 TO TRUE.                                 DTSBR751
00398      GO TO S001-DATE.                                             DTSBR751
00399                                                                   DTSBR751
00400  S001-FROM-ABS-DAY.                                               DTSBR751
00401      SET L001-FROM-ABS-DAY TO TRUE.                               DTSBR751
00402      GO TO S001-DATE.                                             DTSBR751
00403                                                                   DTSBR751
00404  S001-DATE.                                                       DTSBR751
00405      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBR751
00406  S001-EXIT.                                                       DTSBR751
00407      EXIT.                                                        DTSBR751
00408                                                                   DTSBR751
00409  S002-UPPER-CASE.                                                 DTSBR751
00410      SET L002-UPPER-CASE TO TRUE.                                 DTSBR751
00411      GO TO S002-DATE-ALPHA.                                       DTSBR751
00412                                                                   DTSBR751
00413  S002-MIXED-CASE.                                                 DTSBR751
00414      SET L002-MIXED-CASE TO TRUE.                                 DTSBR751
00415      GO TO S002-DATE-ALPHA.                                       DTSBR751
00416                                                                   DTSBR751
00417  S002-DATE-ALPHA.                                                 DTSBR751
00418      CALL 'DTSBU002' USING L002-LINK-AREA.                        DTSBR751
00419  S002-EXIT.                                                       DTSBR751
00420      EXIT.                                                        DTSBR751
00421                                                                   DTSBR751
00422  S999-ABEND.                                                      DTSBR751
00423      DISPLAY '***'.                                               DTSBR751
00424      DISPLAY '***  '                                              DTSBR751
00425              ABEND-MSG.                                           DTSBR751
00426      DISPLAY '***'.                                               DTSBR751
00427                                                                   DTSBR751
00428      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBR751
00429  S999-EXIT.                                                       DTSBR751
00430      EXIT.                                                        DTSBR751
00431                                                                   DTSBR751
