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