00001  IDENTIFICATION DIVISION.                                         10/10/17
00002  PROGRAM-ID.             DTSBE328.                                DTSBE328
00003  AUTHOR.                 NGC                                         LV018
00004  DATE-WRITTEN.           SEPTEMBER 2006.                          DTSBE328
00005  DATE-COMPILED.                                                   DTSBE328
00006      SKIP3                                                        DTSBE328
00007 *****                                                             DTSBE328
00008 * COMPUTES ONLY ONE QUARTER OF ASSESSMENTS FOR NOW.               DTSBE328
00009 * BE328 WILL COMPUTE ANY SI CHARGES THAT WERE NOT COMPUTED           CL**2
00010 * PREVIOUSLY.                                                        CL**2
00011 *    FUNCTION:  COMPUTE ADMINISTRATIVE TAX (SUR CHARGE) FOR       DTSBE328
00012 *               SELF INSURED EMPLOYERS.                           DTSBE328
00013 *****                                                             DTSBE328
00014      SKIP3                                                        DTSBE328
00015  ENVIRONMENT DIVISION.                                            DTSBE328
00016      SKIP2                                                        DTSBE328
00017  CONFIGURATION SECTION.                                           DTSBE328
00018  SPECIAL-NAMES. C01 IS TOP-OF-PAGE.                               DTSBE328
00019  INPUT-OUTPUT SECTION.                                            DTSBE328
00020                                                                   DTSBE328
00021  FILE-CONTROL.                                                    DTSBE328
00022      SELECT DOWNLOAD-FILE ASSIGN TO DTSF328                          CL**2
00023             FILE STATUS IS DWN-STATUS.                            DTSBE328
00024                                                                   DTSBE328
00025      SELECT WESQ-FILE ASSIGN TO DTSWESQ                           DTSBE328
00026      ORGANIZATION IS INDEXED                                      DTSBE328
00027      RECORD KEY IS WESQ-KEY-AREA                                  DTSBE328
00028      FILE STATUS IS WESQ-FILE-STATUS                              DTSBE328
00029      ACCESS IS SEQUENTIAL.                                        DTSBE328
00030                                                                   DTSBE328
00031  DATA DIVISION.                                                   DTSBE328
00032                                                                   DTSBE328
00033  FILE SECTION.                                                    DTSBE328
00034  FD  DOWNLOAD-FILE                                                DTSBE328
00035      RECORDING MODE IS F.                                         DTSBE328
00036  01  DOWNLOAD-REC            PIC X(114).                          DTSBE328
00037                                                                   DTSBE328
00038  FD  WESQ-FILE.                                                   DTSBE328
00039  01  WESQ-REC.                                                    DTSBE328
00040  ++INCLUDE DTSIWESQ                                               DTSBE328
00041                                                                   DTSBE328
00042                                                                   DTSBE328
00043  WORKING-STORAGE SECTION.                                         DTSBE328
000435 77  PAN-VALET PICTURE X(24) VALUE '018DTSBE328  10/10/17'.       DTSBE328
00044  77  PAN-VALET PICTURE X(24) VALUE '003DTSBE327  06/19/13'.       DTSBE328
00045  77  PAN-VALET PICTURE X(24) VALUE '003DTSBE327  06/19/13'.       DTSBE328
00046  77  PAN-VALET PICTURE X(24) VALUE '001DTSBE327  06/18/13'.       DTSBE328
00047  77  PAN-VALET PICTURE X(24) VALUE '004DTSBE327  06/17/13'.       DTSBE328
00048  77  PAN-VALET PICTURE X(24) VALUE '020DTSBE325  03/19/13'.       DTSBE328
00049      SKIP3                                                        DTSBE328
00050  01  WRK-AREA.                                                    DTSBE328
00051      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +328.   CL**2
00052                                                                   DTSBE328
00053      05  ABEND-MSG                   PIC  X(60).                  DTSBE328
00054                                                                   DTSBE328
00055      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBE328'.   CL**2
00056                                                                   DTSBE328
00057      05  WRK-CONSTANTS.                                           DTSBE328
00058          10  WRK-MAX-PCT             PIC S9V9(04)      COMP-3     DTSBE328
00059                                       VALUE +0.1.                    CL*10
00060 *                                     VALUE +0.0.                    CL*10
00061          10  WRK-MAX-WAGE-DIFF       PIC S9(11)V9(02)  COMP-3     DTSBE328
00062                                       VALUE +100000.                 CL*10
00063 *                                     VALUE +200000.                 CL*10
00064      05  WESQ-FILE-STATUS            PIC  X(02).                  DTSBE328
00065          88  WESQ-FILE-OK-88          VALUE '00'.                 DTSBE328
00066          88  WESQ-FILE-NO-REC-88      VALUE '10' '23'.            DTSBE328
00067          88  WESQ-FILE-VERIFY-88      VALUE '97'.                 DTSBE328
00068                                                                   DTSBE328
00069      05  RPT-STATUS                  PIC  X(02).                  DTSBE328
00070          88  RPT-STATUS-OK-88         VALUE '00'.                 DTSBE328
00071      05  DWN-STATUS                  PIC  X(02).                  DTSBE328
00072          88  DWN-STATUS-OK-88         VALUE '00'.                 DTSBE328
00073      05  WRK-QTR-FOUND-IND          PIC  X(01).                   DTSBE328
00074          88  WRK-QTR-FOUND-YES-88    VALUE 'Y'.                   DTSBE328
00075          88  WRK-QTR-FOUND-NO-88     VALUE 'N'.                   DTSBE328
00076      05  WRK-ERROR-IND             PIC  X(01).                    DTSBE328
00077          88  WRK-ERROR-YES-88       VALUE 'Y'.                    DTSBE328
00078          88  WRK-ERROR-NO-88        VALUE 'N'.                    DTSBE328
00079                                                                   DTSBE328
00080 ***********************************************************       DTSBE328
00081 *  THE FOLLOWING INDICATOR SHOWS THE DIFFERENCE BETWEEN           DTSBE328
00082 *  THE UC-30 REPORTED WAGES AND THE WAGE FILE WAGES.              DTSBE328
00083 *     EXACT:     NO DIFFERENCE.                                   DTSBE328
00084 *     TOL:       WITHIN TOLERANCE ($0.99 * EMPLOYEE COUNT)        DTSBE328
00085 *     UNDER MAX: DIFFERENCE < 10% AND UNDER $100,000.00           DTSBE328
00086 *     NO ASSESS: DIFFERENCE IS TOO GREAT - NO ASSESSMENT          DTSBE328
00087 *                CHARGED.                                         DTSBE328
00088 *                                                                 DTSBE328
00089 *     IF THE COMPUTED AMOUNT FROM ACTUAL EARNINGS IS              DTSBE328
00090 *     GREATER THAN THE AMOUNT REPORTED ON THE UC-30,              DTSBE328
00091 *     THE COMPUTED AMOUNT WILL BE USED.                           DTSBE328
00092 ***********************************************************       DTSBE328
00093      05  WRK-ASSESS-STATUS         PIC  X(01).                    DTSBE328
00094          88  WRK-ASSESS-EXACT-88     VALUE '0'.                   DTSBE328
00095          88  WRK-ASSESS-TOL-88       VALUE '1'.                   DTSBE328
00096          88  WRK-ASSESS-UNDER-MAX-88 VALUE '2'.                   DTSBE328
00097          88  WRK-ASSESS-OVER-MAX-88  VALUE '3'.                   DTSBE328
00098          88  WRK-NO-WAGES-88         VALUE '4'.                   DTSBE328
00099          88  WRK-NO-ASSESS-88        VALUE '4'.                      CL*10
00100          88  WRK-CHARGE-ASSESS-88    VALUE '0' '1' '2' '3'.          CL*10
00101 *        88  WRK-NO-ASSESS-88        VALUE '3' '4'.                  CL*10
00102 *        88  WRK-CHARGE-ASSESS-88    VALUE '0' '1' '2'.              CL*10
00103                                                                   DTSBE328
00104      05  WRK-STATUS-CNTS.                                         DTSBE328
00105          10  WRK-EXACT-CNT       PIC S9(07)  COMP-3 VALUE 0.      DTSBE328
00106          10  WRK-TOL-CNT         PIC S9(07)  COMP-3 VALUE 0.      DTSBE328
00107          10  WRK-UNDER-MAX-CNT   PIC S9(07)  COMP-3 VALUE 0.      DTSBE328
00108          10  WRK-OVER-MAX-CNT    PIC S9(07)  COMP-3 VALUE 0.      DTSBE328
00109          10  WRK-NO-WAGES-CNT    PIC S9(07)  COMP-3 VALUE 0.      DTSBE328
00110          10  WRK-INACT-CNT    PIC S9(07)  COMP-3 VALUE 0.         DTSBE328
00111                                                                   DTSBE328
00112      05  WRK-T026-CNT                PIC S9(07)  COMP-3           DTSBE328
00113                                   VALUE +0.                       DTSBE328
00114      05  WRK-MPRF-CNT                PIC S9(07)  COMP-3           DTSBE328
00115                                   VALUE +0.                       DTSBE328
00116      05  WRK-PREV-CNT                PIC S9(07)  COMP-3              CL**2
00117                                   VALUE +0.                          CL**2
00118                                                                   DTSBE328
00119      05  WRK-SUR-RATE            PIC S9V9(04)      COMP-3.        DTSBE328
00120      05  WRK-START-YRQ           PIC S9(05)  COMP-3 VALUE 0.      DTSBE328
00121      05  WRK-END-YRQ             PIC S9(05)  COMP-3 VALUE 0.      DTSBE328
00122      05  WRK-CURR-YRQ            PIC S9(05)  COMP-3 VALUE 0.      DTSBE328
00123      05  WRK-CURR-ASSESS         PIC S9(11)V9(02)  COMP-3 VALUE 0.   CL**6
00124      05  WRK-ASSESS-CHNG         PIC S9(11)V9(02)  COMP-3 VALUE 0.   CL**6
00125      05  WRK-EMP-TOT-WAGE        PIC S9(11)V9(02)  COMP-3 VALUE 0.   CL**6
00126      05  WRK-EMP-TAX-WAGE        PIC S9(11)V9(02)  COMP-3 VALUE 0.   CL**6
00127      05  WRK-TAX-REMAIN          PIC S9(11)V9(02)  COMP-3 VALUE 0.   CL**6
00128      05  WRK-TAX-WAGE            PIC S9(11)V9(02)  COMP-3 VALUE 0.   CL**6
00129                                                                   DTSBE328
00130      05  WRK-PCT                 PIC S9V9(04)      COMP-3.        DTSBE328
00131      05  SUB                     PIC S9(04) COMP.                 DTSBE328
00132      05  WRK-QTR-TABLE-MAX       PIC S9(04) COMP VALUE +9.        DTSBE328
00133      05  WRK-QTR-TABLE OCCURS 9 TIMES.                            DTSBE328
00134          10  WRK-QTR-YRQ            PIC S9(05)        COMP-3.     DTSBE328
00135          10  WRK-QTR-RATE           PIC S9V9(04)      COMP-3.     DTSBE328
00136          10  WRK-QTR-OLD-TOT-WAGE   PIC S9(11)V9(02)  COMP-3.     DTSBE328
00137          10  WRK-QTR-OLD-ASSESSMT   PIC S9(11)V9(02)  COMP-3.     DTSBE328
00138          10  WRK-QTR-NEW-TOT-WAGE   PIC S9(11)V9(02)  COMP-3.     DTSBE328
00139          10  WRK-QTR-NEW-TAX-WAGE   PIC S9(11)V9(02)  COMP-3.     DTSBE328
00140          10  WRK-QTR-NEW-ASSESSMT   PIC S9(11)V9(02)  COMP-3.     DTSBE328
00141          10  WRK-QTR-EMP-CNT        PIC S9(07)        COMP-3.     DTSBE328
00142                                                                   DTSBE328
00143      05  WRK-WAGE-TOLERANCE      PIC S9(11)V9(02)  COMP-3.        DTSBE328
00144      05  WRK-WAGE-DIFF           PIC S9(11)V9(02)  COMP-3.        DTSBE328
00145                                                                   DTSBE328
00146      05  WRK-TAX-WAGES           PIC S9(11)V9(02)  COMP-3.        DTSBE328
00147      05  WRK-TAX-REMAINING       PIC S9(11)V9(02)  COMP-3.        DTSBE328
00148      05  WRK-TAX-AMT             PIC S9(09)V9(02)  COMP-3.        DTSBE328
00149      05  WRK-TOT-TAX-CHG         PIC S9(09)V9(02)  COMP-3.        DTSBE328
00150                                                                   DTSBE328
00151                                                                   DTSBE328
00152      05  WRK-DOWNLOAD-REC.                                        DTSBE328
00153          10  WRK-DWN-EMP             PIC  9(06).                  DTSBE328
00154          10  FILLER                  PIC  X(01) VALUE ','.        DTSBE328
00155          10  WRK-DWN-NAME            PIC  X(40).                  DTSBE328
00156          10  FILLER                  PIC  X(01) VALUE ','.        DTSBE328
00157          10  WRK-DWN-YRQ             PIC  X(06).                  DTSBE328
00158          10  FILLER                  PIC  X(01) VALUE ','.        DTSBE328
00159          10  WRK-DWN-TAX-WAGE        PIC  ----------9.99.         DTSBE328
00160          10  FILLER                  PIC  X(01) VALUE ','.        DTSBE328
00161          10  WRK-DWN-OLD-ASSESS      PIC  ----------9.99.         DTSBE328
00162          10  FILLER                  PIC  X(01) VALUE ','.        DTSBE328
00163          10  WRK-DWN-NEW-ASSESS      PIC  ----------9.99.         DTSBE328
00164          10  FILLER                  PIC  X(01) VALUE ','.        DTSBE328
00165          10  WRK-DWN-ASSESS-CHNG     PIC  ----------9.99.         DTSBE328
00166                                                                   DTSBE328
00167      05  WRK-TAX-WAGE-BASE           PIC S9(07)V99  COMP-3.       DTSBE328
00168                                                                   DTSBE328
00169      05  PARM-REC-CNT                PIC S9(07)  COMP-3.          DTSBE328
00170                                                                   DTSBE328
00171      05  WRK-TRACE-IND                   PIC  X(01).              DTSBE328
00172                                                                   DTSBE328
00173      05  WRK-ABEND-MSG            PIC  X(60)  VALUE SPACES.       DTSBE328
00174                                                                   DTSBE328
00175      05  AMT-DISP1                PIC -,---,---,--9.99.           DTSBE328
00176      05  AMT-DISP2                PIC -,---,---,--9.99.           DTSBE328
00177      05  AMT-DISP3                PIC -,---,---,--9.99.           DTSBE328
00178      05  AMT-DISP4                PIC -,---,---,--9.99.           DTSBE328
00179      05  DISP-RATE                PIC 9.9999.                     DTSBE328
00180      05  DISP-DATE1                  PIC  X(10).                  DTSBE328
00181      05  DISP-DATE2                  PIC  X(10).                  DTSBE328
00182                                                                   DTSBE328
00183                                                                   DTSBE328
00184  01  L001-LINK-AREA.                                              DTSBE328
00185  ++INCLUDE DTSIL001                                               DTSBE328
00186      EJECT                                                        DTSBE328
00187  01  L005-LINK-AREA.                                              DTSBE328
00188  ++INCLUDE DTSIL005                                               DTSBE328
00189      EJECT                                                        DTSBE328
00190  01  L109-LINK-AREA.                                              DTSBE328
00191  ++INCLUDE DTSIL109                                               DTSBE328
00192      EJECT                                                        DTSBE328
00193  01  L111-LINK-AREA.                                              DTSBE328
00194  ++INCLUDE DTSIL111                                               DTSBE328
00195      EJECT                                                        DTSBE328
00196  01  L112-LINK-AREA.                                              DTSBE328
00197  ++INCLUDE DTSIL112                                               DTSBE328
00198      EJECT                                                        DTSBE328
00199  01  L910-LINK-AREA.                                              DTSBE328
00200  ++INCLUDE DTSIL910                                               DTSBE328
00201      EJECT                                                        DTSBE328
00202  01  L981-LINK-AREA.                                              DTSBE328
00203  ++INCLUDE DTSIL981                                               DTSBE328
00204      EJECT                                                        DTSBE328
00205  01  MSKL-REC.                                                    DTSBE328
00206  ++INCLUDE DTSIMSKL                                               DTSBE328
00207      EJECT                                                        DTSBE328
00208  01  MHDR-REC.                                                    DTSBE328
00209  ++INCLUDE DTSIMHDR                                               DTSBE328
00210      EJECT                                                        DTSBE328
00211  01  MQTR-REC.                                                    DTSBE328
00212  ++INCLUDE DTSIMQTR                                               DTSBE328
00213      EJECT                                                        DTSBE328
00214  01  MRPT-REC.                                                    DTSBE328
00215  ++INCLUDE DTSIMRPT                                               DTSBE328
00216      EJECT                                                        DTSBE328
00217  01  MEVL-REC.                                                    DTSBE328
00218  ++INCLUDE DTSIMEVL                                               DTSBE328
00219      EJECT                                                        DTSBE328
00220  01  L921-LINK-AREA.                                              DTSBE328
00221  ++INCLUDE DTSIL921                                               DTSBE328
00222      EJECT                                                        DTSBE328
00223  01  ISKL-REC.                                                    DTSBE328
00224  ++INCLUDE DTSIISKL                                               DTSBE328
00225      EJECT                                                        DTSBE328
00226  01  L931-LINK-AREA.                                              DTSBE328
00227  ++INCLUDE DTSIL931                                               DTSBE328
00228      EJECT                                                        DTSBE328
00229  01  FSKL-REC.                                                    DTSBE328
00230  ++INCLUDE DTSIFSKL                                               DTSBE328
00231      EJECT                                                        DTSBE328
00232      EJECT                                                        DTSBE328
00233  01  FQTR-REC.                                                    DTSBE328
00234  ++INCLUDE DTSIFQTR                                               DTSBE328
00235      EJECT                                                        DTSBE328
00236  01  WWGH-REC.                                                    DTSBE328
00237  ++INCLUDE DTSIWWGH                                               DTSBE328
00238      EJECT                                                        DTSBE328
00239  01  R325-REC.                                                    DTSBE328
00240  ++INCLUDE DTSIR325                                               DTSBE328
00241      EJECT                                                        DTSBE328
00242  01  T026-REC.                                                    DTSBE328
00243  ++INCLUDE DTSIT026                                               DTSBE328
00244      EJECT                                                        DTSBE328
00245                                                                   DTSBE328
00246  01  L004-COMM-AREA.                                              DTSBE328
00247  ++INCLUDE DTSIL004                                               DTSBE328
00248      EJECT                                                        DTSBE328
00249  01  L927-LINK-AREA.                                              DTSBE328
00250  ++INCLUDE DTSIL927                                               DTSBE328
00251      EJECT                                                        DTSBE328
00252  LINKAGE SECTION.                                                 DTSBE328
00253      SKIP3                                                        DTSBE328
00254  01  LECM-LINK-AREA.                                              DTSBE328
00255  ++INCLUDE DTSILECM                                               DTSBE328
00256                                                                   DTSBE328
00257  01  MPRF-LINK-REC.                                               DTSBE328
00258  ++INCLUDE DTSIMPRF                                               DTSBE328
00259                                                                   DTSBE328
00260  PROCEDURE DIVISION USING LECM-LINK-AREA                          DTSBE328
00261                           MPRF-LINK-REC.                          DTSBE328
00262      EVALUATE TRUE                                                DTSBE328
00263        WHEN LECM-INITIALIZE-88                                    DTSBE328
00264           PERFORM I0000-INITIATE      THRU I0000-EXIT             DTSBE328
00265                                                                   DTSBE328
00266        WHEN LECM-PROCESS-88                                       DTSBE328
00267           PERFORM P0000-PROCESS       THRU P0000-EXIT             DTSBE328
00268                                                                   DTSBE328
00269        WHEN LECM-TERMINATE-88                                     DTSBE328
00270           PERFORM T0000-TERMINATE     THRU T0000-EXIT             DTSBE328
00271                                                                   DTSBE328
00272        WHEN OTHER                                                 DTSBE328
00273           MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED'           DTSBE328
00274             TO ABEND-MSG                                          DTSBE328
00275           PERFORM S999-ABEND          THRU S999-EXIT              DTSBE328
00276      END-EVALUATE.                                                DTSBE328
00277                                                                   DTSBE328
00278      GOBACK.                                                      DTSBE328
00279                                                                   DTSBE328
00280  I0000-INITIATE.                                                  DTSBE328
00281      SET WRK-ERROR-NO-88 TO TRUE.                                 DTSBE328
00282                                                                   DTSBE328
00283      PERFORM I2000-OPEN-FILES-1        THRU I2000-EXIT.           DTSBE328
00284                                                                   DTSBE328
00285      PERFORM I3000-SUR-TAX-INFO        THRU I3000-EXIT.           DTSBE328
00286                                                                   DTSBE328
00287      PERFORM I4000-INIT-T026           THRU I4000-EXIT.           DTSBE328
00288                                                                   DTSBE328
00289      PERFORM I5000-INIT-WORK           THRU I5000-EXIT.           DTSBE328
00290                                                                   DTSBE328
00291  I0000-EXIT.                                                      DTSBE328
00292        EXIT.                                                      DTSBE328
00293                                                                   DTSBE328
00294  I2000-OPEN-FILES-1.                                              DTSBE328
00295      OPEN OUTPUT DOWNLOAD-FILE                                    DTSBE328
00296      IF NOT DWN-STATUS-OK-88                                      DTSBE328
00297         DISPLAY 'CANNOT OPEN DOWNLOAD FILE' DWN-STATUS            DTSBE328
00298         SET WRK-ERROR-YES-88 TO TRUE                              DTSBE328
00299         GO TO I2000-EXIT                                          DTSBE328
00300      END-IF.                                                      DTSBE328
00301                                                                   DTSBE328
00302      OPEN INPUT WESQ-FILE.                                        DTSBE328
00303      IF WESQ-FILE-OK-88 OR WESQ-FILE-VERIFY-88                    DTSBE328
00304         NEXT SENTENCE                                             DTSBE328
00305      ELSE                                                         DTSBE328
00306         DISPLAY 'CANNOT OPEN WESQ-FILE ' WESQ-FILE-STATUS         DTSBE328
00307         SET WRK-ERROR-YES-88 TO TRUE                              DTSBE328
00308         GO TO I2000-EXIT                                          DTSBE328
00309      END-IF.                                                      DTSBE328
00310                                                                   DTSBE328
00311                                                                   DTSBE328
00312      MOVE LECM-TRACE-IND             TO L910-TRACE-IND.           DTSBE328
00313      MOVE WRK-MOD-NAME               TO L910-MOD-NAME.            DTSBE328
00314                                                                   DTSBE328
00315      SET LECM-MST-OPEN-READ-88 TO TRUE.                           DTSBE328
00316      SET LECM-REF-OPEN-READ-88 TO TRUE.                           DTSBE328
00317                                                                   DTSBE328
00318  I2000-EXIT.                                                      DTSBE328
00319      EXIT.                                                        DTSBE328
00320                                                                   DTSBE328
00321  I3000-SUR-TAX-INFO.                                              DTSBE328
00322      PERFORM I3100-READ-MHDR           THRU I3100-EXIT.           DTSBE328
00323      PERFORM S005-SYS-DATE             THRU S005-EXIT.            DTSBE328
00324                                                                   DTSBE328
00325      PERFORM S109-SUR-RATE-FIRST-QTR   THRU S109-FIRST-EXIT.      DTSBE328
00326      MOVE L109-TAX-WAGE-BASE           TO WRK-TAX-WAGE-BASE.      DTSBE328
00327                                                                   DTSBE328
00328 *    MOVE MHDR-CURR-RUN-DATE           TO L004-DATE.                 CL*18
00329 *    PERFORM S004-FROM-DATE            THRU S004-EXIT.               CL*18
00330 *    IF MHDR-CURR-RUN-DATE < L004-QTR-END-DATE                       CL*18
00331 *       SUBTRACT +1                    FROM L004-ABS-QTR             CL*18
00332 *       PERFORM S004-FROM-ABS          THRU S004-EXIT                CL*18
00333 *    END-IF.                                                         CL*18
00334 *    MOVE L004-QTR-5-9                 TO WRK-END-YRQ.               CL*18
00335                                                                   DTSBE328
00336 *    MOVE L004-DATE                    TO L001-FED-8-DATE-9.      DTSBE328
00337 *    SUBTRACT 1                        FROM L001-FED-8-YR.        DTSBE328
00338 *    MOVE L001-FED-8-DATE-9            TO L004-DATE.              DTSBE328
00339 *    PERFORM S004-FROM-DATE            THRU S004-EXIT.            DTSBE328
00340                                                                   DTSBE328
00341 *    SUBTRACT +1                       FROM L004-ABS-QTR.            CL*18
00342 *    PERFORM S004-FROM-ABS             THRU S004-EXIT                CL*18
00343 *    IF L004-QTR-5-9 < L109-YRQ                                      CL*18
00344 *       MOVE L109-YRQ                  TO WRK-START-YRQ              CL*18
00345 *    ELSE                                                            CL*18
00346 *       MOVE L004-QTR-5-9              TO WRK-START-YRQ              CL*18
00347 *    END-IF.                                                         CL*18
00348                                                                   DTSBE328
00349 *    DISPLAY 'DEFAULT  START QUARTER ' WRK-START-YRQ.                CL*18
00350      MOVE MHDR-LAST-PEN-ASSESSED-YRQ   TO WRK-START-YRQ              CL*18
00351                                           WRK-END-YRQ.               CL*18
00352 *    MOVE  20131  TO WRK-START-YRQ.                               DTSBE328
00353 *    MOVE  20131  TO WRK-END-YRQ.                                 DTSBE328
00354                                                                   DTSBE328
00355 *    MOVE  WRK-END-YRQ                 TO WRK-START-YRQ.             CL*18
00356      MOVE WRK-START-YRQ                TO L004-QTR-5-9.           DTSBE328
00357      PERFORM S004-FROM-5               THRU S004-EXIT.            DTSBE328
00358      DISPLAY 'DTSBE328 START QUARTER ' L004-SLASH-5-QTR.             CL**2
00359                                                                   DTSBE328
00360      MOVE WRK-END-YRQ                  TO L004-QTR-5-9.           DTSBE328
00361      PERFORM S004-FROM-5               THRU S004-EXIT.            DTSBE328
00362      DISPLAY 'DTSBE328 END QUARTER   ' L004-SLASH-5-QTR.             CL**2
00363                                                                   DTSBE328
00364      MOVE MHDR-CURR-RUN-DATE           TO L001-FED-8-DATE-9.      DTSBE328
00365      PERFORM S001-FROM-FED-8           THRU S001-EXIT.            DTSBE328
00366      DISPLAY 'DTSBE328 CURR RUN DATE ' L001-SLASH-8-DATE.            CL**2
00367                                                                   DTSBE328
00368      PERFORM I3200-TAX-RATES           THRU I3200-EXIT.           DTSBE328
00369                                                                   DTSBE328
00370  I3000-EXIT.                                                      DTSBE328
00371      EXIT.                                                        DTSBE328
00372                                                                   DTSBE328
00373  I3100-READ-MHDR.                                                 DTSBE328
00374      MOVE LOW-VALUES              TO MSKL-REC.                    DTSBE328
00375      MOVE +0                      TO MSKL-EMP-NO.                 DTSBE328
00376      SET MSKL-HDR-88              TO TRUE.                        DTSBE328
00377                                                                   DTSBE328
00378      PERFORM S910-READ            THRU S910-EXIT.                 DTSBE328
00379      IF L910-NO-REC-88                                            DTSBE328
00380         DISPLAY 'DTSBE328: MHDR RECORD IS MISSING'                   CL**2
00381         SET WRK-ERROR-YES-88      TO TRUE                         DTSBE328
00382         GO TO I3100-EXIT                                          DTSBE328
00383      ELSE                                                         DTSBE328
00384         MOVE MSKL-REC             TO MHDR-REC                     DTSBE328
00385      END-IF.                                                      DTSBE328
00386                                                                   DTSBE328
00387                                                                   DTSBE328
00388  I3100-EXIT.                                                      DTSBE328
00389      EXIT.                                                        DTSBE328
00390                                                                   DTSBE328
00391  I3200-TAX-RATES.                                                 DTSBE328
00392      MOVE WRK-START-YRQ                TO L004-QTR-5-9.           DTSBE328
00393      PERFORM S004-FROM-5               THRU S004-EXIT.            DTSBE328
00394      DISPLAY SPACE.                                               DTSBE328
00395      DISPLAY 'ASSESSMENT RATES: '.                                DTSBE328
00396      DISPLAY SPACE.                                               DTSBE328
00397                                                                   DTSBE328
00398      PERFORM                                                      DTSBE328
00399        VARYING SUB FROM +1 BY +1                                  DTSBE328
00400        UNTIL SUB > WRK-QTR-TABLE-MAX                              DTSBE328
00401          MOVE L004-QTR-5-9          TO L109-YRQ                   DTSBE328
00402                                        WRK-QTR-YRQ (SUB)          DTSBE328
00403          PERFORM S109-SUR-BY-QTR    THRU S109-QTR-EXIT            DTSBE328
00404          MOVE L109-SUR-RATE         TO WRK-QTR-RATE (SUB)         DTSBE328
00405                                        DISP-RATE                  DTSBE328
00406          DISPLAY '   ' L004-SLASH-5-QTR ' : ' DISP-RATE           DTSBE328
00407            '  ' L109-SUR-RATE                                     DTSBE328
00408          ADD +1                     TO L004-ABS-QTR               DTSBE328
00409          PERFORM S004-FROM-ABS      THRU S004-EXIT                DTSBE328
00410      END-PERFORM.                                                 DTSBE328
00411                                                                   DTSBE328
00412  I3200-EXIT.                                                      DTSBE328
00413      EXIT.                                                        DTSBE328
00414                                                                   DTSBE328
00415  I4000-INIT-T026.                                                 DTSBE328
00416      MOVE LENGTH OF T026-REC     TO T026-LENGTH.                  DTSBE328
00417      MOVE '026'                  TO T026-REC-TYPE.                DTSBE328
00418      MOVE 'DTSBE328'             TO T026-ORIGIN.                     CL**2
00419      MOVE L005-DATE              TO T026-SYS-DATE.                DTSBE328
00420      MOVE L005-TIME              TO T026-SYS-TIME.                DTSBE328
00421      MOVE LOW-VALUES             TO T026-DATA-AREA.               DTSBE328
00422                                                                   DTSBE328
00423  I4000-EXIT.                                                      DTSBE328
00424      EXIT.                                                        DTSBE328
00425                                                                   DTSBE328
00426  I5000-INIT-WORK.                                                 DTSBE328
00427      PERFORM                                                      DTSBE328
00428        VARYING SUB FROM +1 BY +1                                  DTSBE328
00429        UNTIL SUB > WRK-QTR-TABLE-MAX                              DTSBE328
00430           MOVE ZERO TO         WRK-QTR-OLD-TOT-WAGE (SUB)         DTSBE328
00431                                WRK-QTR-OLD-ASSESSMT (SUB)         DTSBE328
00432                                WRK-QTR-EMP-CNT (SUB)              DTSBE328
00433                                WRK-QTR-NEW-TOT-WAGE (SUB)         DTSBE328
00434                                WRK-QTR-NEW-TAX-WAGE (SUB)         DTSBE328
00435                                WRK-QTR-NEW-ASSESSMT (SUB)         DTSBE328
00436      END-PERFORM.                                                 DTSBE328
00437                                                                   DTSBE328
00438  I5000-EXIT.                                                      DTSBE328
00439      EXIT.                                                        DTSBE328
00440                                                                   DTSBE328
00441  P0000-PROCESS.                                                   DTSBE328
00442      IF WRK-ERROR-YES-88                                          DTSBE328
00443         GO TO P0000-EXIT                                          DTSBE328
00444      END-IF.                                                      DTSBE328
00445                                                                   DTSBE328
00446      PERFORM I5000-INIT-WORK            THRU I5000-EXIT.          DTSBE328
00447                                                                   DTSBE328
00448      IF MPRF-CLASS-SELF-INS-88                                       CL**4
00449         NEXT SENTENCE                                                CL**4
00450      ELSE                                                            CL**4
00451         GO TO P0000-EXIT.                                            CL**2
00452                                                                      CL**2
00453         ADD +1 TO WRK-MPRF-CNT                                    DTSBE328
00454         PERFORM P1200-CURR-ASSESSMENT   THRU P1200-EXIT           DTSBE328
00455                                                                      CL**2
00456      IF WRK-CURR-ASSESS > 0                                          CL**2
00457         ADD +1 TO WRK-PREV-CNT                                       CL**2
00458         DISPLAY 'SI CHRG PREV: ' MQTR-EMP-NO ' ' WRK-CURR-ASSESS     CL**2
00459         GO TO P0000-EXIT.                                            CL**2
00460                                                                      CL**2
00461      PERFORM P1300-NEW-ASSESSMENT    THRU P1300-EXIT.                CL**3
00462      PERFORM P2000-CHECK-FOR-UPDATE  THRU P2000-EXIT.                CL**3
00463                                                                   DTSBE328
00464  P0000-EXIT.                                                      DTSBE328
00465      EXIT.                                                        DTSBE328
00466                                                                   DTSBE328
00467  P1200-CURR-ASSESSMENT.                                           DTSBE328
00468      IF MPRF-STATUS-ACT-88                                        DTSBE328
00469         ADD +1 TO WRK-INACT-CNT.                                  DTSBE328
00470      MOVE ZERO              TO WRK-CURR-ASSESS                       CL**8
00471      MOVE LOW-VALUES       TO MQTR-KEY-AREA.                      DTSBE328
00472      MOVE MPRF-EMP-NO      TO MQTR-EMP-NO.                        DTSBE328
00473      MOVE WRK-START-YRQ    TO MQTR-YRQ.                           DTSBE328
00474      SET  MQTR-QTR-88      TO TRUE                                DTSBE328
00475      MOVE MQTR-KEY-AREA    TO MSKL-KEY-AREA.                      DTSBE328
00476                                                                   DTSBE328
00477 *    DISPLAY '  *****EMP NO ' MPRF-EMP-NO.                           CL**7
00478 *    DISPLAY ' WRK START YRQ ' WRK-START-YRQ.                        CL**7
00479 *    DISPLAY ' WRK QTR   YRQ ' WRK-QTR-YRQ (SUB).                    CL**7
00480      PERFORM S910-START-BROWSE    THRU S910-EXIT.                 DTSBE328
00481      PERFORM UNTIL L910-NO-REC-88                                 DTSBE328
00482         MOVE MSKL-REC             TO MQTR-REC                     DTSBE328
00483 *       DISPLAY 'MQTR-YRQ ' MQTR-YRQ  ' END-YRQ ' WRK-END-YRQ        CL**7
00484         IF MQTR-YRQ >                WRK-END-YRQ                  DTSBE328
00485            SET L910-NO-REC-88     TO TRUE                         DTSBE328
00486         ELSE                                                      DTSBE328
00487            PERFORM                                                DTSBE328
00488              VARYING MQTR-ACCT-IDX FROM 1 BY 1                    DTSBE328
00489              UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT                  DTSBE328
00490                IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX)                DTSBE328
00491                   ADD  MQTR-CHARGED-AMT (MQTR-ACCT-IDX)           DTSBE328
00492                      TO WRK-CURR-ASSESS                           DTSBE328
00493                END-IF                                             DTSBE328
00494            END-PERFORM                                            DTSBE328
00495            PERFORM P1210-QTR-SUM      THRU P1210-EXIT             DTSBE328
00496            PERFORM S910-READ-NEXT     THRU S910-EXIT              DTSBE328
00497         END-IF                                                    DTSBE328
00498      END-PERFORM.                                                 DTSBE328
00499                                                                   DTSBE328
00500  P1200-EXIT.                                                      DTSBE328
00501      EXIT.                                                        DTSBE328
00502                                                                   DTSBE328
00503  P1210-QTR-SUM.                                                   DTSBE328
00504      SET WRK-QTR-FOUND-NO-88   TO TRUE.                           DTSBE328
00505      PERFORM                                                      DTSBE328
00506        VARYING SUB FROM +1 BY +1                                  DTSBE328
00507        UNTIL WRK-QTR-FOUND-YES-88                                 DTSBE328
00508 *        DISPLAY ' SUB ' SUB                                         CL**7
00509 *        DISPLAY 'MQTR YRQ ' MQTR-YRQ                                CL**7
00510 *        DISPLAY 'WRK QTR YRQ ' WRK-QTR-YRQ(SUB)                     CL**7
00511 *        DISPLAY '    '                                              CL**7
00512          IF MQTR-YRQ = WRK-QTR-YRQ (SUB)                          DTSBE328
00513             MOVE MQTR-TOT-WAGE   TO WRK-QTR-OLD-TOT-WAGE (SUB)    DTSBE328
00514             MOVE WRK-CURR-ASSESS TO WRK-QTR-OLD-ASSESSMT (SUB)    DTSBE328
00515             SET WRK-QTR-FOUND-YES-88  TO TRUE                     DTSBE328
00516          END-IF                                                   DTSBE328
00517      END-PERFORM.                                                 DTSBE328
00518                                                                   DTSBE328
00519  P1210-EXIT.                                                      DTSBE328
00520      EXIT.                                                        DTSBE328
00521                                                                   DTSBE328
00522  P1300-NEW-ASSESSMENT.                                            DTSBE328
00523 ***  DISPLAY 'P1300 ' MPRF-EMP-NO.                                DTSBE328
00524                                                                   DTSBE328
00525      MOVE LOW-VALUES                  TO WESQ-REC.                DTSBE328
00526      MOVE MPRF-EMP-NO                 TO WESQ-EMP-NO.             DTSBE328
00527      MOVE WRK-START-YRQ               TO WESQ-YRQ.                DTSBE328
00528      START WESQ-FILE KEY IS >=           WESQ-KEY-AREA.           DTSBE328
00529      READ WESQ-FILE NEXT.                                         DTSBE328
00530      PERFORM UNTIL NOT WESQ-FILE-OK-88                            DTSBE328
00531         MOVE ZERO                     TO WRK-TAX-WAGE             DTSBE328
00532         IF WESQ-EMP-NO = MPRF-EMP-NO                              DTSBE328
00533         AND WESQ-YRQ <= WRK-END-YRQ                               DTSBE328
00534            PERFORM P1310-TAX-WAGE     THRU P1310-EXIT             DTSBE328
00535            PERFORM P1320-QTR-SUM      THRU P1320-EXIT             DTSBE328
00536            READ WESQ-FILE NEXT                                    DTSBE328
00537         ELSE                                                      DTSBE328
00538            SET WESQ-FILE-NO-REC-88    TO TRUE                     DTSBE328
00539         END-IF                                                    DTSBE328
00540      END-PERFORM.                                                 DTSBE328
00541                                                                   DTSBE328
00542      PERFORM P1330-COMPUTE-ASSESS    THRU P1330-EXIT.             DTSBE328
00543                                                                   DTSBE328
00544  P1300-EXIT.                                                      DTSBE328
00545      EXIT.                                                        DTSBE328
00546                                                                   DTSBE328
00547  P1310-TAX-WAGE.                                                  DTSBE328
00548 *    IF WESQ-EMP-NO = 813380                                      DTSBE328
00549 *       MOVE WESQ-EARNINGS TO AMT-DISP1                           DTSBE328
00550 *       MOVE WESQ-YTD-EARNINGS TO AMT-DISP2                       DTSBE328
00551 *       DISPLAY 'P1300 ' WESQ-SSN '  ' AMT-DISP1                  DTSBE328
00552 *          '  ' WESQ-YRQ '  YTD ' AMT-DISP2                       DTSBE328
00553 *    END-IF.                                                      DTSBE328
00554                                                                   DTSBE328
00555      IF WESQ-YTD-EARNINGS >= 9000                                 DTSBE328
00556         MOVE ZERO               TO WRK-TAX-WAGE                   DTSBE328
00557      ELSE                                                         DTSBE328
00558         COMPUTE WRK-TAX-REMAIN = (9000 - WESQ-YTD-EARNINGS)       DTSBE328
00559         IF WRK-TAX-REMAIN    >  WESQ-EARNINGS                     DTSBE328
00560            MOVE WESQ-EARNINGS   TO WRK-TAX-WAGE                   DTSBE328
00561         ELSE                                                      DTSBE328
00562            MOVE WRK-TAX-REMAIN  TO WRK-TAX-WAGE                   DTSBE328
00563         END-IF                                                    DTSBE328
00564      END-IF.                                                      DTSBE328
00565                                                                   DTSBE328
00566  P1310-EXIT.                                                      DTSBE328
00567      EXIT.                                                        DTSBE328
00568                                                                   DTSBE328
00569  P1320-QTR-SUM.                                                   DTSBE328
00570 *    IF MPRF-EMP-NO = 813380                                      DTSBE328
00571 *       MOVE WESQ-EARNINGS      TO AMT-DISP1                      DTSBE328
00572 *       MOVE WRK-TAX-WAGE       TO AMT-DISP2                      DTSBE328
00573 *       DISPLAY 'P1320 WESQ ' WESQ-SSN '  ' AMT-DISP1             DTSBE328
00574 *          '  TAX ' AMT-DISP2                                     DTSBE328
00575 *          '  ' WESQ-YRQ                                          DTSBE328
00576 *    END-IF.                                                      DTSBE328
00577      SET WRK-QTR-FOUND-NO-88   TO TRUE.                           DTSBE328
00578      PERFORM                                                      DTSBE328
00579        VARYING SUB FROM +1 BY +1                                  DTSBE328
00580        UNTIL WRK-QTR-FOUND-YES-88                                 DTSBE328
00581          IF WESQ-YRQ = WRK-QTR-YRQ (SUB)                          DTSBE328
00582            ADD  WESQ-EARNINGS   TO WRK-QTR-NEW-TOT-WAGE (SUB)     DTSBE328
00583            ADD  WRK-TAX-WAGE    TO WRK-QTR-NEW-TAX-WAGE (SUB)     DTSBE328
00584            ADD +1               TO WRK-QTR-EMP-CNT (SUB)          DTSBE328
00585            SET WRK-QTR-FOUND-YES-88  TO TRUE                      DTSBE328
00586          END-IF                                                   DTSBE328
00587      END-PERFORM.                                                 DTSBE328
00588                                                                   DTSBE328
00589  P1320-EXIT.                                                      DTSBE328
00590      EXIT.                                                        DTSBE328
00591                                                                   DTSBE328
00592  P1330-COMPUTE-ASSESS.                                            DTSBE328
00593      PERFORM                                                      DTSBE328
00594        VARYING SUB FROM +1 BY +1                                  DTSBE328
00595        UNTIL SUB > WRK-QTR-TABLE-MAX                              DTSBE328
00596           COMPUTE WRK-QTR-NEW-ASSESSMT (SUB) ROUNDED =            DTSBE328
00597             (WRK-QTR-NEW-TAX-WAGE (SUB) *                         DTSBE328
00598              WRK-QTR-RATE (SUB))                                  DTSBE328
00599      END-PERFORM.                                                 DTSBE328
00600                                                                   DTSBE328
00601  P1330-EXIT.                                                      DTSBE328
00602      EXIT.                                                        DTSBE328
00603                                                                   DTSBE328
00604  P2000-CHECK-FOR-UPDATE.                                          DTSBE328
00605      PERFORM                                                      DTSBE328
00606        VARYING SUB FROM +1 BY +1                                  DTSBE328
00607        UNTIL SUB > WRK-QTR-TABLE-MAX                              DTSBE328
00608 *&                                                                DTSBE328
00609 *    IF MPRF-EMP-NO = 150337                                         CL**7
00610 *       MOVE WRK-QTR-NEW-ASSESSMT (SUB) TO AMT-DISP1                 CL**7
00611 *       MOVE WRK-QTR-OLD-ASSESSMT (SUB) TO AMT-DISP2                 CL**7
00612 *       DISPLAY 'P2000 OLD ' AMT-DISP2 '  NEW ' AMT-DISP1            CL**7
00613 *         '  ' WRK-QTR-YRQ (SUB)                                     CL**7
00614 *    END-IF                                                          CL**7
00615 *&                                                                DTSBE328
00616          IF WRK-QTR-YRQ (SUB) < WRK-START-YRQ OR                  DTSBE328
00617             WRK-QTR-YRQ (SUB) > WRK-END-YRQ                       DTSBE328
00618             NEXT SENTENCE                                         DTSBE328
00619          ELSE                                                     DTSBE328
00620 *        IF WRK-QTR-OLD-ASSESSMT (SUB) NOT =                      DTSBE328
00621 *           WRK-QTR-NEW-ASSESSMT (SUB)                            DTSBE328
00622             PERFORM P2100-REPORT      THRU P2100-EXIT             DTSBE328
00623          END-IF                                                   DTSBE328
00624      END-PERFORM.                                                 DTSBE328
00625                                                                   DTSBE328
00626                                                                   DTSBE328
00627  P2000-EXIT.                                                      DTSBE328
00628      EXIT.                                                        DTSBE328
00629                                                                   DTSBE328
00630  P2100-REPORT.                                                    DTSBE328
00631      COMPUTE WRK-WAGE-TOLERANCE =                                 DTSBE328
00632         (WRK-QTR-EMP-CNT (SUB) * .99)                             DTSBE328
00633                                                                   DTSBE328
00634      COMPUTE WRK-WAGE-DIFF =                                      DTSBE328
00635         (WRK-QTR-OLD-TOT-WAGE (SUB) -                             DTSBE328
00636          WRK-QTR-NEW-TOT-WAGE (SUB)).                             DTSBE328
00637                                                                   DTSBE328
00638 **********************************************************        DTSBE328
00639 *  ALLOW THE SYSTEM TO CHARGE THE ASSESSMENT IF THE WAGES         DTSBE328
00640 *  ON THE WAGE FILE ARE GREATER THAN THOSE REPORTED ON            DTSBE328
00641 *  THE UC-30.  (WRK-WAGE-DIFF WILL BE < 0 IN THIS CASE.)          DTSBE328
00642 **********************************************************        DTSBE328
00643      MOVE 0             TO WRK-PCT.                               DTSBE328
00644      IF WRK-WAGE-DIFF > ZERO                                      DTSBE328
00645         IF WRK-QTR-OLD-TOT-WAGE (SUB) > 0                         DTSBE328
00646            COMPUTE WRK-PCT =                                      DTSBE328
00647               (WRK-WAGE-DIFF / WRK-QTR-OLD-TOT-WAGE (SUB))        DTSBE328
00648         END-IF                                                    DTSBE328
00649      END-IF.                                                      DTSBE328
00650                                                                   DTSBE328
00651      COMPUTE WRK-ASSESS-CHNG =                                    DTSBE328
00652         (WRK-QTR-NEW-ASSESSMT (SUB) -                             DTSBE328
00653          WRK-QTR-OLD-ASSESSMT (SUB)).                             DTSBE328
00654                                                                   DTSBE328
00655      EVALUATE TRUE                                                DTSBE328
00656        WHEN WRK-QTR-NEW-TOT-WAGE (SUB) = ZERO                     DTSBE328
00657           SET WRK-NO-WAGES-88             TO TRUE                 DTSBE328
00658           ADD +1                          TO WRK-NO-WAGES-CNT     DTSBE328
00659 *         DISPLAY 'NO WAGE ' MPRF-EMP-NO ' ' MPRF-EMP-STATUS         CL**8
00660                                                                   DTSBE328
00661        WHEN (WRK-PCT > WRK-MAX-PCT                                DTSBE328
00662          OR WRK-WAGE-DIFF > WRK-MAX-WAGE-DIFF)                    DTSBE328
00663           SET WRK-ASSESS-OVER-MAX-88      TO TRUE                 DTSBE328
00664           ADD +1                          TO WRK-OVER-MAX-CNT     DTSBE328
00665                                                                   DTSBE328
00666        WHEN WRK-WAGE-DIFF > WRK-WAGE-TOLERANCE                    DTSBE328
00667           SET WRK-ASSESS-UNDER-MAX-88     TO TRUE                 DTSBE328
00668           ADD +1                          TO WRK-UNDER-MAX-CNT    DTSBE328
00669                                                                   DTSBE328
00670        WHEN WRK-WAGE-DIFF = 0                                     DTSBE328
00671           SET WRK-ASSESS-EXACT-88         TO TRUE                    CL*14
00672 *         SET WRK-NO-WAGES-88             TO TRUE                    CL*14
00673           ADD +1                          TO WRK-EXACT-CNT        DTSBE328
00674                                                                   DTSBE328
00675        WHEN OTHER                                                 DTSBE328
00676           SET WRK-ASSESS-TOL-88           TO TRUE                 DTSBE328
00677           ADD +1                          TO WRK-TOL-CNT          DTSBE328
00678      END-EVALUATE.                                                DTSBE328
00679                                                                   DTSBE328
00680      IF WRK-CHARGE-ASSESS-88                                      DTSBE328
00681         IF WRK-ASSESS-CHNG  > 0.99                                   CL*17
00682            PERFORM P2110-WRITE-T026       THRU P2110-EXIT         DTSBE328
00683            PERFORM P2130-WRITE-DOWNLOAD   THRU P2130-EXIT         DTSBE328
00684         END-IF                                                       CL*17
00685      END-IF.                                                      DTSBE328
00686                                                                   DTSBE328
00687       IF  WRK-NO-WAGES-88 AND MPRF-EMP-STATUS NOT = 'A'           DTSBE328
00688           NEXT SENTENCE                                           DTSBE328
00689       ELSE                                                        DTSBE328
00690      PERFORM P2120-WRITE-R325             THRU P2120-EXIT.        DTSBE328
00691                                                                   DTSBE328
00692  P2100-EXIT.                                                      DTSBE328
00693      EXIT.                                                        DTSBE328
00694                                                                   DTSBE328
00695  P2110-WRITE-T026.                                                DTSBE328
00696      IF WRK-QTR-YRQ (SUB) < WRK-START-YRQ OR                      DTSBE328
00697         WRK-QTR-YRQ (SUB) > WRK-END-YRQ OR                           CL*14
00698         WRK-ASSESS-CHNG < 1.00                                       CL*15
00699         GO TO P2110-EXIT.                                         DTSBE328
00700      ADD 1                    TO WRK-T026-CNT.                    DTSBE328
00701      MOVE MPRF-EMP-NO         TO T026-EMP-NO.                     DTSBE328
00702      MOVE WRK-ASSESS-CHNG     TO T026-AMT.                        DTSBE328
00703      MOVE WRK-QTR-YRQ (SUB)   TO T026-APPLIC-YRQ.                 DTSBE328
00704      MOVE +0                  TO T026-RECEIVED-DATE.              DTSBE328
00705      MOVE SPACES              TO T026-NAME-CHECK                  DTSBE328
00706                                  T026-INT-SPAN-IND.               DTSBE328
00707      MOVE 'SU'                TO T026-APPLIC-IND.                 DTSBE328
00708      SET  T026-ADM-ASSESSMNT  TO TRUE.                            DTSBE328
00709      MOVE +0                  TO T026-APPLIC-BATCH-NO             DTSBE328
00710                                  T026-APPLIC-ITEM-NO              DTSBE328
00711                                  T026-DATE-1                      DTSBE328
00712                                  T026-DATE-2.                     DTSBE328
00713                                                                   DTSBE328
00714      MOVE SPACES               TO T026-RESPONSIBLE-ACTIVITY.      DTSBE328
00715      MOVE 'DTSBE328'           TO T026-RESPONSIBLE-OP-ID.            CL**2
00716                                                                   DTSBE328
00717      PERFORM S927-WRITE        THRU S927-EXIT.                    DTSBE328
00718                                                                   DTSBE328
00719  P2110-EXIT.                                                      DTSBE328
00720      EXIT.                                                        DTSBE328
00721                                                                   DTSBE328
00722  P2120-WRITE-R325.                                                DTSBE328
00723      IF WRK-QTR-YRQ (SUB) < WRK-START-YRQ OR                      DTSBE328
00724         WRK-QTR-YRQ (SUB) > WRK-END-YRQ OR                           CL*16
00725         WRK-ASSESS-CHNG < 1.00                                       CL*15
00726         GO TO P2120-EXIT.                                         DTSBE328
00727                                                                   DTSBE328
00728      MOVE LOW-VALUES            TO  R325-SORT-AREA.               DTSBE328
00729      MOVE LENGTH OF R325-REC    TO  R325-LENGTH.                  DTSBE328
00730      MOVE '325'                 TO  R325-REC-TYPE.                DTSBE328
00731      MOVE WRK-ASSESS-STATUS     TO  R325-RPT-TYPE.                DTSBE328
00732      MOVE MPRF-EMP-NO           TO  R325-EMP-NO.                  DTSBE328
00733      MOVE MPRF-FEIN             TO  R325-EMP-FEIN.                DTSBE328
00734      MOVE MHDR-CURR-RUN-DATE    TO  R325-STMT-DATE.               DTSBE328
00735      MOVE SPACES                TO  R325-OP-ID                    DTSBE328
00736      MOVE WRK-QTR-RATE (SUB)    TO  R325-ASSESSMENT-RATE.         DTSBE328
00737      MOVE WRK-QTR-YRQ (SUB)     TO  R325-QTR.                     DTSBE328
00738      MOVE WRK-QTR-OLD-TOT-WAGE (SUB)                              DTSBE328
00739                                 TO  R325-UC30-WAGES.              DTSBE328
00740      MOVE WRK-QTR-NEW-TOT-WAGE (SUB)                              DTSBE328
00741                                 TO  R325-WAGE-FILE-WAGES.         DTSBE328
00742      MOVE WRK-QTR-NEW-TAX-WAGE (SUB)                              DTSBE328
00743                                 TO  R325-ASSESSMENT-WAGES.        DTSBE328
00744      MOVE WRK-ASSESS-CHNG       TO  R325-CALC-ASSESS-DUE          DTSBE328
00745                                     R325-FINAL-ASSESS-DUE.        DTSBE328
00746      PERFORM P2121-GET-ADDR     THRU P2121-EXIT.                  DTSBE328
00747      PERFORM S946-WRITE-R325 THRU S946-EXIT.                      DTSBE328
00748                                                                   DTSBE328
00749      MOVE WRK-QTR-NEW-TOT-WAGE (SUB) TO AMT-DISP1.                DTSBE328
00750      MOVE WRK-QTR-OLD-TOT-WAGE (SUB) TO AMT-DISP2.                DTSBE328
00751 ***  MOVE WRK-QTR-NEW-TAX-WAGE (SUB)  TO AMT-DISP2.               DTSBE328
00752      MOVE WRK-QTR-OLD-ASSESSMT (SUB)  TO AMT-DISP3.               DTSBE328
00753      MOVE WRK-QTR-NEW-ASSESSMT (SUB)  TO AMT-DISP4.               DTSBE328
00754                                                                   DTSBE328
00755      DISPLAY SPACE.                                               DTSBE328
00756      IF WRK-ASSESS-EXACT-88                                       DTSBE328
00757        DISPLAY 'EX  ' MPRF-EMP-NO '  ' WRK-QTR-YRQ (SUB)          DTSBE328
00758        '  ' MPRF-PRIMARY-NAME '  ' WRK-QTR-EMP-CNT (SUB)          DTSBE328
00759      ELSE                                                         DTSBE328
00760        IF WRK-ASSESS-TOL-88                                       DTSBE328
00761          DISPLAY 'TL  ' MPRF-EMP-NO '  ' WRK-QTR-YRQ (SUB)        DTSBE328
00762          '  ' MPRF-PRIMARY-NAME '  ' WRK-QTR-EMP-CNT (SUB)        DTSBE328
00763        ELSE                                                       DTSBE328
00764          IF WRK-ASSESS-UNDER-MAX-88                               DTSBE328
00765            DISPLAY 'MX  ' MPRF-EMP-NO '  ' WRK-QTR-YRQ (SUB)      DTSBE328
00766            '  ' MPRF-PRIMARY-NAME '  ' WRK-QTR-EMP-CNT (SUB)      DTSBE328
00767          ELSE                                                     DTSBE328
00768            DISPLAY 'ERR ' MPRF-EMP-NO '  ' WRK-QTR-YRQ (SUB)      DTSBE328
00769            '  ' MPRF-PRIMARY-NAME '  ' WRK-QTR-EMP-CNT (SUB)      DTSBE328
00770          END-IF                                                   DTSBE328
00771        END-IF                                                     DTSBE328
00772      END-IF.                                                      DTSBE328
00773      DISPLAY  '  OLD ' AMT-DISP2 '  NEW ' AMT-DISP1.              DTSBE328
00774      DISPLAY '   OLD ' AMT-DISP3 '  NEW ' AMT-DISP4.              DTSBE328
00775      MOVE WRK-QTR-OLD-TOT-WAGE (SUB) TO AMT-DISP1.                DTSBE328
00776 **   DISPLAY  '  TAX ' AMT-DISP2                                  DTSBE328
00777 **   DISPLAY '   OLD ' AMT-DISP3 '  NEW ' AMT-DISP4.              DTSBE328
00778                                                                   DTSBE328
00779  P2120-EXIT.                                                      DTSBE328
00780      EXIT.                                                        DTSBE328
00781                                                                   DTSBE328
00782  P2121-GET-ADDR.                                                  DTSBE328
00783        MOVE LOW-VALUES           TO  L111-RETURN-AREA.            DTSBE328
00784        MOVE MPRF-EMP-NO          TO  L111-EMP-NO.                 DTSBE328
00785        SET L111-LOOKUP-TAD-88    TO  TRUE.                        DTSBE328
00786        MOVE +001                 TO  L111-ID-NO.                  DTSBE328
00787                                                                   DTSBE328
00788        PERFORM S111-LOOKUP-ADDR  THRU  S111-EXIT.                 DTSBE328
00789                                                                   DTSBE328
00790        IF L111-ADDR-FOUND-88                                      DTSBE328
00791            SET L112-TAD-ADDR-88  TO  TRUE                         DTSBE328
00792            MOVE L111-RETURN-AREA TO  L112-NAME-ADDRESS-AREA       DTSBE328
00793            PERFORM P2122-FORMAT-ADDR  THRU P2122-EXIT             DTSBE328
00794        ELSE                                                       DTSBE328
00795            MOVE ALL '?'          TO  R325-FMT-ADDR                DTSBE328
00796                                      R325-ZIP                     DTSBE328
00797                                      R325-ADVANCED-BARCODE.       DTSBE328
00798  P2121-EXIT.                                                      DTSBE328
00799      EXIT.                                                        DTSBE328
00800  P2122-FORMAT-ADDR.                                               DTSBE328
00801       SET L112-ANCHOR-FIRST-88  TO  TRUE.                         DTSBE328
00802       MOVE MPRF-PRIMARY-NAME    TO  L112-PRIMARY-NAME.            DTSBE328
00803                                                                   DTSBE328
00804       PERFORM S112-FORMAT-ADDR  THRU  S112-EXIT.                  DTSBE328
00805                                                                   DTSBE328
00806       MOVE L112-MAILING-ADDRESS   TO  R325-FMT-ADDR.              DTSBE328
00807       MOVE L112-ZIP               TO  R325-ZIP.                   DTSBE328
00808       MOVE R325-ZIP               TO  R325-SORT-ZIP.              DTSBE328
00809       MOVE L112-ADVANCED-BARCODE  TO  R325-ADVANCED-BARCODE.      DTSBE328
00810                                                                   DTSBE328
00811  P2122-EXIT.                                                      DTSBE328
00812      EXIT.                                                        DTSBE328
00813                                                                   DTSBE328
00814  P2130-WRITE-DOWNLOAD.                                            DTSBE328
00815      MOVE MPRF-EMP-NO            TO WRK-DWN-EMP.                  DTSBE328
00816      MOVE MPRF-PRIMARY-NAME      TO WRK-DWN-NAME.                 DTSBE328
00817      MOVE WRK-QTR-YRQ (SUB)      TO L004-QTR-5-9.                 DTSBE328
00818      PERFORM S004-FROM-5         THRU S004-EXIT.                  DTSBE328
00819      MOVE L004-SLASH-5-QTR       TO WRK-DWN-YRQ.                  DTSBE328
00820      MOVE WRK-QTR-NEW-TAX-WAGE (SUB)                              DTSBE328
00821                                  TO WRK-DWN-TAX-WAGE.             DTSBE328
00822      MOVE WRK-QTR-OLD-ASSESSMT (SUB)                              DTSBE328
00823                                  TO WRK-DWN-OLD-ASSESS.           DTSBE328
00824      MOVE WRK-QTR-NEW-ASSESSMT (SUB)                              DTSBE328
00825                                  TO WRK-DWN-NEW-ASSESS.           DTSBE328
00826      MOVE WRK-ASSESS-CHNG        TO WRK-DWN-ASSESS-CHNG.          DTSBE328
00827                                                                   DTSBE328
00828      WRITE DOWNLOAD-REC          FROM WRK-DOWNLOAD-REC.           DTSBE328
00829                                                                   DTSBE328
00830  P2130-EXIT.                                                      DTSBE328
00831      EXIT.                                                        DTSBE328
00832                                                                   DTSBE328
00833  P2300-WRITE-MEVL.                                                DTSBE328
00834        MOVE LOW-VALUES                     TO  MEVL-REC.          DTSBE328
00835        MOVE L005-DATE                      TO  MEVL-ESTB-DATE     DTSBE328
00836                                                MEVL-CHNG-DATE     DTSBE328
00837                                                MEVL-DATE.         DTSBE328
00838                                                                   DTSBE328
00839        ADD  +1000                          TO  L005-ABSTIME.      DTSBE328
00840        PERFORM S005-FROM-ABSTIME           THRU S005-EXIT.        DTSBE328
00841                                                                   DTSBE328
00842        MOVE MPRF-EMP-NO                    TO  MEVL-EMP-NO.       DTSBE328
00843        SET MEVL-EVL-88                     TO  TRUE.              DTSBE328
00844        MOVE +0                             TO  MEVL-PURGE-DATE.   DTSBE328
00845        MOVE 'SI ADMIN ASSESS BILL SENT'    TO  MEVL-TEXT.         DTSBE328
00846        MOVE 'DTSBE328'                     TO  MEVL-SOURCE.          CL**2
00847        SET MEVL-NOT-CONVERTED-88           TO  TRUE.              DTSBE328
00848        MOVE L005-TIME                      TO  MEVL-TIME.         DTSBE328
00849        MOVE MEVL-REC                       TO  MSKL-REC.          DTSBE328
00850        PERFORM S910-WRITE                  THRU S910-EXIT.        DTSBE328
00851                                                                   DTSBE328
00852  P2300-EXIT.                                                      DTSBE328
00853      EXIT.                                                        DTSBE328
00854                                                                   DTSBE328
00855                                                                   DTSBE328
00856  T0000-TERMINATE.                                                 DTSBE328
00857      IF WRK-ERROR-YES-88                                          DTSBE328
00858         GO TO T0000-EXIT                                          DTSBE328
00859      END-IF.                                                      DTSBE328
00860                                                                   DTSBE328
00861      DISPLAY ' '.                                                 DTSBE328
00862                                                                   DTSBE328
00863      DISPLAY '*** DTSBE328 TERMINATION STATISTICS ***'.              CL**2
00864                                                                   DTSBE328
00865      DISPLAY ' '.                                                 DTSBE328
00866                                                                   DTSBE328
00867      DISPLAY 'TOTAL SELF INS READ         : ' WRK-MPRF-CNT.       DTSBE328
00868      DISPLAY SPACE.                                               DTSBE328
00869      DISPLAY 'TOTAL SI ALREADY COMPUTED   : ' WRK-PREV-CNT.          CL**2
00870      DISPLAY SPACE.                                                  CL**2
00871      DISPLAY 'ASSESSED COUNTS             : '                     DTSBE328
00872      DISPLAY '  WAGES EXACT               : ' WRK-EXACT-CNT.      DTSBE328
00873      DISPLAY '  TOLERATED                 : ' WRK-TOL-CNT.        DTSBE328
00874      DISPLAY '  UNDER MAX                 : ' WRK-UNDER-MAX-CNT.  DTSBE328
00875      DISPLAY 'T026 TRANSACTIONS CREATED   : ' WRK-T026-CNT.       DTSBE328
00876      DISPLAY SPACE.                                               DTSBE328
00877      DISPLAY 'NO ASSESSMENT COUNTS        : '                     DTSBE328
00878      DISPLAY '  OVER MAX                  : ' WRK-OVER-MAX-CNT.   DTSBE328
00879      DISPLAY '  NO WAGES                  : ' WRK-NO-WAGES-CNT.   DTSBE328
00880      DISPLAY '  INACTIVE SI EMPLS         : ' WRK-INACT-CNT.      DTSBE328
00881                                                                   DTSBE328
00882       CLOSE DOWNLOAD-FILE                                         DTSBE328
00883             WESQ-FILE.                                            DTSBE328
00884                                                                   DTSBE328
00885                                                                   DTSBE328
00886  T0000-EXIT.                                                      DTSBE328
00887      EXIT.                                                        DTSBE328
00888                                                                   DTSBE328
00889  S001-FROM-FED-8.                                                 DTSBE328
00890      SET L001-FROM-FED-8 TO TRUE.                                 DTSBE328
00891      GO TO S001-DATE.                                             DTSBE328
00892                                                                   DTSBE328
00893  S001-FROM-ABS-DAY.                                               DTSBE328
00894      SET L001-FROM-ABS-DAY TO TRUE.                               DTSBE328
00895      GO TO S001-DATE.                                             DTSBE328
00896                                                                   DTSBE328
00897  S001-DATE.                                                       DTSBE328
00898      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBE328
00899                                                                   DTSBE328
00900  S001-EXIT.                                                       DTSBE328
00901      EXIT.                                                        DTSBE328
00902      SKIP3                                                        DTSBE328
00903  S004-FROM-5.                                                     DTSBE328
00904      SET L004-FROM-5     TO TRUE.                                 DTSBE328
00905      GO TO S004-EDIT-QTR.                                         DTSBE328
00906                                                                   DTSBE328
00907  S004-FROM-DATE.                                                  DTSBE328
00908      SET L004-FROM-DATE  TO TRUE.                                 DTSBE328
00909      GO TO S004-EDIT-QTR.                                         DTSBE328
00910                                                                   DTSBE328
00911  S004-FROM-ABS.                                                   DTSBE328
00912      SET L004-FROM-ABS   TO TRUE.                                 DTSBE328
00913      GO TO S004-EDIT-QTR.                                         DTSBE328
00914                                                                   DTSBE328
00915  S004-EDIT-QTR.                                                   DTSBE328
00916      CALL 'DTSBU004' USING L004-COMM-AREA.                        DTSBE328
00917                                                                   DTSBE328
00918  S004-EXIT.                                                       DTSBE328
00919      EXIT.                                                        DTSBE328
00920      SKIP3                                                        DTSBE328
00921  S005-SYS-DATE.                                                   DTSBE328
00922       SET L005-FROM-SYS TO TRUE                                   DTSBE328
00923       GO TO S005-ABSTIME.                                         DTSBE328
00924  S005-FROM-ABSTIME.                                               DTSBE328
00925       SET L005-FROM-ABSTIME TO TRUE.                              DTSBE328
00926       GO TO S005-ABSTIME.                                         DTSBE328
00927   S005-ABSTIME.                                                   DTSBE328
00928       CALL 'DTSBU005' USING L005-LINK-AREA.                       DTSBE328
00929   S005-EXIT.                                                      DTSBE328
00930       EXIT.                                                       DTSBE328
00931      SKIP3                                                        DTSBE328
00932  S109-SUR-RATE-FIRST-QTR.                                         DTSBE328
00933      SET L109-CMND-FIRST-QTR-88  TO TRUE.                         DTSBE328
00934      CALL 'DTSBU109' USING L109-LINK-AREA.                        DTSBE328
00935                                                                   DTSBE328
00936  S109-FIRST-EXIT.                                                 DTSBE328
00937      EXIT.                                                        DTSBE328
00938  S109-SUR-BY-QTR.                                                 DTSBE328
00939      SET L109-CLASS-SELF-INS-88  TO TRUE.                         DTSBE328
00940      SET L109-CMND-INPUT-QTR-88  TO TRUE.                         DTSBE328
00941      CALL 'DTSBU109' USING L109-LINK-AREA.                        DTSBE328
00942                                                                   DTSBE328
00943  S109-QTR-EXIT.                                                   DTSBE328
00944      EXIT.                                                        DTSBE328
00945      SKIP3                                                        DTSBE328
00946       SKIP3                                                       DTSBE328
00947  S111-LOOKUP-ADDR.                                                DTSBE328
00948       CALL 'DTSBU111' USING L111-LINK-AREA.                       DTSBE328
00949   S111-EXIT.                                                      DTSBE328
00950       EXIT.                                                       DTSBE328
00951       SKIP3                                                       DTSBE328
00952   S112-FORMAT-ADDR.                                               DTSBE328
00953       CALL 'DTSBU112' USING L112-LINK-AREA.                       DTSBE328
00954   S112-EXIT.                                                      DTSBE328
00955       EXIT.                                                       DTSBE328
00956       SKIP3                                                       DTSBE328
00957                                                                   DTSBE328
00958 *S910-OPEN-READ.                                                  DTSBE328
00959 *    SET L910-OPEN-READ-88 TO TRUE.                               DTSBE328
00960 *    GO TO S910-MSTR-IO.                                          DTSBE328
00961 *                                                                 DTSBE328
00962 *S910-OPEN-UPDATE-NO-AIX.                                         DTSBE328
00963 *    SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE.                      DTSBE328
00964 *    GO TO S910-MSTR-IO.                                          DTSBE328
00965                                                                   DTSBE328
00966  S910-READ.                                                       DTSBE328
00967      SET L910-READ-88 TO TRUE.                                    DTSBE328
00968      GO TO S910-MSTR-IO.                                          DTSBE328
00969                                                                   DTSBE328
00970  S910-START-BROWSE.                                               DTSBE328
00971      SET L910-START-BROWSE-88 TO TRUE.                            DTSBE328
00972      GO TO S910-MSTR-IO.                                          DTSBE328
00973                                                                   DTSBE328
00974  S910-READ-NEXT.                                                  DTSBE328
00975      SET L910-READ-NEXT-88 TO TRUE.                               DTSBE328
00976      GO TO S910-MSTR-IO.                                          DTSBE328
00977                                                                   DTSBE328
00978  S910-COUNT.                                                      DTSBE328
00979      SET L910-COUNT-88 TO TRUE.                                   DTSBE328
00980      GO TO S910-MSTR-IO.                                          DTSBE328
00981                                                                   DTSBE328
00982  S910-REWRITE.                                                    DTSBE328
00983      SET L910-REWRITE-88 TO TRUE.                                 DTSBE328
00984      GO TO S910-MSTR-IO.                                          DTSBE328
00985                                                                   DTSBE328
00986  S910-WRITE.                                                      DTSBE328
00987      SET L910-WRITE-88 TO TRUE.                                   DTSBE328
00988      GO TO S910-MSTR-IO.                                          DTSBE328
00989                                                                   DTSBE328
00990 *S910-CLOSE.                                                      DTSBE328
00991 *    SET L910-CLOSE-88     TO TRUE.                               DTSBE328
00992 *    GO TO S910-MSTR-IO.                                          DTSBE328
00993                                                                   DTSBE328
00994  S910-MSTR-IO.                                                    DTSBE328
00995      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBE328
00996                            MSKL-REC.                              DTSBE328
00997  S910-EXIT.                                                       DTSBE328
00998      EXIT.                                                        DTSBE328
00999      SKIP3                                                        DTSBE328
01000  S927-OPEN-UPDATE.                                                DTSBE328
01001      SET L927-OPEN-UPDATE-88 TO TRUE.                             DTSBE328
01002      GO TO S927-IO.                                               DTSBE328
01003  S927-WRITE.                                                      DTSBE328
01004      SET L927-WRITE-88 TO TRUE.                                   DTSBE328
01005      GO TO S927-IO.                                               DTSBE328
01006  S927-CLOSE.                                                      DTSBE328
01007      SET L927-CLOSE-88 TO TRUE.                                   DTSBE328
01008      GO TO S927-IO.                                               DTSBE328
01009  S927-IO.                                                         DTSBE328
01010      CALL 'DTSBU927' USING L927-LINK-AREA                         DTSBE328
01011                            T026-REC.                              DTSBE328
01012  S927-EXIT.                                                       DTSBE328
01013       EXIT.                                                       DTSBE328
01014                                                                   DTSBE328
01015  S946-WRITE-R325.                                                 DTSBE328
01016       CALL 'DTSBU946' USING R325-REC.                             DTSBE328
01017  S946-EXIT.                                                       DTSBE328
01018       EXIT.                                                       DTSBE328
01019                                                                   DTSBE328
01020  S981-OPEN-READ.                                                  DTSBE328
01021      SET L981-OPEN-READ-88 TO TRUE.                               DTSBE328
01022      GO TO S981-MSTR-IO.                                          DTSBE328
01023                                                                   DTSBE328
01024  S981-READ.                                                       DTSBE328
01025      SET L981-READ-88 TO TRUE.                                    DTSBE328
01026      GO TO S981-MSTR-IO.                                          DTSBE328
01027                                                                   DTSBE328
01028  S981-START-BROWSE.                                               DTSBE328
01029      SET L981-START-BROWSE-88 TO TRUE.                            DTSBE328
01030      GO TO S981-MSTR-IO.                                          DTSBE328
01031                                                                   DTSBE328
01032  S981-READ-NEXT.                                                  DTSBE328
01033      SET L981-READ-NEXT-88 TO TRUE.                               DTSBE328
01034      GO TO S981-MSTR-IO.                                          DTSBE328
01035                                                                   DTSBE328
01036  S981-CLOSE.                                                      DTSBE328
01037      SET L981-CLOSE-88     TO TRUE.                               DTSBE328
01038      GO TO S981-MSTR-IO.                                          DTSBE328
01039                                                                   DTSBE328
01040  S981-MSTR-IO.                                                    DTSBE328
01041      CALL 'DTSBU981' USING L981-LINK-AREA                         DTSBE328
01042                            WWGH-REC.                              DTSBE328
01043  S981-EXIT.                                                       DTSBE328
01044      EXIT.                                                        DTSBE328
01045      SKIP3                                                        DTSBE328
01046                                                                   DTSBE328
01047  S999-ABEND.                                                      DTSBE328
01048      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBE328
01049  S999-EXIT.                                                       DTSBE328
01050      EXIT.                                                        DTSBE328
