00001  IDENTIFICATION DIVISION.                                         08/31/05
00002  PROGRAM-ID.             DTSBE332.                                DTSBE332
00003  AUTHOR.                 NGC.                                        LV001
00004  DATE-WRITTEN.           OCTOBER 2004.                            DTSBE332
00005  DATE-COMPILED.                                                   DTSBE332
00006      SKIP3                                                        DTSBE332
00007 *****                                                             DTSBE332
00008 *                                                                 DTSBE332
00009 *    FUNCTION:  EXTRACT ACCOUTING DATA FOR COLLECTIONS REPORT:    DTSBE332
00010 *               RECEIVABLES OVER 120 DAYS OLD.                    DTSBE332
00011 *                                                                 DTSBE332
00012 *    MODIFICATION LOG:                                            DTSBE332
00013 *                                                                 DTSBE332
00014 *    10/28/2004  INITIAL DEVELOPMENT.                             DTSBE332
00015 *                REFERENCE:                     PROGRAMMER: GD    DTSBE332
00016 *                                                                 DTSBE332
00017 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBE332
00018 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBE332
00019 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSBE332
00020 *                                                                 DTSBE332
00021 *                                                                 DTSBE332
00022 *  DESCRIPTION:                                                   DTSBE332
00023 *                                                                 DTSBE332
00024 *                                                                 DTSBE332
00025 *    INITIATION:                                                  DTSBE332
00026 *                                                                 DTSBE332
00027 *      SET LECM-MST-OPEN-READ-88 TO TRUE.                         DTSBE332
00028 *      SET LECM-REF-OPEN-READ-88 TO TRUE.                         DTSBE332
00029 *                                                                 DTSBE332
00030 *      EDIT AND DEFAULT PARAMETERS.                               DTSBE332
00031 *                                                                 DTSBE332
00032 *                                                                 DTSBE332
00033 *    PROCESSING:                                                  DTSBE332
00034 *                                                                 DTSBE332
00035 *      THIS PROGRAM RUNS QUARTERLY, ON THE LAST DAY OF THE        DTSBE332
00036 *      MIDDLE MONTH OF EACH QUARTER.                              DTSBE332
00037 *      IT SELECTS EMPLOYERS WITH A RECEIVABLE ESTABLISHED DURING  DTSBE332
00038 *      A 90 DAY WINDOW BETWEEN THE FOURTH AND SIXTH MONTHS PRIOR  DTSBE332
00039 *      TO THE RUN DATE, WHERE THE RECEIVABLE STILL HAS A BALANCE  DTSBE332
00040 *      DUE.  THESE RECEIVABLES ARE NOW 120 DAYS OLD, AND REQUIRE  DTSBE332
00041 *      ACTION FROM ENFORCEMENT STAFF.                             DTSBE332
00042 *      THE PROGRAM PRODUCES AN R332 REPORT, CREATES A FIELD       DTSBE332
00043 *      ASSIGNMENT AND ADDS AN EVENT LOG RECORD.                   DTSBE332
00044 *                                                                 DTSBE332
00045 *    TERMINATION:                                                 DTSBE332
00046 *                                                                 DTSBE332
00047 *                                                                 DTSBE332
00048 *                                                                 DTSBE332
00049 *    RECORDS READ:                                                DTSBE332
00050 *                                                                 DTSBE332
00051 *      MASTER:                                                    DTSBE332
00052 *                                                                 DTSBE332
00053 *        MSOL                                                     DTSBE332
00054 *        MQTR                                                     DTSBE332
00055 *        MJRN                                                     DTSBE332
00056 *                                                                 DTSBE332
00057 *      ALTERNATE INDEX:                                           DTSBE332
00058 *                                                                 DTSBE332
00059 *        NONE.                                                    DTSBE332
00060 *                                                                 DTSBE332
00061 *                                                                 DTSBE332
00062 *      REFERENCE:                                                 DTSBE332
00063 *                                                                 DTSBE332
00064 *                                                                 DTSBE332
00065 *                                                                 DTSBE332
00066 *    RECORDS UPDATED:                                             DTSBE332
00067 *                                                                 DTSBE332
00068 *        NONE                                                     DTSBE332
00069 *                                                                 DTSBE332
00070 *                                                                 DTSBE332
00071 *    OUTPUT RECORDS WRITTEN:                                      DTSBE332
00072 *                                                                 DTSBE332
00073 *        DTSBX330                                                 DTSBE332
00074 *                                                                 DTSBE332
00075 *                                                                 DTSBE332
00076 *    BATCH TRANSACTION COLLECTION RECORDS WRITTEN:                DTSBE332
00077 *                                                                 DTSBE332
00078 *        NONE.                                                    DTSBE332
00079 *                                                                 DTSBE332
00080 *                                                                 DTSBE332
00081 *    MODULES CALLED:                                              DTSBE332
00082 *                                                                 DTSBE332
00083 *        DTSBU001  DATE EDIT/CONVERSION.                          DTSBE332
00084 *        DTSBU004  QUARTER EDIT/CONVERSION.                       DTSBE332
00085 *        DTSBU910  MASTER FILE I/O.                               DTSBE332
00086 *                                                                 DTSBE332
00087 *                                                                 DTSBE332
00088 *                                                                 DTSBE332
00089 *****                                                             DTSBE332
00090      SKIP3                                                        DTSBE332
00091  ENVIRONMENT DIVISION.                                            DTSBE332
00092  INPUT-OUTPUT SECTION.                                            DTSBE332
00093  FILE-CONTROL.                                                    DTSBE332
00094      SELECT X332-FILE         ASSIGN TO X332FILE                  DTSBE332
00095         FILE STATUS IS X332-STATUS.                               DTSBE332
00096                                                                   DTSBE332
00097      SELECT BE332-PARM-FILE   ASSIGN TO BE332PRM                  DTSBE332
00098         FILE STATUS IS PARM-STATUS.                               DTSBE332
00099                                                                   DTSBE332
00100  DATA DIVISION.                                                   DTSBE332
00101  FILE SECTION.                                                    DTSBE332
00102  FD  X332-FILE                                                    DTSBE332
00103      RECORDING MODE IS F                                          DTSBE332
00104      LABEL RECORDS ARE STANDARD                                   DTSBE332
00105      BLOCK CONTAINS 0 CHARACTERS.                                 DTSBE332
00106                                                                   DTSBE332
00107  01  X332-REC.                                                    DTSBE332
00108  ++INCLUDE DTSIX332                                               DTSBE332
00109                                                                   DTSBE332
00110  FD  BE332-PARM-FILE                                              DTSBE332
00111      RECORDING MODE IS F                                          DTSBE332
00112      LABEL RECORDS ARE STANDARD                                   DTSBE332
00113      BLOCK CONTAINS 0 CHARACTERS.                                 DTSBE332
00114                                                                   DTSBE332
00115  01  BE332-PARM-REC.                                              DTSBE332
00116      05  BE332-PARM-START-DATE          PIC S9(09) COMP-3.        DTSBE332
00117      05  BE332-PARM-END-DATE            PIC S9(09) COMP-3.        DTSBE332
00118      05  BE332-PARM-UPDATE-IND          PIC  X(01).               DTSBE332
00119                                                                   DTSBE332
00120  WORKING-STORAGE SECTION.                                         DTSBE332
001205 77  PAN-VALET PICTURE X(24) VALUE '001DTSBE332  08/31/05'.       DTSBE332
00121      SKIP3                                                        DTSBE332
00122  01  WRK-AREA.                                                    DTSBE332
00123      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +332.DTSBE332
00124                                                                   DTSBE332
00125      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBE332'.DTSBE332
00126                                                                   DTSBE332
00127      05  ABEND-MSG                   PIC  X(60).                  DTSBE332
00128                                                                   DTSBE332
00129      05  X332-STATUS                 PIC  X(02).                  DTSBE332
00130          88  X332-STATUS-OK-88        VALUE '00'.                 DTSBE332
00131                                                                   DTSBE332
00132      05  PARM-STATUS                 PIC  X(02).                  DTSBE332
00133          88  PARM-STATUS-OK-88        VALUE '00'.                 DTSBE332
00134                                                                   DTSBE332
00135      05  WRK-PARM-UPDATE-IND         PIC  X(01).                  DTSBE332
00136          88  WRK-PARM-UPDATE-YES-88   VALUE 'Y'.                  DTSBE332
00137          88  WRK-PARM-UPDATE-NO-88    VALUE 'N'.                  DTSBE332
00138                                                                   DTSBE332
00139      05  WRK-RUN-DATE-OK-IND         PIC  X(01).                  DTSBE332
00140          88  WRK-RUN-DATE-OK-88       VALUE 'Y'.                  DTSBE332
00141          88  WRK-RUN-DATE-NOT-OK-88   VALUE 'N'.                  DTSBE332
00142                                                                   DTSBE332
00143      05  WRK-FLD-REP-ID              PIC  X(02).                  DTSBE332
00144      05  WRK-SUBJECT-DATE            PIC S9(09)  COMP-3 VALUE +0. DTSBE332
00145      05  WRK-START-DATE              PIC S9(09)  COMP-3 VALUE +0. DTSBE332
00146      05  WRK-END-DATE                PIC S9(09)  COMP-3 VALUE +0. DTSBE332
00147      05  WRK-CURR-DATE               PIC S9(09)  COMP-3 VALUE +0. DTSBE332
00148                                                                   DTSBE332
00149 ***********************************************                   DTSBE332
00150 *   BYPASS QUARTER TABLE                      *                   DTSBE332
00151 *     INDICATES WHICH QUARTERS TO BYPASS.     *                   DTSBE332
00152 *     QUARTERS ARE BYPASSED IF THEY ARE       *                   DTSBE332
00153 *     EITHER ESTIMATED OR INCLUDED IN A LIEN. *                   DTSBE332
00154 ***********************************************                   DTSBE332
00155      05  BYPASS-MAX                 PIC S9(04)  COMP VALUE +400.  DTSBE332
00156      05  BYPASS-SUB                 PIC S9(04)  COMP.             DTSBE332
00157      05  WRK-BYPASS-TABLE OCCURS 400 TIMES.                       DTSBE332
00158          10  WRK-BYPASS-IND          PIC  X(01).                  DTSBE332
00159              88  WRK-BYPASS-YES-88    VALUE 'Y'.                  DTSBE332
00160              88  WRK-BYPASS-NO-88     VALUE 'N'.                  DTSBE332
00161                                                                   DTSBE332
00162      05  QTR-FIRST                  PIC S9(04)  COMP VALUE +400.  DTSBE332
00163      05  QTR-LAST                   PIC S9(04)  COMP VALUE +0.    DTSBE332
00164      05  QTR-SUB                    PIC S9(04)  COMP.             DTSBE332
00165      05  WRK-JRN-TABLE OCCURS 400 TIMES.                          DTSBE332
00166          10  WRK-JRN-YRQ             PIC S9(05)    COMP-3.        DTSBE332
00167          10  WRK-JRN-AMT             PIC S9(09)V99 COMP-3.        DTSBE332
00168                                                                   DTSBE332
00169                                                                   DTSBE332
00170      05  WRK-MQTR-BAL                PIC S9(11)V99 COMP-3.        DTSBE332
00171                                                                   DTSBE332
00172      05  WRK-X332-CNT               PIC S9(07)  COMP-3            DTSBE332
00173                                      VALUE +0.                    DTSBE332
00174                                                                   DTSBE332
00175      05  WRK-DISP-EMP               PIC S9(07) COMP-3             DTSBE332
00176                                      VALUE +010169.               DTSBE332
00177                                                                   DTSBE332
00178      05  DISPLAY-CNT                PIC  Z(06)9.                  DTSBE332
00179                                                                   DTSBE332
00180      05  DISPLAY-AMT-X               PIC  X(15).                  DTSBE332
00181      05  DISPLAY-AMT REDEFINES DISPLAY-AMT-X                      DTSBE332
00182                                      PIC  ZZZ,ZZZ,ZZ9.99-.        DTSBE332
00183      EJECT                                                        DTSBE332
00184  01  L001-LINK-AREA.                                              DTSBE332
00185  ++INCLUDE DTSIL001                                               DTSBE332
00186      EJECT                                                        DTSBE332
00187  01  L004-LINK-AREA.                                              DTSBE332
00188  ++INCLUDE DTSIL004                                               DTSBE332
00189      EJECT                                                        DTSBE332
00190  01  L005-LINK-AREA.                                              DTSBE332
00191  ++INCLUDE DTSIL005                                               DTSBE332
00192                                                                   DTSBE332
00193  01  L061-LINK-AREA.                                              DTSBE332
00194  ++INCLUDE DTSIL061                                               DTSBE332
00195                                                                   DTSBE332
00196  01  L910-LINK-AREA.                                              DTSBE332
00197  ++INCLUDE DTSIL910                                               DTSBE332
00198      SKIP3                                                        DTSBE332
00199  01  MSKL-REC.                                                    DTSBE332
00200  ++INCLUDE DTSIMSKL                                               DTSBE332
00201      SKIP3                                                        DTSBE332
00202  01  MQTR-REC.                                                    DTSBE332
00203  ++INCLUDE DTSIMQTR                                               DTSBE332
00204      SKIP3                                                        DTSBE332
00205  01  MLIN-REC.                                                    DTSBE332
00206  ++INCLUDE DTSIMLIN                                               DTSBE332
00207      SKIP3                                                        DTSBE332
00208  01  MJRN-REC.                                                    DTSBE332
00209  ++INCLUDE DTSIMJRN                                               DTSBE332
00210      SKIP3                                                        DTSBE332
00211  01  L931-LINK-AREA.                                              DTSBE332
00212  ++INCLUDE DTSIL931                                               DTSBE332
00213      SKIP3                                                        DTSBE332
00214  01  FSKL-REC.                                                    DTSBE332
00215  ++INCLUDE DTSIFSKL                                               DTSBE332
00216      SKIP3                                                        DTSBE332
00217  01  FQTR-REC.                                                    DTSBE332
00218  ++INCLUDE DTSIFQTR                                               DTSBE332
00219                                                                   DTSBE332
00220  LINKAGE SECTION.                                                 DTSBE332
00221      SKIP3                                                        DTSBE332
00222  01  LECM-LINK-AREA.                                              DTSBE332
00223  ++INCLUDE DTSILECM                                               DTSBE332
00224      SKIP3                                                        DTSBE332
00225          10  FILLER REDEFINES LECM-EXTRACT-PARMS.                 DTSBE332
00226              15  LECM-PARM-SUBJECT-DATE       PIC  X(06).         DTSBE332
00227              15  FILLER                       PIC  X(01).         DTSBE332
00228              15  LECM-PARM-UPDATE-IND         PIC  X(01).         DTSBE332
00229                  88  LECM-PARM-UPDATE-YES-88   VALUE 'Y'.         DTSBE332
00230                  88  LECM-PARM-UPDATE-NO-88    VALUE 'N'.         DTSBE332
00231              15  FILLER                       PIC  X(60).         DTSBE332
00232      EJECT                                                        DTSBE332
00233  01  MPRF-LINK-REC.                                               DTSBE332
00234  ++INCLUDE DTSIMPRF                                               DTSBE332
00235      EJECT                                                        DTSBE332
00236  PROCEDURE DIVISION USING LECM-LINK-AREA                          DTSBE332
00237                           MPRF-LINK-REC.                          DTSBE332
00238                                                                   DTSBE332
00239      IF LECM-PROCESS-88                                           DTSBE332
00240          PERFORM P0000-PROCESS THRU P0000-EXIT                    DTSBE332
00241      ELSE                                                         DTSBE332
00242      IF LECM-INITIALIZE-88                                        DTSBE332
00243          PERFORM I0000-INITIALIZE THRU I0000-EXIT                 DTSBE332
00244      ELSE                                                         DTSBE332
00245      IF LECM-TERMINATE-88                                         DTSBE332
00246          PERFORM T0000-TERMINATE THRU T0000-EXIT                  DTSBE332
00247      ELSE                                                         DTSBE332
00248          MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED'            DTSBE332
00249            TO ABEND-MSG                                           DTSBE332
00250          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBE332
00251      SKIP2                                                        DTSBE332
00252      GOBACK.                                                      DTSBE332
00253      EJECT                                                        DTSBE332
00254  I0000-INITIALIZE.                                                DTSBE332
00255      SKIP2                                                        DTSBE332
00256      MOVE LECM-TRACE-IND TO L910-TRACE-IND.                       DTSBE332
00257                                                                   DTSBE332
00258      MOVE WRK-MOD-NAME TO L910-MOD-NAME.                          DTSBE332
00259                                                                   DTSBE332
00260                                                                   DTSBE332
00261      PERFORM I1000-EDIT-AND-DEFAULT-PARMS THRU I1000-EXIT.        DTSBE332
00262                                                                   DTSBE332
00263      PERFORM I2000-OPEN-FILES   THRU I2000-EXIT.                  DTSBE332
00264                                                                   DTSBE332
00265      PERFORM I3000-WRITE-PARM   THRU I3000-EXIT.                  DTSBE332
00266                                                                   DTSBE332
00267      SET LECM-MST-OPEN-READ-88 TO TRUE.                           DTSBE332
00268                                                                   DTSBE332
00269      SET LECM-REF-OPEN-READ-88 TO TRUE.                           DTSBE332
00270                                                                   DTSBE332
00271  I0000-EXIT.                                                      DTSBE332
00272      EXIT.                                                        DTSBE332
00273      EJECT                                                        DTSBE332
00274  I1000-EDIT-AND-DEFAULT-PARMS.                                    DTSBE332
00275      IF LECM-PARM-UPDATE-YES-88                                   DTSBE332
00276      OR LECM-PARM-UPDATE-NO-88                                    DTSBE332
00277         MOVE LECM-PARM-UPDATE-IND       TO WRK-PARM-UPDATE-IND    DTSBE332
00278      ELSE                                                         DTSBE332
00279         PERFORM I1002-ERROR                THRU I1002-EXIT        DTSBE332
00280      END-IF.                                                      DTSBE332
00281                                                                   DTSBE332
00282      IF LECM-PARM-SUBJECT-DATE = SPACES                           DTSBE332
00283         PERFORM I1100-CHK-RUN-DATE         THRU I1100-EXIT        DTSBE332
00284         IF WRK-RUN-DATE-OK-88                                     DTSBE332
00285            MOVE LECM-PRIOR-RUN-DATE        TO WRK-SUBJECT-DATE    DTSBE332
00286            PERFORM I1200-SET-DATES         THRU I1200-EXIT        DTSBE332
00287         ELSE                                                      DTSBE332
00288            GO TO I1000-EXIT                                       DTSBE332
00289         END-IF                                                    DTSBE332
00290      ELSE                                                         DTSBE332
00291         MOVE LECM-PARM-SUBJECT-DATE     TO L001-CAL-6-DATE-X      DTSBE332
00292         PERFORM S001-FROM-CAL-6         THRU S001-EXIT            DTSBE332
00293         IF L001-VALID-DATE                                        DTSBE332
00294            MOVE L001-FED-8-DATE-9    TO WRK-SUBJECT-DATE          DTSBE332
00295            PERFORM I1200-SET-DATES   THRU I1200-EXIT              DTSBE332
00296         ELSE                                                      DTSBE332
00297            PERFORM I1001-ERROR          THRU I1001-EXIT           DTSBE332
00298         END-IF                                                    DTSBE332
00299      END-IF.                                                      DTSBE332
00300                                                                   DTSBE332
00301                                                                   DTSBE332
00302  I1000-EXIT.                                                      DTSBE332
00303      EXIT.                                                        DTSBE332
00304                                                                   DTSBE332
00305  I1001-ERROR.                                                     DTSBE332
00306      DISPLAY 'INVALID PARM DATE ' L001-FED-8-DATE-X.              DTSBE332
00307      MOVE 'INVALID PARM DATE' TO ABEND-MSG.                       DTSBE332
00308      PERFORM S999-ABEND THRU S999-EXIT.                           DTSBE332
00309  I1001-EXIT.                                                      DTSBE332
00310      EXIT.                                                        DTSBE332
00311                                                                   DTSBE332
00312  I1002-ERROR.                                                     DTSBE332
00313      DISPLAY 'UPDATE IND INVALID ' LECM-PARM-UPDATE-IND.          DTSBE332
00314      MOVE 'UPDATE IND INVALID' TO ABEND-MSG.                      DTSBE332
00315      PERFORM S999-ABEND THRU S999-EXIT.                           DTSBE332
00316  I1002-EXIT.                                                      DTSBE332
00317      EXIT.                                                        DTSBE332
00318                                                                   DTSBE332
00319  I1100-CHK-RUN-DATE.                                              DTSBE332
00320      DISPLAY 'I1100 CURR RUN ' LECM-CURR-RUN-DATE.                DTSBE332
00321      MOVE LECM-CURR-RUN-DATE          TO L004-DATE.               DTSBE332
00322      PERFORM S004-FROM-DATE           THRU S004-EXIT              DTSBE332
00323      MOVE L004-QTR-END-DATE           TO L001-FED-8-DATE-9.       DTSBE332
00324      MOVE 1                           TO L001-FED-8-DA.           DTSBE332
00325      PERFORM S001-FROM-FED-8          THRU S001-EXIT.             DTSBE332
00326      MOVE L001-FED-8-DATE-9           TO WRK-CURR-DATE.           DTSBE332
00327      DISPLAY 'I1100 LAST MONTH ' WRK-CURR-DATE.                   DTSBE332
00328      IF WRK-CURR-DATE = LECM-CURR-RUN-DATE                        DTSBE332
00329         SET WRK-RUN-DATE-OK-88        TO TRUE                     DTSBE332
00330      ELSE                                                         DTSBE332
00331         SET WRK-RUN-DATE-NOT-OK-88    TO TRUE                     DTSBE332
00332      END-IF.                                                      DTSBE332
00333                                                                   DTSBE332
00334  I1100-EXIT.                                                      DTSBE332
00335      EXIT.                                                        DTSBE332
00336                                                                   DTSBE332
00337  I1200-SET-DATES.                                                 DTSBE332
00338      MOVE WRK-SUBJECT-DATE            TO L004-DATE.               DTSBE332
00339      PERFORM S004-FROM-DATE           THRU S004-EXIT              DTSBE332
00340      DISPLAY 'SUBJECT DATE ' WRK-SUBJECT-DATE.                    DTSBE332
00341                                                                   DTSBE332
00342      SUBTRACT +1                      FROM L004-ABS-QTR.          DTSBE332
00343      PERFORM S004-FROM-ABS            THRU S004-EXIT.             DTSBE332
00344      MOVE L004-QTR-END-DATE           TO L001-FED-8-DATE-9.       DTSBE332
00345      MOVE 1                           TO L001-FED-8-DA.           DTSBE332
00346      PERFORM S001-FROM-FED-8          THRU S001-EXIT.             DTSBE332
00347      SUBTRACT +1                      FROM L001-JUL-ABS-DAY.      DTSBE332
00348      PERFORM S001-FROM-ABS-DAY        THRU S001-EXIT.             DTSBE332
00349      MOVE L001-FED-8-DATE-9           TO WRK-END-DATE.            DTSBE332
00350                                                                   DTSBE332
00351      SUBTRACT +1                      FROM L004-ABS-QTR.          DTSBE332
00352      PERFORM S004-FROM-ABS            THRU S004-EXIT.             DTSBE332
00353      MOVE L004-QTR-END-DATE           TO L001-FED-8-DATE-9.       DTSBE332
00354      MOVE 1                           TO L001-FED-8-DA.           DTSBE332
00355      PERFORM S001-FROM-FED-8          THRU S001-EXIT.             DTSBE332
00356      MOVE L001-FED-8-DATE-9           TO WRK-START-DATE.          DTSBE332
00357                                                                   DTSBE332
00358      DISPLAY '  START DATE ' WRK-START-DATE.                      DTSBE332
00359      DISPLAY '    END DATE ' WRK-END-DATE.                        DTSBE332
00360  I1200-EXIT.                                                      DTSBE332
00361      EXIT.                                                        DTSBE332
00362                                                                   DTSBE332
00363  I2000-OPEN-FILES.                                                DTSBE332
00364      OPEN OUTPUT X332-FILE.                                       DTSBE332
00365      IF NOT X332-STATUS-OK-88                                     DTSBE332
00366         DISPLAY 'X332 FILE OPEN ERROR: ' X332-STATUS              DTSBE332
00367         MOVE 'FILE OPEN ERROR'                                    DTSBE332
00368                TO ABEND-MSG                                       DTSBE332
00369         PERFORM S999-ABEND THRU S999-EXIT                         DTSBE332
00370      END-IF.                                                      DTSBE332
00371                                                                   DTSBE332
00372  I2000-EXIT.                                                      DTSBE332
00373      EXIT.                                                        DTSBE332
00374                                                                   DTSBE332
00375  I3000-WRITE-PARM.                                                DTSBE332
00376      OPEN OUTPUT BE332-PARM-FILE.                                 DTSBE332
00377      IF NOT PARM-STATUS-OK-88                                     DTSBE332
00378         DISPLAY 'PARM FILE OPEN ERROR: ' PARM-STATUS              DTSBE332
00379         PERFORM S999-ABEND THRU S999-EXIT                         DTSBE332
00380      END-IF.                                                      DTSBE332
00381                                                                   DTSBE332
00382      MOVE WRK-END-DATE            TO BE332-PARM-END-DATE,         DTSBE332
00383      MOVE WRK-START-DATE          TO BE332-PARM-START-DATE.       DTSBE332
00384      MOVE WRK-PARM-UPDATE-IND     TO BE332-PARM-UPDATE-IND.       DTSBE332
00385                                                                   DTSBE332
00386      WRITE BE332-PARM-REC.                                        DTSBE332
00387      IF NOT PARM-STATUS-OK-88                                     DTSBE332
00388         DISPLAY 'PARM FILE WRITE ERROR: ' PARM-STATUS             DTSBE332
00389         PERFORM S999-ABEND THRU S999-EXIT                         DTSBE332
00390      END-IF.                                                      DTSBE332
00391                                                                   DTSBE332
00392      CLOSE BE332-PARM-FILE.                                       DTSBE332
00393      IF NOT PARM-STATUS-OK-88                                     DTSBE332
00394         DISPLAY 'PARM FILE CLOSE ERROR: ' PARM-STATUS             DTSBE332
00395         PERFORM S999-ABEND THRU S999-EXIT                         DTSBE332
00396      END-IF.                                                      DTSBE332
00397                                                                   DTSBE332
00398  I3000-EXIT.                                                      DTSBE332
00399      EXIT.                                                        DTSBE332
00400                                                                   DTSBE332
00401  P0000-PROCESS.                                                   DTSBE332
00402      IF WRK-RUN-DATE-NOT-OK-88                                    DTSBE332
00403         GO TO P0000-EXIT                                          DTSBE332
00404      END-IF.                                                      DTSBE332
00405                                                                   DTSBE332
00406      IF MPRF-SUSPEND-COLL-YES-88                                  DTSBE332
00407         GO TO P0000-EXIT                                          DTSBE332
00408      ELSE                                                         DTSBE332
00409         IF MPRF-TOT-BALANCE-AMT > 1500                            DTSBE332
00410            NEXT SENTENCE                                          DTSBE332
00411         ELSE                                                      DTSBE332
00412            GO TO P0000-EXIT                                       DTSBE332
00413         END-IF                                                    DTSBE332
00414      END-IF.                                                      DTSBE332
00415                                                                   DTSBE332
00416      PERFORM P1000-GET-FIELD-REP          THRU P1000-EXIT.        DTSBE332
00417                                                                   DTSBE332
00418      PERFORM                                                      DTSBE332
00419        VARYING BYPASS-SUB FROM +1 BY +1                           DTSBE332
00420        UNTIL BYPASS-SUB > BYPASS-MAX                              DTSBE332
00421          SET WRK-BYPASS-NO-88 (BYPASS-SUB) TO TRUE                DTSBE332
00422      END-PERFORM.                                                 DTSBE332
00423                                                                   DTSBE332
00424      PERFORM P2000-CHECK-ESTIMATES        THRU P2000-EXIT.        DTSBE332
00425      PERFORM P3000-CHECK-LIENS            THRU P3000-EXIT.        DTSBE332
00426      PERFORM P4000-ACCTS-RECEIVABLE       THRU P4000-EXIT.        DTSBE332
00427                                                                   DTSBE332
00428  P0000-EXIT.                                                      DTSBE332
00429      EXIT.                                                        DTSBE332
00430                                                                   DTSBE332
00431  P1000-GET-FIELD-REP.                                             DTSBE332
00432      PERFORM S061-DETERMINE-FLD-REP THRU S061-EXIT.               DTSBE332
00433      MOVE L061-FLD-REP-ID        TO WRK-FLD-REP-ID.               DTSBE332
00434  P1000-EXIT.                                                      DTSBE332
00435      EXIT.                                                        DTSBE332
00436                                                                   DTSBE332
00437  P2000-CHECK-ESTIMATES.                                           DTSBE332
00438      MOVE LOW-VALUES TO MQTR-KEY-AREA.                            DTSBE332
00439      MOVE MPRF-EMP-NO TO MQTR-EMP-NO.                             DTSBE332
00440      SET MQTR-QTR-88 TO TRUE.                                     DTSBE332
00441      MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA.                         DTSBE332
00442      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBE332
00443      PERFORM UNTIL L910-NO-REC-88                                 DTSBE332
00444         MOVE MSKL-REC                TO MQTR-REC                  DTSBE332
00445         IF MQTR-CURR-ESTIM-88                                     DTSBE332
00446            MOVE MQTR-YRQ             TO L004-QTR-5-9              DTSBE332
00447            PERFORM S004-FROM-5       THRU S004-EXIT               DTSBE332
00448            MOVE L004-ABS-QTR         TO BYPASS-SUB                DTSBE332
00449            SET WRK-BYPASS-YES-88 (BYPASS-SUB) TO TRUE             DTSBE332
00450         ELSE                                                      DTSBE332
00451            PERFORM P2100-CHK-BALANCE THRU P2100-EXIT              DTSBE332
00452         END-IF                                                    DTSBE332
00453         PERFORM S910-READ-NEXT       THRU S910-EXIT               DTSBE332
00454      END-PERFORM.                                                 DTSBE332
00455                                                                   DTSBE332
00456  P2000-EXIT.                                                      DTSBE332
00457      EXIT.                                                        DTSBE332
00458                                                                   DTSBE332
00459  P2100-CHK-BALANCE.                                               DTSBE332
00460      MOVE ZERO                TO WRK-MQTR-BAL.                    DTSBE332
00461                                                                   DTSBE332
00462      PERFORM                                                      DTSBE332
00463        VARYING MQTR-ACCT-IDX FROM +1 BY +1                        DTSBE332
00464        UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT                        DTSBE332
00465          IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX)                       DTSBE332
00466             ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX)                  DTSBE332
00467               TO WRK-MQTR-BAL                                     DTSBE332
00468          END-IF                                                   DTSBE332
00469      END-PERFORM.                                                 DTSBE332
00470                                                                   DTSBE332
00471      IF WRK-MQTR-BAL = ZERO                                       DTSBE332
00472         MOVE MQTR-YRQ             TO L004-QTR-5-9                 DTSBE332
00473         PERFORM S004-FROM-5       THRU S004-EXIT                  DTSBE332
00474         MOVE L004-ABS-QTR         TO BYPASS-SUB                   DTSBE332
00475         SET WRK-BYPASS-YES-88 (BYPASS-SUB) TO TRUE                DTSBE332
00476      END-IF.                                                      DTSBE332
00477                                                                   DTSBE332
00478  P2100-EXIT.                                                      DTSBE332
00479      EXIT.                                                        DTSBE332
00480                                                                   DTSBE332
00481  P3000-CHECK-LIENS.                                               DTSBE332
00482      MOVE LOW-VALUES TO MLIN-KEY-AREA.                            DTSBE332
00483      MOVE MPRF-EMP-NO TO MLIN-EMP-NO.                             DTSBE332
00484      SET MLIN-LIN-88 TO TRUE.                                     DTSBE332
00485      MOVE MLIN-KEY-AREA TO MSKL-KEY-AREA.                         DTSBE332
00486      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBE332
00487      PERFORM UNTIL L910-NO-REC-88                                 DTSBE332
00488         MOVE MSKL-REC                TO MLIN-REC                  DTSBE332
00489         IF MLIN-STATUS-ACTIVE-88                                  DTSBE332
00490            PERFORM                                                DTSBE332
00491              VARYING MLIN-COV-IDX FROM +1 BY +1                   DTSBE332
00492              UNTIL MLIN-COV-IDX > MLIN-COV-CNT                    DTSBE332
00493                MOVE MLIN-COVERED-YRQ (MLIN-COV-IDX)               DTSBE332
00494                                          TO L004-QTR-5-9          DTSBE332
00495                PERFORM S004-FROM-5       THRU S004-EXIT           DTSBE332
00496                MOVE L004-ABS-QTR         TO BYPASS-SUB            DTSBE332
00497                SET WRK-BYPASS-YES-88 (BYPASS-SUB) TO TRUE         DTSBE332
00498            END-PERFORM                                            DTSBE332
00499         END-IF                                                    DTSBE332
00500         PERFORM S910-READ-NEXT       THRU S910-EXIT               DTSBE332
00501      END-PERFORM.                                                 DTSBE332
00502                                                                   DTSBE332
00503  P3000-EXIT.                                                      DTSBE332
00504      EXIT.                                                        DTSBE332
00505                                                                   DTSBE332
00506  P4000-ACCTS-RECEIVABLE.                                          DTSBE332
00507      MOVE LOW-VALUES TO MJRN-KEY-AREA.                            DTSBE332
00508      MOVE MPRF-EMP-NO TO MJRN-EMP-NO.                             DTSBE332
00509      SET MJRN-JRN-88 TO TRUE.                                     DTSBE332
00510      MOVE MJRN-KEY-AREA TO MSKL-KEY-AREA.                         DTSBE332
00511      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBE332
00512      PERFORM UNTIL L910-NO-REC-88                                 DTSBE332
00513         MOVE MSKL-REC                TO MJRN-REC                  DTSBE332
00514         PERFORM P4200-ACCT-TABLE     THRU P4200-EXIT              DTSBE332
00515         PERFORM S910-READ-NEXT       THRU S910-EXIT               DTSBE332
00516      END-PERFORM.                                                 DTSBE332
00517                                                                   DTSBE332
00518                                                                   DTSBE332
00519  P4000-EXIT.                                                      DTSBE332
00520      EXIT.                                                        DTSBE332
00521                                                                   DTSBE332
00522  P4200-ACCT-TABLE.                                                DTSBE332
00523      MOVE +400   TO QTR-FIRST                                     DTSBE332
00524      MOVE +0     TO QTR-LAST.                                     DTSBE332
00525                                                                   DTSBE332
00526      PERFORM                                                      DTSBE332
00527        VARYING QTR-SUB FROM +1 BY +1                              DTSBE332
00528        UNTIL QTR-SUB > +400                                       DTSBE332
00529          MOVE +0 TO WRK-JRN-YRQ (QTR-SUB)                         DTSBE332
00530                     WRK-JRN-AMT (QTR-SUB)                         DTSBE332
00531      END-PERFORM.                                                 DTSBE332
00532                                                                   DTSBE332
00533      IF MJRN-TRAN-CNVR-88                                         DTSBE332
00534         GO TO P4200-EXIT.                                         DTSBE332
00535                                                                   DTSBE332
00536      PERFORM P4210-ACCT-ENTRY  THRU P4210-EXIT                    DTSBE332
00537        VARYING MJRN-OCC-IDX FROM +1 BY +1                         DTSBE332
00538        UNTIL MJRN-OCC-IDX > MJRN-OCC-CNT.                         DTSBE332
00539                                                                   DTSBE332
00540      PERFORM P4300-WRITE-DEBITS  THRU P4300-EXIT.                 DTSBE332
00541                                                                   DTSBE332
00542  P4200-EXIT.                                                      DTSBE332
00543      EXIT.                                                        DTSBE332
00544                                                                   DTSBE332
00545                                                                   DTSBE332
00546  P4210-ACCT-ENTRY.                                                DTSBE332
00547      IF MJRN-YRQ (MJRN-OCC-IDX) = LECM-PICKUP-YRQ                 DTSBE332
00548         GO TO P4210-EXIT.                                         DTSBE332
00549                                                                   DTSBE332
00550      IF MJRN-ROW-UI-88 (MJRN-OCC-IDX)                             DTSBE332
00551         PERFORM P4211-TAX               THRU P4211-EXIT           DTSBE332
00552      END-IF.                                                      DTSBE332
00553                                                                   DTSBE332
00554  P4210-EXIT.                                                      DTSBE332
00555      EXIT.                                                        DTSBE332
00556                                                                   DTSBE332
00557  P4211-TAX.                                                       DTSBE332
00558      MOVE MJRN-YRQ (MJRN-OCC-IDX) TO L004-QTR-5-9.                DTSBE332
00559      PERFORM S004-FROM-5          THRU S004-EXIT.                 DTSBE332
00560      MOVE L004-ABS-QTR            TO QTR-SUB.                     DTSBE332
00561      MOVE L004-QTR-5-9            TO WRK-JRN-YRQ (QTR-SUB).       DTSBE332
00562                                                                   DTSBE332
00563      IF WRK-BYPASS-YES-88 (QTR-SUB)                               DTSBE332
00564         GO TO P4211-EXIT                                          DTSBE332
00565      END-IF.                                                      DTSBE332
00566                                                                   DTSBE332
00567      IF QTR-SUB < QTR-FIRST                                       DTSBE332
00568         MOVE QTR-SUB TO QTR-FIRST                                 DTSBE332
00569      END-IF.                                                      DTSBE332
00570                                                                   DTSBE332
00571      IF QTR-SUB > QTR-LAST                                        DTSBE332
00572         MOVE QTR-SUB TO QTR-LAST                                  DTSBE332
00573      END-IF.                                                      DTSBE332
00574                                                                   DTSBE332
00575      IF MJRN-COL-PAID-88 (MJRN-OCC-IDX)                           DTSBE332
00576      OR MJRN-COL-TOLERATED-88 (MJRN-OCC-IDX)                      DTSBE332
00577      OR MJRN-COL-WAIVED-88 (MJRN-OCC-IDX)                         DTSBE332
00578      OR MJRN-COL-WRITTEN-OFF-88 (MJRN-OCC-IDX)                    DTSBE332
00579         SUBTRACT MJRN-AMT (MJRN-OCC-IDX)                          DTSBE332
00580                                  FROM WRK-JRN-AMT (QTR-SUB)       DTSBE332
00581      ELSE                                                         DTSBE332
00582         ADD      MJRN-AMT (MJRN-OCC-IDX)                          DTSBE332
00583                                    TO WRK-JRN-AMT (QTR-SUB)       DTSBE332
00584      END-IF.                                                      DTSBE332
00585                                                                   DTSBE332
00586 *&                                                                DTSBE332
00587 *    IF MPRF-EMP-NO = 061224                                      DTSBE332
00588 *       MOVE WRK-JRN-AMT (QTR-SUB) TO DISPLAY-AMT                 DTSBE332
00589 *       DISPLAY 'P4211 ' MPRF-EMP-NO                              DTSBE332
00590 *          '  QTR ' WRK-JRN-YRQ (QTR-SUB)                         DTSBE332
00591 *          '  ' DISPLAY-AMT                                       DTSBE332
00592 *    END-IF.                                                      DTSBE332
00593 *&                                                                DTSBE332
00594  P4211-EXIT.                                                      DTSBE332
00595      EXIT.                                                        DTSBE332
00596                                                                   DTSBE332
00597                                                                   DTSBE332
00598  P4300-WRITE-DEBITS.                                              DTSBE332
00599      PERFORM                                                      DTSBE332
00600        VARYING QTR-SUB FROM QTR-FIRST BY +1                       DTSBE332
00601        UNTIL QTR-SUB > QTR-LAST                                   DTSBE332
00602          IF WRK-JRN-AMT (QTR-SUB) NOT = ZERO                      DTSBE332
00603             PERFORM P4310-WRITE-X332     THRU P4310-EXIT          DTSBE332
00604         END-IF                                                    DTSBE332
00605      END-PERFORM.                                                 DTSBE332
00606                                                                   DTSBE332
00607  P4300-EXIT.                                                      DTSBE332
00608      EXIT.                                                        DTSBE332
00609                                                                   DTSBE332
00610  P4310-WRITE-X332.                                                DTSBE332
00611      MOVE MPRF-EMP-NO           TO X332-EMP-NO.                   DTSBE332
00612      MOVE WRK-JRN-YRQ (QTR-SUB)  TO X332-YRQ.                     DTSBE332
00613      MOVE MJRN-ESTB-DATE         TO X332-ESTB-DATE.               DTSBE332
00614      MOVE MJRN-BATCH-NO          TO X332-BATCH-NO.                DTSBE332
00615      MOVE MJRN-ITEM-NO           TO X332-ITEM-NO.                 DTSBE332
00616      MOVE MPRF-PRIMARY-NAME      TO X332-PRIMARY-NAME.            DTSBE332
00617      MOVE MJRN-TRAN-TYPE         TO X332-TRAN-TYPE.               DTSBE332
00618      MOVE WRK-FLD-REP-ID         TO X332-FLD-REP-ID.              DTSBE332
00619                                                                   DTSBE332
00620      MOVE WRK-JRN-AMT (QTR-SUB)  TO X332-AMT.                     DTSBE332
00621                                                                   DTSBE332
00622      WRITE X332-REC.                                              DTSBE332
00623      IF X332-STATUS-OK-88                                         DTSBE332
00624         ADD +1 TO WRK-X332-CNT                                    DTSBE332
00625      ELSE                                                         DTSBE332
00626         DISPLAY 'CANNOT WRITE X332 ' MPRF-EMP-NO                  DTSBE332
00627            '  ' MJRN-BATCH-NO '  ' MJRN-ITEM-NO                   DTSBE332
00628      END-IF.                                                      DTSBE332
00629                                                                   DTSBE332
00630  P4310-EXIT.                                                      DTSBE332
00631      EXIT.                                                        DTSBE332
00632                                                                   DTSBE332
00633  T0000-TERMINATE.                                                 DTSBE332
00634      IF WRK-RUN-DATE-NOT-OK-88                                    DTSBE332
00635         DISPLAY '*********************************************'   DTSBE332
00636         DISPLAY '**   DTSBE332 NOT NEEDED THIS MONTH        **'   DTSBE332
00637         DISPLAY '*********************************************'   DTSBE332
00638         GO TO T0000-EXIT                                          DTSBE332
00639      END-IF.                                                      DTSBE332
00640                                                                   DTSBE332
00641      CLOSE X332-FILE.                                             DTSBE332
00642                                                                   DTSBE332
00643      MOVE WRK-X332-CNT TO DISPLAY-CNT.                            DTSBE332
00644                                                                   DTSBE332
00645      DISPLAY '*********************************************'.     DTSBE332
00646      DISPLAY '**   DTSBE332 TERMINATION STATISTICS       **'.     DTSBE332
00647      DISPLAY '**                                         **'.     DTSBE332
00648      DISPLAY '**  X332 COUNT    ' DISPLAY-CNT                     DTSBE332
00649                                       '                  **'.     DTSBE332
00650      DISPLAY '**                                         **'.     DTSBE332
00651      DISPLAY '*********************************************'.     DTSBE332
00652                                                                   DTSBE332
00653  T0000-EXIT.                                                      DTSBE332
00654      EXIT.                                                        DTSBE332
00655                                                                   DTSBE332
00656  S001-FROM-FED-8.                                                 DTSBE332
00657      SET L001-FROM-FED-8 TO TRUE.                                 DTSBE332
00658      GO TO S001-DATE.                                             DTSBE332
00659                                                                   DTSBE332
00660  S001-FROM-ABS-DAY.                                               DTSBE332
00661      SET L001-FROM-ABS-DAY TO TRUE.                               DTSBE332
00662      GO TO S001-DATE.                                             DTSBE332
00663                                                                   DTSBE332
00664  S001-FROM-CAL-6.                                                 DTSBE332
00665      SET L001-FROM-CAL-6 TO TRUE.                                 DTSBE332
00666      GO TO S001-DATE.                                             DTSBE332
00667                                                                   DTSBE332
00668  S001-DATE.                                                       DTSBE332
00669      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBE332
00670  S001-EXIT.                                                       DTSBE332
00671      EXIT.                                                        DTSBE332
00672      SKIP3                                                        DTSBE332
00673  S004-FROM-5.                                                     DTSBE332
00674      SET L004-FROM-5 TO TRUE.                                     DTSBE332
00675      GO TO S004-QTR.                                              DTSBE332
00676                                                                   DTSBE332
00677  S004-FROM-ABS.                                                   DTSBE332
00678      SET L004-FROM-ABS TO TRUE.                                   DTSBE332
00679      GO TO S004-QTR.                                              DTSBE332
00680                                                                   DTSBE332
00681  S004-FROM-3.                                                     DTSBE332
00682      SET L004-FROM-3 TO TRUE.                                     DTSBE332
00683      GO TO S004-QTR.                                              DTSBE332
00684                                                                   DTSBE332
00685  S004-FROM-DATE.                                                  DTSBE332
00686      SET L004-FROM-DATE TO TRUE.                                  DTSBE332
00687      GO TO S004-QTR.                                              DTSBE332
00688                                                                   DTSBE332
00689  S004-QTR.                                                        DTSBE332
00690                                                                   DTSBE332
00691      CALL 'DTSBU004' USING L004-LINK-AREA.                        DTSBE332
00692                                                                   DTSBE332
00693  S004-EXIT.                                                       DTSBE332
00694      EXIT.                                                        DTSBE332
00695      SKIP3                                                        DTSBE332
00696  S005-FROM-DATE-TIME.                                             DTSBE332
00697      SET L005-FROM-DATE-TIME TO TRUE.                             DTSBE332
00698      CALL 'DTSBU005' USING L005-LINK-AREA.                        DTSBE332
00699  S005-EXIT.                                                       DTSBE332
00700      EXIT.                                                        DTSBE332
00701                                                                   DTSBE332
00702  S061-DETERMINE-FLD-REP.                                          DTSBE332
00703      MOVE MPRF-FLD-ZIP-ST TO L061-FLD-ZIP-ST.                     DTSBE332
00704      MOVE MPRF-EMP-NO TO L061-EMP-NO.                             DTSBE332
00705                                                                   DTSBE332
00706      CALL 'DTSBU061' USING L061-LINK-AREA.                        DTSBE332
00707                                                                   DTSBE332
00708  S061-EXIT.                                                       DTSBE332
00709      EXIT.                                                        DTSBE332
00710                                                                   DTSBE332
00711  S910-READ.                                                       DTSBE332
00712      SET L910-READ-88 TO TRUE.                                    DTSBE332
00713      GO TO S910-MSTR-IO.                                          DTSBE332
00714                                                                   DTSBE332
00715  S910-START-BROWSE.                                               DTSBE332
00716      SET L910-START-BROWSE-88 TO TRUE.                            DTSBE332
00717      GO TO S910-MSTR-IO.                                          DTSBE332
00718                                                                   DTSBE332
00719  S910-READ-NEXT.                                                  DTSBE332
00720      SET L910-READ-NEXT-88 TO TRUE.                               DTSBE332
00721      GO TO S910-MSTR-IO.                                          DTSBE332
00722                                                                   DTSBE332
00723 *S910-COUNT.                                                      DTSBE332
00724 *****SET L910-COUNT-88 TO TRUE.                                   DTSBE332
00725 *****GO TO S910-MSTR-IO.                                          DTSBE332
00726                                                                   DTSBE332
00727  S910-REWRITE.                                                    DTSBE332
00728      SET L910-REWRITE-88 TO TRUE.                                 DTSBE332
00729      SET LECM-EMP-UPDATED-YES-88 TO TRUE.                         DTSBE332
00730      GO TO S910-MSTR-IO.                                          DTSBE332
00731                                                                   DTSBE332
00732  S910-MSTR-IO.                                                    DTSBE332
00733      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBE332
00734                            MSKL-REC.                              DTSBE332
00735  S910-EXIT.                                                       DTSBE332
00736      EXIT.                                                        DTSBE332
00737      SKIP3                                                        DTSBE332
00738                                                                   DTSBE332
00739  S931-READ.                                                       DTSBE332
00740      SET L931-READ-88 TO TRUE.                                    DTSBE332
00741      GO TO S931-REF-IO.                                           DTSBE332
00742                                                                   DTSBE332
00743  S931-REF-IO.                                                     DTSBE332
00744      CALL 'DTSBU931' USING L931-LINK-AREA                         DTSBE332
00745                            FSKL-REC.                              DTSBE332
00746  S931-EXIT.                                                       DTSBE332
00747      EXIT.                                                        DTSBE332
00748                                                                   DTSBE332
00749  S999-ABEND.                                                      DTSBE332
00750      DISPLAY '*** DTSBE332 ABENDING.  '                           DTSBE332
00751              ABEND-MSG.                                           DTSBE332
00752                                                                   DTSBE332
00753      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBE332
00754  S999-EXIT.                                                       DTSBE332
00755      EXIT.                                                        DTSBE332
