00001  IDENTIFICATION DIVISION.                                         08/31/05
00002  PROGRAM-ID.             DTSBE331.                                DTSBE331
00003  AUTHOR.                 NGC.                                        LV001
00004  DATE-WRITTEN.           OCTOBER 2004.                            DTSBE331
00005  DATE-COMPILED.                                                   DTSBE331
00006      SKIP3                                                        DTSBE331
00007 *****                                                             DTSBE331
00008 *                                                                 DTSBE331
00009 *    FUNCTION:  EXTRACT CREDIT/DEBIT DATA FOR WEB CREDIT/DEBIT    DTSBE331
00010 *               APPLICATION.                                      DTSBE331
00011 *                                                                 DTSBE331
00012 *    MODIFICATION LOG:                                            DTSBE331
00013 *                                                                 DTSBE331
00014 *    10/28/2004  INITIAL DEVELOPMENT.                             DTSBE331
00015 *                REFERENCE:                     PROGRAMMER: GD    DTSBE331
00016 *                                                                 DTSBE331
00017 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBE331
00018 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBE331
00019 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSBE331
00020 *                                                                 DTSBE331
00021 *                                                                 DTSBE331
00022 *  DESCRIPTION:                                                   DTSBE331
00023 *                                                                 DTSBE331
00024 *                                                                 DTSBE331
00025 *    INITIATION:                                                  DTSBE331
00026 *                                                                 DTSBE331
00027 *      SET LECM-MST-OPEN-READ-88 TO TRUE.                         DTSBE331
00028 *      SET LECM-REF-OPEN-READ-88 TO TRUE.                         DTSBE331
00029 *                                                                 DTSBE331
00030 *      EDIT AND DEFAULT PARAMETERS.                               DTSBE331
00031 *                                                                 DTSBE331
00032 *                                                                 DTSBE331
00033 *    PROCESSING:                                                  DTSBE331
00034 *                                                                 DTSBE331
00035 *      SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS (DTSBX331)     DTSBE331
00036 *                                                                 DTSBE331
00037 *      THIS PROGRAM RUNS DAILY, FOLLOWING THE DAILY UPDATE.       DTSBE331
00038 *      IT SELECTS EMPLOYERS WITH EITHER A BALANCE DUE OR A CREDIT.DTSBE331
00039 *      FOR EACH EMPLOYER SELECTED, IT READS MJRN RECORDS CREATED  DTSBE331
00040 *      DURING THE MOST RECENT DAILY UPDATE.  IT SUMMARIZES THE    DTSBE331
00041 *      RESULTS OF EACH TRANSACTION, AND WRITES AN OUTPUT RECORD   DTSBE331
00042 *      (DTSIX331) FOR EACH THAT RESULTED IN EITHER A DEBIT OR     DTSBE331
00043 *      CREDIT.  THESE RECORDS ARE PASSED TO DTSBX331, WHICH       DTSBE331
00044 *      PRODUCES DTSIR330 REPORT RECORDS.                          DTSBE331
00045 *                                                                 DTSBE331
00046 *    TERMINATION:                                                 DTSBE331
00047 *                                                                 DTSBE331
00048 *                                                                 DTSBE331
00049 *                                                                 DTSBE331
00050 *    RECORDS READ:                                                DTSBE331
00051 *                                                                 DTSBE331
00052 *      MASTER:                                                    DTSBE331
00053 *                                                                 DTSBE331
00054 *        MSOL                                                     DTSBE331
00055 *        MQTR                                                     DTSBE331
00056 *                                                                 DTSBE331
00057 *                                                                 DTSBE331
00058 *      ALTERNATE INDEX:                                           DTSBE331
00059 *                                                                 DTSBE331
00060 *        NONE.                                                    DTSBE331
00061 *                                                                 DTSBE331
00062 *                                                                 DTSBE331
00063 *      REFERENCE:                                                 DTSBE331
00064 *                                                                 DTSBE331
00065 *                                                                 DTSBE331
00066 *                                                                 DTSBE331
00067 *    RECORDS UPDATED:                                             DTSBE331
00068 *                                                                 DTSBE331
00069 *        NONE                                                     DTSBE331
00070 *                                                                 DTSBE331
00071 *                                                                 DTSBE331
00072 *    OUTPUT RECORDS WRITTEN:                                      DTSBE331
00073 *                                                                 DTSBE331
00074 *        DTSBX331                                                 DTSBE331
00075 *                                                                 DTSBE331
00076 *                                                                 DTSBE331
00077 *    BATCH TRANSACTION COLLECTION RECORDS WRITTEN:                DTSBE331
00078 *                                                                 DTSBE331
00079 *        NONE.                                                    DTSBE331
00080 *                                                                 DTSBE331
00081 *                                                                 DTSBE331
00082 *    MODULES CALLED:                                              DTSBE331
00083 *                                                                 DTSBE331
00084 *        DTSBU001  DATE EDIT/CONVERSION.                          DTSBE331
00085 *        DTSBU004  QUARTER EDIT/CONVERSION.                       DTSBE331
00086 *        DTSBU910  MASTER FILE I/O.                               DTSBE331
00087 *                                                                 DTSBE331
00088 *                                                                 DTSBE331
00089 *                                                                 DTSBE331
00090 *****                                                             DTSBE331
00091      SKIP3                                                        DTSBE331
00092  ENVIRONMENT DIVISION.                                            DTSBE331
00093  INPUT-OUTPUT SECTION.                                            DTSBE331
00094  FILE-CONTROL.                                                    DTSBE331
00095      SELECT X331-FILE         ASSIGN TO X331FILE                  DTSBE331
00096         FILE STATUS IS X331-STATUS.                               DTSBE331
00097                                                                   DTSBE331
00098      SELECT BE331-PARM-FILE   ASSIGN TO BE331PRM                  DTSBE331
00099         FILE STATUS IS PARM-STATUS.                               DTSBE331
00100                                                                   DTSBE331
00101  DATA DIVISION.                                                   DTSBE331
00102  FILE SECTION.                                                    DTSBE331
00103  FD  X331-FILE                                                    DTSBE331
00104      RECORDING MODE IS F                                          DTSBE331
00105      LABEL RECORDS ARE STANDARD                                   DTSBE331
00106      BLOCK CONTAINS 0 CHARACTERS.                                 DTSBE331
00107                                                                   DTSBE331
00108  01  X331-REC.                                                    DTSBE331
00109  ++INCLUDE DTSIX331                                               DTSBE331
00110                                                                   DTSBE331
00111  FD  BE331-PARM-FILE                                              DTSBE331
00112      RECORDING MODE IS F                                          DTSBE331
00113      LABEL RECORDS ARE STANDARD                                   DTSBE331
00114      BLOCK CONTAINS 0 CHARACTERS.                                 DTSBE331
00115                                                                   DTSBE331
00116  01  BE331-PARM-REC                 PIC S9(09) COMP-3.            DTSBE331
00117                                                                   DTSBE331
00118  WORKING-STORAGE SECTION.                                         DTSBE331
001185 77  PAN-VALET PICTURE X(24) VALUE '001DTSBE331  08/31/05'.       DTSBE331
00119      SKIP3                                                        DTSBE331
00120  01  WRK-AREA.                                                    DTSBE331
00121      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +331.DTSBE331
00122                                                                   DTSBE331
00123      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBE331'.DTSBE331
00124                                                                   DTSBE331
00125      05  ABEND-MSG                   PIC  X(60).                  DTSBE331
00126                                                                   DTSBE331
00127      05  X331-STATUS                 PIC  X(02).                  DTSBE331
00128          88  X331-STATUS-OK-88        VALUE '00'.                 DTSBE331
00129                                                                   DTSBE331
00130      05  PARM-STATUS                 PIC  X(02).                  DTSBE331
00131          88  PARM-STATUS-OK-88        VALUE '00'.                 DTSBE331
00132                                                                   DTSBE331
00133      05  WRK-SUBJECT-DATE            PIC S9(09)  COMP-3 VALUE +0. DTSBE331
00134      05  WRK-ABSTIME                 PIC S9(15)  COMP-3 VALUE +0. DTSBE331
00135                                                                   DTSBE331
00136      05  QTR-FIRST                  PIC S9(04)  COMP VALUE +400.  DTSBE331
00137      05  QTR-LAST                   PIC S9(04)  COMP VALUE +0.    DTSBE331
00138      05  QTR-SUB                    PIC S9(04)  COMP.             DTSBE331
00139      05  WRK-JRN-TABLE OCCURS 400 TIMES.                          DTSBE331
00140          10  WRK-JRN-YRQ             PIC S9(05)    COMP-3.        DTSBE331
00141          10  WRK-JRN-AMT             PIC S9(09)V99 COMP-3.        DTSBE331
00142                                                                   DTSBE331
00143      05  CR-LAST                    PIC S9(04)  COMP VALUE +0.    DTSBE331
00144      05  CR-MAX                     PIC S9(04)  COMP VALUE +400.  DTSBE331
00145      05  CR-SUB                     PIC S9(04)  COMP.             DTSBE331
00146      05  WRK-CREDIT-TABLE OCCURS 400 TIMES.                       DTSBE331
00147          10  WRK-CREDIT-AMT          PIC S9(09)V99 COMP-3.        DTSBE331
00148                                                                   DTSBE331
00149      05  WRK-MJRN-READ-CNT           PIC S9(07)    COMP-3         DTSBE331
00150                                      VALUE +0.                    DTSBE331
00151                                                                   DTSBE331
00152      05  WRK-AMT                     PIC S9(09)V99 COMP-3.        DTSBE331
00153      05  WRK-QTR-BAL                 PIC S9(11)V99 COMP-3.        DTSBE331
00154                                                                   DTSBE331
00155                                                                   DTSBE331
00156      05  WRK-X331-CNT               PIC S9(07)  COMP-3            DTSBE331
00157                                      VALUE +0.                    DTSBE331
00158                                                                   DTSBE331
00159      05  WRK-DISP-EMP               PIC S9(07) COMP-3             DTSBE331
00160                                      VALUE +010169.               DTSBE331
00161                                                                   DTSBE331
00162      05  DISPLAY-CNT                PIC  Z(06)9.                  DTSBE331
00163                                                                   DTSBE331
00164      05  DISPLAY-AMT-X               PIC  X(15).                  DTSBE331
00165      05  DISPLAY-AMT REDEFINES DISPLAY-AMT-X                      DTSBE331
00166                                      PIC  ZZZ,ZZZ,ZZ9.99-.        DTSBE331
00167      EJECT                                                        DTSBE331
00168  01  L001-LINK-AREA.                                              DTSBE331
00169  ++INCLUDE DTSIL001                                               DTSBE331
00170      EJECT                                                        DTSBE331
00171  01  L004-LINK-AREA.                                              DTSBE331
00172  ++INCLUDE DTSIL004                                               DTSBE331
00173      EJECT                                                        DTSBE331
00174  01  L005-LINK-AREA.                                              DTSBE331
00175  ++INCLUDE DTSIL005                                               DTSBE331
00176                                                                   DTSBE331
00177  01  L910-LINK-AREA.                                              DTSBE331
00178  ++INCLUDE DTSIL910                                               DTSBE331
00179      SKIP3                                                        DTSBE331
00180  01  MSKL-REC.                                                    DTSBE331
00181  ++INCLUDE DTSIMSKL                                               DTSBE331
00182      SKIP3                                                        DTSBE331
00183  01  MQTR-REC.                                                    DTSBE331
00184  ++INCLUDE DTSIMQTR                                               DTSBE331
00185      SKIP3                                                        DTSBE331
00186  01  MJRN-REC.                                                    DTSBE331
00187  ++INCLUDE DTSIMJRN                                               DTSBE331
00188      SKIP3                                                        DTSBE331
00189  01  L931-LINK-AREA.                                              DTSBE331
00190  ++INCLUDE DTSIL931                                               DTSBE331
00191      SKIP3                                                        DTSBE331
00192  01  FSKL-REC.                                                    DTSBE331
00193  ++INCLUDE DTSIFSKL                                               DTSBE331
00194      SKIP3                                                        DTSBE331
00195  01  FQTR-REC.                                                    DTSBE331
00196  ++INCLUDE DTSIFQTR                                               DTSBE331
00197                                                                   DTSBE331
00198  LINKAGE SECTION.                                                 DTSBE331
00199      SKIP3                                                        DTSBE331
00200  01  LECM-LINK-AREA.                                              DTSBE331
00201  ++INCLUDE DTSILECM                                               DTSBE331
00202      SKIP3                                                        DTSBE331
00203          10  FILLER REDEFINES LECM-EXTRACT-PARMS.                 DTSBE331
00204              15  LECM-PARM-SUBJECT-DATE       PIC  X(06).         DTSBE331
00205              15  FILLER                       PIC  X(62).         DTSBE331
00206      EJECT                                                        DTSBE331
00207  01  MPRF-LINK-REC.                                               DTSBE331
00208  ++INCLUDE DTSIMPRF                                               DTSBE331
00209      EJECT                                                        DTSBE331
00210  PROCEDURE DIVISION USING LECM-LINK-AREA                          DTSBE331
00211                           MPRF-LINK-REC.                          DTSBE331
00212                                                                   DTSBE331
00213      IF LECM-PROCESS-88                                           DTSBE331
00214          PERFORM P0000-PROCESS THRU P0000-EXIT                    DTSBE331
00215      ELSE                                                         DTSBE331
00216      IF LECM-INITIALIZE-88                                        DTSBE331
00217          PERFORM I0000-INITIALIZE THRU I0000-EXIT                 DTSBE331
00218      ELSE                                                         DTSBE331
00219      IF LECM-TERMINATE-88                                         DTSBE331
00220          PERFORM T0000-TERMINATE THRU T0000-EXIT                  DTSBE331
00221      ELSE                                                         DTSBE331
00222          MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED'            DTSBE331
00223            TO ABEND-MSG                                           DTSBE331
00224          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBE331
00225      SKIP2                                                        DTSBE331
00226      GOBACK.                                                      DTSBE331
00227      EJECT                                                        DTSBE331
00228  I0000-INITIALIZE.                                                DTSBE331
00229      SKIP2                                                        DTSBE331
00230      MOVE LECM-TRACE-IND TO L910-TRACE-IND.                       DTSBE331
00231                                                                   DTSBE331
00232      MOVE WRK-MOD-NAME TO L910-MOD-NAME.                          DTSBE331
00233                                                                   DTSBE331
00234                                                                   DTSBE331
00235      PERFORM I1000-EDIT-AND-DEFAULT-PARMS THRU I1000-EXIT.        DTSBE331
00236                                                                   DTSBE331
00237      PERFORM I2000-OPEN-FILES   THRU I2000-EXIT.                  DTSBE331
00238                                                                   DTSBE331
00239      PERFORM I3000-WRITE-PARM   THRU I3000-EXIT.                  DTSBE331
00240                                                                   DTSBE331
00241      SET LECM-MST-OPEN-READ-88 TO TRUE.                           DTSBE331
00242                                                                   DTSBE331
00243      SET LECM-REF-OPEN-READ-88 TO TRUE.                           DTSBE331
00244                                                                   DTSBE331
00245  I0000-EXIT.                                                      DTSBE331
00246      EXIT.                                                        DTSBE331
00247      EJECT                                                        DTSBE331
00248  I1000-EDIT-AND-DEFAULT-PARMS.                                    DTSBE331
00249      IF LECM-PARM-SUBJECT-DATE = SPACES                           DTSBE331
00250         PERFORM I1200-DEFAULT-DATE    THRU I1200-EXIT             DTSBE331
00251         PERFORM I1100-SET-DATES       THRU I1100-EXIT             DTSBE331
00252      ELSE                                                         DTSBE331
00253         MOVE LECM-PARM-SUBJECT-DATE   TO L001-CAL-6-DATE-X        DTSBE331
00254         PERFORM S001-FROM-CAL-6       THRU S001-EXIT              DTSBE331
00255         IF L001-VALID-DATE                                        DTSBE331
00256            IF L001-FED-8-DATE-9 <= LECM-PRIOR-RUN-DATE            DTSBE331
00257               MOVE L001-FED-8-DATE-9  TO WRK-SUBJECT-DATE         DTSBE331
00258               PERFORM I1100-SET-DATES THRU I1100-EXIT             DTSBE331
00259            ELSE                                                   DTSBE331
00260               PERFORM I1002-ERROR     THRU I1002-EXIT             DTSBE331
00261         ELSE                                                      DTSBE331
00262            PERFORM I1001-ERROR        THRU I1001-EXIT             DTSBE331
00263         END-IF                                                    DTSBE331
00264      END-IF.                                                      DTSBE331
00265                                                                   DTSBE331
00266                                                                   DTSBE331
00267  I1000-EXIT.                                                      DTSBE331
00268      EXIT.                                                        DTSBE331
00269                                                                   DTSBE331
00270  I1001-ERROR.                                                     DTSBE331
00271      DISPLAY 'INVALID PARM DATE ' L001-FED-8-DATE-X.              DTSBE331
00272      MOVE 'INVALID PARM DATE' TO ABEND-MSG.                       DTSBE331
00273      PERFORM S999-ABEND THRU S999-EXIT.                           DTSBE331
00274  I1001-EXIT.                                                      DTSBE331
00275      EXIT.                                                        DTSBE331
00276                                                                   DTSBE331
00277                                                                   DTSBE331
00278  I1002-ERROR.                                                     DTSBE331
00279      DISPLAY 'SUBJECT DATE CANNOT BE > PRIOR RUN DATE '           DTSBE331
00280         L001-FED-8-DATE-X.                                        DTSBE331
00281      MOVE 'FUTURE DATE' TO ABEND-MSG.                             DTSBE331
00282      PERFORM S999-ABEND THRU S999-EXIT.                           DTSBE331
00283  I1002-EXIT.                                                      DTSBE331
00284      EXIT.                                                        DTSBE331
00285                                                                   DTSBE331
00286  I1100-SET-DATES.                                                 DTSBE331
00287      MOVE WRK-SUBJECT-DATE            TO L005-DATE.               DTSBE331
00288      MOVE ZERO                        TO L005-TIME.               DTSBE331
00289      PERFORM S005-FROM-DATE-TIME      THRU S005-EXIT.             DTSBE331
00290      MOVE L005-ABSTIME                TO WRK-ABSTIME.             DTSBE331
00291                                                                   DTSBE331
00292      DISPLAY 'SUBJECT DATE ' WRK-SUBJECT-DATE.                    DTSBE331
00293      DISPLAY 'ABSTIME ' WRK-ABSTIME.                              DTSBE331
00294  I1100-EXIT.                                                      DTSBE331
00295      EXIT.                                                        DTSBE331
00296                                                                   DTSBE331
00297  I1200-DEFAULT-DATE.                                              DTSBE331
00298         MOVE LECM-PRIOR-RUN-DATE      TO L001-FED-8-DATE-9.       DTSBE331
00299         PERFORM S001-FROM-FED-8       THRU S001-EXIT.             DTSBE331
00300         SUBTRACT 3                    FROM L001-FED-8-YR.         DTSBE331
00301         PERFORM S001-FROM-FED-8       THRU S001-EXIT.             DTSBE331
00302         MOVE L001-FED-8-DATE-9        TO WRK-SUBJECT-DATE.        DTSBE331
00303  I1200-EXIT.                                                      DTSBE331
00304      EXIT.                                                        DTSBE331
00305                                                                   DTSBE331
00306  I2000-OPEN-FILES.                                                DTSBE331
00307      OPEN OUTPUT X331-FILE.                                       DTSBE331
00308      IF NOT X331-STATUS-OK-88                                     DTSBE331
00309         DISPLAY 'X331 FILE OPEN ERROR: ' X331-STATUS              DTSBE331
00310         MOVE 'FILE OPEN ERROR'                                    DTSBE331
00311                TO ABEND-MSG                                       DTSBE331
00312         PERFORM S999-ABEND THRU S999-EXIT                         DTSBE331
00313      END-IF.                                                      DTSBE331
00314                                                                   DTSBE331
00315  I2000-EXIT.                                                      DTSBE331
00316      EXIT.                                                        DTSBE331
00317                                                                   DTSBE331
00318  I3000-WRITE-PARM.                                                DTSBE331
00319      OPEN OUTPUT BE331-PARM-FILE.                                 DTSBE331
00320      IF NOT PARM-STATUS-OK-88                                     DTSBE331
00321         DISPLAY 'PARM FILE OPEN ERROR: ' PARM-STATUS              DTSBE331
00322         PERFORM S999-ABEND THRU S999-EXIT                         DTSBE331
00323      END-IF.                                                      DTSBE331
00324                                                                   DTSBE331
00325      WRITE BE331-PARM-REC FROM WRK-SUBJECT-DATE.                  DTSBE331
00326      IF NOT PARM-STATUS-OK-88                                     DTSBE331
00327         DISPLAY 'PARM FILE WRITE ERROR: ' PARM-STATUS             DTSBE331
00328         PERFORM S999-ABEND THRU S999-EXIT                         DTSBE331
00329      END-IF.                                                      DTSBE331
00330                                                                   DTSBE331
00331      CLOSE BE331-PARM-FILE.                                       DTSBE331
00332      IF NOT PARM-STATUS-OK-88                                     DTSBE331
00333         DISPLAY 'PARM FILE CLOSE ERROR: ' PARM-STATUS             DTSBE331
00334         PERFORM S999-ABEND THRU S999-EXIT                         DTSBE331
00335      END-IF.                                                      DTSBE331
00336                                                                   DTSBE331
00337  I3000-EXIT.                                                      DTSBE331
00338      EXIT.                                                        DTSBE331
00339                                                                   DTSBE331
00340  P0000-PROCESS.                                                   DTSBE331
00341      IF MPRF-TOT-BALANCE-AMT > ZERO                               DTSBE331
00342      OR MPRF-TOT-CREDIT-AMT > ZERO                                DTSBE331
00343          NEXT SENTENCE                                            DTSBE331
00344      ELSE                                                         DTSBE331
00345          GO TO P0000-EXIT.                                        DTSBE331
00346                                                                   DTSBE331
00347      PERFORM P4000-ACCTS-RECEIVABLE       THRU P4000-EXIT.        DTSBE331
00348                                                                   DTSBE331
00349  P0000-EXIT.                                                      DTSBE331
00350      EXIT.                                                        DTSBE331
00351                                                                   DTSBE331
00352  P4000-ACCTS-RECEIVABLE.                                          DTSBE331
00353 *&                                                                DTSBE331
00354 *    IF MPRF-EMP-NO = 079042 OR 052388                            DTSBE331
00355 *       DISPLAY 'P4000 ' MPRF-EMP-NO '  ' MJRN-BATCH-NO           DTSBE331
00356 *          '  ' MJRN-ITEM-NO '  ' MJRN-ESTB-DATE                  DTSBE331
00357 *    END-IF.                                                      DTSBE331
00358 *&                                                                DTSBE331
00359      MOVE LOW-VALUES TO MJRN-KEY-AREA.                            DTSBE331
00360      MOVE MPRF-EMP-NO TO MJRN-EMP-NO.                             DTSBE331
00361      MOVE WRK-ABSTIME TO MJRN-ESTB-ABSTIME.                       DTSBE331
00362      SET MJRN-JRN-88 TO TRUE.                                     DTSBE331
00363      MOVE MJRN-KEY-AREA TO MSKL-KEY-AREA.                         DTSBE331
00364      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBE331
00365      PERFORM UNTIL L910-NO-REC-88                                 DTSBE331
00366         MOVE MSKL-REC                TO MJRN-REC                  DTSBE331
00367         ADD +1                       TO WRK-MJRN-READ-CNT         DTSBE331
00368         IF MJRN-ESTB-DATE            >= WRK-SUBJECT-DATE          DTSBE331
00369            PERFORM P4200-ACCT-TABLE  THRU P4200-EXIT              DTSBE331
00370         END-IF                                                    DTSBE331
00371         PERFORM S910-READ-NEXT       THRU S910-EXIT               DTSBE331
00372      END-PERFORM.                                                 DTSBE331
00373                                                                   DTSBE331
00374                                                                   DTSBE331
00375  P4000-EXIT.                                                      DTSBE331
00376      EXIT.                                                        DTSBE331
00377                                                                   DTSBE331
00378  P4200-ACCT-TABLE.                                                DTSBE331
00379      MOVE +400   TO QTR-FIRST                                     DTSBE331
00380      MOVE +0     TO QTR-LAST                                      DTSBE331
00381                     CR-LAST                                       DTSBE331
00382                     CR-SUB.                                       DTSBE331
00383                                                                   DTSBE331
00384      PERFORM                                                      DTSBE331
00385        VARYING QTR-SUB FROM +1 BY +1                              DTSBE331
00386        UNTIL QTR-SUB > +400                                       DTSBE331
00387          MOVE +0 TO WRK-JRN-YRQ (QTR-SUB)                         DTSBE331
00388                     WRK-JRN-AMT (QTR-SUB)                         DTSBE331
00389                     WRK-CREDIT-AMT (QTR-SUB)                      DTSBE331
00390      END-PERFORM.                                                 DTSBE331
00391                                                                   DTSBE331
00392      IF MJRN-TRAN-CNVR-88                                         DTSBE331
00393      OR MJRN-REFUND-PAY-88                                        DTSBE331
00394         GO TO P4200-EXIT.                                         DTSBE331
00395                                                                   DTSBE331
00396      PERFORM P4210-ACCT-ENTRY  THRU P4210-EXIT                    DTSBE331
00397        VARYING MJRN-OCC-IDX FROM +1 BY +1                         DTSBE331
00398        UNTIL MJRN-OCC-IDX > MJRN-OCC-CNT.                         DTSBE331
00399                                                                   DTSBE331
00400      PERFORM P4300-WRITE-DEBITS  THRU P4300-EXIT.                 DTSBE331
00401                                                                   DTSBE331
00402      PERFORM P4400-WRITE-CREDITS THRU P4400-EXIT.                 DTSBE331
00403                                                                   DTSBE331
00404  P4200-EXIT.                                                      DTSBE331
00405      EXIT.                                                        DTSBE331
00406                                                                   DTSBE331
00407                                                                   DTSBE331
00408  P4210-ACCT-ENTRY.                                                DTSBE331
00409      IF MJRN-YRQ (MJRN-OCC-IDX) = LECM-PICKUP-YRQ                 DTSBE331
00410         GO TO P4210-EXIT.                                         DTSBE331
00411                                                                   DTSBE331
00412      IF MJRN-ROW-UI-88 (MJRN-OCC-IDX)                             DTSBE331
00413         PERFORM P4211-TAX               THRU P4211-EXIT           DTSBE331
00414      ELSE                                                         DTSBE331
00415         IF MJRN-YRQ-CREDIT-88 (MJRN-OCC-IDX)                      DTSBE331
00416            PERFORM P4212-CREDIT         THRU P4212-EXIT           DTSBE331
00417            GO TO P4210-EXIT                                       DTSBE331
00418         END-IF                                                    DTSBE331
00419      END-IF.                                                      DTSBE331
00420                                                                   DTSBE331
00421  P4210-EXIT.                                                      DTSBE331
00422      EXIT.                                                        DTSBE331
00423                                                                   DTSBE331
00424  P4211-TAX.                                                       DTSBE331
00425      MOVE MJRN-YRQ (MJRN-OCC-IDX) TO L004-QTR-5-9.                DTSBE331
00426      PERFORM S004-FROM-5          THRU S004-EXIT.                 DTSBE331
00427      MOVE L004-ABS-QTR            TO QTR-SUB.                     DTSBE331
00428      MOVE L004-QTR-5-9            TO WRK-JRN-YRQ (QTR-SUB).       DTSBE331
00429                                                                   DTSBE331
00430      IF QTR-SUB < QTR-FIRST                                       DTSBE331
00431         MOVE QTR-SUB TO QTR-FIRST                                 DTSBE331
00432      END-IF.                                                      DTSBE331
00433                                                                   DTSBE331
00434      IF QTR-SUB > QTR-LAST                                        DTSBE331
00435         MOVE QTR-SUB TO QTR-LAST                                  DTSBE331
00436      END-IF.                                                      DTSBE331
00437                                                                   DTSBE331
00438      IF MJRN-COL-PAID-88 (MJRN-OCC-IDX)                           DTSBE331
00439      OR MJRN-COL-TOLERATED-88 (MJRN-OCC-IDX)                      DTSBE331
00440      OR MJRN-COL-WAIVED-88 (MJRN-OCC-IDX)                         DTSBE331
00441      OR MJRN-COL-WRITTEN-OFF-88 (MJRN-OCC-IDX)                    DTSBE331
00442         SUBTRACT MJRN-AMT (MJRN-OCC-IDX)                          DTSBE331
00443                                  FROM WRK-JRN-AMT (QTR-SUB)       DTSBE331
00444      ELSE                                                         DTSBE331
00445         ADD      MJRN-AMT (MJRN-OCC-IDX)                          DTSBE331
00446                                    TO WRK-JRN-AMT (QTR-SUB)       DTSBE331
00447      END-IF.                                                      DTSBE331
00448                                                                   DTSBE331
00449  P4211-EXIT.                                                      DTSBE331
00450      EXIT.                                                        DTSBE331
00451                                                                   DTSBE331
00452  P4212-CREDIT.                                                    DTSBE331
00453      IF CR-SUB < CR-MAX                                           DTSBE331
00454         ADD +1             TO CR-SUB                              DTSBE331
00455         MOVE CR-SUB        TO CR-LAST                             DTSBE331
00456      ELSE                                                         DTSBE331
00457         DISPLAY 'CREDIT TABLE LENGTH EXCEEDED '                   DTSBE331
00458            MJRN-EMP-NO '  ' MJRN-BATCH-NO '  ' MJRN-ITEM-NO       DTSBE331
00459         GO TO P4212-EXIT                                          DTSBE331
00460      END-IF.                                                      DTSBE331
00461                                                                   DTSBE331
00462      ADD MJRN-AMT (MJRN-OCC-IDX) TO WRK-CREDIT-AMT (CR-SUB).      DTSBE331
00463                                                                   DTSBE331
00464 *&                                                                DTSBE331
00465 *    MOVE MJRN-AMT (MJRN-OCC-IDX) TO DISPLAY-AMT.                 DTSBE331
00466 *    DISPLAY 'P4412 ' MJRN-EMP-NO '  ' MJRN-BATCH-NO              DTSBE331
00467 *       '  ' MJRN-ITEM-NO '  ' DISPLAY-AMT.                       DTSBE331
00468 *    DISPLAY SPACE.                                               DTSBE331
00469 *&                                                                DTSBE331
00470  P4212-EXIT.                                                      DTSBE331
00471      EXIT.                                                        DTSBE331
00472                                                                   DTSBE331
00473                                                                   DTSBE331
00474  P4300-WRITE-DEBITS.                                              DTSBE331
00475      PERFORM                                                      DTSBE331
00476        VARYING QTR-SUB FROM QTR-FIRST BY +1                       DTSBE331
00477        UNTIL QTR-SUB > QTR-LAST                                   DTSBE331
00478          IF WRK-JRN-AMT (QTR-SUB) NOT = ZERO                      DTSBE331
00479             PERFORM P4310-WRITE-X331     THRU P4310-EXIT          DTSBE331
00480         END-IF                                                    DTSBE331
00481      END-PERFORM.                                                 DTSBE331
00482                                                                   DTSBE331
00483  P4300-EXIT.                                                      DTSBE331
00484      EXIT.                                                        DTSBE331
00485                                                                   DTSBE331
00486  P4310-WRITE-X331.                                                DTSBE331
00487      MOVE MPRF-EMP-NO           TO X331-EMP-NO.                   DTSBE331
00488      MOVE WRK-JRN-YRQ (QTR-SUB)  TO X331-YRQ.                     DTSBE331
00489      MOVE MJRN-ESTB-DATE         TO X331-ESTB-DATE.               DTSBE331
00490      MOVE MJRN-BATCH-NO          TO X331-BATCH-NO.                DTSBE331
00491      MOVE MJRN-ITEM-NO           TO X331-ITEM-NO.                 DTSBE331
00492      MOVE MJRN-TRAN-TYPE         TO X331-TRAN-TYPE.               DTSBE331
00493      MOVE MJRN-TRAN-CATEGORY     TO X331-TRAN-CATEGORY.           DTSBE331
00494      MOVE MJRN-EMP-CLASS         TO X331-EMP-CLASS.               DTSBE331
00495                                                                   DTSBE331
00496      MOVE WRK-JRN-AMT (QTR-SUB)  TO X331-AMT.                     DTSBE331
00497 *&                                                                DTSBE331
00498 *    IF MPRF-EMP-NO = 079042 OR 052388                            DTSBE331
00499 *       DISPLAY 'P4311 ' X331-EMP-NO '  ' X331-BATCH-NO           DTSBE331
00500 *          '  ' X331-ITEM-NO '  ' X331-AMT                        DTSBE331
00501 *       DISPLAY SPACE                                             DTSBE331
00502 *    END-IF.                                                      DTSBE331
00503 *&                                                                DTSBE331
00504      WRITE X331-REC.                                              DTSBE331
00505      IF X331-STATUS-OK-88                                         DTSBE331
00506         ADD +1 TO WRK-X331-CNT                                    DTSBE331
00507      ELSE                                                         DTSBE331
00508         DISPLAY 'CANNOT WRITE X331 ' MPRF-EMP-NO                  DTSBE331
00509            '  ' MJRN-BATCH-NO '  ' MJRN-ITEM-NO                   DTSBE331
00510      END-IF.                                                      DTSBE331
00511                                                                   DTSBE331
00512  P4310-EXIT.                                                      DTSBE331
00513      EXIT.                                                        DTSBE331
00514                                                                   DTSBE331
00515  P4400-WRITE-CREDITS.                                             DTSBE331
00516      PERFORM                                                      DTSBE331
00517        VARYING CR-SUB FROM +1 BY +1                               DTSBE331
00518        UNTIL CR-SUB > CR-LAST                                     DTSBE331
00519          IF WRK-CREDIT-AMT (CR-SUB) > +1                          DTSBE331
00520             PERFORM P4410-WRITE-X331     THRU P4410-EXIT          DTSBE331
00521         END-IF                                                    DTSBE331
00522      END-PERFORM.                                                 DTSBE331
00523                                                                   DTSBE331
00524  P4400-EXIT.                                                      DTSBE331
00525      EXIT.                                                        DTSBE331
00526                                                                   DTSBE331
00527  P4410-WRITE-X331.                                                DTSBE331
00528      MOVE MPRF-EMP-NO                 TO X331-EMP-NO.             DTSBE331
00529      MOVE +99999                      TO X331-YRQ.                DTSBE331
00530      MOVE MJRN-ESTB-DATE              TO X331-ESTB-DATE.          DTSBE331
00531      MOVE MJRN-BATCH-NO               TO X331-BATCH-NO.           DTSBE331
00532      MOVE MJRN-ITEM-NO                TO X331-ITEM-NO.            DTSBE331
00533      MOVE MJRN-TRAN-TYPE              TO X331-TRAN-TYPE.          DTSBE331
00534      MOVE MJRN-TRAN-CATEGORY          TO X331-TRAN-CATEGORY.      DTSBE331
00535      MOVE MJRN-EMP-CLASS              TO X331-EMP-CLASS.          DTSBE331
00536                                                                   DTSBE331
00537      MOVE WRK-CREDIT-AMT (CR-SUB) TO X331-AMT.                    DTSBE331
00538 *&                                                                DTSBE331
00539 *    DISPLAY 'P4410 ' X331-EMP-NO '  ' X331-BATCH-NO              DTSBE331
00540 *       '  ' X331-ITEM-NO '  ' X331-AMT '  ' X331-YRQ.            DTSBE331
00541 *    DISPLAY SPACE.                                               DTSBE331
00542 *&                                                                DTSBE331
00543      WRITE X331-REC.                                              DTSBE331
00544      IF X331-STATUS-OK-88                                         DTSBE331
00545         ADD +1 TO WRK-X331-CNT                                    DTSBE331
00546      ELSE                                                         DTSBE331
00547         DISPLAY 'CANNOT WRITE X331 ' MPRF-EMP-NO                  DTSBE331
00548            '  ' MJRN-BATCH-NO '  ' MJRN-ITEM-NO                   DTSBE331
00549      END-IF.                                                      DTSBE331
00550                                                                   DTSBE331
00551  P4410-EXIT.                                                      DTSBE331
00552      EXIT.                                                        DTSBE331
00553                                                                   DTSBE331
00554  T0000-TERMINATE.                                                 DTSBE331
00555      CLOSE X331-FILE.                                             DTSBE331
00556                                                                   DTSBE331
00557      MOVE WRK-X331-CNT TO DISPLAY-CNT.                            DTSBE331
00558                                                                   DTSBE331
00559      DISPLAY '*********************************************'.     DTSBE331
00560      DISPLAY '**   DTSBE331 TERMINATION STATISTICS       **'.     DTSBE331
00561      DISPLAY '**                                         **'.     DTSBE331
00562      DISPLAY '**  X331 COUNT    ' DISPLAY-CNT                     DTSBE331
00563                                       '                  **'.     DTSBE331
00564      DISPLAY '**                                         **'.     DTSBE331
00565      DISPLAY '*********************************************'.     DTSBE331
00566                                                                   DTSBE331
00567  T0000-EXIT.                                                      DTSBE331
00568      EXIT.                                                        DTSBE331
00569                                                                   DTSBE331
00570  S001-FROM-FED-8.                                                 DTSBE331
00571      SET L001-FROM-FED-8 TO TRUE.                                 DTSBE331
00572      GO TO S001-DATE.                                             DTSBE331
00573                                                                   DTSBE331
00574  S001-FROM-ABS-DAY.                                               DTSBE331
00575      SET L001-FROM-ABS-DAY TO TRUE.                               DTSBE331
00576      GO TO S001-DATE.                                             DTSBE331
00577                                                                   DTSBE331
00578  S001-FROM-CAL-6.                                                 DTSBE331
00579      SET L001-FROM-CAL-6 TO TRUE.                                 DTSBE331
00580      GO TO S001-DATE.                                             DTSBE331
00581                                                                   DTSBE331
00582  S001-DATE.                                                       DTSBE331
00583      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBE331
00584  S001-EXIT.                                                       DTSBE331
00585      EXIT.                                                        DTSBE331
00586      SKIP3                                                        DTSBE331
00587  S004-FROM-5.                                                     DTSBE331
00588      SET L004-FROM-5 TO TRUE.                                     DTSBE331
00589      GO TO S004-QTR.                                              DTSBE331
00590                                                                   DTSBE331
00591  S004-FROM-ABS.                                                   DTSBE331
00592      SET L004-FROM-ABS TO TRUE.                                   DTSBE331
00593      GO TO S004-QTR.                                              DTSBE331
00594                                                                   DTSBE331
00595  S004-FROM-3.                                                     DTSBE331
00596      SET L004-FROM-3 TO TRUE.                                     DTSBE331
00597      GO TO S004-QTR.                                              DTSBE331
00598                                                                   DTSBE331
00599  S004-FROM-DATE.                                                  DTSBE331
00600      SET L004-FROM-DATE TO TRUE.                                  DTSBE331
00601      GO TO S004-QTR.                                              DTSBE331
00602                                                                   DTSBE331
00603  S004-QTR.                                                        DTSBE331
00604                                                                   DTSBE331
00605      CALL 'DTSBU004' USING L004-LINK-AREA.                        DTSBE331
00606                                                                   DTSBE331
00607  S004-EXIT.                                                       DTSBE331
00608      EXIT.                                                        DTSBE331
00609      SKIP3                                                        DTSBE331
00610  S005-FROM-DATE-TIME.                                             DTSBE331
00611      SET L005-FROM-DATE-TIME TO TRUE.                             DTSBE331
00612      CALL 'DTSBU005' USING L005-LINK-AREA.                        DTSBE331
00613  S005-EXIT.                                                       DTSBE331
00614      EXIT.                                                        DTSBE331
00615                                                                   DTSBE331
00616  S910-READ.                                                       DTSBE331
00617      SET L910-READ-88 TO TRUE.                                    DTSBE331
00618      GO TO S910-MSTR-IO.                                          DTSBE331
00619                                                                   DTSBE331
00620  S910-START-BROWSE.                                               DTSBE331
00621      SET L910-START-BROWSE-88 TO TRUE.                            DTSBE331
00622      GO TO S910-MSTR-IO.                                          DTSBE331
00623                                                                   DTSBE331
00624  S910-READ-NEXT.                                                  DTSBE331
00625      SET L910-READ-NEXT-88 TO TRUE.                               DTSBE331
00626      GO TO S910-MSTR-IO.                                          DTSBE331
00627                                                                   DTSBE331
00628 *S910-COUNT.                                                      DTSBE331
00629 *****SET L910-COUNT-88 TO TRUE.                                   DTSBE331
00630 *****GO TO S910-MSTR-IO.                                          DTSBE331
00631                                                                   DTSBE331
00632  S910-REWRITE.                                                    DTSBE331
00633      SET L910-REWRITE-88 TO TRUE.                                 DTSBE331
00634      SET LECM-EMP-UPDATED-YES-88 TO TRUE.                         DTSBE331
00635      GO TO S910-MSTR-IO.                                          DTSBE331
00636                                                                   DTSBE331
00637  S910-MSTR-IO.                                                    DTSBE331
00638      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBE331
00639                            MSKL-REC.                              DTSBE331
00640  S910-EXIT.                                                       DTSBE331
00641      EXIT.                                                        DTSBE331
00642      SKIP3                                                        DTSBE331
00643                                                                   DTSBE331
00644  S931-READ.                                                       DTSBE331
00645      SET L931-READ-88 TO TRUE.                                    DTSBE331
00646      GO TO S931-REF-IO.                                           DTSBE331
00647                                                                   DTSBE331
00648  S931-REF-IO.                                                     DTSBE331
00649      CALL 'DTSBU931' USING L931-LINK-AREA                         DTSBE331
00650                            FSKL-REC.                              DTSBE331
00651  S931-EXIT.                                                       DTSBE331
00652      EXIT.                                                        DTSBE331
00653                                                                   DTSBE331
00654  S999-ABEND.                                                      DTSBE331
00655      DISPLAY '*** DTSBE331 ABENDING.  '                           DTSBE331
00656              ABEND-MSG.                                           DTSBE331
00657                                                                   DTSBE331
00658      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBE331
00659  S999-EXIT.                                                       DTSBE331
00660      EXIT.                                                        DTSBE331
