00001  IDENTIFICATION DIVISION.                                         01/18/04
00002  PROGRAM-ID.             DTSBU549.                                DTSBU549
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV009
00004  DATE-WRITTEN.           JANUARY 1991.                            DTSBU549
00005  DATE-COMPILED.                                                   DTSBU549
00006      SKIP3                                                        DTSBU549
00007 *****                                                             DTSBU549
00008 *                                                                 DTSBU549
00009 *    FUNCTION:  JOURNALING/BATCH DETAIL LISTING.                  DTSBU549
00010 *                                                                 DTSBU549
00011 *                                                                 DTSBU549
00012 *    MODIFICATION LOG:                                            DTSBU549
00013 *                                                                 DTSBU549
00014 *    01/26/92  INITIAL DEVELOPMENT.                               DTSBU549
00015 *              WORK ORDER:                      PROGRAMMER: TCL   DTSBU549
00016 *                                                                 DTSBU549
00017 *    12/13/1998  REVIEWED AND MODIFIED FOR DC.                    DTSBU549
00018 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH   DTSBU549
00019 *                                                                 DTSBU549
00020 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBU549
00021 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBU549
00022 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSBU549
00023 *                                                                 DTSBU549
00024 *                                                                 DTSBU549
00025 *  DESCRIPTION:                                                   DTSBU549
00026 *                                                                 DTSBU549
00027 *      FOR A GIVEN ACCOUNTING TRANSACTION DTSBU549 IS CALLED:     DTSBU549
00028 *                                                                 DTSBU549
00029 *        A.  ONE TIME WITH L549-INIT-TRAN-88.                     DTSBU549
00030 *                                                                 DTSBU549
00031 *        B.  ZERO, ONE, OR MANY TIMES WITH L549-DELTA-88.         DTSBU549
00032 *                                                                 DTSBU549
00033 *        C.  ONE TIME WITH L549-CANCEL-TRAN-88                    DTSBU549
00034 *            OR L549-TERM-TRAN-88.                                DTSBU549
00035 *                                                                 DTSBU549
00036 *      DTSBU549 SHOULD BE CONSTRUCTED TO PROCESS TWO TRANSACTIONS DTSBU549
00037 *      AT THE SAME TIME.  THIS WILL PROBABLY NOT BE NECESSARY,    DTSBU549
00038 *      BUT WILL BE REQUIRED IF AN ACCOUNTING TRANSACTION CAN      DTSBU549
00039 *      GENERATE AN INTERNAL ACCOUNTING TRANSACTION.               DTSBU549
00040 *                                                                 DTSBU549
00041 *      IF L549-INIT-TRAN-88, THEN HOLD L549-INIT-AREA IN WORKING  DTSBU549
00042 *      STORAGE AND INITIALIZE A TABLE TO HOLD THE CHANGES TO      DTSBU549
00043 *      ACCOUNTING AMOUNTS.                                        DTSBU549
00044 *                                                                 DTSBU549
00045 *      IF L549-DELTA-88, THEN DTSBU549 IS BEING ASKED TO TABLE    DTSBU549
00046 *      A CHANGE TO AN ACCOUNTING AMOUNT.  IF THERE IS NO ROOM IN  DTSBU549
00047 *      THE TABLE FOR THE AMOUNT, THEN WRITE A MJRN RECORD AND     DTSBU549
00048 *      WRITE A R302 RECORD (MAKE THE NUMBER OF OCCURRENCES IN     DTSBU549
00049 *      THE TABLE BIG ENOUGH TO MAKE THIS EVENT RARE).  TABLING    DTSBU549
00050 *      CHANGES TO ACCOUNTING AMOUNTS (BASED ON L549-DELTA-KEY)    DTSBU549
00051 *      WILL ALLOW US TO MINIMIZE THE NUMBER OF MJRN AND R302      DTSBU549
00052 *      RECORDS WRITTEN.                                           DTSBU549
00053 *                                                                 DTSBU549
00054 *      IF L549-CANCEL-TRAN-88                                     DTSBU549
00055 *        IF NO INFORMATION TABLED                                 DTSBU549
00056 *          CANCEL THE TRANSACTION WITHOUT WRITING ANY RECORDS     DTSBU549
00057 *        ELSE                                                     DTSBU549
00058 *          ABEND THE MODULE.                                      DTSBU549
00059 *                                                                 DTSBU549
00060 *      IF L549-TERM-TRN-88                                        DTSBU549
00061 *        WRITE AN R302-TRAN-INFO RECORD                           DTSBU549
00062 *        IF INFORMATION TABLED                                    DTSBU549
00063 *           FOR EACH NON ZERO TABLE ENTRY, WRITE A R302-ACCT-INFO DTSBU549
00064 *           RECORD; WRITE ONE TO TEN MJRN RECORDS.                DTSBU549
00065 *                                                                 DTSBU549
00066 *                                                                 DTSBU549
00067 *      MASTER FILE RECORDS READ:                                  DTSBU549
00068 *                                                                 DTSBU549
00069 *        NONE                                                     DTSBU549
00070 *                                                                 DTSBU549
00071 *                                                                 DTSBU549
00072 *      MASTER FILE RECORDS UPDATED:                               DTSBU549
00073 *                                                                 DTSBU549
00074 *        MJRN (WRITE)                                             DTSBU549
00075 *                                                                 DTSBU549
00076 *                                                                 DTSBU549
00077 *      REPORT RECORDS WRITTEN:                                    DTSBU549
00078 *                                                                 DTSBU549
00079 *        R302  BATCH DETAIL.                                      DTSBU549
00080 *                                                                 DTSBU549
00081 *                                                                 DTSBU549
00082 *      MODULES CALLED:                                            DTSBU549
00083 *                                                                 DTSBU549
00084 *        DTSBU910 MASTER FILE I/O.                                DTSBU549
00085 *        DTSBU946 VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 1.     DTSBU549
00086 *                                                                 DTSBU549
00087 *                                                                 DTSBU549
00088 *****                                                             DTSBU549
00089      SKIP3                                                        DTSBU549
00090  ENVIRONMENT DIVISION.                                            DTSBU549
00091      EJECT                                                        DTSBU549
00092  DATA DIVISION.                                                   DTSBU549
00093      SKIP3                                                        DTSBU549
00094  WORKING-STORAGE SECTION.                                         DTSBU549
000945 77  PAN-VALET PICTURE X(24) VALUE '009DTSBU549  01/18/04'.       DTSBU549
00095      SKIP3                                                        DTSBU549
00096  01  WRK-AREA.                                                    DTSBU549
00097      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +549.DTSBU549
00098                                                                   DTSBU549
00099      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBU549'.DTSBU549
00100                                                                   DTSBU549
00101      05  MAX-DET-CNT                 PIC S9(04)  COMP VALUE +1000.DTSBU549
00102                                                                   DTSBU549
00103      05  ALL-NINES-YRQ               PIC S9(05)  COMP-3           DTSBU549
00104                                                  VALUE +99999.    DTSBU549
00105                                                                   DTSBU549
00106      05  FIRST-TIME-IND              PIC  X(01)  VALUE 'Y'.       DTSBU549
00107                                                                   DTSBU549
00108      05  WRK-MJRN-FOUND-KEY          PIC  X(16).                  DTSBU549
00109                                                                   DTSBU549
00110      05  WRK-START-ABSTIME               PIC S9(15)       COMP-3. DTSBU549
00111                                                                   DTSBU549
00112      05  WRK-ABSTIME                     PIC S9(15)       COMP-3. DTSBU549
00113                                                                   DTSBU549
00114      05  WRK-CURR-RUN-DATE               PIC S9(09)       COMP-3. DTSBU549
00115                                                                   DTSBU549
00116      05  WRK-EMP-NO                      PIC S9(07)       COMP-3. DTSBU549
00117                                                                   DTSBU549
00118      05  WRK-DET-SUB                     PIC S9(04)       COMP.   DTSBU549
00119                                                                   DTSBU549
00120      05  WRK-CREDIT-PAID-AMT             PIC S9(09)V9(02) COMP-3. DTSBU549
00121                                                                   DTSBU549
00122      05  WRK-TRN.                                                 DTSBU549
00123          10  WRK-DOC-NO                  PIC  X(05).              DTSBU549
00124          10  FILLER REDEFINES WRK-DOC-NO.                         DTSBU549
00125              15  WRK-BATCH-NO            PIC S9(05)       COMP-3. DTSBU549
00126              15  WRK-ITEM-NO             PIC S9(03)       COMP-3. DTSBU549
00127          10  WRK-EMP-CLASS               PIC  X(01).              DTSBU549
00128          10  WRK-EMP-ELIGIBLE-CD         PIC S9(03)       COMP-3. DTSBU549
00129          10  WRK-REC-TYPE                PIC  X(01).              DTSBU549
00130          10  WRK-TRANS-TYPE              PIC  X(02).              DTSBU549
00131          10  WRK-RECEIVED-DATE           PIC S9(09)       COMP-3. DTSBU549
00132          10  WRK-DEPOSIT-DATE            PIC S9(09)       COMP-3. DTSBU549
00133          10  WRK-REMIT-AMT               PIC S9(09)V9(02) COMP-3. DTSBU549
00134          10  WRK-WAIVE-INT-IND           PIC  X(01).              DTSBU549
00135          10  WRK-WAIVE-LATE-PEN-IND      PIC  X(01).              DTSBU549
00136          10  WRK-APPLIC-YRQ              PIC S9(05)       COMP-3. DTSBU549
00137          10  WRK-APPLIC-ACCT-IND         PIC  X(02).              DTSBU549
00138          10  WRK-APPLIC-DOC-NO           PIC  X(05).              DTSBU549
00139          10  WRK-RESP-ACTIVITY           PIC  X(03).              DTSBU549
00140          10  WRK-RESP-OP-ID              PIC  X(08).              DTSBU549
00141          10  WRK-TOT-WAGE-CHNG           PIC S9(11)V9(02) COMP-3. DTSBU549
00142          10  WRK-TAX-WAGE-CHNG           PIC S9(11)V9(02) COMP-3. DTSBU549
00143                                                                   DTSBU549
00144          10  WRK-MJRN-CNT                PIC S9(04)       COMP.   DTSBU549
00145                                                                   DTSBU549
00146          10  WRK-R302-CNT                PIC S9(04)       COMP.   DTSBU549
00147                                                                   DTSBU549
00148          10  WRK-DET-CNT                 PIC S9(04)       COMP.   DTSBU549
00149                                                                   DTSBU549
00150          10  WRK-DETAIL OCCURS 1000 TIMES                         DTSBU549
00151                         INDEXED BY WRK-DET-IDX.                   DTSBU549
00152              15  WRK-DET-KEY.                                     DTSBU549
00153                  20  WRK-DET-YRQ         PIC S9(05)       COMP-3. DTSBU549
00154                  20  WRK-DET-ACCT-IND    PIC  X(02).              DTSBU549
00155              15  WRK-DET-DATA.                                    DTSBU549
00156                  20  WRK-DET-CHARGED-AMT PIC S9(09)V9(02) COMP-3. DTSBU549
00157                  20  WRK-DET-PAID-AMT    PIC S9(09)V9(02) COMP-3. DTSBU549
00158                  20  WRK-DET-WAIVED-AMT  PIC S9(09)V9(02) COMP-3. DTSBU549
00159                  20  WRK-DET-WRITTEN-OFF-AMT                      DTSBU549
00160                                          PIC S9(09)V9(02) COMP-3. DTSBU549
00161                  20  WRK-DET-TOLER-AMT   PIC S9(09)V9(02) COMP-3. DTSBU549
00162      SKIP3                                                        DTSBU549
00163  01  TBL-AREA.                                                    DTSBU549
00164      05  TBL-TRN OCCURS 2 TIMES.                                  DTSBU549
00165          10  TBL-DOC-NO                  PIC  X(05).              DTSBU549
00166              88  TBL-EMPTY-88                VALUE LOW-VALUES.    DTSBU549
00167          10  FILLER                      PIC  X(40000).           DTSBU549
00168      EJECT                                                        DTSBU549
00169  01  R302-REC.                                                    DTSBU549
00170  ++INCLUDE DTSIR302                                               DTSBU549
00171      EJECT                                                        DTSBU549
00172  01  L910-LINK-AREA.                                              DTSBU549
00173  ++INCLUDE DTSIL910                                               DTSBU549
00174      SKIP3                                                        DTSBU549
00175  01  MSKL-REC.                                                    DTSBU549
00176  ++INCLUDE DTSIMSKL                                               DTSBU549
00177      SKIP3                                                        DTSBU549
00178  01  MJRN-REC.                                                    DTSBU549
00179  ++INCLUDE DTSIMJRN                                               DTSBU549
00180      EJECT                                                        DTSBU549
00181  01  CACT-LITERALS.                                               DTSBU549
00182  ++INCLUDE DTSICACT                                               DTSBU549
00183      SKIP3                                                        DTSBU549
00184  01  MMAX-LITERALS.                                               DTSBU549
00185  ++INCLUDE DTSIMMAX                                               DTSBU549
00186      EJECT                                                        DTSBU549
00187  LINKAGE SECTION.                                                 DTSBU549
00188      SKIP3                                                        DTSBU549
00189  01  L549-LINK-AREA.                                              DTSBU549
00190  ++INCLUDE DTSIL549                                               DTSBU549
00191      EJECT                                                        DTSBU549
00192  PROCEDURE DIVISION USING L549-LINK-AREA.                         DTSBU549
00193                                                                   DTSBU549
00194                                                                   DTSBU549
00195      IF FIRST-TIME-IND = 'Y'                                      DTSBU549
00196          PERFORM I0000-INITIATE THRU I0000-EXIT                   DTSBU549
00197          MOVE 'N' TO FIRST-TIME-IND.                              DTSBU549
00198                                                                   DTSBU549
00199                                                                   DTSBU549
00200      IF L549-INIT-TRAN-88                                         DTSBU549
00201          PERFORM P1000-INIT-TRAN THRU P1000-EXIT                  DTSBU549
00202      ELSE                                                         DTSBU549
00203      IF L549-DELTA-88                                             DTSBU549
00204          PERFORM P2000-DELTA THRU P2000-EXIT                      DTSBU549
00205      ELSE                                                         DTSBU549
00206      IF L549-CANCEL-TRAN-88                                       DTSBU549
00207          PERFORM P3000-CANCEL-TRAN THRU P3000-EXIT                DTSBU549
00208      ELSE                                                         DTSBU549
00209      IF L549-TERM-TRAN-PRIM-88                                    DTSBU549
00210          PERFORM P4000-TERM-TRAN-PRIM THRU P4000-EXIT             DTSBU549
00211      ELSE                                                         DTSBU549
00212      IF L549-TERM-TRAN-SEC-88                                     DTSBU549
00213          PERFORM P5000-TERM-TRAN-SEC THRU P5000-EXIT              DTSBU549
00214      ELSE                                                         DTSBU549
00215          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU549
00216                                                                   DTSBU549
00217                                                                   DTSBU549
00218      GOBACK.                                                      DTSBU549
00219      EJECT                                                        DTSBU549
00220  I0000-INITIATE.                                                  DTSBU549
00221      MOVE L549-INIT-ABSTIME TO WRK-START-ABSTIME                  DTSBU549
00222                                WRK-ABSTIME.                       DTSBU549
00223                                                                   DTSBU549
00224      MOVE L549-INIT-CURR-RUN-DATE TO WRK-CURR-RUN-DATE.           DTSBU549
00225                                                                   DTSBU549
00226      MOVE -1 TO WRK-EMP-NO.                                       DTSBU549
00227                                                                   DTSBU549
00228      MOVE LOW-VALUES TO TBL-DOC-NO (1)                            DTSBU549
00229                         TBL-DOC-NO (2).                           DTSBU549
00230                                                                   DTSBU549
00231      MOVE L549-INIT-TRACE-IND TO L910-TRACE-IND.                  DTSBU549
00232                                                                   DTSBU549
00233      MOVE WRK-MOD-NAME TO L910-MOD-NAME.                          DTSBU549
00234                                                                   DTSBU549
00235      MOVE LENGTH OF R302-REC TO R302-LENGTH.                      DTSBU549
00236  I0000-EXIT.                                                      DTSBU549
00237      EXIT.                                                        DTSBU549
00238      EJECT                                                        DTSBU549
00239  P0000-EMP-NO-BREAK.                                              DTSBU549
00240      IF (TBL-EMPTY-88 (1)) AND (TBL-EMPTY-88 (2))                 DTSBU549
00241          NEXT SENTENCE                                            DTSBU549
00242      ELSE                                                         DTSBU549
00243          DISPLAY 'BU549 ABEND P0000 ' L549-INIT-EMP-NO            DTSBU549
00244          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU549
00245                                                                   DTSBU549
00246      MOVE WRK-START-ABSTIME TO WRK-ABSTIME.                       DTSBU549
00247  P0000-EXIT.                                                      DTSBU549
00248      EXIT.                                                        DTSBU549
00249      EJECT                                                        DTSBU549
00250  P1000-INIT-TRAN.                                                 DTSBU549
00251      IF L549-INIT-EMP-NO NOT = WRK-EMP-NO                         DTSBU549
00252          PERFORM P0000-EMP-NO-BREAK THRU P0000-EXIT               DTSBU549
00253          MOVE L549-INIT-EMP-NO TO WRK-EMP-NO.                     DTSBU549
00254                                                                   DTSBU549
00255      PERFORM P1100-INIT-WRK THRU P1100-EXIT.                      DTSBU549
00256                                                                   DTSBU549
00257      IF TBL-EMPTY-88 (1)                                          DTSBU549
00258          MOVE WRK-TRN TO TBL-TRN (1)                              DTSBU549
00259      ELSE                                                         DTSBU549
00260      IF TBL-EMPTY-88 (2)                                          DTSBU549
00261          MOVE WRK-TRN TO TBL-TRN (2)                              DTSBU549
00262      ELSE                                                         DTSBU549
00263          DISPLAY 'BU549 ABEND P1000 ' L549-INIT-EMP-NO            DTSBU549
00264          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU549
00265  P1000-EXIT.                                                      DTSBU549
00266      EXIT.                                                        DTSBU549
00267      EJECT                                                        DTSBU549
00268  P1100-INIT-WRK.                                                  DTSBU549
00269      MOVE L549-TRN-DOC-NO TO WRK-DOC-NO.                          DTSBU549
00270                                                                   DTSBU549
00271      MOVE L549-INIT-EMP-CLASS TO WRK-EMP-CLASS.                   DTSBU549
00272                                                                   DTSBU549
00273      MOVE L549-INIT-ELIGIBLE-CD TO WRK-EMP-ELIGIBLE-CD.           DTSBU549
00274                                                                   DTSBU549
00275      MOVE L549-INIT-REC-TYPE TO WRK-REC-TYPE.                     DTSBU549
00276                                                                   DTSBU549
00277      MOVE L549-INIT-TRANS-TYPE TO WRK-TRANS-TYPE.                 DTSBU549
00278                                                                   DTSBU549
00279      MOVE L549-INIT-RECEIVED-DATE TO WRK-RECEIVED-DATE.           DTSBU549
00280                                                                   DTSBU549
00281      MOVE L549-INIT-DEPOSIT-DATE TO WRK-DEPOSIT-DATE.             DTSBU549
00282                                                                   DTSBU549
00283      MOVE L549-INIT-REMIT-AMT TO WRK-REMIT-AMT.                   DTSBU549
00284                                                                   DTSBU549
00285      MOVE L549-INIT-WAIVE-INT-IND TO WRK-WAIVE-INT-IND.           DTSBU549
00286                                                                   DTSBU549
00287      MOVE L549-INIT-WAIVE-LATE-PEN-IND TO WRK-WAIVE-LATE-PEN-IND. DTSBU549
00288                                                                   DTSBU549
00289      MOVE L549-INIT-APPLIC-YRQ TO WRK-APPLIC-YRQ.                 DTSBU549
00290                                                                   DTSBU549
00291      MOVE L549-INIT-APPLIC-ACCT-IND TO WRK-APPLIC-ACCT-IND.       DTSBU549
00292                                                                   DTSBU549
00293      MOVE L549-INIT-APPLIC-DOC-NO TO WRK-APPLIC-DOC-NO.           DTSBU549
00294                                                                   DTSBU549
00295      MOVE L549-INIT-RESP-ACTIVITY TO WRK-RESP-ACTIVITY.           DTSBU549
00296                                                                   DTSBU549
00297      MOVE L549-INIT-RESP-OP-ID TO WRK-RESP-OP-ID.                 DTSBU549
00298                                                                   DTSBU549
00299      MOVE +0 TO WRK-TOT-WAGE-CHNG                                 DTSBU549
00300                 WRK-TAX-WAGE-CHNG.                                DTSBU549
00301                                                                   DTSBU549
00302      MOVE +0 TO WRK-R302-CNT                                      DTSBU549
00303                 WRK-DET-CNT                                       DTSBU549
00304                 WRK-MJRN-CNT.                                     DTSBU549
00305  P1100-EXIT.                                                      DTSBU549
00306      EXIT.                                                        DTSBU549
00307      EJECT                                                        DTSBU549
00308  P2000-DELTA.                                                     DTSBU549
00309      IF L549-TRN-DOC-NO = TBL-DOC-NO (1)                          DTSBU549
00310          MOVE TBL-TRN (1) TO WRK-TRN                              DTSBU549
00311          PERFORM P2100-UPDATE-WRK THRU P2100-EXIT                 DTSBU549
00312          MOVE WRK-TRN TO TBL-TRN (1)                              DTSBU549
00313      ELSE                                                         DTSBU549
00314      IF L549-TRN-DOC-NO = TBL-DOC-NO (2)                          DTSBU549
00315          MOVE TBL-TRN (2) TO WRK-TRN                              DTSBU549
00316          PERFORM P2100-UPDATE-WRK THRU P2100-EXIT                 DTSBU549
00317          MOVE WRK-TRN TO TBL-TRN (2)                              DTSBU549
00318      ELSE                                                         DTSBU549
00319          DISPLAY 'BU549 ABEND P2000 ' L549-INIT-EMP-NO            DTSBU549
00320          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU549
00321  P2000-EXIT.                                                      DTSBU549
00322      EXIT.                                                        DTSBU549
00323      SKIP3                                                        DTSBU549
00324  P2100-UPDATE-WRK.                                                DTSBU549
00325      IF L549-DELTA-ACCT-IND = CACT-ACCT-WAGE                      DTSBU549
00326          PERFORM P2130-WAGE THRU P2130-EXIT                       DTSBU549
00327          GO TO P2100-EXIT.                                        DTSBU549
00328                                                                   DTSBU549
00329                                                                   DTSBU549
00330      MOVE +0 TO WRK-DET-SUB.                                      DTSBU549
00331                                                                   DTSBU549
00332      PERFORM P2110-LOCATE-DET-KEY THRU P2110-EXIT                 DTSBU549
00333          VARYING WRK-DET-IDX FROM 1 BY 1                          DTSBU549
00334          UNTIL (WRK-DET-IDX > WRK-DET-CNT)                        DTSBU549
00335                   OR                                              DTSBU549
00336                (WRK-DET-SUB NOT = 0).                             DTSBU549
00337                                                                   DTSBU549
00338      IF WRK-DET-SUB = 0                                           DTSBU549
00339          PERFORM P2120-INIT-DET-KEY THRU P2120-EXIT.              DTSBU549
00340                                                                   DTSBU549
00341      IF L549-DELTA-CAT-IND = CACT-CAT-CHARGED                     DTSBU549
00342          ADD L549-DELTA-AMT TO WRK-DET-CHARGED-AMT (WRK-DET-SUB)  DTSBU549
00343      ELSE                                                         DTSBU549
00344      IF L549-DELTA-CAT-IND = CACT-CAT-PAID                        DTSBU549
00345          ADD L549-DELTA-AMT TO WRK-DET-PAID-AMT (WRK-DET-SUB)     DTSBU549
00346      ELSE                                                         DTSBU549
00347      IF L549-DELTA-CAT-IND = CACT-CAT-WAIVED                      DTSBU549
00348          ADD L549-DELTA-AMT TO WRK-DET-WAIVED-AMT (WRK-DET-SUB)   DTSBU549
00349      ELSE                                                         DTSBU549
00350      IF L549-DELTA-CAT-IND = CACT-CAT-WRITTEN-OFF                 DTSBU549
00351          ADD L549-DELTA-AMT                                       DTSBU549
00352           TO WRK-DET-WRITTEN-OFF-AMT (WRK-DET-SUB)                DTSBU549
00353      ELSE                                                         DTSBU549
00354      IF L549-DELTA-CAT-IND = CACT-CAT-TOLER                       DTSBU549
00355          ADD L549-DELTA-AMT TO WRK-DET-TOLER-AMT (WRK-DET-SUB)    DTSBU549
00356      ELSE                                                         DTSBU549
00357          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU549
00358  P2100-EXIT.                                                      DTSBU549
00359      EXIT.                                                        DTSBU549
00360      SKIP3                                                        DTSBU549
00361  P2110-LOCATE-DET-KEY.                                            DTSBU549
00362      IF L549-DELTA-KEY = WRK-DET-KEY (WRK-DET-IDX)                DTSBU549
00363          SET WRK-DET-SUB TO WRK-DET-IDX.                          DTSBU549
00364  P2110-EXIT.                                                      DTSBU549
00365      EXIT.                                                        DTSBU549
00366      SKIP3                                                        DTSBU549
00367  P2120-INIT-DET-KEY.                                              DTSBU549
00368      IF WRK-DET-CNT < MAX-DET-CNT                                 DTSBU549
00369          NEXT SENTENCE                                            DTSBU549
00370      ELSE                                                         DTSBU549
00371          DISPLAY '*** DTSBU549 WRK-DETAIL MAX OCCURENCES '        DTSBU549
00372                  'EXCEEDED.'                                      DTSBU549
00373          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU549
00374                                                                   DTSBU549
00375                                                                   DTSBU549
00376      ADD +1 TO WRK-DET-CNT.                                       DTSBU549
00377                                                                   DTSBU549
00378      MOVE L549-DELTA-KEY TO WRK-DET-KEY (WRK-DET-CNT).            DTSBU549
00379                                                                   DTSBU549
00380      MOVE +0 TO WRK-DET-CHARGED-AMT (WRK-DET-CNT)                 DTSBU549
00381                 WRK-DET-PAID-AMT (WRK-DET-CNT)                    DTSBU549
00382                 WRK-DET-WAIVED-AMT (WRK-DET-CNT)                  DTSBU549
00383                 WRK-DET-WRITTEN-OFF-AMT (WRK-DET-CNT)             DTSBU549
00384                 WRK-DET-TOLER-AMT (WRK-DET-CNT).                  DTSBU549
00385                                                                   DTSBU549
00386      MOVE WRK-DET-CNT TO WRK-DET-SUB.                             DTSBU549
00387  P2120-EXIT.                                                      DTSBU549
00388      EXIT.                                                        DTSBU549
00389      SKIP3                                                        DTSBU549
00390  P2130-WAGE.                                                      DTSBU549
00391      IF L549-DELTA-YRQ = WRK-APPLIC-YRQ                           DTSBU549
00392          NEXT SENTENCE                                            DTSBU549
00393      ELSE                                                         DTSBU549
00394          DISPLAY 'BU549 ABEND P2130 - 1 ' L549-INIT-EMP-NO        DTSBU549
00395          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU549
00396                                                                   DTSBU549
00397      IF L549-DELTA-CAT-IND = CACT-CAT-TOT-WAGE                    DTSBU549
00398          ADD L549-DELTA-AMT TO WRK-TOT-WAGE-CHNG                  DTSBU549
00399      ELSE                                                         DTSBU549
00400      IF L549-DELTA-CAT-IND = CACT-CAT-TAX-WAGE                    DTSBU549
00401          ADD L549-DELTA-AMT TO WRK-TAX-WAGE-CHNG                  DTSBU549
00402      ELSE                                                         DTSBU549
00403          DISPLAY 'BU549 ABEND P2130 - 2 ' L549-INIT-EMP-NO        DTSBU549
00404          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU549
00405  P2130-EXIT.                                                      DTSBU549
00406      EXIT.                                                        DTSBU549
00407      EJECT                                                        DTSBU549
00408  P3000-CANCEL-TRAN.                                               DTSBU549
00409      IF L549-TRN-DOC-NO = TBL-DOC-NO (1)                          DTSBU549
00410          MOVE TBL-TRN (1) TO WRK-TRN                              DTSBU549
00411          PERFORM P3100-CANCEL-WRK THRU P3100-EXIT                 DTSBU549
00412          MOVE WRK-TRN TO TBL-TRN (1)                              DTSBU549
00413      ELSE                                                         DTSBU549
00414      IF L549-TRN-DOC-NO = TBL-DOC-NO (2)                          DTSBU549
00415          MOVE TBL-TRN (2) TO WRK-TRN                              DTSBU549
00416          PERFORM P3100-CANCEL-WRK THRU P3100-EXIT                 DTSBU549
00417          MOVE WRK-TRN TO TBL-TRN (2)                              DTSBU549
00418      ELSE                                                         DTSBU549
00419          DISPLAY 'BU549 ABEND P3000 ' L549-INIT-EMP-NO            DTSBU549
00420          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU549
00421  P3000-EXIT.                                                      DTSBU549
00422      EXIT.                                                        DTSBU549
00423      SKIP3                                                        DTSBU549
00424  P3100-CANCEL-WRK.                                                DTSBU549
00425      IF WRK-DET-CNT = 0                                           DTSBU549
00426          MOVE LOW-VALUES TO WRK-DOC-NO                            DTSBU549
00427      ELSE                                                         DTSBU549
00428          DISPLAY 'BU549 ABEND P3100 ' L549-INIT-EMP-NO            DTSBU549
00429          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU549
00430  P3100-EXIT.                                                      DTSBU549
00431      EXIT.                                                        DTSBU549
00432      EJECT                                                        DTSBU549
00433  P4000-TERM-TRAN-PRIM.                                            DTSBU549
00434      IF L549-TRN-DOC-NO = TBL-DOC-NO (1)                          DTSBU549
00435          MOVE TBL-TRN (1) TO WRK-TRN                              DTSBU549
00436          PERFORM P4100-TERM-PRIM-WRK THRU P4100-EXIT              DTSBU549
00437          MOVE WRK-TRN TO TBL-TRN (1)                              DTSBU549
00438      ELSE                                                         DTSBU549
00439      IF L549-TRN-DOC-NO = TBL-DOC-NO (2)                          DTSBU549
00440          MOVE TBL-TRN (2) TO WRK-TRN                              DTSBU549
00441          PERFORM P4100-TERM-PRIM-WRK THRU P4100-EXIT              DTSBU549
00442          MOVE WRK-TRN TO TBL-TRN (2)                              DTSBU549
00443      ELSE                                                         DTSBU549
00444          DISPLAY 'BU549 ABEND P4000 ' L549-INIT-EMP-NO            DTSBU549
00445          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU549
00446  P4000-EXIT.                                                      DTSBU549
00447      EXIT.                                                        DTSBU549
00448      SKIP3                                                        DTSBU549
00449  P4100-TERM-PRIM-WRK.                                             DTSBU549
00450      ADD +100 TO WRK-ABSTIME.                                     DTSBU549
00451                                                                   DTSBU549
00452      PERFORM S1100-INIT-MJRN THRU S1100-EXIT.                     DTSBU549
00453                                                                   DTSBU549
00454      PERFORM S1200-INIT-R302-TRAN-DATA THRU S1200-EXIT.           DTSBU549
00455                                                                   DTSBU549
00456      PERFORM S9200-R302-WRITE THRU S9200-EXIT.                    DTSBU549
00457                                                                   DTSBU549
00458      SET R302-ACCT-DATA-88 TO TRUE.                               DTSBU549
00459                                                                   DTSBU549
00460      MOVE LOW-VALUES TO R302-TRAN-DATA-AREA.                      DTSBU549
00461                                                                   DTSBU549
00462      PERFORM S2100-WRK-DET-PROCESS THRU S2100-EXIT                DTSBU549
00463          VARYING WRK-DET-IDX FROM 1 BY 1                          DTSBU549
00464          UNTIL WRK-DET-IDX > WRK-DET-CNT.                         DTSBU549
00465                                                                   DTSBU549
00466      IF MJRN-OCC-CNT > +0                                         DTSBU549
00467          PERFORM S9100-MJRN-WRITE THRU S9100-EXIT.                DTSBU549
00468                                                                   DTSBU549
00469 *****IF WRK-R302-CNT = +0                                         DTSBU549
00470 *********MOVE +0 TO R302-SORT-YRQ                                 DTSBU549
00471 ********************R302-SORT-ACCT-SEQ                            DTSBU549
00472 *********MOVE SPACE TO R302-SORT-ACCT-IND                         DTSBU549
00473 *********MOVE +0 TO R302-YRQ                                      DTSBU549
00474 *********MOVE SPACE TO R302-ACCT-IND                              DTSBU549
00475 *********MOVE +0 TO R302-CHARGED-AMT                              DTSBU549
00476 ********************R302-PAID-AMT                                 DTSBU549
00477 ********************R302-WAIVED-AMT                               DTSBU549
00478 ********************R302-WRITTEN-OFF-AMT                          DTSBU549
00479 ********************R302-TOLER-AMT                                DTSBU549
00480 *********PERFORM S9200-R302-WRITE THRU S9200-EXIT.                DTSBU549
00481                                                                   DTSBU549
00482      MOVE LOW-VALUES TO WRK-DOC-NO.                               DTSBU549
00483  P4100-EXIT.                                                      DTSBU549
00484      EXIT.                                                        DTSBU549
00485      EJECT                                                        DTSBU549
00486  P5000-TERM-TRAN-SEC.                                             DTSBU549
00487      IF L549-TRN-DOC-NO = TBL-DOC-NO (1)                          DTSBU549
00488          MOVE TBL-TRN (1) TO WRK-TRN                              DTSBU549
00489          PERFORM P5100-TERM-SEC-WRK THRU P5100-EXIT               DTSBU549
00490          MOVE WRK-TRN TO TBL-TRN (1)                              DTSBU549
00491      ELSE                                                         DTSBU549
00492      IF L549-TRN-DOC-NO = TBL-DOC-NO (2)                          DTSBU549
00493          MOVE TBL-TRN (2) TO WRK-TRN                              DTSBU549
00494          PERFORM P5100-TERM-SEC-WRK THRU P5100-EXIT               DTSBU549
00495          MOVE WRK-TRN TO TBL-TRN (2)                              DTSBU549
00496      ELSE                                                         DTSBU549
00497          DISPLAY 'BU549 ABEND P5000 ' L549-INIT-EMP-NO            DTSBU549
00498          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU549
00499  P5000-EXIT.                                                      DTSBU549
00500      EXIT.                                                        DTSBU549
00501      SKIP3                                                        DTSBU549
00502  P5100-TERM-SEC-WRK.                                              DTSBU549
00503      PERFORM P5110-PREPARE-MJRN THRU P5110-EXIT.                  DTSBU549
00504                                                                   DTSBU549
00505      MOVE WRK-DEPOSIT-DATE TO R302-DEPOSIT-DATE.                  DTSBU549
00506                                                                   DTSBU549
00507      MOVE WRK-BATCH-NO TO R302-BATCH-NO.                          DTSBU549
00508                                                                   DTSBU549
00509      MOVE WRK-EMP-NO TO R302-EMP-NO.                              DTSBU549
00510                                                                   DTSBU549
00511      MOVE WRK-ITEM-NO TO R302-ITEM-NO.                            DTSBU549
00512                                                                   DTSBU549
00513      SET R302-ACCT-DATA-88 TO TRUE.                               DTSBU549
00514                                                                   DTSBU549
00515      MOVE +0 TO R302-SORT-YRQ                                     DTSBU549
00516                 R302-SORT-ACCT-SEQ.                               DTSBU549
00517                                                                   DTSBU549
00518      MOVE SPACES TO R302-SORT-ACCT-IND.                           DTSBU549
00519                                                                   DTSBU549
00520      MOVE LOW-VALUES TO R302-TRAN-DATA-AREA.                      DTSBU549
00521                                                                   DTSBU549
00522      PERFORM S2100-WRK-DET-PROCESS THRU S2100-EXIT                DTSBU549
00523          VARYING WRK-DET-IDX FROM 1 BY 1                          DTSBU549
00524          UNTIL WRK-DET-IDX > WRK-DET-CNT.                         DTSBU549
00525                                                                   DTSBU549
00526      IF MJRN-OCC-CNT > +0                                         DTSBU549
00527          PERFORM S9100-MJRN-WRITE THRU S9100-EXIT.                DTSBU549
00528                                                                   DTSBU549
00529      MOVE LOW-VALUES TO WRK-DOC-NO.                               DTSBU549
00530  P5100-EXIT.                                                      DTSBU549
00531      EXIT.                                                        DTSBU549
00532      SKIP3                                                        DTSBU549
00533  P5110-PREPARE-MJRN.                                              DTSBU549
00534      MOVE LOW-VALUES TO MJRN-KEY-AREA.                            DTSBU549
00535                                                                   DTSBU549
00536      MOVE WRK-EMP-NO TO MJRN-EMP-NO.                              DTSBU549
00537                                                                   DTSBU549
00538      SET MJRN-JRN-88 TO TRUE.                                     DTSBU549
00539                                                                   DTSBU549
00540      MOVE WRK-START-ABSTIME TO MJRN-ESTB-ABSTIME.                 DTSBU549
00541                                                                   DTSBU549
00542      MOVE LOW-VALUES TO WRK-MJRN-FOUND-KEY.                       DTSBU549
00543                                                                   DTSBU549
00544      MOVE MJRN-KEY-AREA TO MSKL-KEY-AREA.                         DTSBU549
00545                                                                   DTSBU549
00546      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBU549
00547                                                                   DTSBU549
00548      PERFORM P5111-SCAN-MJRN THRU P5111-EXIT                      DTSBU549
00549          UNTIL L910-NO-REC-88.                                    DTSBU549
00550                                                                   DTSBU549
00551      IF WRK-MJRN-FOUND-KEY = LOW-VALUES                           DTSBU549
00552          ADD +100 TO WRK-ABSTIME                                  DTSBU549
00553          PERFORM S1100-INIT-MJRN THRU S1100-EXIT                  DTSBU549
00554      ELSE                                                         DTSBU549
00555          MOVE WRK-MJRN-FOUND-KEY TO MSKL-KEY-AREA                 DTSBU549
00556          PERFORM S910-READ THRU S910-EXIT                         DTSBU549
00557          IF L910-NO-REC-88                                        DTSBU549
00558              DISPLAY 'BU549 ABEND P5110 ' L549-INIT-EMP-NO        DTSBU549
00559              PERFORM S999-ABEND THRU S999-EXIT                    DTSBU549
00560          END-IF                                                   DTSBU549
00561          MOVE MSKL-REC TO MJRN-REC                                DTSBU549
00562          PERFORM S910-DELETE THRU S910-EXIT.                      DTSBU549
00563  P5110-EXIT.                                                      DTSBU549
00564      EXIT.                                                        DTSBU549
00565      SKIP3                                                        DTSBU549
00566  P5111-SCAN-MJRN.                                                 DTSBU549
00567      MOVE MSKL-REC TO MJRN-REC.                                   DTSBU549
00568                                                                   DTSBU549
00569      IF MJRN-DOC-NO = WRK-DOC-NO                                  DTSBU549
00570          MOVE MJRN-KEY-AREA TO WRK-MJRN-FOUND-KEY.                DTSBU549
00571                                                                   DTSBU549
00572      PERFORM S910-READ-NEXT THRU S910-EXIT.                       DTSBU549
00573  P5111-EXIT.                                                      DTSBU549
00574      EXIT.                                                        DTSBU549
00575      EJECT                                                        DTSBU549
00576  S1100-INIT-MJRN.                                                 DTSBU549
00577      MOVE LOW-VALUES TO MJRN-REC.                                 DTSBU549
00578                                                                   DTSBU549
00579      MOVE WRK-EMP-NO TO MJRN-EMP-NO.                              DTSBU549
00580                                                                   DTSBU549
00581      SET MJRN-JRN-88 TO TRUE.                                     DTSBU549
00582                                                                   DTSBU549
00583      MOVE WRK-ABSTIME TO MJRN-ESTB-ABSTIME.                       DTSBU549
00584                                                                   DTSBU549
00585      MOVE +0 TO MJRN-PURGE-DATE.                                  DTSBU549
00586                                                                   DTSBU549
00587      MOVE WRK-DOC-NO TO MJRN-DOC-NO.                              DTSBU549
00588                                                                   DTSBU549
00589      MOVE WRK-REC-TYPE TO MJRN-TRAN-CATEGORY.                     DTSBU549
00590                                                                   DTSBU549
00591      MOVE WRK-TRANS-TYPE TO MJRN-TRAN-TYPE.                       DTSBU549
00592                                                                   DTSBU549
00593      MOVE WRK-RECEIVED-DATE TO MJRN-RECEIVED-DATE.                DTSBU549
00594                                                                   DTSBU549
00595      MOVE WRK-DEPOSIT-DATE TO MJRN-DEPOSIT-DATE.                  DTSBU549
00596                                                                   DTSBU549
00597      MOVE WRK-EMP-CLASS TO MJRN-EMP-CLASS.                        DTSBU549
00598                                                                   DTSBU549
00599      MOVE WRK-EMP-ELIGIBLE-CD TO MJRN-ELIGIBLE-CD.                DTSBU549
00600                                                                   DTSBU549
00601      MOVE WRK-RESP-ACTIVITY TO MJRN-RESPONSIBLE-ACTIVITY.         DTSBU549
00602                                                                   DTSBU549
00603      MOVE WRK-RESP-OP-ID TO MJRN-RESPONSIBLE-OP-ID.               DTSBU549
00604                                                                   DTSBU549
00605      SET MJRN-NOT-CONVERTED-88 TO TRUE.                           DTSBU549
00606                                                                   DTSBU549
00607      MOVE WRK-CURR-RUN-DATE TO MJRN-ESTB-DATE.                    DTSBU549
00608                                                                   DTSBU549
00609      MOVE +0 TO MJRN-OCC-CNT.                                     DTSBU549
00610  S1100-EXIT.                                                      DTSBU549
00611      EXIT.                                                        DTSBU549
00612      SKIP3                                                        DTSBU549
00613  S1200-INIT-R302-TRAN-DATA.                                       DTSBU549
00614      MOVE WRK-DEPOSIT-DATE TO R302-DEPOSIT-DATE.                  DTSBU549
00615                                                                   DTSBU549
00616      MOVE WRK-BATCH-NO TO R302-BATCH-NO.                          DTSBU549
00617                                                                   DTSBU549
00618      MOVE WRK-ITEM-NO TO R302-ITEM-NO.                            DTSBU549
00619                                                                   DTSBU549
00620      MOVE WRK-EMP-NO TO R302-EMP-NO.                              DTSBU549
00621                                                                   DTSBU549
00622      SET R302-TRAN-DATA-88 TO TRUE.                               DTSBU549
00623                                                                   DTSBU549
00624      MOVE +0 TO R302-SORT-YRQ                                     DTSBU549
00625                 R302-SORT-ACCT-SEQ.                               DTSBU549
00626                                                                   DTSBU549
00627      MOVE SPACE TO R302-SORT-ACCT-IND.                            DTSBU549
00628                                                                   DTSBU549
00629      MOVE LOW-VALUES TO R302-TRAN-DATA-AREA.                      DTSBU549
00630                                                                   DTSBU549
00631      MOVE WRK-CURR-RUN-DATE TO R302-CURR-RUN-DATE.                DTSBU549
00632                                                                   DTSBU549
00633      MOVE WRK-RECEIVED-DATE TO R302-RECEIVED-DATE.                DTSBU549
00634                                                                   DTSBU549
00635      MOVE WRK-REC-TYPE TO R302-ACCT-REC-TYPE.                     DTSBU549
00636                                                                   DTSBU549
00637      MOVE WRK-TRANS-TYPE TO R302-TRANS-TYPE.                      DTSBU549
00638                                                                   DTSBU549
00639      MOVE WRK-APPLIC-YRQ TO R302-APPLIC-YRQ.                      DTSBU549
00640                                                                   DTSBU549
00641      MOVE WRK-APPLIC-ACCT-IND TO R302-APPLIC-ACCT-IND.            DTSBU549
00642                                                                   DTSBU549
00643      MOVE WRK-APPLIC-DOC-NO TO R302-APPLIC-DOC-NO.                DTSBU549
00644                                                                   DTSBU549
00645      MOVE WRK-WAIVE-INT-IND TO R302-WAIVE-INT-IND.                DTSBU549
00646                                                                   DTSBU549
00647      MOVE WRK-WAIVE-LATE-PEN-IND TO R302-WAIVE-LATE-PEN-IND.      DTSBU549
00648                                                                   DTSBU549
00649      MOVE WRK-REMIT-AMT TO R302-REMIT-AMT.                        DTSBU549
00650                                                                   DTSBU549
00651      MOVE WRK-TOT-WAGE-CHNG TO R302-TOT-WAGE-CHNG.                DTSBU549
00652                                                                   DTSBU549
00653      MOVE WRK-TAX-WAGE-CHNG TO R302-TAX-WAGE-CHNG.                DTSBU549
00654                                                                   DTSBU549
00655      SET R302-OK-88 TO TRUE.                                      DTSBU549
00656  S1200-EXIT.                                                      DTSBU549
00657      EXIT.                                                        DTSBU549
00658      EJECT                                                        DTSBU549
00659  S2100-WRK-DET-PROCESS.                                           DTSBU549
00660      IF (WRK-DET-CHARGED-AMT (WRK-DET-IDX) = +0)                  DTSBU549
00661             AND                                                   DTSBU549
00662         (WRK-DET-PAID-AMT (WRK-DET-IDX) = +0)                     DTSBU549
00663             AND                                                   DTSBU549
00664         (WRK-DET-WAIVED-AMT (WRK-DET-IDX) = +0)                   DTSBU549
00665             AND                                                   DTSBU549
00666         (WRK-DET-WRITTEN-OFF-AMT (WRK-DET-IDX) = +0)              DTSBU549
00667             AND                                                   DTSBU549
00668         (WRK-DET-TOLER-AMT (WRK-DET-IDX) = +0)                    DTSBU549
00669          GO TO S2100-EXIT.                                        DTSBU549
00670                                                                   DTSBU549
00671      IF WRK-DET-ACCT-IND (WRK-DET-IDX) = CACT-ACCT-CREDIT         DTSBU549
00672          PERFORM S2110-CREDIT THRU S2110-EXIT                     DTSBU549
00673      ELSE                                                         DTSBU549
00674          PERFORM S2120-NOT-CREDIT THRU S2120-EXIT.                DTSBU549
00675  S2100-EXIT.                                                      DTSBU549
00676      EXIT.                                                        DTSBU549
00677      EJECT                                                        DTSBU549
00678  S2110-CREDIT.                                                    DTSBU549
00679      COMPUTE WRK-CREDIT-PAID-AMT                                  DTSBU549
00680        = WRK-DET-PAID-AMT (WRK-DET-IDX)                           DTSBU549
00681           + WRK-DET-WRITTEN-OFF-AMT (WRK-DET-IDX)                 DTSBU549
00682           + WRK-DET-TOLER-AMT (WRK-DET-IDX).                      DTSBU549
00683                                                                   DTSBU549
00684      IF WRK-CREDIT-PAID-AMT = +0                                  DTSBU549
00685          NEXT SENTENCE                                            DTSBU549
00686      ELSE                                                         DTSBU549
00687          PERFORM S2111-CREDIT-PAID-MJRN THRU S2111-EXIT.          DTSBU549
00688                                                                   DTSBU549
00689      IF WRK-DET-WRITTEN-OFF-AMT (WRK-DET-IDX) = +0                DTSBU549
00690          NEXT SENTENCE                                            DTSBU549
00691      ELSE                                                         DTSBU549
00692          PERFORM S2112-CREDIT-WRITTEN-OFF-MJRN THRU S2112-EXIT.   DTSBU549
00693                                                                   DTSBU549
00694      IF WRK-DET-TOLER-AMT (WRK-DET-IDX) = +0                      DTSBU549
00695          NEXT SENTENCE                                            DTSBU549
00696      ELSE                                                         DTSBU549
00697          PERFORM S2113-CREDIT-TOLER-MJRN THRU S2113-EXIT.         DTSBU549
00698                                                                   DTSBU549
00699                                                                   DTSBU549
00700      MOVE ALL-NINES-YRQ TO R302-SORT-YRQ.                         DTSBU549
00701                                                                   DTSBU549
00702      MOVE +0 TO R302-SORT-ACCT-SEQ.                               DTSBU549
00703                                                                   DTSBU549
00704      MOVE CACT-ACCT-CREDIT TO R302-SORT-ACCT-IND.                 DTSBU549
00705                                                                   DTSBU549
00706      MOVE CACT-CREDIT-YRQ TO R302-YRQ.                            DTSBU549
00707                                                                   DTSBU549
00708      MOVE CACT-ACCT-CREDIT TO R302-ACCT-IND.                      DTSBU549
00709                                                                   DTSBU549
00710      MOVE +0 TO R302-CHARGED-AMT.                                 DTSBU549
00711                                                                   DTSBU549
00712      MOVE WRK-CREDIT-PAID-AMT TO R302-PAID-AMT.                   DTSBU549
00713                                                                   DTSBU549
00714      MOVE +0 TO R302-WAIVED-AMT.                                  DTSBU549
00715                                                                   DTSBU549
00716      COMPUTE R302-WRITTEN-OFF-AMT                                 DTSBU549
00717        = WRK-DET-WRITTEN-OFF-AMT (WRK-DET-IDX) * -1.              DTSBU549
00718                                                                   DTSBU549
00719      COMPUTE R302-TOLER-AMT                                       DTSBU549
00720        = WRK-DET-TOLER-AMT (WRK-DET-IDX) * -1.                    DTSBU549
00721                                                                   DTSBU549
00722      IF (R302-PAID-AMT = +0)                                      DTSBU549
00723             AND                                                   DTSBU549
00724         (R302-WRITTEN-OFF-AMT = +0)                               DTSBU549
00725             AND                                                   DTSBU549
00726         (R302-TOLER-AMT = +0)                                     DTSBU549
00727          NEXT SENTENCE                                            DTSBU549
00728      ELSE                                                         DTSBU549
00729          PERFORM S9200-R302-WRITE THRU S9200-EXIT.                DTSBU549
00730  S2110-EXIT.                                                      DTSBU549
00731      EXIT.                                                        DTSBU549
00732      SKIP3                                                        DTSBU549
00733  S2111-CREDIT-PAID-MJRN.                                          DTSBU549
00734      IF MJRN-OCC-CNT < MMAX-JRN-ACCT-MAX                          DTSBU549
00735          NEXT SENTENCE                                            DTSBU549
00736      ELSE                                                         DTSBU549
00737          PERFORM S9100-MJRN-WRITE THRU S9100-EXIT.                DTSBU549
00738                                                                   DTSBU549
00739                                                                   DTSBU549
00740      ADD +1 TO MJRN-OCC-CNT.                                      DTSBU549
00741                                                                   DTSBU549
00742      MOVE CACT-ACCT-CREDIT TO MJRN-ACCT-ROW (MJRN-OCC-CNT).       DTSBU549
00743                                                                   DTSBU549
00744      MOVE CACT-CAT-PAID TO MJRN-ACCT-COL (MJRN-OCC-CNT).          DTSBU549
00745                                                                   DTSBU549
00746      MOVE CACT-CREDIT-YRQ TO MJRN-YRQ (MJRN-OCC-CNT).             DTSBU549
00747                                                                   DTSBU549
00748      MOVE WRK-CREDIT-PAID-AMT TO MJRN-AMT (MJRN-OCC-CNT).         DTSBU549
00749  S2111-EXIT.                                                      DTSBU549
00750      EXIT.                                                        DTSBU549
00751      SKIP3                                                        DTSBU549
00752  S2112-CREDIT-WRITTEN-OFF-MJRN.                                   DTSBU549
00753      IF MJRN-OCC-CNT < MMAX-JRN-ACCT-MAX                          DTSBU549
00754          NEXT SENTENCE                                            DTSBU549
00755      ELSE                                                         DTSBU549
00756          PERFORM S9100-MJRN-WRITE THRU S9100-EXIT.                DTSBU549
00757                                                                   DTSBU549
00758                                                                   DTSBU549
00759      ADD +1 TO MJRN-OCC-CNT.                                      DTSBU549
00760                                                                   DTSBU549
00761      MOVE CACT-ACCT-CREDIT TO MJRN-ACCT-ROW (MJRN-OCC-CNT).       DTSBU549
00762                                                                   DTSBU549
00763      MOVE CACT-CAT-WRITTEN-OFF TO MJRN-ACCT-COL (MJRN-OCC-CNT).   DTSBU549
00764                                                                   DTSBU549
00765      MOVE CACT-CREDIT-YRQ TO MJRN-YRQ (MJRN-OCC-CNT).             DTSBU549
00766                                                                   DTSBU549
00767      COMPUTE MJRN-AMT (MJRN-OCC-CNT)                              DTSBU549
00768        = WRK-DET-WRITTEN-OFF-AMT (WRK-DET-IDX) * -1.              DTSBU549
00769  S2112-EXIT.                                                      DTSBU549
00770      EXIT.                                                        DTSBU549
00771      SKIP3                                                        DTSBU549
00772  S2113-CREDIT-TOLER-MJRN.                                         DTSBU549
00773      IF MJRN-OCC-CNT < MMAX-JRN-ACCT-MAX                          DTSBU549
00774          NEXT SENTENCE                                            DTSBU549
00775      ELSE                                                         DTSBU549
00776          PERFORM S9100-MJRN-WRITE THRU S9100-EXIT.                DTSBU549
00777                                                                   DTSBU549
00778                                                                   DTSBU549
00779      ADD +1 TO MJRN-OCC-CNT.                                      DTSBU549
00780                                                                   DTSBU549
00781      MOVE CACT-ACCT-CREDIT TO MJRN-ACCT-ROW (MJRN-OCC-CNT).       DTSBU549
00782                                                                   DTSBU549
00783      MOVE CACT-CAT-TOLER TO MJRN-ACCT-COL (MJRN-OCC-CNT).         DTSBU549
00784                                                                   DTSBU549
00785      MOVE CACT-CREDIT-YRQ TO MJRN-YRQ (MJRN-OCC-CNT).             DTSBU549
00786                                                                   DTSBU549
00787      COMPUTE MJRN-AMT (MJRN-OCC-CNT)                              DTSBU549
00788        = WRK-DET-TOLER-AMT (WRK-DET-IDX) * -1.                    DTSBU549
00789  S2113-EXIT.                                                      DTSBU549
00790      EXIT.                                                        DTSBU549
00791      EJECT                                                        DTSBU549
00792  S2120-NOT-CREDIT.                                                DTSBU549
00793      IF WRK-DET-CHARGED-AMT (WRK-DET-IDX) = +0                    DTSBU549
00794          NEXT SENTENCE                                            DTSBU549
00795      ELSE                                                         DTSBU549
00796          PERFORM S2121-CHARGED-MJRN THRU S2121-EXIT.              DTSBU549
00797                                                                   DTSBU549
00798      IF WRK-DET-PAID-AMT (WRK-DET-IDX) = +0                       DTSBU549
00799          NEXT SENTENCE                                            DTSBU549
00800      ELSE                                                         DTSBU549
00801          PERFORM S2122-PAID-MJRN THRU S2122-EXIT.                 DTSBU549
00802                                                                   DTSBU549
00803      IF WRK-DET-WAIVED-AMT (WRK-DET-IDX) = +0                     DTSBU549
00804          NEXT SENTENCE                                            DTSBU549
00805      ELSE                                                         DTSBU549
00806          PERFORM S2123-WAIVED-MJRN THRU S2123-EXIT.               DTSBU549
00807                                                                   DTSBU549
00808      IF WRK-DET-WRITTEN-OFF-AMT (WRK-DET-IDX) = +0                DTSBU549
00809          NEXT SENTENCE                                            DTSBU549
00810      ELSE                                                         DTSBU549
00811          PERFORM S2124-WRITTEN-OFF-MJRN THRU S2124-EXIT.          DTSBU549
00812                                                                   DTSBU549
00813      IF WRK-DET-TOLER-AMT (WRK-DET-IDX) = +0                      DTSBU549
00814          NEXT SENTENCE                                            DTSBU549
00815      ELSE                                                         DTSBU549
00816          PERFORM S2125-TOLER-MJRN THRU S2125-EXIT.                DTSBU549
00817                                                                   DTSBU549
00818      IF WRK-DET-YRQ (WRK-DET-IDX) = WRK-APPLIC-YRQ                DTSBU549
00819          MOVE +0 TO R302-SORT-YRQ                                 DTSBU549
00820      ELSE                                                         DTSBU549
00821          MOVE WRK-DET-YRQ (WRK-DET-IDX) TO R302-SORT-YRQ.         DTSBU549
00822                                                                   DTSBU549
00823      MOVE WRK-DET-ACCT-IND (WRK-DET-IDX) TO R302-SORT-ACCT-IND.   DTSBU549
00824                                                                   DTSBU549
00825      SET CACT-ACCT-IDX TO 1.                                      DTSBU549
00826                                                                   DTSBU549
00827      SEARCH CACT-ACCT-LIT                                         DTSBU549
00828          AT END                                                   DTSBU549
00829              MOVE +32 TO R302-SORT-ACCT-SEQ                       DTSBU549
00830          WHEN                                                     DTSBU549
00831              R302-SORT-ACCT-IND                                   DTSBU549
00832                 = CACT-ACCT-LIT (CACT-ACCT-IDX)                   DTSBU549
00833               SET R302-SORT-ACCT-SEQ TO CACT-ACCT-IDX.            DTSBU549
00834                                                                   DTSBU549
00835 *****                                                             DTSBU549
00836 *****                                                             DTSBU549
00837 *****REVERSE 'P ' AND 'I ' ON R302 DETAIL LINES ONLY.             DTSBU549
00838 *****PER DANITA 03/14/95.                                         DTSBU549
00839 *****                                                             DTSBU549
00840 *****                                                             DTSBU549
00841                                                                   DTSBU549
00842 *****IF R302-SORT-ACCT-SEQ = +5                                   DTSBU549
00843 *********MOVE +6 TO R302-SORT-ACCT-SEQ                            DTSBU549
00844 *****ELSE                                                         DTSBU549
00845 *****IF R302-SORT-ACCT-SEQ = +6                                   DTSBU549
00846 *********MOVE +5 TO R302-SORT-ACCT-SEQ.                           DTSBU549
00847                                                                   DTSBU549
00848      MOVE WRK-DET-YRQ (WRK-DET-IDX) TO R302-YRQ.                  DTSBU549
00849                                                                   DTSBU549
00850      MOVE WRK-DET-ACCT-IND (WRK-DET-IDX) TO R302-ACCT-IND.        DTSBU549
00851                                                                   DTSBU549
00852      MOVE WRK-DET-CHARGED-AMT (WRK-DET-IDX) TO R302-CHARGED-AMT.  DTSBU549
00853                                                                   DTSBU549
00854      MOVE WRK-DET-PAID-AMT (WRK-DET-IDX) TO R302-PAID-AMT.        DTSBU549
00855                                                                   DTSBU549
00856      MOVE WRK-DET-WAIVED-AMT (WRK-DET-IDX) TO R302-WAIVED-AMT.    DTSBU549
00857                                                                   DTSBU549
00858      MOVE WRK-DET-WRITTEN-OFF-AMT (WRK-DET-IDX)                   DTSBU549
00859        TO R302-WRITTEN-OFF-AMT.                                   DTSBU549
00860                                                                   DTSBU549
00861      MOVE WRK-DET-TOLER-AMT (WRK-DET-IDX) TO R302-TOLER-AMT.      DTSBU549
00862                                                                   DTSBU549
00863      PERFORM S9200-R302-WRITE THRU S9200-EXIT.                    DTSBU549
00864  S2120-EXIT.                                                      DTSBU549
00865      EXIT.                                                        DTSBU549
00866      SKIP3                                                        DTSBU549
00867  S2121-CHARGED-MJRN.                                              DTSBU549
00868      IF MJRN-OCC-CNT < MMAX-JRN-ACCT-MAX                          DTSBU549
00869          NEXT SENTENCE                                            DTSBU549
00870      ELSE                                                         DTSBU549
00871          PERFORM S9100-MJRN-WRITE THRU S9100-EXIT.                DTSBU549
00872                                                                   DTSBU549
00873                                                                   DTSBU549
00874      ADD +1 TO MJRN-OCC-CNT.                                      DTSBU549
00875                                                                   DTSBU549
00876      MOVE WRK-DET-ACCT-IND (WRK-DET-IDX)                          DTSBU549
00877        TO MJRN-ACCT-ROW (MJRN-OCC-CNT).                           DTSBU549
00878                                                                   DTSBU549
00879      MOVE CACT-CAT-CHARGED                                        DTSBU549
00880        TO MJRN-ACCT-COL (MJRN-OCC-CNT).                           DTSBU549
00881                                                                   DTSBU549
00882      MOVE WRK-DET-YRQ (WRK-DET-IDX)                               DTSBU549
00883        TO MJRN-YRQ (MJRN-OCC-CNT).                                DTSBU549
00884                                                                   DTSBU549
00885      MOVE WRK-DET-CHARGED-AMT (WRK-DET-IDX)                       DTSBU549
00886        TO MJRN-AMT (MJRN-OCC-CNT).                                DTSBU549
00887  S2121-EXIT.                                                      DTSBU549
00888      EXIT.                                                        DTSBU549
00889      SKIP3                                                        DTSBU549
00890  S2122-PAID-MJRN.                                                 DTSBU549
00891      IF MJRN-OCC-CNT < MMAX-JRN-ACCT-MAX                          DTSBU549
00892          NEXT SENTENCE                                            DTSBU549
00893      ELSE                                                         DTSBU549
00894          PERFORM S9100-MJRN-WRITE THRU S9100-EXIT.                DTSBU549
00895                                                                   DTSBU549
00896                                                                   DTSBU549
00897      ADD +1 TO MJRN-OCC-CNT.                                      DTSBU549
00898                                                                   DTSBU549
00899      MOVE WRK-DET-ACCT-IND (WRK-DET-IDX)                          DTSBU549
00900        TO MJRN-ACCT-ROW (MJRN-OCC-CNT).                           DTSBU549
00901                                                                   DTSBU549
00902      MOVE CACT-CAT-PAID                                           DTSBU549
00903        TO MJRN-ACCT-COL (MJRN-OCC-CNT).                           DTSBU549
00904                                                                   DTSBU549
00905      MOVE WRK-DET-YRQ (WRK-DET-IDX)                               DTSBU549
00906        TO MJRN-YRQ (MJRN-OCC-CNT).                                DTSBU549
00907                                                                   DTSBU549
00908      MOVE WRK-DET-PAID-AMT (WRK-DET-IDX)                          DTSBU549
00909        TO MJRN-AMT (MJRN-OCC-CNT).                                DTSBU549
00910  S2122-EXIT.                                                      DTSBU549
00911      EXIT.                                                        DTSBU549
00912      SKIP3                                                        DTSBU549
00913  S2123-WAIVED-MJRN.                                               DTSBU549
00914      IF MJRN-OCC-CNT < MMAX-JRN-ACCT-MAX                          DTSBU549
00915          NEXT SENTENCE                                            DTSBU549
00916      ELSE                                                         DTSBU549
00917          PERFORM S9100-MJRN-WRITE THRU S9100-EXIT.                DTSBU549
00918                                                                   DTSBU549
00919                                                                   DTSBU549
00920      ADD +1 TO MJRN-OCC-CNT.                                      DTSBU549
00921                                                                   DTSBU549
00922      MOVE WRK-DET-ACCT-IND (WRK-DET-IDX)                          DTSBU549
00923        TO MJRN-ACCT-ROW (MJRN-OCC-CNT).                           DTSBU549
00924                                                                   DTSBU549
00925      MOVE CACT-CAT-WAIVED                                         DTSBU549
00926        TO MJRN-ACCT-COL (MJRN-OCC-CNT).                           DTSBU549
00927                                                                   DTSBU549
00928      MOVE WRK-DET-YRQ (WRK-DET-IDX)                               DTSBU549
00929        TO MJRN-YRQ (MJRN-OCC-CNT).                                DTSBU549
00930                                                                   DTSBU549
00931      MOVE WRK-DET-WAIVED-AMT (WRK-DET-IDX)                        DTSBU549
00932        TO MJRN-AMT (MJRN-OCC-CNT).                                DTSBU549
00933  S2123-EXIT.                                                      DTSBU549
00934      EXIT.                                                        DTSBU549
00935      SKIP3                                                        DTSBU549
00936  S2124-WRITTEN-OFF-MJRN.                                          DTSBU549
00937      IF MJRN-OCC-CNT < MMAX-JRN-ACCT-MAX                          DTSBU549
00938          NEXT SENTENCE                                            DTSBU549
00939      ELSE                                                         DTSBU549
00940          PERFORM S9100-MJRN-WRITE THRU S9100-EXIT.                DTSBU549
00941                                                                   DTSBU549
00942                                                                   DTSBU549
00943      ADD +1 TO MJRN-OCC-CNT.                                      DTSBU549
00944                                                                   DTSBU549
00945      MOVE WRK-DET-ACCT-IND (WRK-DET-IDX)                          DTSBU549
00946        TO MJRN-ACCT-ROW (MJRN-OCC-CNT).                           DTSBU549
00947                                                                   DTSBU549
00948      MOVE CACT-CAT-WRITTEN-OFF                                    DTSBU549
00949        TO MJRN-ACCT-COL (MJRN-OCC-CNT).                           DTSBU549
00950                                                                   DTSBU549
00951      MOVE WRK-DET-YRQ (WRK-DET-IDX)                               DTSBU549
00952        TO MJRN-YRQ (MJRN-OCC-CNT).                                DTSBU549
00953                                                                   DTSBU549
00954      MOVE WRK-DET-WRITTEN-OFF-AMT (WRK-DET-IDX)                   DTSBU549
00955        TO MJRN-AMT (MJRN-OCC-CNT).                                DTSBU549
00956  S2124-EXIT.                                                      DTSBU549
00957      EXIT.                                                        DTSBU549
00958      SKIP3                                                        DTSBU549
00959  S2125-TOLER-MJRN.                                                DTSBU549
00960      IF MJRN-OCC-CNT < MMAX-JRN-ACCT-MAX                          DTSBU549
00961          NEXT SENTENCE                                            DTSBU549
00962      ELSE                                                         DTSBU549
00963          PERFORM S9100-MJRN-WRITE THRU S9100-EXIT.                DTSBU549
00964                                                                   DTSBU549
00965                                                                   DTSBU549
00966      ADD +1 TO MJRN-OCC-CNT.                                      DTSBU549
00967                                                                   DTSBU549
00968      MOVE WRK-DET-ACCT-IND (WRK-DET-IDX)                          DTSBU549
00969        TO MJRN-ACCT-ROW (MJRN-OCC-CNT).                           DTSBU549
00970                                                                   DTSBU549
00971      MOVE CACT-CAT-TOLER                                          DTSBU549
00972        TO MJRN-ACCT-COL (MJRN-OCC-CNT).                           DTSBU549
00973                                                                   DTSBU549
00974      MOVE WRK-DET-YRQ (WRK-DET-IDX)                               DTSBU549
00975        TO MJRN-YRQ (MJRN-OCC-CNT).                                DTSBU549
00976                                                                   DTSBU549
00977      MOVE WRK-DET-TOLER-AMT (WRK-DET-IDX)                         DTSBU549
00978        TO MJRN-AMT (MJRN-OCC-CNT).                                DTSBU549
00979  S2125-EXIT.                                                      DTSBU549
00980      EXIT.                                                        DTSBU549
00981      EJECT                                                        DTSBU549
00982  S9100-MJRN-WRITE.                                                DTSBU549
00983      MOVE MJRN-REC TO MSKL-REC.                                   DTSBU549
00984                                                                   DTSBU549
00985      PERFORM S910-WRITE THRU S910-EXIT.                           DTSBU549
00986                                                                   DTSBU549
00987      ADD +1 TO MJRN-ESTB-ABSTIME                                  DTSBU549
00988                WRK-MJRN-CNT.                                      DTSBU549
00989                                                                   DTSBU549
00990      MOVE +0 TO MJRN-OCC-CNT.                                     DTSBU549
00991  S9100-EXIT.                                                      DTSBU549
00992      EXIT.                                                        DTSBU549
00993      SKIP3                                                        DTSBU549
00994  S9200-R302-WRITE.                                                DTSBU549
00995      PERFORM S946-R302-WRITE THRU S946-EXIT.                      DTSBU549
00996                                                                   DTSBU549
00997      ADD +1 TO WRK-R302-CNT.                                      DTSBU549
00998  S9200-EXIT.                                                      DTSBU549
00999      EXIT.                                                        DTSBU549
01000      EJECT                                                        DTSBU549
01001  S910-READ.                                                       DTSBU549
01002      SET L910-READ-88 TO TRUE.                                    DTSBU549
01003      GO TO S910-MSTR-IO.                                          DTSBU549
01004                                                                   DTSBU549
01005  S910-START-BROWSE.                                               DTSBU549
01006      SET L910-START-BROWSE-88 TO TRUE.                            DTSBU549
01007      GO TO S910-MSTR-IO.                                          DTSBU549
01008                                                                   DTSBU549
01009  S910-READ-NEXT.                                                  DTSBU549
01010      SET L910-READ-NEXT-88 TO TRUE.                               DTSBU549
01011      GO TO S910-MSTR-IO.                                          DTSBU549
01012                                                                   DTSBU549
01013 *S910-COUNT.                                                      DTSBU549
01014 *****SET L910-COUNT-88 TO TRUE.                                   DTSBU549
01015 *****GO TO S910-MSTR-IO.                                          DTSBU549
01016                                                                   DTSBU549
01017  S910-WRITE.                                                      DTSBU549
01018 *****SET LBCM-EMP-UPDATE-YES-88 TO TRUE.                          DTSBU549
01019      SET L910-WRITE-88 TO TRUE.                                   DTSBU549
01020      GO TO S910-MSTR-IO.                                          DTSBU549
01021                                                                   DTSBU549
01022 *S910-REWRITE.                                                    DTSBU549
01023 *****SET LBCM-EMP-UPDATE-YES-88 TO TRUE.                          DTSBU549
01024 *****SET L910-REWRITE-88 TO TRUE.                                 DTSBU549
01025 *****GO TO S910-MSTR-IO.                                          DTSBU549
01026                                                                   DTSBU549
01027  S910-DELETE.                                                     DTSBU549
01028 *****SET LBCM-EMP-UPDATE-YES-88 TO TRUE.                          DTSBU549
01029      SET L910-DELETE-88 TO TRUE.                                  DTSBU549
01030      GO TO S910-MSTR-IO.                                          DTSBU549
01031                                                                   DTSBU549
01032  S910-MSTR-IO.                                                    DTSBU549
01033      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBU549
01034                            MSKL-REC.                              DTSBU549
01035  S910-EXIT.                                                       DTSBU549
01036      EXIT.                                                        DTSBU549
01037      SKIP3                                                        DTSBU549
01038  S946-R302-WRITE.                                                 DTSBU549
01039      CALL 'DTSBU946' USING R302-REC.                              DTSBU549
01040  S946-EXIT.                                                       DTSBU549
01041      EXIT.                                                        DTSBU549
01042      SKIP3                                                        DTSBU549
01043  S999-ABEND.                                                      DTSBU549
01044      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBU549
01045  S999-EXIT.                                                       DTSBU549
01046      EXIT.                                                        DTSBU549
