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