00001  IDENTIFICATION DIVISION.                                         05/27/10
00002  PROGRAM-ID.             DTSCS52.                                 DTSCS52
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV036
00004  DATE-WRITTEN.           MAY 1994.                                DTSCS52
00005  DATE-COMPILED.                                                   DTSCS52
00006      SKIP3                                                        DTSCS52
00007 *****                                                             DTSCS52
00008 *                                                                 DTSCS52
00009 *    FUNCTION:  RATE CUTOFF INQUIRY/UPDATE SCREEN PROCESSOR.      DTSCS52
00010 *                                                                 DTSCS52
00011 *                                                                 DTSCS52
00012 *    MODIFICATION LOG:                                            DTSCS52
00013 *                                                                 DTSCS52
00014 *    08/01/97  MODIFY LOGIC TO ALLOW DELETE FUNCTION TO BE        DTSCS52
00015 *              PERFORMED USING FUNCTION KEY 23 INSTEAD OF 11.     DTSCS52
00016 *              REFERENCE RFP: TCL 096           PROGRAMMER: FLS   DTSCS52
00017 *                                                                 DTSCS52
00018 *    01/23/1999  REVIEWED AND MODIFIED FOR DC.                    DTSCS52
00019 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH   DTSCS52
00020 *                                                                 DTSCS52
00021 *    06/16/1999  MODIFY ADD CANCEL LOGIC AND MODIFY CANCEL LOGIC  DTSCS52
00022 *                TO REVERSE EFFECT OF PSEUDO UPDATE FROM SCREEN.  DTSCS52
00023 *                REFERENCE: TPR 06/16/1999      PROGRAMMER: EHH   DTSCS52
00024 *                                                                 DTSCS52
00025 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCS52
00026 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCS52
00027 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSCS52
00028 *                                                                 DTSCS52
00029 *                                                                 DTSCS52
00030 *  DESCRIPTION:                                                   DTSCS52
00031 *                                                                 DTSCS52
00032 *                                                                 DTSCS52
00033 *    CLEAR:                                                       DTSCS52
00034 *                                                                 DTSCS52
00035 *      FIELD DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO).            DTSCS52
00036 *                                                                 DTSCS52
00037 *                                                                 DTSCS52
00038 *    JUMP:                                                        DTSCS52
00039 *                                                                 DTSCS52
00040 *      NONE                                                       DTSCS52
00041 *                                                                 DTSCS52
00042 *                                                                 DTSCS52
00043 *    INQUIRY:                                                     DTSCS52
00044 *                                                                 DTSCS52
00045 *      CONTROL FIELDS: MAP-EMP-NO.                                DTSCS52
00046 *                                                                 DTSCS52
00047 *      JUMP IN: IF LCCM-EMP-NO = LCCM-HOLD-SCR52-AREA  EMP-NO     DTSCS52
00048 *                 DISPLAY RECORD INDICATED BY LCCM-HOLD-SCR52-AREADTSCS52
00049 *               ELSE                                              DTSCS52
00050 *                 DISPLAY LAST PAGE OF DATA ASSOCIATED            DTSCS52
00051 *                   WITH LCCM-EMP-NO.                             DTSCS52
00052 *                                                                 DTSCS52
00053 *      ENTER, F5, F6, F7, F8: STANDARD PAGING.                    DTSCS52
00054 *                                                                 DTSCS52
00055 *           DISPLAY SEQUENCE: ASCENDING ON MRCT-EFF-YRQ.          DTSCS52
00056 *                                                                 DTSCS52
00057 *   PAGE INITIALLY DISPLAYED: LAST                                DTSCS52
00058 *                                                                 DTSCS52
00059 *                                                                 DTSCS52
00060 *      JUMP OUT:  STANDARD LCCM-EMP-NO MAINTENANCE                DTSCS52
00061 *                                                                 DTSCS52
00062 *                 STORE INFORMATION REPRESENTING PAGE CURRENTLY   DTSCS52
00063 *                 DISPLAYED IN LCCM-SCR52-HOLD-AREA.              DTSCS52
00064 *                                                                 DTSCS52
00065 *                                                                 DTSCS52
00066 *    UPDATE:                                                      DTSCS52
00067 *                                                                 DTSCS52
00068 *      ADD                                                        DTSCS52
00069 *      MOD                                                        DTSCS52
00070 *      DEL                                                        DTSCS52
00071 *                                                                 DTSCS52
00072 *      CHANGING MAP-EFF-YRQ PRIOR TO MOD OR DEL IS AN ERROR.      DTSCS52
00073 *                                                                 DTSCS52
00074 *                                                                 DTSCS52
00075 *                                                                 DTSCS52
00076 *    RECORDS READ:                                                DTSCS52
00077 *                                                                 DTSCS52
00078 *      MASTER:                                                    DTSCS52
00079 *                                                                 DTSCS52
00080 *        MPRF                                                     DTSCS52
00081 *        MRCT                                                     DTSCS52
00082 *                                                                 DTSCS52
00083 *                                                                 DTSCS52
00084 *      ALTERNATE INDEX:                                           DTSCS52
00085 *                                                                 DTSCS52
00086 *        NONE.                                                    DTSCS52
00087 *                                                                 DTSCS52
00088 *                                                                 DTSCS52
00089 *      REFERENCE:                                                 DTSCS52
00090 *                                                                 DTSCS52
00091 *        NONE.                                                    DTSCS52
00092 *                                                                 DTSCS52
00093 *                                                                 DTSCS52
00094 *      ACCOUNTING TRANSACTION COLLECTION:                         DTSCS52
00095 *                                                                 DTSCS52
00096 *        NONE.                                                    DTSCS52
00097 *                                                                 DTSCS52
00098 *                                                                 DTSCS52
00099 *    RECORDS UPDATED:                                             DTSCS52
00100 *                                                                 DTSCS52
00101 *      MASTER:                                                    DTSCS52
00102 *                                                                 DTSCS52
00103 *        MRCT (WRITE, DELETE, REWRITE).                           DTSCS52
00104 *                                                                 DTSCS52
00105 *                                                                 DTSCS52
00106 *      REFERENCE:                                                 DTSCS52
00107 *                                                                 DTSCS52
00108 *        NONE.                                                    DTSCS52
00109 *                                                                 DTSCS52
00110 *                                                                 DTSCS52
00111 *      ACCOUNTING TRANSACTION COLLECTION:                         DTSCS52
00112 *                                                                 DTSCS52
00113 *        NONE.                                                    DTSCS52
00114 *                                                                 DTSCS52
00115 *                                                                 DTSCS52
00116 *    ON-LINE ACTIVITY FILE RECODS WRITTEN:                        DTSCS52
00117 *                                                                 DTSCS52
00118 *      NONE.                                                      DTSCS52
00119 *                                                                 DTSCS52
00120 *                                                                 DTSCS52
00121 *    TEMPORARY STORAGE USAGE:                                     DTSCS52
00122 *                                                                 DTSCS52
00123 *      NONE                                                       DTSCS52
00124 *                                                                 DTSCS52
00125 *                                                                 DTSCS52
00126 *    MODULES LINKED TO:                                           DTSCS52
00127 *                                                                 DTSCS52
00128 *      DTSCU001  DATE EDIT/CONVERSION.                            DTSCS52
00129 *      DTSCU004  QUARTER EDIT/CONVERSION.                         DTSCS52
00130 *      DTSCU006  RATING YEAR/RATING EXPERIENCE PERIOD START/END.  DTSCS52
00131 *      DTSCU011  AMOUNT FROM SCREEN FORMAT/EDIT.                  DTSCS52
00132 *      DTSCU013  COUNT (INTEGER) FROM SCREEN FORMAT/EDIT.         DTSCS52
00133 *      DTSCU015  DATE FROM SCREEN FORMAT/EDIT.                    DTSCS52
00134 *      DTSCU016  YEAR/QUARTER FROM SCREEN FORMAT/EDIT.            DTSCS52
00135 *      DTSCU018  EMP NO FROM SCREEN FORMAT/EDIT.                  DTSCS52
00136 *      DTSCU054  UI RATE DETERMINATION FROM MRCT RECORD.          DTSCS52
00137 *      DTSCU055  UI RATE EXPERIENCE PERIOD.                       DTSCS52
00138 *      DTSCU056  RATE DISPLAY.                                    DTSCS52
00139 *      DTSCU057  RESERVE RATIO DISPLAY.                           DTSCS52
00140 *      DTSCU221  MPRF-UPDATE DATA ELEMENTS MAINTENANCE.           DTSCS52
00141 *      DTSCU331  WRITE MLOG RECORDS.                              DTSCS52
00142 *      DTSCU810  MASTER FILE INPUT/OUTPUT.                        DTSCS52
00143 *                                                                 DTSCS52
00144 *****                                                             DTSCS52
00145                                                                   DTSCS52
00146  ENVIRONMENT DIVISION.                                            DTSCS52
00147                                                                   DTSCS52
00148  DATA DIVISION.                                                   DTSCS52
00149                                                                   DTSCS52
00150  WORKING-STORAGE SECTION.                                         DTSCS52
001505 77  PAN-VALET PICTURE X(24) VALUE '036DTSCS52   05/27/10'.       DTSCS52
00151                                                                   DTSCS52
00152  01  WRK-AREA.                                                    DTSCS52
00153      05  WRK-ABEND-CD                PIC  X(04)  VALUE 'S52 '.    DTSCS52
00154                                                                   DTSCS52
00155      05  WRK-SCR-ID.                                              DTSCS52
00156          10  WRK-SCR-ID-N            PIC  9(02)  VALUE 52.        DTSCS52
00157                                                                   DTSCS52
00158      05  WRK-F03-SCR-ID              PIC  X(02)  VALUE '50'.      DTSCS52
00159                                                                   DTSCS52
00160                                                                   DTSCS52
00161      05  SCR-ACCESS-IND              PIC X(01).                   DTSCS52
00162          88  SCR-ACCESS-INQ                  VALUE '1'.           DTSCS52
00163          88  SCR-ACCESS-UPDATE               VALUE '2'.           DTSCS52
00164                                                                   DTSCS52
00165                                                                   DTSCS52
00166      05  CURSOR-SET-IND              PIC X(01).                   DTSCS52
00167          88  CURSOR-SET-YES                  VALUE 'Y'.           DTSCS52
00168          88  CURSOR-SET-NO                   VALUE 'N'.           DTSCS52
00169          88  CURSOR-SET-GOTO                 VALUE 'G'.           DTSCS52
00170                                                                   DTSCS52
00171                                                                   DTSCS52
00172      05  REQ-IND                     PIC X(01).                   DTSCS52
00173          88  REQ-ERROR                       VALUE 'O'.           DTSCS52
00174          88  REQ-JUMP                        VALUE 'J'.           DTSCS52
00175          88  REQ-INQUIRE                     VALUE 'I'.           DTSCS52
00176          88  REQ-CLEAR                       VALUE 'C'.           DTSCS52
00177          88  REQ-EDIT                        VALUE 'E'.           DTSCS52
00178          88  REQ-UPDATE                      VALUE 'U'.           DTSCS52
00179          88  REQ-CURSOR-TO-GOTO              VALUE 'G'.           DTSCS52
00180                                                                   DTSCS52
00181                                                                   DTSCS52
00182      05  RESP-IND                    PIC X(01).                   DTSCS52
00183          88  RESP-SEND-MSGONLY               VALUE 'O'.           DTSCS52
00184          88  RESP-SEND-MAP                   VALUE 'M'.           DTSCS52
00185          88  RESP-JUMP                       VALUE 'J'.           DTSCS52
00186          88  RESP-CURSOR-TO-GOTO             VALUE 'G'.           DTSCS52
00187                                                                   DTSCS52
00188                                                                   DTSCS52
00189      05  WRK-MSG-AREA                PIC  X(64).                  DTSCS52
00190                                                                   DTSCS52
00191                                                                   DTSCS52
00192      05  WRK-ATB-AN                  PIC  X(01).                  DTSCS52
00193                                                                   DTSCS52
00194      05  WRK-ATB-NUM                 PIC  X(01).                  DTSCS52
00195                                                                   DTSCS52
00196      05  WRK-EMP-NO                  PIC S9(07)  COMP-3.          DTSCS52
00197                                                                   DTSCS52
00198      05  WRK-MPRF-IND                PIC  X(01).                  DTSCS52
00199          88  WRK-MPRF-YES-88                VALUE 'Y'.            DTSCS52
00200          88  WRK-MPRF-NO-88                 VALUE 'N'.            DTSCS52
00201                                                                   DTSCS52
00202      05  WRK-MRCT-IND                PIC  X(01).                  DTSCS52
00203          88  WRK-MRCT-YES-88                VALUE 'Y'.            DTSCS52
00204          88  WRK-MRCT-NO-88                 VALUE 'N'.            DTSCS52
00205                                                                   DTSCS52
00206      05  WRK-CTR                     PIC S9(04) COMP.             DTSCS52
00207                                                                   DTSCS52
00208                                                                   DTSCS52
00209      05  WRK-DISPLAY                 PIC 9(11).                   DTSCS52
00210                                                                   DTSCS52
00211      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS52
00212          10  FILLER                  PIC X(08).                   DTSCS52
00213          10  WRK-DISPLAY-QTR-YR      PIC X(02).                   DTSCS52
00214          10  WRK-DISPLAY-QTR-Q       PIC X(01).                   DTSCS52
00215                                                                   DTSCS52
00216      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS52
00217          10  FILLER                  PIC X(05).                   DTSCS52
00218          10  WRK-DISPLAY-EMP-NO-1    PIC X(03).                   DTSCS52
00219          10  WRK-DISPLAY-EMP-NO-2    PIC X(03).                   DTSCS52
00220                                                                   DTSCS52
00221      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS52
00222          10  FILLER                  PIC 9(05).                   DTSCS52
00223          10  WRK-DISPLAY-YR          PIC 9(02).                   DTSCS52
00224          10  WRK-DISPLAY-MO          PIC 9(02).                   DTSCS52
00225          10  WRK-DISPLAY-DA          PIC 9(02).                   DTSCS52
00226                                                                   DTSCS52
00227                                                                   DTSCS52
00228                                                                   DTSCS52
00229      05  INQUIRY-CONTROL-AREA.                                    DTSCS52
00230          10  LAST-REC-NUM            PIC S9(08)  COMP.            DTSCS52
00231                                                                   DTSCS52
00232          10  WS-REC-NUM              PIC S9(08)  COMP.            DTSCS52
00233                                                                   DTSCS52
00234          10  LAST-REC-KEY-AREA       PIC  X(16).                  DTSCS52
00235                                                                   DTSCS52
00236          10  SCR-REC-KEY-AREA        PIC  X(16).                  DTSCS52
00237                                                                   DTSCS52
00238          10  WS-REC-FOUND-IND        PIC  X(01).                  DTSCS52
00239                                                                   DTSCS52
00240                                                                   DTSCS52
00241  01  WRK-HOLD-AREA                  PIC X(1984).                  DTSCS52
00242                                                                   DTSCS52
00243  01  WRK-NUM-N                      PIC ------,---,--9.99.        DTSCS52
00244                                                                   DTSCS52
00245  01  WRK-MISS-RPT-CNT-N             PIC ZZ9.                      DTSCS52
00246                                                                   DTSCS52
00247  01  WRK-CHK-NEGATIVE-AMT           PIC S9(11)V9(02)  COMP-3.     DTSCS52
00248                                                                   DTSCS52
00249  01  WRK-CHK-TOT-WAGE-AMT           PIC S9(11)V9(02)  COMP-3.     DTSCS52
00250                                                                   DTSCS52
00251  01  WRK-CHK-TAX-WAGE-AMT           PIC S9(11)V9(02)  COMP-3.     DTSCS52
00252                                                                   DTSCS52
00253  01  WRK-LABEL-AREA.                                              DTSCS52
00254      05  FILLER                     PIC X(14).                    DTSCS52
00255      05  WRK-LABEL-LEFT-PAREN       PIC X(01).                    DTSCS52
00256      05  WRK-LABEL-OCC              PIC 9(01).                    DTSCS52
00257      05  WRK-LABEL-RIGHT-PAREN      PIC X(01).                    DTSCS52
00258                                                                   DTSCS52
00259 *01  WRK-OCCURS-AREA.                                             DTSCS52
00260 *****05  WRK-TBL-TOT OCCURS 4 TIMES   PIC S9(11)V99 COMP-3.       DTSCS52
00261                                                                   DTSCS52
00262 *****05  WRK-TBL-OK-IND OCCURS 4 TIMES PIC X.                     DTSCS52
00263 *********88  WRK-TBL-OK-88        VALUE 'Y'.                      DTSCS52
00264 *********88  WRK-TBL-NOT-OK-88    VALUE 'N'.                      DTSCS52
00265                                                                   DTSCS52
00266  01  WRK-LITS.                                                    DTSCS52
00267      05  WRK-MAX-LIT                PIC  S9(09) COMP-3            DTSCS52
00268                                     VALUE +100000000.             DTSCS52
00269      05  WRK-MIN-LIT                PIC  S9(09) COMP-3            DTSCS52
00270                                     VALUE -100000000.             DTSCS52
00271      EJECT                                                        DTSCS52
00272  01  MSG-LITERALS.                                                DTSCS52
00273      05  MSG-E521-AREA.                                           DTSCS52
00274          10  FILLER                  PIC  X(04)  VALUE 'E521'.    DTSCS52
00275          10  FILLER                  PIC  X(30)                   DTSCS52
00276                VALUE 'UPDATE REQUIRES EMPLOYER CLASS'.            DTSCS52
00277          10  FILLER                  PIC  X(30)                   DTSCS52
00278                VALUE ' RATED                        '.            DTSCS52
00279                                                                   DTSCS52
00280      05  MSG-E522-AREA.                                           DTSCS52
00281          10  FILLER                  PIC  X(04)  VALUE 'E522'.    DTSCS52
00282          10  FILLER                  PIC  X(30)                   DTSCS52
00283                VALUE 'EXISTING AMOUNT PLUS CHANGE AM'.            DTSCS52
00284          10  FILLER                  PIC  X(30)                   DTSCS52
00285                VALUE 'OUNT IS NEGATIVE              '.            DTSCS52
00286                                                                   DTSCS52
00287 *****05  MSG-E523-AREA.                                           DTSCS52
00288 *********10  FILLER                  PIC  X(04)  VALUE 'E523'.    DTSCS52
00289 *********10  FILLER                  PIC  X(30)                   DTSCS52
00290 ***************VALUE 'NEGATIVE BENEFIT CHARGES TOTAL'.            DTSCS52
00291 *********10  FILLER                  PIC  X(30)                   DTSCS52
00292 ***************VALUE ' NOT VALID                    '.            DTSCS52
00293      EJECT                                                        DTSCS52
00294  01  L001-COMM-AREA.                                              DTSCS52
00295  ++INCLUDE DTSIL001                                               DTSCS52
00296      EJECT                                                        DTSCS52
00297  01  L004-COMM-AREA.                                              DTSCS52
00298  ++INCLUDE DTSIL004                                               DTSCS52
00299      EJECT                                                        DTSCS52
00300  01  L006-COMM-AREA.                                              DTSCS52
00301  ++INCLUDE DTSIL006                                               DTSCS52
00302      EJECT                                                        DTSCS52
00303  01  L011-COMM-AREA.                                              DTSCS52
00304  ++INCLUDE DTSIL011                                               DTSCS52
00305      EJECT                                                        DTSCS52
00306  01  L013-COMM-AREA.                                              DTSCS52
00307  ++INCLUDE DTSIL013                                               DTSCS52
00308      EJECT                                                        DTSCS52
00309  01  L015-COMM-AREA.                                              DTSCS52
00310  ++INCLUDE DTSIL015                                               DTSCS52
00311      EJECT                                                        DTSCS52
00312  01  L016-COMM-AREA.                                              DTSCS52
00313  ++INCLUDE DTSIL016                                               DTSCS52
00314      EJECT                                                        DTSCS52
00315  01  L018-COMM-AREA.                                              DTSCS52
00316  ++INCLUDE DTSIL018                                               DTSCS52
00317      EJECT                                                        DTSCS52
00318  01  L054-COMM-AREA.                                              DTSCS52
00319      03  FILLER.                                                  DTSCS52
00320  ++INCLUDE DTSIL054                                               DTSCS52
00321      SKIP3                                                        DTSCS52
00322      03  MRCT-REC.                                                DTSCS52
00323  ++INCLUDE DTSIMRCT                                               DTSCS52
00324      SKIP3                                                        DTSCS52
00325      03  MRTE-REC.                                                DTSCS52
00326  ++INCLUDE DTSIMRTE                                               DTSCS52
00327      EJECT                                                        DTSCS52
00328  01  L055-COMM-AREA.                                              DTSCS52
00329  ++INCLUDE DTSIL055                                               DTSCS52
00330      EJECT                                                        DTSCS52
00331  01  L056-COMM-AREA.                                              DTSCS52
00332  ++INCLUDE DTSIL056                                               DTSCS52
00333      EJECT                                                        DTSCS52
00334  01  L057-COMM-AREA.                                              DTSCS52
00335  ++INCLUDE DTSIL057                                               DTSCS52
00336      EJECT                                                        DTSCS52
00337  01  L221-COMM-AREA.                                              DTSCS52
00338  ++INCLUDE DTSIL221                                               DTSCS52
00339      EJECT                                                        DTSCS52
00340  01  L331-COMM-AREA.                                              DTSCS52
00341  ++INCLUDE DTSIL331                                               DTSCS52
00342      EJECT                                                        DTSCS52
00343  01  L805-COMM-AREA.                                              DTSCS52
00344  ++INCLUDE DTSIL805                                               DTSCS52
00345      EJECT                                                        DTSCS52
00346  01  L810-COMM-AREA.                                              DTSCS52
00347      05  L810-CONTROL-BLOCK.                                      DTSCS52
00348  ++INCLUDE DTSIL810                                               DTSCS52
00349      EJECT                                                        DTSCS52
00350      05  MSKL-REC.                                                DTSCS52
00351  ++INCLUDE DTSIMSKL                                               DTSCS52
00352      EJECT                                                        DTSCS52
00353  01  MPRF-REC.                                                    DTSCS52
00354  ++INCLUDE DTSIMPRF                                               DTSCS52
00355      EJECT                                                        DTSCS52
00356 *01  L825-COMM-AREA.                                              DTSCS52
00357 *****05  L825-CONTROL-BLOCK.                                      DTSCS52
00358 ***INCLUDE DTSIL825                                               DTSCS52
00359      SKIP3                                                        DTSCS52
00360 *****05  RSKL-REC.                                                DTSCS52
00361 ***INCLUDE DTSIRSK1                                               DTSCS52
00362      EJECT                                                        DTSCS52
00363  01  L851-COMM-AREA.                                              DTSCS52
00364  ++INCLUDE DTSIL851                                               DTSCS52
00365                                                                   DTSCS52
00366      05  MAP-AREA REDEFINES L851-MAP-AREA.                        DTSCS52
00367  ++INCLUDE DTSIS52                                                DTSCS52
00368      EJECT                                                        DTSCS52
00369  01  CATB-LITERALS.                                               DTSCS52
00370  ++INCLUDE DTSICATB                                               DTSCS52
00371      SKIP3                                                        DTSCS52
00372  01  CFKD-LITERALS.                                               DTSCS52
00373  ++INCLUDE DTSICFKD                                               DTSCS52
00374      SKIP3                                                        DTSCS52
00375  01  CECD-LITERALS.                                               DTSCS52
00376  ++INCLUDE DTSICECD                                               DTSCS52
00377      SKIP3                                                        DTSCS52
00378  01  CPCD-LITERALS.                                               DTSCS52
00379  ++INCLUDE DTSICPCD                                               DTSCS52
00380      EJECT                                                        DTSCS52
00381  LINKAGE SECTION.                                                 DTSCS52
00382                                                                   DTSCS52
00383  01  DFHCOMMAREA.                                                 DTSCS52
00384  ++INCLUDE DTSILCCM                                               DTSCS52
00385      EJECT                                                        DTSCS52
00386 ******************************************************************DTSCS52
00387 *                                                                *DTSCS52
00388 ******************************************************************DTSCS52
00389  PROCEDURE DIVISION.                                              DTSCS52
00390                                                                   DTSCS52
00391 *****PERFORM                                                      DTSCS52
00392 ******VARYING WRK-CTR FROM 1 BY 1                                 DTSCS52
00393 ******UNTIL  WRK-CTR > 4                                          DTSCS52
00394 *********MOVE 0 TO WRK-TBL-TOT (WRK-CTR)                          DTSCS52
00395 *********SET WRK-TBL-OK-88 (WRK-CTR) TO TRUE                      DTSCS52
00396 *****END-PERFORM                                                  DTSCS52
00397                                                                   DTSCS52
00398                                                                   DTSCS52
00399      MOVE +0 TO WRK-EMP-NO.                                       DTSCS52
00400                                                                   DTSCS52
00401      SET WRK-MPRF-NO-88 TO TRUE.                                  DTSCS52
00402                                                                   DTSCS52
00403      SET WRK-MRCT-NO-88 TO TRUE.                                  DTSCS52
00404                                                                   DTSCS52
00405      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS52
00406                                                                   DTSCS52
00407      SET CURSOR-SET-NO TO TRUE.                                   DTSCS52
00408                                                                   DTSCS52
00409      MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N)                  DTSCS52
00410        TO SCR-ACCESS-IND.                                         DTSCS52
00411                                                                   DTSCS52
00412                                                                   DTSCS52
00413      MOVE SPACE TO REQ-IND.                                       DTSCS52
00414                                                                   DTSCS52
00415      PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT.               DTSCS52
00416                                                                   DTSCS52
00417                                                                   DTSCS52
00418 *-----------------------------------------------------            DTSCS52
00419 *    P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE           DTSCS52
00420 *    "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT             DTSCS52
00421 *    REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE             DTSCS52
00422 *    OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED.         DTSCS52
00423 *                                                                 DTSCS52
00424 *    THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE                DTSCS52
00425 *    PROCESSED.                                                   DTSCS52
00426 *                                                                 DTSCS52
00427 *    THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND,         DTSCS52
00428 *    INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE            DTSCS52
00429 *    WORK STATION OPERATOR.                                       DTSCS52
00430 *-----------------------------------------------------            DTSCS52
00431                                                                   DTSCS52
00432      MOVE SPACE TO RESP-IND.                                      DTSCS52
00433                                                                   DTSCS52
00434      IF REQ-ERROR                                                 DTSCS52
00435         PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT               DTSCS52
00436      ELSE                                                         DTSCS52
00437      IF REQ-JUMP                                                  DTSCS52
00438         PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT                DTSCS52
00439      ELSE                                                         DTSCS52
00440      IF REQ-CLEAR                                                 DTSCS52
00441         PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT               DTSCS52
00442      ELSE                                                         DTSCS52
00443      IF REQ-CURSOR-TO-GOTO                                        DTSCS52
00444         PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT              DTSCS52
00445      ELSE                                                         DTSCS52
00446      IF REQ-INQUIRE                                               DTSCS52
00447         PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT             DTSCS52
00448      ELSE                                                         DTSCS52
00449      IF REQ-EDIT                                                  DTSCS52
00450         PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT                DTSCS52
00451      ELSE                                                         DTSCS52
00452      IF REQ-UPDATE                                                DTSCS52
00453         PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT              DTSCS52
00454      ELSE                                                         DTSCS52
00455         GO TO S899-ABEND.                                         DTSCS52
00456                                                                   DTSCS52
00457                                                                   DTSCS52
00458 *-----------------------------------------------------            DTSCS52
00459 *    THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED             DTSCS52
00460 *    IN RESP-IND THE TYPE OF RESPONSE TO BE MADE.                 DTSCS52
00461 *-----------------------------------------------------            DTSCS52
00462                                                                   DTSCS52
00463      IF RESP-SEND-MAP                                             DTSCS52
00464          PERFORM S9300-SEND-MAP THRU S9300-EXIT                   DTSCS52
00465          SET LCCM-END-TASK-88 TO TRUE                             DTSCS52
00466      ELSE                                                         DTSCS52
00467      IF RESP-SEND-MSGONLY                                         DTSCS52
00468          PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT              DTSCS52
00469          SET LCCM-END-TASK-88 TO TRUE                             DTSCS52
00470      ELSE                                                         DTSCS52
00471      IF RESP-JUMP                                                 DTSCS52
00472          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS52
00473      ELSE                                                         DTSCS52
00474      IF RESP-CURSOR-TO-GOTO                                       DTSCS52
00475          PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT              DTSCS52
00476          SET LCCM-END-TASK-88 TO TRUE                             DTSCS52
00477      ELSE                                                         DTSCS52
00478          GO TO S899-ABEND.                                        DTSCS52
00479                                                                   DTSCS52
00480                                                                   DTSCS52
00481  MAINLINE-EXIT.                                                   DTSCS52
00482                                                                   DTSCS52
00483      EXEC CICS                                                    DTSCS52
00484          RETURN                                                   DTSCS52
00485      END-EXEC.                                                    DTSCS52
00486                                                                   DTSCS52
00487                                                                   DTSCS52
00488      GOBACK.                                                      DTSCS52
00489      EJECT                                                        DTSCS52
00490 /*****************************************************************DTSCS52
00491 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION         *DTSCS52
00492 ******************************************************************DTSCS52
00493                                                                   DTSCS52
00494  P1000-ANALYZE-REQUEST.                                           DTSCS52
00495                                                                   DTSCS52
00496 *-----------------------------------------------------            DTSCS52
00497 *     IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE)         DTSCS52
00498 *     THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE               DTSCS52
00499 *     REPLACED WITH ENTER)                                        DTSCS52
00500 *-----------------------------------------------------            DTSCS52
00501                                                                   DTSCS52
00502      IF LCCM-SCR-ID NOT = WRK-SCR-ID                              DTSCS52
00503         SET LCCM-ENTER-88 TO TRUE                                 DTSCS52
00504         IF LCCM-EMP-NO > ZERO                                     DTSCS52
00505             SET REQ-INQUIRE TO TRUE                               DTSCS52
00506             MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1                    DTSCS52
00507             MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2                    DTSCS52
00508         ELSE                                                      DTSCS52
00509             SET REQ-CLEAR TO TRUE                                 DTSCS52
00510         END-IF                                                    DTSCS52
00511         GO TO P1000-EXIT.                                         DTSCS52
00512                                                                   DTSCS52
00513                                                                   DTSCS52
00514 *-----------------------------------------------------            DTSCS52
00515 *      RECEIVE THE MAP                                            DTSCS52
00516 *-----------------------------------------------------            DTSCS52
00517                                                                   DTSCS52
00518      PERFORM S9100-RECEIVE THRU S9100-EXIT.                       DTSCS52
00519                                                                   DTSCS52
00520                                                                   DTSCS52
00521 *-----------------------------------------------------            DTSCS52
00522 *    CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE            DTSCS52
00523 *    WORK STATION                                                 DTSCS52
00524 *-----------------------------------------------------            DTSCS52
00525                                                                   DTSCS52
00526      IF LCCM-CLEAR-88                                             DTSCS52
00527         SET REQ-CLEAR TO TRUE                                     DTSCS52
00528         GO TO P1000-EXIT.                                         DTSCS52
00529                                                                   DTSCS52
00530                                                                   DTSCS52
00531 *-----------------------------------------------------            DTSCS52
00532 *    IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED             DTSCS52
00533 *-----------------------------------------------------            DTSCS52
00534                                                                   DTSCS52
00535      IF LCCM-SCR-UPDATE-LOCKED                                    DTSCS52
00536         PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT               DTSCS52
00537         GO TO P1000-EXIT.                                         DTSCS52
00538                                                                   DTSCS52
00539                                                                   DTSCS52
00540 *-----------------------------------------------------            DTSCS52
00541 *    PA2 IS A REQUEST TO POSITION CURSOR AT GO TO:                DTSCS52
00542 *-----------------------------------------------------            DTSCS52
00543                                                                   DTSCS52
00544      IF LCCM-PA2-88                                               DTSCS52
00545          SET REQ-CURSOR-TO-GOTO TO TRUE                           DTSCS52
00546          GO TO P1000-EXIT.                                        DTSCS52
00547                                                                   DTSCS52
00548                                                                   DTSCS52
00549 *-----------------------------------------------------            DTSCS52
00550 *    ALL OTHER PA KEYS ARE NOT ACTIVE                             DTSCS52
00551 *-----------------------------------------------------            DTSCS52
00552                                                                   DTSCS52
00553      IF LCCM-PA-88                                                DTSCS52
00554        PERFORM S804-INVALID-KEY THRU S804-EXIT                    DTSCS52
00555        SET REQ-ERROR TO TRUE                                      DTSCS52
00556        GO TO P1000-EXIT.                                          DTSCS52
00557                                                                   DTSCS52
00558                                                                   DTSCS52
00559 *-----------------------------------------------------            DTSCS52
00560 *    IN DC F12 (WHEN UPDATE IS NOT IN PROGRESS) IS A              DTSCS52
00561 *    REQUEST TO CLEAR THE SCREEN.                                 DTSCS52
00562 *-----------------------------------------------------            DTSCS52
00563                                                                   DTSCS52
00564      IF LCCM-F12-88                                               DTSCS52
00565         MOVE LOW-VALUES TO MAP-AREA                               DTSCS52
00566         SET REQ-CLEAR TO TRUE                                     DTSCS52
00567         GO TO P1000-EXIT.                                         DTSCS52
00568                                                                   DTSCS52
00569                                                                   DTSCS52
00570 *-----------------------------------------------------            DTSCS52
00571 *    IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION            DTSCS52
00572 *-----------------------------------------------------            DTSCS52
00573                                                                   DTSCS52
00574      IF LCCM-F03-88                                               DTSCS52
00575         MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID                    DTSCS52
00576         SET REQ-JUMP TO TRUE                                      DTSCS52
00577         GO TO P1000-EXIT.                                         DTSCS52
00578                                                                   DTSCS52
00579                                                                   DTSCS52
00580 *-----------------------------------------------------            DTSCS52
00581 *    IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN         DTSCS52
00582 *-----------------------------------------------------            DTSCS52
00583                                                                   DTSCS52
00584      IF LCCM-F04-88                                               DTSCS52
00585         MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID                 DTSCS52
00586         SET REQ-JUMP TO TRUE                                      DTSCS52
00587         GO TO P1000-EXIT.                                         DTSCS52
00588                                                                   DTSCS52
00589                                                                   DTSCS52
00590 *-----------------------------------------------------            DTSCS52
00591 *    IF JUMP TO CORRESPONDENCE QUEUE INQUIRY/UPDATE KEY           DTSCS52
00592 *    PRESSED, THEN JUMP.                                          DTSCS52
00593 *-----------------------------------------------------            DTSCS52
00594                                                                   DTSCS52
00595      IF LCCM-F14-88                                               DTSCS52
00596         MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID                  DTSCS52
00597         SET REQ-JUMP TO TRUE                                      DTSCS52
00598         GO TO P1000-EXIT.                                         DTSCS52
00599                                                                   DTSCS52
00600                                                                   DTSCS52
00601 *-----------------------------------------------------            DTSCS52
00602 *    IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO               DTSCS52
00603 *    REQUESTED SCREEN TYPE                                        DTSCS52
00604 *-----------------------------------------------------            DTSCS52
00605                                                                   DTSCS52
00606      IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID             DTSCS52
00607         NEXT SENTENCE                                             DTSCS52
00608      ELSE                                                         DTSCS52
00609        MOVE MAP-GOTO TO LCCM-REQ-SCR-ID                           DTSCS52
00610        SET REQ-JUMP TO TRUE                                       DTSCS52
00611        GO TO P1000-EXIT.                                          DTSCS52
00612                                                                   DTSCS52
00613                                                                   DTSCS52
00614 *-----------------------------------------------------            DTSCS52
00615 *    IF REQUEST TO UPDATE THE DATA (ADD,MOD,DEL)                  DTSCS52
00616 *          VERIFY USER ACCESS TO PERFORM UPDATE                   DTSCS52
00617 *-----------------------------------------------------            DTSCS52
00618                                                                   DTSCS52
00619      IF LCCM-F09-88                                               DTSCS52
00620      OR LCCM-F10-88                                               DTSCS52
00621      OR LCCM-F23-88                                               DTSCS52
00622         IF SCR-ACCESS-UPDATE                                      DTSCS52
00623            SET REQ-EDIT TO TRUE                                   DTSCS52
00624            GO TO P1000-EXIT                                       DTSCS52
00625         ELSE                                                      DTSCS52
00626            PERFORM S804-INVALID-KEY THRU S804-EXIT                DTSCS52
00627            SET REQ-ERROR TO TRUE                                  DTSCS52
00628            GO TO P1000-EXIT.                                      DTSCS52
00629                                                                   DTSCS52
00630 *-----------------------------------------------------            DTSCS52
00631 *    IF INQUIRY TYPE KEY PRESSED (ENTER, F5, F6, F7,              DTSCS52
00632 *          OR F8), INDICATE INQUIRY REQUEST                       DTSCS52
00633 *-----------------------------------------------------            DTSCS52
00634                                                                   DTSCS52
00635      IF LCCM-INQUIRY-88                                           DTSCS52
00636          SET REQ-INQUIRE TO TRUE                                  DTSCS52
00637          GO TO P1000-EXIT.                                        DTSCS52
00638                                                                   DTSCS52
00639                                                                   DTSCS52
00640 *-----------------------------------------------------            DTSCS52
00641 *     ANY OTHER KEY IS INVALID                                    DTSCS52
00642 *-----------------------------------------------------            DTSCS52
00643                                                                   DTSCS52
00644      PERFORM S804-INVALID-KEY THRU S804-EXIT.                     DTSCS52
00645                                                                   DTSCS52
00646      SET REQ-ERROR TO TRUE.                                       DTSCS52
00647  P1000-EXIT.                                                      DTSCS52
00648      EXIT.                                                        DTSCS52
00649      SKIP3                                                        DTSCS52
00650 ******************************************************************DTSCS52
00651 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS52
00652 ******************************************************************DTSCS52
00653                                                                   DTSCS52
00654  P1100-UPDATE-LOCKED.                                             DTSCS52
00655                                                                   DTSCS52
00656 *-----------------------------------------------------            DTSCS52
00657 *    IF THE SCREEN IS "LOCKED FOR UPDATE", THEN                   DTSCS52
00658 *    THE ONLY VALID OPERATOR REQUESTS ARE ENTER                   DTSCS52
00659 *    (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE).              DTSCS52
00660 *-----------------------------------------------------            DTSCS52
00661                                                                   DTSCS52
00662      IF LCCM-ENTER-88 OR LCCM-F12-88                              DTSCS52
00663         SET REQ-UPDATE TO TRUE                                    DTSCS52
00664      ELSE                                                         DTSCS52
00665         SET REQ-ERROR TO TRUE                                     DTSCS52
00666         IF LCCM-SCR-ADD-LOCKED                                    DTSCS52
00667            MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID                   DTSCS52
00668         ELSE                                                      DTSCS52
00669         IF LCCM-SCR-MOD-LOCKED                                    DTSCS52
00670            MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID                   DTSCS52
00671         ELSE                                                      DTSCS52
00672         IF LCCM-SCR-DEL-LOCKED                                    DTSCS52
00673            MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID                   DTSCS52
00674         ELSE                                                      DTSCS52
00675            GO TO S899-ABEND.                                      DTSCS52
00676  P1100-EXIT.                                                      DTSCS52
00677      EXIT.                                                        DTSCS52
00678 /*****************************************************************DTSCS52
00679 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS52
00680 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN.                      *DTSCS52
00681 ******************************************************************DTSCS52
00682                                                                   DTSCS52
00683  P2000-REQUEST-ERROR.                                             DTSCS52
00684      IF LCCM-MSG                                                  DTSCS52
00685         SET RESP-SEND-MSGONLY TO TRUE                             DTSCS52
00686      ELSE                                                         DTSCS52
00687         GO TO S899-ABEND.                                         DTSCS52
00688  P2000-EXIT.                                                      DTSCS52
00689      EXIT.                                                        DTSCS52
00690 /*****************************************************************DTSCS52
00691 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED                  *DTSCS52
00692 ******************************************************************DTSCS52
00693                                                                   DTSCS52
00694  P3000-REQUEST-JUMP.                                              DTSCS52
00695                                                                   DTSCS52
00696 *-----------------------------------------------------            DTSCS52
00697 *    VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE    DTSCS52
00698 *    BY USER                                                      DTSCS52
00699 *-----------------------------------------------------            DTSCS52
00700                                                                   DTSCS52
00701      PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT.                 DTSCS52
00702                                                                   DTSCS52
00703                                                                   DTSCS52
00704 *-----------------------------------------------------            DTSCS52
00705 *    VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED               DTSCS52
00706 *-----------------------------------------------------            DTSCS52
00707                                                                   DTSCS52
00708      IF LCCM-MSG                                                  DTSCS52
00709         SET RESP-SEND-MSGONLY TO TRUE                             DTSCS52
00710         SET CURSOR-SET-GOTO TO TRUE                               DTSCS52
00711         GO TO P3000-EXIT.                                         DTSCS52
00712                                                                   DTSCS52
00713                                                                   DTSCS52
00714      MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA.                  DTSCS52
00715                                                                   DTSCS52
00716      PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT.              DTSCS52
00717                                                                   DTSCS52
00718      IF L018-VALID                                                DTSCS52
00719          MOVE L018-EMP-NO TO LCCM-EMP-NO.                         DTSCS52
00720                                                                   DTSCS52
00721                                                                   DTSCS52
00722 *-----------------------------------------------------            DTSCS52
00723 *    CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING      DTSCS52
00724 *-----------------------------------------------------            DTSCS52
00725                                                                   DTSCS52
00726      MOVE LOW-VALUES TO LCCM-SCR-STATUS                           DTSCS52
00727                         LCCM-SCR-HOLD-AREA.                       DTSCS52
00728                                                                   DTSCS52
00729      MOVE +0 TO LCCM-SCR-ABSTIME.                                 DTSCS52
00730                                                                   DTSCS52
00731      SET RESP-JUMP TO TRUE.                                       DTSCS52
00732  P3000-EXIT.                                                      DTSCS52
00733      EXIT.                                                        DTSCS52
00734 /*****************************************************************DTSCS52
00735 * CLEAR KEY WAS PRESSED                                          *DTSCS52
00736 ******************************************************************DTSCS52
00737                                                                   DTSCS52
00738  P4000-REQUEST-CLEAR.                                             DTSCS52
00739                                                                   DTSCS52
00740 *-----------------------------------------------------            DTSCS52
00741 *   CLEAN UP INDICATORS AND PAGING STORAGE.  RESET KEY            DTSCS52
00742 *   FIELDS FROM EARLIER REQUESTS                                  DTSCS52
00743 *-----------------------------------------------------            DTSCS52
00744                                                                   DTSCS52
00745      IF LCCM-EMP-NO > ZERO                                        DTSCS52
00746          MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1                       DTSCS52
00747          MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2.                      DTSCS52
00748                                                                   DTSCS52
00749      MOVE ZERO TO LCCM-EMP-NO.                                    DTSCS52
00750                                                                   DTSCS52
00751      MOVE LOW-VALUES TO LCCM-SCR52-HOLD-AREA.                     DTSCS52
00752                                                                   DTSCS52
00753      MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS52
00754                                                                   DTSCS52
00755      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS52
00756                                                                   DTSCS52
00757      SET RESP-SEND-MAP TO TRUE.                                   DTSCS52
00758                                                                   DTSCS52
00759      IF SCR-ACCESS-UPDATE                                         DTSCS52
00760          PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT           DTSCS52
00761      ELSE                                                         DTSCS52
00762          PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT.             DTSCS52
00763  P4000-EXIT.                                                      DTSCS52
00764      EXIT.                                                        DTSCS52
00765 /*****************************************************************DTSCS52
00766 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED                   *DTSCS52
00767 ******************************************************************DTSCS52
00768                                                                   DTSCS52
00769  P5000-CURSOR-TO-GOTO.                                            DTSCS52
00770      SET CURSOR-SET-GOTO TO TRUE.                                 DTSCS52
00771                                                                   DTSCS52
00772      SET RESP-CURSOR-TO-GOTO TO TRUE.                             DTSCS52
00773  P5000-EXIT.                                                      DTSCS52
00774      EXIT.                                                        DTSCS52
00775 /*****************************************************************DTSCS52
00776 * INQUIRY WAS REQUESTED                                          *DTSCS52
00777 ******************************************************************DTSCS52
00778                                                                   DTSCS52
00779  P6000-REQUEST-INQUIRE.                                           DTSCS52
00780      MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA.                  DTSCS52
00781                                                                   DTSCS52
00782      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS52
00783                                                                   DTSCS52
00784      MOVE L018-S-EMP-NO-AREA TO MAP-EMP-NO-AREA.                  DTSCS52
00785                                                                   DTSCS52
00786      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS52
00787                                                                   DTSCS52
00788      MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS52
00789                                                                   DTSCS52
00790      SET RESP-SEND-MAP TO TRUE.                                   DTSCS52
00791                                                                   DTSCS52
00792      IF SCR-ACCESS-UPDATE                                         DTSCS52
00793          PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT           DTSCS52
00794      ELSE                                                         DTSCS52
00795          PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT.             DTSCS52
00796                                                                   DTSCS52
00797      MOVE LCCM-SCR52-HOLD-AREA TO SCR-REC-KEY-AREA.               DTSCS52
00798                                                                   DTSCS52
00799      MOVE LOW-VALUES TO LCCM-SCR52-HOLD-AREA.                     DTSCS52
00800                                                                   DTSCS52
00801                                                                   DTSCS52
00802      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS52
00803                                                                   DTSCS52
00804      IF LCCM-MSG                                                  DTSCS52
00805          GO TO P6000-EXIT.                                        DTSCS52
00806                                                                   DTSCS52
00807                                                                   DTSCS52
00808      PERFORM S1110-READ-MPRF THRU S1110-EXIT.                     DTSCS52
00809                                                                   DTSCS52
00810      IF LCCM-MSG                                                  DTSCS52
00811          GO TO P6000-EXIT.                                        DTSCS52
00812                                                                   DTSCS52
00813                                                                   DTSCS52
00814      MOVE WRK-EMP-NO TO LCCM-EMP-NO.                              DTSCS52
00815                                                                   DTSCS52
00816                                                                   DTSCS52
00817      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSCS52
00818                                                                   DTSCS52
00819      MOVE WRK-EMP-NO TO MSKL-EMP-NO.                              DTSCS52
00820                                                                   DTSCS52
00821      SET MSKL-RCT-88 TO TRUE.                                     DTSCS52
00822                                                                   DTSCS52
00823      PERFORM S810-COUNT THRU S810-EXIT.                           DTSCS52
00824                                                                   DTSCS52
00825      IF L810-RECORD-CNT = +0                                      DTSCS52
00826          MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                      DTSCS52
00827          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS52
00828          GO TO P6000-EXIT.                                        DTSCS52
00829                                                                   DTSCS52
00830                                                                   DTSCS52
00831      MOVE L810-RECORD-CNT TO LAST-REC-NUM.                        DTSCS52
00832                                                                   DTSCS52
00833      MOVE MSKL-KEY-AREA TO LAST-REC-KEY-AREA.                     DTSCS52
00834                                                                   DTSCS52
00835                                                                   DTSCS52
00836      PERFORM P6100-LOCATE-REC THRU P6100-EXIT.                    DTSCS52
00837                                                                   DTSCS52
00838      IF LCCM-MSG                                                  DTSCS52
00839          GO TO P6000-EXIT.                                        DTSCS52
00840                                                                   DTSCS52
00841                                                                   DTSCS52
00842      PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT.              DTSCS52
00843                                                                   DTSCS52
00844                                                                   DTSCS52
00845      MOVE MRCT-KEY-AREA TO LCCM-SCR52-HOLD-AREA.                  DTSCS52
00846                                                                   DTSCS52
00847      SET LCCM-SCR-INQUIRE TO TRUE.                                DTSCS52
00848                                                                   DTSCS52
00849      IF SCR-ACCESS-UPDATE                                         DTSCS52
00850          PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.          DTSCS52
00851  P6000-EXIT.                                                      DTSCS52
00852      EXIT.                                                        DTSCS52
00853      EJECT                                                        DTSCS52
00854  P6100-LOCATE-REC.                                                DTSCS52
00855                                                                   DTSCS52
00856 *------------------------------------------------------------     DTSCS52
00857 *    IF, AT THE LAST USE OF THIS SCREEN, A RECORD FOR             DTSCS52
00858 *    EMPLOYER NUMBER LCCM-EMP-NO WAS DISPLAYED ON THE             DTSCS52
00859 *    SCREEN, THEN BASE THE PAGING LOGIC ON THE LAST RECORD        DTSCS52
00860 *    DISPLAYED ON THIS SCREEN; OTHERWISE, DISPLAY THE             DTSCS52
00861 *    RECORD WITH THE GREATEST MRCT-EFF-YRQ                        DTSCS52
00862 *    ASSOCIATED WITH WRK-EMP-NO).                                 DTSCS52
00863 *------------------------------------------------------------     DTSCS52
00864                                                                   DTSCS52
00865      IF SCR-REC-KEY-AREA = LOW-VALUES                             DTSCS52
00866          PERFORM P6140-LAST-REC THRU P6140-EXIT                   DTSCS52
00867          GO TO P6100-EXIT.                                        DTSCS52
00868                                                                   DTSCS52
00869                                                                   DTSCS52
00870      MOVE SCR-REC-KEY-AREA TO MRCT-KEY-AREA.                      DTSCS52
00871                                                                   DTSCS52
00872      IF WRK-EMP-NO = MRCT-EMP-NO                                  DTSCS52
00873          NEXT SENTENCE                                            DTSCS52
00874      ELSE                                                         DTSCS52
00875          PERFORM P6140-LAST-REC THRU P6140-EXIT                   DTSCS52
00876          GO TO P6100-EXIT.                                        DTSCS52
00877                                                                   DTSCS52
00878                                                                   DTSCS52
00879      IF LCCM-F05-88                                               DTSCS52
00880          PERFORM P6110-FIRST-REC THRU P6110-EXIT                  DTSCS52
00881          GO TO P6100-EXIT.                                        DTSCS52
00882                                                                   DTSCS52
00883                                                                   DTSCS52
00884      IF LCCM-F06-88                                               DTSCS52
00885          PERFORM P6140-LAST-REC THRU P6140-EXIT                   DTSCS52
00886          GO TO P6100-EXIT.                                        DTSCS52
00887                                                                   DTSCS52
00888                                                                   DTSCS52
00889      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSCS52
00890                                                                   DTSCS52
00891      MOVE WRK-EMP-NO TO MSKL-EMP-NO.                              DTSCS52
00892                                                                   DTSCS52
00893      SET MSKL-RCT-88 TO TRUE.                                     DTSCS52
00894                                                                   DTSCS52
00895      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS52
00896                                                                   DTSCS52
00897      IF L810-NO-REC-88                                            DTSCS52
00898          MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                      DTSCS52
00899          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS52
00900          GO TO P6100-EXIT.                                        DTSCS52
00901                                                                   DTSCS52
00902                                                                   DTSCS52
00903      MOVE +0 TO WS-REC-NUM.                                       DTSCS52
00904                                                                   DTSCS52
00905      MOVE 'N' TO WS-REC-FOUND-IND.                                DTSCS52
00906                                                                   DTSCS52
00907      PERFORM P6190-BROWSE-MRCT THRU P6190-EXIT                    DTSCS52
00908          UNTIL (L810-NO-REC-88)                                   DTSCS52
00909                    OR                                             DTSCS52
00910                (WS-REC-FOUND-IND = 'Y').                          DTSCS52
00911                                                                   DTSCS52
00912                                                                   DTSCS52
00913      IF L810-NO-REC-88                                            DTSCS52
00914          PERFORM P6140-LAST-REC THRU P6140-EXIT                   DTSCS52
00915          GO TO P6100-EXIT.                                        DTSCS52
00916                                                                   DTSCS52
00917                                                                   DTSCS52
00918      IF LCCM-ENTER-88                                             DTSCS52
00919          PERFORM S810-END-BROWSE THRU S810-EXIT                   DTSCS52
00920          GO TO P6100-EXIT.                                        DTSCS52
00921                                                                   DTSCS52
00922                                                                   DTSCS52
00923      IF LCCM-F07-88                                               DTSCS52
00924          PERFORM P6120-PREV-REC THRU P6120-EXIT                   DTSCS52
00925          GO TO P6100-EXIT.                                        DTSCS52
00926                                                                   DTSCS52
00927                                                                   DTSCS52
00928      IF LCCM-F08-88                                               DTSCS52
00929          PERFORM P6130-NEXT-REC THRU P6130-EXIT                   DTSCS52
00930          GO TO P6100-EXIT.                                        DTSCS52
00931                                                                   DTSCS52
00932                                                                   DTSCS52
00933      GO TO S899-ABEND.                                            DTSCS52
00934  P6100-EXIT.                                                      DTSCS52
00935      EXIT.                                                        DTSCS52
00936      SKIP3                                                        DTSCS52
00937  P6110-FIRST-REC.                                                 DTSCS52
00938      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSCS52
00939                                                                   DTSCS52
00940      MOVE WRK-EMP-NO TO MSKL-EMP-NO.                              DTSCS52
00941                                                                   DTSCS52
00942      SET MSKL-RCT-88 TO TRUE.                                     DTSCS52
00943                                                                   DTSCS52
00944      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS52
00945                                                                   DTSCS52
00946      IF L810-NO-REC-88                                            DTSCS52
00947          MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                      DTSCS52
00948          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS52
00949          GO TO P6110-EXIT.                                        DTSCS52
00950                                                                   DTSCS52
00951                                                                   DTSCS52
00952      PERFORM S810-END-BROWSE THRU S810-EXIT.                      DTSCS52
00953                                                                   DTSCS52
00954      MOVE MSKL-REC TO MRCT-REC.                                   DTSCS52
00955                                                                   DTSCS52
00956      MOVE +1 TO WS-REC-NUM.                                       DTSCS52
00957  P6110-EXIT.                                                      DTSCS52
00958      EXIT.                                                        DTSCS52
00959      SKIP3                                                        DTSCS52
00960  P6120-PREV-REC.                                                  DTSCS52
00961      PERFORM S810-READ-PREV THRU S810-EXIT.                       DTSCS52
00962                                                                   DTSCS52
00963      IF L810-NO-REC-88                                            DTSCS52
00964          MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                      DTSCS52
00965          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS52
00966          GO TO P6120-EXIT.                                        DTSCS52
00967                                                                   DTSCS52
00968                                                                   DTSCS52
00969      PERFORM S810-READ-PREV THRU S810-EXIT.                       DTSCS52
00970                                                                   DTSCS52
00971      IF L810-NO-REC-88                                            DTSCS52
00972          GO TO P6120-EXIT.                                        DTSCS52
00973                                                                   DTSCS52
00974                                                                   DTSCS52
00975      PERFORM S810-END-BROWSE THRU S810-EXIT.                      DTSCS52
00976                                                                   DTSCS52
00977      SUBTRACT 1 FROM WS-REC-NUM.                                  DTSCS52
00978                                                                   DTSCS52
00979      MOVE MSKL-REC TO MRCT-REC.                                   DTSCS52
00980  P6120-EXIT.                                                      DTSCS52
00981      EXIT.                                                        DTSCS52
00982      SKIP3                                                        DTSCS52
00983  P6130-NEXT-REC.                                                  DTSCS52
00984      IF MRCT-KEY-AREA > SCR-REC-KEY-AREA                          DTSCS52
00985          PERFORM S810-END-BROWSE THRU S810-EXIT                   DTSCS52
00986          GO TO P6130-EXIT.                                        DTSCS52
00987                                                                   DTSCS52
00988                                                                   DTSCS52
00989      PERFORM S810-READ-NEXT THRU S810-EXIT.                       DTSCS52
00990                                                                   DTSCS52
00991      IF L810-NO-REC-88                                            DTSCS52
00992          GO TO P6130-EXIT.                                        DTSCS52
00993                                                                   DTSCS52
00994                                                                   DTSCS52
00995      PERFORM S810-END-BROWSE THRU S810-EXIT.                      DTSCS52
00996                                                                   DTSCS52
00997      ADD +1 TO WS-REC-NUM.                                        DTSCS52
00998                                                                   DTSCS52
00999      MOVE MSKL-REC TO MRCT-REC.                                   DTSCS52
01000  P6130-EXIT.                                                      DTSCS52
01001      EXIT.                                                        DTSCS52
01002      SKIP3                                                        DTSCS52
01003  P6140-LAST-REC.                                                  DTSCS52
01004      MOVE LAST-REC-KEY-AREA TO MSKL-KEY-AREA.                     DTSCS52
01005                                                                   DTSCS52
01006      PERFORM S810-READ THRU S810-EXIT.                            DTSCS52
01007                                                                   DTSCS52
01008      IF L810-NO-REC-88                                            DTSCS52
01009          MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                      DTSCS52
01010          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS52
01011          GO TO P6140-EXIT.                                        DTSCS52
01012                                                                   DTSCS52
01013                                                                   DTSCS52
01014      MOVE MSKL-REC TO MRCT-REC.                                   DTSCS52
01015                                                                   DTSCS52
01016      MOVE LAST-REC-NUM TO WS-REC-NUM.                             DTSCS52
01017  P6140-EXIT.                                                      DTSCS52
01018      EXIT.                                                        DTSCS52
01019      SKIP3                                                        DTSCS52
01020  P6190-BROWSE-MRCT.                                               DTSCS52
01021      MOVE MSKL-REC TO MRCT-REC.                                   DTSCS52
01022                                                                   DTSCS52
01023      ADD +1 TO WS-REC-NUM.                                        DTSCS52
01024                                                                   DTSCS52
01025      IF MRCT-KEY-AREA NOT < SCR-REC-KEY-AREA                      DTSCS52
01026          MOVE 'Y' TO WS-REC-FOUND-IND                             DTSCS52
01027      ELSE                                                         DTSCS52
01028          PERFORM S810-READ-NEXT THRU S810-EXIT.                   DTSCS52
01029  P6190-EXIT.                                                      DTSCS52
01030      EXIT.                                                        DTSCS52
01031 /*****************************************************************DTSCS52
01032 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS            *DTSCS52
01033 ******************************************************************DTSCS52
01034                                                                   DTSCS52
01035  P6900-CONSTRUCT-SCREEN.                                          DTSCS52
01036                                                                   DTSCS52
01037 *****PERFORM                                                      DTSCS52
01038 ******VARYING WRK-CTR FROM 1 BY 1                                 DTSCS52
01039 ******UNTIL  WRK-CTR > 4                                          DTSCS52
01040 *********MOVE 0 TO WRK-TBL-TOT (WRK-CTR)                          DTSCS52
01041 *********SET WRK-TBL-OK-88 (WRK-CTR) TO TRUE                      DTSCS52
01042 *****END-PERFORM                                                  DTSCS52
01043                                                                   DTSCS52
01044      PERFORM P6910-FROM-MRTE THRU P6910-EXIT.                     DTSCS52
01045                                                                   DTSCS52
01046      PERFORM P6920-FROM-MRCT THRU P6920-EXIT.                     DTSCS52
01047                                                                   DTSCS52
01048      PERFORM P6990-PAGE-NUMBER THRU P6990-EXIT.                   DTSCS52
01049  P6900-EXIT.                                                      DTSCS52
01050      EXIT.                                                        DTSCS52
01051      SKIP3                                                        DTSCS52
01052  P6910-FROM-MRTE.                                                 DTSCS52
01053      PERFORM P6911-FIND-MRTE   THRU P6911-EXIT.                   DTSCS52
01054                                                                   DTSCS52
01055      IF L810-OK-88                                                DTSCS52
01056         MOVE MRTE-RATE-TYPE-IND   TO MAP-RATE-TYPE                DTSCS52
01057      ELSE                                                         DTSCS52
01058         SET MAP-RATE-TYPE-NULL-88 TO TRUE.                        DTSCS52
01059                                                                   DTSCS52
01060      IF MAP-RATE-TYPE-ESTIM-88                                    DTSCS52
01061      OR MAP-RATE-TYPE-FINAL-88                                    DTSCS52
01062         MOVE MRCT-QTR1-ESTIM-TAX-WAGE                             DTSCS52
01063                                   TO MAP-ESTIM-QTR1-WAGE-N.       DTSCS52
01064                                                                   DTSCS52
01065  P6910-EXIT.                                                      DTSCS52
01066      EXIT.                                                        DTSCS52
01067      SKIP3                                                        DTSCS52
01068  P6911-FIND-MRTE.                                                 DTSCS52
01069      MOVE LOW-VALUES TO MRTE-KEY-AREA.                            DTSCS52
01070                                                                   DTSCS52
01071      MOVE WRK-EMP-NO TO MRTE-EMP-NO.                              DTSCS52
01072                                                                   DTSCS52
01073      SET MRTE-RTE-88 TO TRUE.                                     DTSCS52
01074                                                                   DTSCS52
01075      MOVE MRCT-EFF-YRQ  TO MRTE-EFF-YRQ.                          DTSCS52
01076                                                                   DTSCS52
01077      MOVE MRTE-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS52
01078                                                                   DTSCS52
01079      PERFORM S810-READ  THRU S810-EXIT.                           DTSCS52
01080                                                                   DTSCS52
01081      IF L810-OK-88                                                DTSCS52
01082         MOVE MSKL-REC   TO MRTE-REC.                              DTSCS52
01083                                                                   DTSCS52
01084  P6911-EXIT.                                                      DTSCS52
01085      EXIT.                                                        DTSCS52
01086      SKIP3                                                        DTSCS52
01087  P6920-FROM-MRCT.                                                 DTSCS52
01088      MOVE MRCT-EFF-YRQ TO WRK-DISPLAY.                            DTSCS52
01089                                                                   DTSCS52
01090      MOVE WRK-DISPLAY-QTR-YR TO MAP-EFF-QTR-YR.                   DTSCS52
01091                                                                   DTSCS52
01092      MOVE WRK-DISPLAY-QTR-Q  TO MAP-EFF-QTR-Q.                    DTSCS52
01093                                                                   DTSCS52
01094                                                                   DTSCS52
01095      MOVE MRCT-EFF-YRQ TO L006-YRQ.                               DTSCS52
01096                                                                   DTSCS52
01097      PERFORM S006-RATE-PERIOD THRU S006-EXIT.                     DTSCS52
01098                                                                   DTSCS52
01099                                                                   DTSCS52
01100      MOVE L006-RTE-YR-START-DATE TO L001-FED-8-DATE-9.            DTSCS52
01101                                                                   DTSCS52
01102      PERFORM S001-FROM-FED-8 THRU S001-EXIT.                      DTSCS52
01103                                                                   DTSCS52
01104      MOVE L001-SLASH-DATE TO MAP-PERIOD-FROM.                     DTSCS52
01105                                                                   DTSCS52
01106                                                                   DTSCS52
01107      MOVE L006-RTE-YR-END-DATE TO L001-FED-8-DATE-9.              DTSCS52
01108                                                                   DTSCS52
01109      PERFORM S001-FROM-FED-8 THRU S001-EXIT.                      DTSCS52
01110                                                                   DTSCS52
01111      MOVE L001-SLASH-DATE TO MAP-PERIOD-TO.                       DTSCS52
01112                                                                   DTSCS52
01113                                                                   DTSCS52
01114      MOVE MRCT-EARLIEST-LIAB-DATE TO WRK-DISPLAY.                 DTSCS52
01115                                                                   DTSCS52
01116      MOVE WRK-DISPLAY-MO TO MAP-EARLIEST-LIAB-MONTH.              DTSCS52
01117                                                                   DTSCS52
01118      MOVE WRK-DISPLAY-DA TO MAP-EARLIEST-LIAB-DAY.                DTSCS52
01119                                                                   DTSCS52
01120      MOVE WRK-DISPLAY-YR TO MAP-EARLIEST-LIAB-YEAR.               DTSCS52
01121                                                                   DTSCS52
01122                                                                   DTSCS52
01123      MOVE MRCT-ACTIVE-IND TO MAP-ACTIVE-IND.                      DTSCS52
01124                                                                   DTSCS52
01125                                                                   DTSCS52
01126      IF MRCT-TRANSFERRED-TO-EMP-NO NOT = ZERO                     DTSCS52
01127          MOVE MRCT-TRANSFERRED-TO-EMP-NO TO WRK-DISPLAY           DTSCS52
01128          MOVE WRK-DISPLAY-EMP-NO-1 TO MAP-TRNSF-TO-EMP-NO-1       DTSCS52
01129          MOVE WRK-DISPLAY-EMP-NO-2 TO MAP-TRNSF-TO-EMP-NO-2.      DTSCS52
01130                                                                   DTSCS52
01131                                                                   DTSCS52
01132      MOVE MRCT-EFF-YRQ TO L055-EFF-YRQ.                           DTSCS52
01133                                                                   DTSCS52
01134      PERFORM S055-EXPERIENCE-PERIODS THRU S055-EXIT.              DTSCS52
01135                                                                   DTSCS52
01136                                                                   DTSCS52
01137      MOVE L055-PRIOR-RESERVE-THRU-DATE TO L001-FED-8-DATE-9.      DTSCS52
01138                                                                   DTSCS52
01139      PERFORM S001-FROM-FED-8 THRU S001-EXIT.                      DTSCS52
01140                                                                   DTSCS52
01141      MOVE '(' TO MAP-PRIOR-DATE-LEFT.                             DTSCS52
01142                                                                   DTSCS52
01143      MOVE L001-SLASH-DATE TO MAP-PRIOR-DATE.                      DTSCS52
01144                                                                   DTSCS52
01145      MOVE ')' TO MAP-PRIOR-DATE-RIGHT.                            DTSCS52
01146                                                                   DTSCS52
01147                                                                   DTSCS52
01148      MOVE MRCT-PRIOR-RESERVE-AMT TO MAP-PRIOR-RESERVE-N.          DTSCS52
01149                                                                   DTSCS52
01150                                                                   DTSCS52
01151      MOVE MRCT-UI-TAX-PAID-AMT TO MAP-UI-TAX-PAID-N.              DTSCS52
01152                                                                   DTSCS52
01153                                                                   DTSCS52
01154      MOVE MRCT-TRUST-FUND-INTEREST-AMT TO MAP-TRUST-FUND-INT-N.   DTSCS52
01155                                                                   DTSCS52
01156                                                                   DTSCS52
01157      MOVE MRCT-BENEFITS-CHARGED-AMT TO MAP-UI-BEN-CHRGD-N.        DTSCS52
01158                                                                   DTSCS52
01159                                                                   DTSCS52
01160      PERFORM VARYING WRK-CTR                                      DTSCS52
01161         FROM 1 BY 1                                               DTSCS52
01162         UNTIL WRK-CTR > 3                                         DTSCS52
01163             MOVE L055-WAGES-FROM-YRQ (WRK-CTR) TO L004-QTR-5-9    DTSCS52
01164             PERFORM S004-FROM-5 THRU S004-EXIT                    DTSCS52
01165             MOVE L004-SLASH-QTR TO MAP-START-YRQ (WRK-CTR)        DTSCS52
01166             MOVE L055-WAGES-THRU-YRQ (WRK-CTR) TO L004-QTR-5-9    DTSCS52
01167             PERFORM S004-FROM-5 THRU S004-EXIT                    DTSCS52
01168             MOVE L004-SLASH-QTR TO MAP-END-YRQ (WRK-CTR)          DTSCS52
01169             MOVE MRCT-TOT-WAGE (WRK-CTR)                          DTSCS52
01170               TO MAP-TOT-WAGE-N (WRK-CTR)                         DTSCS52
01171             MOVE MRCT-TAX-WAGE (WRK-CTR)                          DTSCS52
01172               TO MAP-TAX-WAGE-N (WRK-CTR)                         DTSCS52
01173      END-PERFORM.                                                 DTSCS52
01174                                                                   DTSCS52
01175                                                                   DTSCS52
01176      MOVE L055-CURRENT-RESERVE-THRU-DATE TO L001-FED-8-DATE-9.    DTSCS52
01177                                                                   DTSCS52
01178      PERFORM S001-FROM-FED-8 THRU S001-EXIT.                      DTSCS52
01179                                                                   DTSCS52
01180      MOVE '(' TO MAP-CURRENT-DATE-LEFT.                           DTSCS52
01181                                                                   DTSCS52
01182      MOVE L001-SLASH-DATE TO MAP-CURRENT-DATE.                    DTSCS52
01183                                                                   DTSCS52
01184      MOVE ')' TO MAP-CURRENT-DATE-RIGHT.                          DTSCS52
01185                                                                   DTSCS52
01186                                                                   DTSCS52
01187      MOVE MRCT-MISS-RPT-CNT TO MAP-MISS-RPT-CNT-N.                DTSCS52
01188                                                                   DTSCS52
01189                                                                   DTSCS52
01190      MOVE MRCT-ESTB-DATE TO L001-FED-8-DATE-9.                    DTSCS52
01191                                                                   DTSCS52
01192      PERFORM S001-FROM-FED-8 THRU S001-EXIT.                      DTSCS52
01193                                                                   DTSCS52
01194      MOVE L001-SLASH-DATE TO MAP-ESTB-DATE.                       DTSCS52
01195                                                                   DTSCS52
01196                                                                   DTSCS52
01197      MOVE MRCT-TOT-UI-TAX-BALANCE-AMT TO MAP-UI-TAX-DUE-N.        DTSCS52
01198                                                                   DTSCS52
01199                                                                   DTSCS52
01200      MOVE MRCT-CHNG-DATE TO L001-FED-8-DATE-9.                    DTSCS52
01201                                                                   DTSCS52
01202      PERFORM S001-FROM-FED-8 THRU S001-EXIT.                      DTSCS52
01203                                                                   DTSCS52
01204      MOVE L001-SLASH-DATE TO MAP-CHNG-DATE.                       DTSCS52
01205                                                                   DTSCS52
01206                                                                   DTSCS52
01207      MOVE MRCT-PRED-DUE-IND TO MAP-PRED-DUE-IND.                  DTSCS52
01208                                                                   DTSCS52
01209                                                                   DTSCS52
01210      MOVE MRCT-CHNG-OP-ID TO MAP-CHNG-OPID.                       DTSCS52
01211                                                                   DTSCS52
01212                                                                   DTSCS52
01213      PERFORM P6921-MISC-INFO THRU P6921-EXIT.                     DTSCS52
01214  P6920-EXIT.                                                      DTSCS52
01215      EXIT.                                                        DTSCS52
01216      SKIP3                                                        DTSCS52
01217  P6921-MISC-INFO.                                                 DTSCS52
01218      SET L054-RATE-LOOKUP-YES-88 TO TRUE.                         DTSCS52
01219                                                                   DTSCS52
01220      IF MAP-RATE-TYPE-ESTIM-88                                    DTSCS52
01221      OR MAP-RATE-TYPE-FINAL-88                                    DTSCS52
01222         SET L054-ESTIMATED-RATE-YES-88 TO TRUE                    DTSCS52
01223      ELSE                                                         DTSCS52
01224         SET L054-ESTIMATED-RATE-NO-88  TO TRUE.                   DTSCS52
01225                                                                   DTSCS52
01226      PERFORM S054-RATE-DETERMINATION THRU S054-EXIT.              DTSCS52
01227                                                                   DTSCS52
01228                                                                   DTSCS52
01229      MOVE L054-CURRENT-RESERVE-AMT TO MAP-CURRENT-RESERVE-N.      DTSCS52
01230                                                                   DTSCS52
01231                                                                   DTSCS52
01232      MOVE L054-AVG-TAX-WAGE TO MAP-AVG-TAX-WAGE-N.                DTSCS52
01233                                                                   DTSCS52
01234                                                                   DTSCS52
01235      MOVE L054-RATIO TO L057-RATIO.                               DTSCS52
01236                                                                   DTSCS52
01237      PERFORM S057-RESERVE-RATIO-DISPLAY THRU S057-EXIT.           DTSCS52
01238                                                                   DTSCS52
01239      MOVE L057-DISP-RATIO TO MAP-RESERVE-RATIO.                   DTSCS52
01240                                                                   DTSCS52
01241                                                                   DTSCS52
01242      MOVE SPACES TO MAP-RATE-A.                                   DTSCS52
01243                                                                   DTSCS52
01244      IF L054-OK-88                                                DTSCS52
01245         IF L054-UI-PEN-RATE-YES-88                                DTSCS52
01246            MOVE L054-UI-PEN-RATE TO L056-RATE                     DTSCS52
01247            PERFORM S056-RATE-DISPLAY-LEFT THRU S056-EXIT          DTSCS52
01248            MOVE '(' TO MAP-RATE-A-LEFT                            DTSCS52
01249            MOVE L056-DISP-RATE TO MAP-RATE-A-DISP                 DTSCS52
01250            MOVE ')' TO MAP-RATE-A-RIGHT                           DTSCS52
01251         END-IF                                                    DTSCS52
01252         MOVE L054-UI-CALC-RATE TO L056-RATE                       DTSCS52
01253         PERFORM S056-RATE-DISPLAY-RIGHT THRU S056-EXIT            DTSCS52
01254         MOVE L056-DISP-RATE (3:5) TO MAP-RATE-B                   DTSCS52
01255      ELSE                                                         DTSCS52
01256         MOVE '  ?.?' TO MAP-RATE-B.                               DTSCS52
01257                                                                   DTSCS52
01258                                                                   DTSCS52
01259      MOVE L054-UI-PEN-RATE-CD TO MAP-PEN-RATE-IND.                DTSCS52
01260                                                                   DTSCS52
01261                                                                   DTSCS52
01262      IF L054-CLASSIFIED-88                                        DTSCS52
01263          MOVE 'CLASSIFIED' TO MAP-RATE-CATEGORY-DSCR              DTSCS52
01264      ELSE                                                         DTSCS52
01265          MOVE 'NONCLASSIFIED' TO MAP-RATE-CATEGORY-DSCR.          DTSCS52
01266  P6921-EXIT.                                                      DTSCS52
01267      EXIT.                                                        DTSCS52
01268      SKIP3                                                        DTSCS52
01269  P6990-PAGE-NUMBER.                                               DTSCS52
01270      MOVE WS-REC-NUM TO MAP-CURR-PAGE.                            DTSCS52
01271                                                                   DTSCS52
01272      MOVE LAST-REC-NUM TO MAP-LAST-PAGE.                          DTSCS52
01273                                                                   DTSCS52
01274      IF WS-REC-NUM = +1                                           DTSCS52
01275          IF LAST-REC-NUM = +1                                     DTSCS52
01276              MOVE PMSG-ONLY-PAGE TO LCCM-MSG-AREA                 DTSCS52
01277          ELSE                                                     DTSCS52
01278              MOVE PMSG-FIRST-PAGE TO LCCM-MSG-AREA                DTSCS52
01279      ELSE                                                         DTSCS52
01280          IF WS-REC-NUM = LAST-REC-NUM                             DTSCS52
01281              MOVE PMSG-LAST-PAGE TO LCCM-MSG-AREA.                DTSCS52
01282  P6990-EXIT.                                                      DTSCS52
01283      EXIT.                                                        DTSCS52
01284 /*****************************************************************DTSCS52
01285 * FUNCTION KEY TO ADD, MOD OR DEL THE RECORD WAS PRESSED.        *DTSCS52
01286 ******************************************************************DTSCS52
01287                                                                   DTSCS52
01288  P7000-REQUEST-EDIT.                                              DTSCS52
01289      PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.              DTSCS52
01290                                                                   DTSCS52
01291                                                                   DTSCS52
01292      IF LCCM-F09-88                                               DTSCS52
01293         PERFORM P7100-EDIT-ADD THRU P7100-EXIT                    DTSCS52
01294      ELSE                                                         DTSCS52
01295      IF LCCM-F10-88                                               DTSCS52
01296         PERFORM P7200-EDIT-MOD THRU P7200-EXIT                    DTSCS52
01297      ELSE                                                         DTSCS52
01298      IF LCCM-F23-88                                               DTSCS52
01299         PERFORM P7300-EDIT-DEL THRU P7300-EXIT                    DTSCS52
01300      ELSE                                                         DTSCS52
01301         GO TO S899-ABEND.                                         DTSCS52
01302                                                                   DTSCS52
01303                                                                   DTSCS52
01304 *------------------------------------------------------           DTSCS52
01305 *  SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED.          DTSCS52
01306 *  IN ORDER TO CONTINUE TO ATTEMPT A MOD THE SCREEN MUST          DTSCS52
01307 *  REMAIN IN 'INQUIRE' STATUS.                                    DTSCS52
01308 *------------------------------------------------------           DTSCS52
01309                                                                   DTSCS52
01310      IF LCCM-MSG                                                  DTSCS52
01311         NEXT SENTENCE                                             DTSCS52
01312      ELSE                                                         DTSCS52
01313         PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT              DTSCS52
01314         IF LCCM-F09-88                                            DTSCS52
01315            SET LCCM-SCR-ADD-LOCKED TO TRUE                        DTSCS52
01316            MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID                   DTSCS52
01317            PERFORM P7010-PSUEDO-UPDATE THRU P7010-EXIT            DTSCS52
01318         ELSE                                                      DTSCS52
01319         IF LCCM-F10-88                                            DTSCS52
01320            SET LCCM-SCR-MOD-LOCKED TO TRUE                        DTSCS52
01321            MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID                   DTSCS52
01322            PERFORM P7010-PSUEDO-UPDATE THRU P7010-EXIT            DTSCS52
01323         ELSE                                                      DTSCS52
01324         IF LCCM-F23-88                                            DTSCS52
01325            SET LCCM-SCR-DEL-LOCKED TO TRUE                        DTSCS52
01326            MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID.                  DTSCS52
01327                                                                   DTSCS52
01328                                                                   DTSCS52
01329      SET RESP-SEND-MAP TO TRUE.                                   DTSCS52
01330  P7000-EXIT.                                                      DTSCS52
01331      EXIT.                                                        DTSCS52
01332      SKIP3                                                        DTSCS52
01333  P7010-PSUEDO-UPDATE.                                             DTSCS52
01334      MOVE MAP-AREA TO WRK-HOLD-AREA.                              DTSCS52
01335                                                                   DTSCS52
01336                                                                   DTSCS52
01337 *****PERFORM                                                      DTSCS52
01338 ******VARYING WRK-CTR FROM 1 BY 1                                 DTSCS52
01339 ******UNTIL  WRK-CTR > 4                                          DTSCS52
01340 *********MOVE 0 TO WRK-TBL-TOT (WRK-CTR)                          DTSCS52
01341 *********SET WRK-TBL-OK-88 (WRK-CTR) TO TRUE                      DTSCS52
01342 *****END-PERFORM.                                                 DTSCS52
01343                                                                   DTSCS52
01344                                                                   DTSCS52
01345      IF LCCM-SCR-ADD-LOCKED                                       DTSCS52
01346         PERFORM P8110-CONSTRUCT-MRCT THRU P8110-EXIT              DTSCS52
01347      ELSE                                                         DTSCS52
01348         PERFORM P8210-CONSTRUCT-MRCT THRU P8210-EXIT.             DTSCS52
01349                                                                   DTSCS52
01350                                                                   DTSCS52
01351      MOVE WRK-HOLD-AREA TO MAP-AREA.                              DTSCS52
01352                                                                   DTSCS52
01353                                                                   DTSCS52
01354      PERFORM P6921-MISC-INFO THRU P6921-EXIT.                     DTSCS52
01355                                                                   DTSCS52
01356                                                                   DTSCS52
01357 *****PERFORM S9335-TOTALS THRU S9335-EXIT.                        DTSCS52
01358  P7010-EXIT.                                                      DTSCS52
01359      EXIT.                                                        DTSCS52
01360 /*****************************************************************DTSCS52
01361 * ADD FUNCTION WAS REQUESTED                                     *DTSCS52
01362 ******************************************************************DTSCS52
01363                                                                   DTSCS52
01364  P7100-EDIT-ADD.                                                  DTSCS52
01365                                                                   DTSCS52
01366 *-----------------------------------------------------            DTSCS52
01367 *    ADDITION REQUIRES THAT THE SCREEN WAS CLEARED FIRST          DTSCS52
01368 *-----------------------------------------------------            DTSCS52
01369                                                                   DTSCS52
01370      IF NOT LCCM-SCR-CLEAR                                        DTSCS52
01371         MOVE EMSG-ADD-PRECEDED TO LCCM-MSG-ID                     DTSCS52
01372         GO TO P7100-EXIT.                                         DTSCS52
01373                                                                   DTSCS52
01374                                                                   DTSCS52
01375      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS52
01376                                                                   DTSCS52
01377      IF LCCM-MSG                                                  DTSCS52
01378          GO TO P7100-EXIT.                                        DTSCS52
01379                                                                   DTSCS52
01380                                                                   DTSCS52
01381      PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT.                  DTSCS52
01382  P7100-EXIT.                                                      DTSCS52
01383      EXIT.                                                        DTSCS52
01384 /*****************************************************************DTSCS52
01385 * MODIFICATION FUNCTION WAS REQUESTED                            *DTSCS52
01386 ******************************************************************DTSCS52
01387                                                                   DTSCS52
01388  P7200-EDIT-MOD.                                                  DTSCS52
01389                                                                   DTSCS52
01390 *-----------------------------------------------------            DTSCS52
01391 *    MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY         DTSCS52
01392 *    INQUIRED                                                     DTSCS52
01393 *-----------------------------------------------------            DTSCS52
01394                                                                   DTSCS52
01395      IF NOT LCCM-SCR-INQUIRE                                      DTSCS52
01396         MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-ID                     DTSCS52
01397         GO TO P7200-EXIT.                                         DTSCS52
01398                                                                   DTSCS52
01399                                                                   DTSCS52
01400 *-----------------------------------------------------            DTSCS52
01401 *    MAP-EMP-NO MAY NOT BE CHANGED DURING THE MOD                 DTSCS52
01402 *-----------------------------------------------------            DTSCS52
01403                                                                   DTSCS52
01404      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS52
01405                                                                   DTSCS52
01406      IF LCCM-MSG                                                  DTSCS52
01407          GO TO P7200-EXIT.                                        DTSCS52
01408                                                                   DTSCS52
01409                                                                   DTSCS52
01410      IF LCCM-EMP-NO NOT = WRK-EMP-NO                              DTSCS52
01411          MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA         DTSCS52
01412          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS52
01413          GO TO P7200-EXIT.                                        DTSCS52
01414                                                                   DTSCS52
01415                                                                   DTSCS52
01416      PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT.                  DTSCS52
01417  P7200-EXIT.                                                      DTSCS52
01418      EXIT.                                                        DTSCS52
01419 /*****************************************************************DTSCS52
01420 * DELETE FUNCTION WAS REQUESTED                                  *DTSCS52
01421 ******************************************************************DTSCS52
01422                                                                   DTSCS52
01423  P7300-EDIT-DEL.                                                  DTSCS52
01424                                                                   DTSCS52
01425 *-----------------------------------------------------            DTSCS52
01426 *    DELETION REQUIRES THAT A RECORD WAS SUCCESSFULLY             DTSCS52
01427 *    INQUIRED                                                     DTSCS52
01428 *-----------------------------------------------------            DTSCS52
01429                                                                   DTSCS52
01430      IF NOT LCCM-SCR-INQUIRE                                      DTSCS52
01431         MOVE EMSG-DEL-PRECEDED TO LCCM-MSG-ID                     DTSCS52
01432         GO TO P7300-EXIT.                                         DTSCS52
01433                                                                   DTSCS52
01434                                                                   DTSCS52
01435 *-----------------------------------------------------            DTSCS52
01436 *    MAP-EMP-NO MAY NOT BE CHANGED DURING THE DEL                 DTSCS52
01437 *-----------------------------------------------------            DTSCS52
01438                                                                   DTSCS52
01439      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS52
01440                                                                   DTSCS52
01441      IF LCCM-MSG                                                  DTSCS52
01442          GO TO P7300-EXIT.                                        DTSCS52
01443                                                                   DTSCS52
01444                                                                   DTSCS52
01445      IF LCCM-EMP-NO NOT = WRK-EMP-NO                              DTSCS52
01446          MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA         DTSCS52
01447          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS52
01448          GO TO P7300-EXIT.                                        DTSCS52
01449  P7300-EXIT.                                                      DTSCS52
01450      EXIT.                                                        DTSCS52
01451 /*****************************************************************DTSCS52
01452 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED       *DTSCS52
01453 ******************************************************************DTSCS52
01454                                                                   DTSCS52
01455  P8000-REQUEST-UPDATE.                                            DTSCS52
01456      IF LCCM-SCR-ADD-LOCKED                                       DTSCS52
01457         PERFORM P8100-ADD THRU P8100-EXIT                         DTSCS52
01458      ELSE                                                         DTSCS52
01459      IF LCCM-SCR-MOD-LOCKED                                       DTSCS52
01460         PERFORM P8200-MOD THRU P8200-EXIT                         DTSCS52
01461      ELSE                                                         DTSCS52
01462      IF LCCM-SCR-DEL-LOCKED                                       DTSCS52
01463         PERFORM P8300-DEL THRU P8300-EXIT                         DTSCS52
01464      ELSE                                                         DTSCS52
01465         GO TO S899-ABEND.                                         DTSCS52
01466                                                                   DTSCS52
01467                                                                   DTSCS52
01468      SET RESP-SEND-MAP TO TRUE.                                   DTSCS52
01469  P8000-EXIT.                                                      DTSCS52
01470      EXIT.                                                        DTSCS52
01471 /*****************************************************************DTSCS52
01472 *                                                                *DTSCS52
01473 ******************************************************************DTSCS52
01474                                                                   DTSCS52
01475  P8100-ADD.                                                       DTSCS52
01476      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS52
01477                                                                   DTSCS52
01478                                                                   DTSCS52
01479      PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.              DTSCS52
01480                                                                   DTSCS52
01481                                                                   DTSCS52
01482      IF LCCM-F12-88                                               DTSCS52
01483         PERFORM P8120-REVERSE-PSUEDO-UPDATE THRU P8120-EXIT       DTSCS52
01484         MOVE PMSG-ADD-CANCELED TO LCCM-MSG-ID                     DTSCS52
01485         GO TO P8100-EXIT.                                         DTSCS52
01486                                                                   DTSCS52
01487                                                                   DTSCS52
01488      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS52
01489                                                                   DTSCS52
01490                                                                   DTSCS52
01491      MOVE 'A' TO L221-UPDATE-FUNCTION.                            DTSCS52
01492                                                                   DTSCS52
01493      PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT.                 DTSCS52
01494                                                                   DTSCS52
01495      IF LCCM-MSG                                                  DTSCS52
01496          GO TO P8100-EXIT.                                        DTSCS52
01497                                                                   DTSCS52
01498                                                                   DTSCS52
01499      MOVE LOW-VALUES TO MRCT-DATA-AREA.                           DTSCS52
01500                                                                   DTSCS52
01501      PERFORM S1110-READ-MPRF THRU S1110-EXIT.                     DTSCS52
01502                                                                   DTSCS52
01503      PERFORM P8110-CONSTRUCT-MRCT THRU P8110-EXIT.                DTSCS52
01504                                                                   DTSCS52
01505      MOVE MRCT-REC TO MSKL-REC.                                   DTSCS52
01506                                                                   DTSCS52
01507      PERFORM S810-WRITE THRU S810-EXIT.                           DTSCS52
01508                                                                   DTSCS52
01509                                                                   DTSCS52
01510      PERFORM S221-EMP-UNLOCK THRU S221-EXIT.                      DTSCS52
01511                                                                   DTSCS52
01512                                                                   DTSCS52
01513      MOVE MRCT-KEY-AREA TO LCCM-SCR52-HOLD-AREA.                  DTSCS52
01514                                                                   DTSCS52
01515      SET LCCM-ENTER-88 TO TRUE.                                   DTSCS52
01516                                                                   DTSCS52
01517      PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT.               DTSCS52
01518                                                                   DTSCS52
01519      MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-ID.                     DTSCS52
01520                                                                   DTSCS52
01521      MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS52
01522  P8100-EXIT.                                                      DTSCS52
01523      EXIT.                                                        DTSCS52
01524      SKIP3                                                        DTSCS52
01525  P8110-CONSTRUCT-MRCT.                                            DTSCS52
01526      MOVE LOW-VALUES TO MRCT-REC.                                 DTSCS52
01527                                                                   DTSCS52
01528                                                                   DTSCS52
01529      MOVE WRK-EMP-NO TO MRCT-EMP-NO.                              DTSCS52
01530                                                                   DTSCS52
01531                                                                   DTSCS52
01532      SET MRCT-RCT-88 TO TRUE.                                     DTSCS52
01533                                                                   DTSCS52
01534                                                                   DTSCS52
01535      MOVE MAP-EFF-YRQ-AREA TO L016-S-YRQ-AREA.                    DTSCS52
01536                                                                   DTSCS52
01537      PERFORM S016-QTR-FROM-SCREEN THRU S016-EXIT.                 DTSCS52
01538                                                                   DTSCS52
01539      MOVE L016-YRQ TO MRCT-EFF-YRQ.                               DTSCS52
01540                                                                   DTSCS52
01541                                                                   DTSCS52
01542      MOVE +0 TO MRCT-PURGE-DATE.                                  DTSCS52
01543                                                                   DTSCS52
01544                                                                   DTSCS52
01545      PERFORM P8900-MLOG-INIT THRU P8900-EXIT.                     DTSCS52
01546                                                                   DTSCS52
01547                                                                   DTSCS52
01548      MOVE MAP-ACTIVE-IND TO MRCT-ACTIVE-IND.                      DTSCS52
01549                                                                   DTSCS52
01550      PERFORM P8900-MLOG-ACTIVE-IND THRU P8900-EXIT.               DTSCS52
01551                                                                   DTSCS52
01552                                                                   DTSCS52
01553      MOVE MAP-PRIOR-RESERVE-CHNG-AREA TO L011-S-AMT-AREA.         DTSCS52
01554                                                                   DTSCS52
01555      PERFORM S011-MAX-LIMITS THRU S011-EXIT.                      DTSCS52
01556                                                                   DTSCS52
01557      MOVE L011-AMT TO MRCT-PRIOR-RESERVE-AMT.                     DTSCS52
01558                                                                   DTSCS52
01559      IF L011-AMT NOT = +0                                         DTSCS52
01560          PERFORM P8900-MLOG-PRIOR-RESERVE-AMT THRU P8900-EXIT.    DTSCS52
01561                                                                   DTSCS52
01562                                                                   DTSCS52
01563      MOVE MAP-UI-TAX-PAID-CHNG-AREA TO L011-S-AMT-AREA.           DTSCS52
01564                                                                   DTSCS52
01565      PERFORM S011-MAX-LIMITS THRU S011-EXIT.                      DTSCS52
01566                                                                   DTSCS52
01567      MOVE L011-AMT TO MRCT-UI-TAX-PAID-AMT.                       DTSCS52
01568                                                                   DTSCS52
01569      IF L011-AMT NOT = +0                                         DTSCS52
01570          PERFORM P8900-MLOG-UI-TAX-PAID-AMT THRU P8900-EXIT.      DTSCS52
01571                                                                   DTSCS52
01572                                                                   DTSCS52
01573      MOVE MAP-TRUST-FUND-INT-CHNG-AREA TO L011-S-AMT-AREA.        DTSCS52
01574                                                                   DTSCS52
01575      PERFORM S011-MAX-LIMITS THRU S011-EXIT.                      DTSCS52
01576                                                                   DTSCS52
01577      MOVE L011-AMT TO MRCT-TRUST-FUND-INTEREST-AMT.               DTSCS52
01578                                                                   DTSCS52
01579      IF L011-AMT NOT = +0                                         DTSCS52
01580          PERFORM P8900-MLOG-TRUST-FUND-INT-AMT THRU P8900-EXIT.   DTSCS52
01581                                                                   DTSCS52
01582                                                                   DTSCS52
01583      MOVE MAP-UI-BEN-CHRGD-CHNG-AREA TO L011-S-AMT-AREA.          DTSCS52
01584                                                                   DTSCS52
01585      PERFORM S011-MAX-LIMITS THRU S011-EXIT.                      DTSCS52
01586                                                                   DTSCS52
01587      MOVE L011-AMT TO MRCT-BENEFITS-CHARGED-AMT.                  DTSCS52
01588                                                                   DTSCS52
01589      IF L011-AMT NOT = +0                                         DTSCS52
01590          PERFORM P8900-MLOG-BENEFITS-CHRGD-AMT THRU P8900-EXIT.   DTSCS52
01591                                                                   DTSCS52
01592                                                                   DTSCS52
01593      PERFORM                                                      DTSCS52
01594        VARYING WRK-CTR FROM 1 BY 1                                DTSCS52
01595        UNTIL WRK-CTR > 3                                          DTSCS52
01596             MOVE +0 TO MRCT-TOT-WAGE (WRK-CTR)                    DTSCS52
01597                        MRCT-TAX-WAGE (WRK-CTR)                    DTSCS52
01598             MOVE MAP-TOT-WAGE-CHNG-AREA (WRK-CTR)                 DTSCS52
01599               TO L011-S-AMT-AREA                                  DTSCS52
01600             PERFORM S011-MAX-LIMITS THRU S011-EXIT                DTSCS52
01601             IF L011-AMT NOT = +0                                  DTSCS52
01602                ADD L011-AMT TO MRCT-TOT-WAGE (WRK-CTR)            DTSCS52
01603                PERFORM P8900-MLOG-TOT-WAGE THRU P8900-EXIT        DTSCS52
01604             END-IF                                                DTSCS52
01605             MOVE MAP-TAX-WAGE-CHNG-AREA (WRK-CTR)                 DTSCS52
01606               TO L011-S-AMT-AREA                                  DTSCS52
01607             PERFORM S011-MAX-LIMITS THRU S011-EXIT                DTSCS52
01608             IF L011-AMT NOT = +0                                  DTSCS52
01609                ADD L011-AMT TO MRCT-TAX-WAGE (WRK-CTR)            DTSCS52
01610                PERFORM P8900-MLOG-TAX-WAGE THRU P8900-EXIT        DTSCS52
01611             END-IF                                                DTSCS52
01612      END-PERFORM.                                                 DTSCS52
01613                                                                   DTSCS52
01614                                                                   DTSCS52
01615      MOVE MAP-EARLIEST-LIAB-DATE-AREA TO L015-S-DATE-AREA.        DTSCS52
01616                                                                   DTSCS52
01617      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS52
01618                                                                   DTSCS52
01619      MOVE L015-DATE TO MRCT-EARLIEST-LIAB-DATE.                   DTSCS52
01620                                                                   DTSCS52
01621      PERFORM P8900-MLOG-EARLIEST-LIAB-DATE THRU P8900-EXIT.       DTSCS52
01622                                                                   DTSCS52
01623                                                                   DTSCS52
01624      MOVE MAP-MISS-RPT-CNT-AREA TO L013-S-CNT-AREA.               DTSCS52
01625                                                                   DTSCS52
01626      PERFORM S013-MAX-LIMITS THRU S013-EXIT.                      DTSCS52
01627                                                                   DTSCS52
01628      MOVE L013-CNT TO MRCT-MISS-RPT-CNT.                          DTSCS52
01629                                                                   DTSCS52
01630      IF L013-CNT NOT = +0                                         DTSCS52
01631          PERFORM P8900-MLOG-MISS-RPT-CNT THRU P8900-EXIT.         DTSCS52
01632                                                                   DTSCS52
01633                                                                   DTSCS52
01634      MOVE MAP-UI-TAX-DUE-AREA TO L011-S-AMT-AREA.                 DTSCS52
01635                                                                   DTSCS52
01636      PERFORM S011-MAX-LIMITS THRU S011-EXIT.                      DTSCS52
01637                                                                   DTSCS52
01638      MOVE L011-AMT TO MRCT-TOT-UI-TAX-BALANCE-AMT.                DTSCS52
01639                                                                   DTSCS52
01640      IF L011-AMT NOT = +0                                         DTSCS52
01641          PERFORM P8900-MLOG-TOT-DUE-AMT THRU P8900-EXIT.          DTSCS52
01642                                                                   DTSCS52
01643                                                                   DTSCS52
01644      MOVE MAP-PRED-DUE-IND TO MRCT-PRED-DUE-IND                   DTSCS52
01645                                                                   DTSCS52
01646      PERFORM P8900-MLOG-PRED-DUE-IND THRU P8900-EXIT.             DTSCS52
01647                                                                   DTSCS52
01648                                                                   DTSCS52
01649      MOVE MAP-TRNSF-TO-EMP-NO-AREA TO L018-S-EMP-NO-AREA.         DTSCS52
01650                                                                   DTSCS52
01651      PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT.              DTSCS52
01652                                                                   DTSCS52
01653      MOVE L018-EMP-NO TO MRCT-TRANSFERRED-TO-EMP-NO.              DTSCS52
01654                                                                   DTSCS52
01655      IF L018-EMP-NO NOT = +0                                      DTSCS52
01656          PERFORM P8900-MLOG-TRNSFR-TO-EMP-NO THRU P8900-EXIT.     DTSCS52
01657                                                                   DTSCS52
01658                                                                   DTSCS52
01659      MOVE LCCM-OP-ID TO MRCT-CHNG-OP-ID                           DTSCS52
01660                                                                   DTSCS52
01661      SET MRCT-NOT-CONVERTED-88 TO TRUE.                           DTSCS52
01662                                                                   DTSCS52
01663      MOVE LCCM-CURR-RUN-DATE TO MRCT-ESTB-DATE.                   DTSCS52
01664                                                                   DTSCS52
01665      MOVE LCCM-CURR-RUN-DATE TO MRCT-CHNG-DATE.                   DTSCS52
01666  P8110-EXIT.                                                      DTSCS52
01667      EXIT.                                                        DTSCS52
01668      EJECT                                                        DTSCS52
01669  P8120-REVERSE-PSUEDO-UPDATE.                                     DTSCS52
01670      MOVE LOW-VALUES TO MAP-PRIOR-DATE-DISP                       DTSCS52
01671                         MAP-PRIOR-RESERVE                         DTSCS52
01672                         MAP-UI-TAX-PAID                           DTSCS52
01673                         MAP-TRUST-FUND-INT                        DTSCS52
01674                         MAP-UI-BEN-CHRGD.                         DTSCS52
01675                                                                   DTSCS52
01676      PERFORM                                                      DTSCS52
01677        VARYING WRK-CTR FROM 1 BY 1                                DTSCS52
01678        UNTIL WRK-CTR > +3                                         DTSCS52
01679          MOVE LOW-VALUES TO MAP-START-YRQ (WRK-CTR)               DTSCS52
01680                             MAP-END-YRQ (WRK-CTR)                 DTSCS52
01681                             MAP-TOT-WAGE (WRK-CTR)                DTSCS52
01682                             MAP-TAX-WAGE (WRK-CTR)                DTSCS52
01683      END-PERFORM.                                                 DTSCS52
01684                                                                   DTSCS52
01685      MOVE LOW-VALUES TO MAP-CURRENT-RESERVE                       DTSCS52
01686                         MAP-CURRENT-DATE-DISP                     DTSCS52
01687                         MAP-AVG-TAX-WAGE                          DTSCS52
01688                         MAP-RESERVE-RATIO                         DTSCS52
01689                         MAP-RATE-A                                DTSCS52
01690                         MAP-RATE-B                                DTSCS52
01691                         MAP-PEN-RATE-IND                          DTSCS52
01692                         MAP-RATE-CATEGORY-DSCR                    DTSCS52
01693                         MAP-ESTB-DATE                             DTSCS52
01694                         MAP-CHNG-DATE                             DTSCS52
01695                         MAP-CHNG-OPID.                            DTSCS52
01696  P8120-EXIT.                                                      DTSCS52
01697      EXIT.                                                        DTSCS52
01698 /*****************************************************************DTSCS52
01699 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS        *DTSCS52
01700 ******************************************************************DTSCS52
01701                                                                   DTSCS52
01702  P8200-MOD.                                                       DTSCS52
01703      SET LCCM-SCR-INQUIRE TO TRUE.                                DTSCS52
01704                                                                   DTSCS52
01705      PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.              DTSCS52
01706                                                                   DTSCS52
01707      IF LCCM-F12-88                                               DTSCS52
01708         PERFORM P8220-REVERSE-PSEUDO-UPDATE THRU P8220-EXIT       DTSCS52
01709         MOVE PMSG-MOD-CANCELED TO LCCM-MSG-ID                     DTSCS52
01710         GO TO P8200-EXIT.                                         DTSCS52
01711                                                                   DTSCS52
01712                                                                   DTSCS52
01713      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS52
01714                                                                   DTSCS52
01715                                                                   DTSCS52
01716      MOVE 'M' TO L221-UPDATE-FUNCTION.                            DTSCS52
01717                                                                   DTSCS52
01718      PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT.                 DTSCS52
01719                                                                   DTSCS52
01720      IF LCCM-MSG                                                  DTSCS52
01721          GO TO P8200-EXIT.                                        DTSCS52
01722                                                                   DTSCS52
01723                                                                   DTSCS52
01724      PERFORM S1110-READ-MPRF THRU S1110-EXIT.                     DTSCS52
01725                                                                   DTSCS52
01726                                                                   DTSCS52
01727      PERFORM P8210-CONSTRUCT-MRCT THRU P8210-EXIT.                DTSCS52
01728                                                                   DTSCS52
01729                                                                   DTSCS52
01730      MOVE MRCT-REC TO MSKL-REC.                                   DTSCS52
01731                                                                   DTSCS52
01732      PERFORM S810-REWRITE THRU S810-EXIT.                         DTSCS52
01733                                                                   DTSCS52
01734                                                                   DTSCS52
01735      PERFORM S221-EMP-UNLOCK THRU S221-EXIT.                      DTSCS52
01736                                                                   DTSCS52
01737                                                                   DTSCS52
01738      SET LCCM-ENTER-88 TO TRUE.                                   DTSCS52
01739                                                                   DTSCS52
01740      PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT.               DTSCS52
01741                                                                   DTSCS52
01742      MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-ID.                     DTSCS52
01743                                                                   DTSCS52
01744      MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS52
01745  P8200-EXIT.                                                      DTSCS52
01746      EXIT.                                                        DTSCS52
01747      EJECT                                                        DTSCS52
01748  P8210-CONSTRUCT-MRCT.                                            DTSCS52
01749      MOVE LCCM-SCR52-HOLD-AREA TO MSKL-KEY-AREA.                  DTSCS52
01750                                                                   DTSCS52
01751      PERFORM S810-READ THRU S810-EXIT.                            DTSCS52
01752                                                                   DTSCS52
01753      IF L810-NO-REC-88                                            DTSCS52
01754          GO TO S899-ABEND.                                        DTSCS52
01755                                                                   DTSCS52
01756                                                                   DTSCS52
01757      MOVE MSKL-REC TO MRCT-REC.                                   DTSCS52
01758                                                                   DTSCS52
01759                                                                   DTSCS52
01760      PERFORM P8900-MLOG-INIT THRU P8900-EXIT.                     DTSCS52
01761                                                                   DTSCS52
01762                                                                   DTSCS52
01763      IF MAP-ACTIVE-IND NOT = MRCT-ACTIVE-IND                      DTSCS52
01764         MOVE MRCT-ACTIVE-IND TO L331-FROM-VALUE                   DTSCS52
01765         MOVE MAP-ACTIVE-IND TO MRCT-ACTIVE-IND                    DTSCS52
01766         PERFORM P8900-MLOG-ACTIVE-IND THRU P8900-EXIT.            DTSCS52
01767                                                                   DTSCS52
01768                                                                   DTSCS52
01769      MOVE MAP-PRIOR-RESERVE-CHNG-AREA TO L011-S-AMT-AREA.         DTSCS52
01770                                                                   DTSCS52
01771      PERFORM S011-MAX-LIMITS THRU S011-EXIT.                      DTSCS52
01772                                                                   DTSCS52
01773      IF L011-AMT NOT = +0                                         DTSCS52
01774          MOVE MRCT-PRIOR-RESERVE-AMT TO WRK-NUM-N                 DTSCS52
01775          MOVE WRK-NUM-N TO L331-FROM-VALUE                        DTSCS52
01776          ADD L011-AMT TO MRCT-PRIOR-RESERVE-AMT                   DTSCS52
01777          PERFORM P8900-MLOG-PRIOR-RESERVE-AMT THRU P8900-EXIT.    DTSCS52
01778                                                                   DTSCS52
01779                                                                   DTSCS52
01780      MOVE MAP-UI-TAX-PAID-CHNG-AREA TO L011-S-AMT-AREA.           DTSCS52
01781                                                                   DTSCS52
01782      PERFORM S011-MAX-LIMITS THRU S011-EXIT.                      DTSCS52
01783                                                                   DTSCS52
01784      IF L011-AMT NOT = +0                                         DTSCS52
01785          MOVE MRCT-UI-TAX-PAID-AMT TO WRK-NUM-N                   DTSCS52
01786          MOVE WRK-NUM-N TO L331-FROM-VALUE                        DTSCS52
01787          ADD L011-AMT TO MRCT-UI-TAX-PAID-AMT                     DTSCS52
01788          PERFORM P8900-MLOG-UI-TAX-PAID-AMT THRU P8900-EXIT.      DTSCS52
01789                                                                   DTSCS52
01790                                                                   DTSCS52
01791      MOVE MAP-TRUST-FUND-INT-CHNG-AREA TO L011-S-AMT-AREA.        DTSCS52
01792                                                                   DTSCS52
01793      PERFORM S011-MAX-LIMITS THRU S011-EXIT.                      DTSCS52
01794                                                                   DTSCS52
01795      IF L011-AMT NOT = +0                                         DTSCS52
01796          MOVE MRCT-TRUST-FUND-INTEREST-AMT TO WRK-NUM-N           DTSCS52
01797          MOVE WRK-NUM-N TO L331-FROM-VALUE                        DTSCS52
01798          ADD L011-AMT TO MRCT-TRUST-FUND-INTEREST-AMT             DTSCS52
01799          PERFORM P8900-MLOG-TRUST-FUND-INT-AMT THRU P8900-EXIT.   DTSCS52
01800                                                                   DTSCS52
01801                                                                   DTSCS52
01802      MOVE MAP-UI-BEN-CHRGD-CHNG-AREA TO L011-S-AMT-AREA.          DTSCS52
01803                                                                   DTSCS52
01804      PERFORM S011-MAX-LIMITS THRU S011-EXIT.                      DTSCS52
01805                                                                   DTSCS52
01806      IF L011-AMT NOT = +0                                         DTSCS52
01807          MOVE MRCT-BENEFITS-CHARGED-AMT TO WRK-NUM-N              DTSCS52
01808          MOVE WRK-NUM-N TO L331-FROM-VALUE                        DTSCS52
01809          ADD L011-AMT TO MRCT-BENEFITS-CHARGED-AMT                DTSCS52
01810          PERFORM P8900-MLOG-BENEFITS-CHRGD-AMT THRU P8900-EXIT.   DTSCS52
01811                                                                   DTSCS52
01812                                                                   DTSCS52
01813      PERFORM                                                      DTSCS52
01814        VARYING WRK-CTR FROM 1 BY 1                                DTSCS52
01815        UNTIL WRK-CTR > 3                                          DTSCS52
01816             MOVE MAP-TOT-WAGE-CHNG-AREA (WRK-CTR)                 DTSCS52
01817               TO L011-S-AMT-AREA                                  DTSCS52
01818             PERFORM S011-MAX-LIMITS THRU S011-EXIT                DTSCS52
01819             IF L011-AMT NOT = +0                                  DTSCS52
01820                MOVE MRCT-TOT-WAGE (WRK-CTR) TO WRK-NUM-N          DTSCS52
01821                MOVE WRK-NUM-N TO L331-FROM-VALUE                  DTSCS52
01822                ADD L011-AMT TO MRCT-TOT-WAGE (WRK-CTR)            DTSCS52
01823                PERFORM P8900-MLOG-TOT-WAGE THRU P8900-EXIT        DTSCS52
01824             END-IF                                                DTSCS52
01825             MOVE MAP-TAX-WAGE-CHNG-AREA (WRK-CTR)                 DTSCS52
01826               TO L011-S-AMT-AREA                                  DTSCS52
01827             PERFORM S011-MAX-LIMITS THRU S011-EXIT                DTSCS52
01828             IF L011-AMT NOT = +0                                  DTSCS52
01829                MOVE MRCT-TAX-WAGE (WRK-CTR) TO WRK-NUM-N          DTSCS52
01830                MOVE WRK-NUM-N TO L331-FROM-VALUE                  DTSCS52
01831                ADD L011-AMT TO MRCT-TAX-WAGE (WRK-CTR)            DTSCS52
01832                PERFORM P8900-MLOG-TAX-WAGE THRU P8900-EXIT        DTSCS52
01833             END-IF                                                DTSCS52
01834      END-PERFORM.                                                 DTSCS52
01835                                                                   DTSCS52
01836                                                                   DTSCS52
01837      MOVE MAP-EARLIEST-LIAB-DATE-AREA TO L015-S-DATE-AREA.        DTSCS52
01838                                                                   DTSCS52
01839      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS52
01840                                                                   DTSCS52
01841      IF L015-DATE NOT = MRCT-EARLIEST-LIAB-DATE                   DTSCS52
01842          MOVE MRCT-EARLIEST-LIAB-DATE TO L001-FED-8-DATE-9        DTSCS52
01843          PERFORM S001-FROM-FED-8 THRU S001-EXIT                   DTSCS52
01844          MOVE L001-SLASH-8-DATE TO L331-FROM-VALUE                DTSCS52
01845          MOVE L015-DATE TO MRCT-EARLIEST-LIAB-DATE                DTSCS52
01846          PERFORM P8900-MLOG-EARLIEST-LIAB-DATE THRU P8900-EXIT.   DTSCS52
01847                                                                   DTSCS52
01848                                                                   DTSCS52
01849      MOVE MAP-MISS-RPT-CNT-AREA TO L013-S-CNT-AREA.               DTSCS52
01850                                                                   DTSCS52
01851      PERFORM S013-MAX-LIMITS THRU S013-EXIT.                      DTSCS52
01852                                                                   DTSCS52
01853      IF L013-CNT NOT = MRCT-MISS-RPT-CNT                          DTSCS52
01854          MOVE MRCT-MISS-RPT-CNT TO WRK-MISS-RPT-CNT-N             DTSCS52
01855          MOVE WRK-MISS-RPT-CNT-N TO L331-FROM-VALUE               DTSCS52
01856          MOVE L013-CNT TO MRCT-MISS-RPT-CNT                       DTSCS52
01857          PERFORM P8900-MLOG-MISS-RPT-CNT THRU P8900-EXIT.         DTSCS52
01858                                                                   DTSCS52
01859                                                                   DTSCS52
01860      MOVE MAP-UI-TAX-DUE-AREA TO L011-S-AMT-AREA.                 DTSCS52
01861                                                                   DTSCS52
01862      PERFORM S011-MAX-LIMITS THRU S011-EXIT.                      DTSCS52
01863                                                                   DTSCS52
01864      IF L011-AMT NOT = MRCT-TOT-UI-TAX-BALANCE-AMT                DTSCS52
01865          MOVE MRCT-TOT-UI-TAX-BALANCE-AMT TO WRK-NUM-N            DTSCS52
01866          MOVE WRK-NUM-N TO L331-FROM-VALUE                        DTSCS52
01867          MOVE L011-AMT TO MRCT-TOT-UI-TAX-BALANCE-AMT             DTSCS52
01868          PERFORM P8900-MLOG-TOT-DUE-AMT THRU P8900-EXIT.          DTSCS52
01869                                                                   DTSCS52
01870                                                                   DTSCS52
01871      IF MAP-PRED-DUE-IND NOT = MRCT-PRED-DUE-IND                  DTSCS52
01872          MOVE MRCT-PRED-DUE-IND TO L331-FROM-VALUE                DTSCS52
01873          MOVE MAP-PRED-DUE-IND TO MRCT-PRED-DUE-IND               DTSCS52
01874          PERFORM P8900-MLOG-PRED-DUE-IND THRU P8900-EXIT.         DTSCS52
01875                                                                   DTSCS52
01876                                                                   DTSCS52
01877      MOVE MAP-TRNSF-TO-EMP-NO-AREA TO L018-S-EMP-NO-AREA.         DTSCS52
01878                                                                   DTSCS52
01879      PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT.              DTSCS52
01880                                                                   DTSCS52
01881      IF L018-EMP-NO NOT = MRCT-TRANSFERRED-TO-EMP-NO              DTSCS52
01882          MOVE MRCT-TRANSFERRED-TO-EMP-NO TO WRK-DISPLAY           DTSCS52
01883          MOVE SPACES TO L331-FROM-VALUE                           DTSCS52
01884          STRING                                                   DTSCS52
01885              WRK-DISPLAY-EMP-NO-1 DELIMITED BY SIZE               DTSCS52
01886              ' '                  DELIMITED BY SIZE               DTSCS52
01887              WRK-DISPLAY-EMP-NO-2 DELIMITED BY SIZE               DTSCS52
01888            INTO                                                   DTSCS52
01889              L331-FROM-VALUE                                      DTSCS52
01890          END-STRING                                               DTSCS52
01891          MOVE L018-EMP-NO TO MRCT-TRANSFERRED-TO-EMP-NO           DTSCS52
01892          PERFORM P8900-MLOG-TRNSFR-TO-EMP-NO THRU P8900-EXIT.     DTSCS52
01893                                                                   DTSCS52
01894                                                                   DTSCS52
01895      MOVE LCCM-OP-ID TO MRCT-CHNG-OP-ID                           DTSCS52
01896                                                                   DTSCS52
01897      MOVE LCCM-CURR-RUN-DATE TO MRCT-CHNG-DATE.                   DTSCS52
01898  P8210-EXIT.                                                      DTSCS52
01899      EXIT.                                                        DTSCS52
01900      EJECT                                                        DTSCS52
01901  P8220-REVERSE-PSEUDO-UPDATE.                                     DTSCS52
01902      MOVE LCCM-SCR52-HOLD-AREA TO MSKL-KEY-AREA.                  DTSCS52
01903                                                                   DTSCS52
01904      PERFORM S810-READ THRU S810-EXIT.                            DTSCS52
01905                                                                   DTSCS52
01906      IF L810-NO-REC-88                                            DTSCS52
01907          GO TO P8220-EXIT.                                        DTSCS52
01908                                                                   DTSCS52
01909      MOVE MSKL-REC TO MRCT-REC.                                   DTSCS52
01910                                                                   DTSCS52
01911                                                                   DTSCS52
01912      PERFORM P6921-MISC-INFO THRU P6921-EXIT.                     DTSCS52
01913  P8220-EXIT.                                                      DTSCS52
01914      EXIT.                                                        DTSCS52
01915 /*****************************************************************DTSCS52
01916 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS        *DTSCS52
01917 ******************************************************************DTSCS52
01918                                                                   DTSCS52
01919  P8300-DEL.                                                       DTSCS52
01920      SET LCCM-SCR-INQUIRE TO TRUE.                                DTSCS52
01921                                                                   DTSCS52
01922      PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.              DTSCS52
01923                                                                   DTSCS52
01924                                                                   DTSCS52
01925      IF LCCM-F12-88                                               DTSCS52
01926         MOVE PMSG-DEL-CANCELED TO LCCM-MSG-ID                     DTSCS52
01927         GO TO P8300-EXIT.                                         DTSCS52
01928                                                                   DTSCS52
01929                                                                   DTSCS52
01930      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS52
01931                                                                   DTSCS52
01932                                                                   DTSCS52
01933      MOVE 'D' TO L221-UPDATE-FUNCTION.                            DTSCS52
01934                                                                   DTSCS52
01935      PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT.                 DTSCS52
01936                                                                   DTSCS52
01937      IF LCCM-MSG                                                  DTSCS52
01938          GO TO P8300-EXIT.                                        DTSCS52
01939                                                                   DTSCS52
01940                                                                   DTSCS52
01941      PERFORM S1110-READ-MPRF THRU S1110-EXIT.                     DTSCS52
01942                                                                   DTSCS52
01943      MOVE LCCM-SCR52-HOLD-AREA TO MSKL-KEY-AREA.                  DTSCS52
01944                                                                   DTSCS52
01945      PERFORM S810-READ THRU S810-EXIT.                            DTSCS52
01946                                                                   DTSCS52
01947      IF L810-NO-REC-88                                            DTSCS52
01948          GO TO S899-ABEND.                                        DTSCS52
01949                                                                   DTSCS52
01950                                                                   DTSCS52
01951      MOVE MSKL-REC TO MRCT-REC.                                   DTSCS52
01952                                                                   DTSCS52
01953                                                                   DTSCS52
01954      PERFORM S810-DELETE THRU S810-EXIT.                          DTSCS52
01955                                                                   DTSCS52
01956                                                                   DTSCS52
01957      PERFORM P8900-MLOG-INIT THRU P8900-EXIT.                     DTSCS52
01958                                                                   DTSCS52
01959      MOVE 'MRCT' TO L331-FIELD-NAME.                              DTSCS52
01960                                                                   DTSCS52
01961      MOVE 'RECORD DELETED ' TO L331-FROM-VALUE.                   DTSCS52
01962                                                                   DTSCS52
01963      MOVE SPACES TO L331-TO-VALUE.                                DTSCS52
01964                                                                   DTSCS52
01965      PERFORM P8900-MLOG-WRITE THRU P8900-EXIT.                    DTSCS52
01966                                                                   DTSCS52
01967                                                                   DTSCS52
01968      PERFORM S221-EMP-UNLOCK THRU S221-EXIT.                      DTSCS52
01969                                                                   DTSCS52
01970                                                                   DTSCS52
01971      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS52
01972                                                                   DTSCS52
01973                                                                   DTSCS52
01974      MOVE WRK-EMP-NO TO WRK-DISPLAY.                              DTSCS52
01975                                                                   DTSCS52
01976      MOVE WRK-DISPLAY-EMP-NO-1 TO MAP-EMP-NO-1.                   DTSCS52
01977                                                                   DTSCS52
01978      MOVE WRK-DISPLAY-EMP-NO-2 TO MAP-EMP-NO-2.                   DTSCS52
01979                                                                   DTSCS52
01980                                                                   DTSCS52
01981      MOVE MRCT-EFF-YRQ TO WRK-DISPLAY.                            DTSCS52
01982                                                                   DTSCS52
01983      MOVE WRK-DISPLAY-QTR-YR TO MAP-EFF-QTR-YR.                   DTSCS52
01984                                                                   DTSCS52
01985      MOVE WRK-DISPLAY-QTR-Q TO MAP-EFF-QTR-Q.                     DTSCS52
01986                                                                   DTSCS52
01987                                                                   DTSCS52
01988      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS52
01989                                                                   DTSCS52
01990      PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.              DTSCS52
01991                                                                   DTSCS52
01992      MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS52
01993                                                                   DTSCS52
01994      MOVE PMSG-DEL-SUCCESSFUL TO LCCM-MSG-ID.                     DTSCS52
01995  P8300-EXIT.                                                      DTSCS52
01996      EXIT.                                                        DTSCS52
01997      EJECT                                                        DTSCS52
01998  P8810-LOCK-EMPLOYER.                                             DTSCS52
01999      MOVE WRK-EMP-NO TO L221-EMP-NO.                              DTSCS52
02000                                                                   DTSCS52
02001      MOVE LCCM-SCR-ABSTIME TO L221-SCR-ABSTIME.                   DTSCS52
02002                                                                   DTSCS52
02003      MOVE LCCM-TASK-ID TO L221-UPDATE-TASK-ID.                    DTSCS52
02004                                                                   DTSCS52
02005      MOVE LCCM-OP-ID TO L221-UPDATE-OP-ID.                        DTSCS52
02006                                                                   DTSCS52
02007      MOVE LCCM-CICS-TERM-ID TO L221-UPDATE-TERMID.                DTSCS52
02008                                                                   DTSCS52
02009      MOVE LCCM-TASK-NETNAME TO L221-UPDATE-NETNAME.               DTSCS52
02010                                                                   DTSCS52
02011      MOVE LCCM-TASK-START-DATE TO L221-UPDATE-START-DATE.         DTSCS52
02012                                                                   DTSCS52
02013      MOVE LCCM-TASK-START-TIME TO L221-UPDATE-START-TIME.         DTSCS52
02014                                                                   DTSCS52
02015      MOVE WRK-SCR-ID TO L221-UPDATE-SCR-ID.                       DTSCS52
02016                                                                   DTSCS52
02017      PERFORM S221-EMP-LOCK THRU S221-EXIT.                        DTSCS52
02018  P8810-EXIT.                                                      DTSCS52
02019      EXIT.                                                        DTSCS52
02020      EJECT                                                        DTSCS52
02021  P8900-MLOG-INIT.                                                 DTSCS52
02022      MOVE WRK-EMP-NO TO L331-EMP-NO.                              DTSCS52
02023      MOVE LCCM-CURR-RUN-DATE TO L331-CURR-RUN-DATE.               DTSCS52
02024      MOVE LCCM-TASK-START-ABSTIME TO L331-UPDATE-ABSTIME.         DTSCS52
02025      MOVE LCCM-OP-ID TO L331-OP-ID.                               DTSCS52
02026      MOVE MRCT-EFF-YRQ TO L004-QTR-5-9.                           DTSCS52
02027      PERFORM S004-FROM-5 THRU S004-EXIT.                          DTSCS52
02028      MOVE L004-SLASH-5-QTR TO L331-REC-OCC-ID.                    DTSCS52
02029      MOVE SPACE TO L331-FROM-VALUE.                               DTSCS52
02030      GO TO P8900-EXIT.                                            DTSCS52
02031                                                                   DTSCS52
02032  P8900-MLOG-ACTIVE-IND.                                           DTSCS52
02033      MOVE 'MRCT-ACTIVE-IND     ' TO L331-FIELD-NAME.              DTSCS52
02034      MOVE MAP-ACTIVE-IND TO L331-TO-VALUE.                        DTSCS52
02035      GO TO P8900-MLOG-WRITE.                                      DTSCS52
02036                                                                   DTSCS52
02037  P8900-MLOG-PRIOR-RESERVE-AMT.                                    DTSCS52
02038      MOVE 'MRCT-PRIOR-RESERVE-AMT' TO L331-FIELD-NAME.            DTSCS52
02039      MOVE MRCT-PRIOR-RESERVE-AMT TO WRK-NUM-N.                    DTSCS52
02040      MOVE WRK-NUM-N TO L331-TO-VALUE.                             DTSCS52
02041      GO TO P8900-MLOG-WRITE.                                      DTSCS52
02042                                                                   DTSCS52
02043  P8900-MLOG-UI-TAX-PAID-AMT.                                      DTSCS52
02044      MOVE 'MRCT-UI-TAX-PAID-AMT' TO L331-FIELD-NAME.              DTSCS52
02045      MOVE MRCT-UI-TAX-PAID-AMT TO WRK-NUM-N.                      DTSCS52
02046      MOVE WRK-NUM-N TO L331-TO-VALUE.                             DTSCS52
02047      GO TO P8900-MLOG-WRITE.                                      DTSCS52
02048                                                                   DTSCS52
02049  P8900-MLOG-TRUST-FUND-INT-AMT.                                   DTSCS52
02050      MOVE 'MRCT-TRUST-FUND-INTEREST-AMT' TO L331-FIELD-NAME.      DTSCS52
02051      MOVE MRCT-TRUST-FUND-INTEREST-AMT TO WRK-NUM-N.              DTSCS52
02052      MOVE WRK-NUM-N TO L331-TO-VALUE.                             DTSCS52
02053      GO TO P8900-MLOG-WRITE.                                      DTSCS52
02054                                                                   DTSCS52
02055  P8900-MLOG-BENEFITS-CHRGD-AMT.                                   DTSCS52
02056      MOVE 'MRCT-BENEFITS-CHARGED-AMT' TO L331-FIELD-NAME.         DTSCS52
02057      MOVE MRCT-BENEFITS-CHARGED-AMT TO WRK-NUM-N.                 DTSCS52
02058      MOVE WRK-NUM-N TO L331-TO-VALUE.                             DTSCS52
02059      GO TO P8900-MLOG-WRITE.                                      DTSCS52
02060                                                                   DTSCS52
02061  P8900-MLOG-TOT-WAGE.                                             DTSCS52
02062      MOVE 'MRCT-TOT-WAGE ' TO WRK-LABEL-AREA.                     DTSCS52
02063      MOVE '(' TO WRK-LABEL-LEFT-PAREN.                            DTSCS52
02064      MOVE WRK-CTR TO WRK-LABEL-OCC.                               DTSCS52
02065      MOVE ')' TO WRK-LABEL-RIGHT-PAREN.                           DTSCS52
02066      MOVE WRK-LABEL-AREA TO L331-FIELD-NAME.                      DTSCS52
02067      MOVE MRCT-TOT-WAGE (WRK-CTR) TO WRK-NUM-N.                   DTSCS52
02068      MOVE WRK-NUM-N TO L331-TO-VALUE.                             DTSCS52
02069      GO TO P8900-MLOG-WRITE.                                      DTSCS52
02070                                                                   DTSCS52
02071  P8900-MLOG-TAX-WAGE.                                             DTSCS52
02072      MOVE 'MRCT-TAX-WAGE ' TO WRK-LABEL-AREA.                     DTSCS52
02073      MOVE '(' TO WRK-LABEL-LEFT-PAREN.                            DTSCS52
02074      MOVE WRK-CTR TO WRK-LABEL-OCC.                               DTSCS52
02075      MOVE ')' TO WRK-LABEL-RIGHT-PAREN.                           DTSCS52
02076      MOVE WRK-LABEL-AREA TO L331-FIELD-NAME.                      DTSCS52
02077      MOVE MRCT-TAX-WAGE(WRK-CTR) TO WRK-NUM-N.                    DTSCS52
02078      MOVE WRK-NUM-N TO L331-TO-VALUE.                             DTSCS52
02079      GO TO P8900-MLOG-WRITE.                                      DTSCS52
02080                                                                   DTSCS52
02081  P8900-MLOG-EARLIEST-LIAB-DATE.                                   DTSCS52
02082      MOVE 'MRCT-EARLIEST-LIAB-DATE' TO L331-FIELD-NAME.           DTSCS52
02083      MOVE MRCT-EARLIEST-LIAB-DATE TO L001-FED-8-DATE-9.           DTSCS52
02084      PERFORM S001-FROM-FED-8 THRU S001-EXIT.                      DTSCS52
02085      MOVE L001-SLASH-8-DATE TO L331-TO-VALUE.                     DTSCS52
02086      GO TO P8900-MLOG-WRITE.                                      DTSCS52
02087                                                                   DTSCS52
02088  P8900-MLOG-MISS-RPT-CNT.                                         DTSCS52
02089      MOVE 'MRCT-MISS-RPT-CNT    ' TO L331-FIELD-NAME.             DTSCS52
02090      MOVE MRCT-MISS-RPT-CNT TO WRK-MISS-RPT-CNT-N.                DTSCS52
02091      MOVE WRK-MISS-RPT-CNT-N TO L331-TO-VALUE.                    DTSCS52
02092      GO TO P8900-MLOG-WRITE.                                      DTSCS52
02093                                                                   DTSCS52
02094  P8900-MLOG-TOT-DUE-AMT.                                          DTSCS52
02095      MOVE 'MRCT-TOT-UI-TAX-BALANCE-AMT' TO L331-FIELD-NAME.       DTSCS52
02096      MOVE MRCT-TOT-UI-TAX-BALANCE-AMT TO WRK-NUM-N.               DTSCS52
02097      MOVE WRK-NUM-N TO L331-TO-VALUE.                             DTSCS52
02098      GO TO P8900-MLOG-WRITE.                                      DTSCS52
02099                                                                   DTSCS52
02100  P8900-MLOG-PRED-DUE-IND.                                         DTSCS52
02101      MOVE 'MRCT-PRED-DUE-IND    ' TO L331-FIELD-NAME.             DTSCS52
02102      MOVE MRCT-PRED-DUE-IND TO L331-TO-VALUE.                     DTSCS52
02103      GO TO P8900-MLOG-WRITE.                                      DTSCS52
02104                                                                   DTSCS52
02105  P8900-MLOG-TRNSFR-TO-EMP-NO.                                     DTSCS52
02106      MOVE 'MRCT-TRANSFERRED-TO-EMP-NO' TO L331-FIELD-NAME.        DTSCS52
02107      MOVE MRCT-TRANSFERRED-TO-EMP-NO TO WRK-DISPLAY.              DTSCS52
02108      MOVE SPACES TO L331-TO-VALUE.                                DTSCS52
02109      STRING                                                       DTSCS52
02110          WRK-DISPLAY-EMP-NO-1 DELIMITED BY SIZE                   DTSCS52
02111          ' '                  DELIMITED BY SIZE                   DTSCS52
02112          WRK-DISPLAY-EMP-NO-2 DELIMITED BY SIZE                   DTSCS52
02113        INTO                                                       DTSCS52
02114          L331-TO-VALUE.                                           DTSCS52
02115      GO TO P8900-EXIT.                                            DTSCS52
02116                                                                   DTSCS52
02117  P8900-MLOG-WRITE.                                                DTSCS52
02118      IF LCCM-SCR-UPDATE-LOCKED                                    DTSCS52
02119         GO TO P8900-EXIT.                                         DTSCS52
02120                                                                   DTSCS52
02121      PERFORM S331-WRITE-MLOG THRU S331-EXIT.                      DTSCS52
02122  P8900-EXIT.                                                      DTSCS52
02123      EXIT.                                                        DTSCS52
02124 /*****************************************************************DTSCS52
02125 * LINKS TO UTILITY MODULES                                        DTSCS52
02126 ******************************************************************DTSCS52
02127                                                                   DTSCS52
02128  S001-FROM-FED-8.                                                 DTSCS52
02129      SET L001-FROM-FED-8 TO TRUE.                                 DTSCS52
02130      GO TO S001-DATE.                                             DTSCS52
02131                                                                   DTSCS52
02132  S001-FROM-ABS-DATE.                                              DTSCS52
02133      SET L001-FROM-ABS-DAY TO TRUE.                               DTSCS52
02134      GO TO S001-DATE.                                             DTSCS52
02135                                                                   DTSCS52
02136  S001-DATE.                                                       DTSCS52
02137      EXEC CICS LINK                                               DTSCS52
02138          PROGRAM('DTSCU001')                                      DTSCS52
02139          COMMAREA(L001-COMM-AREA)                                 DTSCS52
02140      END-EXEC.                                                    DTSCS52
02141  S001-EXIT.                                                       DTSCS52
02142      EXIT.                                                        DTSCS52
02143                                                                   DTSCS52
02144                                                                   DTSCS52
02145                                                                   DTSCS52
02146  S004-FROM-5.                                                     DTSCS52
02147      SET L004-FROM-5 TO TRUE.                                     DTSCS52
02148      GO TO S004-YRQ.                                              DTSCS52
02149                                                                   DTSCS52
02150  S004-FROM-ABS.                                                   DTSCS52
02151      SET L004-FROM-ABS TO TRUE.                                   DTSCS52
02152      GO TO S004-YRQ.                                              DTSCS52
02153                                                                   DTSCS52
02154  S004-FROM-DATE.                                                  DTSCS52
02155      SET L004-FROM-DATE TO TRUE.                                  DTSCS52
02156      GO TO S004-YRQ.                                              DTSCS52
02157                                                                   DTSCS52
02158  S004-YRQ.                                                        DTSCS52
02159      EXEC CICS LINK                                               DTSCS52
02160          PROGRAM('DTSCU004')                                      DTSCS52
02161          COMMAREA(L004-COMM-AREA)                                 DTSCS52
02162      END-EXEC.                                                    DTSCS52
02163  S004-EXIT.                                                       DTSCS52
02164      EXIT.                                                        DTSCS52
02165                                                                   DTSCS52
02166                                                                   DTSCS52
02167                                                                   DTSCS52
02168  S006-RATE-PERIOD.                                                DTSCS52
02169      SET L006-FROM-QTR TO TRUE.                                   DTSCS52
02170                                                                   DTSCS52
02171      EXEC CICS LINK                                               DTSCS52
02172          PROGRAM('DTSCU006')                                      DTSCS52
02173          COMMAREA(L006-COMM-AREA)                                 DTSCS52
02174      END-EXEC.                                                    DTSCS52
02175  S006-EXIT.                                                       DTSCS52
02176      EXIT.                                                        DTSCS52
02177                                                                   DTSCS52
02178                                                                   DTSCS52
02179  S011-MAX-LIMITS.                                                 DTSCS52
02180      MOVE -99999999999.99 TO L011-MIN-AMT.                        DTSCS52
02181      MOVE +99999999999.99 TO L011-MAX-AMT.                        DTSCS52
02182                                                                   DTSCS52
02183  S011-AMOUNT-FROM-SCREEN.                                         DTSCS52
02184      EXEC CICS LINK                                               DTSCS52
02185          PROGRAM('DTSCU011')                                      DTSCS52
02186          COMMAREA(L011-COMM-AREA)                                 DTSCS52
02187      END-EXEC.                                                    DTSCS52
02188  S011-EXIT.                                                       DTSCS52
02189      EXIT.                                                        DTSCS52
02190                                                                   DTSCS52
02191                                                                   DTSCS52
02192  S013-MAX-LIMITS.                                                 DTSCS52
02193      MOVE -999 TO L013-MIN-CNT.                                   DTSCS52
02194      MOVE +999 TO L013-MAX-CNT.                                   DTSCS52
02195                                                                   DTSCS52
02196  S013-COUNT-FROM-SCREEN.                                          DTSCS52
02197      EXEC CICS LINK                                               DTSCS52
02198          PROGRAM('DTSCU013')                                      DTSCS52
02199          COMMAREA(L013-COMM-AREA)                                 DTSCS52
02200      END-EXEC.                                                    DTSCS52
02201  S013-EXIT.                                                       DTSCS52
02202      EXIT.                                                        DTSCS52
02203                                                                   DTSCS52
02204                                                                   DTSCS52
02205                                                                   DTSCS52
02206  S015-DATE-FROM-SCREEN.                                           DTSCS52
02207      EXEC CICS LINK                                               DTSCS52
02208          PROGRAM('DTSCU015')                                      DTSCS52
02209          COMMAREA(L015-COMM-AREA)                                 DTSCS52
02210      END-EXEC.                                                    DTSCS52
02211  S015-EXIT.                                                       DTSCS52
02212      EXIT.                                                        DTSCS52
02213                                                                   DTSCS52
02214                                                                   DTSCS52
02215                                                                   DTSCS52
02216  S016-QTR-FROM-SCREEN.                                            DTSCS52
02217      EXEC CICS LINK                                               DTSCS52
02218          PROGRAM('DTSCU016')                                      DTSCS52
02219          COMMAREA(L016-COMM-AREA)                                 DTSCS52
02220      END-EXEC.                                                    DTSCS52
02221  S016-EXIT.                                                       DTSCS52
02222      EXIT.                                                        DTSCS52
02223                                                                   DTSCS52
02224                                                                   DTSCS52
02225                                                                   DTSCS52
02226  S018-EMP-NO-FROM-SCREEN.                                         DTSCS52
02227      EXEC CICS LINK                                               DTSCS52
02228          PROGRAM('DTSCU018')                                      DTSCS52
02229          COMMAREA(L018-COMM-AREA)                                 DTSCS52
02230      END-EXEC.                                                    DTSCS52
02231  S018-EXIT.                                                       DTSCS52
02232      EXIT.                                                        DTSCS52
02233                                                                   DTSCS52
02234                                                                   DTSCS52
02235                                                                   DTSCS52
02236  S054-RATE-DETERMINATION.                                         DTSCS52
02237      EXEC CICS LINK                                               DTSCS52
02238          PROGRAM('DTSCU054')                                      DTSCS52
02239          COMMAREA(L054-COMM-AREA)                                 DTSCS52
02240      END-EXEC.                                                    DTSCS52
02241                                                                   DTSCS52
02242      IF L054-FILE-CLOSED-88                                       DTSCS52
02243          MOVE L054-MSG-AREA TO LCCM-MSG-AREA                      DTSCS52
02244          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS52
02245          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS52
02246          GO TO MAINLINE-EXIT.                                     DTSCS52
02247  S054-EXIT.                                                       DTSCS52
02248      EXIT.                                                        DTSCS52
02249                                                                   DTSCS52
02250                                                                   DTSCS52
02251                                                                   DTSCS52
02252  S055-EXPERIENCE-PERIODS.                                         DTSCS52
02253      SET L055-FROM-EFF-YRQ-88 TO TRUE.                            DTSCS52
02254                                                                   DTSCS52
02255      EXEC CICS LINK                                               DTSCS52
02256          PROGRAM('DTSCU055')                                      DTSCS52
02257          COMMAREA(L055-COMM-AREA)                                 DTSCS52
02258      END-EXEC.                                                    DTSCS52
02259  S055-EXIT.                                                       DTSCS52
02260      EXIT.                                                        DTSCS52
02261                                                                   DTSCS52
02262                                                                   DTSCS52
02263                                                                   DTSCS52
02264  S056-RATE-DISPLAY-RIGHT.                                         DTSCS52
02265      SET L056-DISP1-RIGHT-88 TO TRUE.                             DTSCS52
02266      GO TO S056-RATE-DISPLAY.                                     DTSCS52
02267                                                                   DTSCS52
02268  S056-RATE-DISPLAY-LEFT.                                          DTSCS52
02269      SET L056-DISP1-LEFT-88 TO TRUE.                              DTSCS52
02270      GO TO S056-RATE-DISPLAY.                                     DTSCS52
02271                                                                   DTSCS52
02272  S056-RATE-DISPLAY.                                               DTSCS52
02273      EXEC CICS LINK                                               DTSCS52
02274          PROGRAM('DTSCU056')                                      DTSCS52
02275          COMMAREA(L056-COMM-AREA)                                 DTSCS52
02276      END-EXEC.                                                    DTSCS52
02277  S056-EXIT.                                                       DTSCS52
02278      EXIT.                                                        DTSCS52
02279                                                                   DTSCS52
02280                                                                   DTSCS52
02281                                                                   DTSCS52
02282  S057-RESERVE-RATIO-DISPLAY.                                      DTSCS52
02283      EXEC CICS LINK                                               DTSCS52
02284          PROGRAM('DTSCU057')                                      DTSCS52
02285          COMMAREA(L057-COMM-AREA)                                 DTSCS52
02286      END-EXEC.                                                    DTSCS52
02287  S057-EXIT.                                                       DTSCS52
02288      EXIT.                                                        DTSCS52
02289                                                                   DTSCS52
02290                                                                   DTSCS52
02291                                                                   DTSCS52
02292  S221-EMP-LOCK.                                                   DTSCS52
02293      SET L221-START-UPDATE TO TRUE.                               DTSCS52
02294      GO TO S221-EMP-LOCK-UNLOCK.                                  DTSCS52
02295                                                                   DTSCS52
02296  S221-EMP-UNLOCK.                                                 DTSCS52
02297      SET L221-END-UPDATE TO TRUE.                                 DTSCS52
02298      GO TO S221-EMP-LOCK-UNLOCK.                                  DTSCS52
02299                                                                   DTSCS52
02300  S221-EMP-LOCK-UNLOCK.                                            DTSCS52
02301      EXEC CICS LINK                                               DTSCS52
02302          PROGRAM('DTSCU221')                                      DTSCS52
02303          COMMAREA(L221-COMM-AREA)                                 DTSCS52
02304      END-EXEC.                                                    DTSCS52
02305                                                                   DTSCS52
02306      IF L221-FILE-CLOSED                                          DTSCS52
02307          MOVE L221-MSG-AREA TO LCCM-MSG-AREA                      DTSCS52
02308          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS52
02309          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS52
02310          GO TO MAINLINE-EXIT.                                     DTSCS52
02311                                                                   DTSCS52
02312      IF L221-NOT-OK                                               DTSCS52
02313          MOVE L221-MSG-AREA TO LCCM-MSG-AREA.                     DTSCS52
02314  S221-EXIT.                                                       DTSCS52
02315      EXIT.                                                        DTSCS52
02316                                                                   DTSCS52
02317                                                                   DTSCS52
02318                                                                   DTSCS52
02319  S331-WRITE-MLOG.                                                 DTSCS52
02320      EXEC CICS LINK                                               DTSCS52
02321          PROGRAM('DTSCU331')                                      DTSCS52
02322          COMMAREA(L331-COMM-AREA)                                 DTSCS52
02323      END-EXEC.                                                    DTSCS52
02324                                                                   DTSCS52
02325      IF L331-FILE-CLOSED                                          DTSCS52
02326          MOVE L331-MSG-AREA TO LCCM-MSG-AREA                      DTSCS52
02327          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS52
02328          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS52
02329          GO TO MAINLINE-EXIT.                                     DTSCS52
02330  S331-EXIT.                                                       DTSCS52
02331      EXIT.                                                        DTSCS52
02332                                                                   DTSCS52
02333                                                                   DTSCS52
02334                                                                   DTSCS52
02335  S803-REQ-SCR-ID-EDIT.                                            DTSCS52
02336      EXEC CICS LINK                                               DTSCS52
02337          PROGRAM ('DTSCU803')                                     DTSCS52
02338          COMMAREA (DFHCOMMAREA)                                   DTSCS52
02339      END-EXEC.                                                    DTSCS52
02340  S803-EXIT.                                                       DTSCS52
02341      EXIT.                                                        DTSCS52
02342                                                                   DTSCS52
02343                                                                   DTSCS52
02344                                                                   DTSCS52
02345  S804-INVALID-KEY.                                                DTSCS52
02346      EXEC CICS LINK                                               DTSCS52
02347          PROGRAM ('DTSCU804')                                     DTSCS52
02348          COMMAREA (DFHCOMMAREA)                                   DTSCS52
02349      END-EXEC.                                                    DTSCS52
02350  S804-EXIT.                                                       DTSCS52
02351      EXIT.                                                        DTSCS52
02352                                                                   DTSCS52
02353                                                                   DTSCS52
02354                                                                   DTSCS52
02355  S805-MSG-AREA.                                                   DTSCS52
02356      MOVE LCCM-MSG-AREA TO L805-MSG-AREA.                         DTSCS52
02357                                                                   DTSCS52
02358      EXEC CICS LINK                                               DTSCS52
02359          PROGRAM ('DTSCU805')                                     DTSCS52
02360          COMMAREA (L805-COMM-AREA)                                DTSCS52
02361      END-EXEC.                                                    DTSCS52
02362                                                                   DTSCS52
02363      MOVE L805-S-MSG-AREA TO MAP-MSG-AREA.                        DTSCS52
02364  S805-EXIT.                                                       DTSCS52
02365      EXIT.                                                        DTSCS52
02366                                                                   DTSCS52
02367                                                                   DTSCS52
02368                                                                   DTSCS52
02369  S810-READ.                                                       DTSCS52
02370      SET L810-READ-88 TO TRUE.                                    DTSCS52
02371      GO TO S810-IO.                                               DTSCS52
02372                                                                   DTSCS52
02373  S810-START-BROWSE.                                               DTSCS52
02374      SET L810-START-BROWSE-88 TO TRUE.                            DTSCS52
02375      GO TO S810-IO.                                               DTSCS52
02376                                                                   DTSCS52
02377  S810-READ-NEXT.                                                  DTSCS52
02378      SET L810-READ-NEXT-88 TO TRUE.                               DTSCS52
02379      GO TO S810-IO.                                               DTSCS52
02380                                                                   DTSCS52
02381  S810-READ-PREV.                                                  DTSCS52
02382      SET L810-READ-PREV-88 TO TRUE.                               DTSCS52
02383      GO TO S810-IO.                                               DTSCS52
02384                                                                   DTSCS52
02385  S810-END-BROWSE.                                                 DTSCS52
02386      SET L810-END-BROWSE-88 TO TRUE.                              DTSCS52
02387      GO TO S810-IO.                                               DTSCS52
02388                                                                   DTSCS52
02389  S810-COUNT.                                                      DTSCS52
02390      SET L810-COUNT-88 TO TRUE.                                   DTSCS52
02391      GO TO S810-IO.                                               DTSCS52
02392                                                                   DTSCS52
02393  S810-REWRITE.                                                    DTSCS52
02394      SET L810-REWRITE-88 TO TRUE.                                 DTSCS52
02395      GO TO S810-IO.                                               DTSCS52
02396                                                                   DTSCS52
02397  S810-WRITE.                                                      DTSCS52
02398      SET L810-WRITE-88 TO TRUE.                                   DTSCS52
02399      GO TO S810-IO.                                               DTSCS52
02400                                                                   DTSCS52
02401  S810-DELETE.                                                     DTSCS52
02402      SET L810-DELETE-88 TO TRUE.                                  DTSCS52
02403      GO TO S810-IO.                                               DTSCS52
02404                                                                   DTSCS52
02405  S810-IO.                                                         DTSCS52
02406      EXEC CICS LINK                                               DTSCS52
02407          PROGRAM ('DTSCU810')                                     DTSCS52
02408          COMMAREA (L810-COMM-AREA)                                DTSCS52
02409      END-EXEC.                                                    DTSCS52
02410                                                                   DTSCS52
02411      IF L810-FILE-CLOSED-88                                       DTSCS52
02412          MOVE L810-MSG-AREA TO LCCM-MSG-AREA                      DTSCS52
02413          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS52
02414          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS52
02415          GO TO MAINLINE-EXIT.                                     DTSCS52
02416  S810-EXIT.                                                       DTSCS52
02417      EXIT.                                                        DTSCS52
02418                                                                   DTSCS52
02419                                                                   DTSCS52
02420                                                                   DTSCS52
02421 *S825-WRITE.                                                      DTSCS52
02422 *****SET L825-WRITE-88 TO TRUE.                                   DTSCS52
02423 *****GO TO S825-O.                                                DTSCS52
02424                                                                   DTSCS52
02425 *S825-O.                                                          DTSCS52
02426                                                                   DTSCS52
02427 *****COMPUTE L825-LENGTH = L825-CB-LENGTH + RSK1-LENGTH.          DTSCS52
02428                                                                   DTSCS52
02429 *****EXEC CICS LINK                                               DTSCS52
02430 *********PROGRAM ('DTSCU825')                                     DTSCS52
02431 *********COMMAREA (L825-COMM-AREA)                                DTSCS52
02432 *********LENGTH (L825-LENGTH)                                     DTSCS52
02433 *****END-EXEC.                                                    DTSCS52
02434                                                                   DTSCS52
02435 *****IF L825-FILE-CLOSED-88                                       DTSCS52
02436 *********MOVE L825-MSG-AREA TO LCCM-MSG-AREA                      DTSCS52
02437 *********SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS52
02438 *********SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS52
02439 *********GO TO MAINLINE-EXIT.                                     DTSCS52
02440 *S825-EXIT.                                                       DTSCS52
02441 *****EXIT.                                                        DTSCS52
02442                                                                   DTSCS52
02443                                                                   DTSCS52
02444                                                                   DTSCS52
02445  S851-SCREEN-PROCESSING.                                          DTSCS52
02446      EXEC CICS LINK                                               DTSCS52
02447          PROGRAM ('DTSCU851')                                     DTSCS52
02448          COMMAREA (L851-COMM-AREA)                                DTSCS52
02449      END-EXEC.                                                    DTSCS52
02450  S851-EXIT.                                                       DTSCS52
02451      EXIT.                                                        DTSCS52
02452                                                                   DTSCS52
02453                                                                   DTSCS52
02454                                                                   DTSCS52
02455  S899-ABEND.                                                      DTSCS52
02456      EXEC CICS ABEND                                              DTSCS52
02457          ABCODE(WRK-ABEND-CD)                                     DTSCS52
02458      END-EXEC.                                                    DTSCS52
02459  S899-EXIT.                                                       DTSCS52
02460      EXIT.                                                        DTSCS52
02461 /*****************************************************************DTSCS52
02462 *    EDIT THE INFORMATION ON THE SCREEN.                         *DTSCS52
02463 ******************************************************************DTSCS52
02464                                                                   DTSCS52
02465  S1000-SCREEN-EDITS.                                              DTSCS52
02466      PERFORM S1110-READ-MPRF THRU S1110-EXIT.                     DTSCS52
02467                                                                   DTSCS52
02468      IF LCCM-MSG                                                  DTSCS52
02469          GO TO S1000-EXIT.                                        DTSCS52
02470                                                                   DTSCS52
02471                                                                   DTSCS52
02472 *****                                                             DTSCS52
02473 *                                                                 DTSCS52
02474 *    IF EMP CLASS IS NOT RATED, THEN SOME OF THE RATE             DTSCS52
02475 *    UTILITY MODULES BLOW UP.                                     DTSCS52
02476 *                                                                 DTSCS52
02477 *    THIS IS AN EASY FIX.                                         DTSCS52
02478 *                                                                 DTSCS52
02479 *****                                                             DTSCS52
02480                                                                   DTSCS52
02481      IF MPRF-CLASS-RATED-88                                       DTSCS52
02482          NEXT SENTENCE                                            DTSCS52
02483      ELSE                                                         DTSCS52
02484          MOVE MSG-E521-AREA TO WRK-MSG-AREA                       DTSCS52
02485          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS52
02486          GO TO S1000-EXIT.                                        DTSCS52
02487                                                                   DTSCS52
02488                                                                   DTSCS52
02489      PERFORM S1200-EFF-YRQ THRU S1200-EXIT.                       DTSCS52
02490                                                                   DTSCS52
02491      PERFORM S1300-EARLIEST-LIAB-DATE THRU S1300-EXIT.            DTSCS52
02492                                                                   DTSCS52
02493      PERFORM S1400-ACTIVE-IND THRU S1400-EXIT.                    DTSCS52
02494                                                                   DTSCS52
02495      PERFORM S1500-TRNSF-TO-EMP-NO THRU S1500-EXIT.               DTSCS52
02496                                                                   DTSCS52
02497      PERFORM S1600-PRIOR-RESERVE-CHNG THRU S1600-EXIT.            DTSCS52
02498                                                                   DTSCS52
02499      PERFORM S1700-UI-TAX-PAID-CHNG THRU S1700-EXIT.              DTSCS52
02500                                                                   DTSCS52
02501      PERFORM S1800-TRUST-FUND-INT-CHNG THRU S1800-EXIT.           DTSCS52
02502                                                                   DTSCS52
02503      PERFORM S1900-UI-BEN-CHRGD-CHNG THRU S1900-EXIT.             DTSCS52
02504                                                                   DTSCS52
02505      PERFORM S2000-WAGE-CHNG THRU S2000-EXIT                      DTSCS52
02506          VARYING WRK-CTR FROM 1 BY 1                              DTSCS52
02507          UNTIL WRK-CTR > 3.                                       DTSCS52
02508                                                                   DTSCS52
02509      PERFORM S2100-MISS-RPT-CNT THRU S2100-EXIT.                  DTSCS52
02510                                                                   DTSCS52
02511      PERFORM S2200-UI-TAX-DUE THRU S2200-EXIT.                    DTSCS52
02512                                                                   DTSCS52
02513      PERFORM S2300-PRED-DUE-IND THRU S2300-EXIT.                  DTSCS52
02514                                                                   DTSCS52
02515      IF LCCM-MSG                                                  DTSCS52
02516         GO TO S1000-EXIT.                                         DTSCS52
02517                                                                   DTSCS52
02518                                                                   DTSCS52
02519      PERFORM S3100-MISC-EDITS THRU S3100-EXIT.                    DTSCS52
02520  S1000-EXIT.                                                      DTSCS52
02521      EXIT.                                                        DTSCS52
02522      EJECT                                                        DTSCS52
02523  S1100-EDIT-KEY.                                                  DTSCS52
02524      PERFORM S1101-EMP-NO THRU S1101-EXIT.                        DTSCS52
02525  S1100-EXIT.                                                      DTSCS52
02526      EXIT.                                                        DTSCS52
02527 /*****************************************************************DTSCS52
02528 *                                                                 DTSCS52
02529 ******************************************************************DTSCS52
02530                                                                   DTSCS52
02531  S1101-EMP-NO.                                                    DTSCS52
02532      MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA.                  DTSCS52
02533                                                                   DTSCS52
02534      PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT.              DTSCS52
02535                                                                   DTSCS52
02536      IF L018-NO-ENTRY                                             DTSCS52
02537         MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA                  DTSCS52
02538         PERFORM S1199-ERROR THRU S1199-EXIT                       DTSCS52
02539         GO TO S1101-EXIT.                                         DTSCS52
02540                                                                   DTSCS52
02541      IF L018-NOT-VALID                                            DTSCS52
02542         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS52
02543         PERFORM S1199-ERROR THRU S1199-EXIT                       DTSCS52
02544         GO TO S1101-EXIT.                                         DTSCS52
02545                                                                   DTSCS52
02546      MOVE L018-EMP-NO TO WRK-EMP-NO.                              DTSCS52
02547  S1101-EXIT.                                                      DTSCS52
02548      EXIT.                                                        DTSCS52
02549      SKIP3                                                        DTSCS52
02550  S1110-READ-MPRF.                                                 DTSCS52
02551      MOVE LOW-VALUES TO MPRF-KEY-AREA.                            DTSCS52
02552                                                                   DTSCS52
02553      MOVE WRK-EMP-NO TO MPRF-EMP-NO.                              DTSCS52
02554                                                                   DTSCS52
02555      SET MPRF-PRF-88 TO TRUE.                                     DTSCS52
02556                                                                   DTSCS52
02557      MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS52
02558                                                                   DTSCS52
02559      PERFORM S810-READ THRU S810-EXIT.                            DTSCS52
02560                                                                   DTSCS52
02561      IF L810-NO-REC-88                                            DTSCS52
02562          MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA                    DTSCS52
02563          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS52
02564      ELSE                                                         DTSCS52
02565          MOVE MSKL-REC TO MPRF-REC                                DTSCS52
02566          SET WRK-MPRF-YES-88 TO TRUE.                             DTSCS52
02567  S1110-EXIT.                                                      DTSCS52
02568      EXIT.                                                        DTSCS52
02569      SKIP3                                                        DTSCS52
02570  S1199-ERROR.                                                     DTSCS52
02571      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A            DTSCS52
02572                                         MAP-EMP-NO-2-A.           DTSCS52
02573                                                                   DTSCS52
02574      IF LCCM-NO-MSG                                               DTSCS52
02575         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS52
02576         MOVE CATB-CURSOR TO MAP-EMP-NO-1-L                        DTSCS52
02577         SET CURSOR-SET-YES TO TRUE.                               DTSCS52
02578  S1199-EXIT.                                                      DTSCS52
02579      EXIT.                                                        DTSCS52
02580 /*****************************************************************DTSCS52
02581 *                                                                *DTSCS52
02582 ******************************************************************DTSCS52
02583  S1200-EFF-YRQ.                                                   DTSCS52
02584      MOVE MAP-EFF-YRQ-AREA TO L016-S-YRQ-AREA.                    DTSCS52
02585                                                                   DTSCS52
02586      PERFORM S016-QTR-FROM-SCREEN THRU S016-EXIT.                 DTSCS52
02587                                                                   DTSCS52
02588      IF L016-NO-ENTRY                                             DTSCS52
02589         MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA                  DTSCS52
02590         PERFORM S1201-ERROR THRU S1201-EXIT                       DTSCS52
02591      ELSE                                                         DTSCS52
02592      IF L016-NOT-VALID                                            DTSCS52
02593         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS52
02594         PERFORM S1201-ERROR THRU S1201-EXIT                       DTSCS52
02595      ELSE                                                         DTSCS52
02596          MOVE L016-YRQ TO L006-YRQ                                DTSCS52
02597          SET L006-FROM-QTR TO TRUE                                DTSCS52
02598          PERFORM S006-RATE-PERIOD THRU S006-EXIT                  DTSCS52
02599          MOVE L006-RTE-YR-START-DATE TO L001-FED-8-DATE-9         DTSCS52
02600          PERFORM S001-FROM-FED-8 THRU S001-EXIT                   DTSCS52
02601          MOVE L001-SLASH-DATE TO MAP-PERIOD-FROM                  DTSCS52
02602          MOVE L006-RTE-YR-END-DATE TO L001-FED-8-DATE-9           DTSCS52
02603          PERFORM S001-FROM-FED-8 THRU S001-EXIT                   DTSCS52
02604          MOVE L001-SLASH-DATE TO MAP-PERIOD-TO                    DTSCS52
02605          IF L006-RTE-YR-START-YRQ NOT = L016-YRQ                  DTSCS52
02606              MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA            DTSCS52
02607              PERFORM S1201-ERROR THRU S1201-EXIT                  DTSCS52
02608          ELSE                                                     DTSCS52
02609              PERFORM S1220-EXP-QTRS THRU S1220-EXIT.              DTSCS52
02610  S1200-EXIT.                                                      DTSCS52
02611      EXIT.                                                        DTSCS52
02612      SKIP3                                                        DTSCS52
02613  S1201-ERROR.                                                     DTSCS52
02614      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EFF-QTR-YR-A          DTSCS52
02615                                         MAP-EFF-QTR-Q-A.          DTSCS52
02616                                                                   DTSCS52
02617      IF LCCM-NO-MSG                                               DTSCS52
02618         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA.                       DTSCS52
02619         MOVE CATB-CURSOR TO MAP-EFF-QTR-YR-L.                     DTSCS52
02620         SET CURSOR-SET-YES TO TRUE.                               DTSCS52
02621  S1201-EXIT.                                                      DTSCS52
02622      EXIT.                                                        DTSCS52
02623      SKIP3                                                        DTSCS52
02624  S1220-EXP-QTRS.                                                  DTSCS52
02625      MOVE L016-YRQ TO L055-EFF-YRQ.                               DTSCS52
02626                                                                   DTSCS52
02627      PERFORM S055-EXPERIENCE-PERIODS THRU S055-EXIT.              DTSCS52
02628                                                                   DTSCS52
02629                                                                   DTSCS52
02630      MOVE L055-PRIOR-RESERVE-THRU-DATE TO L001-FED-8-DATE-9.      DTSCS52
02631                                                                   DTSCS52
02632      PERFORM S001-FROM-FED-8 THRU S001-EXIT.                      DTSCS52
02633                                                                   DTSCS52
02634      MOVE '(' TO MAP-PRIOR-DATE-LEFT.                             DTSCS52
02635                                                                   DTSCS52
02636      MOVE L001-SLASH-DATE TO MAP-PRIOR-DATE.                      DTSCS52
02637                                                                   DTSCS52
02638      MOVE ')' TO MAP-PRIOR-DATE-RIGHT.                            DTSCS52
02639                                                                   DTSCS52
02640                                                                   DTSCS52
02641      PERFORM S1221-LOOP THRU S1221-EXIT                           DTSCS52
02642        VARYING WRK-CTR FROM 1 BY 1                                DTSCS52
02643        UNTIL WRK-CTR > 3.                                         DTSCS52
02644                                                                   DTSCS52
02645                                                                   DTSCS52
02646      MOVE L055-CURRENT-RESERVE-THRU-DATE TO L001-FED-8-DATE-9.    DTSCS52
02647                                                                   DTSCS52
02648      PERFORM S001-FROM-FED-8 THRU S001-EXIT.                      DTSCS52
02649                                                                   DTSCS52
02650      MOVE '(' TO MAP-CURRENT-DATE-LEFT.                           DTSCS52
02651                                                                   DTSCS52
02652      MOVE L001-SLASH-DATE TO MAP-CURRENT-DATE.                    DTSCS52
02653                                                                   DTSCS52
02654      MOVE ')' TO MAP-CURRENT-DATE-RIGHT.                          DTSCS52
02655  S1220-EXIT.                                                      DTSCS52
02656      EXIT.                                                        DTSCS52
02657      SKIP3                                                        DTSCS52
02658  S1221-LOOP.                                                      DTSCS52
02659      MOVE L055-WAGES-FROM-YRQ (WRK-CTR) TO L004-QTR-5-9.          DTSCS52
02660                                                                   DTSCS52
02661      PERFORM S004-FROM-5 THRU S004-EXIT.                          DTSCS52
02662                                                                   DTSCS52
02663      MOVE L004-SLASH-QTR TO MAP-START-YRQ (WRK-CTR).              DTSCS52
02664                                                                   DTSCS52
02665                                                                   DTSCS52
02666      MOVE L055-WAGES-THRU-YRQ (WRK-CTR) TO L004-QTR-5-9.          DTSCS52
02667                                                                   DTSCS52
02668      PERFORM S004-FROM-5 THRU S004-EXIT.                          DTSCS52
02669                                                                   DTSCS52
02670      MOVE L004-SLASH-QTR TO MAP-END-YRQ (WRK-CTR).                DTSCS52
02671  S1221-EXIT.                                                      DTSCS52
02672      EXIT.                                                        DTSCS52
02673 /*****************************************************************DTSCS52
02674 *                                                                *DTSCS52
02675 ******************************************************************DTSCS52
02676  S1300-EARLIEST-LIAB-DATE.                                        DTSCS52
02677      MOVE MAP-EARLIEST-LIAB-DATE-AREA TO L015-S-DATE-AREA.        DTSCS52
02678                                                                   DTSCS52
02679      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS52
02680                                                                   DTSCS52
02681      IF L015-NO-ENTRY                                             DTSCS52
02682         MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA                  DTSCS52
02683         PERFORM S1301-ERROR THRU S1301-EXIT                       DTSCS52
02684      ELSE                                                         DTSCS52
02685      IF L015-NOT-VALID                                            DTSCS52
02686         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS52
02687         PERFORM S1301-ERROR THRU S1301-EXIT.                      DTSCS52
02688  S1300-EXIT.                                                      DTSCS52
02689      EXIT.                                                        DTSCS52
02690      SKIP3                                                        DTSCS52
02691  S1301-ERROR.                                                     DTSCS52
02692      MOVE CATB-UNPROT-NORM-NUM-MDTON                              DTSCS52
02693        TO MAP-EARLIEST-LIAB-MONTH-A                               DTSCS52
02694           MAP-EARLIEST-LIAB-DAY-A                                 DTSCS52
02695           MAP-EARLIEST-LIAB-YEAR-A.                               DTSCS52
02696                                                                   DTSCS52
02697      IF LCCM-NO-MSG                                               DTSCS52
02698         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA.                       DTSCS52
02699         MOVE CATB-CURSOR TO MAP-EARLIEST-LIAB-MONTH-L             DTSCS52
02700         SET CURSOR-SET-YES TO TRUE.                               DTSCS52
02701  S1301-EXIT.                                                      DTSCS52
02702      EXIT.                                                        DTSCS52
02703      SKIP3                                                        DTSCS52
02704 /*****************************************************************DTSCS52
02705 *                                                                *DTSCS52
02706 ******************************************************************DTSCS52
02707  S1400-ACTIVE-IND.                                                DTSCS52
02708      IF MAP-ACTIVE-IND = LOW-VALUES OR SPACES                     DTSCS52
02709         MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA                  DTSCS52
02710         PERFORM S1401-ERROR THRU S1401-EXIT                       DTSCS52
02711      ELSE                                                         DTSCS52
02712      IF MAP-ACTIVE-IND = 'Y' OR 'N'                               DTSCS52
02713         NEXT SENTENCE                                             DTSCS52
02714      ELSE                                                         DTSCS52
02715         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS52
02716         PERFORM S1401-ERROR THRU S1401-EXIT.                      DTSCS52
02717                                                                   DTSCS52
02718  S1400-EXIT.                                                      DTSCS52
02719      EXIT.                                                        DTSCS52
02720      SKIP3                                                        DTSCS52
02721  S1401-ERROR.                                                     DTSCS52
02722      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ACTIVE-IND-A.          DTSCS52
02723                                                                   DTSCS52
02724      IF LCCM-NO-MSG                                               DTSCS52
02725         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS52
02726         MOVE CATB-CURSOR TO MAP-ACTIVE-IND-L                      DTSCS52
02727         SET CURSOR-SET-YES TO TRUE.                               DTSCS52
02728  S1401-EXIT.                                                      DTSCS52
02729      EXIT.                                                        DTSCS52
02730 /*****************************************************************DTSCS52
02731 *                                                                 DTSCS52
02732 ******************************************************************DTSCS52
02733                                                                   DTSCS52
02734  S1500-TRNSF-TO-EMP-NO.                                           DTSCS52
02735      MOVE MAP-TRNSF-TO-EMP-NO-AREA TO L018-S-EMP-NO-AREA.         DTSCS52
02736                                                                   DTSCS52
02737      PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT.              DTSCS52
02738                                                                   DTSCS52
02739      IF L018-NO-ENTRY                                             DTSCS52
02740         GO TO S1500-EXIT.                                         DTSCS52
02741                                                                   DTSCS52
02742      IF L018-NOT-VALID                                            DTSCS52
02743         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS52
02744         PERFORM S1501-ERROR THRU S1501-EXIT                       DTSCS52
02745         GO TO S1500-EXIT.                                         DTSCS52
02746                                                                   DTSCS52
02747      IF L018-EMP-NO = WRK-EMP-NO                                  DTSCS52
02748          MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA                     DTSCS52
02749          PERFORM S1501-ERROR THRU S1501-EXIT                      DTSCS52
02750          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS52
02751          GO TO S1500-EXIT.                                        DTSCS52
02752                                                                   DTSCS52
02753      IF LCCM-F09-88                                               DTSCS52
02754          PERFORM S1510-TRNSF-TO-EXISTENCE-CHECK THRU S1510-EXIT   DTSCS52
02755          GO TO S1500-EXIT.                                        DTSCS52
02756                                                                   DTSCS52
02757      MOVE LOW-VALUES TO MRCT-KEY-AREA.                            DTSCS52
02758                                                                   DTSCS52
02759      MOVE WRK-EMP-NO TO MRCT-EMP-NO.                              DTSCS52
02760                                                                   DTSCS52
02761      SET MRCT-RCT-88 TO TRUE.                                     DTSCS52
02762                                                                   DTSCS52
02763      MOVE L016-YRQ TO MRCT-EFF-YRQ.                               DTSCS52
02764                                                                   DTSCS52
02765      MOVE MRCT-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS52
02766                                                                   DTSCS52
02767      PERFORM S810-READ THRU S810-EXIT.                            DTSCS52
02768                                                                   DTSCS52
02769      IF L810-OK-88                                                DTSCS52
02770          MOVE MSKL-REC TO MRCT-REC                                DTSCS52
02771          IF MRCT-TRANSFERRED-TO-EMP-NO NOT = L018-EMP-NO          DTSCS52
02772              PERFORM S1510-TRNSF-TO-EXISTENCE-CHECK               DTSCS52
02773                 THRU S1510-EXIT.                                  DTSCS52
02774  S1500-EXIT.                                                      DTSCS52
02775      EXIT.                                                        DTSCS52
02776      SKIP3                                                        DTSCS52
02777  S1501-ERROR.                                                     DTSCS52
02778      MOVE CATB-UNPROT-NORM-NUM-MDTON                              DTSCS52
02779        TO MAP-TRNSF-TO-EMP-NO-1-A                                 DTSCS52
02780           MAP-TRNSF-TO-EMP-NO-2-A.                                DTSCS52
02781                                                                   DTSCS52
02782      IF LCCM-NO-MSG                                               DTSCS52
02783         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS52
02784         MOVE CATB-CURSOR TO MAP-TRNSF-TO-EMP-NO-1-L               DTSCS52
02785         SET CURSOR-SET-YES TO TRUE.                               DTSCS52
02786  S1501-EXIT.                                                      DTSCS52
02787      EXIT.                                                        DTSCS52
02788      SKIP3                                                        DTSCS52
02789  S1510-TRNSF-TO-EXISTENCE-CHECK.                                  DTSCS52
02790      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSCS52
02791                                                                   DTSCS52
02792      MOVE L018-EMP-NO TO MSKL-EMP-NO.                             DTSCS52
02793                                                                   DTSCS52
02794      SET MSKL-PRF-88 TO TRUE.                                     DTSCS52
02795                                                                   DTSCS52
02796      PERFORM S810-READ THRU S810-EXIT.                            DTSCS52
02797                                                                   DTSCS52
02798      IF L810-NO-REC-88                                            DTSCS52
02799          MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA                    DTSCS52
02800          PERFORM S1501-ERROR THRU S1501-EXIT                      DTSCS52
02801          GO TO S1510-EXIT.                                        DTSCS52
02802                                                                   DTSCS52
02803      MOVE MSKL-REC TO MPRF-REC.                                   DTSCS52
02804                                                                   DTSCS52
02805      IF NOT MPRF-CLASS-RATED-88                                   DTSCS52
02806          MOVE MSG-E521-AREA TO WRK-MSG-AREA                       DTSCS52
02807          PERFORM S1501-ERROR THRU S1501-EXIT.                     DTSCS52
02808                                                                   DTSCS52
02809      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSCS52
02810                                                                   DTSCS52
02811      MOVE WRK-EMP-NO TO MSKL-EMP-NO.                              DTSCS52
02812                                                                   DTSCS52
02813      SET MSKL-PRF-88 TO TRUE.                                     DTSCS52
02814                                                                   DTSCS52
02815      PERFORM S810-READ THRU S810-EXIT.                            DTSCS52
02816                                                                   DTSCS52
02817      IF L810-OK-88                                                DTSCS52
02818          MOVE MSKL-REC TO MPRF-REC.                               DTSCS52
02819  S1510-EXIT.                                                      DTSCS52
02820      EXIT.                                                        DTSCS52
02821 /*****************************************************************DTSCS52
02822 *                                                                 DTSCS52
02823 ******************************************************************DTSCS52
02824                                                                   DTSCS52
02825  S1600-PRIOR-RESERVE-CHNG.                                        DTSCS52
02826      MOVE MAP-PRIOR-RESERVE-CHNG-AREA TO L011-S-AMT-AREA.         DTSCS52
02827                                                                   DTSCS52
02828      MOVE WRK-MAX-LIT TO L011-MAX-AMT.                            DTSCS52
02829                                                                   DTSCS52
02830      MOVE WRK-MIN-LIT TO L011-MIN-AMT.                            DTSCS52
02831                                                                   DTSCS52
02832      PERFORM S011-AMOUNT-FROM-SCREEN THRU S011-EXIT.              DTSCS52
02833                                                                   DTSCS52
02834      IF L011-NO-ENTRY                                             DTSCS52
02835         NEXT SENTENCE                                             DTSCS52
02836      ELSE                                                         DTSCS52
02837      IF L011-EXCEEDS-MIN-MAX                                      DTSCS52
02838         MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA                 DTSCS52
02839         PERFORM S1601-ERROR THRU S1601-EXIT                       DTSCS52
02840      ELSE                                                         DTSCS52
02841      IF L011-NOT-VALID                                            DTSCS52
02842         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS52
02843         PERFORM S1601-ERROR THRU S1601-EXIT                       DTSCS52
02844      ELSE                                                         DTSCS52
02845         MOVE L011-AMT TO MAP-PRIOR-RESERVE-CHNG-N.                DTSCS52
02846  S1600-EXIT.                                                      DTSCS52
02847      EXIT.                                                        DTSCS52
02848      SKIP3                                                        DTSCS52
02849  S1601-ERROR.                                                     DTSCS52
02850      MOVE CATB-UNPROT-NORM-NUM-MDTON                              DTSCS52
02851        TO MAP-PRIOR-RESERVE-CHNG-A.                               DTSCS52
02852                                                                   DTSCS52
02853      IF LCCM-NO-MSG                                               DTSCS52
02854         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS52
02855         MOVE CATB-CURSOR                                          DTSCS52
02856           TO MAP-PRIOR-RESERVE-CHNG-L                             DTSCS52
02857         SET CURSOR-SET-YES TO TRUE.                               DTSCS52
02858  S1601-EXIT.                                                      DTSCS52
02859      EXIT.                                                        DTSCS52
02860 /*****************************************************************DTSCS52
02861 *                                                                 DTSCS52
02862 ******************************************************************DTSCS52
02863                                                                   DTSCS52
02864  S1700-UI-TAX-PAID-CHNG.                                          DTSCS52
02865      MOVE MAP-UI-TAX-PAID-CHNG-AREA TO L011-S-AMT-AREA.           DTSCS52
02866                                                                   DTSCS52
02867      MOVE WRK-MAX-LIT TO L011-MAX-AMT.                            DTSCS52
02868                                                                   DTSCS52
02869      MOVE WRK-MIN-LIT TO L011-MIN-AMT.                            DTSCS52
02870                                                                   DTSCS52
02871      PERFORM S011-AMOUNT-FROM-SCREEN THRU S011-EXIT.              DTSCS52
02872                                                                   DTSCS52
02873      IF L011-NO-ENTRY                                             DTSCS52
02874         NEXT SENTENCE                                             DTSCS52
02875      ELSE                                                         DTSCS52
02876      IF L011-EXCEEDS-MIN-MAX                                      DTSCS52
02877         MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA                 DTSCS52
02878         PERFORM S1701-ERROR THRU S1701-EXIT                       DTSCS52
02879      ELSE                                                         DTSCS52
02880      IF L011-NOT-VALID                                            DTSCS52
02881         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS52
02882         PERFORM S1701-ERROR THRU S1701-EXIT                       DTSCS52
02883      ELSE                                                         DTSCS52
02884         MOVE L011-AMT TO MAP-UI-TAX-PAID-CHNG-N.                  DTSCS52
02885  S1700-EXIT.                                                      DTSCS52
02886      EXIT.                                                        DTSCS52
02887      SKIP3                                                        DTSCS52
02888  S1701-ERROR.                                                     DTSCS52
02889      MOVE CATB-UNPROT-NORM-NUM-MDTON                              DTSCS52
02890        TO MAP-UI-TAX-PAID-CHNG-A.                                 DTSCS52
02891                                                                   DTSCS52
02892      IF LCCM-NO-MSG                                               DTSCS52
02893         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS52
02894         MOVE CATB-CURSOR                                          DTSCS52
02895           TO MAP-UI-TAX-PAID-CHNG-L                               DTSCS52
02896         SET CURSOR-SET-YES TO TRUE.                               DTSCS52
02897  S1701-EXIT.                                                      DTSCS52
02898      EXIT.                                                        DTSCS52
02899 /*****************************************************************DTSCS52
02900 *                                                                 DTSCS52
02901 ******************************************************************DTSCS52
02902                                                                   DTSCS52
02903  S1800-TRUST-FUND-INT-CHNG.                                       DTSCS52
02904      MOVE MAP-TRUST-FUND-INT-AREA TO L011-S-AMT-AREA.             DTSCS52
02905                                                                   DTSCS52
02906      PERFORM S011-MAX-LIMITS THRU S011-EXIT.                      DTSCS52
02907                                                                   DTSCS52
02908      MOVE L011-AMT TO WRK-CHK-NEGATIVE-AMT.                       DTSCS52
02909                                                                   DTSCS52
02910                                                                   DTSCS52
02911      MOVE MAP-TRUST-FUND-INT-CHNG-AREA TO L011-S-AMT-AREA.        DTSCS52
02912                                                                   DTSCS52
02913      MOVE WRK-MAX-LIT TO L011-MAX-AMT.                            DTSCS52
02914                                                                   DTSCS52
02915      MOVE WRK-MIN-LIT TO L011-MIN-AMT.                            DTSCS52
02916                                                                   DTSCS52
02917      PERFORM S011-AMOUNT-FROM-SCREEN THRU S011-EXIT.              DTSCS52
02918                                                                   DTSCS52
02919      IF L011-NO-ENTRY                                             DTSCS52
02920         NEXT SENTENCE                                             DTSCS52
02921      ELSE                                                         DTSCS52
02922      IF L011-EXCEEDS-MIN-MAX                                      DTSCS52
02923         MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA                 DTSCS52
02924         PERFORM S1801-ERROR THRU S1801-EXIT                       DTSCS52
02925      ELSE                                                         DTSCS52
02926      IF L011-NOT-VALID                                            DTSCS52
02927         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS52
02928         PERFORM S1801-ERROR THRU S1801-EXIT                       DTSCS52
02929      ELSE                                                         DTSCS52
02930         ADD L011-AMT TO WRK-CHK-NEGATIVE-AMT                      DTSCS52
02931         IF WRK-CHK-NEGATIVE-AMT < +0                              DTSCS52
02932            MOVE MSG-E522-AREA TO WRK-MSG-AREA                     DTSCS52
02933            PERFORM S1801-ERROR THRU S1801-EXIT                    DTSCS52
02934         ELSE                                                      DTSCS52
02935            MOVE L011-AMT TO MAP-TRUST-FUND-INT-CHNG-N.            DTSCS52
02936  S1800-EXIT.                                                      DTSCS52
02937      EXIT.                                                        DTSCS52
02938      SKIP3                                                        DTSCS52
02939  S1801-ERROR.                                                     DTSCS52
02940      MOVE CATB-UNPROT-NORM-NUM-MDTON                              DTSCS52
02941        TO MAP-TRUST-FUND-INT-CHNG-A.                              DTSCS52
02942                                                                   DTSCS52
02943      IF LCCM-NO-MSG                                               DTSCS52
02944         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS52
02945         MOVE CATB-CURSOR                                          DTSCS52
02946           TO MAP-TRUST-FUND-INT-CHNG-L                            DTSCS52
02947         SET CURSOR-SET-YES TO TRUE.                               DTSCS52
02948  S1801-EXIT.                                                      DTSCS52
02949      EXIT.                                                        DTSCS52
02950 /*****************************************************************DTSCS52
02951 *                                                                 DTSCS52
02952 ******************************************************************DTSCS52
02953                                                                   DTSCS52
02954  S1900-UI-BEN-CHRGD-CHNG.                                         DTSCS52
02955      MOVE MAP-UI-BEN-CHRGD-CHNG-AREA TO L011-S-AMT-AREA.          DTSCS52
02956                                                                   DTSCS52
02957      MOVE WRK-MAX-LIT TO L011-MAX-AMT.                            DTSCS52
02958                                                                   DTSCS52
02959      MOVE WRK-MIN-LIT TO L011-MIN-AMT.                            DTSCS52
02960                                                                   DTSCS52
02961      PERFORM S011-AMOUNT-FROM-SCREEN THRU S011-EXIT.              DTSCS52
02962                                                                   DTSCS52
02963      IF L011-NO-ENTRY                                             DTSCS52
02964         NEXT SENTENCE                                             DTSCS52
02965      ELSE                                                         DTSCS52
02966      IF L011-EXCEEDS-MIN-MAX                                      DTSCS52
02967         MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA                 DTSCS52
02968         PERFORM S1901-ERROR THRU S1901-EXIT                       DTSCS52
02969      ELSE                                                         DTSCS52
02970      IF L011-NOT-VALID                                            DTSCS52
02971         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS52
02972         PERFORM S1901-ERROR THRU S1901-EXIT                       DTSCS52
02973      ELSE                                                         DTSCS52
02974         MOVE L011-AMT TO MAP-UI-BEN-CHRGD-CHNG-N.                 DTSCS52
02975  S1900-EXIT.                                                      DTSCS52
02976      EXIT.                                                        DTSCS52
02977      SKIP3                                                        DTSCS52
02978  S1901-ERROR.                                                     DTSCS52
02979      MOVE CATB-UNPROT-NORM-NUM-MDTON                              DTSCS52
02980        TO MAP-UI-BEN-CHRGD-CHNG-A.                                DTSCS52
02981                                                                   DTSCS52
02982      IF LCCM-NO-MSG                                               DTSCS52
02983         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS52
02984         MOVE CATB-CURSOR                                          DTSCS52
02985           TO MAP-UI-BEN-CHRGD-CHNG-L                              DTSCS52
02986         SET CURSOR-SET-YES TO TRUE.                               DTSCS52
02987  S1901-EXIT.                                                      DTSCS52
02988      EXIT.                                                        DTSCS52
02989 /*****************************************************************DTSCS52
02990 *                                                                 DTSCS52
02991 ******************************************************************DTSCS52
02992                                                                   DTSCS52
02993  S2000-WAGE-CHNG.                                                 DTSCS52
02994      PERFORM S2010-TOT-WAGE-CHNG THRU S2010-EXIT.                 DTSCS52
02995                                                                   DTSCS52
02996      PERFORM S2020-TAX-WAGE-CHNG THRU S2020-EXIT.                 DTSCS52
02997  S2000-EXIT.                                                      DTSCS52
02998      EXIT.                                                        DTSCS52
02999      SKIP3                                                        DTSCS52
03000  S2010-TOT-WAGE-CHNG.                                             DTSCS52
03001      MOVE MAP-TOT-WAGE-AREA (WRK-CTR) TO L011-S-AMT-AREA.         DTSCS52
03002                                                                   DTSCS52
03003      PERFORM S011-MAX-LIMITS THRU S011-EXIT.                      DTSCS52
03004                                                                   DTSCS52
03005      MOVE L011-AMT TO WRK-CHK-NEGATIVE-AMT                        DTSCS52
03006                       WRK-CHK-TOT-WAGE-AMT.                       DTSCS52
03007                                                                   DTSCS52
03008 *****IF WRK-TBL-OK-88 (1)                                         DTSCS52
03009 ********ADD L011-AMT TO WRK-TBL-TOT (1).                          DTSCS52
03010                                                                   DTSCS52
03011                                                                   DTSCS52
03012      MOVE MAP-TOT-WAGE-CHNG-AREA (WRK-CTR) TO L011-S-AMT-AREA.    DTSCS52
03013                                                                   DTSCS52
03014      MOVE WRK-MAX-LIT TO L011-MAX-AMT.                            DTSCS52
03015                                                                   DTSCS52
03016      MOVE WRK-MIN-LIT TO L011-MIN-AMT.                            DTSCS52
03017                                                                   DTSCS52
03018      PERFORM S011-AMOUNT-FROM-SCREEN THRU S011-EXIT.              DTSCS52
03019                                                                   DTSCS52
03020      IF L011-NO-ENTRY                                             DTSCS52
03021         NEXT SENTENCE                                             DTSCS52
03022      ELSE                                                         DTSCS52
03023      IF L011-EXCEEDS-MIN-MAX                                      DTSCS52
03024         MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA                 DTSCS52
03025         PERFORM S2011-ERROR THRU S2011-EXIT                       DTSCS52
03026      ELSE                                                         DTSCS52
03027      IF L011-NOT-VALID                                            DTSCS52
03028         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS52
03029         PERFORM S2011-ERROR THRU S2011-EXIT                       DTSCS52
03030      ELSE                                                         DTSCS52
03031         ADD L011-AMT TO WRK-CHK-NEGATIVE-AMT                      DTSCS52
03032         IF WRK-CHK-NEGATIVE-AMT < +0                              DTSCS52
03033            MOVE MSG-E522-AREA TO WRK-MSG-AREA                     DTSCS52
03034            PERFORM S2011-ERROR THRU S2011-EXIT                    DTSCS52
03035         ELSE                                                      DTSCS52
03036            MOVE L011-AMT TO MAP-TOT-WAGE-CHNG-N (WRK-CTR)         DTSCS52
03037            ADD L011-AMT TO WRK-CHK-TOT-WAGE-AMT.                  DTSCS52
03038 ***********IF WRK-TBL-OK-88 (1)                                   DTSCS52
03039 **************ADD L011-AMT TO WRK-TBL-TOT (1).                    DTSCS52
03040  S2010-EXIT.                                                      DTSCS52
03041      EXIT.                                                        DTSCS52
03042      SKIP3                                                        DTSCS52
03043  S2011-ERROR.                                                     DTSCS52
03044 *****SET WRK-TBL-NOT-OK-88 (1) TO TRUE.                           DTSCS52
03045                                                                   DTSCS52
03046      MOVE CATB-UNPROT-NORM-NUM-MDTON                              DTSCS52
03047        TO MAP-TOT-WAGE-CHNG-A (WRK-CTR).                          DTSCS52
03048                                                                   DTSCS52
03049      IF LCCM-NO-MSG                                               DTSCS52
03050         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS52
03051         MOVE CATB-CURSOR                                          DTSCS52
03052           TO MAP-TOT-WAGE-CHNG-L (WRK-CTR)                        DTSCS52
03053         SET CURSOR-SET-YES TO TRUE.                               DTSCS52
03054  S2011-EXIT.                                                      DTSCS52
03055      EXIT.                                                        DTSCS52
03056      SKIP3                                                        DTSCS52
03057  S2020-TAX-WAGE-CHNG.                                             DTSCS52
03058      MOVE MAP-TAX-WAGE-AREA (WRK-CTR) TO L011-S-AMT-AREA.         DTSCS52
03059                                                                   DTSCS52
03060      PERFORM S011-MAX-LIMITS THRU S011-EXIT.                      DTSCS52
03061                                                                   DTSCS52
03062      MOVE L011-AMT TO WRK-CHK-NEGATIVE-AMT                        DTSCS52
03063                       WRK-CHK-TAX-WAGE-AMT.                       DTSCS52
03064                                                                   DTSCS52
03065 *****IF WRK-TBL-OK-88 (2)                                         DTSCS52
03066 ********ADD L011-AMT TO WRK-TBL-TOT (2).                          DTSCS52
03067                                                                   DTSCS52
03068                                                                   DTSCS52
03069      MOVE MAP-TAX-WAGE-CHNG-AREA (WRK-CTR) TO L011-S-AMT-AREA.    DTSCS52
03070                                                                   DTSCS52
03071      MOVE WRK-MAX-LIT TO L011-MAX-AMT.                            DTSCS52
03072                                                                   DTSCS52
03073      MOVE WRK-MIN-LIT TO L011-MIN-AMT.                            DTSCS52
03074                                                                   DTSCS52
03075      PERFORM S011-AMOUNT-FROM-SCREEN THRU S011-EXIT.              DTSCS52
03076                                                                   DTSCS52
03077      IF L011-NO-ENTRY                                             DTSCS52
03078         IF (MAP-TOT-WAGE-CHNG-A (WRK-CTR)                         DTSCS52
03079              NOT = CATB-UNPROT-NORM-NUM-MDTON)                    DTSCS52
03080                  AND                                              DTSCS52
03081            (WRK-CHK-NEGATIVE-AMT > WRK-CHK-TOT-WAGE-AMT)          DTSCS52
03082             MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA                  DTSCS52
03083             PERFORM S2011-ERROR THRU S2011-EXIT                   DTSCS52
03084             PERFORM S2021-ERROR THRU S2021-EXIT                   DTSCS52
03085          ELSE                                                     DTSCS52
03086             NEXT SENTENCE                                         DTSCS52
03087      ELSE                                                         DTSCS52
03088      IF L011-EXCEEDS-MIN-MAX                                      DTSCS52
03089         MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA                 DTSCS52
03090         PERFORM S2021-ERROR THRU S2021-EXIT                       DTSCS52
03091      ELSE                                                         DTSCS52
03092      IF L011-NOT-VALID                                            DTSCS52
03093         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS52
03094         PERFORM S2021-ERROR THRU S2021-EXIT                       DTSCS52
03095      ELSE                                                         DTSCS52
03096         ADD L011-AMT TO WRK-CHK-NEGATIVE-AMT                      DTSCS52
03097         IF WRK-CHK-NEGATIVE-AMT < +0                              DTSCS52
03098            MOVE MSG-E522-AREA TO WRK-MSG-AREA                     DTSCS52
03099            PERFORM S2021-ERROR THRU S2021-EXIT                    DTSCS52
03100         ELSE                                                      DTSCS52
03101         IF (MAP-TOT-WAGE-CHNG-A (WRK-CTR)                         DTSCS52
03102              NOT = CATB-UNPROT-NORM-NUM-MDTON)                    DTSCS52
03103                  AND                                              DTSCS52
03104            (WRK-CHK-NEGATIVE-AMT > WRK-CHK-TOT-WAGE-AMT)          DTSCS52
03105             MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA                  DTSCS52
03106             PERFORM S2011-ERROR THRU S2011-EXIT                   DTSCS52
03107             PERFORM S2021-ERROR THRU S2021-EXIT                   DTSCS52
03108         ELSE                                                      DTSCS52
03109            MOVE L011-AMT TO MAP-TAX-WAGE-CHNG-N (WRK-CTR)         DTSCS52
03110            ADD L011-AMT TO WRK-CHK-TAX-WAGE-AMT.                  DTSCS52
03111                                                                   DTSCS52
03112 ***********IF WRK-TBL-OK-88(2)                                    DTSCS52
03113 **************ADD L011-AMT TO WRK-TBL-TOT (2).                    DTSCS52
03114  S2020-EXIT.                                                      DTSCS52
03115      EXIT.                                                        DTSCS52
03116      SKIP3                                                        DTSCS52
03117  S2021-ERROR.                                                     DTSCS52
03118 *****SET WRK-TBL-NOT-OK-88 (2) TO TRUE.                           DTSCS52
03119                                                                   DTSCS52
03120      MOVE CATB-UNPROT-NORM-NUM-MDTON                              DTSCS52
03121        TO MAP-TAX-WAGE-CHNG-A (WRK-CTR).                          DTSCS52
03122                                                                   DTSCS52
03123      IF LCCM-NO-MSG                                               DTSCS52
03124         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS52
03125         MOVE CATB-CURSOR                                          DTSCS52
03126           TO MAP-TAX-WAGE-CHNG-L (WRK-CTR)                        DTSCS52
03127         SET CURSOR-SET-YES TO TRUE.                               DTSCS52
03128  S2021-EXIT.                                                      DTSCS52
03129      EXIT.                                                        DTSCS52
03130 /*****************************************************************DTSCS52
03131 *                                                                *DTSCS52
03132 ******************************************************************DTSCS52
03133  S2100-MISS-RPT-CNT.                                              DTSCS52
03134      MOVE MAP-MISS-RPT-CNT-AREA TO L013-S-CNT-AREA.               DTSCS52
03135                                                                   DTSCS52
03136      MOVE +0 TO L013-MIN-CNT.                                     DTSCS52
03137                                                                   DTSCS52
03138      MOVE +999 TO L013-MAX-CNT.                                   DTSCS52
03139                                                                   DTSCS52
03140      PERFORM S013-COUNT-FROM-SCREEN THRU S013-EXIT.               DTSCS52
03141                                                                   DTSCS52
03142      IF L013-NO-ENTRY                                             DTSCS52
03143         MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA                  DTSCS52
03144         PERFORM S2101-ERROR THRU S2101-EXIT                       DTSCS52
03145      ELSE                                                         DTSCS52
03146      IF L013-NOT-VALID                                            DTSCS52
03147         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS52
03148         PERFORM S2101-ERROR THRU S2101-EXIT                       DTSCS52
03149      ELSE                                                         DTSCS52
03150         MOVE L013-CNT TO MAP-MISS-RPT-CNT-N.                      DTSCS52
03151  S2100-EXIT.                                                      DTSCS52
03152      EXIT.                                                        DTSCS52
03153      SKIP3                                                        DTSCS52
03154  S2101-ERROR.                                                     DTSCS52
03155      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-MISS-RPT-CNT-A.       DTSCS52
03156                                                                   DTSCS52
03157      IF LCCM-NO-MSG                                               DTSCS52
03158         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS52
03159         MOVE CATB-CURSOR TO MAP-MISS-RPT-CNT-L                    DTSCS52
03160         SET CURSOR-SET-YES TO TRUE.                               DTSCS52
03161  S2101-EXIT.                                                      DTSCS52
03162      EXIT.                                                        DTSCS52
03163 /*****************************************************************DTSCS52
03164 *                                                                *DTSCS52
03165 ******************************************************************DTSCS52
03166  S2200-UI-TAX-DUE.                                                DTSCS52
03167      MOVE MAP-UI-TAX-DUE-AREA TO L011-S-AMT-AREA.                 DTSCS52
03168                                                                   DTSCS52
03169      MOVE +0 TO L011-MIN-AMT.                                     DTSCS52
03170                                                                   DTSCS52
03171      MOVE +999999999.99 TO L011-MAX-AMT.                          DTSCS52
03172                                                                   DTSCS52
03173      PERFORM S011-AMOUNT-FROM-SCREEN THRU S011-EXIT.              DTSCS52
03174                                                                   DTSCS52
03175      IF L011-NO-ENTRY                                             DTSCS52
03176         MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA                  DTSCS52
03177         PERFORM S2201-ERROR THRU S2201-EXIT                       DTSCS52
03178      ELSE                                                         DTSCS52
03179      IF L011-NOT-VALID                                            DTSCS52
03180         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS52
03181         PERFORM S2201-ERROR THRU S2201-EXIT                       DTSCS52
03182      ELSE                                                         DTSCS52
03183         MOVE L011-AMT TO MAP-UI-TAX-DUE-N.                        DTSCS52
03184  S2200-EXIT.                                                      DTSCS52
03185      EXIT.                                                        DTSCS52
03186      SKIP3                                                        DTSCS52
03187  S2201-ERROR.                                                     DTSCS52
03188      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-UI-TAX-DUE-A.         DTSCS52
03189                                                                   DTSCS52
03190      IF LCCM-NO-MSG                                               DTSCS52
03191         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS52
03192         MOVE CATB-CURSOR TO MAP-UI-TAX-DUE-L                      DTSCS52
03193         SET CURSOR-SET-YES TO TRUE.                               DTSCS52
03194  S2201-EXIT.                                                      DTSCS52
03195      EXIT.                                                        DTSCS52
03196 /*****************************************************************DTSCS52
03197 *                                                                *DTSCS52
03198 ******************************************************************DTSCS52
03199  S2300-PRED-DUE-IND.                                              DTSCS52
03200      IF MAP-PRED-DUE-IND = LOW-VALUES OR SPACES                   DTSCS52
03201         MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA                  DTSCS52
03202         PERFORM S2301-ERROR THRU S2301-EXIT                       DTSCS52
03203      ELSE                                                         DTSCS52
03204      IF MAP-PRED-DUE-IND = 'Y' OR 'N'                             DTSCS52
03205         NEXT SENTENCE                                             DTSCS52
03206      ELSE                                                         DTSCS52
03207         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS52
03208         PERFORM S2301-ERROR THRU S2301-EXIT.                      DTSCS52
03209  S2300-EXIT.                                                      DTSCS52
03210      EXIT.                                                        DTSCS52
03211      SKIP3                                                        DTSCS52
03212  S2301-ERROR.                                                     DTSCS52
03213      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-PRED-DUE-IND-A.        DTSCS52
03214                                                                   DTSCS52
03215      IF LCCM-NO-MSG                                               DTSCS52
03216         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS52
03217         MOVE CATB-CURSOR TO MAP-PRED-DUE-IND-L                    DTSCS52
03218         SET CURSOR-SET-YES TO TRUE.                               DTSCS52
03219  S2301-EXIT.                                                      DTSCS52
03220      EXIT.                                                        DTSCS52
03221 /*****************************************************************DTSCS52
03222 *                                                                *DTSCS52
03223 ******************************************************************DTSCS52
03224  S3100-MISC-EDITS.                                                DTSCS52
03225 *****PERFORM S3110-BEN-CHARGED-TOTAL-EDIT THRU S3110-EXIT.        DTSCS52
03226                                                                   DTSCS52
03227                                                                   DTSCS52
03228      MOVE LOW-VALUES TO MRCT-REC.                                 DTSCS52
03229                                                                   DTSCS52
03230      MOVE WRK-EMP-NO TO MRCT-EMP-NO.                              DTSCS52
03231                                                                   DTSCS52
03232      SET MRCT-RCT-88 TO TRUE.                                     DTSCS52
03233                                                                   DTSCS52
03234      MOVE L016-YRQ TO MRCT-EFF-YRQ.                               DTSCS52
03235                                                                   DTSCS52
03236      MOVE MRCT-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS52
03237                                                                   DTSCS52
03238      PERFORM S810-READ THRU S810-EXIT.                            DTSCS52
03239                                                                   DTSCS52
03240                                                                   DTSCS52
03241      IF L810-OK-88                                                DTSCS52
03242           AND LCCM-F09-88                                         DTSCS52
03243         MOVE EMSG-RECORD-EXISTS TO WRK-MSG-AREA                   DTSCS52
03244         PERFORM S1201-ERROR THRU S1201-EXIT                       DTSCS52
03245         GO TO S3100-EXIT.                                         DTSCS52
03246                                                                   DTSCS52
03247                                                                   DTSCS52
03248      IF L810-NO-REC-88                                            DTSCS52
03249           AND LCCM-F10-88                                         DTSCS52
03250         MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                       DTSCS52
03251         PERFORM S1201-ERROR THRU S1201-EXIT                       DTSCS52
03252         GO TO S3100-EXIT.                                         DTSCS52
03253  S3100-EXIT.                                                      DTSCS52
03254      EXIT.                                                        DTSCS52
03255      SKIP3                                                        DTSCS52
03256 *S3110-BEN-CHARGED-TOTAL-EDIT.                                    DTSCS52
03257 *****IF WRK-TBL-NOT-OK-88 (4)                                     DTSCS52
03258 *********GO TO S3110-EXIT.                                        DTSCS52
03259                                                                   DTSCS52
03260 *****IF WRK-TBL-TOT (4) < +0                                      DTSCS52
03261 *********MOVE MSG-E523-AREA TO WRK-MSG-AREA                       DTSCS52
03262 *********PERFORM S1851-ERROR THRU S1851-EXIT                      DTSCS52
03263 *************VARYING WRK-CTR FROM 1 BY 1                          DTSCS52
03264 *************UNTIL WRK-CTR > +4.                                  DTSCS52
03265 *S3110-EXIT.                                                      DTSCS52
03266 *****EXIT.                                                        DTSCS52
03267 /*****************************************************************DTSCS52
03268 * LOCK SCREEN FOR UPDATE CONFIRMATION                            *DTSCS52
03269 ******************************************************************DTSCS52
03270  S5100-SET-LOCK-ATTRB.                                            DTSCS52
03271      MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN                      DTSCS52
03272                                   WRK-ATB-NUM.                    DTSCS52
03273                                                                   DTSCS52
03274      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCS52
03275                                                                   DTSCS52
03276      MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-NO-1-A                  DTSCS52
03277                                   MAP-EMP-NO-2-A                  DTSCS52
03278                                   MAP-GOTO-A.                     DTSCS52
03279  S5100-EXIT.                                                      DTSCS52
03280      EXIT.                                                        DTSCS52
03281      SKIP3                                                        DTSCS52
03282 ******************************************************************DTSCS52
03283 * SET ATTIBUTE BYTES FOR UPDATE ACCESS                           *DTSCS52
03284 ******************************************************************DTSCS52
03285                                                                   DTSCS52
03286  S5200-SET-UPDATE-ATTRB.                                          DTSCS52
03287      MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN.                 DTSCS52
03288                                                                   DTSCS52
03289      MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM.               DTSCS52
03290                                                                   DTSCS52
03291      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCS52
03292                                                                   DTSCS52
03293      IF LCCM-SCR-INQUIRE                                          DTSCS52
03294          MOVE CATB-ASKIP-BRT-MDTON TO MAP-EFF-QTR-YR-A            DTSCS52
03295                                       MAP-EFF-QTR-Q-A.            DTSCS52
03296  S5200-EXIT.                                                      DTSCS52
03297      EXIT.                                                        DTSCS52
03298      SKIP3                                                        DTSCS52
03299 ******************************************************************DTSCS52
03300 *  SET ATTRIBUTE BYTES FOR INQUIRY STATUS                        *DTSCS52
03301 ******************************************************************DTSCS52
03302                                                                   DTSCS52
03303  S5300-SET-INQ-ATTRB.                                             DTSCS52
03304      MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN                     DTSCS52
03305                                    WRK-ATB-NUM.                   DTSCS52
03306                                                                   DTSCS52
03307      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCS52
03308  S5300-EXIT.                                                      DTSCS52
03309      EXIT.                                                        DTSCS52
03310      SKIP3                                                        DTSCS52
03311  S5900-SET-ATTRB.                                                 DTSCS52
03312      MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A             DTSCS52
03313                                        MAP-EMP-NO-2-A.            DTSCS52
03314                                                                   DTSCS52
03315      MOVE WRK-ATB-AN                                              DTSCS52
03316        TO MAP-ACTIVE-IND-A                                        DTSCS52
03317           MAP-PRED-DUE-IND-A                                      DTSCS52
03318           MAP-RATE-TYPE-A.                                        DTSCS52
03319                                                                   DTSCS52
03320      MOVE WRK-ATB-NUM                                             DTSCS52
03321        TO MAP-EFF-QTR-YR-A                                        DTSCS52
03322           MAP-EFF-QTR-Q-A                                         DTSCS52
03323           MAP-EARLIEST-LIAB-MONTH-A                               DTSCS52
03324           MAP-EARLIEST-LIAB-DAY-A                                 DTSCS52
03325           MAP-EARLIEST-LIAB-YEAR-A                                DTSCS52
03326           MAP-TRNSF-TO-EMP-NO-1-A                                 DTSCS52
03327           MAP-TRNSF-TO-EMP-NO-2-A                                 DTSCS52
03328           MAP-PRIOR-RESERVE-CHNG-A                                DTSCS52
03329           MAP-UI-TAX-PAID-CHNG-A                                  DTSCS52
03330           MAP-TRUST-FUND-INT-CHNG-A                               DTSCS52
03331           MAP-UI-BEN-CHRGD-CHNG-A                                 DTSCS52
03332           MAP-MISS-RPT-CNT-A                                      DTSCS52
03333           MAP-UI-TAX-DUE-A .                                      DTSCS52
03334                                                                   DTSCS52
03335      MOVE CATB-ASKIP-BRT-MDTON TO MAP-PRIMARY-NAME-A              DTSCS52
03336                                   MAP-CURR-PAGE-A                 DTSCS52
03337                                   MAP-LAST-PAGE-A                 DTSCS52
03338                                   MAP-PERIOD-FROM-A               DTSCS52
03339                                   MAP-PERIOD-TO-A                 DTSCS52
03340                                   MAP-PRIOR-DATE-A                DTSCS52
03341                                   MAP-PRIOR-RESERVE-A             DTSCS52
03342                                   MAP-UI-TAX-PAID-A               DTSCS52
03343                                   MAP-TRUST-FUND-INT-A            DTSCS52
03344                                   MAP-UI-BEN-CHRGD-A              DTSCS52
03345                                   MAP-CURRENT-RESERVE-A           DTSCS52
03346                                   MAP-CURRENT-DATE-A              DTSCS52
03347                                   MAP-ESTB-DATE-A                 DTSCS52
03348                                   MAP-AVG-TAX-WAGE-A              DTSCS52
03349                                   MAP-CHNG-DATE-A                 DTSCS52
03350                                   MAP-RESERVE-RATIO-A             DTSCS52
03351                                   MAP-CHNG-OPID-A                 DTSCS52
03352                                   MAP-RATE-A-A                    DTSCS52
03353                                   MAP-RATE-B-A                    DTSCS52
03354                                   MAP-PEN-RATE-IND-A              DTSCS52
03355                                   MAP-RATE-CATEGORY-DSCR-A        DTSCS52
03356                                   MAP-ESTIM-QTR1-WAGE-A.          DTSCS52
03357                                                                   DTSCS52
03358      PERFORM S5910-LOOP THRU S5910-EXIT                           DTSCS52
03359         VARYING WRK-CTR FROM 1 BY 1                               DTSCS52
03360         UNTIL WRK-CTR > 3.                                        DTSCS52
03361                                                                   DTSCS52
03362                                                                   DTSCS52
03363      MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A.                 DTSCS52
03364  S5900-EXIT.                                                      DTSCS52
03365      EXIT.                                                        DTSCS52
03366      SKIP3                                                        DTSCS52
03367  S5910-LOOP.                                                      DTSCS52
03368      MOVE WRK-ATB-NUM                                             DTSCS52
03369        TO MAP-TOT-WAGE-CHNG-A (WRK-CTR)                           DTSCS52
03370           MAP-TAX-WAGE-CHNG-A (WRK-CTR).                          DTSCS52
03371                                                                   DTSCS52
03372      MOVE CATB-ASKIP-BRT-MDTON                                    DTSCS52
03373        TO MAP-START-YRQ-A (WRK-CTR)                               DTSCS52
03374           MAP-END-YRQ-A (WRK-CTR)                                 DTSCS52
03375           MAP-TOT-WAGE-A (WRK-CTR)                                DTSCS52
03376           MAP-TAX-WAGE-A (WRK-CTR).                               DTSCS52
03377  S5910-EXIT.                                                      DTSCS52
03378      EXIT.                                                        DTSCS52
03379 /*****************************************************************DTSCS52
03380 * MAP ROUTINES                                                   *DTSCS52
03381 ******************************************************************DTSCS52
03382                                                                   DTSCS52
03383  S9100-RECEIVE.                                                   DTSCS52
03384      SET L851-RECEIVE-88 TO TRUE.                                 DTSCS52
03385                                                                   DTSCS52
03386      MOVE WRK-SCR-ID TO L851-SCR-ID.                              DTSCS52
03387                                                                   DTSCS52
03388      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS52
03389                                                                   DTSCS52
03390      MOVE L851-AID TO LCCM-AID.                                   DTSCS52
03391                                                                   DTSCS52
03392      MOVE L851-CURSOR TO LCCM-CURSOR.                             DTSCS52
03393  S9100-EXIT.                                                      DTSCS52
03394      EXIT.                                                        DTSCS52
03395      SKIP3                                                        DTSCS52
03396  S9200-SEND-DATAONLY.                                             DTSCS52
03397      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS52
03398                                                                   DTSCS52
03399      IF LCCM-NO-MSG                                               DTSCS52
03400          NEXT SENTENCE                                            DTSCS52
03401      ELSE                                                         DTSCS52
03402          PERFORM S805-MSG-AREA THRU S805-EXIT.                    DTSCS52
03403                                                                   DTSCS52
03404      IF CURSOR-SET-GOTO                                           DTSCS52
03405          MOVE CATB-CURSOR TO MAP-GOTO-L                           DTSCS52
03406      ELSE                                                         DTSCS52
03407          MOVE CATB-CURSOR TO MAP-EMP-NO-1-L.                      DTSCS52
03408                                                                   DTSCS52
03409      SET L851-SEND-DATAONLY-88 TO TRUE.                           DTSCS52
03410                                                                   DTSCS52
03411      PERFORM S9900-PREPARE-SEND THRU S9900-EXIT.                  DTSCS52
03412                                                                   DTSCS52
03413      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS52
03414  S9200-EXIT.                                                      DTSCS52
03415      EXIT.                                                        DTSCS52
03416      SKIP3                                                        DTSCS52
03417  S9300-SEND-MAP.                                                  DTSCS52
03418      MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE.              DTSCS52
03419                                                                   DTSCS52
03420      MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME.              DTSCS52
03421                                                                   DTSCS52
03422      MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME.          DTSCS52
03423                                                                   DTSCS52
03424      IF SCR-ACCESS-UPDATE                                         DTSCS52
03425          PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT               DTSCS52
03426      ELSE                                                         DTSCS52
03427          PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT.             DTSCS52
03428                                                                   DTSCS52
03429      PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT.                   DTSCS52
03430                                                                   DTSCS52
03431      PERFORM S805-MSG-AREA THRU S805-EXIT.                        DTSCS52
03432                                                                   DTSCS52
03433      IF CURSOR-SET-NO                                             DTSCS52
03434          MOVE CATB-CURSOR TO MAP-EMP-NO-1-L.                      DTSCS52
03435                                                                   DTSCS52
03436      SET L851-SEND-88 TO TRUE.                                    DTSCS52
03437                                                                   DTSCS52
03438      PERFORM S9900-PREPARE-SEND THRU S9900-EXIT.                  DTSCS52
03439                                                                   DTSCS52
03440      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS52
03441  S9300-EXIT.                                                      DTSCS52
03442      EXIT.                                                        DTSCS52
03443      SKIP3                                                        DTSCS52
03444  S9310-UPDATE-FKEYS.                                              DTSCS52
03445      PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT.                 DTSCS52
03446                                                                   DTSCS52
03447      IF LCCM-SCR-CLEAR                                            DTSCS52
03448          MOVE CFKD-ADD TO MAP-KEY-ADD                             DTSCS52
03449      ELSE                                                         DTSCS52
03450      IF LCCM-SCR-INQUIRE                                          DTSCS52
03451          MOVE CFKD-MOD TO MAP-KEY-MOD                             DTSCS52
03452          MOVE CFKD-DEL TO MAP-KEY-DEL                             DTSCS52
03453      ELSE                                                         DTSCS52
03454      IF LCCM-SCR-UPDATE-LOCKED                                    DTSCS52
03455          MOVE LOW-VALUES TO MAP-KEY-FIRST                         DTSCS52
03456                             MAP-KEY-LAST                          DTSCS52
03457                             MAP-KEY-BACK                          DTSCS52
03458                             MAP-KEY-FWRD                          DTSCS52
03459                             MAP-KEY-ADD                           DTSCS52
03460                             MAP-KEY-MOD                           DTSCS52
03461                             MAP-KEY-DEL.                          DTSCS52
03462  S9310-EXIT.                                                      DTSCS52
03463      EXIT.                                                        DTSCS52
03464      SKIP3                                                        DTSCS52
03465  S9320-INQUIRY-FKEYS.                                             DTSCS52
03466      MOVE CFKD-FIRST TO MAP-KEY-FIRST.                            DTSCS52
03467                                                                   DTSCS52
03468      MOVE CFKD-LAST TO MAP-KEY-LAST.                              DTSCS52
03469                                                                   DTSCS52
03470      MOVE CFKD-BACKWARD TO MAP-KEY-BACK.                          DTSCS52
03471                                                                   DTSCS52
03472      MOVE CFKD-FORWARD TO MAP-KEY-FWRD.                           DTSCS52
03473                                                                   DTSCS52
03474      MOVE LOW-VALUES TO MAP-KEY-ADD                               DTSCS52
03475                         MAP-KEY-MOD                               DTSCS52
03476                         MAP-KEY-DEL.                              DTSCS52
03477  S9320-EXIT.                                                      DTSCS52
03478      EXIT.                                                        DTSCS52
03479      SKIP3                                                        DTSCS52
03480  S9330-DSCR-FIELDS.                                               DTSCS52
03481      IF WRK-MPRF-YES-88                                           DTSCS52
03482          MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME.              DTSCS52
03483  S9330-EXIT.                                                      DTSCS52
03484      EXIT.                                                        DTSCS52
03485      SKIP3                                                        DTSCS52
03486 *S9335-TOTALS.                                                    DTSCS52
03487 *****IF WRK-TBL-OK-88(1)                                          DTSCS52
03488 ********MOVE WRK-TBL-TOT(1) TO MAP-TOTAL-WG-CHNG-N                DTSCS52
03489 *****ELSE                                                         DTSCS52
03490 ********MOVE '  - -ERROR- -  ' TO MAP-TOTAL-WG-CHNG.              DTSCS52
03491                                                                   DTSCS52
03492 *****IF WRK-TBL-OK-88(2)                                          DTSCS52
03493 ********MOVE WRK-TBL-TOT(2) TO MAP-TOTAL-TAX-WG-CHNG-N            DTSCS52
03494 *****ELSE                                                         DTSCS52
03495 ********MOVE '  - -ERROR- -  ' TO MAP-TOTAL-TAX-WG-CHNG.          DTSCS52
03496                                                                   DTSCS52
03497 *****IF WRK-TBL-OK-88(3)                                          DTSCS52
03498 ********MOVE WRK-TBL-TOT(3) TO MAP-TOTAL-UI-PAID-CHNG-N           DTSCS52
03499 *****ELSE                                                         DTSCS52
03500 ********MOVE '  - -ERROR- -  ' TO MAP-TOTAL-UI-PAID-CHNG.         DTSCS52
03501                                                                   DTSCS52
03502 *****IF WRK-TBL-OK-88(4)                                          DTSCS52
03503 ********MOVE WRK-TBL-TOT(4) TO MAP-TOTAL-BEN-CHARGE-CHNG-N        DTSCS52
03504 *****ELSE                                                         DTSCS52
03505 ********MOVE '  - -ERROR- -  ' TO MAP-TOTAL-BEN-CHARGE-CHNG.      DTSCS52
03506 *S9335-EXIT.                                                      DTSCS52
03507 *****EXIT.                                                        DTSCS52
03508      SKIP3                                                        DTSCS52
03509  S9900-PREPARE-SEND.                                              DTSCS52
03510      MOVE WRK-SCR-ID TO L851-SCR-ID                               DTSCS52
03511                         LCCM-SCR-ID.                              DTSCS52
03512                                                                   DTSCS52
03513      MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND.                    DTSCS52
03514                                                                   DTSCS52
03515      MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE.                         DTSCS52
03516  S9900-EXIT.                                                      DTSCS52
03517      EXIT.                                                        DTSCS52
