00001  IDENTIFICATION DIVISION.                                         08/02/02
00002  PROGRAM-ID.             DTSBD401.                                DTSBD401
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV001
00004  DATE-WRITTEN.           DECEMBER 1991.                           DTSBD401
00005  DATE-COMPILED.                                                   DTSBD401
00006      SKIP3                                                        DTSBD401
00007 *****                                                             DTSBD401
00008 *                                                                 DTSBD401
00009 *    FUNCTION:  PERIODIC REPORT EXTRACT.                          DTSBD401
00010 *               ***  ONLINE JOB REQUEST VERSION  ***              DTSBD401
00011 *                                                                 DTSBD401
00012 *                                                                 DTSBD401
00013 *    MODIFICATION LOG:                                            DTSBD401
00014 *                                                                 DTSBD401
00015 *    12/31/91  INITIAL DEVELOPMENT.                               DTSBD401
00016 *              WORK ORDER:                      PROGRAMMER: TCL   DTSBD401
00017 *                                                                 DTSBD401
00018 *    10/05/1998  REVIEWED AND MODIFIED FOR DC.                    DTSBD401
00019 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH   DTSBD401
00020 *                                                                 DTSBD401
00021 *    05/24/1999  INITIALIZE LECM-PICKUP-DIR.                      DTSBD401
00022 *                REFERENCE: PICKUP DIR          PROGRAMMER: EHH   DTSBD401
00023 *                                                                 DTSBD401
00024 *    12/07/2001  MODIFIED FOR ONLINE JOB REQUESTS: READ PARMS     DTSBD401
00025 *                FROM EXTPARM FILE.                               DTSBD401
00026 *                REFERENCE: ONLINE JOB REQUEST  PROGRAMMER: GD    DTSBD401
00027 *                                                                 DTSBD401
00028 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBD401
00029 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBD401
00030 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSBD401
00031 *                                                                 DTSBD401
00032 *                                                                 DTSBD401
00033 *  DESCRIPTION:                                                   DTSBD401
00034 *                                                                 DTSBD401
00035 *    INITIATION.                                                  DTSBD401
00036 *                                                                 DTSBD401
00037 *      PROCESS PARAMETERS INPUT VIA LINKAGE (IN PARM-AREA).       DTSBD401
00038 *                                                                 DTSBD401
00039 *                                                                 DTSBD401
00040 *      READ THE PARM-FILE UNTIL PARM-EOF.  ONE TO FIFTY PARM      DTSBD401
00041 *      RECORDS ALLOWED.                                           DTSBD401
00042 *                                                                 DTSBD401
00043 *      DISPLAY EACH PARM RECORD.                                  DTSBD401
00044 *                                                                 DTSBD401
00045 *      EACH PARM RECORD INDICATES AN EXTRACT MODULE TO BE CALLED  DTSBD401
00046 *      DURING THIS PARTICULAR RUN, AND CONTAINS ANY EXTRACT       DTSBD401
00047 *      MODULE SPECIFIC PARAMETERS.                                DTSBD401
00048 *                                                                 DTSBD401
00049 *      TABLE PARM RECORDS 1 THRU N IN WRK-EXTRACT-AREA.           DTSBD401
00050 *                                                                 DTSBD401
00051 *      THE SAME WRK-EXTRACT-ID VALUE IN MULTIPLE OCCURRENCES OF   DTSBD401
00052 *      WRK-EXTRACT-AREA IS NOT ALLOWED.  PARM RECORDS ARRIVE      DTSBD401
00053 *      SORTED IN ASCENDING ORDER BY PROGRAM (WRK-EXTRACT-ID) AND  DTSBD401
00054 *      IN DECENDING ORDER BY TIME ENTERED (MOST RECENT FIRST).    DTSBD401
00055 *      IF THERE ARE DUPLICATES, THE LAST ONE ADDED TO THE OLA     DTSBD401
00056 *      FILE WILL BE ADDED TO THE TABLE, AND ANY EARLIER REQUESTS  DTSBD401
00057 *      FOR THE SAME PROGRAM WILL BE DISCARDED.                    DTSBD401
00058 *                                                                 DTSBD401
00059 *      MAKE AN 'INITIALIZATION' CALL TO EACH OF THE EXTRACT       DTSBD401
00060 *      MODULES TABLED IN WRK-EXTRACT-AREA.  SAVE THE HIGHEST      DTSBD401
00061 *      VALUE RETURNED IN LECM-OPEN-MST-IND AND SAVE THE           DTSBD401
00062 *      HIGHEST VALUE RETURNED IN LECM-OPEN-REF-IND.               DTSBD401
00063 *                                                                 DTSBD401
00064 *      OPEN THE MASTER FILE, ALTERNATE INDEX FILE AND             DTSBD401
00065 *      REFERENCE FILE WITH THE OPEN COMMAND (READ ONLY            DTSBD401
00066 *      OR UPDATE) AS INDICATED BY THE INFORMATION RETURNED        DTSBD401
00067 *      BY THE "INITIALIZATION" CALLS.                             DTSBD401
00068 *                                                                 DTSBD401
00069 *                                                                 DTSBD401
00070 *      READ THE MHDR RECORD.                                      DTSBD401
00071 *                                                                 DTSBD401
00072 *      IF L910-NO-REC-88                                          DTSBD401
00073 *          ABEND THE MODULE.                                      DTSBD401
00074 *                                                                 DTSBD401
00075 *      INITIALIZE THE LECM FIELDS.                                DTSBD401
00076 *                                                                 DTSBD401
00077 *      SET LECM-PROCESS-88 TO TRUE.                               DTSBD401
00078 *                                                                 DTSBD401
00079 *      SET L910 TO "READ NEXT" A MPRF RECORD.                     DTSBD401
00080 *                                                                 DTSBD401
00081 *      MOVE +0 TO WRK-MPRF-CNT.                                   DTSBD401
00082 *                                                                 DTSBD401
00083 *                                                                 DTSBD401
00084 *                                                                 DTSBD401
00085 *    PROCESSING.                                                  DTSBD401
00086 *                                                                 DTSBD401
00087 *          PERFORM P1000-READ-NEXT                                DTSBD401
00088 *              UNTIL L910-NO-REC-88.                              DTSBD401
00089 *                                                                 DTSBD401
00090 *      P1000-READ-NEXT.                                           DTSBD401
00091 *          READ THE NEXT MPRF RECORD.                             DTSBD401
00092 *          IF L910-OK-88                                          DTSBD401
00093 *              ADD +1 TO WRK-MPRF-CNT                             DTSBD401
00094 *              PERFORM S1000-CALL-EXTRACT                         DTSBD401
00095 *                  VARYING WRK-EXT-IDX FROM 1 BY 1                DTSBD401
00096 *                  UNTIL WRK-EXT-IDX > WRK-EXTRACT-CNT.           DTSBD401
00097 *                                                                 DTSBD401
00098 *      S1000-CALL-EXTRACT.                                        DTSBD401
00099 *          MOVE WRK-EXTRACT-PARMS (WRK-EXT-IDX)                   DTSBD401
00100 *            TO LECM-EXTRACT-PARMS.                               DTSBD401
00101 *                                                                 DTSBD401
00102 *            CALL 'DTSBE***' USING LECM-LINK-AREA                 DTSBD401
00103 *                                  MPRF-REC.                      DTSBD401
00104 *                                                                 DTSBD401
00105 *          IF NO EXTRACT MODULE CORRESPONDING TO WRK-EXTRACT-SUB  DTSBD401
00106 *          EXISTS, THEN THE STEP ABENDS (MODULE NOT FOUND).       DTSBD401
00107 *                                                                 DTSBD401
00108 *                                                                 DTSBD401
00109 *                                                                 DTSBD401
00110 *    TERMINATION.                                                 DTSBD401
00111 *                                                                 DTSBD401
00112 *      SET LECM-TERMINATE-88 TO TRUE.                             DTSBD401
00113 *                                                                 DTSBD401
00114 *      PERFORM S1000-CALL-EXTRACT                                 DTSBD401
00115 *          VARYING WRK-EXT-IDX FROM 1 BY 1                        DTSBD401
00116 *          UNTIL WRK-EXT-IDX > WRK-EXTRACT-CNT.                   DTSBD401
00117 *                                                                 DTSBD401
00118 *      DISPLAY TERMINATION STATISTICS (VARIOUS LECM FIELDS AND    DTSBD401
00119 *      WRK-MPRF-CNT.                                              DTSBD401
00120 *                                                                 DTSBD401
00121 *      CLOSE MASTER FILE.                                         DTSBD401
00122 *      CLOSE ALTERNATE INDEX FILE.                                DTSBD401
00123 *      CLOSE REFERENCE FILE.                                      DTSBD401
00124 *      CLOSE REPORT RECORD FILE.                                  DTSBD401
00125 *                                                                 DTSBD401
00126 *      SET RETURN-CODE TO 0.                                      DTSBD401
00127 *                                                                 DTSBD401
00128 *****                                                             DTSBD401
00129      SKIP3                                                        DTSBD401
00130  ENVIRONMENT DIVISION.                                            DTSBD401
00131      SKIP2                                                        DTSBD401
00132  INPUT-OUTPUT SECTION.                                            DTSBD401
00133                                                                   DTSBD401
00134  FILE-CONTROL.                                                    DTSBD401
00135      SELECT PARM-FILE ASSIGN TO EXTPARMS                          DTSBD401
00136         FILE STATUS IS EXTPARM-STATUS.                            DTSBD401
00137      EJECT                                                        DTSBD401
00138  DATA DIVISION.                                                   DTSBD401
00139      SKIP3                                                        DTSBD401
00140  FILE SECTION.                                                    DTSBD401
00141      SKIP2                                                        DTSBD401
00142  FD  PARM-FILE                                                    DTSBD401
00143      RECORDING MODE IS F                                          DTSBD401
00144      BLOCK CONTAINS 0 RECORDS.                                    DTSBD401
00145                                                                   DTSBD401
00146  01  PARM-REC.                                                    DTSBD401
00147          10  PREC-EXTRACT-ID             PIC  X(03).              DTSBD401
00148          10  FILLER                      PIC  X(01).              DTSBD401
00149          10  PREC-EXTRACT-PARMS          PIC  X(68).              DTSBD401
00150          10  FILLER                      PIC  X(08).              DTSBD401
00151      EJECT                                                        DTSBD401
00152  WORKING-STORAGE SECTION.                                         DTSBD401
001525 77  PAN-VALET PICTURE X(24) VALUE '001DTSBD401  08/02/02'.       DTSBD401
00153      SKIP3                                                        DTSBD401
00154  01  WRK-AREA.                                                    DTSBD401
00155      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +401.DTSBD401
00156                                                                   DTSBD401
00157      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBD401'.DTSBD401
00158                                                                   DTSBD401
00159      05  EXTPARM-STATUS              PIC  X(02).                  DTSBD401
00160          88  EXTPARM-FILE-OK-88   VALUE '00'.                     DTSBD401
00161          88  EXTPARM-EOF-88       VALUE '10'.                     DTSBD401
00162                                                                   DTSBD401
00163      05  PARMFILE-IND                PIC  X(01) VALUE '0'.        DTSBD401
00164          88  PARMFILE-OK-88       VALUE '0'.                      DTSBD401
00165          88  PARMFILE-EMPTY-88    VALUE '1'.                      DTSBD401
00166                                                                   DTSBD401
00167      05  WRK-DUPLICATE-IND           PIC  X(01).                  DTSBD401
00168          88  WRK-DUPLICATE-YES-88 VALUE 'Y'.                      DTSBD401
00169          88  WRK-DUPLICATE-NO-88  VALUE 'N'.                      DTSBD401
00170                                                                   DTSBD401
00171      05  WRK-MPRF-CNT                PIC S9(07)  COMP-3.          DTSBD401
00172                                                                   DTSBD401
00173      05  WRK-UPDATED-CNT             PIC S9(07)  COMP-3.          DTSBD401
00174                                                                   DTSBD401
00175      05  PARM-REC-CNT                PIC S9(07)  COMP-3.          DTSBD401
00176                                                                   DTSBD401
00177      05  HOLD-EXTRACT-SUB            PIC S9(04)  COMP.            DTSBD401
00178                                                                   DTSBD401
00179      05  WRK-SUB                     PIC S9(04)  COMP.            DTSBD401
00180                                                                   DTSBD401
00181      05  PARM-EOF-IND                    PIC  X(01).              DTSBD401
00182                                                                   DTSBD401
00183      05  WRK-RUN-TYPE                    PIC  X(02).              DTSBD401
00184                                                                   DTSBD401
00185      05  WRK-PRE-BACKUP-IND              PIC  X(01).              DTSBD401
00186                                                                   DTSBD401
00187      05  WRK-ONLY-CHECK-PARM-IND         PIC  X(01).              DTSBD401
00188                                                                   DTSBD401
00189      05  WRK-TRACE-IND                   PIC  X(01).              DTSBD401
00190                                                                   DTSBD401
00191      05  WRK-MST-OPEN-IND                PIC  X(01).              DTSBD401
00192                                                                   DTSBD401
00193      05  WRK-REF-OPEN-IND                PIC  X(01).              DTSBD401
00194                                                                   DTSBD401
00195 *****05  WRK-BTC-IND                     PIC  X(01).              DTSBD401
00196                                                                   DTSBD401
00197      05  WRK-EMP-UPDATED-IND             PIC  X(01).              DTSBD401
00198          88  WRK-EMP-UPDATED-NO-88              VALUE 'N'.        DTSBD401
00199          88  WRK-EMP-UPDATED-YES-88             VALUE 'Y'.        DTSBD401
00200      SKIP3                                                        DTSBD401
00201      05  WRK-EXTRACT-CNT                 PIC S9(04)       COMP.   DTSBD401
00202                                                                   DTSBD401
00203      05  WRK-EXTRACT-AREA OCCURS 50 TIMES                         DTSBD401
00204                           INDEXED BY WRK-EXT-IDX.                 DTSBD401
00205          10  WRK-EXTRACT-ID              PIC  X(03).              DTSBD401
00206          10  WRK-EXTRACT-PARMS           PIC  X(68).              DTSBD401
00207      SKIP3                                                        DTSBD401
00208      05  WRK-START-ABSTIME               PIC S9(15)       COMP-3. DTSBD401
00209                                                                   DTSBD401
00210      05  WRK-STEP-DURATION-X             PIC  X(09).              DTSBD401
00211      05  WRK-STEP-DURATION REDEFINES WRK-STEP-DURATION-X          DTSBD401
00212                                          PIC  ZZ,ZZ9.99.          DTSBD401
00213      SKIP3                                                        DTSBD401
00214      05  EXTRACT-MOD-NAME.                                        DTSBD401
00215          10  FILLER                  PIC  X(05)  VALUE 'DTSBE'.   DTSBD401
00216          10  EXTRACT-MOD-ID          PIC  X(03).                  DTSBD401
00217      EJECT                                                        DTSBD401
00218  01  MSG-TABLE.                                                   DTSBD401
00219      05  MSG1-UPDATE-LOCKED-EMP.                                  DTSBD401
00220          10  MSG1-ID                 PIC  X(03)  VALUE '991'.     DTSBD401
00221          10  MSG1-TEXT.                                           DTSBD401
00222              15  FILLER              PIC  X(30)                   DTSBD401
00223                    VALUE 'DESPITE BEING LOCKED AGAINST U'.        DTSBD401
00224              15  FILLER              PIC  X(30)                   DTSBD401
00225                    VALUE 'PDATE, A PERIODIC EXTRACT PROC'.        DTSBD401
00226              15  FILLER              PIC  X(05)                   DTSBD401
00227                    VALUE 'ESS ('.                                 DTSBD401
00228              15  MSG1-EXTRACT-ID     PIC  X(03).                  DTSBD401
00229              15  FILLER              PIC  X(31)                   DTSBD401
00230                    VALUE ') UPDATED THE EMPLOYERS RECORDS'.       DTSBD401
00231      05  MSG2-DUPLICATE-REQUEST.                                  DTSBD401
00232          10  MSG2-ID                 PIC  X(03)  VALUE '992'.     DTSBD401
00233          10  MSG2-TEXT.                                           DTSBD401
00234              15  FILLER              PIC  X(30)                   DTSBD401
00235                    VALUE 'DUPLICATE REQUEST FOR PROGRAM '.        DTSBD401
00236              15  MSG2-EXTRACT-ID     PIC  X(03).                  DTSBD401
00237              15  FILLER              PIC  X(15)                   DTSBD401
00238                    VALUE '. REQUESTED BY '.                       DTSBD401
00239              15  MSG2-OP-ID          PIC  X(08).                  DTSBD401
00240              15  FILLER              PIC  X(15)                   DTSBD401
00241                    VALUE '. PARMS: '.                             DTSBD401
00242              15  MSG2-PARMS          PIC  X(34).                  DTSBD401
00243                                                                   DTSBD401
00244  01  LECM-LINK-AREA.                                              DTSBD401
00245  ++INCLUDE DTSILECM                                               DTSBD401
00246      EJECT                                                        DTSBD401
00247  01  L910-LINK-AREA.                                              DTSBD401
00248  ++INCLUDE DTSIL910                                               DTSBD401
00249      EJECT                                                        DTSBD401
00250  01  MSKL-REC.                                                    DTSBD401
00251  ++INCLUDE DTSIMSKL                                               DTSBD401
00252      EJECT                                                        DTSBD401
00253  01  MHDR-REC REDEFINES MSKL-REC.                                 DTSBD401
00254  ++INCLUDE DTSIMHDR                                               DTSBD401
00255      EJECT                                                        DTSBD401
00256  01  MPRF-REC REDEFINES MSKL-REC.                                 DTSBD401
00257  ++INCLUDE DTSIMPRF                                               DTSBD401
00258      EJECT                                                        DTSBD401
00259  01  L921-LINK-AREA.                                              DTSBD401
00260  ++INCLUDE DTSIL921                                               DTSBD401
00261      EJECT                                                        DTSBD401
00262  01  ISKL-REC.                                                    DTSBD401
00263  ++INCLUDE DTSIISKL                                               DTSBD401
00264      EJECT                                                        DTSBD401
00265  01  L927-LINK-AREA.                                              DTSBD401
00266  ++INCLUDE DTSIL927                                               DTSBD401
00267      EJECT                                                        DTSBD401
00268  01  RSKL-REC.                                                    DTSBD401
00269  ++INCLUDE DTSIRSK1                                               DTSBD401
00270      SKIP3                                                        DTSBD401
00271  01  R907-REC.                                                    DTSBD401
00272  ++INCLUDE DTSIR907                                               DTSBD401
00273      EJECT                                                        DTSBD401
00274  01  L931-LINK-AREA.                                              DTSBD401
00275  ++INCLUDE DTSIL931                                               DTSBD401
00276      EJECT                                                        DTSBD401
00277  01  FSKL-REC.                                                    DTSBD401
00278  ++INCLUDE DTSIFSKL                                               DTSBD401
00279      EJECT                                                        DTSBD401
00280  01  L005-LINK-AREA.                                              DTSBD401
00281  ++INCLUDE DTSIL005                                               DTSBD401
00282      EJECT                                                        DTSBD401
00283  LINKAGE SECTION.                                                 DTSBD401
00284      SKIP3                                                        DTSBD401
00285  01  PARM-AREA.                                                   DTSBD401
00286      05  PARM-LENGTH                   PIC S9(04)  COMP.          DTSBD401
00287      05  PARM-DATA.                                               DTSBD401
00288          10  PARM-RUN-TYPE             PIC  X(02).                DTSBD401
00289          10  FILLER                    PIC  X(01).                DTSBD401
00290          10  PARM-PRE-BACKUP-IND       PIC  X(01).                DTSBD401
00291          10  FILLER                    PIC  X(01).                DTSBD401
00292          10  PARM-ONLY-CHECK-PARM-IND  PIC  X(01).                DTSBD401
00293          10  FILLER                    PIC  X(01).                DTSBD401
00294          10  PARM-TRACE-IND            PIC  X(01).                DTSBD401
00295      EJECT                                                        DTSBD401
00296  PROCEDURE DIVISION USING PARM-AREA.                              DTSBD401
00297      SKIP2                                                        DTSBD401
00298  DTSBD400-MAINLINE.                                               DTSBD401
00299      PERFORM I0000-INITIATE THRU I0000-EXIT.                      DTSBD401
00300      IF PARMFILE-EMPTY-88                                         DTSBD401
00301         GO TO DTSBD400-MAINLINE-EXIT.                             DTSBD401
00302                                                                   DTSBD401
00303      IF WRK-ONLY-CHECK-PARM-IND = 'Y'                             DTSBD401
00304          NEXT SENTENCE                                            DTSBD401
00305      ELSE                                                         DTSBD401
00306          PERFORM P0000-PROCESS THRU P0000-EXIT.                   DTSBD401
00307                                                                   DTSBD401
00308      PERFORM T0000-TERMINATE THRU T0000-EXIT.                     DTSBD401
00309      SKIP2                                                        DTSBD401
00310  DTSBD400-MAINLINE-EXIT.                                          DTSBD401
00311      GOBACK.                                                      DTSBD401
00312      EJECT                                                        DTSBD401
00313  I0000-INITIATE.                                                  DTSBD401
00314      SKIP2                                                        DTSBD401
00315      PERFORM I1000-PROCESS-PARMS       THRU I1000-EXIT.           DTSBD401
00316      IF PARMFILE-EMPTY-88                                         DTSBD401
00317         DISPLAY 'DTSBD400: PARMFILE EMPTY'                        DTSBD401
00318         GO TO I0000-EXIT.                                         DTSBD401
00319                                                                   DTSBD401
00320      PERFORM I2000-OPEN-FILES-1        THRU I2000-EXIT.           DTSBD401
00321                                                                   DTSBD401
00322      PERFORM I3000-INITIALIZE-WRK      THRU I3000-EXIT.           DTSBD401
00323                                                                   DTSBD401
00324      PERFORM I4000-INITIAL-CALLS       THRU I4000-EXIT.           DTSBD401
00325                                                                   DTSBD401
00326      IF WRK-ONLY-CHECK-PARM-IND = 'Y'                             DTSBD401
00327          NEXT SENTENCE                                            DTSBD401
00328      ELSE                                                         DTSBD401
00329          PERFORM I5000-OPEN-FILES-2    THRU I5000-EXIT.           DTSBD401
00330                                                                   DTSBD401
00331      PERFORM I6000-RERUN-INSTRUCTIONS  THRU I6000-EXIT.           DTSBD401
00332      SKIP2                                                        DTSBD401
00333  I0000-EXIT.                                                      DTSBD401
00334      EXIT.                                                        DTSBD401
00335      EJECT                                                        DTSBD401
00336  I1000-PROCESS-PARMS.                                             DTSBD401
00337      DISPLAY ' '.                                                 DTSBD401
00338                                                                   DTSBD401
00339      DISPLAY '*** DTSBD400 PARAMETERS'.                           DTSBD401
00340                                                                   DTSBD401
00341                                                                   DTSBD401
00342      IF PARM-LENGTH = +8                                          DTSBD401
00343          NEXT SENTENCE                                            DTSBD401
00344      ELSE                                                         DTSBD401
00345          DISPLAY 'PARM LENGTH NOT EQUAL TO EIGHT'                 DTSBD401
00346          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD401
00347                                                                   DTSBD401
00348                                                                   DTSBD401
00349      IF PARM-PRE-BACKUP-IND = SPACES                              DTSBD401
00350          MOVE 'N' TO WRK-PRE-BACKUP-IND                           DTSBD401
00351      ELSE                                                         DTSBD401
00352          IF PARM-PRE-BACKUP-IND = 'Y' OR 'N'                      DTSBD401
00353              MOVE PARM-PRE-BACKUP-IND                             DTSBD401
00354                TO WRK-PRE-BACKUP-IND                              DTSBD401
00355          ELSE                                                     DTSBD401
00356              DISPLAY 'PARM PRE BACKUP IND = '                     DTSBD401
00357                      PARM-PRE-BACKUP-IND                          DTSBD401
00358                      ' IS NOT A VALID VALUE'                      DTSBD401
00359              PERFORM S999-ABEND THRU S999-EXIT.                   DTSBD401
00360                                                                   DTSBD401
00361                                                                   DTSBD401
00362      IF PARM-RUN-TYPE = SPACES                                    DTSBD401
00363          MOVE 'OR' TO WRK-RUN-TYPE                                DTSBD401
00364      ELSE                                                         DTSBD401
00365          IF PARM-RUN-TYPE = 'WE' OR 'MC' OR 'ME' OR 'QR' OR 'QP'  DTSBD401
00366                                  OR 'QD'                          DTSBD401
00367                                  OR 'QE' OR 'QF' OR 'YE' OR 'OR'  DTSBD401
00368              MOVE PARM-RUN-TYPE TO WRK-RUN-TYPE                   DTSBD401
00369          ELSE                                                     DTSBD401
00370              DISPLAY 'PARM RUN TYPE = '                           DTSBD401
00371                      PARM-RUN-TYPE                                DTSBD401
00372                      ' IS NOT A VALID RUN TYPE'                   DTSBD401
00373              PERFORM S999-ABEND THRU S999-EXIT.                   DTSBD401
00374                                                                   DTSBD401
00375                                                                   DTSBD401
00376      IF PARM-ONLY-CHECK-PARM-IND = SPACES                         DTSBD401
00377          MOVE 'N' TO WRK-ONLY-CHECK-PARM-IND                      DTSBD401
00378      ELSE                                                         DTSBD401
00379          IF PARM-ONLY-CHECK-PARM-IND = 'Y' OR 'N'                 DTSBD401
00380              MOVE PARM-ONLY-CHECK-PARM-IND                        DTSBD401
00381                TO WRK-ONLY-CHECK-PARM-IND                         DTSBD401
00382          ELSE                                                     DTSBD401
00383              DISPLAY 'PARM ONLY CHECK PARM IND = '                DTSBD401
00384                      PARM-ONLY-CHECK-PARM-IND                     DTSBD401
00385                      ' IS NOT A VALID VALUE'                      DTSBD401
00386              PERFORM S999-ABEND THRU S999-EXIT.                   DTSBD401
00387                                                                   DTSBD401
00388                                                                   DTSBD401
00389      IF PARM-TRACE-IND = SPACES                                   DTSBD401
00390          MOVE 'N' TO WRK-TRACE-IND                                DTSBD401
00391      ELSE                                                         DTSBD401
00392          MOVE PARM-TRACE-IND TO WRK-TRACE-IND.                    DTSBD401
00393                                                                   DTSBD401
00394                                                                   DTSBD401
00395      DISPLAY ' '.                                                 DTSBD401
00396                                                                   DTSBD401
00397      DISPLAY '       RUN TYPE: '                                  DTSBD401
00398              WRK-RUN-TYPE.                                        DTSBD401
00399                                                                   DTSBD401
00400      DISPLAY ' PRE-BACKUP IND: '                                  DTSBD401
00401              WRK-PRE-BACKUP-IND.                                  DTSBD401
00402                                                                   DTSBD401
00403      DISPLAY 'ONLY CHECK PARM: '                                  DTSBD401
00404              WRK-ONLY-CHECK-PARM-IND.                             DTSBD401
00405                                                                   DTSBD401
00406      DISPLAY 'TRACE INDICATOR: '                                  DTSBD401
00407              WRK-TRACE-IND.                                       DTSBD401
00408                                                                   DTSBD401
00409      DISPLAY ' '.                                                 DTSBD401
00410                                                                   DTSBD401
00411                                                                   DTSBD401
00412      SET PARMFILE-OK-88   TO TRUE.                                DTSBD401
00413                                                                   DTSBD401
00414      OPEN INPUT PARM-FILE.                                        DTSBD401
00415      IF EXTPARM-FILE-OK-88                                        DTSBD401
00416         NEXT SENTENCE                                             DTSBD401
00417      ELSE                                                         DTSBD401
00418         DISPLAY 'CANNOT OPEN PARM FILE '                          DTSBD401
00419            EXTPARM-STATUS                                         DTSBD401
00420         PERFORM S999-ABEND  THRU S999-EXIT.                       DTSBD401
00421                                                                   DTSBD401
00422      MOVE 'N'   TO PARM-EOF-IND.                                  DTSBD401
00423                                                                   DTSBD401
00424      MOVE +0    TO PARM-REC-CNT.                                  DTSBD401
00425                                                                   DTSBD401
00426      MOVE +0    TO WRK-EXTRACT-CNT.                               DTSBD401
00427                                                                   DTSBD401
00428      PERFORM I1100-READ-PARM  THRU I1100-EXIT                     DTSBD401
00429              UNTIL NOT EXTPARM-FILE-OK-88.                        DTSBD401
00430                                                                   DTSBD401
00431      IF EXTPARM-FILE-OK-88                                        DTSBD401
00432      OR EXTPARM-EOF-88                                            DTSBD401
00433         NEXT SENTENCE                                             DTSBD401
00434      ELSE                                                         DTSBD401
00435         DISPLAY 'CANNOT READ PARAMETER FILE '                     DTSBD401
00436            EXTPARM-STATUS                                         DTSBD401
00437         PERFORM S999-ABEND  THRU S999-EXIT.                       DTSBD401
00438                                                                   DTSBD401
00439      IF PARM-REC-CNT > 50                                         DTSBD401
00440         DISPLAY 'MORE THAN 50 PARAMETER RECORDS IS NOT VALID'     DTSBD401
00441         PERFORM S999-ABEND  THRU S999-EXIT.                       DTSBD401
00442                                                                   DTSBD401
00443      IF PARM-REC-CNT = ZERO                                       DTSBD401
00444         SET PARMFILE-EMPTY-88  TO TRUE                            DTSBD401
00445      ELSE                                                         DTSBD401
00446         IF WRK-EXTRACT-ID (1) = '000'                             DTSBD401
00447            SET PARMFILE-EMPTY-88  TO TRUE.                        DTSBD401
00448                                                                   DTSBD401
00449      CLOSE PARM-FILE.                                             DTSBD401
00450  I1000-EXIT.                                                      DTSBD401
00451      EXIT.                                                        DTSBD401
00452      EJECT                                                        DTSBD401
00453  I1100-READ-PARM.                                                 DTSBD401
00454      READ PARM-FILE.                                              DTSBD401
00455      IF EXTPARM-EOF-88                                            DTSBD401
00456          GO TO I1100-EXIT                                         DTSBD401
00457       ELSE                                                        DTSBD401
00458          IF NOT EXTPARM-FILE-OK-88                                DTSBD401
00459            DISPLAY 'CANNOT READ PARAMETER FILE '                  DTSBD401
00460               EXTPARM-STATUS                                      DTSBD401
00461            PERFORM S999-ABEND  THRU S999-EXIT.                    DTSBD401
00462                                                                   DTSBD401
00463                                                                   DTSBD401
00464      DISPLAY '*** '                                               DTSBD401
00465              PARM-REC.                                            DTSBD401
00466                                                                   DTSBD401
00467                                                                   DTSBD401
00468      IF PREC-EXTRACT-ID = '***'                                   DTSBD401
00469          GO TO I1100-EXIT.                                        DTSBD401
00470                                                                   DTSBD401
00471                                                                   DTSBD401
00472      ADD +1 TO PARM-REC-CNT.                                      DTSBD401
00473                                                                   DTSBD401
00474      PERFORM I1200-LOAD-PARM-TABLE  THRU I1200-EXIT.              DTSBD401
00475  I1100-EXIT.                                                      DTSBD401
00476      EXIT.                                                        DTSBD401
00477      EJECT                                                        DTSBD401
00478  I1200-LOAD-PARM-TABLE.                                           DTSBD401
00479      SET WRK-DUPLICATE-NO-88  TO TRUE.                            DTSBD401
00480      IF WRK-EXTRACT-CNT > 0                                       DTSBD401
00481         PERFORM I1250-DUP-EXTRACT-ID-CHECK THRU I1250-EXIT        DTSBD401
00482            VARYING WRK-SUB FROM 1 BY 1                            DTSBD401
00483            UNTIL WRK-SUB > WRK-EXTRACT-CNT.                       DTSBD401
00484      IF WRK-DUPLICATE-YES-88                                      DTSBD401
00485         GO TO I1200-EXIT.                                         DTSBD401
00486                                                                   DTSBD401
00487      ADD +1 TO WRK-EXTRACT-CNT.                                   DTSBD401
00488                                                                   DTSBD401
00489      IF WRK-EXTRACT-CNT > 50                                      DTSBD401
00490         DISPLAY 'MORE THAN 50 EXTRACT ID CODES INVALID'           DTSBD401
00491         PERFORM S999-ABEND THRU S999-EXIT.                        DTSBD401
00492                                                                   DTSBD401
00493      MOVE PREC-EXTRACT-ID                                         DTSBD401
00494        TO WRK-EXTRACT-ID (WRK-EXTRACT-CNT).                       DTSBD401
00495                                                                   DTSBD401
00496      MOVE PREC-EXTRACT-PARMS                                      DTSBD401
00497        TO WRK-EXTRACT-PARMS (WRK-EXTRACT-CNT).                    DTSBD401
00498  I1200-EXIT.                                                      DTSBD401
00499      EXIT.                                                        DTSBD401
00500      EJECT                                                        DTSBD401
00501  I1250-DUP-EXTRACT-ID-CHECK.                                      DTSBD401
00502      IF PREC-EXTRACT-ID = WRK-EXTRACT-ID (WRK-SUB)                DTSBD401
00503         SET WRK-DUPLICATE-YES-88  TO TRUE                         DTSBD401
00504         MOVE MPRF-EMP-NO          TO R907-EMP-NO                  DTSBD401
00505         MOVE PREC-EXTRACT-ID      TO MSG2-EXTRACT-ID              DTSBD401
00506         MOVE PREC-EXTRACT-PARMS   TO MSG2-PARMS                   DTSBD401
00507         MOVE MSG2-TEXT            TO R907-MSG-TEXT                DTSBD401
00508         MOVE WRK-MOD-NAME         TO R907-MODULE-NAME             DTSBD401
00509         MOVE R907-REC             TO RSKL-REC                     DTSBD401
00510         PERFORM S946-RPT-O        THRU S946-EXIT.                 DTSBD401
00511                                                                   DTSBD401
00512  I1250-EXIT.                                                      DTSBD401
00513      EXIT.                                                        DTSBD401
00514      EJECT                                                        DTSBD401
00515  I2000-OPEN-FILES-1.                                              DTSBD401
00516      MOVE WRK-TRACE-IND TO L910-TRACE-IND                         DTSBD401
00517                            L921-TRACE-IND                         DTSBD401
00518                            L927-TRACE-IND                         DTSBD401
00519                            L931-TRACE-IND.                        DTSBD401
00520                                                                   DTSBD401
00521      MOVE WRK-MOD-NAME TO L910-MOD-NAME                           DTSBD401
00522                           L921-MOD-NAME                           DTSBD401
00523                           L927-MOD-NAME                           DTSBD401
00524                           L931-MOD-NAME.                          DTSBD401
00525                                                                   DTSBD401
00526      PERFORM S910-OPEN-READ THRU S910-EXIT.                       DTSBD401
00527                                                                   DTSBD401
00528      PERFORM S921-OPEN-READ THRU S921-EXIT.                       DTSBD401
00529                                                                   DTSBD401
00530      PERFORM S927-OPEN-UPDATE THRU S927-EXIT.                     DTSBD401
00531                                                                   DTSBD401
00532      PERFORM S931-OPEN-READ THRU S931-EXIT.                       DTSBD401
00533                                                                   DTSBD401
00534      MOVE LENGTH OF R907-REC TO R907-LENGTH.                      DTSBD401
00535  I2000-EXIT.                                                      DTSBD401
00536      EXIT.                                                        DTSBD401
00537      EJECT                                                        DTSBD401
00538  I3000-INITIALIZE-WRK.                                            DTSBD401
00539      MOVE LOW-VALUES TO MHDR-KEY-AREA.                            DTSBD401
00540                                                                   DTSBD401
00541      MOVE +0 TO MHDR-EMP-NO.                                      DTSBD401
00542                                                                   DTSBD401
00543      SET MHDR-HDR-88 TO TRUE.                                     DTSBD401
00544                                                                   DTSBD401
00545      PERFORM S910-READ THRU S910-EXIT.                            DTSBD401
00546                                                                   DTSBD401
00547      IF L910-NO-REC-88                                            DTSBD401
00548         PERFORM S999-ABEND THRU S999-EXIT.                        DTSBD401
00549                                                                   DTSBD401
00550      PERFORM S005-FROM-SYS THRU S005-EXIT.                        DTSBD401
00551                                                                   DTSBD401
00552      MOVE L005-ABSTIME TO WRK-START-ABSTIME.                      DTSBD401
00553                                                                   DTSBD401
00554      PERFORM I3100-INIT-LECM-PARMS THRU I3100-EXIT.               DTSBD401
00555                                                                   DTSBD401
00556      MOVE +0 TO WRK-MPRF-CNT                                      DTSBD401
00557                 WRK-UPDATED-CNT.                                  DTSBD401
00558  I3000-EXIT.                                                      DTSBD401
00559      EXIT.                                                        DTSBD401
00560      EJECT                                                        DTSBD401
00561  I3100-INIT-LECM-PARMS.                                           DTSBD401
00562      MOVE WRK-RUN-TYPE TO LECM-RUN-TYPE.                          DTSBD401
00563                                                                   DTSBD401
00564      IF WRK-RUN-TYPE = 'WE'                                       DTSBD401
00565         MOVE MHDR-CMPL-WEEK-BEGIN-DATE TO LECM-PERIOD-START-DATE  DTSBD401
00566         MOVE MHDR-CMPL-WEEK-END-DATE TO LECM-PERIOD-END-DATE      DTSBD401
00567      ELSE                                                         DTSBD401
00568      IF WRK-RUN-TYPE = 'MC' OR 'ME'                               DTSBD401
00569         MOVE MHDR-CMPL-MONTH-BEGIN-DATE TO LECM-PERIOD-START-DATE DTSBD401
00570         MOVE MHDR-CMPL-MONTH-END-DATE TO LECM-PERIOD-END-DATE     DTSBD401
00571      ELSE                                                         DTSBD401
00572      IF WRK-RUN-TYPE = 'QR' OR 'QD' OR 'QE' OR 'QF' OR 'QP'       DTSBD401
00573         MOVE MHDR-CMPL-QTR-BEGIN-DATE TO LECM-PERIOD-START-DATE   DTSBD401
00574         MOVE MHDR-CMPL-QTR-END-DATE TO LECM-PERIOD-END-DATE       DTSBD401
00575      ELSE                                                         DTSBD401
00576      IF WRK-RUN-TYPE = 'YE'                                       DTSBD401
00577         MOVE MHDR-CMPL-YEAR-BEGIN-DATE TO LECM-PERIOD-START-DATE  DTSBD401
00578         MOVE MHDR-CMPL-YEAR-END-DATE TO LECM-PERIOD-END-DATE      DTSBD401
00579      ELSE                                                         DTSBD401
00580         MOVE +0 TO LECM-PERIOD-START-DATE                         DTSBD401
00581         MOVE +0 TO LECM-PERIOD-END-DATE.                          DTSBD401
00582                                                                   DTSBD401
00583      MOVE L005-ABSTIME TO LECM-RUN-ABSTIME.                       DTSBD401
00584                                                                   DTSBD401
00585      MOVE L005-DATE TO LECM-SYS-DATE.                             DTSBD401
00586                                                                   DTSBD401
00587      MOVE L005-TIME TO LECM-SYS-TIME.                             DTSBD401
00588                                                                   DTSBD401
00589      MOVE MHDR-CURR-RUN-DATE TO LECM-CURR-RUN-DATE.               DTSBD401
00590                                                                   DTSBD401
00591      MOVE MHDR-CURR-MAIL-DATE TO LECM-CURR-MAIL-DATE.             DTSBD401
00592                                                                   DTSBD401
00593      MOVE MHDR-PRIOR-RUN-DATE TO LECM-PRIOR-RUN-DATE.             DTSBD401
00594                                                                   DTSBD401
00595      MOVE MHDR-PRIOR-MAIL-DATE TO LECM-PRIOR-MAIL-DATE.           DTSBD401
00596                                                                   DTSBD401
00597      MOVE MHDR-LAST-UC30-MASS-MAIL-YRQ                            DTSBD401
00598        TO LECM-LAST-UC30-MASS-MAIL-YRQ.                           DTSBD401
00599                                                                   DTSBD401
00600      MOVE MHDR-LAST-PEN-ASSESSED-YRQ                              DTSBD401
00601        TO LECM-LAST-PEN-ASSESSED-YRQ.                             DTSBD401
00602                                                                   DTSBD401
00603      MOVE MHDR-LAST-UC30-DEL-MAIL-YRQ                             DTSBD401
00604        TO LECM-LAST-UC30-DEL-MAIL-YRQ.                            DTSBD401
00605                                                                   DTSBD401
00606      MOVE MHDR-FIRST-PURSUED-RPT-YRQ                              DTSBD401
00607        TO LECM-FIRST-PURSUED-RPT-YRQ.                             DTSBD401
00608                                                                   DTSBD401
00609      MOVE MHDR-LAST-RATE-END-YRQ                                  DTSBD401
00610        TO LECM-LAST-RATE-END-YRQ.                                 DTSBD401
00611                                                                   DTSBD401
00612      MOVE MHDR-LAST-MJRN-PURGE-DATE                               DTSBD401
00613        TO LECM-LAST-MJRN-PURGE-DATE.                              DTSBD401
00614                                                                   DTSBD401
00615      MOVE +19924 TO LECM-PICKUP-YRQ.                              DTSBD401
00616                                                                   DTSBD401
00617      MOVE WRK-TRACE-IND TO LECM-TRACE-IND.                        DTSBD401
00618  I3100-EXIT.                                                      DTSBD401
00619      EXIT.                                                        DTSBD401
00620      EJECT                                                        DTSBD401
00621  I4000-INITIAL-CALLS.                                             DTSBD401
00622      SET LECM-INITIALIZE-88 TO TRUE.                              DTSBD401
00623                                                                   DTSBD401
00624      SET LECM-MST-OPEN-READ-88 TO TRUE.                           DTSBD401
00625                                                                   DTSBD401
00626      SET LECM-REF-OPEN-READ-88 TO TRUE.                           DTSBD401
00627                                                                   DTSBD401
00628      MOVE LECM-MST-OPEN-IND TO WRK-MST-OPEN-IND.                  DTSBD401
00629                                                                   DTSBD401
00630      MOVE LECM-REF-OPEN-IND TO WRK-REF-OPEN-IND.                  DTSBD401
00631                                                                   DTSBD401
00632      PERFORM I4100-EXTRACT-LOOP THRU I4100-EXIT                   DTSBD401
00633          VARYING WRK-EXT-IDX FROM 1 BY 1                          DTSBD401
00634          UNTIL WRK-EXT-IDX > WRK-EXTRACT-CNT.                     DTSBD401
00635  I4000-EXIT.                                                      DTSBD401
00636      EXIT.                                                        DTSBD401
00637      SKIP3                                                        DTSBD401
00638  I4100-EXTRACT-LOOP.                                              DTSBD401
00639      SET LECM-MST-OPEN-READ-88 TO TRUE.                           DTSBD401
00640                                                                   DTSBD401
00641      SET LECM-REF-OPEN-READ-88 TO TRUE.                           DTSBD401
00642                                                                   DTSBD401
00643      PERFORM S1000-CALL-EXTRACT THRU S1000-EXIT.                  DTSBD401
00644                                                                   DTSBD401
00645      IF LECM-MST-OPEN-IND > WRK-MST-OPEN-IND                      DTSBD401
00646          MOVE LECM-MST-OPEN-IND TO WRK-MST-OPEN-IND.              DTSBD401
00647                                                                   DTSBD401
00648      IF LECM-REF-OPEN-IND > WRK-REF-OPEN-IND                      DTSBD401
00649          MOVE LECM-REF-OPEN-IND TO WRK-REF-OPEN-IND.              DTSBD401
00650  I4100-EXIT.                                                      DTSBD401
00651      EXIT.                                                        DTSBD401
00652      EJECT                                                        DTSBD401
00653  I5000-OPEN-FILES-2.                                              DTSBD401
00654      MOVE WRK-MST-OPEN-IND TO LECM-MST-OPEN-IND.                  DTSBD401
00655                                                                   DTSBD401
00656      MOVE WRK-REF-OPEN-IND TO LECM-REF-OPEN-IND.                  DTSBD401
00657                                                                   DTSBD401
00658      IF (LECM-MST-OPEN-UPDATE-HDR-88)                             DTSBD401
00659            OR                                                     DTSBD401
00660         (LECM-MST-OPEN-UPDATE-88)                                 DTSBD401
00661          IF WRK-PRE-BACKUP-IND = 'Y'                              DTSBD401
00662              NEXT SENTENCE                                        DTSBD401
00663          ELSE                                                     DTSBD401
00664              DISPLAY 'MASTER FILE UPDATING POSSIBLE '             DTSBD401
00665                      'BUT PARM-PRE-BACKUP-IND NOT EQUAL TO "Y"'   DTSBD401
00666              PERFORM S999-ABEND THRU S999-EXIT.                   DTSBD401
00667                                                                   DTSBD401
00668      IF LECM-MST-OPEN-READ-88                                     DTSBD401
00669          NEXT SENTENCE                                            DTSBD401
00670      ELSE                                                         DTSBD401
00671          PERFORM S910-CLOSE THRU S910-EXIT                        DTSBD401
00672          IF LECM-MST-OPEN-UPDATE-HDR-88                           DTSBD401
00673              PERFORM S910-OPEN-UPDATE-HDR THRU S910-EXIT          DTSBD401
00674          ELSE                                                     DTSBD401
00675          IF LECM-MST-OPEN-UPDATE-88                               DTSBD401
00676              PERFORM S921-CLOSE THRU S921-EXIT                    DTSBD401
00677              PERFORM S910-OPEN-UPDATE THRU S910-EXIT              DTSBD401
00678              PERFORM S921-OPEN-UPDATE THRU S921-EXIT              DTSBD401
00679          ELSE                                                     DTSBD401
00680              PERFORM S999-ABEND THRU S999-EXIT.                   DTSBD401
00681                                                                   DTSBD401
00682      IF LECM-REF-OPEN-UPDATE-88                                   DTSBD401
00683          IF WRK-PRE-BACKUP-IND = 'Y'                              DTSBD401
00684              NEXT SENTENCE                                        DTSBD401
00685          ELSE                                                     DTSBD401
00686              DISPLAY 'REFERENCE FILE UPDATING POSSIBLE '          DTSBD401
00687                      'BUT PARM-PRE-BACKUP-IND NOT EQUAL TO "Y"'   DTSBD401
00688              PERFORM S999-ABEND THRU S999-EXIT.                   DTSBD401
00689                                                                   DTSBD401
00690      IF LECM-REF-OPEN-UPDATE-88                                   DTSBD401
00691          PERFORM S931-CLOSE THRU S931-EXIT                        DTSBD401
00692          PERFORM S931-OPEN-UPDATE THRU S931-EXIT.                 DTSBD401
00693  I5000-EXIT.                                                      DTSBD401
00694      EXIT.                                                        DTSBD401
00695      EJECT                                                        DTSBD401
00696  I6000-RERUN-INSTRUCTIONS.                                        DTSBD401
00697      DISPLAY ' '.                                                 DTSBD401
00698                                                                   DTSBD401
00699      DISPLAY ' '.                                                 DTSBD401
00700                                                                   DTSBD401
00701      DISPLAY '****************************************'           DTSBD401
00702              '****************************************'.          DTSBD401
00703                                                                   DTSBD401
00704      DISPLAY '**                                      '           DTSBD401
00705              '                                      **'.          DTSBD401
00706                                                                   DTSBD401
00707      DISPLAY '**                        DTSBD400 RERUN'           DTSBD401
00708              ' INSTRUCTIONS                         **'.          DTSBD401
00709                                                                   DTSBD401
00710      DISPLAY '**                                      '           DTSBD401
00711              '                                      **'.          DTSBD401
00712                                                                   DTSBD401
00713      DISPLAY '**     IF DTSBD400 ABENDS THEN:         '           DTSBD401
00714              '                                      **'.          DTSBD401
00715                                                                   DTSBD401
00716      IF LECM-MST-OPEN-UPDATE-HDR-88                               DTSBD401
00717          DISPLAY '**                                      '       DTSBD401
00718                  '                                      **'       DTSBD401
00719          DISPLAY '**          RESTORE MASTER FILE HEADER R'       DTSBD401
00720                  'ECORD PRIOR TO ATTEMPTING RERUN.      **'.      DTSBD401
00721                                                                   DTSBD401
00722      IF LECM-MST-OPEN-UPDATE-88                                   DTSBD401
00723          DISPLAY '**                                      '       DTSBD401
00724                  '                                      **'       DTSBD401
00725          DISPLAY '**          RESTORE MASTER FILE PRIOR TO'       DTSBD401
00726                  ' ATTEMPTING RERUN.                    **'.      DTSBD401
00727                                                                   DTSBD401
00728      IF LECM-REF-OPEN-UPDATE-88                                   DTSBD401
00729          DISPLAY '**                                      '       DTSBD401
00730                  '                                      **'       DTSBD401
00731          DISPLAY '**          RESTORE REFERENCE FILE PRIOR'       DTSBD401
00732                  ' TO ATTEMPTING RERUN.                 **'.      DTSBD401
00733                                                                   DTSBD401
00734      IF (LECM-MST-OPEN-UPDATE-HDR-88)                             DTSBD401
00735               OR                                                  DTSBD401
00736         (LECM-MST-OPEN-UPDATE-88)                                 DTSBD401
00737               OR                                                  DTSBD401
00738         (LECM-REF-OPEN-UPDATE-88)                                 DTSBD401
00739          NEXT SENTENCE                                            DTSBD401
00740      ELSE                                                         DTSBD401
00741          DISPLAY '**                                      '       DTSBD401
00742                  '                                      **'       DTSBD401
00743          DISPLAY '**          NO SPECIAL ACTIONS NEEDED.  '       DTSBD401
00744                  '                                      **'.      DTSBD401
00745                                                                   DTSBD401
00746      DISPLAY '**                                      '           DTSBD401
00747              '                                      **'.          DTSBD401
00748                                                                   DTSBD401
00749      DISPLAY '****************************************'           DTSBD401
00750              '****************************************'.          DTSBD401
00751                                                                   DTSBD401
00752      DISPLAY ' '.                                                 DTSBD401
00753                                                                   DTSBD401
00754      DISPLAY ' '.                                                 DTSBD401
00755  I6000-EXIT.                                                      DTSBD401
00756      EXIT.                                                        DTSBD401
00757      EJECT                                                        DTSBD401
00758  P0000-PROCESS.                                                   DTSBD401
00759      SET LECM-PROCESS-88 TO TRUE.                                 DTSBD401
00760                                                                   DTSBD401
00761      MOVE LOW-VALUES TO MPRF-KEY-AREA.                            DTSBD401
00762                                                                   DTSBD401
00763      MOVE +0 TO MPRF-EMP-NO.                                      DTSBD401
00764                                                                   DTSBD401
00765      SET MPRF-PRF-88 TO TRUE.                                     DTSBD401
00766                                                                   DTSBD401
00767      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBD401
00768                                                                   DTSBD401
00769      PERFORM P1000-READ-NEXT THRU P1000-EXIT                      DTSBD401
00770         UNTIL L910-NO-REC-88.                                     DTSBD401
00771  P0000-EXIT.                                                      DTSBD401
00772      EXIT.                                                        DTSBD401
00773      EJECT                                                        DTSBD401
00774  P1000-READ-NEXT.                                                 DTSBD401
00775      ADD +1 TO WRK-MPRF-CNT.                                      DTSBD401
00776                                                                   DTSBD401
00777      SET WRK-EMP-UPDATED-NO-88 TO TRUE.                           DTSBD401
00778                                                                   DTSBD401
00779      MOVE LECM-RUN-ABSTIME TO LECM-EMP-ABSTIME.                   DTSBD401
00780                                                                   DTSBD401
00781      PERFORM S1000-CALL-EXTRACT THRU S1000-EXIT                   DTSBD401
00782              VARYING WRK-EXT-IDX FROM 1 BY 1                      DTSBD401
00783              UNTIL WRK-EXT-IDX > WRK-EXTRACT-CNT.                 DTSBD401
00784                                                                   DTSBD401
00785      IF WRK-EMP-UPDATED-YES-88                                    DTSBD401
00786          PERFORM P1100-EMPLOYER-UPDATED THRU P1100-EXIT.          DTSBD401
00787                                                                   DTSBD401
00788      PERFORM S910-READ-NEXT THRU S910-EXIT.                       DTSBD401
00789  P1000-EXIT.                                                      DTSBD401
00790      EXIT.                                                        DTSBD401
00791      SKIP3                                                        DTSBD401
00792  P1100-EMPLOYER-UPDATED.                                          DTSBD401
00793      IF MPRF-UPDATE-ACTIVE-88                                     DTSBD401
00794          NEXT SENTENCE                                            DTSBD401
00795      ELSE                                                         DTSBD401
00796          MOVE LECM-RUN-ABSTIME TO MPRF-UPDATE-END-ABSTIME         DTSBD401
00797          MOVE +0 TO MPRF-UPDATE-TASK-ID                           DTSBD401
00798          MOVE 'BATCH' TO MPRF-UPDATE-OP-ID                        DTSBD401
00799          MOVE SPACES TO MPRF-UPDATE-TERMID                        DTSBD401
00800          MOVE SPACES TO MPRF-UPDATE-NETNAME                       DTSBD401
00801          MOVE LECM-SYS-DATE TO MPRF-UPDATE-START-DATE             DTSBD401
00802          MOVE LECM-SYS-TIME TO MPRF-UPDATE-START-TIME             DTSBD401
00803          MOVE SPACES TO MPRF-UPDATE-SCR-ID                        DTSBD401
00804                         MPRF-UPDATE-FUNCTION                      DTSBD401
00805          MOVE LECM-CURR-RUN-DATE TO MPRF-CHNG-DATE.               DTSBD401
00806                                                                   DTSBD401
00807      PERFORM S910-REWRITE THRU S910-EXIT.                         DTSBD401
00808                                                                   DTSBD401
00809      ADD +1 TO WRK-UPDATED-CNT.                                   DTSBD401
00810  P1100-EXIT.                                                      DTSBD401
00811      EXIT.                                                        DTSBD401
00812      EJECT                                                        DTSBD401
00813  T0000-TERMINATE.                                                 DTSBD401
00814      IF WRK-ONLY-CHECK-PARM-IND = 'Y'                             DTSBD401
00815          NEXT SENTENCE                                            DTSBD401
00816      ELSE                                                         DTSBD401
00817          SET LECM-TERMINATE-88 TO TRUE                            DTSBD401
00818          PERFORM S1000-CALL-EXTRACT THRU S1000-EXIT               DTSBD401
00819              VARYING WRK-EXT-IDX FROM 1 BY 1                      DTSBD401
00820              UNTIL WRK-EXT-IDX > WRK-EXTRACT-CNT.                 DTSBD401
00821                                                                   DTSBD401
00822                                                                   DTSBD401
00823      DISPLAY ' '.                                                 DTSBD401
00824                                                                   DTSBD401
00825      DISPLAY '*** DTSBD400 TERMINATION STATISTICS ***'.           DTSBD401
00826                                                                   DTSBD401
00827      DISPLAY ' '.                                                 DTSBD401
00828                                                                   DTSBD401
00829      DISPLAY 'NUMBER OF MASTER FILE PROFILE RECORDS ENCOUNTERED: 'DTSBD401
00830              WRK-MPRF-CNT.                                        DTSBD401
00831                                                                   DTSBD401
00832      DISPLAY ' '.                                                 DTSBD401
00833                                                                   DTSBD401
00834      DISPLAY 'NUMBER OF MASTER FILE EMPLOYERS UPDATED          : 'DTSBD401
00835              WRK-UPDATED-CNT.                                     DTSBD401
00836                                                                   DTSBD401
00837      DISPLAY ' '.                                                 DTSBD401
00838                                                                   DTSBD401
00839      DISPLAY 'MODULE LINKAGE - RUN TYPE            : '            DTSBD401
00840              LECM-RUN-TYPE.                                       DTSBD401
00841                                                                   DTSBD401
00842      DISPLAY ' '.                                                 DTSBD401
00843                                                                   DTSBD401
00844      DISPLAY 'MODULE LINKAGE - PERIOD START DATE   : '            DTSBD401
00845              LECM-PERIOD-START-DATE.                              DTSBD401
00846                                                                   DTSBD401
00847      DISPLAY ' '.                                                 DTSBD401
00848                                                                   DTSBD401
00849      DISPLAY 'MODULE LINKAGE - PERIOD END DATE     : '            DTSBD401
00850              LECM-PERIOD-END-DATE.                                DTSBD401
00851                                                                   DTSBD401
00852      DISPLAY ' '.                                                 DTSBD401
00853                                                                   DTSBD401
00854                                                                   DTSBD401
00855      PERFORM S910-CLOSE THRU S910-EXIT.                           DTSBD401
00856                                                                   DTSBD401
00857      PERFORM S921-CLOSE THRU S921-EXIT.                           DTSBD401
00858                                                                   DTSBD401
00859      PERFORM S927-CLOSE THRU S927-EXIT.                           DTSBD401
00860                                                                   DTSBD401
00861      PERFORM S931-CLOSE THRU S931-EXIT.                           DTSBD401
00862                                                                   DTSBD401
00863      MOVE -1 TO RSK1-LENGTH.                                      DTSBD401
00864                                                                   DTSBD401
00865      PERFORM S946-RPT-O THRU S946-EXIT.                           DTSBD401
00866                                                                   DTSBD401
00867                                                                   DTSBD401
00868      PERFORM S005-FROM-SYS THRU S005-EXIT.                        DTSBD401
00869                                                                   DTSBD401
00870      COMPUTE WRK-STEP-DURATION ROUNDED                            DTSBD401
00871        = (L005-ABSTIME - WRK-START-ABSTIME ) / 1000.              DTSBD401
00872                                                                   DTSBD401
00873      DISPLAY '*** '                                               DTSBD401
00874              WRK-STEP-DURATION-X                                  DTSBD401
00875              ' STEP DURATION (SECONDS)'.                          DTSBD401
00876                                                                   DTSBD401
00877 *****MOVE WRK-MST-OPEN-IND TO LECM-MST-OPEN-IND.                  DTSBD401
00878                                                                   DTSBD401
00879 *****MOVE WRK-REF-OPEN-IND TO LECM-REF-OPEN-IND.                  DTSBD401
00880                                                                   DTSBD401
00881 *****IF LECM-MST-OPEN-READ-88                                     DTSBD401
00882 *****    MOVE +0 TO RETURN-CODE                                   DTSBD401
00883 *****ELSE                                                         DTSBD401
00884 *****IF LECM-MST-OPEN-UPDATE-HDR-88                               DTSBD401
00885 *****    MOVE +1 TO RETURN-CODE                                   DTSBD401
00886 *****ELSE                                                         DTSBD401
00887 *****    MOVE +2 TO RETURN-CODE.                                  DTSBD401
00888  T0000-EXIT.                                                      DTSBD401
00889      EXIT.                                                        DTSBD401
00890      EJECT                                                        DTSBD401
00891  S1000-CALL-EXTRACT.                                              DTSBD401
00892      SET LECM-EMP-UPDATED-NO-88 TO TRUE.                          DTSBD401
00893                                                                   DTSBD401
00894      MOVE WRK-EXTRACT-PARMS (WRK-EXT-IDX)                         DTSBD401
00895        TO LECM-EXTRACT-PARMS.                                     DTSBD401
00896                                                                   DTSBD401
00897      MOVE WRK-EXTRACT-ID (WRK-EXT-IDX) TO EXTRACT-MOD-ID.         DTSBD401
00898                                                                   DTSBD401
00899      CALL EXTRACT-MOD-NAME USING LECM-LINK-AREA                   DTSBD401
00900                                  MPRF-REC.                        DTSBD401
00901                                                                   DTSBD401
00902      IF LECM-EMP-UPDATED-YES-88                                   DTSBD401
00903          PERFORM S1100-EMPLOYER-UPDATED THRU S1100-EXIT.          DTSBD401
00904  S1000-EXIT.                                                      DTSBD401
00905      EXIT.                                                        DTSBD401
00906      SKIP3                                                        DTSBD401
00907  S1100-EMPLOYER-UPDATED.                                          DTSBD401
00908      IF LECM-PROCESS-88                                           DTSBD401
00909          NEXT SENTENCE                                            DTSBD401
00910      ELSE                                                         DTSBD401
00911          GO TO S1100-EXIT.                                        DTSBD401
00912                                                                   DTSBD401
00913      SET WRK-EMP-UPDATED-YES-88 TO TRUE.                          DTSBD401
00914                                                                   DTSBD401
00915      IF MPRF-UPDATE-ACTIVE-88                                     DTSBD401
00916          MOVE MSG1-ID TO R907-MSG-ID                              DTSBD401
00917          MOVE MPRF-EMP-NO TO R907-EMP-NO                          DTSBD401
00918          MOVE EXTRACT-MOD-ID TO MSG1-EXTRACT-ID                   DTSBD401
00919          MOVE MSG1-TEXT TO R907-MSG-TEXT                          DTSBD401
00920          MOVE WRK-MOD-NAME TO R907-MODULE-NAME                    DTSBD401
00921          MOVE R907-REC TO RSKL-REC                                DTSBD401
00922          PERFORM S946-RPT-O THRU S946-EXIT.                       DTSBD401
00923  S1100-EXIT.                                                      DTSBD401
00924      EXIT.                                                        DTSBD401
00925      EJECT                                                        DTSBD401
00926  S005-FROM-SYS.                                                   DTSBD401
00927      SET L005-FROM-SYS TO TRUE.                                   DTSBD401
00928      GO TO S005-ABSTIME.                                          DTSBD401
00929                                                                   DTSBD401
00930  S005-ABSTIME.                                                    DTSBD401
00931      CALL 'DTSBU005' USING L005-LINK-AREA.                        DTSBD401
00932  S005-EXIT.                                                       DTSBD401
00933      EXIT.                                                        DTSBD401
00934      SKIP3                                                        DTSBD401
00935  S910-OPEN-READ.                                                  DTSBD401
00936      SET L910-OPEN-READ-88 TO TRUE.                               DTSBD401
00937      GO TO S910-MSTR-IO.                                          DTSBD401
00938                                                                   DTSBD401
00939  S910-OPEN-UPDATE-HDR.                                            DTSBD401
00940      SET L910-OPEN-UPDATE-HDR-88 TO TRUE.                         DTSBD401
00941      GO TO S910-MSTR-IO.                                          DTSBD401
00942                                                                   DTSBD401
00943  S910-OPEN-UPDATE.                                                DTSBD401
00944      SET L910-OPEN-UPDATE-88 TO TRUE.                             DTSBD401
00945      GO TO S910-MSTR-IO.                                          DTSBD401
00946                                                                   DTSBD401
00947  S910-READ.                                                       DTSBD401
00948      SET L910-READ-88 TO TRUE.                                    DTSBD401
00949      GO TO S910-MSTR-IO.                                          DTSBD401
00950                                                                   DTSBD401
00951  S910-START-BROWSE.                                               DTSBD401
00952      SET L910-START-BROWSE-88 TO TRUE.                            DTSBD401
00953      GO TO S910-MSTR-IO.                                          DTSBD401
00954                                                                   DTSBD401
00955  S910-READ-NEXT.                                                  DTSBD401
00956      SET L910-READ-NEXT-88 TO TRUE.                               DTSBD401
00957      GO TO S910-MSTR-IO.                                          DTSBD401
00958                                                                   DTSBD401
00959  S910-REWRITE.                                                    DTSBD401
00960      SET L910-REWRITE-88 TO TRUE.                                 DTSBD401
00961      GO TO S910-MSTR-IO.                                          DTSBD401
00962                                                                   DTSBD401
00963  S910-CLOSE.                                                      DTSBD401
00964      SET L910-CLOSE-88     TO TRUE.                               DTSBD401
00965      GO TO S910-MSTR-IO.                                          DTSBD401
00966                                                                   DTSBD401
00967  S910-MSTR-IO.                                                    DTSBD401
00968      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBD401
00969                            MSKL-REC.                              DTSBD401
00970  S910-EXIT.                                                       DTSBD401
00971      EXIT.                                                        DTSBD401
00972      SKIP3                                                        DTSBD401
00973  S921-OPEN-READ.                                                  DTSBD401
00974      SET L921-OPEN-READ-88 TO TRUE.                               DTSBD401
00975      GO TO S921-AIX-IO.                                           DTSBD401
00976                                                                   DTSBD401
00977  S921-OPEN-UPDATE.                                                DTSBD401
00978      SET L921-OPEN-UPDATE-88 TO TRUE.                             DTSBD401
00979      GO TO S921-AIX-IO.                                           DTSBD401
00980                                                                   DTSBD401
00981  S921-CLOSE.                                                      DTSBD401
00982      SET L921-CLOSE-88 TO TRUE.                                   DTSBD401
00983      GO TO S921-AIX-IO.                                           DTSBD401
00984                                                                   DTSBD401
00985  S921-AIX-IO.                                                     DTSBD401
00986      CALL 'DTSBU921' USING L921-LINK-AREA                         DTSBD401
00987                            ISKL-REC.                              DTSBD401
00988  S921-EXIT.                                                       DTSBD401
00989      EXIT.                                                        DTSBD401
00990      SKIP3                                                        DTSBD401
00991  S927-OPEN-UPDATE.                                                DTSBD401
00992      SET L927-OPEN-UPDATE-88 TO TRUE.                             DTSBD401
00993      GO TO S927-BTC-O.                                            DTSBD401
00994                                                                   DTSBD401
00995  S927-CLOSE.                                                      DTSBD401
00996      SET L927-CLOSE-88 TO TRUE.                                   DTSBD401
00997      GO TO S927-BTC-O.                                            DTSBD401
00998                                                                   DTSBD401
00999  S927-BTC-O.                                                      DTSBD401
01000      CALL 'DTSBU927' USING L927-LINK-AREA                         DTSBD401
01001                            RSKL-REC.                              DTSBD401
01002  S927-EXIT.                                                       DTSBD401
01003      EXIT.                                                        DTSBD401
01004      SKIP3                                                        DTSBD401
01005  S931-OPEN-READ.                                                  DTSBD401
01006      SET L931-OPEN-READ-88 TO TRUE.                               DTSBD401
01007      GO TO S931-REF-IO.                                           DTSBD401
01008                                                                   DTSBD401
01009  S931-OPEN-UPDATE.                                                DTSBD401
01010      SET L931-OPEN-UPDATE-88 TO TRUE.                             DTSBD401
01011      GO TO S931-REF-IO.                                           DTSBD401
01012                                                                   DTSBD401
01013  S931-CLOSE.                                                      DTSBD401
01014      SET L931-CLOSE-88 TO TRUE.                                   DTSBD401
01015      GO TO S931-REF-IO.                                           DTSBD401
01016                                                                   DTSBD401
01017  S931-REF-IO.                                                     DTSBD401
01018      CALL 'DTSBU931' USING L931-LINK-AREA                         DTSBD401
01019                            FSKL-REC.                              DTSBD401
01020  S931-EXIT.                                                       DTSBD401
01021      EXIT.                                                        DTSBD401
01022      SKIP3                                                        DTSBD401
01023  S946-RPT-O.                                                      DTSBD401
01024      CALL 'DTSBU946' USING RSKL-REC.                              DTSBD401
01025  S946-EXIT.                                                       DTSBD401
01026      EXIT.                                                        DTSBD401
01027      SKIP3                                                        DTSBD401
01028  S999-ABEND.                                                      DTSBD401
01029      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBD401
01030  S999-EXIT.                                                       DTSBD401
01031      EXIT.                                                        DTSBD401
