00001  IDENTIFICATION DIVISION.                                         04/30/08
00002  PROGRAM-ID.             DTSBE426.                                DTSBE426
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV024
00004  DATE-WRITTEN.           AUGUST 1994.                             DTSBE426
00005                          MODIFIED BY TRW JAN 1999.                DTSBE426
00006  DATE-COMPILED.                                                   DTSBE426
00007      SKIP3                                                        DTSBE426
00008 *****                                                             DTSBE426
00009 *                                                                 DTSBE426
00010 *    CALLING SEQUENCE:  DTSBD400 CALLS                            DTSBE426
00011 *                       DTSBE426 WHICH CREATES DTSIR426 RECORDS   DTSBE426
00012 *                       DTSBD800 CALLS                            DTSBE426
00013 *                       DTSBR426 WHICH READS DTSIR426 RECORDS     DTSBE426
00014 *                                                                 DTSBE426
00015 *    FUNCTION:  COLLECTIONS SUMMARY REPORT EXTRACT.               DTSBE426
00016 *                                                                 DTSBE426
00017 *                                                                 DTSBE426
00018 *    MODIFICATION LOG:                                            DTSBE426
00019 *                                                                 DTSBE426
00020 *    10/06/2001  OJR IMPLEMENATION                          JMO'  DTSBE426
00021 *                WORK ORDER:                      PROGRAMMER:     DTSBE426
00022 *                                                                 DTSBE426
00023 *    03/20/2006  MODIFIED P3111 TO EXCLUDE SURTAX FROM INTEREST   DTSBE426
00024 *                CALCULATION.                                     DTSBE426
00025 *                WORK ORDER: ADMIN ASSESSMENT     PROGRAMMER: GD  DTSBE426
00026 *                                                                 DTSBE426
00027 *    01/31/2008  MODIFIED ADMINISTRATIVE ASSESSMENT PROCESS       DTSBE426
00028 *                TO INCLUDE PENALTY AND INTEREST CALCULATION      DTSBE426
00029 *                STARTING WITH 2008/1.                            DTSBE426
00030 *                REFERENCE: ADMIN ASSESS        PROGRAMMER: RW1   DTSBE426
00031 *                                                                 DTSBE426
00032 *  DESCRIPTION:                                                   DTSBE426
00033 *                                                                 DTSBE426
00034 *                                                                 DTSBE426
00035 *    INITIATION:                                                  DTSBE426
00036 *                                                                 DTSBE426
00037 *      SET LECM-MST-OPEN-READ-88 TO TRUE.                         DTSBE426
00038 *      SET LECM-REF-OPEN-READ-88 TO TRUE.                         DTSBE426
00039 *                                                                 DTSBE426
00040 *      EDIT AND DEFAULT PARAMETERS.  SEE PRINTED OUTPUTS          DTSBE426
00041 *      DESCRIPTIONS AND LAYOUTS (426R1).                          DTSBE426
00042 *                                                                 DTSBE426
00043 *                                                                 DTSBE426
00044 *    PROCESSING:                                                  DTSBE426
00045 *                                                                 DTSBE426
00046 *      SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS (426R1).       DTSBE426
00047 *                                                                 DTSBE426
00048 *                                                                 DTSBE426
00049 *    TERMINATION:                                                 DTSBE426
00050 *                                                                 DTSBE426
00051 *      NONE.                                                      DTSBE426
00052 *                                                                 DTSBE426
00053 *                                                                 DTSBE426
00054 *    RECORDS READ:                                                DTSBE426
00055 *                                                                 DTSBE426
00056 *      MASTER:                                                    DTSBE426
00057 *                                                                 DTSBE426
00058 *        MQTR                                                     DTSBE426
00059 *        MFAS                                                     DTSBE426
00060 *        MLIN                                                     DTSBE426
00061 *                                                                 DTSBE426
00062 *                                                                 DTSBE426
00063 *      ALTERNATE INDEX:                                           DTSBE426
00064 *                                                                 DTSBE426
00065 *        NONE.                                                    DTSBE426
00066 *                                                                 DTSBE426
00067 *                                                                 DTSBE426
00068 *      REFERENCE:                                                 DTSBE426
00069 *                                                                 DTSBE426
00070 *        NONE.                                                    DTSBE426
00071 *                                                                 DTSBE426
00072 *                                                                 DTSBE426
00073 *    RECORDS UPDATED:                                             DTSBE426
00074 *                                                                 DTSBE426
00075 *        NONE.                                                    DTSBE426
00076 *                                                                 DTSBE426
00077 *                                                                 DTSBE426
00078 *    REPORT RECORDS WRITTEN:                                      DTSBE426
00079 *                                                                 DTSBE426
00080 *        R426  COLLECTIONS SUMMARY REPORT.                        DTSBE426
00081 *                                                                 DTSBE426
00082 *                                                                 DTSBE426
00083 *    BATCH TRANSACTION COLLECTION RECORDS WRITTEN:                DTSBE426
00084 *                                                                 DTSBE426
00085 *        NONE.                                                    DTSBE426
00086 *                                                                 DTSBE426
00087 *                                                                 DTSBE426
00088 *    MODULES CALLED:                                              DTSBE426
00089 *                                                                 DTSBE426
00090 *        DTSBU001  DATE CONVERSION/EDIT.                          DTSBE426
00091 *        DTSBU004  QUARTER CONVERSION/EDIT.                       DTSBE426
00092 *        DTSBU061  FIELD ZIP / FIELD REP ID.                      DTSBE426
00093 *        DTSBU101  INTEREST AND PENALTY COMPUTATION.              DTSBE426
00094 *        DTSBU910  MASTER FILE I/O DRIVER.                        DTSBE426
00095 *        DTSBU946  VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1.   DTSBE426
00096 *                                                                 DTSBE426
00097 *                                                                 DTSBE426
00098 *    VERMONT REFERENCE:                                           DTSBE426
00099 *                                                                 DTSBE426
00100 *        NONE.                                                    DTSBE426
00101 *                                                                 DTSBE426
00102 *****                                                             DTSBE426
00103      SKIP3                                                        DTSBE426
00104  ENVIRONMENT DIVISION.                                            DTSBE426
00105      EJECT                                                        DTSBE426
00106  DATA DIVISION.                                                   DTSBE426
00107      SKIP3                                                        DTSBE426
00108  WORKING-STORAGE SECTION.                                         DTSBE426
001085 77  PAN-VALET PICTURE X(24) VALUE '024DTSBE426  04/30/08'.       DTSBE426
00109      SKIP3                                                        DTSBE426
00110  01  WRK-AREA.                                                    DTSBE426
00111      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +426.DTSBE426
00112      SKIP1                                                        DTSBE426
00113      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBE426'.DTSBE426
00114      SKIP3                                                        DTSBE426
00115      05  ABEND-MSG                   PIC  X(60).                  DTSBE426
00116                                                                   DTSBE426
00117      05  WRK-SUB                     PIC S9(04)  COMP.            DTSBE426
00118                                                                   DTSBE426
00119  01  WRK-BUCKETS.                                                 DTSBE426
00120                                                                   DTSBE426
00121      05  WRK-QTR-UI-DUE              PIC S9(09)V99 COMP-3.        DTSBE426
00122      05  WRK-QTR-UI-PD               PIC S9(09)V99 COMP-3.        DTSBE426
00123      05  WRK-QTR-SUR-DUE             PIC S9(09)V99 COMP-3.        DTSBE426
00124      05  WRK-QTR-SUR-PD              PIC S9(09)V99 COMP-3.        DTSBE426
00125      05  WRK-QTR-PEN-DUE             PIC S9(09)V99 COMP-3.        DTSBE426
00126      05  WRK-QTR-PEN-PD              PIC S9(09)V99 COMP-3.        DTSBE426
00127      05  WRK-QTR-INT-DUE             PIC S9(09)V99 COMP-3.        DTSBE426
00128      05  WRK-QTR-INT-PD              PIC S9(09)V99 COMP-3.        DTSBE426
00129      05  WRK-SUR-TOT                 PIC S9(09)V99 COMP-3         DTSBE426
00130                                            VALUE +0.              DTSBE426
00131      05  WRK-QTR-INT-DUE-TOT         PIC S9(09)V99 COMP-3         DTSBE426
00132                                            VALUE +0.              DTSBE426
00133      05  WRK-LIENED-UI-DUE           PIC S9(09)V99 COMP-3.        DTSBE426
00134      05  WRK-LIENED-SUR-DUE          PIC S9(09)V99 COMP-3.        DTSBE426
00135      05  WRK-LIENED-PEN-DUE          PIC S9(09)V99 COMP-3.        DTSBE426
00136      05  WRK-LIENED-INT-DUE          PIC S9(09)V99 COMP-3.        DTSBE426
00137                                                                   DTSBE426
00138      05  WRK-NOT-LIENED-UI-DUE       PIC S9(09)V99 COMP-3.        DTSBE426
00139      05  WRK-NOT-LIENED-SUR-DUE      PIC S9(09)V99 COMP-3.        DTSBE426
00140      05  WRK-NOT-LIENED-PEN-DUE      PIC S9(09)V99 COMP-3.        DTSBE426
00141      05  WRK-NOT-LIENED-INT-DUE      PIC S9(09)V99 COMP-3.        DTSBE426
00142      SKIP3                                                        DTSBE426
00143      05  WRK-ACTIVE-AR-FAS-IND       PIC  X(01).                  DTSBE426
00144          88  WRK-ACTIVE-AR-FAS-YES-88           VALUE 'Y'.        DTSBE426
00145          88  WRK-ACTIVE-AR-FAS-NO-88            VALUE 'N'.        DTSBE426
00146                                                                   DTSBE426
00147      05  WRK-ACTIVE-LIEN-IND         PIC  X(01).                  DTSBE426
00148          88  WRK-ACTIVE-LIEN-YES-88             VALUE 'Y'.        DTSBE426
00149          88  WRK-ACTIVE-LIEN-NO-88              VALUE 'N'.        DTSBE426
00150                                                                   DTSBE426
00151      05  HOLD-YRQ                    PIC S9(05)  COMP-3.          DTSBE426
00152 *RW1                                                              DTSBE426
00153      05  WRK-FIRST-PEN-INT-YRQ       PIC S9(05)  COMP-3.          DTSBE426
00154 *RW2                                                              DTSBE426
00155      SKIP3                                                        DTSBE426
00156  01  ACTIVE-LIEN-YRQ-AREA.                                        DTSBE426
00157      05  ACTIVE-LIEN-YRQ-CNT       PIC S9(04)  COMP.              DTSBE426
00158      05  ACTIVE-LIEN-YRQ OCCURS 400 TIMES                         DTSBE426
00159                          INDEXED BY ACTIVE-LIEN-IDX               DTSBE426
00160                                    PIC S9(05)  COMP-3.            DTSBE426
00161      EJECT                                                        DTSBE426
00162  01  MSG-AREA.                                                    DTSBE426
00163      05  MSG1-AREA.                                               DTSBE426
00164          10  MSG1-ID                PIC  X(03)  VALUE '   '.      DTSBE426
00165          10  MSG1-TEXT.                                           DTSBE426
00166              15  FILLER             PIC  X(40)                    DTSBE426
00167                VALUE '                                        '.  DTSBE426
00168              15  FILLER             PIC  X(40)                    DTSBE426
00169                VALUE '                                        '.  DTSBE426
00170                                                                   DTSBE426
00171  01  WRK-END-AREA                            PIC  X(02).          DTSBE426
00172      EJECT                                                        DTSBE426
00173  01  L001-LINK-AREA.                                              DTSBE426
00174  ++INCLUDE DTSIL001                                               DTSBE426
00175      EJECT                                                        DTSBE426
00176  01  L002-LINK-AREA.                                              DTSBE426
00177  ++INCLUDE DTSIL002                                               DTSBE426
00178      EJECT                                                        DTSBE426
00179  01  L004-LINK-AREA.                                              DTSBE426
00180  ++INCLUDE DTSIL004                                               DTSBE426
00181      EJECT                                                        DTSBE426
00182  01  L061-LINK-AREA.                                              DTSBE426
00183  ++INCLUDE DTSIL061                                               DTSBE426
00184      EJECT                                                        DTSBE426
00185  01  L101-LINK-AREA.                                              DTSBE426
00186  ++INCLUDE DTSIL101                                               DTSBE426
00187      EJECT                                                        DTSBE426
00188  01  L109-LINK-AREA.                                              DTSBE426
00189  ++INCLUDE DTSIL109                                               DTSBE426
00190      EJECT                                                        DTSBE426
00191  01  L910-LINK-AREA.                                              DTSBE426
00192  ++INCLUDE DTSIL910                                               DTSBE426
00193      SKIP3                                                        DTSBE426
00194  01  MSKL-REC.                                                    DTSBE426
00195  ++INCLUDE DTSIMSKL                                               DTSBE426
00196      SKIP3                                                        DTSBE426
00197  01  MQTR-REC.                                                    DTSBE426
00198  ++INCLUDE DTSIMQTR                                               DTSBE426
00199      SKIP3                                                        DTSBE426
00200  01  MFAS-REC.                                                    DTSBE426
00201  ++INCLUDE DTSIMFAS                                               DTSBE426
00202      SKIP3                                                        DTSBE426
00203  01  MLIN-REC.                                                    DTSBE426
00204  ++INCLUDE DTSIMLIN                                               DTSBE426
00205      EJECT                                                        DTSBE426
00206  01  R426-REC.                                                    DTSBE426
00207  ++INCLUDE DTSIR426                                               DTSBE426
00208      EJECT                                                        DTSBE426
00209  01  CACT-LITETALS.                                               DTSBE426
00210  ++INCLUDE DTSICACT                                               DTSBE426
00211      EJECT                                                        DTSBE426
00212  ++INCLUDE OJRWE426                                               DTSBE426
00213      EJECT                                                        DTSBE426
00214  LINKAGE SECTION.                                                 DTSBE426
00215      SKIP3                                                        DTSBE426
00216  01  LECM-LINK-AREA.                                              DTSBE426
00217  ++INCLUDE DTSILECM                                               DTSBE426
00218      SKIP3                                                        DTSBE426
00219          10  FILLER REDEFINES LECM-EXTRACT-PARMS.                 DTSBE426
00220              15  LECM-PARM-AR-ASSIGN-TYPE-1  PIC  X(02).          DTSBE426
00221              15  FILLER                      PIC  X(01).          DTSBE426
00222              15  LECM-PARM-AR-ASSIGN-TYPE-2  PIC  X(02).          DTSBE426
00223              15  FILLER                      PIC  X(01).          DTSBE426
00224              15  LECM-PARM-AR-ASSIGN-TYPE-3  PIC  X(02).          DTSBE426
00225              15  FILLER                      PIC  X(01).          DTSBE426
00226              15  LECM-PARM-INTEREST-COMP-DATE PIC X(06).          DTSBE426
00227              15  FILLER                      PIC  X(53).          DTSBE426
00228      EJECT                                                        DTSBE426
00229  01  MPRF-LINK-REC.                                               DTSBE426
00230  ++INCLUDE DTSIMPRF                                               DTSBE426
00231      EJECT                                                        DTSBE426
00232  PROCEDURE DIVISION USING LECM-LINK-AREA                          DTSBE426
00233                           MPRF-LINK-REC.                          DTSBE426
00234      SKIP2                                                        DTSBE426
00235                                                                   DTSBE426
00236      EVALUATE TRUE                                                DTSBE426
00237          WHEN LECM-PROCESS-88                                     DTSBE426
00238              PERFORM P0000-PROCESS THRU P0000-EXIT                DTSBE426
00239                                                                   DTSBE426
00240          WHEN LECM-INITIALIZE-88                                  DTSBE426
00241              SET WRK-EDIT-PASSED-88   TO TRUE                     DTSBE426
00242              PERFORM I0000-INITIALIZE THRU I0000-EXIT             DTSBE426
00243              IF WRK-EDIT-FAILED-88                                DTSBE426
00244                  PERFORM S999-ABEND THRU S999-EXIT                DTSBE426
00245              END-IF                                               DTSBE426
00246                                                                   DTSBE426
00247          WHEN LECM-TERMINATE-88                                   DTSBE426
00248              PERFORM T0000-TERMINATE THRU T0000-EXIT              DTSBE426
00249                                                                   DTSBE426
00250          WHEN OTHER                                               DTSBE426
00251              MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED'        DTSBE426
00252                    TO ABEND-MSG                                   DTSBE426
00253              PERFORM S999-ABEND THRU S999-EXIT                    DTSBE426
00254                                                                   DTSBE426
00255      END-EVALUATE.                                                DTSBE426
00256                                                                   DTSBE426
00257      SKIP2                                                        DTSBE426
00258      GOBACK.                                                      DTSBE426
00259      EJECT                                                        DTSBE426
00260  I0000-INITIALIZE.                                                DTSBE426
00261      SKIP2                                                        DTSBE426
00262      MOVE LECM-TRACE-IND TO L910-TRACE-IND.                       DTSBE426
00263      MOVE WRK-MOD-NAME TO L910-MOD-NAME.                          DTSBE426
00264 *OJR                                                              DTSBE426
00265      MOVE LECM-PARM-AR-ASSIGN-TYPE-1                              DTSBE426
00266                                  TO OJR-PARM-AR-ASSIGN-TYPE-1.    DTSBE426
00267                                                                   DTSBE426
00268      MOVE LECM-PARM-AR-ASSIGN-TYPE-2                              DTSBE426
00269                                  TO OJR-PARM-AR-ASSIGN-TYPE-2.    DTSBE426
00270                                                                   DTSBE426
00271      MOVE LECM-PARM-AR-ASSIGN-TYPE-3                              DTSBE426
00272                                  TO OJR-PARM-AR-ASSIGN-TYPE-3.    DTSBE426
00273                                                                   DTSBE426
00274      MOVE LECM-PARM-INTEREST-COMP-DATE                            DTSBE426
00275                                  TO OJR-PARM-INTEREST-COMP-DATE.  DTSBE426
00276                                                                   DTSBE426
00277      MOVE LECM-CURR-RUN-DATE     TO OJR-CURR-RUN-DATE.            DTSBE426
00278                                                                   DTSBE426
00279      PERFORM I1000-EDIT-AND-DEFAULT-PARMS THRU I1000-EXIT.        DTSBE426
00280                                                                   DTSBE426
00281      MOVE LENGTH OF R426-REC TO R426-LENGTH.                      DTSBE426
00282      MOVE '426'              TO R426-REC-TYPE.                    DTSBE426
00283      SET LECM-MST-OPEN-READ-88 TO TRUE.                           DTSBE426
00284      SET LECM-REF-OPEN-READ-88 TO TRUE.                           DTSBE426
00285 *RW1                                                              DTSBE426
00286      PERFORM S109-FIRST-PEN-INT-YRQ  THRU S109-EXIT.              DTSBE426
00287      MOVE L109-FIRST-PEN-INT-YRQ TO WRK-FIRST-PEN-INT-YRQ.        DTSBE426
00288 *RW2                                                              DTSBE426
00289      SKIP2                                                        DTSBE426
00290  I0000-EXIT.                                                      DTSBE426
00291      EXIT.                                                        DTSBE426
00292      EJECT                                                        DTSBE426
00293  ++INCLUDE OJRPE426                                               DTSBE426
00294      EJECT                                                        DTSBE426
00295 ***************************************************************   DTSBE426
00296 *  THIS IS THE PROCESS PARAGRAPH FOR DTSBE426.                    DTSBE426
00297 ***************************************************************   DTSBE426
00298                                                                   DTSBE426
00299  P0000-PROCESS.                                                   DTSBE426
00300                                                                   DTSBE426
00301      IF MPRF-TOT-BALANCE-AMT  GREATER THAN  ZERO                  DTSBE426
00302          NEXT SENTENCE                                            DTSBE426
00303      ELSE                                                         DTSBE426
00304          GO TO P0000-EXIT.                                        DTSBE426
00305                                                                   DTSBE426
00306      IF MPRF-NOT-WRITTEN-OFF-88                                   DTSBE426
00307          NEXT SENTENCE                                            DTSBE426
00308      ELSE                                                         DTSBE426
00309          GO TO  P0000-EXIT.                                       DTSBE426
00310                                                                   DTSBE426
00311      IF MPRF-CLASS-CHG-ONLY-88  OR                                DTSBE426
00312         MPRF-CLASS-UNK-88                                         DTSBE426
00313          GO TO P0000-EXIT.                                        DTSBE426
00314                                                                   DTSBE426
00315      SET WRK-ACTIVE-AR-FAS-NO-88 TO  TRUE.                        DTSBE426
00316                                                                   DTSBE426
00317      IF MPRF-MFAS-EXISTS-88                                       DTSBE426
00318          PERFORM P1000-CHECK-FOR-ACTIVE-AR-FAS THRU P1000-EXIT.   DTSBE426
00319                                                                   DTSBE426
00320      MOVE +0 TO ACTIVE-LIEN-YRQ-CNT.                              DTSBE426
00321                                                                   DTSBE426
00322      IF MPRF-MLIN-EXISTS-88                                       DTSBE426
00323          PERFORM P2000-CHECK-FOR-ACTIVE-LIEN THRU P2000-EXIT.     DTSBE426
00324                                                                   DTSBE426
00325      MOVE ZEROS                  TO  WRK-LIENED-UI-DUE            DTSBE426
00326                                      WRK-LIENED-SUR-DUE           DTSBE426
00327                                      WRK-LIENED-PEN-DUE           DTSBE426
00328                                      WRK-LIENED-INT-DUE           DTSBE426
00329                                      WRK-NOT-LIENED-UI-DUE        DTSBE426
00330                                      WRK-NOT-LIENED-SUR-DUE       DTSBE426
00331                                      WRK-NOT-LIENED-PEN-DUE       DTSBE426
00332                                      WRK-NOT-LIENED-INT-DUE.      DTSBE426
00333                                                                   DTSBE426
00334      MOVE LOW-VALUES             TO  MQTR-KEY-AREA.               DTSBE426
00335      MOVE MPRF-EMP-NO            TO  MQTR-EMP-NO.                 DTSBE426
00336      SET MQTR-QTR-88             TO  TRUE.                        DTSBE426
00337      MOVE MQTR-KEY-AREA          TO  MSKL-KEY-AREA.               DTSBE426
00338                                                                   DTSBE426
00339      PERFORM S910-START-BROWSE  THRU  S910-EXIT.                  DTSBE426
00340                                                                   DTSBE426
00341      PERFORM P3000-SCAN-MQTR  THRU  P3000-EXIT                    DTSBE426
00342          UNTIL  L910-NO-REC-88.                                   DTSBE426
00343                                                                   DTSBE426
00344      PERFORM P4000-SETUP-R426  THRU  P4000-EXIT.                  DTSBE426
00345                                                                   DTSBE426
00346      PERFORM S946-WRITE-R426  THRU  S946-EXIT.                    DTSBE426
00347                                                                   DTSBE426
00348      PERFORM P5000-INITIALIZE-TABLE  THRU  P5000-EXIT             DTSBE426
00349          VARYING WRK-SUB  FROM 1 BY 1                             DTSBE426
00350              UNTIL WRK-SUB  GREATER THAN  R426-ACCT-CNT.          DTSBE426
00351                                                                   DTSBE426
00352  P0000-EXIT.                                                      DTSBE426
00353      EXIT.                                                        DTSBE426
00354      EJECT                                                        DTSBE426
00355 ***************************************************************   DTSBE426
00356 *  THIS PARAGRAPH CAUSES THE FIELD ASSIGNMENT RECORDS TO BE       DTSBE426
00357 *  READ TO DETERMINE IF THERE IS AN ACTIVE A/R FIELD              DTSBE426
00358 *  ASSIGNMENT.                                                    DTSBE426
00359 ***************************************************************   DTSBE426
00360                                                                   DTSBE426
00361  P1000-CHECK-FOR-ACTIVE-AR-FAS.                                   DTSBE426
00362                                                                   DTSBE426
00363      MOVE LOW-VALUES      TO  MFAS-KEY-AREA.                      DTSBE426
00364      MOVE MPRF-EMP-NO     TO  MFAS-EMP-NO.                        DTSBE426
00365      SET MFAS-FAS-88      TO  TRUE.                               DTSBE426
00366      MOVE MFAS-KEY-AREA   TO  MSKL-KEY-AREA.                      DTSBE426
00367                                                                   DTSBE426
00368      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBE426
00369                                                                   DTSBE426
00370      PERFORM P1100-SCAN-MFAS THRU P1100-EXIT                      DTSBE426
00371          UNTIL L910-NO-REC-88.                                    DTSBE426
00372                                                                   DTSBE426
00373  P1000-EXIT.                                                      DTSBE426
00374      EXIT.                                                        DTSBE426
00375      SKIP3                                                        DTSBE426
00376 ***************************************************************   DTSBE426
00377 *  THIS PARAGRAPH SCANS THE FIELD ASSIGNMENT RECORDS AND          DTSBE426
00378 *  SETS THE WORKING STORAGE INDICATOR IF THERE IS AN ACTIVE       DTSBE426
00379 *  A/R FIELD ASSIGNMENT.                                          DTSBE426
00380 ***************************************************************   DTSBE426
00381                                                                   DTSBE426
00382  P1100-SCAN-MFAS.                                                 DTSBE426
00383                                                                   DTSBE426
00384      MOVE MSKL-REC                        TO  MFAS-REC.           DTSBE426
00385                                                                   DTSBE426
00386      IF MFAS-STATUS-ACTIVE-88                                     DTSBE426
00387          IF MFAS-ASSIGN-TYPE = WRK-PARM-AR-ASSIGN-TYPE-1   OR     DTSBE426
00388                                WRK-PARM-AR-ASSIGN-TYPE-2   OR     DTSBE426
00389                                WRK-PARM-AR-ASSIGN-TYPE-3          DTSBE426
00390              SET WRK-ACTIVE-AR-FAS-YES-88 TO  TRUE                DTSBE426
00391              SET L910-NO-REC-88           TO  TRUE                DTSBE426
00392              GO TO P1100-EXIT.                                    DTSBE426
00393                                                                   DTSBE426
00394      PERFORM S910-READ-NEXT THRU S910-EXIT.                       DTSBE426
00395                                                                   DTSBE426
00396  P1100-EXIT.                                                      DTSBE426
00397      EXIT.                                                        DTSBE426
00398      EJECT                                                        DTSBE426
00399 ***************************************************************   DTSBE426
00400 *  THIS PARAGRAPH CAUSES THE MLIN RECORDS TO BE PROCESSED         DTSBE426
00401 *  TO DETERMINE IF THEIR IS A LIEN ON THE ACCOUNT.                DTSBE426
00402 ***************************************************************   DTSBE426
00403                                                                   DTSBE426
00404  P2000-CHECK-FOR-ACTIVE-LIEN.                                     DTSBE426
00405                                                                   DTSBE426
00406      MOVE LOW-VALUES          TO  MLIN-KEY-AREA.                  DTSBE426
00407      MOVE MPRF-EMP-NO         TO  MLIN-EMP-NO.                    DTSBE426
00408      SET MLIN-LIN-88          TO  TRUE.                           DTSBE426
00409      MOVE MLIN-KEY-AREA       TO  MSKL-KEY-AREA.                  DTSBE426
00410                                                                   DTSBE426
00411      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBE426
00412                                                                   DTSBE426
00413      PERFORM P2100-SCAN-MLIN THRU P2100-EXIT                      DTSBE426
00414          UNTIL L910-NO-REC-88.                                    DTSBE426
00415                                                                   DTSBE426
00416  P2000-EXIT.                                                      DTSBE426
00417      EXIT.                                                        DTSBE426
00418      SKIP3                                                        DTSBE426
00419 ***************************************************************   DTSBE426
00420 *  THIS PARAGRAPH SCANS THE MLIN RECORDS AND SETS THE WORKING     DTSBE426
00421 *  STORAGE INDICATOR IF THERE IS A LIEN ON THE ACCOUNT.           DTSBE426
00422 ***************************************************************   DTSBE426
00423                                                                   DTSBE426
00424  P2100-SCAN-MLIN.                                                 DTSBE426
00425                                                                   DTSBE426
00426      MOVE MSKL-REC                   TO  MLIN-REC.                DTSBE426
00427                                                                   DTSBE426
00428      IF MLIN-STATUS-ACTIVE-88                                     DTSBE426
00429          PERFORM P2110-COVERED-YRQ THRU P2110-EXIT                DTSBE426
00430              VARYING MLIN-COV-IDX FROM 1 BY 1                     DTSBE426
00431              UNTIL MLIN-COV-IDX > MLIN-COV-CNT.                   DTSBE426
00432                                                                   DTSBE426
00433      PERFORM S910-READ-NEXT THRU S910-EXIT.                       DTSBE426
00434                                                                   DTSBE426
00435  P2100-EXIT.                                                      DTSBE426
00436      EXIT.                                                        DTSBE426
00437      SKIP3                                                        DTSBE426
00438  P2110-COVERED-YRQ.                                               DTSBE426
00439      MOVE MLIN-COVERED-YRQ (MLIN-COV-IDX) TO HOLD-YRQ.            DTSBE426
00440                                                                   DTSBE426
00441      PERFORM                                                      DTSBE426
00442          VARYING ACTIVE-LIEN-IDX FROM 1 BY 1                      DTSBE426
00443          UNTIL (ACTIVE-LIEN-IDX > ACTIVE-LIEN-YRQ-CNT)            DTSBE426
00444                  OR                                               DTSBE426
00445                (HOLD-YRQ = +0)                                    DTSBE426
00446            IF HOLD-YRQ = ACTIVE-LIEN-YRQ (ACTIVE-LIEN-IDX)        DTSBE426
00447                MOVE +0 TO HOLD-YRQ                                DTSBE426
00448            END-IF                                                 DTSBE426
00449      END-PERFORM.                                                 DTSBE426
00450                                                                   DTSBE426
00451      IF HOLD-YRQ = +0                                             DTSBE426
00452          GO TO P2110-EXIT.                                        DTSBE426
00453                                                                   DTSBE426
00454      IF ACTIVE-LIEN-YRQ-CNT < +400                                DTSBE426
00455          ADD +1 TO ACTIVE-LIEN-YRQ-CNT                            DTSBE426
00456          MOVE HOLD-YRQ TO ACTIVE-LIEN-YRQ (ACTIVE-LIEN-YRQ-CNT).  DTSBE426
00457  P2110-EXIT.                                                      DTSBE426
00458      EXIT.                                                        DTSBE426
00459      EJECT                                                        DTSBE426
00460 ***************************************************************   DTSBE426
00461 *  THIS PARAGRAPH SCANS THE MQTR RECORDS, PROJECTING PENALTY      DTSBE426
00462 *  AND INTEREST, AND ACCUMULATING TOTALS FOR THE EMPLOYER.        DTSBE426
00463 ***************************************************************   DTSBE426
00464                                                                   DTSBE426
00465  P3000-SCAN-MQTR.                                                 DTSBE426
00466                                                                   DTSBE426
00467      MOVE MSKL-REC                   TO  MQTR-REC.                DTSBE426
00468                                                                   DTSBE426
00469      MOVE ZEROS                      TO  WRK-QTR-UI-DUE           DTSBE426
00470                                          WRK-QTR-UI-PD            DTSBE426
00471                                          WRK-QTR-SUR-DUE          DTSBE426
00472                                          WRK-QTR-SUR-PD           DTSBE426
00473                                          WRK-QTR-PEN-DUE          DTSBE426
00474                                          WRK-QTR-PEN-PD           DTSBE426
00475                                          WRK-QTR-INT-DUE          DTSBE426
00476                                          WRK-QTR-INT-PD.          DTSBE426
00477                                                                   DTSBE426
00478      PERFORM P3111-PROJECT-INT  THRU  P3111-EXIT.                 DTSBE426
00479                                                                   DTSBE426
00480      SET WRK-ACTIVE-LIEN-NO-88 TO TRUE.                           DTSBE426
00481                                                                   DTSBE426
00482      PERFORM                                                      DTSBE426
00483        VARYING ACTIVE-LIEN-IDX FROM 1 BY 1                        DTSBE426
00484        UNTIL (ACTIVE-LIEN-IDX > ACTIVE-LIEN-YRQ-CNT)              DTSBE426
00485                  OR                                               DTSBE426
00486              (WRK-ACTIVE-LIEN-YES-88)                             DTSBE426
00487          IF MQTR-YRQ = ACTIVE-LIEN-YRQ (ACTIVE-LIEN-IDX)          DTSBE426
00488              SET WRK-ACTIVE-LIEN-YES-88 TO TRUE                   DTSBE426
00489          END-IF                                                   DTSBE426
00490      END-PERFORM.                                                 DTSBE426
00491                                                                   DTSBE426
00492      IF WRK-ACTIVE-LIEN-YES-88                                    DTSBE426
00493          ADD WRK-QTR-UI-DUE  TO  WRK-LIENED-UI-DUE                DTSBE426
00494          ADD WRK-QTR-SUR-DUE TO  WRK-LIENED-SUR-DUE               DTSBE426
00495          ADD WRK-QTR-PEN-DUE TO  WRK-LIENED-PEN-DUE               DTSBE426
00496          ADD WRK-QTR-INT-DUE TO  WRK-LIENED-INT-DUE               DTSBE426
00497      ELSE                                                         DTSBE426
00498          ADD WRK-QTR-UI-DUE  TO  WRK-NOT-LIENED-UI-DUE            DTSBE426
00499          ADD WRK-QTR-SUR-DUE TO  WRK-NOT-LIENED-SUR-DUE           DTSBE426
00500          ADD WRK-QTR-PEN-DUE TO  WRK-NOT-LIENED-PEN-DUE           DTSBE426
00501          ADD WRK-QTR-INT-DUE TO  WRK-NOT-LIENED-INT-DUE.          DTSBE426
00502                                                                   DTSBE426
00503      PERFORM S910-READ-NEXT  THRU  S910-EXIT.                     DTSBE426
00504                                                                   DTSBE426
00505  P3000-EXIT.                                                      DTSBE426
00506      EXIT.                                                        DTSBE426
00507      EJECT                                                        DTSBE426
00508 ***************************************************************   DTSBE426
00509 *  THIS PARAGRAPH PROJECTS INTEREST DUE                           DTSBE426
00510 ***************************************************************   DTSBE426
00511                                                                   DTSBE426
00512  P3111-PROJECT-INT.                                               DTSBE426
00513 ****************************************************              DTSBE426
00514 *  INCLUDE UI & SURTAX IN CALCULATION OF INTEREST                 DTSBE426
00515 ****************************************************              DTSBE426
00516                                                                   DTSBE426
00517      MOVE ZERO                       TO  L101-PAID-CHNG.          DTSBE426
00518                                                                   DTSBE426
00519      PERFORM                                                      DTSBE426
00520          VARYING MQTR-ACCT-IDX  FROM 1 BY 1                       DTSBE426
00521              UNTIL MQTR-ACCT-IDX  GREATER THAN  MQTR-ACCT-CNT     DTSBE426
00522                                                                   DTSBE426
00523          PERFORM P3111-1-ACCUM  THRU  P3111-1-EXIT                DTSBE426
00524                                                                   DTSBE426
00525          IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX)                       DTSBE426
00526              ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX)                 DTSBE426
00527                                       TO  L101-PAID-CHNG          DTSBE426
00528          END-IF                                                   DTSBE426
00529 *RW1                                                              DTSBE426
00530          IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX)                      DTSBE426
00531             IF MQTR-YRQ >= WRK-FIRST-PEN-INT-YRQ                  DTSBE426
00532                ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX)               DTSBE426
00533                  TO L101-PAID-CHNG                                DTSBE426
00534             END-IF                                                DTSBE426
00535          END-IF                                                   DTSBE426
00536 *RW2                                                              DTSBE426
00537      END-PERFORM.                                                 DTSBE426
00538                                                                   DTSBE426
00539      IF L101-PAID-CHNG  GREATER THAN  ZERO                        DTSBE426
00540          NEXT SENTENCE                                            DTSBE426
00541      ELSE                                                         DTSBE426
00542          GO TO P3111-EXIT.                                        DTSBE426
00543                                                                   DTSBE426
00544      MOVE WRK-PARM-INT-COMP-DATE       TO  L101-RECEIVED-DATE.    DTSBE426
00545      SET L101-WAIVE-INT-NO-88          TO  TRUE.                  DTSBE426
00546      MOVE MQTR-TAX-DUE-DATE            TO  L101-TAX-DUE-DATE.     DTSBE426
00547      MOVE MQTR-INT-AREA                TO  L101-INT-AREA.         DTSBE426
00548                                                                   DTSBE426
00549      PERFORM S101-PER-MONTH-NO  THRU  S101-EXIT.                  DTSBE426
00550                                                                   DTSBE426
00551      ADD L101-INT-CHARGE-CHNG          TO  WRK-QTR-INT-DUE.       DTSBE426
00552      SUBTRACT L101-INT-WAIVE-CHNG  FROM  WRK-QTR-INT-DUE.         DTSBE426
00553                                                                   DTSBE426
00554  P3111-EXIT.                                                      DTSBE426
00555      EXIT.                                                        DTSBE426
00556      EJECT                                                        DTSBE426
00557 ***************************************************************   DTSBE426
00558 *  THIS PARAGRAPH ACCUMULATES THE TOTAL TAXES, PENALTY AND        DTSBE426
00559 *  INTEREST DUE AND PAID IN THE QUARTER RECORD.                   DTSBE426
00560 ***************************************************************   DTSBE426
00561                                                                   DTSBE426
00562  P3111-1-ACCUM.                                                   DTSBE426
00563                                                                   DTSBE426
00564      IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX)                           DTSBE426
00565          ADD MQTR-PAID-AMT (MQTR-ACCT-IDX)     TO  WRK-QTR-UI-PD  DTSBE426
00566          ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX)  TO  WRK-QTR-UI-DUE DTSBE426
00567      ELSE                                                         DTSBE426
00568      IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX)                          DTSBE426
00569          ADD MQTR-PAID-AMT (MQTR-ACCT-IDX)     TO  WRK-QTR-SUR-PD DTSBE426
00570          ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX)  TO  WRK-QTR-SUR-DUEDTSBE426
00571      ELSE                                                         DTSBE426
00572      IF MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX)   OR                DTSBE426
00573         MQTR-ACCT-NSF-PEN-88 (MQTR-ACCT-IDX)    OR                DTSBE426
00574         MQTR-ACCT-MISC-PEN-88 (MQTR-ACCT-IDX)                     DTSBE426
00575          ADD MQTR-PAID-AMT (MQTR-ACCT-IDX)     TO  WRK-QTR-PEN-PD DTSBE426
00576          ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX)  TO  WRK-QTR-PEN-DUEDTSBE426
00577      ELSE                                                         DTSBE426
00578      IF MQTR-ACCT-INT-88 (MQTR-ACCT-IDX)                          DTSBE426
00579         ADD MQTR-PAID-AMT (MQTR-ACCT-IDX)     TO  WRK-QTR-INT-PD  DTSBE426
00580         ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX)  TO  WRK-QTR-INT-DUE.DTSBE426
00581                                                                   DTSBE426
00582  P3111-1-EXIT.                                                    DTSBE426
00583      EXIT.                                                        DTSBE426
00584      EJECT                                                        DTSBE426
00585 *!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!                                  DTSBE426
00586 ***************************************************************   DTSBE426
00587 *  THIS PARAGRAPH SETS UP THE R426 EXTRACT RECORD.                DTSBE426
00588 ***************************************************************   DTSBE426
00589                                                                   DTSBE426
00590  P4000-SETUP-R426.                                                DTSBE426
00591                                                                   DTSBE426
00592      IF WRK-ACTIVE-AR-FAS-YES-88                                  DTSBE426
00593          SET R426-CATEGORY-FLD-ASSIGN-88        TO  TRUE          DTSBE426
00594      ELSE                                                         DTSBE426
00595          IF MPRF-BANKRP-OPEN-88                                   DTSBE426
00596              SET R426-CATEGORY-BANKRPT-88       TO  TRUE          DTSBE426
00597          ELSE                                                     DTSBE426
00598              SET R426-CATEGORY-NOT-BANKRPT-88   TO  TRUE.         DTSBE426
00599                                                                   DTSBE426
00600      MOVE WRK-PARM-INT-COMP-DATE    TO  R426-COMP-DATE.           DTSBE426
00601                                                                   DTSBE426
00602      MOVE ZERO                           TO  R426-FLD-TYPE-CNT.   DTSBE426
00603                                                                   DTSBE426
00604      IF WRK-PARM-AR-ASSIGN-TYPE-1     EQUAL  SPACES               DTSBE426
00605          NEXT SENTENCE                                            DTSBE426
00606      ELSE                                                         DTSBE426
00607          ADD +1                          TO  R426-FLD-TYPE-CNT    DTSBE426
00608          MOVE WRK-PARM-AR-ASSIGN-TYPE-1                           DTSBE426
00609                           TO  R426-FLD-TYPE (R426-FLD-TYPE-CNT).  DTSBE426
00610                                                                   DTSBE426
00611      IF WRK-PARM-AR-ASSIGN-TYPE-2     EQUAL  SPACES               DTSBE426
00612          NEXT SENTENCE                                            DTSBE426
00613      ELSE                                                         DTSBE426
00614          ADD +1                          TO  R426-FLD-TYPE-CNT    DTSBE426
00615          MOVE WRK-PARM-AR-ASSIGN-TYPE-2                           DTSBE426
00616                           TO  R426-FLD-TYPE (R426-FLD-TYPE-CNT).  DTSBE426
00617                                                                   DTSBE426
00618      IF WRK-PARM-AR-ASSIGN-TYPE-3     EQUAL  SPACES               DTSBE426
00619          NEXT SENTENCE                                            DTSBE426
00620      ELSE                                                         DTSBE426
00621          ADD +1                          TO  R426-FLD-TYPE-CNT    DTSBE426
00622          MOVE WRK-PARM-AR-ASSIGN-TYPE-3                           DTSBE426
00623                           TO  R426-FLD-TYPE (R426-FLD-TYPE-CNT).  DTSBE426
00624                                                                   DTSBE426
00625      MOVE ZERO                           TO  R426-ACCT-CNT.       DTSBE426
00626                                                                   DTSBE426
00627      PERFORM P4100-SETUP-ACCT-OCCURS   THRU  P4100-EXIT.          DTSBE426
00628                                                                   DTSBE426
00629      PERFORM S061-DETERMINE-FLD-REP    THRU  S061-EXIT.           DTSBE426
00630                                                                   DTSBE426
00631      MOVE L061-FLD-REP-ID                TO  R426-FIELD-REP-ID.   DTSBE426
00632                                                                   DTSBE426
00633  P4000-EXIT.                                                      DTSBE426
00634      EXIT.                                                        DTSBE426
00635      EJECT                                                        DTSBE426
00636 ***************************************************************   DTSBE426
00637 *  THIS PARAGRAPH SETS UP THE ACCNT OCCURS CLAUSE IN THE          DTSBE426
00638 *  R426 REPORT EXTRACT RECORD.                                    DTSBE426
00639 ***************************************************************   DTSBE426
00640                                                                   DTSBE426
00641  P4100-SETUP-ACCT-OCCURS.                                         DTSBE426
00642                                                                   DTSBE426
00643      IF (WRK-LIENED-UI-DUE  GREATER THAN  ZERO)                   DTSBE426
00644             OR                                                    DTSBE426
00645         (WRK-NOT-LIENED-UI-DUE GREATER THAN ZERO)                 DTSBE426
00646          ADD +1 TO  R426-ACCT-CNT                                 DTSBE426
00647          MOVE CACT-ACCT-UI                                        DTSBE426
00648            TO  R426-ACCT-IND (R426-ACCT-CNT)                      DTSBE426
00649          MOVE WRK-LIENED-UI-DUE                                   DTSBE426
00650            TO  R426-LIENED-BAL-AMT (R426-ACCT-CNT)                DTSBE426
00651          MOVE WRK-NOT-LIENED-UI-DUE                               DTSBE426
00652            TO  R426-NOT-LIENED-BAL-AMT (R426-ACCT-CNT).           DTSBE426
00653                                                                   DTSBE426
00654      IF (WRK-LIENED-SUR-DUE GREATER THAN  ZERO)                   DTSBE426
00655             OR                                                    DTSBE426
00656         (WRK-NOT-LIENED-SUR-DUE GREATER THAN ZERO)                DTSBE426
00657          ADD +1 TO  R426-ACCT-CNT                                 DTSBE426
00658          MOVE CACT-ACCT-SUR                                       DTSBE426
00659            TO  R426-ACCT-IND (R426-ACCT-CNT)                      DTSBE426
00660          MOVE WRK-LIENED-SUR-DUE                                  DTSBE426
00661            TO  R426-LIENED-BAL-AMT (R426-ACCT-CNT)                DTSBE426
00662          MOVE WRK-NOT-LIENED-SUR-DUE                              DTSBE426
00663            TO  R426-NOT-LIENED-BAL-AMT (R426-ACCT-CNT).           DTSBE426
00664                                                                   DTSBE426
00665      IF (WRK-LIENED-PEN-DUE GREATER THAN  ZERO)                   DTSBE426
00666             OR                                                    DTSBE426
00667         (WRK-NOT-LIENED-PEN-DUE GREATER THAN ZERO)                DTSBE426
00668          ADD +1 TO  R426-ACCT-CNT                                 DTSBE426
00669 *******************************************************           DTSBE426
00670 *  DOES NOT MATTER WHICH PENALTY ACCT IND IS MOVED                DTSBE426
00671 *******************************************************           DTSBE426
00672          MOVE CACT-ACCT-LATE-PEN                                  DTSBE426
00673            TO  R426-ACCT-IND (R426-ACCT-CNT)                      DTSBE426
00674          MOVE WRK-LIENED-PEN-DUE                                  DTSBE426
00675            TO  R426-LIENED-BAL-AMT (R426-ACCT-CNT)                DTSBE426
00676          MOVE WRK-NOT-LIENED-PEN-DUE                              DTSBE426
00677            TO  R426-NOT-LIENED-BAL-AMT (R426-ACCT-CNT).           DTSBE426
00678                                                                   DTSBE426
00679      IF (WRK-LIENED-INT-DUE GREATER THAN  ZERO)                   DTSBE426
00680             OR                                                    DTSBE426
00681         (WRK-NOT-LIENED-INT-DUE GREATER THAN ZERO)                DTSBE426
00682          ADD +1 TO  R426-ACCT-CNT                                 DTSBE426
00683          MOVE CACT-ACCT-INT                                       DTSBE426
00684            TO  R426-ACCT-IND (R426-ACCT-CNT)                      DTSBE426
00685          MOVE WRK-LIENED-INT-DUE                                  DTSBE426
00686            TO  R426-LIENED-BAL-AMT (R426-ACCT-CNT)                DTSBE426
00687          MOVE WRK-NOT-LIENED-INT-DUE                              DTSBE426
00688            TO  R426-NOT-LIENED-BAL-AMT (R426-ACCT-CNT).           DTSBE426
00689                                                                   DTSBE426
00690  P4100-EXIT.                                                      DTSBE426
00691      EXIT.                                                        DTSBE426
00692      EJECT                                                        DTSBE426
00693 ***************************************************************   DTSBE426
00694 *  THIS PARAGRAPH INITIALIZES THE ACCOUNTS TABLE IN THE R426      DTSBE426
00695 *  REPORT EXTRACT RECORD.                                         DTSBE426
00696 ***************************************************************   DTSBE426
00697                                                                   DTSBE426
00698  P5000-INITIALIZE-TABLE.                                          DTSBE426
00699                                                                   DTSBE426
00700      MOVE LOW-VALUES     TO  R426-ACCT-OCCURS (WRK-SUB).          DTSBE426
00701                                                                   DTSBE426
00702  P5000-EXIT.                                                      DTSBE426
00703      EXIT.                                                        DTSBE426
00704      EJECT                                                        DTSBE426
00705  T0000-TERMINATE.                                                 DTSBE426
00706                                                                   DTSBE426
00707      MOVE SPACE TO WRK-END-AREA.                                  DTSBE426
00708                                                                   DTSBE426
00709  T0000-EXIT.                                                      DTSBE426
00710      EXIT.                                                        DTSBE426
00711      EJECT                                                        DTSBE426
00712  S001-FROM-FED-8.                                                 DTSBE426
00713      SET L001-FROM-FED-8 TO TRUE.                                 DTSBE426
00714      GO TO S001-DATE.                                             DTSBE426
00715      SKIP1                                                        DTSBE426
00716  S001-FROM-CAL-6.                                                 DTSBE426
00717      SET L001-FROM-CAL-6 TO TRUE.                                 DTSBE426
00718      GO TO S001-DATE.                                             DTSBE426
00719      SKIP1                                                        DTSBE426
00720  S001-FROM-ABS-DAY.                                               DTSBE426
00721      SET L001-FROM-ABS-DAY TO TRUE.                               DTSBE426
00722      GO TO S001-DATE.                                             DTSBE426
00723      SKIP1                                                        DTSBE426
00724  S001-DATE.                                                       DTSBE426
00725      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBE426
00726  S001-EXIT.                                                       DTSBE426
00727      EXIT.                                                        DTSBE426
00728      SKIP3                                                        DTSBE426
00729  S004-FROM-5.                                                     DTSBE426
00730      SET L004-FROM-5 TO TRUE.                                     DTSBE426
00731      GO TO S004-QTR.                                              DTSBE426
00732      SKIP1                                                        DTSBE426
00733  S004-FROM-ABS.                                                   DTSBE426
00734      SET L004-FROM-ABS TO TRUE.                                   DTSBE426
00735      GO TO S004-QTR.                                              DTSBE426
00736      SKIP1                                                        DTSBE426
00737  S004-FROM-3.                                                     DTSBE426
00738      SET L004-FROM-3 TO TRUE.                                     DTSBE426
00739      GO TO S004-QTR.                                              DTSBE426
00740      SKIP1                                                        DTSBE426
00741  S004-QTR.                                                        DTSBE426
00742      SKIP1                                                        DTSBE426
00743      CALL 'DTSBU004' USING L004-LINK-AREA.                        DTSBE426
00744      SKIP1                                                        DTSBE426
00745  S004-EXIT.                                                       DTSBE426
00746      EXIT.                                                        DTSBE426
00747      SKIP3                                                        DTSBE426
00748  S061-DETERMINE-FLD-REP.                                          DTSBE426
00749 *    MOVE MPRF-FLD-ZIP TO L061-FLD-ZIP.                           DTSBE426
00750      MOVE MPRF-FLD-ZIP-ST TO L061-FLD-ZIP-ST.                     DTSBE426
00751      MOVE MPRF-EMP-NO TO L061-EMP-NO.                             DTSBE426
00752                                                                   DTSBE426
00753      CALL 'DTSBU061' USING L061-LINK-AREA.                        DTSBE426
00754  S061-EXIT.                                                       DTSBE426
00755      EXIT.                                                        DTSBE426
00756      SKIP3                                                        DTSBE426
00757  S101-PER-MONTH-NO.                                               DTSBE426
00758      SET L101-PER-MONTH-NO-88 TO TRUE.                            DTSBE426
00759      GO TO S101-INTEREST-COMP.                                    DTSBE426
00760                                                                   DTSBE426
00761  S101-INTEREST-COMP.                                              DTSBE426
00762      CALL 'DTSBU101' USING L101-LINK-AREA.                        DTSBE426
00763  S101-EXIT.                                                       DTSBE426
00764      EXIT.                                                        DTSBE426
00765      SKIP3                                                        DTSBE426
00766  S109-FIRST-PEN-INT-YRQ.                                          DTSBE426
00767      SET L109-CMND-PEN-INT-QTR-88 TO TRUE.                        DTSBE426
00768      GO TO S109-SUR-RATE.                                         DTSBE426
00769                                                                   DTSBE426
00770  S109-SUR-RATE.                                                   DTSBE426
00771      CALL 'DTSBU109' USING L109-LINK-AREA.                        DTSBE426
00772  S109-EXIT.                                                       DTSBE426
00773      EXIT.                                                        DTSBE426
00774      SKIP3                                                        DTSBE426
00775  S910-READ.                                                       DTSBE426
00776      SET L910-READ-88 TO TRUE.                                    DTSBE426
00777      GO TO S910-MSTR-IO.                                          DTSBE426
00778      SKIP1                                                        DTSBE426
00779  S910-START-BROWSE.                                               DTSBE426
00780      SET L910-START-BROWSE-88 TO TRUE.                            DTSBE426
00781      GO TO S910-MSTR-IO.                                          DTSBE426
00782      SKIP1                                                        DTSBE426
00783  S910-READ-NEXT.                                                  DTSBE426
00784      SET L910-READ-NEXT-88 TO TRUE.                               DTSBE426
00785      GO TO S910-MSTR-IO.                                          DTSBE426
00786      SKIP1                                                        DTSBE426
00787  S910-COUNT.                                                      DTSBE426
00788      SET L910-COUNT-88 TO TRUE.                                   DTSBE426
00789      GO TO S910-MSTR-IO.                                          DTSBE426
00790      SKIP1                                                        DTSBE426
00791  S910-MSTR-IO.                                                    DTSBE426
00792      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBE426
00793                            MSKL-REC.                              DTSBE426
00794  S910-EXIT.                                                       DTSBE426
00795      EXIT.                                                        DTSBE426
00796      SKIP3                                                        DTSBE426
00797  S946-WRITE-R426.                                                 DTSBE426
00798      CALL 'DTSBU946' USING R426-REC.                              DTSBE426
00799      GO TO S946-EXIT.                                             DTSBE426
00800      SKIP1                                                        DTSBE426
00801  S946-EXIT.                                                       DTSBE426
00802      EXIT.                                                        DTSBE426
00803      SKIP3                                                        DTSBE426
00804  S999-ABEND.                                                      DTSBE426
00805      DISPLAY '*** DTSBE426 ABENDING.  '                           DTSBE426
00806              ABEND-MSG.                                           DTSBE426
00807      SKIP1                                                        DTSBE426
00808      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBE426
00809  S999-EXIT.                                                       DTSBE426
00810      EXIT.                                                        DTSBE426
