00001  IDENTIFICATION DIVISION.                                         04/30/08
00002  PROGRAM-ID.             DTSBD325.                                DTSBD325
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV024
00004  DATE-WRITTEN.           FEBRUARY 1999.                           DTSBD325
00005  DATE-COMPILED.                                                   DTSBD325
00006      SKIP3                                                        DTSBD325
00007 *****                                                             DTSBD325
00008 *                                                                 DTSBD325
00009 *    FUNCTION:  DEFERRED PAYMENT CONTRACT PACKAGE.                DTSBD325
00010 *                                                                 DTSBD325
00011 *                                                                 DTSBD325
00012 *    MODIFICATION LOG:                                            DTSBD325
00013 *                                                                 DTSBD325
00014 *    02/10/1999  CLONED FROM DTSBD321.                            DTSBD325
00015 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH   DTSBD325
00016 *                                                                 DTSBD325
00017 *    10/04/1999  MODIFIED SETTING OF R434-CORPORATION-IND         DTSBD325
00018 *                IN P1000.  ALL EMPLOYERS EXCEPT PARTNERSHIPS     DTSBD325
00019 *                GET THE CORPORATION TYPE OF DPC.                 DTSBD325
00020 *                REFERENCE:                     PROGRAMMER: GD    DTSBD325
00021 *                                                                 DTSBD325
00022 *    08/01/2006  PENALTY AND INTEREST CALCULATIONS MODIFIED       DTSBD325
00023 *                TO EXCLUDE SUR-TAX: P3100.                       DTSBD325
00024 *                REFERENCE: ADMIN ASSESS        PROGRAMMER: GD    DTSBD325
00025 *                                                                 DTSBD325
00026 *    01/31/2008  MODIFIED ADMINISTRATIVE ASSESSMENT PROCESS       DTSBD325
00027 *                TO INCLUDE PENALTY AND INTEREST CALCULATION      DTSBD325
00028 *                STARTING WITH 2008/1.                            DTSBD325
00029 *                REFERENCE: ADMIN ASSESS        PROGRAMMER: RW1   DTSBD325
00030 *                                                                 DTSBD325
00031 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBD325
00032 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBD325
00033 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSBD325
00034 *                                                                 DTSBD325
00035 *                                                                 DTSBD325
00036 *  DESCRIPTION:                                                   DTSBD325
00037 *                                                                 DTSBD325
00038 *      READ THE MDPC RECORD INDICATED BY T011-ESTB-ABSTIME.       DTSBD325
00039 *                                                                 DTSBD325
00040 *      IF MDPC RECORD INDICATED BY T011-ESTB-ABSTIME DOES NOT     DTSBD325
00041 *      EXIST, THEN THE TRANSACTION IS IN ERROR.                   DTSBD325
00042 *                                                                 DTSBD325
00043 *      IF NOT (MDPC-STATUS-OPEN-88 OR MDPC-STATUS-PENDING-88),    DTSBD325
00044 *      THEN THE TRANSACTION IS IN ERROR.                          DTSBD325
00045 *                                                                 DTSBD325
00046 *      IF NOT (MDPC-FREQ-WEEKLY-88 OR MDPC-FREQ-BIWEEKLY-88 OR    DTSBD325
00047 *      MDPC-FREQ-MONTHLY-88), THEN THE TRANSACTION IS IN ERROR.   DTSBD325
00048 *                                                                 DTSBD325
00049 *      SCAN THE MQTR RECORDS INDICATED BY MDPC-COVERED-YRQ.       DTSBD325
00050 *      IF NO AMOUNTS ARE DUE IN MDPC-COVERED-YRQ(S),              DTSBD325
00051 *      THEN CHANGE MDPC STATUS TO MDPC-STATUS-WITHDRAWN-88        DTSBD325
00052 *      AND THE TRANSACTION IS IN ERROR.                           DTSBD325
00053 *                                                                 DTSBD325
00054 *      THE FOLLOWING SPECIFICATIONS ASSUME AMOUNTS ARE DUE        DTSBD325
00055 *      IN ONE OR MORE OF MDPC-COVERED-YRQ(S).                     DTSBD325
00056 *                                                                 DTSBD325
00057 *        CONSTRUCT AND WRITE A R434 RECORD.                       DTSBD325
00058 *                                                                 DTSBD325
00059 *        WRITE AN EVENT LOG RECORD.                               DTSBD325
00060 *                                                                 DTSBD325
00061 *      THERE IS ONE TRICKY BIT - THE HANDLING OF TOLERANCE.       DTSBD325
00062 *                                                                 DTSBD325
00063 *      TOLERANCE IS NOT RESOLVED UNTIL ALL TRANSACTIONS           DTSBD325
00064 *      FOR THE EMPLOYER HAVE BEEN PROCESSED. THUS,                DTSBD325
00065 *      THIS MODULE SHOULD DO SOME "PSEUDO" TOLERANCE              DTSBD325
00066 *      PROCESSING.  WHILE PROCESSING MQTR RECORDS, JUST ADD       DTSBD325
00067 *      UP THE BALANCES DUE (WITHOUT PROJECTING INTEREST).         DTSBD325
00068 *      IF THE RESULT IS LESS THAN OR EQUAL TO LBCM-QTR-TOL-MAX,   DTSBD325
00069 *      THEN JUST PRETEND THERE IS NO BALANCE DUE FOR THIS         DTSBD325
00070 *      QUARTER.                                                   DTSBD325
00071 *                                                                 DTSBD325
00072 *                                                                 DTSBD325
00073 *      SEE DTSCS45 FOR AN EXAMPLE OF DETERMINING THE BALANCE      DTSBD325
00074 *      DUE IN A PARTICULAR QUARTER AND PROJECTING INTEREST        DTSBD325
00075 *      THRU A SPECIFIED "COMPUTATION" DATE.                       DTSBD325
00076 *                                                                 DTSBD325
00077 *                                                                 DTSBD325
00078 *      MASTER FILE RECORDS READ:                                  DTSBD325
00079 *                                                                 DTSBD325
00080 *        MDPC                                                     DTSBD325
00081 *        MQTR                                                     DTSBD325
00082 *        MOPO                                                     DTSBD325
00083 *                                                                 DTSBD325
00084 *                                                                 DTSBD325
00085 *      MASTER FILE RECORDS UPDATED:                               DTSBD325
00086 *                                                                 DTSBD325
00087 *        MDPC (REWRITE)                                           DTSBD325
00088 *        MEVL (WRITE)                                             DTSBD325
00089 *                                                                 DTSBD325
00090 *                                                                 DTSBD325
00091 *      REPORT RECORDS WRITTEN:                                    DTSBD325
00092 *                                                                 DTSBD325
00093 *        R434  DEFERRED PAYMENT CONTRACT DOCUMENTS.               DTSBD325
00094 *        R907  EXCEPTION REPORT.                                  DTSBD325
00095 *                                                                 DTSBD325
00096 *                                                                 DTSBD325
00097 *      MODULES CALLED:                                            DTSBD325
00098 *                                                                 DTSBD325
00099 *        DTSBU001 DATE EDIT/CONVERSION.                           DTSBD325
00100 *        DTSBU004 QUARTER EDIT/CONVERSION.                        DTSBD325
00101 *        DTSBU005 TIME EDIT/CONVERSION.                           DTSBD325
00102 *        DTSBU101 INTEREST CHARGE/ABATEMENT COMPUTATION.          DTSBD325
00103 *        DTSBU910 MASTER FILE I/O DRIVER.                         DTSBD325
00104 *        DTSBU946 VARIABLE LENGTH RECORD SEQUENTAIL OUTPUT 1.     DTSBD325
00105 *                                                                 DTSBD325
00106 *                                                                 DTSBD325
00107 *****                                                             DTSBD325
00108      SKIP3                                                        DTSBD325
00109  ENVIRONMENT DIVISION.                                            DTSBD325
00110      EJECT                                                        DTSBD325
00111  DATA DIVISION.                                                   DTSBD325
00112      SKIP3                                                        DTSBD325
00113  WORKING-STORAGE SECTION.                                         DTSBD325
001135 77  PAN-VALET PICTURE X(24) VALUE '024DTSBD325  04/30/08'.       DTSBD325
00114      SKIP3                                                        DTSBD325
00115  01  WRK-AREA.                                                    DTSBD325
00116      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +325.DTSBD325
00117                                                                   DTSBD325
00118      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBD325'.DTSBD325
00119                                                                   DTSBD325
00120      05  FIRST-TIME-IND              PIC  X(01)        VALUE 'Y'. DTSBD325
00121                                                                   DTSBD325
00122                                                                   DTSBD325
00123      05  WRK-CNT                     PIC S9(04)  COMP.            DTSBD325
00124                                                                   DTSBD325
00125      05  WRK-TOT-BALANCE-AMT         PIC S9(09)V9(02) COMP-3.     DTSBD325
00126                                                                   DTSBD325
00127      05  WRK-FIRST-PEN-INT-YRQ       PIC S9(05)       COMP-3.     DTSBD325
00128                                                                   DTSBD325
00129      05  WRK-COV-QTRS-TBL.                                        DTSBD325
00130          10  FILLER OCCURS 400.                                   DTSBD325
00131              15  WRK-COV-QTR         PIC S9(05)       COMP-3.     DTSBD325
00132                  88  WRK-NOT-COVERED-88      VALUE +0.            DTSBD325
00133              15  WRK-COV-SUBJECT-IND PIC  X(01).                  DTSBD325
00134                  88  WRK-COV-SUBJECT-YES-88  VALUE 'X'.           DTSBD325
00135                  88  WRK-COV-SUBJECT-NO-88   VALUE SPACE.         DTSBD325
00136                                                                   DTSBD325
00137      05  WRK-SMALL-ABS-QTR           PIC S9(04)  COMP.            DTSBD325
00138                                                                   DTSBD325
00139      05  WRK-LARGE-ABS-QTR           PIC S9(04)  COMP.            DTSBD325
00140                                                                   DTSBD325
00141      05  WRK-EVENT-TXT.                                           DTSBD325
00142          10  FILLER                  PIC  X(36)                   DTSBD325
00143                VALUE 'DEFERRED PAYMENT CONTRACT PRINTED.  '.      DTSBD325
00144      EJECT                                                        DTSBD325
00145  01  MSG-TABLE.                                                   DTSBD325
00146      05  MSG1-MDPC-NOT-FOUND.                                     DTSBD325
00147          10  MSG1-ID         PIC  X(11)  VALUE 'DTSBD325411'.     DTSBD325
00148          10  MSG1-SHORT-TEXT PIC  X(20)  VALUE 'DELETED MDPC  '.  DTSBD325
00149          10  MSG1-LONG-TEXT.                                      DTSBD325
00150              15  FILLER      PIC  X(30)                           DTSBD325
00151                    VALUE 'TRANSACTION FAILED - RECORD NO'.        DTSBD325
00152              15  FILLER      PIC  X(30)                           DTSBD325
00153                    VALUE 'T FOUND - NO DPC PRINTED      '.        DTSBD325
00154                                                                   DTSBD325
00155      05  MSG2-MDPC-NOT-OPEN.                                      DTSBD325
00156          10  MSG2-ID         PIC  X(11)  VALUE 'DTSBD325412'.     DTSBD325
00157          10  MSG2-SHORT-TEXT PIC  X(20)  VALUE 'NOT OPEN MDPC '.  DTSBD325
00158          10  MSG2-LONG-TEXT.                                      DTSBD325
00159              15  FILLER      PIC  X(30)                           DTSBD325
00160                    VALUE 'TRANSACTION FAILED - DPC NOT O'.        DTSBD325
00161              15  FILLER      PIC  X(30)                           DTSBD325
00162                    VALUE 'PEN OR PENDING - NO DPC PRNTED'.        DTSBD325
00163                                                                   DTSBD325
00164      05  MSG3-MDPC-FREQ-INVALID.                                  DTSBD325
00165          10  MSG3-ID         PIC  X(11)  VALUE 'DTSBD325413'.     DTSBD325
00166          10  MSG3-SHORT-TEXT PIC  X(20)  VALUE 'MDPC PMT FREQ '.  DTSBD325
00167          10  MSG3-LONG-TEXT.                                      DTSBD325
00168              15  FILLER      PIC  X(30)                           DTSBD325
00169                    VALUE 'TRANSACTION FAILED - DPC PMT F'.        DTSBD325
00170              15  FILLER      PIC  X(30)                           DTSBD325
00171                    VALUE 'REF NOT WEEK, BIWEEK, OR MNTH '.        DTSBD325
00172                                                                   DTSBD325
00173      05  MSG4-NO-DUE.                                             DTSBD325
00174          10  MSG4-ID.                                             DTSBD325
00175              15  MSG4-ID-1   PIC  X(08)  VALUE 'DTSBD325'.        DTSBD325
00176              15  MSG4-ID-2   PIC  X(03)  VALUE '414'.             DTSBD325
00177          10  MSG4-SHORT-TEXT PIC  X(20)  VALUE 'NOTHING DUE   '.  DTSBD325
00178          10  MSG4-LONG-TEXT.                                      DTSBD325
00179              15  FILLER      PIC  X(30)                           DTSBD325
00180                    VALUE 'NO AMOUNTS DUE - NO DEFERRED P'.        DTSBD325
00181              15  FILLER      PIC  X(30)                           DTSBD325
00182                    VALUE 'AYMENT CONTRACT PRINTED       '.        DTSBD325
00183      EJECT                                                        DTSBD325
00184  01  L001-LINK-AREA.                                              DTSBD325
00185  ++INCLUDE DTSIL001                                               DTSBD325
00186      SKIP3                                                        DTSBD325
00187  01  L004-LINK-AREA.                                              DTSBD325
00188  ++INCLUDE DTSIL004                                               DTSBD325
00189      SKIP3                                                        DTSBD325
00190  01  L005-LINK-AREA.                                              DTSBD325
00191  ++INCLUDE DTSIL005                                               DTSBD325
00192      SKIP3                                                        DTSBD325
00193  01  L101-LINK-AREA.                                              DTSBD325
00194  ++INCLUDE DTSIL101                                               DTSBD325
00195      SKIP3                                                        DTSBD325
00196  01  L109-LINK-AREA.                                              DTSBD325
00197  ++INCLUDE DTSIL109                                               DTSBD325
00198      EJECT                                                        DTSBD325
00199  01  L910-LINK-AREA.                                              DTSBD325
00200  ++INCLUDE DTSIL910                                               DTSBD325
00201      SKIP3                                                        DTSBD325
00202  01  MSKL-REC.                                                    DTSBD325
00203  ++INCLUDE DTSIMSKL                                               DTSBD325
00204      SKIP3                                                        DTSBD325
00205  01  MDPC-REC.                                                    DTSBD325
00206  ++INCLUDE DTSIMDPC                                               DTSBD325
00207      SKIP3                                                        DTSBD325
00208  01  MQTR-REC.                                                    DTSBD325
00209  ++INCLUDE DTSIMQTR                                               DTSBD325
00210      SKIP3                                                        DTSBD325
00211  01  MEVL-REC.                                                    DTSBD325
00212  ++INCLUDE DTSIMEVL                                               DTSBD325
00213      SKIP3                                                        DTSBD325
00214  01  MOPO-REC.                                                    DTSBD325
00215  ++INCLUDE DTSIMOPO                                               DTSBD325
00216      EJECT                                                        DTSBD325
00217  01  MMAX-LITERALS.                                               DTSBD325
00218  ++INCLUDE DTSIMMAX                                               DTSBD325
00219      EJECT                                                        DTSBD325
00220  01  R434-REC.                                                    DTSBD325
00221  ++INCLUDE DTSIR434                                               DTSBD325
00222      SKIP3                                                        DTSBD325
00223  01  R907-REC.                                                    DTSBD325
00224  ++INCLUDE DTSIR907                                               DTSBD325
00225      EJECT                                                        DTSBD325
00226  LINKAGE SECTION.                                                 DTSBD325
00227      SKIP3                                                        DTSBD325
00228  01  LBCM-LINK-AREA.                                              DTSBD325
00229  ++INCLUDE DTSILBCM                                               DTSBD325
00230      EJECT                                                        DTSBD325
00231  01  MPRF-REC.                                                    DTSBD325
00232  ++INCLUDE DTSIMPRF                                               DTSBD325
00233      EJECT                                                        DTSBD325
00234  01  T011-REC.                                                    DTSBD325
00235  ++INCLUDE DTSIT011                                               DTSBD325
00236      EJECT                                                        DTSBD325
00237  PROCEDURE DIVISION USING LBCM-LINK-AREA                          DTSBD325
00238                           MPRF-REC                                DTSBD325
00239                           T011-REC.                               DTSBD325
00240                                                                   DTSBD325
00241                                                                   DTSBD325
00242      IF FIRST-TIME-IND = 'Y'                                      DTSBD325
00243          PERFORM I0000-FIRST-TIME THRU I0000-EXIT                 DTSBD325
00244          MOVE 'N' TO FIRST-TIME-IND.                              DTSBD325
00245                                                                   DTSBD325
00246                                                                   DTSBD325
00247      IF T011-DPC-PKG                                              DTSBD325
00248          PERFORM P0000-PROCESS THRU P0000-EXIT                    DTSBD325
00249      ELSE                                                         DTSBD325
00250          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD325
00251                                                                   DTSBD325
00252                                                                   DTSBD325
00253      GOBACK.                                                      DTSBD325
00254      EJECT                                                        DTSBD325
00255  I0000-FIRST-TIME.                                                DTSBD325
00256      MOVE LBCM-TRACE-IND TO L910-TRACE-IND.                       DTSBD325
00257                                                                   DTSBD325
00258      MOVE WRK-MOD-NAME TO L910-MOD-NAME                           DTSBD325
00259                           R907-MODULE-NAME.                       DTSBD325
00260                                                                   DTSBD325
00261      MOVE LENGTH OF R434-REC TO R434-LENGTH.                      DTSBD325
00262                                                                   DTSBD325
00263      MOVE LENGTH OF R907-REC TO R907-LENGTH.                      DTSBD325
00264 *RW1                                                              DTSBD325
00265      PERFORM S109-FIRST-PEN-INT-YRQ  THRU S109-EXIT.              DTSBD325
00266      MOVE L109-FIRST-PEN-INT-YRQ TO WRK-FIRST-PEN-INT-YRQ.        DTSBD325
00267 *RW2                                                              DTSBD325
00268  I0000-EXIT.                                                      DTSBD325
00269      EXIT.                                                        DTSBD325
00270      EJECT                                                        DTSBD325
00271  P0000-PROCESS.                                                   DTSBD325
00272      PERFORM S1000-READ-SUBJECT-MDPC THRU S1000-EXIT.             DTSBD325
00273                                                                   DTSBD325
00274      IF L910-NO-REC-88                                            DTSBD325
00275          SET LBCM-TRN-NOT-OK-88 TO TRUE                           DTSBD325
00276          MOVE MSG1-MDPC-NOT-FOUND TO LBCM-TRN-MSG-AREA            DTSBD325
00277          GO TO P0000-EXIT.                                        DTSBD325
00278                                                                   DTSBD325
00279      IF MDPC-STATUS-OPEN-88 OR MDPC-STATUS-PENDING-88             DTSBD325
00280          NEXT SENTENCE                                            DTSBD325
00281      ELSE                                                         DTSBD325
00282          SET LBCM-TRN-NOT-OK-88 TO TRUE                           DTSBD325
00283          MOVE MSG2-MDPC-NOT-OPEN TO LBCM-TRN-MSG-AREA             DTSBD325
00284          GO TO P0000-EXIT.                                        DTSBD325
00285                                                                   DTSBD325
00286      IF MDPC-FREQ-WEEKLY-88                                       DTSBD325
00287             OR                                                    DTSBD325
00288         MDPC-FREQ-BIWEEKLY-88                                     DTSBD325
00289             OR                                                    DTSBD325
00290         MDPC-FREQ-MONTHLY-88                                      DTSBD325
00291          NEXT SENTENCE                                            DTSBD325
00292      ELSE                                                         DTSBD325
00293          SET LBCM-TRN-NOT-OK-88 TO TRUE                           DTSBD325
00294          MOVE MSG3-MDPC-FREQ-INVALID TO LBCM-TRN-MSG-AREA         DTSBD325
00295          GO TO P0000-EXIT.                                        DTSBD325
00296                                                                   DTSBD325
00297      PERFORM P1000-START-R434 THRU P1000-EXIT.                    DTSBD325
00298                                                                   DTSBD325
00299      PERFORM P2000-LOAD-COV-TABLE THRU P2000-EXIT.                DTSBD325
00300                                                                   DTSBD325
00301      MOVE MDPC-COMP-DATE TO L101-RECEIVED-DATE.                   DTSBD325
00302                                                                   DTSBD325
00303      SET L101-WAIVE-INT-NO-88 TO TRUE.                            DTSBD325
00304                                                                   DTSBD325
00305      MOVE LOW-VALUE TO MQTR-KEY-AREA.                             DTSBD325
00306                                                                   DTSBD325
00307      MOVE MPRF-EMP-NO TO MQTR-EMP-NO.                             DTSBD325
00308                                                                   DTSBD325
00309      SET MQTR-QTR-88 TO TRUE.                                     DTSBD325
00310                                                                   DTSBD325
00311      PERFORM P3000-PROCESS-MQTR THRU P3000-EXIT                   DTSBD325
00312          VARYING WRK-CNT FROM WRK-SMALL-ABS-QTR BY 1              DTSBD325
00313          UNTIL WRK-CNT > WRK-LARGE-ABS-QTR.                       DTSBD325
00314                                                                   DTSBD325
00315                                                                   DTSBD325
00316      PERFORM P4000-WRITE-MDPC-AND-REPORT THRU P4000-EXIT.         DTSBD325
00317  P0000-EXIT.                                                      DTSBD325
00318      EXIT.                                                        DTSBD325
00319      EJECT                                                        DTSBD325
00320  P1000-START-R434.                                                DTSBD325
00321      MOVE T011-RESP-OP-ID TO R434-RESP-OP-ID.                     DTSBD325
00322                                                                   DTSBD325
00323      MOVE MPRF-EMP-NO TO R434-EMP-NO.                             DTSBD325
00324                                                                   DTSBD325
00325                                                                   DTSBD325
00326      INITIALIZE R434-DATA-AREA.                                   DTSBD325
00327                                                                   DTSBD325
00328 **********************************************************        DTSBD325
00329 *    R434-CORPORATION-IND DETERNMINES THE TYPE OF                 DTSBD325
00330 *    DPC THE SYSTEM WILL PRINT.  THERE IS A SPECIAL               DTSBD325
00331 *    VERSION FOR PARTNERSHIPS; EVERYONE ELSE GETS                 DTSBD325
00332 *    THE CORPORATION TYPE OF DPC.                                 DTSBD325
00333 **********************************************************        DTSBD325
00334      IF MPRF-ORG-PARTNERSHIP-88                                   DTSBD325
00335          SET R434-CORPORATION-NO-88 TO TRUE                       DTSBD325
00336      ELSE                                                         DTSBD325
00337          SET R434-CORPORATION-YES-88 TO TRUE.                     DTSBD325
00338                                                                   DTSBD325
00339      MOVE MDPC-STMT-DATE TO R434-STMT-DATE.                       DTSBD325
00340                                                                   DTSBD325
00341      MOVE MPRF-PRIMARY-NAME TO R434-PRIMARY-NAME.                 DTSBD325
00342                                                                   DTSBD325
00343      MOVE MDPC-EMPLOYER-SIGNEE TO R434-EMPLOYER-SIGNEE.           DTSBD325
00344                                                                   DTSBD325
00345      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSBD325
00346                                                                   DTSBD325
00347      MOVE MPRF-EMP-NO TO MSKL-EMP-NO.                             DTSBD325
00348                                                                   DTSBD325
00349      SET MSKL-OPO-88 TO TRUE.                                     DTSBD325
00350                                                                   DTSBD325
00351      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBD325
00352                                                                   DTSBD325
00353      PERFORM                                                      DTSBD325
00354        UNTIL L910-NO-REC-88                                       DTSBD325
00355          MOVE MSKL-REC TO MOPO-REC                                DTSBD325
00356          IF MOPO-NAME = R434-EMPLOYER-SIGNEE                      DTSBD325
00357              MOVE MOPO-TITLE TO R434-SIGNEE-TITLE                 DTSBD325
00358          END-IF                                                   DTSBD325
00359          PERFORM S910-READ-NEXT THRU S910-EXIT                    DTSBD325
00360      END-PERFORM.                                                 DTSBD325
00361                                                                   DTSBD325
00362      IF R434-SIGNEE-TITLE = LOW-VALUES                            DTSBD325
00363          MOVE SPACES TO R434-SIGNEE-TITLE.                        DTSBD325
00364                                                                   DTSBD325
00365      MOVE MDPC-MAILING-ADDRESS TO R434-MAILING-ADDRESS.           DTSBD325
00366                                                                   DTSBD325
00367      MOVE MDPC-INSTALL-PMT-AMT TO R434-INSTALL-PMT-AMT.           DTSBD325
00368                                                                   DTSBD325
00369      MOVE MDPC-PMT-BEGIN-DATE TO R434-PMT-BEGIN-DATE.             DTSBD325
00370                                                                   DTSBD325
00371      MOVE MDPC-PMT-FREQUENCY TO R434-PMT-FREQUENCY.               DTSBD325
00372  P1000-EXIT.                                                      DTSBD325
00373      EXIT.                                                        DTSBD325
00374      EJECT                                                        DTSBD325
00375  P2000-LOAD-COV-TABLE.                                            DTSBD325
00376      INITIALIZE WRK-COV-QTRS-TBL.                                 DTSBD325
00377                                                                   DTSBD325
00378      MOVE +400 TO WRK-SMALL-ABS-QTR.                              DTSBD325
00379                                                                   DTSBD325
00380      MOVE +1 TO WRK-LARGE-ABS-QTR.                                DTSBD325
00381                                                                   DTSBD325
00382                                                                   DTSBD325
00383      MOVE LOW-VALUE TO MSKL-KEY-AREA.                             DTSBD325
00384                                                                   DTSBD325
00385      MOVE MPRF-EMP-NO TO MSKL-EMP-NO.                             DTSBD325
00386                                                                   DTSBD325
00387      SET MSKL-DPC-88 TO TRUE.                                     DTSBD325
00388                                                                   DTSBD325
00389      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBD325
00390                                                                   DTSBD325
00391      PERFORM                                                      DTSBD325
00392        UNTIL L910-NO-REC-88                                       DTSBD325
00393          MOVE MSKL-REC TO MDPC-REC                                DTSBD325
00394          IF MDPC-STATUS-ACTIVE-88 OR MDPC-STATUS-PENDING-88       DTSBD325
00395              PERFORM P2100-COVERED-SCAN THRU P2100-EXIT           DTSBD325
00396                      VARYING MDPC-COV-IDX FROM 1 BY 1             DTSBD325
00397                      UNTIL MDPC-COV-IDX > MDPC-COV-CNT            DTSBD325
00398          END-IF                                                   DTSBD325
00399          PERFORM S910-READ-NEXT THRU S910-EXIT                    DTSBD325
00400      END-PERFORM.                                                 DTSBD325
00401                                                                   DTSBD325
00402                                                                   DTSBD325
00403      PERFORM S1000-READ-SUBJECT-MDPC THRU S1000-EXIT.             DTSBD325
00404                                                                   DTSBD325
00405      IF L910-NO-REC-88                                            DTSBD325
00406          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD325
00407  P2000-EXIT.                                                      DTSBD325
00408      EXIT.                                                        DTSBD325
00409      SKIP3                                                        DTSBD325
00410  P2100-COVERED-SCAN.                                              DTSBD325
00411      MOVE MDPC-COVERED-YRQ (MDPC-COV-IDX) TO L004-QTR-5-9.        DTSBD325
00412                                                                   DTSBD325
00413      PERFORM S004-FROM-5 THRU S004-EXIT.                          DTSBD325
00414                                                                   DTSBD325
00415      IF  L004-INVALID-QTR                                         DTSBD325
00416          GO TO P2100-EXIT.                                        DTSBD325
00417                                                                   DTSBD325
00418                                                                   DTSBD325
00419      MOVE L004-QTR-5-9 TO WRK-COV-QTR (L004-ABS-QTR).             DTSBD325
00420                                                                   DTSBD325
00421      IF MDPC-ESTB-ABSTIME =  T011-ESTB-ABSTIME                    DTSBD325
00422          SET WRK-COV-SUBJECT-YES-88 (L004-ABS-QTR) TO TRUE.       DTSBD325
00423                                                                   DTSBD325
00424                                                                   DTSBD325
00425      IF L004-ABS-QTR < WRK-SMALL-ABS-QTR                          DTSBD325
00426          MOVE L004-ABS-QTR TO WRK-SMALL-ABS-QTR.                  DTSBD325
00427                                                                   DTSBD325
00428      IF L004-ABS-QTR > WRK-LARGE-ABS-QTR                          DTSBD325
00429          MOVE L004-ABS-QTR TO WRK-LARGE-ABS-QTR.                  DTSBD325
00430  P2100-EXIT.                                                      DTSBD325
00431      EXIT.                                                        DTSBD325
00432      EJECT                                                        DTSBD325
00433  P3000-PROCESS-MQTR.                                              DTSBD325
00434      IF WRK-NOT-COVERED-88 (WRK-CNT)                              DTSBD325
00435          GO TO P3000-EXIT.                                        DTSBD325
00436                                                                   DTSBD325
00437                                                                   DTSBD325
00438      MOVE WRK-COV-QTR (WRK-CNT) TO MQTR-YRQ.                      DTSBD325
00439                                                                   DTSBD325
00440      MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA.                         DTSBD325
00441                                                                   DTSBD325
00442      PERFORM S910-READ THRU S910-EXIT.                            DTSBD325
00443                                                                   DTSBD325
00444      IF L910-OK-88                                                DTSBD325
00445          MOVE MSKL-REC TO MQTR-REC                                DTSBD325
00446      ELSE                                                         DTSBD325
00447          GO TO P3000-EXIT.                                        DTSBD325
00448                                                                   DTSBD325
00449                                                                   DTSBD325
00450      MOVE +0 TO WRK-TOT-BALANCE-AMT                               DTSBD325
00451                 L101-PAID-CHNG.                                   DTSBD325
00452                                                                   DTSBD325
00453                                                                   DTSBD325
00454      PERFORM P3100-PROCESS-ACCT-AREA THRU P3100-EXIT              DTSBD325
00455          VARYING MQTR-ACCT-IDX FROM 1 BY 1                        DTSBD325
00456          UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT.                     DTSBD325
00457                                                                   DTSBD325
00458      IF WRK-TOT-BALANCE-AMT NOT > LBCM-QTR-TOL-MAX                DTSBD325
00459          GO TO P3000-EXIT.                                        DTSBD325
00460                                                                   DTSBD325
00461                                                                   DTSBD325
00462      MOVE MQTR-TAX-DUE-DATE TO L101-TAX-DUE-DATE.                 DTSBD325
00463                                                                   DTSBD325
00464      MOVE MQTR-INT-AREA TO L101-INT-AREA.                         DTSBD325
00465                                                                   DTSBD325
00466      PERFORM S101-PER-MONTH-NO THRU S101-EXIT.                    DTSBD325
00467                                                                   DTSBD325
00468      ADD L101-INT-CHARGE-CHNG TO WRK-TOT-BALANCE-AMT.             DTSBD325
00469                                                                   DTSBD325
00470      SUBTRACT L101-INT-WAIVE-CHNG FROM WRK-TOT-BALANCE-AMT.       DTSBD325
00471                                                                   DTSBD325
00472                                                                   DTSBD325
00473      IF WRK-COV-SUBJECT-YES-88 (WRK-CNT)                          DTSBD325
00474               AND R434-COV-CNT < MMAX-DPC-COV-MAX                 DTSBD325
00475          ADD +1 TO R434-COV-CNT                                   DTSBD325
00476          MOVE MQTR-YRQ TO R434-COVERED-YRQ (R434-COV-CNT)         DTSBD325
00477          ADD WRK-TOT-BALANCE-AMT                                  DTSBD325
00478           TO R434-STMT-DUE-AMT.                                   DTSBD325
00479  P3000-EXIT.                                                      DTSBD325
00480      EXIT.                                                        DTSBD325
00481      EJECT                                                        DTSBD325
00482  P3100-PROCESS-ACCT-AREA.                                         DTSBD325
00483      ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) TO WRK-TOT-BALANCE-AMT. DTSBD325
00484                                                                   DTSBD325
00485 ************************************************************      DTSBD325
00486 * INCLUDE UI TAX PAYMENTS ONLY FOR CALCULATING INTEREST           DTSBD325
00487 ************************************************************      DTSBD325
00488      IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX)                           DTSBD325
00489          ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX)                     DTSBD325
00490           TO L101-PAID-CHNG.                                      DTSBD325
00491 *RW                                                               DTSBD325
00492      IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX)                          DTSBD325
00493         IF MQTR-YRQ >= WRK-FIRST-PEN-INT-YRQ                      DTSBD325
00494            ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX)                   DTSBD325
00495              TO L101-PAID-CHNG                                    DTSBD325
00496         END-IF                                                    DTSBD325
00497      END-IF.                                                      DTSBD325
00498 *RW                                                               DTSBD325
00499  P3100-EXIT.                                                      DTSBD325
00500      EXIT.                                                        DTSBD325
00501      EJECT                                                        DTSBD325
00502  P4000-WRITE-MDPC-AND-REPORT.                                     DTSBD325
00503      IF MDPC-STMT-DUE-AMT > +0                                    DTSBD325
00504          MOVE R434-STMT-DUE-AMT TO MDPC-STMT-DUE-AMT              DTSBD325
00505          PERFORM S946-WRITE-R434 THRU S946-EXIT                   DTSBD325
00506          PERFORM P4100-WRITE-MEVL THRU P4100-EXIT                 DTSBD325
00507      ELSE                                                         DTSBD325
00508          MOVE MSG4-ID-2 TO R907-MSG-ID                            DTSBD325
00509          MOVE MPRF-EMP-NO TO R907-EMP-NO                          DTSBD325
00510          MOVE MSG4-LONG-TEXT TO R907-MSG-TEXT                     DTSBD325
00511          PERFORM S946-WRITE-R907 THRU S946-EXIT                   DTSBD325
00512          SET MDPC-STATUS-WITHDRAWN-88 TO TRUE                     DTSBD325
00513          MOVE LBCM-CURR-RUN-DATE TO MDPC-STATUS-DATE              DTSBD325
00514          SET MDPC-STATUS-SYSTEM-88 TO TRUE                        DTSBD325
00515          MOVE +0 TO MDPC-STMT-DUE-AMT.                            DTSBD325
00516                                                                   DTSBD325
00517                                                                   DTSBD325
00518      MOVE LBCM-CURR-RUN-DATE TO MDPC-CHNG-DATE.                   DTSBD325
00519                                                                   DTSBD325
00520      MOVE MDPC-REC TO MSKL-REC.                                   DTSBD325
00521                                                                   DTSBD325
00522      PERFORM S910-REWRITE THRU S910-EXIT.                         DTSBD325
00523  P4000-EXIT.                                                      DTSBD325
00524      EXIT.                                                        DTSBD325
00525      EJECT                                                        DTSBD325
00526  P4100-WRITE-MEVL.                                                DTSBD325
00527      MOVE LOW-VALUE TO MEVL-REC.                                  DTSBD325
00528                                                                   DTSBD325
00529      MOVE MPRF-EMP-NO TO MEVL-EMP-NO.                             DTSBD325
00530                                                                   DTSBD325
00531      SET MEVL-EVL-88 TO TRUE.                                     DTSBD325
00532                                                                   DTSBD325
00533      ADD +1000 TO LBCM-EMP-ABSTIME.                               DTSBD325
00534                                                                   DTSBD325
00535      MOVE LBCM-EMP-ABSTIME TO L005-ABSTIME.                       DTSBD325
00536                                                                   DTSBD325
00537      PERFORM S005-FROM-ABSTIME THRU S005-EXIT.                    DTSBD325
00538                                                                   DTSBD325
00539      MOVE L005-DATE TO MEVL-DATE.                                 DTSBD325
00540                                                                   DTSBD325
00541      MOVE L005-TIME TO MEVL-TIME.                                 DTSBD325
00542                                                                   DTSBD325
00543      MOVE +0 TO MEVL-PURGE-DATE.                                  DTSBD325
00544                                                                   DTSBD325
00545      MOVE WRK-EVENT-TXT TO MEVL-TEXT.                             DTSBD325
00546                                                                   DTSBD325
00547      SET MEVL-SOURCE-SYSTEM-88 TO TRUE.                           DTSBD325
00548                                                                   DTSBD325
00549      SET MEVL-NOT-CONVERTED-88 TO TRUE.                           DTSBD325
00550                                                                   DTSBD325
00551      MOVE LBCM-CURR-RUN-DATE TO MEVL-ESTB-DATE                    DTSBD325
00552                                 MEVL-CHNG-DATE.                   DTSBD325
00553                                                                   DTSBD325
00554      MOVE MEVL-REC TO MSKL-REC.                                   DTSBD325
00555                                                                   DTSBD325
00556      PERFORM S910-WRITE THRU S910-EXIT.                           DTSBD325
00557  P4100-EXIT.                                                      DTSBD325
00558      EXIT.                                                        DTSBD325
00559      EJECT                                                        DTSBD325
00560  S1000-READ-SUBJECT-MDPC.                                         DTSBD325
00561      MOVE LOW-VALUE TO MDPC-KEY-AREA.                             DTSBD325
00562                                                                   DTSBD325
00563      MOVE MPRF-EMP-NO TO MDPC-EMP-NO.                             DTSBD325
00564                                                                   DTSBD325
00565      SET MDPC-DPC-88 TO TRUE.                                     DTSBD325
00566                                                                   DTSBD325
00567      MOVE T011-ESTB-ABSTIME TO MDPC-ESTB-ABSTIME.                 DTSBD325
00568                                                                   DTSBD325
00569      MOVE MDPC-KEY-AREA TO MSKL-KEY-AREA.                         DTSBD325
00570                                                                   DTSBD325
00571      PERFORM S910-READ THRU S910-EXIT.                            DTSBD325
00572                                                                   DTSBD325
00573      IF L910-OK-88                                                DTSBD325
00574          MOVE MSKL-REC TO MDPC-REC.                               DTSBD325
00575  S1000-EXIT.                                                      DTSBD325
00576      EXIT.                                                        DTSBD325
00577      EJECT                                                        DTSBD325
00578  S004-FROM-5.                                                     DTSBD325
00579      SET L004-FROM-5 TO TRUE.                                     DTSBD325
00580      GO TO S004-YRQ.                                              DTSBD325
00581                                                                   DTSBD325
00582  S004-YRQ.                                                        DTSBD325
00583      CALL 'DTSBU004' USING L004-LINK-AREA.                        DTSBD325
00584  S004-EXIT.                                                       DTSBD325
00585      EXIT.                                                        DTSBD325
00586      SKIP3                                                        DTSBD325
00587  S005-FROM-ABSTIME.                                               DTSBD325
00588      SET L005-FROM-ABSTIME TO TRUE.                               DTSBD325
00589      GO TO S005-TIME.                                             DTSBD325
00590                                                                   DTSBD325
00591  S005-TIME.                                                       DTSBD325
00592      CALL 'DTSBU005' USING L005-LINK-AREA.                        DTSBD325
00593  S005-EXIT.                                                       DTSBD325
00594      EXIT.                                                        DTSBD325
00595      SKIP3                                                        DTSBD325
00596  S101-PER-MONTH-NO.                                               DTSBD325
00597      SET L101-PER-MONTH-NO-88 TO TRUE.                            DTSBD325
00598      GO TO S101-INTEREST.                                         DTSBD325
00599                                                                   DTSBD325
00600  S101-INTEREST.                                                   DTSBD325
00601      CALL 'DTSBU101' USING L101-LINK-AREA.                        DTSBD325
00602  S101-EXIT.                                                       DTSBD325
00603      EXIT.                                                        DTSBD325
00604      SKIP3                                                        DTSBD325
00605  S109-FIRST-PEN-INT-YRQ.                                          DTSBD325
00606      SET L109-CMND-PEN-INT-QTR-88 TO TRUE.                        DTSBD325
00607      GO TO S109-SUR-RATE.                                         DTSBD325
00608                                                                   DTSBD325
00609  S109-SUR-RATE.                                                   DTSBD325
00610      CALL 'DTSBU109' USING L109-LINK-AREA.                        DTSBD325
00611  S109-EXIT.                                                       DTSBD325
00612      EXIT.                                                        DTSBD325
00613      SKIP3                                                        DTSBD325
00614  S910-READ.                                                       DTSBD325
00615      SET L910-READ-88 TO TRUE.                                    DTSBD325
00616      GO TO S910-MSTR-IO.                                          DTSBD325
00617                                                                   DTSBD325
00618  S910-START-BROWSE.                                               DTSBD325
00619      SET L910-START-BROWSE-88 TO TRUE.                            DTSBD325
00620      GO TO S910-MSTR-IO.                                          DTSBD325
00621                                                                   DTSBD325
00622  S910-READ-NEXT.                                                  DTSBD325
00623      SET L910-READ-NEXT-88 TO TRUE.                               DTSBD325
00624      GO TO S910-MSTR-IO.                                          DTSBD325
00625                                                                   DTSBD325
00626 *S910-COUNT.                                                      DTSBD325
00627 *****SET L910-COUNT-88 TO TRUE.                                   DTSBD325
00628 *****GO TO S910-MSTR-IO.                                          DTSBD325
00629                                                                   DTSBD325
00630  S910-WRITE.                                                      DTSBD325
00631      SET LBCM-EMP-UPDATE-YES-88 TO TRUE.                          DTSBD325
00632      SET L910-WRITE-88 TO TRUE.                                   DTSBD325
00633      GO TO S910-MSTR-IO.                                          DTSBD325
00634                                                                   DTSBD325
00635  S910-REWRITE.                                                    DTSBD325
00636      SET LBCM-EMP-UPDATE-YES-88 TO TRUE.                          DTSBD325
00637      SET L910-REWRITE-88 TO TRUE.                                 DTSBD325
00638      GO TO S910-MSTR-IO.                                          DTSBD325
00639                                                                   DTSBD325
00640 *S910-DELETE.                                                     DTSBD325
00641 *****SET LBCM-EMP-UPDATE-YES-88 TO TRUE.                          DTSBD325
00642 *****SET L910-DELETE-88 TO TRUE.                                  DTSBD325
00643 *****GO TO S910-MSTR-IO.                                          DTSBD325
00644                                                                   DTSBD325
00645  S910-MSTR-IO.                                                    DTSBD325
00646      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBD325
00647                            MSKL-REC.                              DTSBD325
00648  S910-EXIT.                                                       DTSBD325
00649      EXIT.                                                        DTSBD325
00650      SKIP3                                                        DTSBD325
00651  S946-WRITE-R434.                                                 DTSBD325
00652      CALL 'DTSBU946' USING R434-REC.                              DTSBD325
00653      GO TO S946-EXIT.                                             DTSBD325
00654                                                                   DTSBD325
00655  S946-WRITE-R907.                                                 DTSBD325
00656      CALL 'DTSBU907' USING R907-REC.                              DTSBD325
00657      GO TO S946-EXIT.                                             DTSBD325
00658                                                                   DTSBD325
00659  S946-EXIT.                                                       DTSBD325
00660      EXIT.                                                        DTSBD325
00661      SKIP3                                                        DTSBD325
00662  S999-ABEND.                                                      DTSBD325
00663      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBD325
00664  S999-EXIT.                                                       DTSBD325
00665      EXIT.                                                        DTSBD325
