00001  IDENTIFICATION DIVISION.                                         05/19/08
00002  PROGRAM-ID.             DTSCS48.                                 DTSCS48
00003  AUTHOR.                 NGC.                                        LV007
00004  DATE-WRITTEN.           APRIL 2004.                              DTSCS48
00005  DATE-COMPILED.                                                   DTSCS48
00006      SKIP3                                                        DTSCS48
00007 *****                                                             DTSCS48
00008 *                                                                 DTSCS48
00009 *    FUNCTION:  COMPROMISE SETTLEMENT INQUIRY/UPDATE              DTSCS48
00010 *               SCREEN PROCESSOR.                                 DTSCS48
00011 *                                                                 DTSCS48
00012 *                                                                 DTSCS48
00013 *    MODIFICATION LOG:                                            DTSCS48
00014 *                                                                 DTSCS48
00015 *    04/23/2004  INITIAL DEVELOPMENT.                             DTSCS48
00016 *                REFERENCE: COMPROMISE            PROGRAMMER:     DTSCS48
00017 *                                                                 DTSCS48
00018 *                                                                 DTSCS48
00019 *    04/25/2007  MODIFIED CODE TO EXCLUDE SUR-TAX FROM INTEREST   DTSCS48
00020 *                CALC.                                            DTSCS48
00021 *                REFERENCE: SUR TAX               PROGRAMMER: ZL1 DTSCS48
00022 *                                                                 DTSCS48
00023 *                                                                 DTSCS48
00024 *    02/12/2008  MODIFIED CODE TO INCLUDE SUR-TAX IN INTEREST     DTSCS48
00025 *                CALC.                                            DTSCS48
00026 *                REFERENCE: SUR TAX               PROGRAMMER: ZL1 DTSCS48
00027 *                                                                 DTSCS48
00028 *                                                                 DTSCS48
00029 *  DESCRIPTION:                                                   DTSCS48
00030 *                                                                 DTSCS48
00031 *    CLEAR:                                                       DTSCS48
00032 *                                                                 DTSCS48
00033 *      FIELD DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO).            DTSCS48
00034 *                                                                 DTSCS48
00035 *                                                                 DTSCS48
00036 *    JUMP:                                                        DTSCS48
00037 *                                                                 DTSCS48
00038 *      F19  QUARTER INQUIRY (31).                                 DTSCS48
00039 *      F20  COLLECTIONS INQUIRY (41).                             DTSCS48
00040 *                                                                 DTSCS48
00041 *                                                                 DTSCS48
00042 *    INQUIRY:                                                     DTSCS48
00043 *                                                                 DTSCS48
00044 *      CONTROL FIELD(S): MAP-EMP-NO.                              DTSCS48
00045 *                                                                 DTSCS48
00046 *      JUMP IN:  IF LCCM-EMP-NO = LCCM-SCR48-HOLD-AREA  EMP-NO    DTSCS48
00047 *                  DISPLAY RECORD INDICATED BY                    DTSCS48
00048 *                  LCCM-SCR48-HOLD-AREA                           DTSCS48
00049 *                ELSE                                             DTSCS48
00050 *                  DISPLAY LAST PAGE OF DATA ASSOCIATED           DTSCS48
00051 *                  WITH LCCM-EMP-NO.                              DTSCS48
00052 *                                                                 DTSCS48
00053 *      ENTER, F05, F06, F07, F08: STANDARD PAGING.                DTSCS48
00054 *                                                                 DTSCS48
00055 *               DISPLAY SEQUENCE: ASCENDING ON MCMP-ESTB-ABSTIME. DTSCS48
00056 *                                                                 DTSCS48
00057 *       PAGE INITIALLY DISPLAYED: LAST.                           DTSCS48
00058 *                                                                 DTSCS48
00059 *                                                                 DTSCS48
00060 *      JUMP OUT:  STANDARD LCCM-EMP-NO MAINTENANCE.               DTSCS48
00061 *                                                                 DTSCS48
00062 *                 STORE INFORMATION REPRESENTING PAGE             DTSCS48
00063 *                 CURRENTLY DISPLAYED IN LCCM-SCR48-HOLD-AREA.    DTSCS48
00064 *                                                                 DTSCS48
00065 *                                                                 DTSCS48
00066 *      STORE PAGING CONTROL INFORMATION IN LCCM-SCR-HOLD-AREA.    DTSCS48
00067 *                                                                 DTSCS48
00068 *      MAINTAIN LCCM-COMP-DATE.                                   DTSCS48
00069 *                                                                 DTSCS48
00070 *                                                                 DTSCS48
00071 *    UPDATE:                                                      DTSCS48
00072 *                                                                 DTSCS48
00073 *      ADD                                                        DTSCS48
00074 *      MOD                                                        DTSCS48
00075 *      DEL                                                        DTSCS48
00076 *                                                                 DTSCS48
00077 *                                                                 DTSCS48
00078 *    RECORDS READ:                                                DTSCS48
00079 *                                                                 DTSCS48
00080 *      MASTER:                                                    DTSCS48
00081 *                                                                 DTSCS48
00082 *        MPRF                                                     DTSCS48
00083 *        MCMP                                                     DTSCS48
00084 *        MQTR                                                     DTSCS48
00085 *                                                                 DTSCS48
00086 *                                                                 DTSCS48
00087 *      ALTERNATE INDEX:                                           DTSCS48
00088 *                                                                 DTSCS48
00089 *        NONE.                                                    DTSCS48
00090 *                                                                 DTSCS48
00091 *                                                                 DTSCS48
00092 *      REFERENCE:                                                 DTSCS48
00093 *                                                                 DTSCS48
00094 *        NONE.                                                    DTSCS48
00095 *                                                                 DTSCS48
00096 *                                                                 DTSCS48
00097 *      ACCOUNTING TRANSACTION COLLECTION:                         DTSCS48
00098 *                                                                 DTSCS48
00099 *        NONE.                                                    DTSCS48
00100 *                                                                 DTSCS48
00101 *                                                                 DTSCS48
00102 *    RECORDS UPDATED:                                             DTSCS48
00103 *                                                                 DTSCS48
00104 *      MASTER:                                                    DTSCS48
00105 *                                                                 DTSCS48
00106 *        MCMP (WRITE, REWRITE, DELETE)                            DTSCS48
00107 *                                                                 DTSCS48
00108 *        MEVL (WRITE)                                             DTSCS48
00109 *          IF A CMP IS ADDED OR DELETED, THEN WRITE A MEVL RECORD DTSCS48
00110 *            COMMEMORATING THE EVENT.                             DTSCS48
00111 *          IF A CMP IS 'WITHDRAWN', THEN WRITE A                  DTSCS48
00112 *            MEVL RECORD COMMEMORATING THE EVENT.                 DTSCS48
00113 *                                                                 DTSCS48
00114 *                                                                 DTSCS48
00115 *      REFERENCE:                                                 DTSCS48
00116 *                                                                 DTSCS48
00117 *        NONE.                                                    DTSCS48
00118 *                                                                 DTSCS48
00119 *                                                                 DTSCS48
00120 *      ACCOUNTING TRANSACTION COLLECTION:                         DTSCS48
00121 *                                                                 DTSCS48
00122 *        NONE.                                                    DTSCS48
00123 *                                                                 DTSCS48
00124 *                                                                 DTSCS48
00125 *    ON-LINE ACTIVITY FILE RECORDS WRITTEN:                       DTSCS48
00126 *                                                                 DTSCS48
00127 *      NONE.                                                      DTSCS48
00128 *                                                                 DTSCS48
00129 *                                                                 DTSCS48
00130 *    TEMPORARY STORAGE USAGE:                                     DTSCS48
00131 *                                                                 DTSCS48
00132 *      NONE                                                       DTSCS48
00133 *                                                                 DTSCS48
00134 *                                                                 DTSCS48
00135 *    MODULES LINKED TO:                                           DTSCS48
00136 *                                                                 DTSCS48
00137 *      DTSCU001  DATE EDIT/CONVERSION.                            DTSCS48
00138 *      DTSCU004  QUARTER EDIT/CONVERSION.                         DTSCS48
00139 *      DTSCU011  AMOUNT FROM SCREEN FORMAT/EDIT.                  DTSCS48
00140 *      DTSCU015  DATE FROM SCREEN FORMAT/EDIT.                    DTSCS48
00141 *      DTSCU029  YEAR/QUARTER FROM SCREEN FORMAT/EDIT.            DTSCS48
00142 *      DTSCU018  EMPLOYER NUMBER FROM SCREEN FORMAT/EDIT.         DTSCS48
00143 *      DTSCU034  COLLECTIONS CODES EDIT/DESCRIPTION.              DTSCS48
00144 *      DTSCU071  NAME EDIT/CONVERSION.                            DTSCS48
00145 *      DTSCU082  OPERATOR ID EDIT/LOOKUP.                         DTSCS48
00146 *      DTSCU101  INTEREST AND PENALTY CHARGE/ABATEMENT            DTSCS48
00147 *                COMPUTATION.                                     DTSCS48
00148 *      DTSCU111  ADDRESS LOOKUP.                                  DTSCS48
00149 *      DTSCU112  FORMAT ADDRESS FOR MAILING.                      DTSCS48
00150 *      DTSCU221  EMPLOYER LOCK/UNLOCK.                            DTSCS48
00151 *      DTSCU810  MASTER FILE INPUT/OUTPUT.                        DTSCS48
00152 *****                                                             DTSCS48
00153                                                                   DTSCS48
00154  ENVIRONMENT DIVISION.                                            DTSCS48
00155                                                                   DTSCS48
00156  DATA DIVISION.                                                   DTSCS48
00157                                                                   DTSCS48
00158  WORKING-STORAGE SECTION.                                         DTSCS48
001585 77  PAN-VALET PICTURE X(24) VALUE '007DTSCS48   05/19/08'.       DTSCS48
00159                                                                   DTSCS48
00160  01  WRK-AREA.                                                    DTSCS48
00161      05  WRK-ABEND-CD                PIC  X(04)  VALUE 'S48 '.    DTSCS48
00162                                                                   DTSCS48
00163      05  WRK-SCR-ID.                                              DTSCS48
00164          10  WRK-SCR-ID-N            PIC  9(02)  VALUE 48.        DTSCS48
00165                                                                   DTSCS48
00166      05  WRK-F03-SCR-ID              PIC  X(02)  VALUE '40'.      DTSCS48
00167                                                                   DTSCS48
00168      05  ALL-NINES-DATE              PIC S9(09)  COMP-3           DTSCS48
00169                                             VALUE +999999999.     DTSCS48
00170                                                                   DTSCS48
00171      05  SCR-ACCESS-IND              PIC X(01).                   DTSCS48
00172          88  SCR-ACCESS-INQ                  VALUE '1'.           DTSCS48
00173          88  SCR-ACCESS-UPDATE               VALUE '2'.           DTSCS48
00174                                                                   DTSCS48
00175      05  CURSOR-SET-IND              PIC X(01).                   DTSCS48
00176          88  CURSOR-SET-YES                  VALUE 'Y'.           DTSCS48
00177          88  CURSOR-SET-NO                   VALUE 'N'.           DTSCS48
00178          88  CURSOR-SET-GOTO                 VALUE 'G'.           DTSCS48
00179                                                                   DTSCS48
00180      05  REQ-IND                     PIC X(01).                   DTSCS48
00181          88  REQ-CURSOR-TO-GOTO              VALUE 'G'.           DTSCS48
00182          88  REQ-ERROR                       VALUE 'O'.           DTSCS48
00183          88  REQ-JUMP                        VALUE 'J'.           DTSCS48
00184          88  REQ-UPDATE                      VALUE 'U'.           DTSCS48
00185          88  REQ-INQUIRE                     VALUE 'I'.           DTSCS48
00186          88  REQ-CLEAR                       VALUE 'C'.           DTSCS48
00187          88  REQ-EDIT                        VALUE 'E'.           DTSCS48
00188                                                                   DTSCS48
00189      05  RESP-IND                    PIC X(01).                   DTSCS48
00190          88  RESP-SEND-MSGONLY               VALUE 'O'.           DTSCS48
00191          88  RESP-SEND-MAP                   VALUE 'M'.           DTSCS48
00192          88  RESP-JUMP                       VALUE 'J'.           DTSCS48
00193          88  RESP-CURSOR-TO-GOTO             VALUE 'G'.           DTSCS48
00194                                                                   DTSCS48
00195      05  WRK-MSG-AREA                PIC  X(64).                  DTSCS48
00196                                                                   DTSCS48
00197      05  WRK-ATB-AN                  PIC  X(01).                  DTSCS48
00198                                                                   DTSCS48
00199      05  WRK-ATB-NUM                 PIC  X(01).                  DTSCS48
00200                                                                   DTSCS48
00201      05  WRK-EMP-NO                  PIC S9(07)  COMP-3.          DTSCS48
00202                                                                   DTSCS48
00203      05  WRK-AMT-DUE                 PIC S9(09)V9(02) COMP-3.     DTSCS48
00204      05  WRK-TAX-WAIVED-AMT          PIC S9(09)V9(02) COMP-3.     DTSCS48
00205      05  WRK-PEN-WAIVED-AMT          PIC S9(09)V9(02) COMP-3.     DTSCS48
00206      05  WRK-INT-WAIVED-AMT          PIC S9(09)V9(02) COMP-3.     DTSCS48
00207      05  WRK-TOT-BALANCE-AMT         PIC S9(09)V9(02) COMP-3.     DTSCS48
00208      05  WRK-YRQ-WAIVED-AMT          PIC S9(09)V9(02) COMP-3.     DTSCS48
00209      05  WRK-YRQ-BALANCE-AMT         PIC S9(09)V9(02) COMP-3.     DTSCS48
00210      05  WRK-YRQ-TAX-BAL-AMT         PIC S9(09)V9(02) COMP-3.     DTSCS48
00211      05  WRK-YRQ-WRITTEN-OFF-AMT     PIC S9(09)V9(02) COMP-3.     DTSCS48
00212      05  WRK-STATUS-CD               PIC  X(01).                  DTSCS48
00213                                                                   DTSCS48
00214      05  WRK-SUB                     PIC S9(04)  COMP.            DTSCS48
00215      05  WRK-ANN-SUB                 PIC S9(04)  COMP.            DTSCS48
00216      05  MAP-CNT                     PIC S9(04)  COMP.            DTSCS48
00217                                                                   DTSCS48
00218      05  WRK-SUB2                    PIC S9(04)  COMP.            DTSCS48
00219                                                                   DTSCS48
00220                                                                   DTSCS48
00221      05  WRK-YRQ                     PIC  9(05).                  DTSCS48
00222      05  FILLER REDEFINES WRK-YRQ.                                DTSCS48
00223          10  WRK-YRQ-YR              PIC  9(04).                  DTSCS48
00224          10  WRK-YRQ-Q               PIC  9(01).                  DTSCS48
00225                                                                   DTSCS48
00226                                                                   DTSCS48
00227                                                                   DTSCS48
00228      05  WRK-TBL-SUB                 PIC S9(04)  COMP.            DTSCS48
00229                                                                   DTSCS48
00230      05  WRK-SUB-MINUS-ONE           PIC S9(04)  COMP.            DTSCS48
00231                                                                   DTSCS48
00232      05  WRK-NO-ENTRY-CTR            PIC S9(04)  COMP.            DTSCS48
00233                                                                   DTSCS48
00234      05  WRK-MPRF-IND                PIC  X(01).                  DTSCS48
00235          88  WRK-MPRF-YES-88                VALUE 'Y'.            DTSCS48
00236          88  WRK-MPRF-NO-88                 VALUE 'N'.            DTSCS48
00237                                                                   DTSCS48
00238      05  WRK-MCMP-IND                PIC  X(01).                  DTSCS48
00239          88  WRK-MCMP-YES-88                VALUE 'Y'.            DTSCS48
00240          88  WRK-MCMP-NO-88                 VALUE 'N'.            DTSCS48
00241                                                                   DTSCS48
00242      05  WRK-TBL OCCURS 40 TIMES.                                 DTSCS48
00243          10  WRK-TBL-QTR             PIC S9(05) COMP-3.           DTSCS48
00244          10  WRK-TBL-BALANCE         PIC S9(09)V99 COMP-3.        DTSCS48
00245                                                                   DTSCS48
00246                                                                   DTSCS48
00247      05  WRK-DISPLAY                 PIC 9(11).                   DTSCS48
00248                                                                   DTSCS48
00249      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS48
00250          10  FILLER                  PIC X(05).                   DTSCS48
00251          10  WRK-DISPLAY-EMP-NO-1    PIC X(03).                   DTSCS48
00252          10  WRK-DISPLAY-EMP-NO-2    PIC X(03).                   DTSCS48
00253                                                                   DTSCS48
00254      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS48
00255          10  FILLER                  PIC X(05).                   DTSCS48
00256          10  WRK-DISPLAY-YR          PIC X(02).                   DTSCS48
00257          10  WRK-DISPLAY-MO          PIC X(02).                   DTSCS48
00258          10  WRK-DISPLAY-DA          PIC X(02).                   DTSCS48
00259                                                                   DTSCS48
00260      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS48
00261          10  FILLER                  PIC X(08).                   DTSCS48
00262          10  WRK-DISPLAY-YRQ-YR      PIC X(02).                   DTSCS48
00263          10  WRK-DISPLAY-YRQ-Q       PIC X(01).                   DTSCS48
00264                                                                   DTSCS48
00265                                                                   DTSCS48
00266      05  INQUIRY-CONTROL-AREA.                                    DTSCS48
00267          10  LAST-REC-NUM            PIC S9(08)  COMP.            DTSCS48
00268          10  WS-REC-NUM              PIC S9(08)  COMP.            DTSCS48
00269                                                                   DTSCS48
00270          10  LAST-REC-KEY-AREA       PIC  X(16).                  DTSCS48
00271          10  SCR-REC-KEY-AREA        PIC  X(16).                  DTSCS48
00272                                                                   DTSCS48
00273          10  WS-REC-FOUND-IND        PIC  X(01).                  DTSCS48
00274                                                                   DTSCS48
00275                                                                   DTSCS48
00276      05  EVL-TEXT.                                                DTSCS48
00277          10  FILLER                  PIC  X(26)  VALUE            DTSCS48
00278              'COMPROMISE SETTLEMENT     '.                        DTSCS48
00279          10  EVL-STATUS-CD-DSCR      PIC  X(12).                  DTSCS48
00280      EJECT                                                        DTSCS48
00281  01  MSG-LITERALS.                                                DTSCS48
00282                                                                   DTSCS48
00283      05  MSG-E481-AREA.                                           DTSCS48
00284          10  FILLER                  PIC  X(04)  VALUE 'E481'.    DTSCS48
00285          10  FILLER                  PIC  X(30)                   DTSCS48
00286                VALUE 'YRQ MUST BE IN ASCENDING SEQUE'.            DTSCS48
00287          10  FILLER                  PIC  X(30)                   DTSCS48
00288                VALUE 'NCE                           '.            DTSCS48
00289                                                                   DTSCS48
00290      05  MSG-E482-AREA.                                           DTSCS48
00291          10  FILLER                  PIC  X(04)  VALUE 'E482'.    DTSCS48
00292          10  FILLER                  PIC  X(30)                   DTSCS48
00293                VALUE 'NO UI TAX DUE                 '.            DTSCS48
00294          10  FILLER                  PIC  X(30)                   DTSCS48
00295                VALUE '                              '.            DTSCS48
00296                                                                   DTSCS48
00297      05  MSG-E483-AREA.                                           DTSCS48
00298          10  FILLER                  PIC  X(04)  VALUE 'E483'.    DTSCS48
00299          10  FILLER                  PIC  X(30)                   DTSCS48
00300                VALUE 'STATUS MAY ONLY BE CHANGED TO '.            DTSCS48
00301          10  FILLER                  PIC  X(30)                   DTSCS48
00302                VALUE 'WITHDRAWN                     '.            DTSCS48
00303                                                                   DTSCS48
00304      05  MSG-E484-AREA.                                           DTSCS48
00305          10  FILLER                  PIC  X(04)  VALUE 'E484'.    DTSCS48
00306          10  FILLER                  PIC  X(30)                   DTSCS48
00307                VALUE 'AT LEAST ONE QUARTER MUST BE E'.            DTSCS48
00308          10  FILLER                  PIC  X(30)                   DTSCS48
00309                VALUE 'NTERED                        '.            DTSCS48
00310                                                                   DTSCS48
00311                                                                   DTSCS48
00312      05  MSG-E486-AREA.                                           DTSCS48
00313          10  FILLER                  PIC  X(04)  VALUE 'E486'.    DTSCS48
00314          10  FILLER                  PIC  X(30)                   DTSCS48
00315                VALUE 'STATUS MAY NOT BE CHANGED ONCE'.            DTSCS48
00316          10  FILLER                  PIC  X(30)                   DTSCS48
00317                VALUE ' WITHDRAWN                    '.            DTSCS48
00318                                                                   DTSCS48
00319      05  MSG-E487-AREA.                                           DTSCS48
00320          10  FILLER                  PIC  X(04)  VALUE 'E487'.    DTSCS48
00321          10  FILLER                  PIC  X(30)                   DTSCS48
00322                VALUE 'PENDING COMPROMISE SETTLEMENT '.            DTSCS48
00323          10  FILLER                  PIC  X(30)                   DTSCS48
00324                VALUE 'ALREADY ON FILE               '.            DTSCS48
00325                                                                   DTSCS48
00326      EJECT                                                        DTSCS48
00327  01  L001-COMM-AREA.                                              DTSCS48
00328  ++INCLUDE DTSIL001                                               DTSCS48
00329      EJECT                                                        DTSCS48
00330  01  L011-COMM-AREA.                                              DTSCS48
00331  ++INCLUDE DTSIL011                                               DTSCS48
00332      EJECT                                                        DTSCS48
00333  01  L013-COMM-AREA.                                              DTSCS48
00334  ++INCLUDE DTSIL013                                               DTSCS48
00335      EJECT                                                        DTSCS48
00336  01  L015-COMM-AREA.                                              DTSCS48
00337  ++INCLUDE DTSIL015                                               DTSCS48
00338      EJECT                                                        DTSCS48
00339  01  L018-COMM-AREA.                                              DTSCS48
00340  ++INCLUDE DTSIL018                                               DTSCS48
00341      EJECT                                                        DTSCS48
00342  01  L029-COMM-AREA.                                              DTSCS48
00343  ++INCLUDE DTSIL029                                               DTSCS48
00344      EJECT                                                        DTSCS48
00345  01  L034-COMM-AREA.                                              DTSCS48
00346  ++INCLUDE DTSIL034                                               DTSCS48
00347      EJECT                                                        DTSCS48
00348  01  L071-COMM-AREA.                                              DTSCS48
00349  ++INCLUDE DTSIL071                                               DTSCS48
00350      EJECT                                                        DTSCS48
00351  01  L082-COMM-AREA.                                              DTSCS48
00352  ++INCLUDE DTSIL082                                               DTSCS48
00353      EJECT                                                        DTSCS48
00354  01  L101-COMM-AREA.                                              DTSCS48
00355  ++INCLUDE DTSIL101                                               DTSCS48
00356      EJECT                                                        DTSCS48
00357  01  L111-COMM-AREA.                                              DTSCS48
00358  ++INCLUDE DTSIL111                                               DTSCS48
00359      EJECT                                                        DTSCS48
00360  01  L112-COMM-AREA.                                              DTSCS48
00361  ++INCLUDE DTSIL112                                               DTSCS48
00362      EJECT                                                        DTSCS48
00363  01  L109-COMM-AREA.                                              DTSCS48
00364  ++INCLUDE DTSIL109                                               DTSCS48
00365      EJECT                                                        DTSCS48
00366  01  L221-COMM-AREA.                                              DTSCS48
00367  ++INCLUDE DTSIL221                                               DTSCS48
00368      EJECT                                                        DTSCS48
00369  01  L805-COMM-AREA.                                              DTSCS48
00370  ++INCLUDE DTSIL805                                               DTSCS48
00371      EJECT                                                        DTSCS48
00372  01  L810-COMM-AREA.                                              DTSCS48
00373      05  L810-CONTROL-BLOCK.                                      DTSCS48
00374  ++INCLUDE DTSIL810                                               DTSCS48
00375      EJECT                                                        DTSCS48
00376      05  MSKL-REC.                                                DTSCS48
00377  ++INCLUDE DTSIMSKL                                               DTSCS48
00378      EJECT                                                        DTSCS48
00379  01  MPRF-REC.                                                    DTSCS48
00380  ++INCLUDE DTSIMPRF                                               DTSCS48
00381      EJECT                                                        DTSCS48
00382  01  MCMP-REC.                                                    DTSCS48
00383  ++INCLUDE DTSIMCMP                                               DTSCS48
00384      EJECT                                                        DTSCS48
00385  01  MQTR-REC.                                                    DTSCS48
00386  ++INCLUDE DTSIMQTR                                               DTSCS48
00387      EJECT                                                        DTSCS48
00388  01  MTCK-REC.                                                    DTSCS48
00389  ++INCLUDE DTSIMTCK                                               DTSCS48
00390      EJECT                                                        DTSCS48
00391  01  MEVL-REC.                                                    DTSCS48
00392  ++INCLUDE DTSIMEVL                                               DTSCS48
00393      EJECT                                                        DTSCS48
00394  01  L825-COMM-AREA.                                              DTSCS48
00395      05  L825-CONTROL-BLOCK.                                      DTSCS48
00396  ++INCLUDE DTSIL825                                               DTSCS48
00397                                                                   DTSCS48
00398      05  RSKL-REC.                                                DTSCS48
00399  ++INCLUDE DTSIRSK1                                               DTSCS48
00400      SKIP3                                                        DTSCS48
00401  01  T011-REC.                                                    DTSCS48
00402  ++INCLUDE DTSIT011                                               DTSCS48
00403      EJECT                                                        DTSCS48
00404  01  L851-COMM-AREA.                                              DTSCS48
00405  ++INCLUDE DTSIL851                                               DTSCS48
00406                                                                   DTSCS48
00407      05  MAP-AREA REDEFINES L851-MAP-AREA.                        DTSCS48
00408  ++INCLUDE DTSIS48                                                DTSCS48
00409      EJECT                                                        DTSCS48
00410  01  CATB-LITERALS.                                               DTSCS48
00411  ++INCLUDE DTSICATB                                               DTSCS48
00412                                                                   DTSCS48
00413  01  CFKD-LITERALS.                                               DTSCS48
00414  ++INCLUDE DTSICFKD                                               DTSCS48
00415                                                                   DTSCS48
00416  01  CECD-LITERALS.                                               DTSCS48
00417  ++INCLUDE DTSICECD                                               DTSCS48
00418                                                                   DTSCS48
00419  01  CPCD-LITERALS.                                               DTSCS48
00420  ++INCLUDE DTSICPCD                                               DTSCS48
00421      EJECT                                                        DTSCS48
00422                                                                   DTSCS48
00423  01  MMAX-LITERALS.                                               DTSCS48
00424  ++INCLUDE DTSIMMAX                                               DTSCS48
00425      EJECT                                                        DTSCS48
00426  LINKAGE SECTION.                                                 DTSCS48
00427                                                                   DTSCS48
00428  01  DFHCOMMAREA.                                                 DTSCS48
00429  ++INCLUDE DTSILCCM                                               DTSCS48
00430      SKIP3                                                        DTSCS48
00431              15  FILLER REDEFINES LCCM-SCR-HOLD-AREA.             DTSCS48
00432                  20  LCCM-SCR-HOLD-PROG-NAME    PIC  X(07).       DTSCS48
00433                  20  LCCM-SCR-HOLD-KEY          PIC  X(16).       DTSCS48
00434                  20  LCCM-SCR-HOLD-STATUS-CD    PIC  X(01).       DTSCS48
00435      EJECT                                                        DTSCS48
00436 ***************************************************************** DTSCS48
00437 *                                                                 DTSCS48
00438 ***************************************************************** DTSCS48
00439                                                                   DTSCS48
00440  PROCEDURE DIVISION.                                              DTSCS48
00441                                                                   DTSCS48
00442      MOVE +0 TO WRK-EMP-NO.                                       DTSCS48
00443                                                                   DTSCS48
00444      SET WRK-MPRF-NO-88 TO TRUE.                                  DTSCS48
00445                                                                   DTSCS48
00446      SET WRK-MCMP-NO-88 TO TRUE.                                  DTSCS48
00447                                                                   DTSCS48
00448      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS48
00449                                                                   DTSCS48
00450      SET CURSOR-SET-NO TO TRUE.                                   DTSCS48
00451                                                                   DTSCS48
00452      MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N)                  DTSCS48
00453        TO SCR-ACCESS-IND.                                         DTSCS48
00454                                                                   DTSCS48
00455      IF SCR-ACCESS-UPDATE                                         DTSCS48
00456         IF LCCM-OP-IS-FLD-DESK-88                                 DTSCS48
00457         OR LCCM-OP-IS-ACCOUNTING-DESK-88                          DTSCS48
00458            NEXT SENTENCE                                          DTSCS48
00459         ELSE                                                      DTSCS48
00460            SET SCR-ACCESS-INQ  TO TRUE                            DTSCS48
00461         END-IF.                                                   DTSCS48
00462                                                                   DTSCS48
00463      MOVE SPACE TO REQ-IND.                                       DTSCS48
00464                                                                   DTSCS48
00465      PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT.               DTSCS48
00466                                                                   DTSCS48
00467 *-----------------------------------------------------            DTSCS48
00468 *    P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE           DTSCS48
00469 *    "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT             DTSCS48
00470 *    REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE             DTSCS48
00471 *    OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED.         DTSCS48
00472 *                                                                 DTSCS48
00473 *    THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE                DTSCS48
00474 *    PROCESSED.                                                   DTSCS48
00475 *                                                                 DTSCS48
00476 *    THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND,         DTSCS48
00477 *    INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE            DTSCS48
00478 *    WORK STATION OPERATOR.                                       DTSCS48
00479 *-----------------------------------------------------            DTSCS48
00480                                                                   DTSCS48
00481      MOVE SPACE TO RESP-IND.                                      DTSCS48
00482                                                                   DTSCS48
00483      IF REQ-ERROR                                                 DTSCS48
00484         PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT               DTSCS48
00485      ELSE                                                         DTSCS48
00486      IF REQ-JUMP                                                  DTSCS48
00487         PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT                DTSCS48
00488      ELSE                                                         DTSCS48
00489      IF REQ-CLEAR                                                 DTSCS48
00490         PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT               DTSCS48
00491      ELSE                                                         DTSCS48
00492      IF REQ-CURSOR-TO-GOTO                                        DTSCS48
00493         PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT              DTSCS48
00494      ELSE                                                         DTSCS48
00495      IF REQ-INQUIRE                                               DTSCS48
00496         PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT             DTSCS48
00497      ELSE                                                         DTSCS48
00498      IF REQ-EDIT                                                  DTSCS48
00499         PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT                DTSCS48
00500      ELSE                                                         DTSCS48
00501      IF REQ-UPDATE                                                DTSCS48
00502         PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT              DTSCS48
00503      ELSE                                                         DTSCS48
00504         GO TO S899-ABEND.                                         DTSCS48
00505                                                                   DTSCS48
00506 *-----------------------------------------------------            DTSCS48
00507 *    THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED             DTSCS48
00508 *    IN RESP-IND THE TYPE OF RESPONSE TO BE MADE.                 DTSCS48
00509 *-----------------------------------------------------            DTSCS48
00510                                                                   DTSCS48
00511      IF RESP-SEND-MAP                                             DTSCS48
00512          PERFORM S9300-SEND-MAP THRU S9300-EXIT                   DTSCS48
00513          SET LCCM-END-TASK-88 TO TRUE                             DTSCS48
00514      ELSE                                                         DTSCS48
00515      IF RESP-SEND-MSGONLY                                         DTSCS48
00516          PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT              DTSCS48
00517          SET LCCM-END-TASK-88 TO TRUE                             DTSCS48
00518      ELSE                                                         DTSCS48
00519      IF RESP-JUMP                                                 DTSCS48
00520          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS48
00521      ELSE                                                         DTSCS48
00522      IF RESP-CURSOR-TO-GOTO                                       DTSCS48
00523          PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT              DTSCS48
00524          SET LCCM-END-TASK-88 TO TRUE                             DTSCS48
00525      ELSE                                                         DTSCS48
00526          GO TO S899-ABEND.                                        DTSCS48
00527                                                                   DTSCS48
00528  MAINLINE-EXIT.                                                   DTSCS48
00529                                                                   DTSCS48
00530      EXEC CICS                                                    DTSCS48
00531          RETURN                                                   DTSCS48
00532      END-EXEC.                                                    DTSCS48
00533                                                                   DTSCS48
00534 *    GOBACK.                                                      DTSCS48
00535      EJECT                                                        DTSCS48
00536 /**************************************************************** DTSCS48
00537 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION          DTSCS48
00538 ***************************************************************** DTSCS48
00539  P1000-ANALYZE-REQUEST.                                           DTSCS48
00540                                                                   DTSCS48
00541 *-----------------------------------------------------            DTSCS48
00542 *     IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE)         DTSCS48
00543 *     THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE               DTSCS48
00544 *     REPLACED WITH ENTER)                                        DTSCS48
00545 *-----------------------------------------------------            DTSCS48
00546      IF LCCM-SCR-ID NOT = WRK-SCR-ID                              DTSCS48
00547         SET LCCM-ENTER-88 TO TRUE                                 DTSCS48
00548         IF LCCM-EMP-NO > ZERO                                     DTSCS48
00549             MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1                    DTSCS48
00550             MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2                    DTSCS48
00551         END-IF                                                    DTSCS48
00552         SET REQ-INQUIRE TO TRUE                                   DTSCS48
00553         GO TO P1000-EXIT.                                         DTSCS48
00554                                                                   DTSCS48
00555 *-----------------------------------------------------            DTSCS48
00556 *      MAP IS RECEIVED                                            DTSCS48
00557 *-----------------------------------------------------            DTSCS48
00558      PERFORM S9100-RECEIVE THRU S9100-EXIT.                       DTSCS48
00559                                                                   DTSCS48
00560 *-----------------------------------------------------            DTSCS48
00561 *    CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE            DTSCS48
00562 *    WORK STATION                                                 DTSCS48
00563 *-----------------------------------------------------            DTSCS48
00564      IF LCCM-CLEAR-88                                             DTSCS48
00565         SET REQ-CLEAR TO TRUE                                     DTSCS48
00566         GO TO P1000-EXIT.                                         DTSCS48
00567                                                                   DTSCS48
00568 *-----------------------------------------------------            DTSCS48
00569 *    IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED             DTSCS48
00570 *-----------------------------------------------------            DTSCS48
00571      IF LCCM-SCR-UPDATE-LOCKED                                    DTSCS48
00572         PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT               DTSCS48
00573         GO TO P1000-EXIT.                                         DTSCS48
00574                                                                   DTSCS48
00575 *-----------------------------------------------------            DTSCS48
00576 *    PA2 IS A REQUEST TO POSITION CURSOR AT GO TO:                DTSCS48
00577 *-----------------------------------------------------            DTSCS48
00578      IF LCCM-PA2-88                                               DTSCS48
00579          SET REQ-CURSOR-TO-GOTO TO TRUE                           DTSCS48
00580          GO TO P1000-EXIT.                                        DTSCS48
00581                                                                   DTSCS48
00582 *-----------------------------------------------------            DTSCS48
00583 *    ALL OTHER PA KEYS ARE NOT ACTIVE                             DTSCS48
00584 *-----------------------------------------------------            DTSCS48
00585      IF LCCM-PA-88                                                DTSCS48
00586        PERFORM S804-INVALID-KEY THRU S804-EXIT                    DTSCS48
00587        SET REQ-ERROR TO TRUE                                      DTSCS48
00588        GO TO P1000-EXIT.                                          DTSCS48
00589                                                                   DTSCS48
00590 *-----------------------------------------------------            DTSCS48
00591 *    IF F12 KEY IS PRESSED AND UPDATE NOT IN PROGRESS             DTSCS48
00592 *    THEN CLEAR SCREEN.                                           DTSCS48
00593 *-----------------------------------------------------            DTSCS48
00594      IF LCCM-F12-88                                               DTSCS48
00595         MOVE LOW-VALUES TO MAP-AREA                               DTSCS48
00596         SET REQ-CLEAR TO TRUE                                     DTSCS48
00597         GO TO P1000-EXIT.                                         DTSCS48
00598                                                                   DTSCS48
00599 *-----------------------------------------------------            DTSCS48
00600 *    IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION            DTSCS48
00601 *-----------------------------------------------------            DTSCS48
00602      IF LCCM-F03-88                                               DTSCS48
00603         MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID                    DTSCS48
00604         SET REQ-JUMP TO TRUE                                      DTSCS48
00605         GO TO P1000-EXIT.                                         DTSCS48
00606                                                                   DTSCS48
00607 *-----------------------------------------------------            DTSCS48
00608 *    IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN         DTSCS48
00609 *-----------------------------------------------------            DTSCS48
00610      IF LCCM-F04-88                                               DTSCS48
00611         MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID                 DTSCS48
00612         SET REQ-JUMP TO TRUE                                      DTSCS48
00613         GO TO P1000-EXIT.                                         DTSCS48
00614                                                                   DTSCS48
00615 *---------------------------------------------------------        DTSCS48
00616 *    IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO                DTSCS48
00617 *    CORRESPONDENCE SCREEN.                                       DTSCS48
00618 *---------------------------------------------------------        DTSCS48
00619                                                                   DTSCS48
00620      IF LCCM-F14-88                                               DTSCS48
00621         MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID                  DTSCS48
00622         SET REQ-JUMP TO TRUE                                      DTSCS48
00623         GO TO P1000-EXIT.                                         DTSCS48
00624                                                                   DTSCS48
00625 *-----------------------------------------------------            DTSCS48
00626 *    IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO               DTSCS48
00627 *    REQUESTED SCREEN TYPE                                        DTSCS48
00628 *-----------------------------------------------------            DTSCS48
00629 *                                                                 DTSCS48
00630 *    IF LCCM-F19-88                                               DTSCS48
00631 *       MOVE '31' TO LCCM-REQ-SCR-ID                              DTSCS48
00632 *       SET REQ-JUMP TO TRUE                                      DTSCS48
00633 *       GO TO P1000-EXIT.                                         DTSCS48
00634 *                                                                 DTSCS48
00635 *    IF LCCM-F20-88                                               DTSCS48
00636 *       MOVE '41' TO LCCM-REQ-SCR-ID                              DTSCS48
00637 *       SET REQ-JUMP TO TRUE                                      DTSCS48
00638 *       GO TO P1000-EXIT.                                         DTSCS48
00639 *                                                                 DTSCS48
00640 *-----------------------------------------------------            DTSCS48
00641 *    IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO               DTSCS48
00642 *    REQUESTED SCREEN TYPE                                        DTSCS48
00643 *-----------------------------------------------------            DTSCS48
00644      IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID             DTSCS48
00645         NEXT SENTENCE                                             DTSCS48
00646      ELSE                                                         DTSCS48
00647        MOVE MAP-GOTO TO LCCM-REQ-SCR-ID                           DTSCS48
00648        SET REQ-JUMP TO TRUE                                       DTSCS48
00649        GO TO P1000-EXIT.                                          DTSCS48
00650                                                                   DTSCS48
00651 *-----------------------------------------------------            DTSCS48
00652 *    IF REQUEST TO UPDATE THE DATA (ADD,MOD)                      DTSCS48
00653 *          VERIFY USER ACCESS TO PERFORM UPDATE                   DTSCS48
00654 *-----------------------------------------------------            DTSCS48
00655      IF LCCM-F09-88                                               DTSCS48
00656      OR LCCM-F10-88                                               DTSCS48
00657         IF SCR-ACCESS-UPDATE                                      DTSCS48
00658            SET REQ-EDIT TO TRUE                                   DTSCS48
00659            GO TO P1000-EXIT                                       DTSCS48
00660         ELSE                                                      DTSCS48
00661            PERFORM S804-INVALID-KEY THRU S804-EXIT                DTSCS48
00662            SET REQ-ERROR TO TRUE                                  DTSCS48
00663            GO TO P1000-EXIT.                                      DTSCS48
00664                                                                   DTSCS48
00665 *-----------------------------------------------------            DTSCS48
00666 *    IF INQUIRY TYPE KEY PRESSED (ENTER, F5, F6, F7,              DTSCS48
00667 *          OR F8), INDICATE INQUIRY REQUEST                       DTSCS48
00668 *-----------------------------------------------------            DTSCS48
00669      IF LCCM-INQUIRY-88                                           DTSCS48
00670          SET REQ-INQUIRE TO TRUE                                  DTSCS48
00671          GO TO P1000-EXIT.                                        DTSCS48
00672                                                                   DTSCS48
00673 *-----------------------------------------------------            DTSCS48
00674 *     ANY OTHER KEY IS INVALID                                    DTSCS48
00675 *-----------------------------------------------------            DTSCS48
00676      PERFORM S804-INVALID-KEY THRU S804-EXIT.                     DTSCS48
00677      SET REQ-ERROR TO TRUE.                                       DTSCS48
00678  P1000-EXIT.                                                      DTSCS48
00679      EXIT.                                                        DTSCS48
00680                                                                   DTSCS48
00681 ***************************************************************** DTSCS48
00682 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH  DTSCS48
00683 ***************************************************************** DTSCS48
00684                                                                   DTSCS48
00685  P1100-UPDATE-LOCKED.                                             DTSCS48
00686 *-----------------------------------------------------            DTSCS48
00687 *    IF THE SCREEN IS "LOCKED FOR UPDATE", THEN                   DTSCS48
00688 *    THE ONLY VALID OPERATOR REQUESTS ARE ENTER                   DTSCS48
00689 *    (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE).              DTSCS48
00690 *-----------------------------------------------------            DTSCS48
00691      IF LCCM-ENTER-88 OR LCCM-F12-88                              DTSCS48
00692          SET REQ-UPDATE TO TRUE                                   DTSCS48
00693      ELSE                                                         DTSCS48
00694          SET REQ-ERROR TO TRUE                                    DTSCS48
00695          IF LCCM-SCR-ADD-LOCKED                                   DTSCS48
00696              MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID                 DTSCS48
00697          ELSE                                                     DTSCS48
00698          IF LCCM-SCR-MOD-LOCKED                                   DTSCS48
00699              MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID                 DTSCS48
00700          ELSE                                                     DTSCS48
00701              GO TO S899-ABEND.                                    DTSCS48
00702  P1100-EXIT.                                                      DTSCS48
00703      EXIT.                                                        DTSCS48
00704 /**************************************************************** DTSCS48
00705 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED.  DTSCS48
00706 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN.                       DTSCS48
00707 ***************************************************************** DTSCS48
00708                                                                   DTSCS48
00709  P2000-REQUEST-ERROR.                                             DTSCS48
00710      IF LCCM-MSG                                                  DTSCS48
00711         SET RESP-SEND-MSGONLY TO TRUE                             DTSCS48
00712      ELSE                                                         DTSCS48
00713         GO TO S899-ABEND.                                         DTSCS48
00714  P2000-EXIT.                                                      DTSCS48
00715      EXIT.                                                        DTSCS48
00716 /**************************************************************** DTSCS48
00717 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED                   DTSCS48
00718 ***************************************************************** DTSCS48
00719                                                                   DTSCS48
00720  P3000-REQUEST-JUMP.                                              DTSCS48
00721 *-----------------------------------------------------            DTSCS48
00722 *    VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE    DTSCS48
00723 *    BY USER                                                      DTSCS48
00724 *-----------------------------------------------------            DTSCS48
00725      PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT.                 DTSCS48
00726                                                                   DTSCS48
00727 *-----------------------------------------------------            DTSCS48
00728 *    VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED               DTSCS48
00729 *-----------------------------------------------------            DTSCS48
00730      IF LCCM-MSG                                                  DTSCS48
00731         SET RESP-SEND-MSGONLY TO TRUE                             DTSCS48
00732         SET CURSOR-SET-GOTO TO TRUE                               DTSCS48
00733         GO TO P3000-EXIT.                                         DTSCS48
00734      SKIP3                                                        DTSCS48
00735      MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA.                  DTSCS48
00736      PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT.              DTSCS48
00737      IF L018-VALID                                                DTSCS48
00738          MOVE L018-EMP-NO TO LCCM-EMP-NO.                         DTSCS48
00739                                                                   DTSCS48
00740 *-----------------------------------------------------            DTSCS48
00741 *    CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING      DTSCS48
00742 *-----------------------------------------------------            DTSCS48
00743      MOVE LOW-VALUES TO LCCM-SCR-STATUS                           DTSCS48
00744                         LCCM-SCR-HOLD-AREA.                       DTSCS48
00745      MOVE +0 TO LCCM-SCR-ABSTIME.                                 DTSCS48
00746      SET RESP-JUMP TO TRUE.                                       DTSCS48
00747  P3000-EXIT.                                                      DTSCS48
00748      EXIT.                                                        DTSCS48
00749 /**************************************************************** DTSCS48
00750 * CLEAR KEY WAS PRESSED                                           DTSCS48
00751 ***************************************************************** DTSCS48
00752                                                                   DTSCS48
00753  P4000-REQUEST-CLEAR.                                             DTSCS48
00754                                                                   DTSCS48
00755 *-----------------------------------------------------            DTSCS48
00756 *   CLEAN UP INDICATORS AND PAGING STORAGE.  RESET KEY            DTSCS48
00757 *   FIELDS FROM EARLIER REQUESTS                                  DTSCS48
00758 *-----------------------------------------------------            DTSCS48
00759      IF LCCM-EMP-NO > ZERO                                        DTSCS48
00760          MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1                       DTSCS48
00761          MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2.                      DTSCS48
00762                                                                   DTSCS48
00763      MOVE ZERO TO LCCM-EMP-NO.                                    DTSCS48
00764                                                                   DTSCS48
00765                                                                   DTSCS48
00766      MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA.                       DTSCS48
00767                                                                   DTSCS48
00768      MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS48
00769                                                                   DTSCS48
00770      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS48
00771                                                                   DTSCS48
00772      IF SCR-ACCESS-UPDATE                                         DTSCS48
00773          PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT           DTSCS48
00774      ELSE                                                         DTSCS48
00775          PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT.             DTSCS48
00776                                                                   DTSCS48
00777      SET RESP-SEND-MAP TO TRUE.                                   DTSCS48
00778  P4000-EXIT.                                                      DTSCS48
00779      EXIT.                                                        DTSCS48
00780 /**************************************************************** DTSCS48
00781 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED                    DTSCS48
00782 ***************************************************************** DTSCS48
00783                                                                   DTSCS48
00784  P5000-CURSOR-TO-GOTO.                                            DTSCS48
00785      SET CURSOR-SET-GOTO TO TRUE.                                 DTSCS48
00786      SET RESP-CURSOR-TO-GOTO TO TRUE.                             DTSCS48
00787  P5000-EXIT.                                                      DTSCS48
00788      EXIT.                                                        DTSCS48
00789 /**************************************************************** DTSCS48
00790 * INQUIRY WAS REQUESTED                                           DTSCS48
00791 ***************************************************************** DTSCS48
00792                                                                   DTSCS48
00793  P6000-REQUEST-INQUIRE.                                           DTSCS48
00794      MOVE MAP-EMP-NO-AREA      TO L018-S-EMP-NO-AREA.             DTSCS48
00795      MOVE LOW-VALUES           TO MAP-AREA.                       DTSCS48
00796      MOVE L018-S-EMP-NO-AREA   TO MAP-EMP-NO-AREA.                DTSCS48
00797                                                                   DTSCS48
00798      SET LCCM-SCR-CLEAR              TO TRUE.                     DTSCS48
00799                                                                   DTSCS48
00800      MOVE LCCM-TASK-START-ABSTIME    TO LCCM-SCR-ABSTIME.         DTSCS48
00801                                                                   DTSCS48
00802      IF LCCM-SCR-HOLD-PROG-NAME = 'DTSCS48'                       DTSCS48
00803         MOVE LCCM-SCR-HOLD-KEY    TO SCR-REC-KEY-AREA             DTSCS48
00804         MOVE LOW-VALUES           TO LCCM-SCR-HOLD-AREA           DTSCS48
00805      ELSE                                                         DTSCS48
00806         MOVE LOW-VALUES           TO LCCM-SCR-HOLD-AREA           DTSCS48
00807      END-IF.                                                      DTSCS48
00808                                                                   DTSCS48
00809      SET RESP-SEND-MAP               TO TRUE.                     DTSCS48
00810                                                                   DTSCS48
00811      IF SCR-ACCESS-UPDATE                                         DTSCS48
00812          PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT           DTSCS48
00813      ELSE                                                         DTSCS48
00814          PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT.             DTSCS48
00815                                                                   DTSCS48
00816      PERFORM S1100-EDIT-KEY          THRU S1100-EXIT.             DTSCS48
00817      IF LCCM-MSG                                                  DTSCS48
00818          GO TO P6000-EXIT.                                        DTSCS48
00819                                                                   DTSCS48
00820      MOVE WRK-EMP-NO TO LCCM-EMP-NO.                              DTSCS48
00821                                                                   DTSCS48
00822      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSCS48
00823      MOVE WRK-EMP-NO TO MSKL-EMP-NO.                              DTSCS48
00824      SET MSKL-CMP-88 TO TRUE.                                     DTSCS48
00825      PERFORM S810-COUNT THRU S810-EXIT.                           DTSCS48
00826                                                                   DTSCS48
00827      IF L810-RECORD-CNT = +0                                      DTSCS48
00828          MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                      DTSCS48
00829          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS48
00830          GO TO P6000-EXIT.                                        DTSCS48
00831                                                                   DTSCS48
00832      MOVE L810-RECORD-CNT TO LAST-REC-NUM.                        DTSCS48
00833      MOVE MSKL-KEY-AREA TO LAST-REC-KEY-AREA.                     DTSCS48
00834                                                                   DTSCS48
00835      PERFORM P6100-LOCATE-REC THRU P6100-EXIT.                    DTSCS48
00836      IF LCCM-MSG                                                  DTSCS48
00837          GO TO P6000-EXIT.                                        DTSCS48
00838                                                                   DTSCS48
00839      PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT.              DTSCS48
00840                                                                   DTSCS48
00841      MOVE 'DTSCS48'             TO LCCM-SCR-HOLD-PROG-NAME.       DTSCS48
00842      MOVE MCMP-KEY-AREA         TO LCCM-SCR-HOLD-KEY.             DTSCS48
00843                                                                   DTSCS48
00844      SET LCCM-SCR-INQUIRE TO TRUE.                                DTSCS48
00845                                                                   DTSCS48
00846      IF SCR-ACCESS-UPDATE                                         DTSCS48
00847          PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.          DTSCS48
00848  P6000-EXIT.                                                      DTSCS48
00849      EXIT.                                                        DTSCS48
00850      EJECT                                                        DTSCS48
00851                                                                   DTSCS48
00852  P6100-LOCATE-REC.                                                DTSCS48
00853 *------------------------------------------------------------     DTSCS48
00854 *    IF, AT THE LAST USE OF THIS SCREEN, A RECORD FOR             DTSCS48
00855 *    EMPLOYER NUMBER LCCM-EMP-NO WAS DISPLAYED ON THE             DTSCS48
00856 *    SCREEN, THEN BASE THE PAGING LOGIC ON THE LAST RECORD        DTSCS48
00857 *    DISPLAYED ON THIS SCREEN; OTHERWISE, DISPLAY THE             DTSCS48
00858 *    RECORD WITH THE GREATEST MCMP-ESTB-DATE                      DTSCS48
00859 *------------------------------------------------------------     DTSCS48
00860                                                                   DTSCS48
00861      IF SCR-REC-KEY-AREA = LOW-VALUES                             DTSCS48
00862          PERFORM P6101-DEFAULT-PAGE THRU P6101-EXIT               DTSCS48
00863          GO TO P6100-EXIT.                                        DTSCS48
00864                                                                   DTSCS48
00865      MOVE SCR-REC-KEY-AREA TO MCMP-KEY-AREA.                      DTSCS48
00866                                                                   DTSCS48
00867      IF WRK-EMP-NO = MCMP-EMP-NO                                  DTSCS48
00868          NEXT SENTENCE                                            DTSCS48
00869      ELSE                                                         DTSCS48
00870          PERFORM P6101-DEFAULT-PAGE THRU P6101-EXIT               DTSCS48
00871          GO TO P6100-EXIT.                                        DTSCS48
00872                                                                   DTSCS48
00873      IF LCCM-F05-88                                               DTSCS48
00874          PERFORM P6110-FIRST-REC THRU P6110-EXIT                  DTSCS48
00875          GO TO P6100-EXIT.                                        DTSCS48
00876                                                                   DTSCS48
00877      IF LCCM-F06-88                                               DTSCS48
00878          PERFORM P6140-LAST-REC THRU P6140-EXIT                   DTSCS48
00879          GO TO P6100-EXIT.                                        DTSCS48
00880                                                                   DTSCS48
00881      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSCS48
00882      MOVE WRK-EMP-NO TO MSKL-EMP-NO.                              DTSCS48
00883      SET MSKL-CMP-88 TO TRUE.                                     DTSCS48
00884      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS48
00885      IF L810-NO-REC-88                                            DTSCS48
00886          MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                      DTSCS48
00887          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS48
00888          GO TO P6100-EXIT.                                        DTSCS48
00889                                                                   DTSCS48
00890      MOVE +0 TO WS-REC-NUM.                                       DTSCS48
00891      MOVE 'N' TO WS-REC-FOUND-IND.                                DTSCS48
00892      PERFORM P6190-BROWSE-MCMP THRU P6190-EXIT                    DTSCS48
00893          UNTIL (L810-NO-REC-88)                                   DTSCS48
00894                    OR                                             DTSCS48
00895                (WS-REC-FOUND-IND = 'Y').                          DTSCS48
00896                                                                   DTSCS48
00897      IF L810-NO-REC-88                                            DTSCS48
00898          PERFORM P6101-DEFAULT-PAGE THRU P6101-EXIT               DTSCS48
00899          GO TO P6100-EXIT.                                        DTSCS48
00900                                                                   DTSCS48
00901      IF LCCM-ENTER-88                                             DTSCS48
00902          PERFORM S810-END-BROWSE THRU S810-EXIT                   DTSCS48
00903          GO TO P6100-EXIT.                                        DTSCS48
00904                                                                   DTSCS48
00905      IF LCCM-F07-88                                               DTSCS48
00906          PERFORM P6120-PREV-REC THRU P6120-EXIT                   DTSCS48
00907          GO TO P6100-EXIT.                                        DTSCS48
00908                                                                   DTSCS48
00909      IF LCCM-F08-88                                               DTSCS48
00910          PERFORM P6130-NEXT-REC THRU P6130-EXIT                   DTSCS48
00911          GO TO P6100-EXIT.                                        DTSCS48
00912                                                                   DTSCS48
00913      GO TO S899-ABEND.                                            DTSCS48
00914  P6100-EXIT.                                                      DTSCS48
00915      EXIT.                                                        DTSCS48
00916                                                                   DTSCS48
00917  P6101-DEFAULT-PAGE.                                              DTSCS48
00918      PERFORM P6140-LAST-REC THRU P6140-EXIT.                      DTSCS48
00919  P6101-EXIT.                                                      DTSCS48
00920      EXIT.                                                        DTSCS48
00921                                                                   DTSCS48
00922  P6110-FIRST-REC.                                                 DTSCS48
00923      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSCS48
00924      MOVE WRK-EMP-NO TO MSKL-EMP-NO.                              DTSCS48
00925      SET MSKL-CMP-88 TO TRUE.                                     DTSCS48
00926      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS48
00927      IF L810-NO-REC-88                                            DTSCS48
00928          MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                      DTSCS48
00929          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS48
00930          GO TO P6110-EXIT.                                        DTSCS48
00931                                                                   DTSCS48
00932      PERFORM S810-END-BROWSE THRU S810-EXIT.                      DTSCS48
00933                                                                   DTSCS48
00934      MOVE MSKL-REC TO MCMP-REC.                                   DTSCS48
00935                                                                   DTSCS48
00936      MOVE +1 TO WS-REC-NUM.                                       DTSCS48
00937  P6110-EXIT.                                                      DTSCS48
00938      EXIT.                                                        DTSCS48
00939                                                                   DTSCS48
00940  P6120-PREV-REC.                                                  DTSCS48
00941      PERFORM S810-READ-PREV THRU S810-EXIT.                       DTSCS48
00942      IF L810-NO-REC-88                                            DTSCS48
00943          MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                      DTSCS48
00944          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS48
00945          GO TO P6120-EXIT.                                        DTSCS48
00946                                                                   DTSCS48
00947      PERFORM S810-READ-PREV THRU S810-EXIT.                       DTSCS48
00948      IF L810-NO-REC-88                                            DTSCS48
00949          GO TO P6120-EXIT.                                        DTSCS48
00950                                                                   DTSCS48
00951      PERFORM S810-END-BROWSE THRU S810-EXIT.                      DTSCS48
00952                                                                   DTSCS48
00953      SUBTRACT 1 FROM WS-REC-NUM.                                  DTSCS48
00954                                                                   DTSCS48
00955      MOVE MSKL-REC TO MCMP-REC.                                   DTSCS48
00956  P6120-EXIT.                                                      DTSCS48
00957      EXIT.                                                        DTSCS48
00958                                                                   DTSCS48
00959  P6130-NEXT-REC.                                                  DTSCS48
00960      IF MCMP-KEY-AREA > SCR-REC-KEY-AREA                          DTSCS48
00961          PERFORM S810-END-BROWSE THRU S810-EXIT                   DTSCS48
00962          GO TO P6130-EXIT.                                        DTSCS48
00963                                                                   DTSCS48
00964      PERFORM S810-READ-NEXT THRU S810-EXIT.                       DTSCS48
00965                                                                   DTSCS48
00966      IF L810-NO-REC-88                                            DTSCS48
00967          GO TO P6130-EXIT.                                        DTSCS48
00968                                                                   DTSCS48
00969      PERFORM S810-END-BROWSE THRU S810-EXIT.                      DTSCS48
00970                                                                   DTSCS48
00971      ADD +1 TO WS-REC-NUM.                                        DTSCS48
00972                                                                   DTSCS48
00973      MOVE MSKL-REC TO MCMP-REC.                                   DTSCS48
00974  P6130-EXIT.                                                      DTSCS48
00975      EXIT.                                                        DTSCS48
00976                                                                   DTSCS48
00977  P6140-LAST-REC.                                                  DTSCS48
00978      MOVE LAST-REC-KEY-AREA TO MSKL-KEY-AREA.                     DTSCS48
00979      PERFORM S810-READ THRU S810-EXIT.                            DTSCS48
00980      IF L810-NO-REC-88                                            DTSCS48
00981          MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                      DTSCS48
00982          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS48
00983          GO TO P6140-EXIT.                                        DTSCS48
00984                                                                   DTSCS48
00985      MOVE MSKL-REC TO MCMP-REC.                                   DTSCS48
00986                                                                   DTSCS48
00987      MOVE LAST-REC-NUM TO WS-REC-NUM.                             DTSCS48
00988  P6140-EXIT.                                                      DTSCS48
00989      EXIT.                                                        DTSCS48
00990                                                                   DTSCS48
00991  P6190-BROWSE-MCMP.                                               DTSCS48
00992      MOVE MSKL-REC TO MCMP-REC.                                   DTSCS48
00993      ADD +1 TO WS-REC-NUM.                                        DTSCS48
00994      IF MCMP-KEY-AREA NOT < SCR-REC-KEY-AREA                      DTSCS48
00995          MOVE 'Y' TO WS-REC-FOUND-IND                             DTSCS48
00996      ELSE                                                         DTSCS48
00997          PERFORM S810-READ-NEXT THRU S810-EXIT.                   DTSCS48
00998  P6190-EXIT.                                                      DTSCS48
00999      EXIT.                                                        DTSCS48
01000 /**************************************************************** DTSCS48
01001 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS             DTSCS48
01002 ***************************************************************** DTSCS48
01003                                                                   DTSCS48
01004  P6900-CONSTRUCT-SCREEN.                                          DTSCS48
01005      PERFORM S109-SUR-TAX-QTR THRU S109-EXIT.                     DTSCS48
01006      PERFORM P6910-FROM-MCMP THRU P6910-EXIT.                     DTSCS48
01007                                                                   DTSCS48
01008      PERFORM P6990-PAGE-NUMBER THRU P6990-EXIT.                   DTSCS48
01009  P6900-EXIT.                                                      DTSCS48
01010      EXIT.                                                        DTSCS48
01011                                                                   DTSCS48
01012  P6910-FROM-MCMP.                                                 DTSCS48
01013      MOVE MCMP-STATUS-CD             TO MAP-STATUS-CD             DTSCS48
01014                                         LCCM-SCR-HOLD-STATUS-CD.  DTSCS48
01015                                                                   DTSCS48
01016      MOVE MCMP-SETTLEMENT-DATE       TO WRK-DISPLAY.              DTSCS48
01017      MOVE WRK-DISPLAY-MO             TO MAP-SETTLEMENT-MO.        DTSCS48
01018      MOVE WRK-DISPLAY-DA             TO MAP-SETTLEMENT-DA.        DTSCS48
01019      MOVE WRK-DISPLAY-YR             TO MAP-SETTLEMENT-YR.        DTSCS48
01020                                                                   DTSCS48
01021      MOVE MCMP-INT-COMP-DATE         TO WRK-DISPLAY.              DTSCS48
01022      MOVE WRK-DISPLAY-MO             TO MAP-INT-COMP-MO.          DTSCS48
01023      MOVE WRK-DISPLAY-DA             TO MAP-INT-COMP-DA.          DTSCS48
01024      MOVE WRK-DISPLAY-YR             TO MAP-INT-COMP-YR.          DTSCS48
01025                                                                   DTSCS48
01026      MOVE MCMP-AUTHORIZE-OP-ID       TO MAP-AUTHORIZE-OP-ID.      DTSCS48
01027                                                                   DTSCS48
01028      MOVE MCMP-MAILING-LINE-1        TO MAP-MAILING-LINE-1.       DTSCS48
01029      MOVE MCMP-MAILING-LINE-2        TO MAP-MAILING-LINE-2.       DTSCS48
01030      MOVE MCMP-MAILING-LINE-3        TO MAP-MAILING-LINE-3.       DTSCS48
01031      MOVE MCMP-MAILING-LINE-4        TO MAP-MAILING-LINE-4.       DTSCS48
01032      MOVE MCMP-MAILING-LINE-5        TO MAP-MAILING-LINE-5.       DTSCS48
01033                                                                   DTSCS48
01034      MOVE +0                         TO MAP-CNT.                  DTSCS48
01035      MOVE +0                         TO WRK-AMT-DUE.              DTSCS48
01036      MOVE 99999                      TO WRK-YRQ.                  DTSCS48
01037                                                                   DTSCS48
01038      PERFORM P6911-COVERED-YRQ THRU P6911-EXIT                    DTSCS48
01039          VARYING WRK-SUB FROM 1 BY 1                              DTSCS48
01040          UNTIL   WRK-SUB > MCMP-COV-CNT.                          DTSCS48
01041                                                                   DTSCS48
01042      MOVE MCMP-TAX-WAIVED-AMT        TO MAP-TAX-WAIVED-AMT-Z.     DTSCS48
01043      MOVE MCMP-PEN-WAIVED-AMT        TO MAP-PEN-WAIVED-AMT-Z.     DTSCS48
01044      MOVE MCMP-INT-WAIVED-AMT        TO MAP-INT-WAIVED-AMT-Z.     DTSCS48
01045      MOVE MCMP-TOT-BALANCE-AMT       TO MAP-TOT-BALANCE-AMT-Z.    DTSCS48
01046                                                                   DTSCS48
01047  P6910-EXIT.                                                      DTSCS48
01048      EXIT.                                                        DTSCS48
01049                                                                   DTSCS48
01050  P6911-COVERED-YRQ.                                               DTSCS48
01051                                                                   DTSCS48
01052      MOVE ZEROS                      TO WRK-YRQ.                  DTSCS48
01053      MOVE LOW-VALUES                 TO MQTR-KEY-AREA.            DTSCS48
01054      MOVE MCMP-EMP-NO                TO MQTR-EMP-NO.              DTSCS48
01055      SET MQTR-QTR-88                 TO TRUE.                     DTSCS48
01056      MOVE MCMP-COVERED-YRQ (WRK-SUB) TO MQTR-YRQ.                 DTSCS48
01057      MOVE MQTR-KEY-AREA              TO MSKL-KEY-AREA.            DTSCS48
01058                                                                   DTSCS48
01059      PERFORM S810-READ               THRU S810-EXIT.              DTSCS48
01060                                                                   DTSCS48
01061      IF L810-NO-REC-88                                            DTSCS48
01062          GO TO P6911-EXIT.                                        DTSCS48
01063                                                                   DTSCS48
01064      MOVE MSKL-REC TO MQTR-REC.                                   DTSCS48
01065                                                                   DTSCS48
01066 *    IF MQTR-ANNUAL-YES-88                                        DTSCS48
01067 *       MOVE MQTR-YRQ TO WRK-YRQ.                                 DTSCS48
01068 *                                                                 DTSCS48
01069 *    IF WRK-YRQ-YR NOT = WRK-CURR-ANN-YR                          DTSCS48
01070 *       ADD 1   TO MAP-CNT                                        DTSCS48
01071 *       MOVE +0 TO WRK-YRQ-BALANCE-AMT                            DTSCS48
01072 *               WRK-YRQ-WRITTEN-OFF-AMT.                          DTSCS48
01073                                                                   DTSCS48
01074      ADD 1   TO MAP-CNT.                                          DTSCS48
01075      MOVE +0 TO WRK-YRQ-BALANCE-AMT                               DTSCS48
01076                 WRK-YRQ-WAIVED-AMT                                DTSCS48
01077                 WRK-YRQ-WRITTEN-OFF-AMT                           DTSCS48
01078                 L101-PAID-CHNG                                    DTSCS48
01079                 L101-INT-CHARGE-CHNG                              DTSCS48
01080                 L101-INT-WAIVE-CHNG.                              DTSCS48
01081                                                                   DTSCS48
01082      PERFORM VARYING MQTR-ACCT-IDX FROM 1 BY 1                    DTSCS48
01083              UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT                  DTSCS48
01084          ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX)                     DTSCS48
01085                                TO WRK-YRQ-BALANCE-AMT             DTSCS48
01086          ADD MQTR-WRITTEN-OFF-AMT (MQTR-ACCT-IDX)                 DTSCS48
01087                                TO WRK-YRQ-WRITTEN-OFF-AMT         DTSCS48
01088               ADD MQTR-WAIVED-AMT (MQTR-ACCT-IDX)                 DTSCS48
01089                                TO WRK-YRQ-WAIVED-AMT              DTSCS48
01090          IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX)                       DTSCS48
01091             ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX)                  DTSCS48
01092                              TO L101-PAID-CHNG                    DTSCS48
01093          END-IF                                                   DTSCS48
01094           IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) AND                 DTSCS48
01095              MQTR-YRQ >= L109-FIRST-PEN-INT-YRQ                   DTSCS48
01096              ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX)                 DTSCS48
01097              TO L101-PAID-CHNG                                    DTSCS48
01098           END-IF                                                  DTSCS48
01099      END-PERFORM.                                                 DTSCS48
01100                                                                   DTSCS48
01101      PERFORM S4010-INTEREST        THRU S4010-EXIT.               DTSCS48
01102                                                                   DTSCS48
01103      ADD L101-INT-CHARGE-CHNG      TO WRK-YRQ-BALANCE-AMT.        DTSCS48
01104                                                                   DTSCS48
01105      SUBTRACT L101-INT-WAIVE-CHNG  FROM WRK-YRQ-BALANCE-AMT.      DTSCS48
01106                                                                   DTSCS48
01107      IF WRK-YRQ-WRITTEN-OFF-AMT     NOT =  +0                     DTSCS48
01108          MOVE ' WRITE OFF'          TO MAP-WAIVED-AMT (MAP-CNT)   DTSCS48
01109      ELSE                                                         DTSCS48
01110 *      IF MQTR-ANNUAL-YES-88                                      DTSCS48
01111 *         ADD  WRK-YRQ-BALANCE-AMT  TO WRK-AMT-DUE                DTSCS48
01112 *         MOVE WRK-AMT-DUE          TO MAP-AMT-DUE-Z (MAP-CNT)    DTSCS48
01113 *      ELSE                                                       DTSCS48
01114           MOVE WRK-YRQ-WAIVED-AMT   TO MAP-WAIVED-AMT-Z (MAP-CNT) DTSCS48
01115           MOVE WRK-YRQ-BALANCE-AMT  TO MAP-BALANCE-AMT-Z (MAP-CNT)DTSCS48
01116      END-IF.                                                      DTSCS48
01117                                                                   DTSCS48
01118                                                                   DTSCS48
01119      IF MCMP-COVERED-YRQ (WRK-SUB) = LCCM-PICKUP-YRQ              DTSCS48
01120          MOVE 'PU' TO MAP-COVERED-YRQ-YR (MAP-CNT)                DTSCS48
01121          MOVE ' ' TO MAP-COVERED-YRQ-Q (MAP-CNT)                  DTSCS48
01122      ELSE                                                         DTSCS48
01123        MOVE MCMP-COVERED-YRQ(WRK-SUB) TO WRK-DISPLAY              DTSCS48
01124 *      IF MQTR-ANNUAL-YES-88                                      DTSCS48
01125 *         MOVE WRK-YRQ-YR       TO WRK-CURR-ANN-YR                DTSCS48
01126 *         MOVE ZERO             TO WRK-CURR-ANN-Q                 DTSCS48
01127 *         MOVE WRK-CURR-ANN-YY  TO MAP-COVERED-YRQ-YR(MAP-CNT)    DTSCS48
01128 *         MOVE '*'              TO MAP-COVERED-YRQ-Q(MAP-CNT)     DTSCS48
01129 *      ELSE                                                       DTSCS48
01130          MOVE WRK-DISPLAY-YRQ-YR TO MAP-COVERED-YRQ-YR(MAP-CNT)   DTSCS48
01131          MOVE WRK-DISPLAY-YRQ-Q TO MAP-COVERED-YRQ-Q(MAP-CNT).    DTSCS48
01132                                                                   DTSCS48
01133  P6911-EXIT.                                                      DTSCS48
01134      EXIT.                                                        DTSCS48
01135                                                                   DTSCS48
01136  P6990-PAGE-NUMBER.                                               DTSCS48
01137      MOVE WS-REC-NUM TO MAP-CURR-PAGE.                            DTSCS48
01138      MOVE LAST-REC-NUM TO MAP-LAST-PAGE.                          DTSCS48
01139                                                                   DTSCS48
01140      IF WS-REC-NUM = +1                                           DTSCS48
01141          IF LAST-REC-NUM = +1                                     DTSCS48
01142              MOVE PMSG-ONLY-PAGE TO LCCM-MSG-AREA                 DTSCS48
01143          ELSE                                                     DTSCS48
01144              MOVE PMSG-FIRST-PAGE TO LCCM-MSG-AREA                DTSCS48
01145      ELSE                                                         DTSCS48
01146          IF WS-REC-NUM = LAST-REC-NUM                             DTSCS48
01147              MOVE PMSG-LAST-PAGE TO LCCM-MSG-AREA.                DTSCS48
01148  P6990-EXIT.                                                      DTSCS48
01149      EXIT.                                                        DTSCS48
01150 /**************************************************************** DTSCS48
01151 * FUNCTION KEY TO ADD, MOD OR DEL THE RECORD WAS PRESSED.         DTSCS48
01152 ***************************************************************** DTSCS48
01153                                                                   DTSCS48
01154  P7000-REQUEST-EDIT.                                              DTSCS48
01155      PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.              DTSCS48
01156                                                                   DTSCS48
01157      IF LCCM-F09-88                                               DTSCS48
01158          PERFORM P7100-EDIT-ADD THRU P7100-EXIT                   DTSCS48
01159      ELSE                                                         DTSCS48
01160      IF LCCM-F10-88                                               DTSCS48
01161          PERFORM P7200-EDIT-MOD THRU P7200-EXIT                   DTSCS48
01162 *    ELSE                                                         DTSCS48
01163 *    IF LCCM-F23-88                                               DTSCS48
01164 *        PERFORM P7300-EDIT-DEL THRU P7300-EXIT                   DTSCS48
01165      ELSE                                                         DTSCS48
01166          GO TO S899-ABEND.                                        DTSCS48
01167                                                                   DTSCS48
01168 *------------------------------------------------------           DTSCS48
01169 *  SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED.          DTSCS48
01170 *  IN ORDER TO CONTINUE TO ATTEMPT A MOD THE SCREEN MUST          DTSCS48
01171 *  REMAIN IN 'INQUIRE' STATUS.                                    DTSCS48
01172 *------------------------------------------------------           DTSCS48
01173                                                                   DTSCS48
01174      IF LCCM-MSG                                                  DTSCS48
01175          NEXT SENTENCE                                            DTSCS48
01176      ELSE                                                         DTSCS48
01177          PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT             DTSCS48
01178          IF LCCM-F09-88                                           DTSCS48
01179              SET LCCM-SCR-ADD-LOCKED TO TRUE                      DTSCS48
01180              MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID                 DTSCS48
01181          ELSE                                                     DTSCS48
01182          IF LCCM-F10-88                                           DTSCS48
01183              SET LCCM-SCR-MOD-LOCKED TO TRUE                      DTSCS48
01184              MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID.                DTSCS48
01185 *        ELSE                                                     DTSCS48
01186 *        IF LCCM-F23-88                                           DTSCS48
01187 *            SET LCCM-SCR-DEL-LOCKED TO TRUE                      DTSCS48
01188 *            MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID.                DTSCS48
01189                                                                   DTSCS48
01190      SET RESP-SEND-MAP TO TRUE.                                   DTSCS48
01191  P7000-EXIT.                                                      DTSCS48
01192      EXIT.                                                        DTSCS48
01193 /**************************************************************** DTSCS48
01194 * ADD FUNCTION WAS REQUESTED                                      DTSCS48
01195 ***************************************************************** DTSCS48
01196                                                                   DTSCS48
01197  P7100-EDIT-ADD.                                                  DTSCS48
01198 *-----------------------------------------------------            DTSCS48
01199 *    ADDITION REQUIRES THAT THE SCREEN WAS CLEARED FIRST          DTSCS48
01200 *-----------------------------------------------------            DTSCS48
01201      IF NOT LCCM-SCR-CLEAR                                        DTSCS48
01202         MOVE EMSG-ADD-PRECEDED TO LCCM-MSG-ID                     DTSCS48
01203         GO TO P7100-EXIT.                                         DTSCS48
01204                                                                   DTSCS48
01205 *-----------------------------------------------------            DTSCS48
01206 *    MAP-EMP-NO MAY NOT BE CHANGED DURING THE ADD                 DTSCS48
01207 *-----------------------------------------------------            DTSCS48
01208      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS48
01209      IF LCCM-MSG                                                  DTSCS48
01210          GO TO P7100-EXIT.                                        DTSCS48
01211                                                                   DTSCS48
01212      PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT.                  DTSCS48
01213  P7100-EXIT.                                                      DTSCS48
01214      EXIT.                                                        DTSCS48
01215 /**************************************************************** DTSCS48
01216 * MODIFICATION FUNCTION WAS REQUESTED                             DTSCS48
01217 ***************************************************************** DTSCS48
01218                                                                   DTSCS48
01219  P7200-EDIT-MOD.                                                  DTSCS48
01220 *-----------------------------------------------------            DTSCS48
01221 *    MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY         DTSCS48
01222 *    INQUIRED                                                     DTSCS48
01223 *-----------------------------------------------------            DTSCS48
01224      IF NOT LCCM-SCR-INQUIRE                                      DTSCS48
01225         MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-ID                     DTSCS48
01226         GO TO P7200-EXIT.                                         DTSCS48
01227                                                                   DTSCS48
01228 *-----------------------------------------------------            DTSCS48
01229 *    MAP-EMP-NO MAY NOT BE CHANGED DURING THE MOD                 DTSCS48
01230 *-----------------------------------------------------            DTSCS48
01231      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS48
01232      IF LCCM-MSG                                                  DTSCS48
01233          GO TO P7200-EXIT.                                        DTSCS48
01234                                                                   DTSCS48
01235      IF LCCM-EMP-NO NOT = WRK-EMP-NO                              DTSCS48
01236          MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA         DTSCS48
01237          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS48
01238          GO TO P7200-EXIT.                                        DTSCS48
01239                                                                   DTSCS48
01240      PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT.                  DTSCS48
01241                                                                   DTSCS48
01242  P7200-EXIT.                                                      DTSCS48
01243      EXIT.                                                        DTSCS48
01244 /**************************************************************** DTSCS48
01245 * DELETE FUNCTION WAS REQUESTED                                   DTSCS48
01246 ***************************************************************** DTSCS48
01247                                                                   DTSCS48
01248 *P7300-EDIT-DEL.                                                  DTSCS48
01249 *-----------------------------------------------------            DTSCS48
01250 *    DELETE REQUIRES THAT A RECORD WAS SUCCESSFULLY               DTSCS48
01251 *    INQUIRED                                                     DTSCS48
01252 *-----------------------------------------------------            DTSCS48
01253 *    IF NOT LCCM-SCR-INQUIRE                                      DTSCS48
01254 *       MOVE EMSG-DEL-PRECEDED TO LCCM-MSG-ID                     DTSCS48
01255 *       GO TO P7300-EXIT.                                         DTSCS48
01256 *                                                                 DTSCS48
01257 *-----------------------------------------------------            DTSCS48
01258 *    MAP-EMP-NO MAY NOT BE CHANGED DURING THE DELETE              DTSCS48
01259 *-----------------------------------------------------            DTSCS48
01260 *    PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS48
01261 *    IF LCCM-MSG                                                  DTSCS48
01262 *        GO TO P7300-EXIT.                                        DTSCS48
01263 *                                                                 DTSCS48
01264 *    IF LCCM-EMP-NO NOT = WRK-EMP-NO                              DTSCS48
01265 *        MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA         DTSCS48
01266 *        PERFORM S1199-ERROR THRU S1199-EXIT.                     DTSCS48
01267 *                                                                 DTSCS48
01268 *P7300-EXIT.                                                      DTSCS48
01269 *    EXIT.                                                        DTSCS48
01270 /**************************************************************** DTSCS48
01271 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED        DTSCS48
01272 ***************************************************************** DTSCS48
01273                                                                   DTSCS48
01274  P8000-REQUEST-UPDATE.                                            DTSCS48
01275                                                                   DTSCS48
01276      PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.              DTSCS48
01277                                                                   DTSCS48
01278      IF LCCM-SCR-ADD-LOCKED                                       DTSCS48
01279          PERFORM P8100-ADD THRU P8100-EXIT                        DTSCS48
01280      ELSE                                                         DTSCS48
01281      IF LCCM-SCR-MOD-LOCKED                                       DTSCS48
01282          PERFORM P8200-MOD THRU P8200-EXIT                        DTSCS48
01283 *    ELSE                                                         DTSCS48
01284 *    IF LCCM-SCR-DEL-LOCKED                                       DTSCS48
01285 *        PERFORM P8300-DEL THRU P8300-EXIT                        DTSCS48
01286      ELSE                                                         DTSCS48
01287         GO TO S899-ABEND.                                         DTSCS48
01288                                                                   DTSCS48
01289      SET RESP-SEND-MAP TO TRUE.                                   DTSCS48
01290  P8000-EXIT.                                                      DTSCS48
01291      EXIT.                                                        DTSCS48
01292 /**************************************************************** DTSCS48
01293 *                                                                 DTSCS48
01294 ***************************************************************** DTSCS48
01295                                                                   DTSCS48
01296  P8100-ADD.                                                       DTSCS48
01297      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS48
01298                                                                   DTSCS48
01299      PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.              DTSCS48
01300                                                                   DTSCS48
01301      IF LCCM-F12-88                                               DTSCS48
01302         MOVE PMSG-ADD-CANCELED TO LCCM-MSG-ID                     DTSCS48
01303         GO TO P8100-EXIT.                                         DTSCS48
01304                                                                   DTSCS48
01305      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS48
01306                                                                   DTSCS48
01307      MOVE 'A' TO L221-UPDATE-FUNCTION.                            DTSCS48
01308      PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT.                 DTSCS48
01309      IF LCCM-MSG                                                  DTSCS48
01310          GO TO P8100-EXIT.                                        DTSCS48
01311                                                                   DTSCS48
01312      PERFORM P8110-CONSTRUCT-MCMP THRU P8110-EXIT.                DTSCS48
01313                                                                   DTSCS48
01314 *    IF MPRF-NO-MCMP-88                                           DTSCS48
01315 *       PERFORM P8120-UPDATE-MPRF THRU P8120-EXIT.                DTSCS48
01316                                                                   DTSCS48
01317 *    IF MAP-STATUS-CD = 'P'                                       DTSCS48
01318 *       PERFORM P8130-CREATE-MTCK THRU P8130-EXIT.                DTSCS48
01319                                                                   DTSCS48
01320      PERFORM S221-EMP-UNLOCK THRU S221-EXIT.                      DTSCS48
01321                                                                   DTSCS48
01322      MOVE 'DTSCS48'             TO LCCM-SCR-HOLD-PROG-NAME.       DTSCS48
01323      MOVE MCMP-KEY-AREA         TO LCCM-SCR-HOLD-KEY.             DTSCS48
01324                                                                   DTSCS48
01325      SET LCCM-ENTER-88 TO TRUE.                                   DTSCS48
01326                                                                   DTSCS48
01327      PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT.               DTSCS48
01328                                                                   DTSCS48
01329      MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-ID.                     DTSCS48
01330                                                                   DTSCS48
01331      MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS48
01332  P8100-EXIT.                                                      DTSCS48
01333      EXIT.                                                        DTSCS48
01334                                                                   DTSCS48
01335  P8110-CONSTRUCT-MCMP.                                            DTSCS48
01336      MOVE LOW-VALUES                  TO MCMP-REC.                DTSCS48
01337                                                                   DTSCS48
01338      MOVE WRK-EMP-NO                  TO MCMP-EMP-NO.             DTSCS48
01339      SET MCMP-CMP-88                  TO TRUE.                    DTSCS48
01340      MOVE LCCM-TASK-START-ABSTIME     TO MCMP-ESTB-ABSTIME.       DTSCS48
01341                                                                   DTSCS48
01342      MOVE ZERO                        TO MCMP-PURGE-DATE.         DTSCS48
01343                                                                   DTSCS48
01344      SET MCMP-NOT-CONVERTED-88        TO TRUE.                    DTSCS48
01345      MOVE LCCM-CURR-RUN-DATE          TO MCMP-ESTB-DATE.          DTSCS48
01346      MOVE LCCM-CURR-RUN-DATE          TO MCMP-CHNG-DATE.          DTSCS48
01347                                                                   DTSCS48
01348      SET MCMP-STATUS-PENDING-88       TO TRUE.                    DTSCS48
01349                                                                   DTSCS48
01350      MOVE MAP-MAILING-LINE-1 TO MCMP-MAILING-LINE-1.              DTSCS48
01351      MOVE MAP-MAILING-LINE-2 TO MCMP-MAILING-LINE-2.              DTSCS48
01352      MOVE MAP-MAILING-LINE-3 TO MCMP-MAILING-LINE-3.              DTSCS48
01353      MOVE MAP-MAILING-LINE-4 TO MCMP-MAILING-LINE-4.              DTSCS48
01354      MOVE MAP-MAILING-LINE-5 TO MCMP-MAILING-LINE-5.              DTSCS48
01355                                                                   DTSCS48
01356      MOVE MAP-SETTLEMENT-DATE-AREA    TO L015-S-DATE-AREA.        DTSCS48
01357      PERFORM S015-DATE-FROM-SCREEN    THRU S015-EXIT.             DTSCS48
01358      MOVE L015-DATE                   TO MCMP-SETTLEMENT-DATE.    DTSCS48
01359                                                                   DTSCS48
01360      MOVE MAP-INT-COMP-DATE-AREA      TO L015-S-DATE-AREA.        DTSCS48
01361      PERFORM S015-DATE-FROM-SCREEN    THRU S015-EXIT.             DTSCS48
01362      MOVE L015-DATE                   TO MCMP-INT-COMP-DATE.      DTSCS48
01363                                                                   DTSCS48
01364      MOVE MAP-AUTHORIZE-OP-ID    TO MCMP-AUTHORIZE-OP-ID.         DTSCS48
01365                                                                   DTSCS48
01366      MOVE +0.00 TO L011-MIN-AMT.                                  DTSCS48
01367      MOVE +9999999.99 TO L011-MAX-AMT.                            DTSCS48
01368      MOVE MAP-TAX-WAIVED-AMT-AREA    TO L011-S-AMT-AREA.          DTSCS48
01369      PERFORM S011-AMT-FROM-SCREEN    THRU S011-EXIT.              DTSCS48
01370      MOVE L011-AMT                   TO MCMP-TAX-WAIVED-AMT.      DTSCS48
01371                                                                   DTSCS48
01372      MOVE +0.00 TO L011-MIN-AMT.                                  DTSCS48
01373      MOVE +9999999.99 TO L011-MAX-AMT.                            DTSCS48
01374      MOVE MAP-PEN-WAIVED-AMT-AREA    TO L011-S-AMT-AREA.          DTSCS48
01375      PERFORM S011-AMT-FROM-SCREEN    THRU S011-EXIT.              DTSCS48
01376      MOVE L011-AMT                   TO MCMP-PEN-WAIVED-AMT.      DTSCS48
01377                                                                   DTSCS48
01378      MOVE +0.00 TO L011-MIN-AMT.                                  DTSCS48
01379      MOVE +9999999.99 TO L011-MAX-AMT.                            DTSCS48
01380      MOVE MAP-INT-WAIVED-AMT-AREA    TO L011-S-AMT-AREA.          DTSCS48
01381      PERFORM S011-AMT-FROM-SCREEN    THRU S011-EXIT.              DTSCS48
01382      MOVE L011-AMT                   TO MCMP-INT-WAIVED-AMT.      DTSCS48
01383                                                                   DTSCS48
01384      MOVE +0.00 TO L011-MIN-AMT.                                  DTSCS48
01385      MOVE +9999999.99 TO L011-MAX-AMT.                            DTSCS48
01386      MOVE MAP-TOT-BALANCE-AMT-AREA    TO L011-S-AMT-AREA.         DTSCS48
01387      PERFORM S011-AMT-FROM-SCREEN    THRU S011-EXIT.              DTSCS48
01388      MOVE L011-AMT                   TO MCMP-TOT-BALANCE-AMT.     DTSCS48
01389                                                                   DTSCS48
01390      MOVE +0 TO MCMP-COV-CNT.                                     DTSCS48
01391                                                                   DTSCS48
01392      PERFORM P8111-COVERED-YRQ-LOOP THRU P8111-EXIT               DTSCS48
01393          VARYING WRK-SUB FROM 1 BY 1                              DTSCS48
01394          UNTIL   WRK-SUB > MMAX-CMP-COV-MAX.                      DTSCS48
01395                                                                   DTSCS48
01396      MOVE MCMP-REC                   TO MSKL-REC.                 DTSCS48
01397      PERFORM S810-WRITE              THRU S810-EXIT.              DTSCS48
01398                                                                   DTSCS48
01399      PERFORM P8820-CREATE-MEVL       THRU P8820-EXIT.             DTSCS48
01400                                                                   DTSCS48
01401      PERFORM P8112-ADD-T011          THRU P8112-EXIT.             DTSCS48
01402                                                                   DTSCS48
01403  P8110-EXIT. EXIT.                                                DTSCS48
01404                                                                   DTSCS48
01405  P8111-COVERED-YRQ-LOOP.                                          DTSCS48
01406      MOVE MAP-COVERED-YRQ-AREA (WRK-SUB) TO L029-S-YRQ-AREA.      DTSCS48
01407      PERFORM S029-YRQ-FROM-SCREEN        THRU S029-EXIT.          DTSCS48
01408                                                                   DTSCS48
01409      IF L029-VALID                                                DTSCS48
01410          ADD +1 TO MCMP-COV-CNT                                   DTSCS48
01411          MOVE L029-YRQ TO MCMP-COVERED-YRQ (MCMP-COV-CNT).        DTSCS48
01412  P8111-EXIT.                                                      DTSCS48
01413      EXIT.                                                        DTSCS48
01414      SKIP3                                                        DTSCS48
01415  P8112-ADD-T011.                                                  DTSCS48
01416      MOVE MCMP-EMP-NO TO T011-EMP-NO.                             DTSCS48
01417      MOVE LCCM-OP-ID TO T011-OP-ID.                               DTSCS48
01418      MOVE WRK-SCR-ID TO T011-SCR-ID.                              DTSCS48
01419      MOVE LCCM-TASK-START-DATE TO T011-SYS-DATE.                  DTSCS48
01420      MOVE LCCM-TASK-START-TIME TO T011-SYS-TIME.                  DTSCS48
01421      MOVE LOW-VALUES TO T011-DATA-AREA.                           DTSCS48
01422      MOVE ZEROS      TO T011-START-YRQ                            DTSCS48
01423                         T011-END-YRQ                              DTSCS48
01424                         T011-BATCH-NO                             DTSCS48
01425                         T011-ITEM-NO.                             DTSCS48
01426      SET T011-CMP-PKG TO TRUE.                                    DTSCS48
01427      MOVE LCCM-OP-ID TO T011-RESP-OP-ID.                          DTSCS48
01428      MOVE MCMP-ESTB-ABSTIME TO T011-ESTB-ABSTIME.                 DTSCS48
01429      MOVE LENGTH OF T011-REC TO T011-LENGTH.                      DTSCS48
01430      MOVE T011-REC TO RSKL-REC.                                   DTSCS48
01431      PERFORM S825-WRITE THRU S825-EXIT.                           DTSCS48
01432  P8112-EXIT.                                                      DTSCS48
01433      EXIT.                                                        DTSCS48
01434      SKIP3                                                        DTSCS48
01435 *P8120-UPDATE-MPRF.                                               DTSCS48
01436 *    PERFORM S1110-READ-MPRF THRU S1110-EXIT.                     DTSCS48
01437 *                                                                 DTSCS48
01438 *    SET MPRF-MCMP-EXISTS-88       TO TRUE.                       DTSCS48
01439 *    MOVE LCCM-CURR-RUN-DATE       TO MPRF-CHNG-DATE.             DTSCS48
01440 *    MOVE MPRF-REC                 TO MSKL-REC.                   DTSCS48
01441 *    PERFORM S810-REWRITE          THRU S810-EXIT.                DTSCS48
01442 *P8120-EXIT.                                                      DTSCS48
01443 *    EXIT.                                                        DTSCS48
01444                                                                   DTSCS48
01445 *P8130-CREATE-MTCK.                                               DTSCS48
01446 *    MOVE LOW-VALUE TO MTCK-REC.                                  DTSCS48
01447 *    MOVE MPRF-EMP-NO TO MTCK-EMP-NO.                             DTSCS48
01448 *    SET MTCK-TCK-88 TO TRUE.                                     DTSCS48
01449 *    MOVE LCCM-SCR-ABSTIME TO MTCK-ESTB-ABSTIME.                  DTSCS48
01450 *                                                                 DTSCS48
01451 *    MOVE +0 TO MTCK-PURGE-DATE.                                  DTSCS48
01452 *                                                                 DTSCS48
01453 *    INITIALIZE MTCK-DATA-AREA.                                   DTSCS48
01454 *    SET MTCK-TYPE-CMP-PEND-88 TO TRUE.                           DTSCS48
01455 *                                                                 DTSCS48
01456 *    MOVE LCCM-NEXT-RUN-DATE TO MTCK-TRIGGER-DATE.                DTSCS48
01457 *                                                                 DTSCS48
01458 *    SET MTCK-SOURCE-SYSTEM-88 TO TRUE.                           DTSCS48
01459 *    SET MTCK-DEST-SYSTEM-88 TO TRUE.                             DTSCS48
01460 *    MOVE MCMP-ESTB-ABSTIME TO MTCK-CMP-ESTB-ABSTIME.             DTSCS48
01461 *    SET MTCK-NOT-CONVERTED-88 TO TRUE.                           DTSCS48
01462 *    MOVE LCCM-CURR-RUN-DATE TO MTCK-ESTB-DATE                    DTSCS48
01463 *                               MTCK-CHNG-DATE.                   DTSCS48
01464 *    MOVE +0 TO MTCK-TEXT-CNT.                                    DTSCS48
01465 *                                                                 DTSCS48
01466 *    MOVE MTCK-REC TO MSKL-REC.                                   DTSCS48
01467 *    PERFORM S810-WRITE THRU S810-EXIT.                           DTSCS48
01468 *P8130-EXIT.                                                      DTSCS48
01469 *    EXIT.                                                        DTSCS48
01470 /**************************************************************** DTSCS48
01471 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS         DTSCS48
01472 ***************************************************************** DTSCS48
01473                                                                   DTSCS48
01474  P8200-MOD.                                                       DTSCS48
01475      SET LCCM-SCR-INQUIRE TO TRUE.                                DTSCS48
01476                                                                   DTSCS48
01477      PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.              DTSCS48
01478                                                                   DTSCS48
01479      IF LCCM-F12-88                                               DTSCS48
01480         MOVE PMSG-MOD-CANCELED        TO LCCM-MSG-ID              DTSCS48
01481         GO TO P8200-EXIT.                                         DTSCS48
01482                                                                   DTSCS48
01483      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS48
01484                                                                   DTSCS48
01485      MOVE 'M' TO L221-UPDATE-FUNCTION.                            DTSCS48
01486      PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT.                 DTSCS48
01487      IF LCCM-MSG                                                  DTSCS48
01488          GO TO P8200-EXIT.                                        DTSCS48
01489                                                                   DTSCS48
01490      PERFORM P8210-CONSTRUCT-MCMP THRU P8210-EXIT.                DTSCS48
01491                                                                   DTSCS48
01492      PERFORM S221-EMP-UNLOCK THRU S221-EXIT.                      DTSCS48
01493                                                                   DTSCS48
01494      MOVE 'DTSCS48'             TO LCCM-SCR-HOLD-PROG-NAME.       DTSCS48
01495      MOVE MCMP-KEY-AREA         TO LCCM-SCR-HOLD-KEY.             DTSCS48
01496                                                                   DTSCS48
01497      SET LCCM-ENTER-88 TO TRUE.                                   DTSCS48
01498                                                                   DTSCS48
01499      PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT.               DTSCS48
01500                                                                   DTSCS48
01501      MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-ID.                     DTSCS48
01502                                                                   DTSCS48
01503      MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS48
01504  P8200-EXIT.                                                      DTSCS48
01505      EXIT.                                                        DTSCS48
01506      EJECT                                                        DTSCS48
01507  P8210-CONSTRUCT-MCMP.                                            DTSCS48
01508      IF LCCM-SCR-HOLD-PROG-NAME   = 'DTSCS48'                     DTSCS48
01509         MOVE LCCM-SCR-HOLD-KEY    TO MSKL-KEY-AREA                DTSCS48
01510         PERFORM S810-READ         THRU S810-EXIT                  DTSCS48
01511         IF L810-NO-REC-88                                         DTSCS48
01512             PERFORM S899-ABEND    THRU S899-EXIT                  DTSCS48
01513         ELSE                                                      DTSCS48
01514            MOVE MSKL-REC          TO MCMP-REC                     DTSCS48
01515         END-IF                                                    DTSCS48
01516      ELSE                                                         DTSCS48
01517         PERFORM S899-ABEND        THRU S899-EXIT                  DTSCS48
01518      END-IF.                                                      DTSCS48
01519                                                                   DTSCS48
01520      MOVE MCMP-STATUS-CD TO WRK-STATUS-CD.                        DTSCS48
01521                                                                   DTSCS48
01522      MOVE MAP-STATUS-CD TO MCMP-STATUS-CD.                        DTSCS48
01523                                                                   DTSCS48
01524      IF (WRK-STATUS-CD = 'F' OR 'P')                              DTSCS48
01525              AND                                                  DTSCS48
01526         (MCMP-STATUS-WITHDRAWN-88)                                DTSCS48
01527          PERFORM P8212-ADD-T011      THRU P8212-EXIT              DTSCS48
01528          PERFORM P8820-CREATE-MEVL   THRU P8820-EXIT.             DTSCS48
01529                                                                   DTSCS48
01530      MOVE MCMP-REC                    TO MSKL-REC.                DTSCS48
01531                                                                   DTSCS48
01532      PERFORM S810-REWRITE             THRU S810-EXIT.             DTSCS48
01533  P8210-EXIT. EXIT.                                                DTSCS48
01534                                                                   DTSCS48
01535  P8212-ADD-T011.                                                  DTSCS48
01536      MOVE MCMP-EMP-NO TO T011-EMP-NO.                             DTSCS48
01537      MOVE LCCM-OP-ID TO T011-OP-ID.                               DTSCS48
01538      MOVE WRK-SCR-ID TO T011-SCR-ID.                              DTSCS48
01539      MOVE LCCM-TASK-START-DATE TO T011-SYS-DATE.                  DTSCS48
01540      MOVE LCCM-TASK-START-TIME TO T011-SYS-TIME.                  DTSCS48
01541      MOVE LOW-VALUES TO T011-DATA-AREA.                           DTSCS48
01542      SET T011-CMP-WD  TO TRUE.                                    DTSCS48
01543      MOVE LCCM-OP-ID TO T011-RESP-OP-ID.                          DTSCS48
01544      MOVE MCMP-ESTB-ABSTIME TO T011-ESTB-ABSTIME.                 DTSCS48
01545      MOVE LENGTH OF T011-REC TO T011-LENGTH.                      DTSCS48
01546      MOVE T011-REC TO RSKL-REC.                                   DTSCS48
01547      PERFORM S825-WRITE THRU S825-EXIT.                           DTSCS48
01548  P8212-EXIT. EXIT.                                                DTSCS48
01549                                                                   DTSCS48
01550 /**************************************************************** DTSCS48
01551 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS         DTSCS48
01552 ***************************************************************** DTSCS48
01553                                                                   DTSCS48
01554 *P8300-DEL.                                                       DTSCS48
01555 *    SET LCCM-SCR-INQUIRE TO TRUE.                                DTSCS48
01556 *                                                                 DTSCS48
01557 *    IF LCCM-F12-88                                               DTSCS48
01558 *       MOVE PMSG-DEL-CANCELED        TO LCCM-MSG-ID              DTSCS48
01559 *       GO TO P8300-EXIT.                                         DTSCS48
01560 *                                                                 DTSCS48
01561 *    PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS48
01562 *                                                                 DTSCS48
01563 *    MOVE 'D' TO L221-UPDATE-FUNCTION.                            DTSCS48
01564 *    PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT.                 DTSCS48
01565 *    IF LCCM-MSG                                                  DTSCS48
01566 *        GO TO P8300-EXIT.                                        DTSCS48
01567 *                                                                 DTSCS48
01568 *    MOVE LCCM-SCR48-HOLD-AREA TO MSKL-KEY-AREA.                  DTSCS48
01569 *    PERFORM S810-READ THRU S810-EXIT.                            DTSCS48
01570 *    IF L810-NO-REC-88                                            DTSCS48
01571 *        GO TO S899-ABEND.                                        DTSCS48
01572 *                                                                 DTSCS48
01573 *    PERFORM S810-DELETE              THRU S810-EXIT.             DTSCS48
01574 *                                                                 DTSCS48
01575 *    MOVE LOW-VALUE TO MCMP-STATUS-CD.                            DTSCS48
01576 *    PERFORM P8820-CREATE-MEVL       THRU P8820-EXIT.             DTSCS48
01577 *                                                                 DTSCS48
01578 *    MOVE LOW-VALUE TO MSKL-KEY-AREA.                             DTSCS48
01579 *    MOVE WRK-EMP-NO TO MSKL-EMP-NO.                              DTSCS48
01580 *    SET MSKL-CMP-88  TO TRUE.                                    DTSCS48
01581 *    PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS48
01582 *    IF L810-NO-REC-88                                            DTSCS48
01583 *        PERFORM S1110-READ-MPRF THRU S1110-EXIT                  DTSCS48
01584 *        SET MPRF-NO-MCMP-88           TO TRUE                    DTSCS48
01585 *        MOVE LCCM-CURR-RUN-DATE       TO MPRF-CHNG-DATE          DTSCS48
01586 *        MOVE MPRF-REC                 TO MSKL-REC                DTSCS48
01587 *        PERFORM S810-REWRITE THRU S810-EXIT                      DTSCS48
01588 *    ELSE                                                         DTSCS48
01589 *        PERFORM S810-END-BROWSE THRU S810-EXIT.                  DTSCS48
01590 *                                                                 DTSCS48
01591 *    PERFORM S221-EMP-UNLOCK THRU S221-EXIT.                      DTSCS48
01592 *                                                                 DTSCS48
01593 *    SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS48
01594 *    MOVE LOW-VALUE TO MAP-AREA.                                  DTSCS48
01595 *    PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.              DTSCS48
01596 *                                                                 DTSCS48
01597 *    MOVE WRK-EMP-NO TO WRK-DISPLAY.                              DTSCS48
01598 *    MOVE WRK-DISPLAY-EMP-NO-1 TO MAP-EMP-NO-1.                   DTSCS48
01599 *    MOVE WRK-DISPLAY-EMP-NO-2 TO MAP-EMP-NO-2.                   DTSCS48
01600 *                                                                 DTSCS48
01601 *    MOVE PMSG-DEL-SUCCESSFUL TO LCCM-MSG-ID.                     DTSCS48
01602 *                                                                 DTSCS48
01603 *    MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS48
01604 *P8300-EXIT.                                                      DTSCS48
01605 *    EXIT.                                                        DTSCS48
01606      EJECT                                                        DTSCS48
01607  P8810-LOCK-EMPLOYER.                                             DTSCS48
01608      MOVE WRK-EMP-NO TO L221-EMP-NO.                              DTSCS48
01609      MOVE LCCM-SCR-ABSTIME TO L221-SCR-ABSTIME.                   DTSCS48
01610      MOVE LCCM-TASK-ID TO L221-UPDATE-TASK-ID.                    DTSCS48
01611      MOVE LCCM-OP-ID TO L221-UPDATE-OP-ID.                        DTSCS48
01612      MOVE LCCM-CICS-TERM-ID TO L221-UPDATE-TERMID.                DTSCS48
01613      MOVE LCCM-TASK-NETNAME TO L221-UPDATE-NETNAME.               DTSCS48
01614      MOVE LCCM-TASK-START-DATE TO L221-UPDATE-START-DATE.         DTSCS48
01615      MOVE LCCM-TASK-START-TIME TO L221-UPDATE-START-TIME.         DTSCS48
01616      MOVE WRK-SCR-ID TO L221-UPDATE-SCR-ID.                       DTSCS48
01617                                                                   DTSCS48
01618      PERFORM S221-EMP-LOCK THRU S221-EXIT.                        DTSCS48
01619  P8810-EXIT.                                                      DTSCS48
01620      EXIT.                                                        DTSCS48
01621                                                                   DTSCS48
01622                                                                   DTSCS48
01623  P8820-CREATE-MEVL.                                               DTSCS48
01624      MOVE LOW-VALUES                 TO MEVL-REC.                 DTSCS48
01625                                                                   DTSCS48
01626      MOVE WRK-EMP-NO                 TO MEVL-EMP-NO.              DTSCS48
01627      SET MEVL-EVL-88                 TO TRUE.                     DTSCS48
01628      MOVE LCCM-TASK-START-DATE       TO MEVL-DATE.                DTSCS48
01629      MOVE LCCM-TASK-START-TIME       TO MEVL-TIME.                DTSCS48
01630                                                                   DTSCS48
01631      IF MCMP-STATUS-PENDING-88                                    DTSCS48
01632          MOVE 'PENDING.'   TO EVL-STATUS-CD-DSCR                  DTSCS48
01633      ELSE                                                         DTSCS48
01634      IF MCMP-STATUS-WITHDRAWN-88                                  DTSCS48
01635          MOVE 'WITHDRAWN.' TO EVL-STATUS-CD-DSCR                  DTSCS48
01636      ELSE                                                         DTSCS48
01637      IF MCMP-STATUS-FINAL-88                                      DTSCS48
01638          MOVE 'FINAL.'     TO EVL-STATUS-CD-DSCR                  DTSCS48
01639      ELSE                                                         DTSCS48
01640          GO TO P8820-EXIT.                                        DTSCS48
01641                                                                   DTSCS48
01642      MOVE EVL-TEXT                   TO MEVL-TEXT.                DTSCS48
01643                                                                   DTSCS48
01644      MOVE LCCM-OP-ID                 TO MEVL-SOURCE.              DTSCS48
01645                                                                   DTSCS48
01646      SET MEVL-NOT-CONVERTED-88       TO TRUE.                     DTSCS48
01647                                                                   DTSCS48
01648      MOVE LCCM-CURR-RUN-DATE         TO MEVL-ESTB-DATE            DTSCS48
01649                                         MEVL-CHNG-DATE.           DTSCS48
01650                                                                   DTSCS48
01651      MOVE MEVL-REC                   TO MSKL-REC.                 DTSCS48
01652      PERFORM S810-WRITE              THRU S810-EXIT.              DTSCS48
01653  P8820-EXIT.                                                      DTSCS48
01654      EXIT.                                                        DTSCS48
01655 /**************************************************************** DTSCS48
01656 * LINKS TO UTILITY MODULES                                        DTSCS48
01657 ***************************************************************** DTSCS48
01658                                                                   DTSCS48
01659  S001-FROM-FED-8.                                                 DTSCS48
01660      SET L001-FROM-FED-8 TO TRUE.                                 DTSCS48
01661      GO TO S001-DATE.                                             DTSCS48
01662                                                                   DTSCS48
01663  S001-FROM-ABS-DATE.                                              DTSCS48
01664      SET L001-FROM-ABS-DAY TO TRUE.                               DTSCS48
01665      GO TO S001-DATE.                                             DTSCS48
01666                                                                   DTSCS48
01667  S001-DATE.                                                       DTSCS48
01668      EXEC CICS LINK                                               DTSCS48
01669          PROGRAM('DTSCU001')                                      DTSCS48
01670          COMMAREA(L001-COMM-AREA)                                 DTSCS48
01671      END-EXEC.                                                    DTSCS48
01672  S001-EXIT.                                                       DTSCS48
01673      EXIT.                                                        DTSCS48
01674                                                                   DTSCS48
01675  S011-AMT-FROM-SCREEN.                                            DTSCS48
01676      EXEC CICS LINK                                               DTSCS48
01677          PROGRAM  ('DTSCU011')                                    DTSCS48
01678          COMMAREA (L011-COMM-AREA)                                DTSCS48
01679      END-EXEC.                                                    DTSCS48
01680  S011-EXIT.                                                       DTSCS48
01681      EXIT.                                                        DTSCS48
01682                                                                   DTSCS48
01683  S015-DATE-FROM-SCREEN.                                           DTSCS48
01684      EXEC CICS LINK                                               DTSCS48
01685          PROGRAM  ('DTSCU015')                                    DTSCS48
01686          COMMAREA (L015-COMM-AREA)                                DTSCS48
01687      END-EXEC.                                                    DTSCS48
01688  S015-EXIT.                                                       DTSCS48
01689      EXIT.                                                        DTSCS48
01690                                                                   DTSCS48
01691  S013-COUNT-FROM-SCREEN.                                          DTSCS48
01692      EXEC CICS LINK                                               DTSCS48
01693          PROGRAM('DTSCU013')                                      DTSCS48
01694          COMMAREA(L013-COMM-AREA)                                 DTSCS48
01695      END-EXEC.                                                    DTSCS48
01696  S013-EXIT.                                                       DTSCS48
01697      EXIT.                                                        DTSCS48
01698                                                                   DTSCS48
01699  S018-EMP-NO-FROM-SCREEN.                                         DTSCS48
01700      EXEC CICS LINK                                               DTSCS48
01701          PROGRAM('DTSCU018')                                      DTSCS48
01702          COMMAREA(L018-COMM-AREA)                                 DTSCS48
01703      END-EXEC.                                                    DTSCS48
01704  S018-EXIT.                                                       DTSCS48
01705      EXIT.                                                        DTSCS48
01706                                                                   DTSCS48
01707                                                                   DTSCS48
01708  S029-YRQ-FROM-SCREEN.                                            DTSCS48
01709      EXEC CICS LINK                                               DTSCS48
01710          PROGRAM('DTSCU029')                                      DTSCS48
01711          COMMAREA(L029-COMM-AREA)                                 DTSCS48
01712      END-EXEC.                                                    DTSCS48
01713  S029-EXIT.                                                       DTSCS48
01714      EXIT.                                                        DTSCS48
01715                                                                   DTSCS48
01716                                                                   DTSCS48
01717  S034-MCMP-STATUS-CD.                                             DTSCS48
01718      SET L034-MCMP-STATUS-CD       TO TRUE.                       DTSCS48
01719      GO TO S034-LINK.                                             DTSCS48
01720                                                                   DTSCS48
01721  S034-LINK.                                                       DTSCS48
01722      EXEC CICS LINK                                               DTSCS48
01723          PROGRAM  ('DTSCU034')                                    DTSCS48
01724          COMMAREA (L034-COMM-AREA)                                DTSCS48
01725      END-EXEC.                                                    DTSCS48
01726  S034-EXIT.                                                       DTSCS48
01727      EXIT.                                                        DTSCS48
01728                                                                   DTSCS48
01729  S071-CONVERT-NAME.                                               DTSCS48
01730      SET L071-FROM-LAST-NAME-FIRST   TO TRUE.                     DTSCS48
01731      EXEC CICS LINK                                               DTSCS48
01732          PROGRAM  ('DTSCU071')                                    DTSCS48
01733          COMMAREA (L071-COMM-AREA)                                DTSCS48
01734      END-EXEC.                                                    DTSCS48
01735  S071-EXIT.                                                       DTSCS48
01736      EXIT.                                                        DTSCS48
01737                                                                   DTSCS48
01738  S082-OP-ID-EDIT.                                                 DTSCS48
01739      EXEC CICS LINK                                               DTSCS48
01740          PROGRAM('DTSCU082')                                      DTSCS48
01741          COMMAREA(L082-COMM-AREA)                                 DTSCS48
01742      END-EXEC.                                                    DTSCS48
01743                                                                   DTSCS48
01744      IF L082-FILE-CLOSED                                          DTSCS48
01745          MOVE L082-MSG-AREA TO LCCM-MSG-AREA                      DTSCS48
01746          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS48
01747          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS48
01748          GO TO MAINLINE-EXIT.                                     DTSCS48
01749  S082-EXIT.                                                       DTSCS48
01750      EXIT.                                                        DTSCS48
01751                                                                   DTSCS48
01752  S101-PER-MONTH-YES.                                              DTSCS48
01753      SET L101-PER-MONTH-YES-88 TO TRUE.                           DTSCS48
01754      GO TO S101-INT-COMP.                                         DTSCS48
01755                                                                   DTSCS48
01756  S101-INT-COMP.                                                   DTSCS48
01757      EXEC CICS LINK                                               DTSCS48
01758          PROGRAM ('DTSCU101')                                     DTSCS48
01759          COMMAREA (L101-COMM-AREA)                                DTSCS48
01760      END-EXEC.                                                    DTSCS48
01761  S101-EXIT.                                                       DTSCS48
01762      EXIT.                                                        DTSCS48
01763  S109-SUR-TAX-QTR.                                                DTSCS48
01764       SET L109-CMND-PEN-INT-QTR-88  TO TRUE.                      DTSCS48
01765      EXEC CICS LINK                                               DTSCS48
01766          PROGRAM ('DTSCU109')                                     DTSCS48
01767          COMMAREA (L109-COMM-AREA)                                DTSCS48
01768      END-EXEC.                                                    DTSCS48
01769  S109-EXIT.                                                       DTSCS48
01770      EXIT.                                                        DTSCS48
01771                                                                   DTSCS48
01772  S111-ADDR-LOOKUP.                                                DTSCS48
01773      EXEC CICS LINK                                               DTSCS48
01774          PROGRAM('DTSCU111')                                      DTSCS48
01775          COMMAREA(L111-COMM-AREA)                                 DTSCS48
01776      END-EXEC.                                                    DTSCS48
01777                                                                   DTSCS48
01778      IF L111-FILE-CLOSED-88                                       DTSCS48
01779          MOVE L111-MSG-AREA TO LCCM-MSG-AREA                      DTSCS48
01780          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS48
01781          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS48
01782          GO TO MAINLINE-EXIT.                                     DTSCS48
01783  S111-EXIT.                                                       DTSCS48
01784      EXIT.                                                        DTSCS48
01785                                                                   DTSCS48
01786  S112-ADDR-FORMAT.                                                DTSCS48
01787      MOVE L111-ADDR-TYPE             TO L112-ADDR-TYPE.           DTSCS48
01788      SET L112-ANCHOR-LAST-88 TO TRUE.                             DTSCS48
01789      MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME.                 DTSCS48
01790      MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA.             DTSCS48
01791                                                                   DTSCS48
01792      EXEC CICS LINK                                               DTSCS48
01793          PROGRAM('DTSCU112')                                      DTSCS48
01794          COMMAREA(L112-COMM-AREA)                                 DTSCS48
01795      END-EXEC.                                                    DTSCS48
01796  S112-EXIT.                                                       DTSCS48
01797      EXIT.                                                        DTSCS48
01798                                                                   DTSCS48
01799  S221-EMP-LOCK.                                                   DTSCS48
01800      SET L221-START-UPDATE TO TRUE.                               DTSCS48
01801      GO TO S221-EMP-LOCK-UNLOCK.                                  DTSCS48
01802                                                                   DTSCS48
01803  S221-EMP-UNLOCK.                                                 DTSCS48
01804      SET L221-END-UPDATE TO TRUE.                                 DTSCS48
01805      GO TO S221-EMP-LOCK-UNLOCK.                                  DTSCS48
01806                                                                   DTSCS48
01807  S221-EMP-LOCK-UNLOCK.                                            DTSCS48
01808      EXEC CICS LINK                                               DTSCS48
01809          PROGRAM('DTSCU221')                                      DTSCS48
01810          COMMAREA(L221-COMM-AREA)                                 DTSCS48
01811      END-EXEC.                                                    DTSCS48
01812                                                                   DTSCS48
01813      IF L221-FILE-CLOSED                                          DTSCS48
01814          MOVE L221-MSG-AREA TO LCCM-MSG-AREA                      DTSCS48
01815          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS48
01816          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS48
01817          GO TO MAINLINE-EXIT.                                     DTSCS48
01818                                                                   DTSCS48
01819      IF L221-NOT-OK                                               DTSCS48
01820          MOVE L221-MSG-AREA TO LCCM-MSG-AREA.                     DTSCS48
01821  S221-EXIT.                                                       DTSCS48
01822      EXIT.                                                        DTSCS48
01823                                                                   DTSCS48
01824                                                                   DTSCS48
01825  S803-REQ-SCR-ID-EDIT.                                            DTSCS48
01826      EXEC CICS LINK                                               DTSCS48
01827          PROGRAM ('DTSCU803')                                     DTSCS48
01828          COMMAREA (DFHCOMMAREA)                                   DTSCS48
01829      END-EXEC.                                                    DTSCS48
01830  S803-EXIT.                                                       DTSCS48
01831      EXIT.                                                        DTSCS48
01832                                                                   DTSCS48
01833  S804-INVALID-KEY.                                                DTSCS48
01834      EXEC CICS LINK                                               DTSCS48
01835          PROGRAM ('DTSCU804')                                     DTSCS48
01836          COMMAREA (DFHCOMMAREA)                                   DTSCS48
01837      END-EXEC.                                                    DTSCS48
01838  S804-EXIT.                                                       DTSCS48
01839      EXIT.                                                        DTSCS48
01840                                                                   DTSCS48
01841  S805-MSG-AREA.                                                   DTSCS48
01842      MOVE LCCM-MSG-AREA TO L805-MSG-AREA                          DTSCS48
01843                                                                   DTSCS48
01844      EXEC CICS LINK                                               DTSCS48
01845          PROGRAM ('DTSCU805')                                     DTSCS48
01846          COMMAREA (L805-COMM-AREA)                                DTSCS48
01847      END-EXEC.                                                    DTSCS48
01848                                                                   DTSCS48
01849      MOVE L805-S-MSG-AREA TO MAP-MSG-AREA.                        DTSCS48
01850  S805-EXIT.                                                       DTSCS48
01851      EXIT.                                                        DTSCS48
01852      EJECT                                                        DTSCS48
01853  S810-READ.                                                       DTSCS48
01854      SET L810-READ-88 TO TRUE.                                    DTSCS48
01855      GO TO S810-IO.                                               DTSCS48
01856                                                                   DTSCS48
01857  S810-START-BROWSE.                                               DTSCS48
01858      SET L810-START-BROWSE-88 TO TRUE.                            DTSCS48
01859      GO TO S810-IO.                                               DTSCS48
01860                                                                   DTSCS48
01861  S810-READ-NEXT.                                                  DTSCS48
01862      SET L810-READ-NEXT-88 TO TRUE.                               DTSCS48
01863      GO TO S810-IO.                                               DTSCS48
01864                                                                   DTSCS48
01865  S810-READ-PREV.                                                  DTSCS48
01866      SET L810-READ-PREV-88 TO TRUE.                               DTSCS48
01867      GO TO S810-IO.                                               DTSCS48
01868                                                                   DTSCS48
01869  S810-END-BROWSE.                                                 DTSCS48
01870      SET L810-END-BROWSE-88 TO TRUE.                              DTSCS48
01871      GO TO S810-IO.                                               DTSCS48
01872                                                                   DTSCS48
01873  S810-COUNT.                                                      DTSCS48
01874      SET L810-COUNT-88 TO TRUE.                                   DTSCS48
01875      GO TO S810-IO.                                               DTSCS48
01876                                                                   DTSCS48
01877  S810-REWRITE.                                                    DTSCS48
01878      SET L810-REWRITE-88 TO TRUE.                                 DTSCS48
01879      GO TO S810-IO.                                               DTSCS48
01880                                                                   DTSCS48
01881  S810-WRITE.                                                      DTSCS48
01882      SET L810-WRITE-88 TO TRUE.                                   DTSCS48
01883      GO TO S810-IO.                                               DTSCS48
01884                                                                   DTSCS48
01885  S810-DELETE.                                                     DTSCS48
01886      SET L810-DELETE-88 TO TRUE.                                  DTSCS48
01887      GO TO S810-IO.                                               DTSCS48
01888                                                                   DTSCS48
01889  S810-IO.                                                         DTSCS48
01890                                                                   DTSCS48
01891      EXEC CICS LINK                                               DTSCS48
01892          PROGRAM ('DTSCU810')                                     DTSCS48
01893          COMMAREA (L810-COMM-AREA)                                DTSCS48
01894      END-EXEC.                                                    DTSCS48
01895                                                                   DTSCS48
01896      IF L810-FILE-CLOSED-88                                       DTSCS48
01897          MOVE L810-MSG-AREA TO LCCM-MSG-AREA                      DTSCS48
01898          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS48
01899          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS48
01900          GO TO MAINLINE-EXIT.                                     DTSCS48
01901  S810-EXIT.                                                       DTSCS48
01902      EXIT.                                                        DTSCS48
01903      SKIP3                                                        DTSCS48
01904  S825-WRITE.                                                      DTSCS48
01905      SET L825-WRITE-88 TO TRUE.                                   DTSCS48
01906      GO TO S825-O.                                                DTSCS48
01907                                                                   DTSCS48
01908  S825-O.                                                          DTSCS48
01909      EXEC CICS                                                    DTSCS48
01910          LINK                                                     DTSCS48
01911              PROGRAM ('DTSCU825')                                 DTSCS48
01912              COMMAREA (L825-COMM-AREA)                            DTSCS48
01913      END-EXEC.                                                    DTSCS48
01914                                                                   DTSCS48
01915      IF L825-FILE-CLOSED-88                                       DTSCS48
01916          MOVE L825-MSG-AREA TO LCCM-MSG-AREA                      DTSCS48
01917          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS48
01918          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS48
01919          GO TO MAINLINE-EXIT.                                     DTSCS48
01920  S825-EXIT.                                                       DTSCS48
01921      EXIT.                                                        DTSCS48
01922      SKIP3                                                        DTSCS48
01923  S851-SCREEN-PROCESSING.                                          DTSCS48
01924      EXEC CICS LINK                                               DTSCS48
01925          PROGRAM ('DTSCU851')                                     DTSCS48
01926          COMMAREA (L851-COMM-AREA)                                DTSCS48
01927      END-EXEC.                                                    DTSCS48
01928  S851-EXIT.                                                       DTSCS48
01929      EXIT.                                                        DTSCS48
01930                                                                   DTSCS48
01931  S899-ABEND.                                                      DTSCS48
01932      EXEC CICS ABEND                                              DTSCS48
01933          ABCODE(WRK-ABEND-CD)                                     DTSCS48
01934      END-EXEC.                                                    DTSCS48
01935  S899-EXIT.                                                       DTSCS48
01936      EXIT.                                                        DTSCS48
01937 /**************************************************************** DTSCS48
01938 *    EDIT THE INFORMATION ON THE SCREEN.                          DTSCS48
01939 ***************************************************************** DTSCS48
01940                                                                   DTSCS48
01941  S1000-SCREEN-EDITS.                                              DTSCS48
01942                                                                   DTSCS48
01943      IF LCCM-F09-88                                               DTSCS48
01944         PERFORM S1130-CHK-MCMP          THRU S1130-EXIT           DTSCS48
01945         IF LCCM-MSG                                               DTSCS48
01946            GO TO S1000-EXIT                                       DTSCS48
01947         ELSE                                                      DTSCS48
01948            PERFORM S1200-STATUS-CD         THRU S1200-EXIT        DTSCS48
01949            PERFORM S1300-SETTLEMENT-DATE   THRU S1300-EXIT        DTSCS48
01950            PERFORM S1400-MAIL-ADDRESS      THRU S1400-EXIT        DTSCS48
01951            PERFORM S1500-COMP-DATE         THRU S1500-EXIT        DTSCS48
01952            PERFORM S2400-AUTHORIZE-OP-ID   THRU S2400-EXIT        DTSCS48
01953            PERFORM S2900-COVERED-YRQ       THRU S2900-EXIT        DTSCS48
01954         END-IF                                                    DTSCS48
01955      ELSE                                                         DTSCS48
01956          PERFORM S1120-READ-MCMP         THRU S1120-EXIT          DTSCS48
01957          IF WRK-MCMP-YES-88                                       DTSCS48
01958              PERFORM S1200-STATUS-CD     THRU S1200-EXIT          DTSCS48
01959              PERFORM S2400-AUTHORIZE-OP-ID                        DTSCS48
01960                                          THRU S2400-EXIT          DTSCS48
01961              PERFORM S2500-INT-COMP-DATE THRU S2500-EXIT          DTSCS48
01962          END-IF                                                   DTSCS48
01963      END-IF.                                                      DTSCS48
01964                                                                   DTSCS48
01965      IF LCCM-MSG                                                  DTSCS48
01966          GO TO S1000-EXIT.                                        DTSCS48
01967                                                                   DTSCS48
01968  S1000-EXIT. EXIT.                                                DTSCS48
01969      EJECT                                                        DTSCS48
01970                                                                   DTSCS48
01971  S1100-EDIT-KEY.                                                  DTSCS48
01972      PERFORM S1101-EMP-NO              THRU S1101-EXIT.           DTSCS48
01973  S1100-EXIT. EXIT.                                                DTSCS48
01974 /**************************************************************** DTSCS48
01975 *                                                                 DTSCS48
01976 ***************************************************************** DTSCS48
01977  S1101-EMP-NO.                                                    DTSCS48
01978      MOVE MAP-EMP-NO-AREA            TO L018-S-EMP-NO-AREA.       DTSCS48
01979      PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT.              DTSCS48
01980                                                                   DTSCS48
01981      IF L018-NO-ENTRY                                             DTSCS48
01982         MOVE EMSG-FIELD-REQUIRED     TO WRK-MSG-AREA              DTSCS48
01983         PERFORM S1199-ERROR          THRU S1199-EXIT              DTSCS48
01984         GO TO S1101-EXIT.                                         DTSCS48
01985                                                                   DTSCS48
01986      IF L018-NOT-VALID                                            DTSCS48
01987         MOVE EMSG-FIELD-NOT-VALID    TO WRK-MSG-AREA              DTSCS48
01988         PERFORM S1199-ERROR          THRU S1199-EXIT              DTSCS48
01989         GO TO S1101-EXIT.                                         DTSCS48
01990                                                                   DTSCS48
01991      MOVE L018-EMP-NO                TO WRK-EMP-NO.               DTSCS48
01992      PERFORM S1110-READ-MPRF THRU S1110-EXIT.                     DTSCS48
01993  S1101-EXIT. EXIT.                                                DTSCS48
01994                                                                   DTSCS48
01995  S1110-READ-MPRF.                                                 DTSCS48
01996      MOVE LOW-VALUES     TO MPRF-KEY-AREA.                        DTSCS48
01997      MOVE WRK-EMP-NO     TO MPRF-EMP-NO.                          DTSCS48
01998      SET MPRF-PRF-88     TO TRUE.                                 DTSCS48
01999      MOVE MPRF-KEY-AREA  TO MSKL-KEY-AREA.                        DTSCS48
02000      PERFORM S810-READ   THRU S810-EXIT.                          DTSCS48
02001      IF L810-NO-REC-88                                            DTSCS48
02002          MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA                    DTSCS48
02003          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS48
02004      ELSE                                                         DTSCS48
02005          MOVE MSKL-REC TO MPRF-REC                                DTSCS48
02006          SET WRK-MPRF-YES-88 TO TRUE.                             DTSCS48
02007  S1110-EXIT.                                                      DTSCS48
02008      EXIT.                                                        DTSCS48
02009                                                                   DTSCS48
02010  S1120-READ-MCMP.                                                 DTSCS48
02011      MOVE LCCM-SCR-HOLD-KEY    TO MSKL-KEY-AREA.                  DTSCS48
02012                                                                   DTSCS48
02013      PERFORM S810-READ THRU S810-EXIT.                            DTSCS48
02014                                                                   DTSCS48
02015      IF L810-NO-REC-88                                            DTSCS48
02016          MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                      DTSCS48
02017          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS48
02018      ELSE                                                         DTSCS48
02019          MOVE MSKL-REC TO MCMP-REC                                DTSCS48
02020          SET WRK-MCMP-YES-88 TO TRUE.                             DTSCS48
02021  S1120-EXIT.                                                      DTSCS48
02022      EXIT.                                                        DTSCS48
02023                                                                   DTSCS48
02024  S1130-CHK-MCMP.                                                  DTSCS48
02025      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSCS48
02026      MOVE WRK-EMP-NO TO MSKL-EMP-NO.                              DTSCS48
02027      SET MSKL-CMP-88 TO TRUE.                                     DTSCS48
02028                                                                   DTSCS48
02029      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS48
02030                                                                   DTSCS48
02031      IF L810-NO-REC-88                                            DTSCS48
02032          PERFORM S810-END-BROWSE THRU S810-EXIT                   DTSCS48
02033      ELSE                                                         DTSCS48
02034         PERFORM                                                   DTSCS48
02035           UNTIL L810-NO-REC-88                                    DTSCS48
02036           OR    WRK-MCMP-YES-88                                   DTSCS48
02037             MOVE MSKL-REC                 TO MCMP-REC             DTSCS48
02038             IF MCMP-STATUS-PENDING-88                             DTSCS48
02039                SET WRK-MCMP-YES-88        TO TRUE                 DTSCS48
02040             ELSE                                                  DTSCS48
02041                PERFORM S810-READ-NEXT     THRU S810-EXIT          DTSCS48
02042             END-IF                                                DTSCS48
02043         END-PERFORM                                               DTSCS48
02044         PERFORM S810-END-BROWSE THRU S810-EXIT                    DTSCS48
02045         IF WRK-MCMP-YES-88                                        DTSCS48
02046            MOVE MSG-E487-AREA TO WRK-MSG-AREA                     DTSCS48
02047            PERFORM S1199-ERROR THRU S1199-EXIT                    DTSCS48
02048         END-IF                                                    DTSCS48
02049      END-IF.                                                      DTSCS48
02050                                                                   DTSCS48
02051  S1130-EXIT.                                                      DTSCS48
02052      EXIT.                                                        DTSCS48
02053                                                                   DTSCS48
02054  S1199-ERROR.                                                     DTSCS48
02055      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A            DTSCS48
02056                                         MAP-EMP-NO-2-A.           DTSCS48
02057      IF LCCM-NO-MSG                                               DTSCS48
02058         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS48
02059         MOVE CATB-CURSOR             TO MAP-EMP-NO-1-L            DTSCS48
02060         SET CURSOR-SET-YES TO TRUE.                               DTSCS48
02061  S1199-EXIT. EXIT.                                                DTSCS48
02062                                                                   DTSCS48
02063 /**************************************************************** DTSCS48
02064 *                                                                 DTSCS48
02065 ***************************************************************** DTSCS48
02066  S1200-STATUS-CD.                                                 DTSCS48
02067      IF LCCM-F09-88                                               DTSCS48
02068         SET MCMP-STATUS-PENDING-88  TO TRUE                       DTSCS48
02069         MOVE MCMP-STATUS-CD  TO MAP-STATUS-CD                     DTSCS48
02070         GO TO S1200-EXIT                                          DTSCS48
02071      ELSE                                                         DTSCS48
02072         MOVE MAP-STATUS-CD TO L034-CD                             DTSCS48
02073         PERFORM S034-MCMP-STATUS-CD THRU S034-EXIT                DTSCS48
02074         IF NOT L034-VALID                                         DTSCS48
02075            MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA              DTSCS48
02076            PERFORM S1201-ERROR THRU S1201-EXIT                    DTSCS48
02077            GO TO S1200-EXIT                                       DTSCS48
02078         ELSE                                                      DTSCS48
02079            PERFORM S1220-MOD THRU S1220-EXIT                      DTSCS48
02080         END-IF                                                    DTSCS48
02081      END-IF.                                                      DTSCS48
02082                                                                   DTSCS48
02083  S1200-EXIT. EXIT.                                                DTSCS48
02084                                                                   DTSCS48
02085  S1201-ERROR.                                                     DTSCS48
02086      MOVE CATB-UNPROT-NORM-AN-MDTON  TO MAP-STATUS-CD-A.          DTSCS48
02087      IF LCCM-NO-MSG                                               DTSCS48
02088         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS48
02089         MOVE CATB-CURSOR             TO MAP-STATUS-CD-L           DTSCS48
02090         SET CURSOR-SET-YES TO TRUE.                               DTSCS48
02091  S1201-EXIT. EXIT.                                                DTSCS48
02092                                                                   DTSCS48
02093                                                                   DTSCS48
02094  S1220-MOD.                                                       DTSCS48
02095      IF MAP-STATUS-CD = MCMP-STATUS-CD                            DTSCS48
02096          GO TO S1220-EXIT.                                        DTSCS48
02097                                                                   DTSCS48
02098      IF MCMP-STATUS-CD = 'P' OR 'F'                               DTSCS48
02099         IF MAP-STATUS-CD = 'W'                                    DTSCS48
02100            GO TO S1220-EXIT                                       DTSCS48
02101         ELSE                                                      DTSCS48
02102            MOVE MSG-E483-AREA TO WRK-MSG-AREA                     DTSCS48
02103            PERFORM S1201-ERROR THRU S1201-EXIT                    DTSCS48
02104            GO TO S1220-EXIT                                       DTSCS48
02105         END-IF                                                    DTSCS48
02106      END-IF.                                                      DTSCS48
02107                                                                   DTSCS48
02108      IF MAP-STATUS-CD = 'W'                                       DTSCS48
02109          MOVE MSG-E486-AREA TO WRK-MSG-AREA                       DTSCS48
02110          PERFORM S1201-ERROR THRU S1201-EXIT                      DTSCS48
02111          GO TO S1220-EXIT.                                        DTSCS48
02112                                                                   DTSCS48
02113  S1220-EXIT.                                                      DTSCS48
02114      EXIT.                                                        DTSCS48
02115                                                                   DTSCS48
02116 /**************************************************************** DTSCS48
02117 *                                                                 DTSCS48
02118 ***************************************************************** DTSCS48
02119  S1300-SETTLEMENT-DATE.                                           DTSCS48
02120      MOVE MAP-SETTLEMENT-DATE-AREA TO L015-S-DATE-AREA.           DTSCS48
02121      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS48
02122                                                                   DTSCS48
02123      IF L015-NO-ENTRY                                             DTSCS48
02124         MOVE LCCM-CURR-RUN-DATE TO WRK-DISPLAY                    DTSCS48
02125         MOVE WRK-DISPLAY-MO TO MAP-SETTLEMENT-MO                  DTSCS48
02126         MOVE WRK-DISPLAY-DA TO MAP-SETTLEMENT-DA                  DTSCS48
02127         MOVE WRK-DISPLAY-YR TO MAP-SETTLEMENT-YR                  DTSCS48
02128      ELSE                                                         DTSCS48
02129      IF L015-NOT-VALID                                            DTSCS48
02130          MOVE EMSG-FIELD-NOT-VALID    TO WRK-MSG-AREA             DTSCS48
02131          PERFORM S1301-ERROR          THRU S1301-EXIT.            DTSCS48
02132  S1300-EXIT.                                                      DTSCS48
02133      EXIT.                                                        DTSCS48
02134                                                                   DTSCS48
02135  S1301-ERROR.                                                     DTSCS48
02136      MOVE CATB-UNPROT-NORM-NUM-MDTON                              DTSCS48
02137        TO MAP-SETTLEMENT-MO-A                                     DTSCS48
02138           MAP-SETTLEMENT-DA-A                                     DTSCS48
02139           MAP-SETTLEMENT-YR-A.                                    DTSCS48
02140      IF LCCM-NO-MSG                                               DTSCS48
02141         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS48
02142         MOVE CATB-CURSOR             TO MAP-SETTLEMENT-MO-L       DTSCS48
02143         SET CURSOR-SET-YES TO TRUE.                               DTSCS48
02144  S1301-EXIT. EXIT.                                                DTSCS48
02145                                                                   DTSCS48
02146 /**************************************************************** DTSCS48
02147 *                                                                 DTSCS48
02148 ***************************************************************** DTSCS48
02149  S1400-MAIL-ADDRESS.                                              DTSCS48
02150      PERFORM S1410-ADDR-TYPE         THRU S1410-EXIT.             DTSCS48
02151                                                                   DTSCS48
02152      PERFORM S1420-MAIL-ID-NO        THRU S1420-EXIT.             DTSCS48
02153  S1400-EXIT.                                                      DTSCS48
02154      EXIT.                                                        DTSCS48
02155 /**************************************************************** DTSCS48
02156 *                                                                 DTSCS48
02157 ***************************************************************** DTSCS48
02158  S1410-ADDR-TYPE.                                                 DTSCS48
02159      IF MAP-ADDR-TYPE = SPACES OR LOW-VALUES                      DTSCS48
02160         SET MAP-ADDR-TAX-88 TO TRUE                               DTSCS48
02161      ELSE                                                         DTSCS48
02162      IF MAP-ADDR-VALID-88                                         DTSCS48
02163         NEXT SENTENCE                                             DTSCS48
02164      ELSE                                                         DTSCS48
02165          MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                DTSCS48
02166          PERFORM S1411-ERROR THRU S1411-EXIT.                     DTSCS48
02167  S1410-EXIT. EXIT.                                                DTSCS48
02168                                                                   DTSCS48
02169  S1411-ERROR.                                                     DTSCS48
02170      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ADDR-TYPE-A.           DTSCS48
02171      IF LCCM-NO-MSG                                               DTSCS48
02172         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS48
02173         MOVE CATB-CURSOR             TO MAP-ADDR-TYPE-L           DTSCS48
02174         SET CURSOR-SET-YES TO TRUE.                               DTSCS48
02175  S1411-EXIT. EXIT.                                                DTSCS48
02176 /**************************************************************** DTSCS48
02177 *                                                                 DTSCS48
02178 ***************************************************************** DTSCS48
02179  S1420-MAIL-ID-NO.                                                DTSCS48
02180      INSPECT MAP-ADDR-ID-NO                                       DTSCS48
02181          CONVERTING LOW-VALUES TO SPACES.                         DTSCS48
02182                                                                   DTSCS48
02183      IF MAP-ADDR-TAD-88                                           DTSCS48
02184         PERFORM S1430-ADDR-TAD THRU S1430-EXIT                    DTSCS48
02185         GO TO S1420-EXIT.                                         DTSCS48
02186                                                                   DTSCS48
02187      IF MAP-ADDR-ID-NO = SPACES                                   DTSCS48
02188         IF MAP-ADDR-NONE-88                                       DTSCS48
02189            PERFORM S1440-REQUIRE-ADDRESS THRU S1440-EXIT          DTSCS48
02190            GO TO S1420-EXIT                                       DTSCS48
02191         ELSE                                                      DTSCS48
02192            MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA               DTSCS48
02193            PERFORM S1421-ERROR THRU S1421-EXIT                    DTSCS48
02194            GO TO S1420-EXIT.                                      DTSCS48
02195                                                                   DTSCS48
02196      IF MAP-ADDR-NONE-88                                          DTSCS48
02197         MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA               DTSCS48
02198         PERFORM S1421-ERROR THRU S1421-EXIT                       DTSCS48
02199         GO TO S1420-EXIT.                                         DTSCS48
02200                                                                   DTSCS48
02201      MOVE MAP-ADDR-ID-NO-AREA TO L013-S-CNT-AREA.                 DTSCS48
02202      MOVE   +1 TO L013-MIN-CNT                                    DTSCS48
02203      MOVE +999 TO L013-MAX-CNT.                                   DTSCS48
02204                                                                   DTSCS48
02205      PERFORM S013-COUNT-FROM-SCREEN THRU S013-EXIT.               DTSCS48
02206                                                                   DTSCS48
02207      IF L013-VALID                                                DTSCS48
02208          MOVE L013-CNT TO MAP-ADDR-ID-NO-Z                        DTSCS48
02209       IF MAP-ADDR-TAA-OPO-88                                      DTSCS48
02210          PERFORM S1450-ADDR-TAA-OPO THRU S1450-EXIT               DTSCS48
02211       ELSE                                                        DTSCS48
02212          NEXT SENTENCE                                            DTSCS48
02213      ELSE                                                         DTSCS48
02214      IF L013-NO-ENTRY                                             DTSCS48
02215          MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA                 DTSCS48
02216          PERFORM S1421-ERROR THRU S1421-EXIT                      DTSCS48
02217      ELSE                                                         DTSCS48
02218      IF L013-INVALID-NEGATIVE                                     DTSCS48
02219          MOVE EMSG-INVALID-NEGATIVE TO WRK-MSG-AREA               DTSCS48
02220          PERFORM S1421-ERROR THRU S1421-EXIT                      DTSCS48
02221      ELSE                                                         DTSCS48
02222      IF L013-EXCEEDS-MIN-MAX                                      DTSCS48
02223          MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA                DTSCS48
02224          PERFORM S1421-ERROR THRU S1421-EXIT                      DTSCS48
02225      ELSE                                                         DTSCS48
02226          MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                DTSCS48
02227          PERFORM S1421-ERROR THRU S1421-EXIT.                     DTSCS48
02228  S1420-EXIT. EXIT.                                                DTSCS48
02229                                                                   DTSCS48
02230  S1421-ERROR.                                                     DTSCS48
02231      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-ADDR-ID-NO-A          DTSCS48
02232      IF LCCM-NO-MSG                                               DTSCS48
02233         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS48
02234         MOVE CATB-CURSOR             TO MAP-ADDR-ID-NO-L          DTSCS48
02235         SET CURSOR-SET-YES TO TRUE.                               DTSCS48
02236  S1421-EXIT. EXIT.                                                DTSCS48
02237                                                                   DTSCS48
02238  S1430-ADDR-TAD.                                                  DTSCS48
02239      IF MAP-ADDR-ID-NO NOT = SPACES                               DTSCS48
02240         MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA               DTSCS48
02241         PERFORM S1421-ERROR THRU S1421-EXIT                       DTSCS48
02242         GO TO S1430-EXIT.                                         DTSCS48
02243                                                                   DTSCS48
02244                                                                   DTSCS48
02245      MOVE WRK-EMP-NO TO L111-EMP-NO.                              DTSCS48
02246      IF MAP-ADDR-TAX-88                                           DTSCS48
02247          SET L111-LOOKUP-TAD-88 TO TRUE                           DTSCS48
02248          SET L111-ID-NO-TAD-MAIL-88 TO TRUE                       DTSCS48
02249      ELSE                                                         DTSCS48
02250      IF MAP-ADDR-PHY-88                                           DTSCS48
02251          SET L111-LOOKUP-TAD-88 TO TRUE                           DTSCS48
02252          SET L111-ID-NO-TAD-PHYS-88 TO TRUE                       DTSCS48
02253      ELSE                                                         DTSCS48
02254          GO TO S899-ABEND.                                        DTSCS48
02255                                                                   DTSCS48
02256                                                                   DTSCS48
02257      PERFORM S111-ADDR-LOOKUP THRU S111-EXIT.                     DTSCS48
02258                                                                   DTSCS48
02259      IF L111-ADDR-NOT-FOUND-88                                    DTSCS48
02260         MOVE EMSG-NO-ADDRESS TO WRK-MSG-AREA                      DTSCS48
02261         PERFORM S1421-ERROR THRU S1421-EXIT                       DTSCS48
02262         GO TO S1430-EXIT.                                         DTSCS48
02263                                                                   DTSCS48
02264      PERFORM S1460-FORMAT THRU S1460-EXIT.                        DTSCS48
02265                                                                   DTSCS48
02266  S1430-EXIT.                                                      DTSCS48
02267      EXIT.                                                        DTSCS48
02268  S1440-REQUIRE-ADDRESS.                                           DTSCS48
02269      INSPECT MAP-MAILING-LINE-1                                   DTSCS48
02270          CONVERTING LOW-VALUES TO SPACES.                         DTSCS48
02271      INSPECT MAP-MAILING-LINE-2                                   DTSCS48
02272          CONVERTING LOW-VALUES TO SPACES.                         DTSCS48
02273      INSPECT MAP-MAILING-LINE-3                                   DTSCS48
02274          CONVERTING LOW-VALUES TO SPACES.                         DTSCS48
02275      INSPECT MAP-MAILING-LINE-4                                   DTSCS48
02276          CONVERTING LOW-VALUES TO SPACES.                         DTSCS48
02277      INSPECT MAP-MAILING-LINE-5                                   DTSCS48
02278          CONVERTING LOW-VALUES TO SPACES.                         DTSCS48
02279                                                                   DTSCS48
02280      IF (MAP-MAILING-LINE-1 = SPACES)                             DTSCS48
02281               AND                                                 DTSCS48
02282         (MAP-MAILING-LINE-2 = SPACES)                             DTSCS48
02283               AND                                                 DTSCS48
02284         (MAP-MAILING-LINE-3 = SPACES)                             DTSCS48
02285               AND                                                 DTSCS48
02286         (MAP-MAILING-LINE-4 = SPACES)                             DTSCS48
02287               AND                                                 DTSCS48
02288         (MAP-MAILING-LINE-5 = SPACES)                             DTSCS48
02289          MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA                 DTSCS48
02290          PERFORM S1441-ERROR THRU S1441-EXIT.                     DTSCS48
02291  S1440-EXIT.                                                      DTSCS48
02292      EXIT.                                                        DTSCS48
02293                                                                   DTSCS48
02294  S1441-ERROR.                                                     DTSCS48
02295      MOVE CATB-UNPROT-NORM-AN-MDTON                               DTSCS48
02296        TO MAP-MAILING-LINE-1-A.                                   DTSCS48
02297      IF LCCM-NO-MSG                                               DTSCS48
02298         MOVE WRK-MSG-AREA  TO LCCM-MSG-AREA                       DTSCS48
02299         MOVE CATB-CURSOR   TO MAP-MAILING-LINE-1-L                DTSCS48
02300         SET CURSOR-SET-YES TO TRUE.                               DTSCS48
02301  S1441-EXIT. EXIT.                                                DTSCS48
02302                                                                   DTSCS48
02303 /**************************************************************** DTSCS48
02304 *                                                                 DTSCS48
02305 ***************************************************************** DTSCS48
02306  S1450-ADDR-TAA-OPO.                                              DTSCS48
02307      MOVE WRK-EMP-NO TO L111-EMP-NO.                              DTSCS48
02308      IF MAP-ADDR-TAX-ALT-88                                       DTSCS48
02309          SET L111-LOOKUP-TAA-88 TO TRUE                           DTSCS48
02310      ELSE                                                         DTSCS48
02311      IF MAP-ADDR-OPO-88                                           DTSCS48
02312          SET L111-LOOKUP-OPO-88 TO TRUE                           DTSCS48
02313      ELSE                                                         DTSCS48
02314          GO TO S899-ABEND.                                        DTSCS48
02315                                                                   DTSCS48
02316      IF L013-CNT = 0                                              DTSCS48
02317         MOVE 1                  TO L111-ID-NO                     DTSCS48
02318      ELSE                                                         DTSCS48
02319         MOVE L013-CNT           TO L111-ID-NO.                    DTSCS48
02320                                                                   DTSCS48
02321      PERFORM S111-ADDR-LOOKUP THRU S111-EXIT.                     DTSCS48
02322                                                                   DTSCS48
02323      IF L111-ADDR-NOT-FOUND-88                                    DTSCS48
02324         MOVE EMSG-NO-ADDRESS TO WRK-MSG-AREA                      DTSCS48
02325         PERFORM S1421-ERROR THRU S1421-EXIT                       DTSCS48
02326         GO TO S1450-EXIT.                                         DTSCS48
02327                                                                   DTSCS48
02328      PERFORM S1460-FORMAT THRU S1460-EXIT.                        DTSCS48
02329                                                                   DTSCS48
02330  S1450-EXIT.                                                      DTSCS48
02331      EXIT.                                                        DTSCS48
02332 /**************************************************************** DTSCS48
02333 *                                                                 DTSCS48
02334 ***************************************************************** DTSCS48
02335  S1460-FORMAT.                                                    DTSCS48
02336      PERFORM S112-ADDR-FORMAT THRU S112-EXIT.                     DTSCS48
02337                                                                   DTSCS48
02338      MOVE L112-MAILING-LINE-1 TO MAP-MAILING-LINE-1.              DTSCS48
02339      MOVE L112-MAILING-LINE-2 TO MAP-MAILING-LINE-2.              DTSCS48
02340      MOVE L112-MAILING-LINE-3 TO MAP-MAILING-LINE-3.              DTSCS48
02341      MOVE L112-MAILING-LINE-4 TO MAP-MAILING-LINE-4.              DTSCS48
02342      MOVE L112-MAILING-LINE-5 TO MAP-MAILING-LINE-5.              DTSCS48
02343  S1460-EXIT. EXIT.                                                DTSCS48
02344                                                                   DTSCS48
02345  S1500-COMP-DATE.                                                 DTSCS48
02346      IF MAP-STATUS-PENDING-88                                     DTSCS48
02347         NEXT SENTENCE                                             DTSCS48
02348      ELSE                                                         DTSCS48
02349         GO TO S1500-EXIT                                          DTSCS48
02350      END-IF.                                                      DTSCS48
02351                                                                   DTSCS48
02352      MOVE MAP-INT-COMP-DATE-AREA TO L015-S-DATE-AREA.             DTSCS48
02353      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS48
02354                                                                   DTSCS48
02355      IF L015-NO-ENTRY                                             DTSCS48
02356         MOVE LCCM-CURR-RUN-DATE TO WRK-DISPLAY                    DTSCS48
02357         MOVE WRK-DISPLAY-MO TO MAP-INT-COMP-MO                    DTSCS48
02358         MOVE WRK-DISPLAY-DA TO MAP-INT-COMP-DA                    DTSCS48
02359         MOVE WRK-DISPLAY-YR TO MAP-INT-COMP-YR                    DTSCS48
02360      ELSE                                                         DTSCS48
02361         IF L015-NOT-VALID                                         DTSCS48
02362            IF MAP-INT-COMP-MO = '99'                              DTSCS48
02363            AND MAP-INT-COMP-DA = '99'                             DTSCS48
02364            AND MAP-INT-COMP-YR = '99'                             DTSCS48
02365               MOVE ALL-NINES-DATE TO LCCM-COMP-DATE               DTSCS48
02366            ELSE                                                   DTSCS48
02367               MOVE EMSG-FIELD-NOT-VALID    TO WRK-MSG-AREA        DTSCS48
02368               PERFORM S1501-ERROR          THRU S1501-EXIT        DTSCS48
02369            END-IF                                                 DTSCS48
02370         ELSE                                                      DTSCS48
02371            MOVE L015-DATE TO LCCM-COMP-DATE                       DTSCS48
02372         END-IF                                                    DTSCS48
02373      END-IF.                                                      DTSCS48
02374                                                                   DTSCS48
02375  S1500-EXIT.                                                      DTSCS48
02376      EXIT.                                                        DTSCS48
02377                                                                   DTSCS48
02378  S1501-ERROR.                                                     DTSCS48
02379      MOVE CATB-UNPROT-NORM-NUM-MDTON                              DTSCS48
02380        TO MAP-INT-COMP-MO-A                                       DTSCS48
02381           MAP-INT-COMP-DA-A                                       DTSCS48
02382           MAP-INT-COMP-YR-A.                                      DTSCS48
02383      IF LCCM-NO-MSG                                               DTSCS48
02384         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS48
02385         MOVE CATB-CURSOR             TO MAP-INT-COMP-MO-L         DTSCS48
02386         SET CURSOR-SET-YES TO TRUE.                               DTSCS48
02387  S1501-EXIT.                                                      DTSCS48
02388      EXIT.                                                        DTSCS48
02389                                                                   DTSCS48
02390 /**************************************************************** DTSCS48
02391 *                                                                 DTSCS48
02392 ***************************************************************** DTSCS48
02393  S2400-AUTHORIZE-OP-ID.                                           DTSCS48
02394      IF MAP-AUTHORIZE-OP-ID EQUAL LOW-VALUES OR SPACES            DTSCS48
02395          MOVE LCCM-RESP-OP-ID TO MAP-AUTHORIZE-OP-ID.             DTSCS48
02396                                                                   DTSCS48
02397      IF MAP-AUTHORIZE-OP-ID = LCCM-OP-ID                          DTSCS48
02398          NEXT SENTENCE                                            DTSCS48
02399      ELSE                                                         DTSCS48
02400          MOVE MAP-AUTHORIZE-OP-ID  TO L082-OP-ID                  DTSCS48
02401          PERFORM S082-OP-ID-EDIT    THRU S082-EXIT                DTSCS48
02402          IF (L082-NOT-VALID-OP) OR (L082-INTERNAL-88)             DTSCS48
02403             MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA             DTSCS48
02404             PERFORM S2401-ERROR THRU S2401-EXIT                   DTSCS48
02405             GO TO S2400-EXIT.                                     DTSCS48
02406                                                                   DTSCS48
02407  S2400-EXIT. EXIT.                                                DTSCS48
02408                                                                   DTSCS48
02409  S2401-ERROR.                                                     DTSCS48
02410      MOVE CATB-UNPROT-NORM-AN-MDTON   TO MAP-AUTHORIZE-OP-ID-A.   DTSCS48
02411      IF LCCM-NO-MSG                                               DTSCS48
02412         SET CURSOR-SET-YES           TO TRUE                      DTSCS48
02413         MOVE WRK-MSG-AREA             TO LCCM-MSG-AREA            DTSCS48
02414         MOVE CATB-CURSOR              TO MAP-AUTHORIZE-OP-ID-L.   DTSCS48
02415  S2401-EXIT. EXIT.                                                DTSCS48
02416                                                                   DTSCS48
02417  S2500-INT-COMP-DATE.                                             DTSCS48
02418      MOVE MCMP-INT-COMP-DATE TO WRK-DISPLAY                       DTSCS48
02419                                 LCCM-COMP-DATE.                   DTSCS48
02420      MOVE WRK-DISPLAY-MO TO MAP-INT-COMP-MO.                      DTSCS48
02421      MOVE WRK-DISPLAY-DA TO MAP-INT-COMP-DA.                      DTSCS48
02422      MOVE WRK-DISPLAY-YR TO MAP-INT-COMP-YR.                      DTSCS48
02423                                                                   DTSCS48
02424  S2500-EXIT.                                                      DTSCS48
02425      EXIT.                                                        DTSCS48
02426                                                                   DTSCS48
02427 /**************************************************************** DTSCS48
02428 *                                                                 DTSCS48
02429 ***************************************************************** DTSCS48
02430  S2900-COVERED-YRQ.                                               DTSCS48
02431                                                                   DTSCS48
02432      MOVE +0 TO WRK-TAX-WAIVED-AMT                                DTSCS48
02433                 WRK-PEN-WAIVED-AMT                                DTSCS48
02434                 WRK-INT-WAIVED-AMT.                               DTSCS48
02435                                                                   DTSCS48
02436      MOVE +0 TO WRK-NO-ENTRY-CTR.                                 DTSCS48
02437                                                                   DTSCS48
02438      PERFORM S2910-YRQ-LOOP THRU S2910-EXIT                       DTSCS48
02439          VARYING WRK-SUB FROM 1 BY 1                              DTSCS48
02440          UNTIL   WRK-SUB > MMAX-CMP-COV-MAX.                      DTSCS48
02441                                                                   DTSCS48
02442      IF WRK-NO-ENTRY-CTR NOT < MMAX-CMP-COV-MAX                   DTSCS48
02443          MOVE MSG-E484-AREA TO WRK-MSG-AREA                       DTSCS48
02444          MOVE +1             TO WRK-SUB                           DTSCS48
02445          PERFORM S2999-ERROR THRU S2999-EXIT                      DTSCS48
02446          GO TO S2900-EXIT.                                        DTSCS48
02447                                                                   DTSCS48
02448      IF LCCM-MSG                                                  DTSCS48
02449          MOVE LOW-VALUES TO MAP-TAX-WAIVED-AMT                    DTSCS48
02450                             MAP-PEN-WAIVED-AMT                    DTSCS48
02451                             MAP-INT-WAIVED-AMT                    DTSCS48
02452          GO TO S2900-EXIT                                         DTSCS48
02453      ELSE                                                         DTSCS48
02454          MOVE WRK-TAX-WAIVED-AMT TO MAP-TAX-WAIVED-AMT-Z          DTSCS48
02455          MOVE WRK-PEN-WAIVED-AMT TO MAP-PEN-WAIVED-AMT-Z          DTSCS48
02456          MOVE WRK-INT-WAIVED-AMT TO MAP-INT-WAIVED-AMT-Z          DTSCS48
02457      END-IF.                                                      DTSCS48
02458                                                                   DTSCS48
02459  S2900-EXIT.                                                      DTSCS48
02460      EXIT.                                                        DTSCS48
02461      EJECT                                                        DTSCS48
02462 * CHECK TO SEE WHAT WAS ENTERED ON THE SCREEN                     DTSCS48
02463  S2910-YRQ-LOOP.                                                  DTSCS48
02464      MOVE LOW-VALUE         TO MAP-WAIVED-AMT (WRK-SUB)           DTSCS48
02465                                MAP-BALANCE-AMT (WRK-SUB).         DTSCS48
02466                                                                   DTSCS48
02467      MOVE +0 TO MCMP-COVERED-YRQ (WRK-SUB).                       DTSCS48
02468                                                                   DTSCS48
02469      MOVE MAP-COVERED-YRQ-AREA (WRK-SUB) TO L029-S-YRQ-AREA.      DTSCS48
02470      PERFORM S029-YRQ-FROM-SCREEN    THRU S029-EXIT.              DTSCS48
02471      IF L029-NOT-VALID                                            DTSCS48
02472          MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                DTSCS48
02473          PERFORM S2999-ERROR THRU S2999-EXIT                      DTSCS48
02474      ELSE                                                         DTSCS48
02475      IF L029-NO-ENTRY                                             DTSCS48
02476          PERFORM S2920-NO-ENTRY THRU S2920-EXIT                   DTSCS48
02477      ELSE                                                         DTSCS48
02478          PERFORM S2930-YRQ-ENTERED THRU S2930-EXIT.               DTSCS48
02479  S2910-EXIT.                                                      DTSCS48
02480      EXIT.                                                        DTSCS48
02481                                                                   DTSCS48
02482  S2920-NO-ENTRY.                                                  DTSCS48
02483      ADD +1 TO WRK-NO-ENTRY-CTR.                                  DTSCS48
02484  S2920-EXIT.                                                      DTSCS48
02485      EXIT.                                                        DTSCS48
02486                                                                   DTSCS48
02487  S2930-YRQ-ENTERED.                                               DTSCS48
02488      MOVE L029-YRQ TO MCMP-COVERED-YRQ (WRK-SUB).                 DTSCS48
02489 * QTRS MUST BE ASCENDING SEQ                                      DTSCS48
02490      IF WRK-SUB > +1                                              DTSCS48
02491          COMPUTE WRK-SUB-MINUS-ONE = WRK-SUB - 1                  DTSCS48
02492          IF (MCMP-COVERED-YRQ (WRK-SUB-MINUS-ONE) = +0)           DTSCS48
02493                OR                                                 DTSCS48
02494             (MCMP-COVERED-YRQ (WRK-SUB)                           DTSCS48
02495               NOT > MCMP-COVERED-YRQ (WRK-SUB-MINUS-ONE))         DTSCS48
02496              MOVE MSG-E481-AREA TO WRK-MSG-AREA                   DTSCS48
02497              PERFORM S2999-ERROR THRU S2999-EXIT                  DTSCS48
02498              GO TO S2930-EXIT.                                    DTSCS48
02499                                                                   DTSCS48
02500                                                                   DTSCS48
02501      MOVE LOW-VALUES       TO MQTR-KEY-AREA.                      DTSCS48
02502      MOVE MPRF-EMP-NO      TO MQTR-EMP-NO.                        DTSCS48
02503      SET MQTR-QTR-88       TO TRUE.                               DTSCS48
02504      MOVE MCMP-COVERED-YRQ (WRK-SUB) TO MQTR-YRQ.                 DTSCS48
02505      MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS48
02506                                                                   DTSCS48
02507      PERFORM S810-READ THRU S810-EXIT.                            DTSCS48
02508                                                                   DTSCS48
02509      IF L810-NO-REC-88                                            DTSCS48
02510         IF MAP-STATUS-CD = 'F' OR 'P'                             DTSCS48
02511            MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                    DTSCS48
02512            PERFORM S2999-ERROR THRU S2999-EXIT                    DTSCS48
02513            GO TO S2930-EXIT                                       DTSCS48
02514         ELSE                                                      DTSCS48
02515            GO TO S2930-EXIT.                                      DTSCS48
02516                                                                   DTSCS48
02517      MOVE MSKL-REC TO MQTR-REC.                                   DTSCS48
02518                                                                   DTSCS48
02519      MOVE +0 TO WRK-YRQ-BALANCE-AMT                               DTSCS48
02520                 WRK-YRQ-TAX-BAL-AMT                               DTSCS48
02521                 WRK-YRQ-WAIVED-AMT                                DTSCS48
02522                 WRK-YRQ-WRITTEN-OFF-AMT.                          DTSCS48
02523                                                                   DTSCS48
02524      PERFORM S4000-AMOUNTS    THRU S4000-EXIT.                    DTSCS48
02525                                                                   DTSCS48
02526      IF (WRK-YRQ-TAX-BAL-AMT = +0)                                DTSCS48
02527                AND                                                DTSCS48
02528         (MAP-STATUS-CD = 'F' OR 'P')                              DTSCS48
02529          MOVE MSG-E482-AREA TO WRK-MSG-AREA                       DTSCS48
02530          PERFORM S2999-ERROR THRU S2999-EXIT                      DTSCS48
02531          GO TO S2930-EXIT.                                        DTSCS48
02532                                                                   DTSCS48
02533      IF WRK-YRQ-WRITTEN-OFF-AMT  NOT =  +0                        DTSCS48
02534          MOVE ' WRITE OFF'        TO MAP-WAIVED-AMT (WRK-SUB)     DTSCS48
02535      ELSE                                                         DTSCS48
02536          MOVE WRK-YRQ-WAIVED-AMT  TO MAP-WAIVED-AMT-Z (WRK-SUB)   DTSCS48
02537          MOVE WRK-YRQ-BALANCE-AMT TO MAP-BALANCE-AMT-Z (WRK-SUB). DTSCS48
02538                                                                   DTSCS48
02539                                                                   DTSCS48
02540  S2930-EXIT.                                                      DTSCS48
02541      EXIT.                                                        DTSCS48
02542                                                                   DTSCS48
02543  S2999-ERROR.                                                     DTSCS48
02544      MOVE CATB-UNPROT-NORM-AN-MDTON                               DTSCS48
02545        TO MAP-COVERED-YRQ-YR-A(WRK-SUB)                           DTSCS48
02546           MAP-COVERED-YRQ-Q-A(WRK-SUB)                            DTSCS48
02547      IF LCCM-NO-MSG                                               DTSCS48
02548         MOVE WRK-MSG-AREA       TO LCCM-MSG-AREA                  DTSCS48
02549         MOVE CATB-CURSOR        TO MAP-COVERED-YRQ-YR-L(WRK-SUB)  DTSCS48
02550         SET CURSOR-SET-YES TO TRUE.                               DTSCS48
02551  S2999-EXIT.                                                      DTSCS48
02552      EXIT.                                                        DTSCS48
02553 /**************************************************************** DTSCS48
02554 *                                                                 DTSCS48
02555 ***************************************************************** DTSCS48
02556  S4000-AMOUNTS.                                                   DTSCS48
02557      MOVE +0 TO WRK-YRQ-BALANCE-AMT                               DTSCS48
02558                 WRK-YRQ-TAX-BAL-AMT                               DTSCS48
02559                 WRK-YRQ-WAIVED-AMT                                DTSCS48
02560                 WRK-YRQ-WRITTEN-OFF-AMT                           DTSCS48
02561                 L101-PAID-CHNG                                    DTSCS48
02562                 L101-INT-CHARGE-CHNG                              DTSCS48
02563                 L101-INT-WAIVE-CHNG.                              DTSCS48
02564                                                                   DTSCS48
02565      PERFORM VARYING MQTR-ACCT-IDX FROM 1 BY 1                    DTSCS48
02566              UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT                  DTSCS48
02567          ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX)                     DTSCS48
02568                                TO WRK-YRQ-BALANCE-AMT             DTSCS48
02569          ADD MQTR-WRITTEN-OFF-AMT (MQTR-ACCT-IDX)                 DTSCS48
02570                                TO WRK-YRQ-WRITTEN-OFF-AMT         DTSCS48
02571          ADD MQTR-WAIVED-AMT (MQTR-ACCT-IDX)                      DTSCS48
02572                                TO WRK-YRQ-WAIVED-AMT              DTSCS48
02573 *        IF MQTR-ACCT-TAX-88 (MQTR-ACCT-IDX)                      DTSCS48
02574          IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX)                       DTSCS48
02575             ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX)                  DTSCS48
02576                                TO WRK-YRQ-TAX-BAL-AMT             DTSCS48
02577                                   L101-PAID-CHNG                  DTSCS48
02578             ADD MQTR-WAIVED-AMT (MQTR-ACCT-IDX)                   DTSCS48
02579                                TO WRK-TAX-WAIVED-AMT              DTSCS48
02580          ELSE                                                     DTSCS48
02581            IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) AND                DTSCS48
02582               MQTR-YRQ >= L109-FIRST-PEN-INT-YRQ                  DTSCS48
02583               ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX)                DTSCS48
02584                                TO WRK-YRQ-TAX-BAL-AMT             DTSCS48
02585                                   L101-PAID-CHNG                  DTSCS48
02586          ELSE                                                     DTSCS48
02587             IF MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX)              DTSCS48
02588                ADD MQTR-WAIVED-AMT (MQTR-ACCT-IDX)                DTSCS48
02589                                TO WRK-PEN-WAIVED-AMT              DTSCS48
02590             ELSE                                                  DTSCS48
02591                IF MQTR-ACCT-INT-88 (MQTR-ACCT-IDX)                DTSCS48
02592                   ADD MQTR-WAIVED-AMT (MQTR-ACCT-IDX)             DTSCS48
02593                                TO WRK-INT-WAIVED-AMT              DTSCS48
02594                END-IF                                             DTSCS48
02595             END-IF                                                DTSCS48
02596           END-IF                                                  DTSCS48
02597          END-IF                                                   DTSCS48
02598      END-PERFORM.                                                 DTSCS48
02599                                                                   DTSCS48
02600      PERFORM S4010-INTEREST        THRU S4010-EXIT.               DTSCS48
02601                                                                   DTSCS48
02602      ADD L101-INT-CHARGE-CHNG      TO WRK-YRQ-BALANCE-AMT.        DTSCS48
02603                                                                   DTSCS48
02604      SUBTRACT L101-INT-WAIVE-CHNG  FROM WRK-YRQ-BALANCE-AMT.      DTSCS48
02605                                                                   DTSCS48
02606  S4000-EXIT.                                                      DTSCS48
02607      EXIT.                                                        DTSCS48
02608                                                                   DTSCS48
02609  S4010-INTEREST.                                                  DTSCS48
02610      IF LCCM-COMP-DATE = ALL-NINES-DATE                           DTSCS48
02611          GO TO S4010-EXIT                                         DTSCS48
02612      END-IF.                                                      DTSCS48
02613                                                                   DTSCS48
02614      IF L101-PAID-CHNG > +0                                       DTSCS48
02615          MOVE LCCM-COMP-DATE TO L101-RECEIVED-DATE                DTSCS48
02616          SET L101-WAIVE-INT-NO-88 TO TRUE                         DTSCS48
02617          MOVE MQTR-TAX-DUE-DATE TO L101-TAX-DUE-DATE              DTSCS48
02618          MOVE MQTR-INT-AREA TO L101-INT-AREA                      DTSCS48
02619                                                                   DTSCS48
02620          PERFORM S101-PER-MONTH-YES THRU S101-EXIT                DTSCS48
02621      ELSE                                                         DTSCS48
02622         MOVE ZERO            TO L101-INT-CHARGE-CHNG              DTSCS48
02623                                 L101-INT-WAIVE-CHNG               DTSCS48
02624      END-IF.                                                      DTSCS48
02625                                                                   DTSCS48
02626  S4010-EXIT.                                                      DTSCS48
02627      EXIT.                                                        DTSCS48
02628 /**************************************************************** DTSCS48
02629 * LOCK SCREEN FOR UPDATE CONFIRMATION                             DTSCS48
02630 ***************************************************************** DTSCS48
02631  S5100-SET-LOCK-ATTRB.                                            DTSCS48
02632      MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN                      DTSCS48
02633                                   WRK-ATB-NUM.                    DTSCS48
02634                                                                   DTSCS48
02635      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCS48
02636                                                                   DTSCS48
02637      MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-NO-1-A                  DTSCS48
02638                                   MAP-EMP-NO-2-A                  DTSCS48
02639                                   MAP-GOTO-A.                     DTSCS48
02640  S5100-EXIT.                                                      DTSCS48
02641      EXIT.                                                        DTSCS48
02642                                                                   DTSCS48
02643 ***************************************************************** DTSCS48
02644 * SET ATTIBUTE BYTES FOR UPDATE ACCESS                            DTSCS48
02645 ***************************************************************** DTSCS48
02646  S5200-SET-UPDATE-ATTRB.                                          DTSCS48
02647      MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN.                 DTSCS48
02648      MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM.               DTSCS48
02649                                                                   DTSCS48
02650      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCS48
02651                                                                   DTSCS48
02652                                                                   DTSCS48
02653  S5200-EXIT.                                                      DTSCS48
02654      EXIT.                                                        DTSCS48
02655                                                                   DTSCS48
02656 ***************************************************************** DTSCS48
02657 *  SET ATTRIBUTE BYTES FOR INQUIRY STATUS                         DTSCS48
02658 ***************************************************************** DTSCS48
02659  S5300-SET-INQ-ATTRB.                                             DTSCS48
02660      MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN                     DTSCS48
02661                                    WRK-ATB-NUM.                   DTSCS48
02662                                                                   DTSCS48
02663      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCS48
02664  S5300-EXIT.                                                      DTSCS48
02665      EXIT.                                                        DTSCS48
02666                                                                   DTSCS48
02667  S5900-SET-ATTRB.                                                 DTSCS48
02668      MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A             DTSCS48
02669                                        MAP-EMP-NO-2-A.            DTSCS48
02670                                                                   DTSCS48
02671      IF LCCM-SCR-CLEAR                                            DTSCS48
02672          MOVE CATB-ASKIP-BRT-MDTON                                DTSCS48
02673            TO MAP-STATUS-CD-A                                     DTSCS48
02674          MOVE WRK-ATB-AN                                          DTSCS48
02675            TO MAP-ADDR-TYPE-A                                     DTSCS48
02676               MAP-MAILING-LINE-1-A                                DTSCS48
02677               MAP-MAILING-LINE-2-A                                DTSCS48
02678               MAP-MAILING-LINE-3-A                                DTSCS48
02679               MAP-MAILING-LINE-4-A                                DTSCS48
02680               MAP-MAILING-LINE-5-A                                DTSCS48
02681               MAP-AUTHORIZE-OP-ID-A                               DTSCS48
02682          MOVE WRK-ATB-NUM                                         DTSCS48
02683            TO MAP-ADDR-ID-NO-A                                    DTSCS48
02684               MAP-SETTLEMENT-DA-A                                 DTSCS48
02685               MAP-SETTLEMENT-MO-A                                 DTSCS48
02686               MAP-SETTLEMENT-YR-A                                 DTSCS48
02687               MAP-INT-COMP-DA-A                                   DTSCS48
02688               MAP-INT-COMP-MO-A                                   DTSCS48
02689               MAP-INT-COMP-YR-A                                   DTSCS48
02690                                                                   DTSCS48
02691          PERFORM VARYING WRK-SUB FROM 1 BY 1                      DTSCS48
02692                  UNTIL   WRK-SUB > MMAX-CMP-COV-MAX               DTSCS48
02693              MOVE WRK-ATB-AN                                      DTSCS48
02694                TO MAP-COVERED-YRQ-Q-A (WRK-SUB)                   DTSCS48
02695                   MAP-COVERED-YRQ-YR-A (WRK-SUB)                  DTSCS48
02696              MOVE CATB-ASKIP-BRT-MDTON                            DTSCS48
02697                TO MAP-WAIVED-AMT-A (WRK-SUB)                      DTSCS48
02698                   MAP-BALANCE-AMT-A (WRK-SUB)                     DTSCS48
02699          END-PERFORM                                              DTSCS48
02700      ELSE                                                         DTSCS48
02701          MOVE WRK-ATB-AN                                          DTSCS48
02702            TO MAP-STATUS-CD-A                                     DTSCS48
02703          MOVE CATB-ASKIP-BRT-MDTON                                DTSCS48
02704            TO MAP-ADDR-ID-NO-A                                    DTSCS48
02705               MAP-SETTLEMENT-DA-A                                 DTSCS48
02706               MAP-SETTLEMENT-MO-A                                 DTSCS48
02707               MAP-SETTLEMENT-YR-A                                 DTSCS48
02708               MAP-INT-COMP-DA-A                                   DTSCS48
02709               MAP-INT-COMP-MO-A                                   DTSCS48
02710               MAP-INT-COMP-YR-A                                   DTSCS48
02711               MAP-ADDR-TYPE-A                                     DTSCS48
02712               MAP-MAILING-LINE-1-A                                DTSCS48
02713               MAP-MAILING-LINE-2-A                                DTSCS48
02714               MAP-MAILING-LINE-3-A                                DTSCS48
02715               MAP-MAILING-LINE-4-A                                DTSCS48
02716               MAP-MAILING-LINE-5-A                                DTSCS48
02717               MAP-AUTHORIZE-OP-ID-A                               DTSCS48
02718                                                                   DTSCS48
02719          PERFORM VARYING WRK-SUB FROM 1 BY 1                      DTSCS48
02720                  UNTIL   WRK-SUB > MMAX-CMP-COV-MAX               DTSCS48
02721              MOVE CATB-ASKIP-BRT-MDTON                            DTSCS48
02722                TO MAP-COVERED-YRQ-Q-A (WRK-SUB)                   DTSCS48
02723                   MAP-COVERED-YRQ-YR-A(WRK-SUB)                   DTSCS48
02724                   MAP-WAIVED-AMT-A(WRK-SUB)                       DTSCS48
02725                   MAP-BALANCE-AMT-A(WRK-SUB)                      DTSCS48
02726          END-PERFORM                                              DTSCS48
02727      END-IF.                                                      DTSCS48
02728                                                                   DTSCS48
02729                                                                   DTSCS48
02730      MOVE CATB-ASKIP-BRT-MDTON TO MAP-PRIMARY-NAME-A              DTSCS48
02731                                   MAP-TAX-WAIVED-AMT-A            DTSCS48
02732                                   MAP-PEN-WAIVED-AMT-A            DTSCS48
02733                                   MAP-INT-WAIVED-AMT-A            DTSCS48
02734                                   MAP-TOT-BALANCE-AMT-A           DTSCS48
02735                                   MAP-CURR-PAGE-A                 DTSCS48
02736                                   MAP-LAST-PAGE-A.                DTSCS48
02737                                                                   DTSCS48
02738      MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A.                 DTSCS48
02739  S5900-EXIT.                                                      DTSCS48
02740      EXIT.                                                        DTSCS48
02741      EJECT                                                        DTSCS48
02742 /**************************************************************** DTSCS48
02743 * MAP ROUTINES                                                    DTSCS48
02744 ***************************************************************** DTSCS48
02745  S9100-RECEIVE.                                                   DTSCS48
02746      SET L851-RECEIVE-88 TO TRUE.                                 DTSCS48
02747                                                                   DTSCS48
02748      MOVE WRK-SCR-ID TO L851-SCR-ID.                              DTSCS48
02749                                                                   DTSCS48
02750      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS48
02751                                                                   DTSCS48
02752      MOVE L851-AID TO LCCM-AID.                                   DTSCS48
02753      MOVE L851-CURSOR TO LCCM-CURSOR.                             DTSCS48
02754  S9100-EXIT.                                                      DTSCS48
02755      EXIT.                                                        DTSCS48
02756                                                                   DTSCS48
02757  S9200-SEND-DATAONLY.                                             DTSCS48
02758      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS48
02759                                                                   DTSCS48
02760      IF LCCM-NO-MSG                                               DTSCS48
02761          NEXT SENTENCE                                            DTSCS48
02762      ELSE                                                         DTSCS48
02763          PERFORM S805-MSG-AREA THRU S805-EXIT.                    DTSCS48
02764                                                                   DTSCS48
02765      IF CURSOR-SET-GOTO                                           DTSCS48
02766          MOVE CATB-CURSOR TO MAP-GOTO-L                           DTSCS48
02767      ELSE                                                         DTSCS48
02768          MOVE CATB-CURSOR TO MAP-EMP-NO-1-L.                      DTSCS48
02769                                                                   DTSCS48
02770      SET L851-SEND-DATAONLY-88 TO TRUE.                           DTSCS48
02771                                                                   DTSCS48
02772      PERFORM S9900-PREPARE-SEND THRU S9900-EXIT.                  DTSCS48
02773                                                                   DTSCS48
02774      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS48
02775  S9200-EXIT.                                                      DTSCS48
02776      EXIT.                                                        DTSCS48
02777                                                                   DTSCS48
02778  S9300-SEND-MAP.                                                  DTSCS48
02779      MOVE  LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE.             DTSCS48
02780      MOVE  LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME.             DTSCS48
02781      MOVE  LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME.         DTSCS48
02782                                                                   DTSCS48
02783      IF SCR-ACCESS-UPDATE                                         DTSCS48
02784          PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT               DTSCS48
02785      ELSE                                                         DTSCS48
02786          PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT.             DTSCS48
02787                                                                   DTSCS48
02788      PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT.                   DTSCS48
02789                                                                   DTSCS48
02790      PERFORM S805-MSG-AREA THRU S805-EXIT.                        DTSCS48
02791                                                                   DTSCS48
02792      IF CURSOR-SET-NO                                             DTSCS48
02793          MOVE CATB-CURSOR TO MAP-EMP-NO-1-L.                      DTSCS48
02794                                                                   DTSCS48
02795      SET L851-SEND-88 TO TRUE.                                    DTSCS48
02796                                                                   DTSCS48
02797      PERFORM S9900-PREPARE-SEND THRU S9900-EXIT.                  DTSCS48
02798                                                                   DTSCS48
02799      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS48
02800  S9300-EXIT.                                                      DTSCS48
02801      EXIT.                                                        DTSCS48
02802                                                                   DTSCS48
02803  S9310-UPDATE-FKEYS.                                              DTSCS48
02804      PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT.                 DTSCS48
02805                                                                   DTSCS48
02806                                                                   DTSCS48
02807      IF LCCM-SCR-CLEAR                                            DTSCS48
02808          MOVE CFKD-ADD TO MAP-KEY-ADD                             DTSCS48
02809      ELSE                                                         DTSCS48
02810      IF LCCM-SCR-INQUIRE                                          DTSCS48
02811          MOVE CFKD-MOD TO MAP-KEY-MOD                             DTSCS48
02812      ELSE                                                         DTSCS48
02813      IF LCCM-SCR-UPDATE-LOCKED                                    DTSCS48
02814          MOVE LOW-VALUES TO MAP-KEY-FIRST                         DTSCS48
02815                             MAP-KEY-LAST                          DTSCS48
02816                             MAP-KEY-BACK                          DTSCS48
02817                             MAP-KEY-FWRD.                         DTSCS48
02818  S9310-EXIT.                                                      DTSCS48
02819      EXIT.                                                        DTSCS48
02820                                                                   DTSCS48
02821  S9320-INQUIRY-FKEYS.                                             DTSCS48
02822      MOVE CFKD-FIRST     TO MAP-KEY-FIRST.                        DTSCS48
02823      MOVE CFKD-LAST      TO MAP-KEY-LAST.                         DTSCS48
02824      MOVE CFKD-BACKWARD  TO MAP-KEY-BACK.                         DTSCS48
02825      MOVE CFKD-FORWARD   TO MAP-KEY-FWRD.                         DTSCS48
02826                                                                   DTSCS48
02827      MOVE LOW-VALUES TO MAP-KEY-ADD                               DTSCS48
02828                         MAP-KEY-MOD                               DTSCS48
02829                         MAP-KEY-DEL.                              DTSCS48
02830                                                                   DTSCS48
02831 *    PERFORM S9321-JUMP-KEYS THRU S9321-EXIT.                     DTSCS48
02832  S9320-EXIT.                                                      DTSCS48
02833      EXIT.                                                        DTSCS48
02834                                                                   DTSCS48
02835 *S9321-JUMP-KEYS.                                                 DTSCS48
02836 *    MOVE CFKD-QTR-INQ TO MAP-KEY-QTR-INQ.                        DTSCS48
02837 *    MOVE CFKD-COLL-INQ TO MAP-KEY-COLL-INQ.                      DTSCS48
02838 *S9321-EXIT.                                                      DTSCS48
02839 *    EXIT.                                                        DTSCS48
02840 *                                                                 DTSCS48
02841  S9330-DSCR-FIELDS.                                               DTSCS48
02842      IF WRK-MPRF-YES-88                                           DTSCS48
02843          MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME               DTSCS48
02844      END-IF.                                                      DTSCS48
02845                                                                   DTSCS48
02846      IF MAP-STATUS-CD = LOW-VALUES OR SPACES                      DTSCS48
02847         MOVE LOW-VALUES TO MAP-STATUS-CD-DSCR                     DTSCS48
02848      ELSE                                                         DTSCS48
02849         MOVE MAP-STATUS-CD TO L034-CD                             DTSCS48
02850         PERFORM S034-MCMP-STATUS-CD THRU S034-EXIT                DTSCS48
02851         MOVE L034-SHORT-DSCR TO MAP-STATUS-CD-DSCR.               DTSCS48
02852                                                                   DTSCS48
02853 *    IF MAP-AUTHORIZE-OP-ID = LCCM-OP-ID                          DTSCS48
02854 *       MOVE LCCM-OP-NAME TO MAP-AUTHORIZE-OP-ID-DSCR             DTSCS48
02855 *    ELSE                                                         DTSCS48
02856 *    IF MAP-AUTHORIZE-OP-ID = L082-NAME                           DTSCS48
02857 *        MOVE L082-NAME TO MAP-AUTHORIZE-OP-ID-DSCR               DTSCS48
02858 *    ELSE                                                         DTSCS48
02859 *        MOVE MAP-AUTHORIZE-OP-ID    TO L082-OP-ID                DTSCS48
02860 *        PERFORM S082-OP-ID-EDIT    THRU S082-EXIT                DTSCS48
02861 *        MOVE L082-NAME TO MAP-AUTHORIZE-OP-ID-DSCR.              DTSCS48
02862                                                                   DTSCS48
02863  S9330-EXIT. EXIT.                                                DTSCS48
02864                                                                   DTSCS48
02865  S9900-PREPARE-SEND.                                              DTSCS48
02866      MOVE WRK-SCR-ID TO L851-SCR-ID                               DTSCS48
02867                         LCCM-SCR-ID.                              DTSCS48
02868      MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND.                    DTSCS48
02869      MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE.                         DTSCS48
02870  S9900-EXIT.                                                      DTSCS48
02871      EXIT.                                                        DTSCS48
