00001  IDENTIFICATION DIVISION.                                         01/18/99
00002  PROGRAM-ID.             DTSBE408.                                DTSBE408
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD                   LV004
00004                          MODIFIED BY TRW S&ITG.                      CL**2
00005  DATE-WRITTEN.           AUGUST 1994.                             DTSBE408
00006  DATE-COMPILED.                                                   DTSBE408
00007      SKIP3                                                        DTSBE408
00008 *****                                                             DTSBE408
00009 *                                                                 DTSBE408
00010 *    CALLING SEQUENCE:  DTSBE408 CREATES DTSIR408 RECORDS.           CL**2
00011 *                       DTSBD800 CALLS DTSBR408                      CL**2
00012 *                                WHICH PRODUCES THE EXTRACT.         CL**2
00013 *                                                                    CL**4
00014 *    FUNCTION:  PAYMENT PLANS SATISFIED LIST EXTRACT.             DTSBE408
00015 *                                                                 DTSBE408
00016 *                                                                 DTSBE408
00017 *    MODIFICATION LOG:                                            DTSBE408
00018 *                                                                 DTSBE408
00019 *    XX/XX/XX  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBE408
00020 *              XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBE408
00021 *              WORK ORDER:                      PROGRAMMER: XXX   DTSBE408
00022 *                                                                 DTSBE408
00023 *                                                                 DTSBE408
00024 *  DESCRIPTION:                                                   DTSBE408
00025 *                                                                 DTSBE408
00026 *                                                                 DTSBE408
00027 *    INITIATION:                                                  DTSBE408
00028 *                                                                 DTSBE408
00029 *      SET LECM-MST-OPEN-UPDATE-88 TO TRUE.                       DTSBE408
00030 *      SET LECM-REF-OPEN-READ-88 TO TRUE.                         DTSBE408
00031 *                                                                 DTSBE408
00032 *      EDIT AND DEFAULT PARAMETERS.  SEE PRINTED OUTPUTS          DTSBE408
00033 *      DESCRIPTIONS AND LAYOUTS (408R1).                          DTSBE408
00034 *                                                                 DTSBE408
00035 *      DETERMINE WRK-PAYMENT-CUTOFF-DATE.                         DTSBE408
00036 *                                                                 DTSBE408
00037 *                                                                 DTSBE408
00038 *    PROCESSING:                                                  DTSBE408
00039 *                                                                 DTSBE408
00040 *      SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS (408R1).       DTSBE408
00041 *                                                                 DTSBE408
00042 *      TO DETERMINE THE AGE OF PAYMENTS DISTRIBUTED TO A          DTSBE408
00043 *      SPECIFIED QUARTER, USE THE SAME LOGIC AS FOUND IN          DTSBE408
00044 *      DTSBE405.                                                     CL**2
00045 *                                                                 DTSBE408
00046 *                                                                 DTSBE408
00047 *    TERMINATION:                                                 DTSBE408
00048 *                                                                 DTSBE408
00049 *      NONE.                                                      DTSBE408
00050 *                                                                 DTSBE408
00051 *                                                                 DTSBE408
00052 *    RECORDS READ:                                                DTSBE408
00053 *                                                                 DTSBE408
00054 *      MASTER:                                                    DTSBE408
00055 *                                                                 DTSBE408
00056 *        MDPC                                                     DTSBE408
00057 *        MQTR                                                     DTSBE408
00058 *        MDST                                                     DTSBE408
00059 *                                                                 DTSBE408
00060 *                                                                 DTSBE408
00061 *      ALTERNATE INDEX:                                           DTSBE408
00062 *                                                                 DTSBE408
00063 *        NONE.                                                    DTSBE408
00064 *                                                                 DTSBE408
00065 *                                                                 DTSBE408
00066 *      REFERENCE:                                                 DTSBE408
00067 *                                                                 DTSBE408
00068 *        NONE.                                                    DTSBE408
00069 *                                                                 DTSBE408
00070 *                                                                 DTSBE408
00071 *    RECORDS UPDATED:                                             DTSBE408
00072 *                                                                 DTSBE408
00073 *        MDPC                                                     DTSBE408
00074 *        MEVL                                                     DTSBE408
00075 *                                                                 DTSBE408
00076 *                                                                 DTSBE408
00077 *    REPORT RECORDS WRITTEN:                                      DTSBE408
00078 *                                                                 DTSBE408
00079 *        R408  PAYMENT PLANS SATISFIED LIST.                      DTSBE408
00080 *                                                                 DTSBE408
00081 *                                                                 DTSBE408
00082 *    BATCH TRANSACTION COLLECTION RECORDS WRITTEN:                DTSBE408
00083 *                                                                 DTSBE408
00084 *        NONE.                                                    DTSBE408
00085 *                                                                 DTSBE408
00086 *                                                                 DTSBE408
00087 *    MODULES CALLED:                                              DTSBE408
00088 *                                                                 DTSBE408
00089 *        DTSBU001  DATE CONVERSION/EDIT.                             CL**2
00090 *        DTSBU004  QUARTER CONVERSION/EDIT.                          CL**2
00091 *        DTSBU910  MASTER FILE I/O.                                  CL**2
00092 *        DTSBU946  VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1.      CL**2
00093 *                                                                 DTSBE408
00094 *                                                                 DTSBE408
00095 *    VERMONT REFERENCE:                                           DTSBE408
00096 *                                                                 DTSBE408
00097 *        TXBE348                                                  DTSBE408
00098 *                                                                 DTSBE408
00099 *****                                                             DTSBE408
00100      SKIP3                                                        DTSBE408
00101  ENVIRONMENT DIVISION.                                            DTSBE408
00102      SKIP3                                                        DTSBE408
00103  DATA DIVISION.                                                   DTSBE408
00104      SKIP3                                                        DTSBE408
00105  WORKING-STORAGE SECTION.                                         DTSBE408
001055 77  PAN-VALET PICTURE X(24) VALUE '004DTSBE408  01/18/99'.       DTSBE408
00106      SKIP3                                                        DTSBE408
00107  01  WRK-AREA.                                                    DTSBE408
00108      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +408.DTSBE408
00109      SKIP1                                                        DTSBE408
00110      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBE408'.   CL**2
00111      SKIP3                                                        DTSBE408
00112      05  ABEND-MSG                   PIC  X(60).                  DTSBE408
00113      SKIP3                                                        DTSBE408
00114      05  WRK-PARM-PERIOD-START-DATE  PIC S9(09)  COMP-3.          DTSBE408
00115      SKIP1                                                        DTSBE408
00116      05  WRK-PARM-PERIOD-END-DATE    PIC S9(09)  COMP-3.          DTSBE408
00117      SKIP1                                                        DTSBE408
00118      05  WRK-PAYMENT-CUTOFF-DATE     PIC S9(09)  COMP-3.          DTSBE408
00119      SKIP1                                                        DTSBE408
00120      05  WRK-SUB                     PIC S9(04)  COMP.            DTSBE408
00121      SKIP1                                                        DTSBE408
00122      05  WRK-PLAN-SATISFIED-IND      PIC X(01).                   DTSBE408
00123          88  WRK-PLAN-SATISFIED-88                VALUE 'Y'.      DTSBE408
00124          88  WRK-PLAN-NOT-SATISFIED-88            VALUE 'N'.      DTSBE408
00125                                                                   DTSBE408
00126      05  EVL-TEXT.                                                DTSBE408
00127          10  FILLER                  PIC X(46)    VALUE           DTSBE408
00128              'PAYMENT PLAN HAS BEEN AUTOMATICALLY SATISFIED.'.    DTSBE408
00129      EJECT                                                        DTSBE408
00130  01  L001-LINK-AREA.                                              DTSBE408
00131  ++INCLUDE DTSIL001                                                  CL**2
00132      EJECT                                                        DTSBE408
00133  01  L004-LINK-AREA.                                              DTSBE408
00134  ++INCLUDE DTSIL004                                                  CL**2
00135      EJECT                                                        DTSBE408
00136  01  L005-LINK-AREA.                                              DTSBE408
00137  ++INCLUDE DTSIL005                                                  CL**2
00138      EJECT                                                        DTSBE408
00139  01  L910-LINK-AREA.                                              DTSBE408
00140  ++INCLUDE DTSIL910                                                  CL**2
00141      SKIP3                                                        DTSBE408
00142  01  MSKL-REC.                                                    DTSBE408
00143  ++INCLUDE DTSIMSKL                                                  CL**2
00144      SKIP3                                                        DTSBE408
00145  01  MDPC-REC.                                                    DTSBE408
00146  ++INCLUDE DTSIMDPC                                                  CL**2
00147      SKIP3                                                        DTSBE408
00148  01  MQTR-REC.                                                    DTSBE408
00149  ++INCLUDE DTSIMQTR                                                  CL**2
00150      SKIP3                                                        DTSBE408
00151  01  MDST-REC.                                                    DTSBE408
00152  ++INCLUDE DTSIMDST                                                  CL**2
00153      SKIP3                                                        DTSBE408
00154  01  MEVL-REC.                                                    DTSBE408
00155  ++INCLUDE DTSIMEVL                                                  CL**2
00156      EJECT                                                        DTSBE408
00157  01  R408-REC.                                                    DTSBE408
00158  ++INCLUDE DTSIR408                                                  CL**2
00159      EJECT                                                        DTSBE408
00160  LINKAGE SECTION.                                                 DTSBE408
00161      SKIP3                                                        DTSBE408
00162  01  LECM-LINK-AREA.                                              DTSBE408
00163  ++INCLUDE DTSILECM                                                  CL**2
00164      SKIP3                                                        DTSBE408
00165          10  LECM-PARM-AREA REDEFINES LECM-EXTRACT-PARMS.         DTSBE408
00166              15  LECM-PARM-PERIOD-START-DATE PIC  X(06).          DTSBE408
00167              15  FILLER                      PIC  X(01).          DTSBE408
00168              15  LECM-PARM-PERIOD-END-DATE   PIC  X(06).          DTSBE408
00169              15  FILLER                      PIC  X(55).          DTSBE408
00170      EJECT                                                        DTSBE408
00171  01  MPRF-LINK-REC.                                               DTSBE408
00172  ++INCLUDE DTSIMPRF                                                  CL**2
00173      EJECT                                                        DTSBE408
00174 **************************************************************    DTSBE408
00175 *  PROCEDURE DIVISION FOR DTSBE408 - PAYMENT PLANS SATISFIED         CL**2
00176 *  LIST STARTS HERE.                                              DTSBE408
00177 **************************************************************    DTSBE408
00178                                                                   DTSBE408
00179  PROCEDURE DIVISION USING LECM-LINK-AREA                          DTSBE408
00180                           MPRF-LINK-REC.                          DTSBE408
00181      SKIP2                                                        DTSBE408
00182      IF LECM-PROCESS-88                                           DTSBE408
00183          PERFORM P0000-PROCESS THRU P0000-EXIT                    DTSBE408
00184      ELSE                                                         DTSBE408
00185      IF LECM-INITIALIZE-88                                        DTSBE408
00186          PERFORM I0000-INITIALIZE THRU I0000-EXIT                 DTSBE408
00187      ELSE                                                         DTSBE408
00188      IF LECM-TERMINATE-88                                         DTSBE408
00189          PERFORM T0000-TERMINATE THRU T0000-EXIT                  DTSBE408
00190      ELSE                                                         DTSBE408
00191          MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED'            DTSBE408
00192            TO ABEND-MSG                                           DTSBE408
00193          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBE408
00194      SKIP2                                                        DTSBE408
00195      GOBACK.                                                      DTSBE408
00196      EJECT                                                        DTSBE408
00197 **************************************************************    DTSBE408
00198 *  THIS PARAGRAPH CONTROLS THE INITIALIZATION PROCESS FOR         DTSBE408
00199 *  DTSBE408.                                                         CL**2
00200 **************************************************************    DTSBE408
00201                                                                   DTSBE408
00202  I0000-INITIALIZE.                                                DTSBE408
00203      SKIP2                                                        DTSBE408
00204      MOVE LENGTH OF R408-REC TO R408-LENGTH.                         CL**2
00205      MOVE '408'              TO R408-REC-TYPE.                       CL**2
00206      MOVE LECM-TRACE-IND TO L910-TRACE-IND.                       DTSBE408
00207      MOVE WRK-MOD-NAME TO L910-MOD-NAME.                          DTSBE408
00208                                                                   DTSBE408
00209      PERFORM I1000-EDIT-AND-DEFAULT-PARMS THRU I1000-EXIT.        DTSBE408
00210      SKIP1                                                        DTSBE408
00211      SET LECM-MST-OPEN-UPDATE-88 TO TRUE.                         DTSBE408
00212      SET LECM-REF-OPEN-READ-88 TO TRUE.                           DTSBE408
00213      SKIP2                                                        DTSBE408
00214  I0000-EXIT.                                                      DTSBE408
00215      EXIT.                                                        DTSBE408
00216      SKIP3                                                        DTSBE408
00217 **************************************************************    DTSBE408
00218 *  THIS PARAGRAPH EDITS AND DEFAULTS THE PARMS.                   DTSBE408
00219 **************************************************************    DTSBE408
00220                                                                   DTSBE408
00221  I1000-EDIT-AND-DEFAULT-PARMS.                                    DTSBE408
00222      PERFORM I1100-PERIOD-START-DATE THRU I1100-EXIT.             DTSBE408
00223                                                                   DTSBE408
00224      PERFORM I1200-PERIOD-END-DATE THRU I1200-EXIT.               DTSBE408
00225                                                                   DTSBE408
00226      MOVE LECM-CURR-RUN-DATE TO L001-FED-8-DATE-9.                DTSBE408
00227      PERFORM S001-FROM-FED-8 THRU S001-EXIT.                      DTSBE408
00228      SUBTRACT 14 FROM L001-JUL-ABS-DAY.                           DTSBE408
00229      PERFORM S001-FROM-ABS-DAY THRU S001-EXIT.                    DTSBE408
00230      MOVE L001-FED-8-DATE-9 TO WRK-PAYMENT-CUTOFF-DATE.           DTSBE408
00231  I1000-EXIT.                                                      DTSBE408
00232      EXIT.                                                        DTSBE408
00233      EJECT                                                        DTSBE408
00234 **************************************************************    DTSBE408
00235 *  THIS PARAGRAPH EDITS THE PERIOD START DATE.                    DTSBE408
00236 **************************************************************    DTSBE408
00237                                                                   DTSBE408
00238  I1100-PERIOD-START-DATE.                                         DTSBE408
00239                                                                   DTSBE408
00240      IF LECM-PARM-PERIOD-START-DATE = SPACES                      DTSBE408
00241          IF LECM-PERIOD-START-DATE > +0                           DTSBE408
00242              MOVE LECM-PERIOD-START-DATE                          DTSBE408
00243                TO WRK-PARM-PERIOD-START-DATE                      DTSBE408
00244          ELSE                                                     DTSBE408
00245              MOVE 'PERIOD-START-DATE MISSING'                     DTSBE408
00246                TO ABEND-MSG                                       DTSBE408
00247              PERFORM S999-ABEND THRU S999-EXIT                    DTSBE408
00248      ELSE                                                         DTSBE408
00249          MOVE LECM-PARM-PERIOD-START-DATE TO L001-CAL-6-DATE-X    DTSBE408
00250          PERFORM S001-FROM-CAL-6 THRU S001-EXIT                   DTSBE408
00251          IF L001-VALID-DATE                                       DTSBE408
00252              MOVE L001-FED-8-DATE-9 TO WRK-PARM-PERIOD-START-DATE DTSBE408
00253          ELSE                                                     DTSBE408
00254              MOVE 'PERIOD-START-DATE NOT VALID'                   DTSBE408
00255                TO ABEND-MSG                                       DTSBE408
00256              PERFORM S999-ABEND THRU S999-EXIT.                   DTSBE408
00257  I1100-EXIT.                                                      DTSBE408
00258      EXIT.                                                        DTSBE408
00259      EJECT                                                        DTSBE408
00260 **************************************************************    DTSBE408
00261 *  THIS PARAGRAPH EDITS THE PERIOD END DATE.                      DTSBE408
00262 **************************************************************    DTSBE408
00263                                                                   DTSBE408
00264  I1200-PERIOD-END-DATE.                                           DTSBE408
00265                                                                   DTSBE408
00266      IF LECM-PARM-PERIOD-END-DATE = SPACES                        DTSBE408
00267          IF LECM-PERIOD-END-DATE > +0                             DTSBE408
00268              MOVE LECM-PERIOD-END-DATE                            DTSBE408
00269                TO WRK-PARM-PERIOD-END-DATE                        DTSBE408
00270          ELSE                                                     DTSBE408
00271              MOVE 'PERIOD-END-DATE MISSING'                       DTSBE408
00272                TO ABEND-MSG                                       DTSBE408
00273              PERFORM S999-ABEND THRU S999-EXIT                    DTSBE408
00274      ELSE                                                         DTSBE408
00275          MOVE LECM-PARM-PERIOD-END-DATE TO L001-CAL-6-DATE-X      DTSBE408
00276          PERFORM S001-FROM-CAL-6 THRU S001-EXIT                   DTSBE408
00277          IF L001-VALID-DATE                                       DTSBE408
00278              MOVE L001-FED-8-DATE-9 TO WRK-PARM-PERIOD-END-DATE   DTSBE408
00279          ELSE                                                     DTSBE408
00280              MOVE 'PERIOD-END-DATE NOT VALID'                     DTSBE408
00281                TO ABEND-MSG                                       DTSBE408
00282              PERFORM S999-ABEND THRU S999-EXIT.                   DTSBE408
00283                                                                   DTSBE408
00284      IF WRK-PARM-PERIOD-START-DATE > WRK-PARM-PERIOD-END-DATE     DTSBE408
00285          MOVE 'PERIOD START DATE IS GREATER THAN PERIOD END DATE' DTSBE408
00286            TO ABEND-MSG                                           DTSBE408
00287          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBE408
00288  I1200-EXIT.                                                      DTSBE408
00289      EXIT.                                                        DTSBE408
00290      EJECT                                                        DTSBE408
00291 **************************************************************    DTSBE408
00292 *  THIS IS THE PROCESS PARAGRAPH FOR DTSBE408.                       CL**2
00293 **************************************************************    DTSBE408
00294                                                                   DTSBE408
00295  P0000-PROCESS.                                                   DTSBE408
00296                                                                   DTSBE408
00297      IF MPRF-NO-MDPC-88                                           DTSBE408
00298          GO TO P0000-EXIT.                                        DTSBE408
00299                                                                   DTSBE408
00300      MOVE LOW-VALUES                 TO  MDPC-KEY-AREA.           DTSBE408
00301      MOVE MPRF-EMP-NO                TO  MDPC-EMP-NO.             DTSBE408
00302      SET MDPC-DPC-88                 TO  TRUE.                    DTSBE408
00303      MOVE MDPC-KEY-AREA              TO  MSKL-KEY-AREA.           DTSBE408
00304                                                                   DTSBE408
00305      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBE408
00306                                                                   DTSBE408
00307      PERFORM P1000-MDPC-SCAN THRU P1000-EXIT                      DTSBE408
00308          UNTIL L910-NO-REC-88.                                    DTSBE408
00309                                                                   DTSBE408
00310  P0000-EXIT.                                                      DTSBE408
00311      EXIT.                                                        DTSBE408
00312      SKIP3                                                        DTSBE408
00313 **************************************************************    DTSBE408
00314 *  THIS PARAGRAPH SCANS ALL MDPC RECORDS FOR THE EMPLOYER.        DTSBE408
00315 **************************************************************    DTSBE408
00316                                                                   DTSBE408
00317  P1000-MDPC-SCAN.                                                 DTSBE408
00318                                                                   DTSBE408
00319      MOVE MSKL-REC                            TO  MDPC-REC.       DTSBE408
00320                                                                   DTSBE408
00321      IF MDPC-STATUS-SATISFIED-88                                  DTSBE408
00322          PERFORM P1100-SATISFIED-MDPC THRU P1100-EXIT             DTSBE408
00323      ELSE                                                         DTSBE408
00324          IF MDPC-STATUS-OPEN-88                                   DTSBE408
00325              PERFORM P1200-OPEN-MDPC THRU P1200-EXIT              DTSBE408
00326              MOVE MDPC-KEY-AREA TO MSKL-KEY-AREA                  DTSBE408
00327              PERFORM S910-READ THRU S910-EXIT                     DTSBE408
00328              IF L910-NO-REC-88                                    DTSBE408
00329                  MOVE 'LOGIC ERROR IN P1000'  TO  ABEND-MSG       DTSBE408
00330                  PERFORM S999-ABEND THRU S999-EXIT.               DTSBE408
00331                                                                   DTSBE408
00332      PERFORM S910-READ-NEXT THRU S910-EXIT.                       DTSBE408
00333                                                                   DTSBE408
00334  P1000-EXIT.                                                      DTSBE408
00335      EXIT.                                                        DTSBE408
00336      EJECT                                                        DTSBE408
00337 **************************************************************    DTSBE408
00338 *  THIS PARAGRAPH PROCESSES ALL SATSIFIED MDPC RECORDS.           DTSBE408
00339 **************************************************************    DTSBE408
00340                                                                   DTSBE408
00341  P1100-SATISFIED-MDPC.                                            DTSBE408
00342                                                                   DTSBE408
00343      IF MDPC-STATUS-SYSTEM-88                                     DTSBE408
00344          GO TO P1100-EXIT.                                        DTSBE408
00345                                                                   DTSBE408
00346      IF (MDPC-STATUS-DATE < WRK-PARM-PERIOD-START-DATE)           DTSBE408
00347             OR                                                    DTSBE408
00348         (MDPC-STATUS-DATE > WRK-PARM-PERIOD-END-DATE)             DTSBE408
00349          NEXT SENTENCE                                            DTSBE408
00350      ELSE                                                         DTSBE408
00351          PERFORM P1110-GENERATE-R408 THRU P1110-EXIT.             DTSBE408
00352                                                                   DTSBE408
00353  P1100-EXIT.                                                      DTSBE408
00354      EXIT.                                                        DTSBE408
00355      EJECT                                                        DTSBE408
00356 **************************************************************    DTSBE408
00357 *  THIS PARAGRAPH SETS UP THE R408 REPORT EXTRACT RECORD AND      DTSBE408
00358 *  CAUSES IT TO BE WRITTEN.                                       DTSBE408
00359 **************************************************************    DTSBE408
00360                                                                   DTSBE408
00361  P1110-GENERATE-R408.                                             DTSBE408
00362                                                                   DTSBE408
00363      MOVE MDPC-RESPONSIBLE-OP-ID  TO  R408-OP-ID.                 DTSBE408
00364      MOVE MPRF-EMP-NO             TO  R408-EMP-NO.                DTSBE408
00365      MOVE MPRF-PRIMARY-NAME       TO  R408-PRIMARY-NAME.             CL**2
00366      MOVE WRK-PARM-PERIOD-START-DATE                              DTSBE408
00367                                   TO  R408-PERIOD-START-DATE.     DTSBE408
00368      MOVE WRK-PARM-PERIOD-END-DATE                                DTSBE408
00369                                   TO  R408-PERIOD-END-DATE.       DTSBE408
00370      MOVE MDPC-COV-CNT            TO  R408-COVERED-YRQ-CNT.       DTSBE408
00371                                                                   DTSBE408
00372      PERFORM P1112-MOVE-YRQ-TABLE  THRU  P1112-EXIT               DTSBE408
00373          VARYING MDPC-COV-IDX  FROM 1 BY 1                        DTSBE408
00374              UNTIL MDPC-COV-IDX  GREATER THAN  MDPC-COV-CNT.      DTSBE408
00375                                                                   DTSBE408
00376      PERFORM S946-WRITE-R408  THRU  S946-EXIT.                    DTSBE408
00377                                                                   DTSBE408
00378      PERFORM P1111-INITIALIZE-TABLE  THRU  P1111-EXIT             DTSBE408
00379        VARYING WRK-SUB  FROM 1 BY 1                               DTSBE408
00380          UNTIL WRK-SUB  GREATER THAN  R408-COVERED-YRQ-CNT.       DTSBE408
00381                                                                   DTSBE408
00382  P1110-EXIT.                                                      DTSBE408
00383      EXIT.                                                        DTSBE408
00384      EJECT                                                        DTSBE408
00385 **************************************************************    DTSBE408
00386 *  THIS PARAGRAPH MOVES THE QUARTERS COVERED TABLE IN THE MDPC    DTSBE408
00387 *  RECORD TO THE R408 EXTRACT RECORD TABLE.                       DTSBE408
00388 **************************************************************    DTSBE408
00389                                                                   DTSBE408
00390  P1111-INITIALIZE-TABLE.                                          DTSBE408
00391                                                                   DTSBE408
00392      MOVE ZEROS              TO  R408-COVERED-YRQ (WRK-SUB).      DTSBE408
00393                                                                   DTSBE408
00394  P1111-EXIT.                                                      DTSBE408
00395      EXIT.                                                        DTSBE408
00396      EJECT                                                        DTSBE408
00397 **************************************************************    DTSBE408
00398 *  THIS PARAGRAPH MOVES THE QUARTERS COVERED TABLE IN THE MDPC    DTSBE408
00399 *  RECORD TO THE R408 EXTRACT RECORD TABLE.                       DTSBE408
00400 **************************************************************    DTSBE408
00401                                                                   DTSBE408
00402  P1112-MOVE-YRQ-TABLE.                                            DTSBE408
00403                                                                   DTSBE408
00404      SET R408-YRQ-IDX  TO  MDPC-COV-IDX.                          DTSBE408
00405                                                                   DTSBE408
00406      MOVE MDPC-COVERED-YRQ (MDPC-COV-IDX)                         DTSBE408
00407                        TO  R408-COVERED-YRQ (R408-YRQ-IDX).       DTSBE408
00408                                                                   DTSBE408
00409  P1112-EXIT.                                                      DTSBE408
00410      EXIT.                                                        DTSBE408
00411      EJECT                                                        DTSBE408
00412 **************************************************************    DTSBE408
00413 *  THIS PARAGRAPH DETERMINES WHETHER AN OPEN MDPC RECORD          DTSBE408
00414 *  SHOULD BE AUTOMATICALLY SATISFIED.  IF IT SHOULD BE            DTSBE408
00415 *  SATISFIED MODIFY AND REWRITE THE MDPC RECORD, AND WRITE        DTSBE408
00416 *  AN MEVL RECORD COMMEMORATING THE EVENT.                        DTSBE408
00417 **************************************************************    DTSBE408
00418                                                                   DTSBE408
00419  P1200-OPEN-MDPC.                                                 DTSBE408
00420                                                                   DTSBE408
00421      SET WRK-PLAN-SATISFIED-88       TO  TRUE.                    DTSBE408
00422                                                                   DTSBE408
00423      PERFORM P1210-PROCESS-QTRS  THRU  P1210-EXIT                 DTSBE408
00424          VARYING MDPC-COV-IDX  FROM 1 BY 1                        DTSBE408
00425              UNTIL WRK-PLAN-NOT-SATISFIED-88   OR                 DTSBE408
00426                    MDPC-COV-IDX  GREATER THAN  MDPC-COV-CNT.      DTSBE408
00427                                                                   DTSBE408
00428      IF WRK-PLAN-SATISFIED-88                                     DTSBE408
00429          PERFORM P1110-GENERATE-R408  THRU  P1110-EXIT            DTSBE408
00430          PERFORM P1220-REWRITE-MDPC  THRU  P1220-EXIT             DTSBE408
00431          PERFORM P1230-WRITE-MEVL  THRU  P1230-EXIT.              DTSBE408
00432                                                                   DTSBE408
00433  P1200-EXIT.                                                      DTSBE408
00434      EXIT.                                                        DTSBE408
00435      EJECT                                                        DTSBE408
00436 **************************************************************    DTSBE408
00437 *  THIS PARAGRAPH READS THE MQTR RECORDS COVERED BY THE MDPC      DTSBE408
00438 *  RECORD TO DETERMINE IF THER ARE BALANCES DUE.  IF THERE        DTSBE408
00439 *  ARE NOT THE PAYMENTS ARE CHECKED TO SEE IF THEY ARE OVER       DTSBE408
00440 *  TWO WEEKS OLD.                                                 DTSBE408
00441 **************************************************************    DTSBE408
00442                                                                   DTSBE408
00443  P1210-PROCESS-QTRS.                                              DTSBE408
00444                                                                   DTSBE408
00445      MOVE LOW-VALUES                      TO  MQTR-KEY-AREA.      DTSBE408
00446      MOVE MPRF-EMP-NO                     TO  MQTR-EMP-NO.        DTSBE408
00447      SET MQTR-QTR-88                      TO  TRUE.               DTSBE408
00448      MOVE MDPC-COVERED-YRQ (MDPC-COV-IDX) TO  MQTR-YRQ.           DTSBE408
00449      MOVE MQTR-KEY-AREA                   TO  MSKL-KEY-AREA.      DTSBE408
00450                                                                   DTSBE408
00451      PERFORM S910-READ  THRU  S910-EXIT.                          DTSBE408
00452                                                                   DTSBE408
00453      IF L910-OK-88                                                DTSBE408
00454          NEXT SENTENCE                                            DTSBE408
00455      ELSE                                                         DTSBE408
00456          GO TO P1210-EXIT.                                        DTSBE408
00457                                                                   DTSBE408
00458      MOVE MSKL-REC                        TO  MQTR-REC.           DTSBE408
00459                                                                   DTSBE408
00460      PERFORM P1211-PROCESS-ACCT-AREA  THRU  P1211-EXIT            DTSBE408
00461        VARYING MQTR-ACCT-IDX  FROM 1 BY 1                         DTSBE408
00462          UNTIL WRK-PLAN-NOT-SATISFIED-88 OR                       DTSBE408
00463                MQTR-ACCT-IDX  GREATER THAN  MQTR-ACCT-CNT.        DTSBE408
00464                                                                   DTSBE408
00465      IF MQTR-RPT-IS-PURSUED-88                                    DTSBE408
00466          SET WRK-PLAN-NOT-SATISFIED-88    TO  TRUE.               DTSBE408
00467                                                                   DTSBE408
00468      IF WRK-PLAN-NOT-SATISFIED-88                                 DTSBE408
00469          GO TO P1210-EXIT.                                        DTSBE408
00470                                                                   DTSBE408
00471      MOVE LOW-VALUES                      TO  MDST-KEY-AREA.      DTSBE408
00472      MOVE MPRF-EMP-NO                     TO  MDST-EMP-NO.        DTSBE408
00473      MOVE MQTR-YRQ                        TO  MDST-YRQ.           DTSBE408
00474      SET MDST-DST-88                      TO  TRUE.               DTSBE408
00475      MOVE MDST-KEY-AREA                   TO  MSKL-KEY-AREA.      DTSBE408
00476                                                                   DTSBE408
00477      PERFORM S910-START-BROWSE  THRU  S910-EXIT.                  DTSBE408
00478                                                                   DTSBE408
00479      IF L910-OK-88                                                DTSBE408
00480          PERFORM P1212-CHECK-DATE  THRU  P1212-EXIT               DTSBE408
00481              UNTIL L910-NO-REC-88         OR                      DTSBE408
00482                    WRK-PLAN-NOT-SATISFIED-88.                     DTSBE408
00483                                                                   DTSBE408
00484  P1210-EXIT.                                                      DTSBE408
00485      EXIT.                                                        DTSBE408
00486      EJECT                                                        DTSBE408
00487 **************************************************************    DTSBE408
00488 *  THIS PARAGRAPH CHECKS THE BALANCE DUE IN THE MQTR RECORDS.     DTSBE408
00489 **************************************************************    DTSBE408
00490                                                                   DTSBE408
00491  P1211-PROCESS-ACCT-AREA.                                         DTSBE408
00492                                                                   DTSBE408
00493      IF MQTR-BALANCE-AMT (MQTR-ACCT-IDX)  GREATER THAN ZERO       DTSBE408
00494          SET WRK-PLAN-NOT-SATISFIED-88     TO  TRUE.              DTSBE408
00495                                                                   DTSBE408
00496  P1211-EXIT.                                                      DTSBE408
00497      EXIT.                                                        DTSBE408
00498      EJECT                                                        DTSBE408
00499 **************************************************************    DTSBE408
00500 *  THIS PARAGRAPH CHECKS THE PAYMENT DATES ON ALL MDST            DTSBE408
00501 *  RECORDS FOR THE QUARTER TO DETERMINE IF THE PAYMENTS HAVE      DTSBE408
00502 *  AGED.                                                          DTSBE408
00503 **************************************************************    DTSBE408
00504                                                                   DTSBE408
00505  P1212-CHECK-DATE.                                                DTSBE408
00506                                                                   DTSBE408
00507      MOVE MSKL-REC                        TO  MDST-REC.           DTSBE408
00508                                                                   DTSBE408
00509      IF MDST-YRQ                       EQUAL  MQTR-YRQ            DTSBE408
00510          NEXT SENTENCE                                            DTSBE408
00511      ELSE                                                         DTSBE408
00512          SET L910-NO-REC-88               TO  TRUE                DTSBE408
00513          GO TO P1212-EXIT.                                        DTSBE408
00514                                                                   DTSBE408
00515      IF MDST-RECEIVED-DATE  LESS THAN  WRK-PAYMENT-CUTOFF-DATE    DTSBE408
00516          NEXT SENTENCE                                            DTSBE408
00517      ELSE                                                         DTSBE408
00518          SET WRK-PLAN-NOT-SATISFIED-88    TO  TRUE.               DTSBE408
00519                                                                   DTSBE408
00520      PERFORM S910-READ-NEXT  THRU  S910-EXIT.                     DTSBE408
00521                                                                   DTSBE408
00522  P1212-EXIT.                                                      DTSBE408
00523      EXIT.                                                        DTSBE408
00524      EJECT                                                        DTSBE408
00525 **************************************************************    DTSBE408
00526 *  THIS PARAGRAPH REWRITES THE MDPC RECORD IF IT HAS BEEN         DTSBE408
00527 *  DETERMINED THAT IT SHOULD BE AUTOMATICALLY SATISFIED.          DTSBE408
00528 **************************************************************    DTSBE408
00529                                                                   DTSBE408
00530  P1220-REWRITE-MDPC.                                              DTSBE408
00531                                                                   DTSBE408
00532      SET MDPC-STATUS-SATISFIED-88         TO  TRUE.               DTSBE408
00533      SET MDPC-STATUS-SYSTEM-88            TO  TRUE.               DTSBE408
00534                                                                   DTSBE408
00535      MOVE LECM-CURR-RUN-DATE              TO  MDPC-STATUS-DATE    DTSBE408
00536                                               MDPC-CHNG-DATE.     DTSBE408
00537      MOVE MDPC-REC                        TO  MSKL-REC.           DTSBE408
00538                                                                   DTSBE408
00539      PERFORM S910-REWRITE  THRU  S910-EXIT.                       DTSBE408
00540                                                                   DTSBE408
00541  P1220-EXIT.                                                      DTSBE408
00542      EXIT.                                                        DTSBE408
00543      EJECT                                                        DTSBE408
00544 **************************************************************    DTSBE408
00545 *  THIS PARAGRAPH WRITES AN MEVL RECORD WHEN AN MDST RECORD       DTSBE408
00546 *  HAS BEEN AUTOMATICALLY SATISFIED.                              DTSBE408
00547 **************************************************************    DTSBE408
00548                                                                   DTSBE408
00549  P1230-WRITE-MEVL.                                                DTSBE408
00550                                                                   DTSBE408
00551      MOVE LOW-VALUES                TO  MEVL-REC.                 DTSBE408
00552      MOVE MPRF-EMP-NO               TO  MEVL-EMP-NO.              DTSBE408
00553      SET MEVL-EVL-88                TO  TRUE.                     DTSBE408
00554      ADD +1000                      TO  LECM-EMP-ABSTIME.         DTSBE408
00555      MOVE LECM-EMP-ABSTIME          TO  L005-ABSTIME.             DTSBE408
00556                                                                   DTSBE408
00557      PERFORM S005-FROM-ABSTIME  THRU  S005-EXIT.                  DTSBE408
00558                                                                   DTSBE408
00559      MOVE L005-DATE                 TO  MEVL-DATE.                DTSBE408
00560      MOVE L005-TIME                 TO  MEVL-TIME.                DTSBE408
00561      MOVE ZEROS                     TO  MEVL-PURGE-DATE.          DTSBE408
00562      MOVE EVL-TEXT                  TO  MEVL-TEXT.                DTSBE408
00563                                                                   DTSBE408
00564      SET MEVL-SOURCE-SYSTEM-88      TO  TRUE.                     DTSBE408
00565      SET MEVL-NOT-CONVERTED-88      TO  TRUE.                     DTSBE408
00566                                                                   DTSBE408
00567      MOVE LECM-CURR-RUN-DATE        TO  MEVL-ESTB-DATE            DTSBE408
00568                                         MEVL-CHNG-DATE.           DTSBE408
00569      MOVE MEVL-REC                  TO  MSKL-REC.                 DTSBE408
00570                                                                   DTSBE408
00571      PERFORM S910-WRITE  THRU  S910-EXIT.                         DTSBE408
00572                                                                   DTSBE408
00573  P1230-EXIT.                                                      DTSBE408
00574      EXIT.                                                        DTSBE408
00575      EJECT                                                        DTSBE408
00576  T0000-TERMINATE.                                                 DTSBE408
00577      SKIP2                                                        DTSBE408
00578      SKIP2                                                        DTSBE408
00579  T0000-EXIT.                                                      DTSBE408
00580      EXIT.                                                        DTSBE408
00581      EJECT                                                        DTSBE408
00582  S001-FROM-FED-8.                                                 DTSBE408
00583      SET L001-FROM-FED-8 TO TRUE.                                 DTSBE408
00584      GO TO S001-DATE.                                             DTSBE408
00585      SKIP1                                                        DTSBE408
00586  S001-FROM-CAL-6.                                                 DTSBE408
00587      SET L001-FROM-CAL-6 TO TRUE.                                 DTSBE408
00588      GO TO S001-DATE.                                             DTSBE408
00589      SKIP1                                                        DTSBE408
00590  S001-FROM-ABS-DAY.                                               DTSBE408
00591      SET L001-FROM-ABS-DAY TO TRUE.                               DTSBE408
00592      GO TO S001-DATE.                                             DTSBE408
00593      SKIP1                                                        DTSBE408
00594  S001-DATE.                                                       DTSBE408
00595      CALL 'DTSBU001' USING L001-LINK-AREA.                           CL**2
00596  S001-EXIT.                                                       DTSBE408
00597      EXIT.                                                        DTSBE408
00598      SKIP3                                                        DTSBE408
00599  S004-FROM-ABS.                                                   DTSBE408
00600      SET L004-FROM-ABS TO TRUE.                                   DTSBE408
00601      GO TO S004-QTR.                                              DTSBE408
00602      SKIP1                                                        DTSBE408
00603  S004-FROM-3.                                                     DTSBE408
00604      SET L004-FROM-3 TO TRUE.                                     DTSBE408
00605      GO TO S004-QTR.                                              DTSBE408
00606      SKIP1                                                        DTSBE408
00607  S004-QTR.                                                        DTSBE408
00608      SKIP1                                                        DTSBE408
00609      CALL 'DTSBU004' USING L004-LINK-AREA.                           CL**2
00610      SKIP1                                                        DTSBE408
00611  S004-EXIT.                                                       DTSBE408
00612      EXIT.                                                        DTSBE408
00613      SKIP3                                                        DTSBE408
00614  S005-FROM-ABSTIME.                                               DTSBE408
00615      SET L005-FROM-ABSTIME TO TRUE.                               DTSBE408
00616      GO TO S005-ABSTIME.                                          DTSBE408
00617                                                                   DTSBE408
00618  S005-ABSTIME.                                                    DTSBE408
00619      CALL 'DTSBU005' USING L005-LINK-AREA.                           CL**2
00620  S005-EXIT.                                                       DTSBE408
00621      EXIT.                                                        DTSBE408
00622      SKIP3                                                        DTSBE408
00623  S910-READ.                                                       DTSBE408
00624      SET L910-READ-88 TO TRUE.                                    DTSBE408
00625      GO TO S910-MSTR-IO.                                          DTSBE408
00626      SKIP1                                                        DTSBE408
00627  S910-START-BROWSE.                                               DTSBE408
00628      SET L910-START-BROWSE-88 TO TRUE.                            DTSBE408
00629      GO TO S910-MSTR-IO.                                          DTSBE408
00630      SKIP1                                                        DTSBE408
00631  S910-READ-NEXT.                                                  DTSBE408
00632      SET L910-READ-NEXT-88 TO TRUE.                               DTSBE408
00633      GO TO S910-MSTR-IO.                                          DTSBE408
00634      SKIP1                                                        DTSBE408
00635  S910-WRITE.                                                      DTSBE408
00636      SET L910-WRITE-88 TO TRUE.                                   DTSBE408
00637      SET LECM-EMP-UPDATED-YES-88 TO TRUE.                         DTSBE408
00638      GO TO S910-MSTR-IO.                                          DTSBE408
00639      SKIP1                                                        DTSBE408
00640  S910-REWRITE.                                                    DTSBE408
00641      SET L910-REWRITE-88 TO TRUE.                                 DTSBE408
00642      SET LECM-EMP-UPDATED-YES-88 TO TRUE.                         DTSBE408
00643      GO TO S910-MSTR-IO.                                          DTSBE408
00644      SKIP1                                                        DTSBE408
00645  S910-MSTR-IO.                                                    DTSBE408
00646      CALL 'DTSBU910' USING L910-LINK-AREA                            CL**2
00647                            MSKL-REC.                              DTSBE408
00648  S910-EXIT.                                                       DTSBE408
00649      EXIT.                                                        DTSBE408
00650      SKIP3                                                        DTSBE408
00651  S946-WRITE-R408.                                                 DTSBE408
00652      CALL 'DTSBU946' USING R408-REC.                                 CL**2
00653      GO TO S946-EXIT.                                             DTSBE408
00654      SKIP1                                                        DTSBE408
00655  S946-EXIT.                                                       DTSBE408
00656      EXIT.                                                        DTSBE408
00657      SKIP3                                                        DTSBE408
00658  S999-ABEND.                                                      DTSBE408
00659      DISPLAY '*** DTSBE408 ABENDING.  '                              CL**2
00660              ABEND-MSG.                                           DTSBE408
00661      SKIP1                                                        DTSBE408
00662      CALL 'DTSBU999' USING WRK-ABEND-CD.                             CL**2
00663  S999-EXIT.                                                       DTSBE408
00664      EXIT.                                                        DTSBE408
