00001  IDENTIFICATION DIVISION.                                         11/18/24
00002  PROGRAM-ID.             DTSCS26.                                 DTSCS26
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV010
00004  DATE-WRITTEN.           NOVEMBER 1991.                           DTSCS26
00005  DATE-COMPILED.                                                   DTSCS26
00006      SKIP3                                                        DTSCS26
00007 *****                                                             DTSCS26
00008 *                                                                 DTSCS26
00009 *    FUNCTION:  ADJUSTMENT ENTRY SCREEN PROCESSOR.                DTSCS26
00010 *                                                                 DTSCS26
00011 *                                                                 DTSCS26
00012 *    MODIFICATION LOG:                                            DTSCS26
00013 *                                                                 DTSCS26
00014 *    11/06/91  INITIAL DEVELOPMENT.                               DTSCS26
00015 *              WORK ORDER:                      PROGRAMMER: TCL   DTSCS26
00016 *                                                                 DTSCS26
00017 *    12/13/94  ALTER SELECTED ERROR MESSAGES TO #E051.            DTSCS26
00018 *              WORK ORDER: TPR003               PROGRAMMER: RHC   DTSCS26
00019 *                                                                 DTSCS26
00020 *    01/23/95  RELOCATE ADJUSTMENT TYPE ON THE SCREEN.            DTSCS26
00021 *              WORK ORDER: CR040                PROGRAMMER: RHC   DTSCS26
00022 *                                                                 DTSCS26
00023 *    01/30/95  SPLIT OP INTO SUFFIX AND PREFIX, PREFIX OPTIONAL.  DTSCS26
00024 *              WORK ORDER: CR041                PROGRAMMER: RHC   DTSCS26
00025 *                                                                 DTSCS26
00026 *    05/23/95  REQUIRE DATE-1 FOR SUSPENSIONS.                    DTSCS26
00027 *              WORK ORDER: CR083                PROGRAMMER: RHC   DTSCS26
00028 *                                                                 DTSCS26
00029 *    12/31/1998  REVIEWED AND MODIFIED FOR DC.                    DTSCS26
00030 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH   DTSCS26
00031 *                                                                 DTSCS26
00032 *    02/26/1999  MODIFIED TO REFLECT DC SELF INSURED TAX DUE      DTSCS26
00033 *                DATE REQUIREMENT.                                DTSCS26
00034 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH   DTSCS26
00035 *                                                                 DTSCS26
00036 *    05/13/1999  RESTRICT ENTRY OF APPLIC QTR TO PU OR >= 1993/1. DTSCS26
00037 *                MODIFY MANY EDITS ASSOICATED WITH ENTRY OF       DTSCS26
00038 *                AN ADJUSTMENT TRANSACTIONS AGAINST THE PICK UP   DTSCS26
00039 *                QUARTER.                                         DTSCS26
00040 *                REFERENCE: PICKUP DIR          PROGRAMMER: EHH   DTSCS26
00041 *                                                                 DTSCS26
00042 *    04/08/2004  MODIFIED PROCESSING OF ADJUSTMENTS FOR QUARTERS  DTSCS26
00043 *                REPORTED ANNUALLY. SEPARATE CH AND WV            DTSCS26
00044 *                TRANSACTIONS MUST BE ENTERED FOR EACH QUARTER.   DTSCS26
00045 *                FOR OTHER ADJUSTMENT TYPES, THE SYSTEM WILL      DTSCS26
00046 *                AUTOMATICALLY GENERATE FOUR TRANSACTIONS.        DTSCS26
00047 *                REFERENCE: HOUSEHOLD           PROGRAMMER: GD    DTSCS26
00048 *                                                                 DTSCS26
00049 *    04/22/2004  MODIFIED FOR ENTRY OF COMPROMISE SETTLEMENT      DTSCS26
00050 *                WAIVER TRANSACTIONS.                             DTSCS26
00051 *                REFERENCE: COMPROMISE          PROGRAMMER: GD    DTSCS26
00052 *                                                                 DTSCS26
00053 *    12/14/2004  MODIFIED P8920 - DID NOT INITIALIZE CMP-ASBSTIME DTSCS26
00054 *                CORRECTLY.                                       DTSCS26
00055 *                REFERENCE: COMPROMISE          PROGRAMMER: GD    DTSCS26
00056 *                                                                 DTSCS26
00057 *    10/12/2006  ADDED PROCESSING TO WRITE R906 RECORDS TO        DTSCS26
00058 *                TRACK UPDATES TO ACCOUNTING TRANSACTIONS.        DTSCS26
00059 *                THE PROCESS USES DTSCU221.                       DTSCS26
00060 *                REFERENCE: ACTIVITY TRACKING   PROGRAMMER: GD    DTSCS26
00061 *                                                                 DTSCS26
00062 *    02/02/2007  MODIFIED S4120, S4123 TO ALLOW CHARGE            DTSCS26
00063 *                ADJUSTMENTS TO ADMINISTRATIVE ASSESSMENT FOR     DTSCS26
00064 *                SELF-INSURED EMPLOYERS.                          DTSCS26
00065 *                REFERENCE:                     PROGRAMMER: GD    DTSCS26
00066 *                                                                 DTSCS26
00067 *    12/22/2009  MODIFIED P8110, P8210, P8300 TO CALL DTSCU826    DTSCS26
00068 *                TO SAVE COPIES OF REPORT RECORDS WHEN ADDED      DTSCS26
00069 *                AND WHEN MODIFIED. THE RECORDS ARE SAVED         DTSCS26
00070 *                IN THE ACCOUNTING TRANSACTION HISTORY            DTSCS26
00071 *                FILE (ATH).                                      DTSCS26
00072 *                REFERENCE:                     PROGRAMMER: GD    DTSCS26
00073 *                                                                 DTSCS26
00074 *                                                                 DTSCS26
00075 *    06/08/2012  MODIFIED S1200 TO ALLOW SUPERVISORS ONLY TO      DTSCS26
00076 *                WRITE OFF TRANSACTIONS                           DTSCS26
00077 *                REFERENCE:                     PROGRAMMER: ZL1   DTSCS26
00078 *                                                                 DTSCS26
00079 *    06/20/2012  CORRECTED A MINOR ERROR IN THE WRITE-OFF         DTSCS26
00080 *                CHANGE ABOVE.                                    DTSCS26
00081 *                REFERENCE:                     PROGRAMMER: GD1   DTSCS26
00082 *                                                                 DTSCS26
00083 *                                                                    CL**6
00084 *    10/25/2012  MODIFIED CODE TO CHECK FOR SUPERVISORS APPROVAL     CL**6
00085 *                BEFORE A WRITE OFF TRANSACTION CAN BE UPDATED.      CL**6
00086 *                MOVE PARA S1400-EMP-NO TO S1150-EMP-NO BECAUSE      CL**6
00087 *                NEEDED TO PASS EMP-NO TO CU084 MODULE TO VERIFY     CL**6
00088 *                APPROVAL                                            CL**6
00089 *                REFERENCE:                     PROGRAMMER: ZL1      CL**6
00090 *                                                                    CL**6
00091 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCS26
00092 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCS26
00093 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSCS26
00094 *                                                                 DTSCS26
00095 *                                                                 DTSCS26
00096 *  DESCRIPTION:                                                   DTSCS26
00097 *                                                                 DTSCS26
00098 *                                                                 DTSCS26
00099 *    CLEAR:                                                       DTSCS26
00100 *                                                                 DTSCS26
00101 *      FIELD DISPLAYED:                                           DTSCS26
00102 *                                                                 DTSCS26
00103 *        MAP-BATCH-NO                                             DTSCS26
00104 *          (FROM LCCM-BATCH-NO;  MOVE +0 TO LCCM-BATCH-NO;        DTSCS26
00105 *             MOVE +0 TO LCCM-ITEM-NO)                            DTSCS26
00106 *                                                                 DTSCS26
00107 *        MAP-ENTRY-MODE                                           DTSCS26
00108 *          (FROM LCCM-ENTRY-MODE)                                 DTSCS26
00109 *                                                                 DTSCS26
00110 *                                                                 DTSCS26
00111 *    JUMP:                                                        DTSCS26
00112 *                                                                 DTSCS26
00113 *      STANDARD                                                   DTSCS26
00114 *                                                                 DTSCS26
00115 *                                                                 DTSCS26
00116 *    INQUIRY:                                                     DTSCS26
00117 *                                                                 DTSCS26
00118 *                                                                 DTSCS26
00119 *      CONTROL FIELDS: MAP-DOC-NO (MAP-BATCH-NO AND MAP-ITEM-NO)  DTSCS26
00120 *                                                                 DTSCS26
00121 *                                                                 DTSCS26
00122 *      JUMP IN:                                                   DTSCS26
00123 *                                                                 DTSCS26
00124 *        IF LCCM-BATCH-NO = 0                                     DTSCS26
00125 *            CLEAR                                                DTSCS26
00126 *        ELSE                                                     DTSCS26
00127 *            IF LCCM-ITEM-NO = 0                                  DTSCS26
00128 *                CLEAR                                            DTSCS26
00129 *            ELSE                                                 DTSCS26
00130 *                IF LCCM-DOC-NO EXISTS ON ACCT TRAN FILE          DTSCS26
00131 *                    IF LCCM-DOC-NO IS AN AADJ RECORD             DTSCS26
00132 *                        DISPLAY THE AADJ RECORD                  DTSCS26
00133 *                    ELSE                                         DTSCS26
00134 *                        JUMP TO APPROPRIATE SCREEN TO DISPLAY    DTSCS26
00135 *                        A* RECORD TYPE                           DTSCS26
00136 *                ELSE                                             DTSCS26
00137 *                    CLEAR; DISPLAY 'NO RECORD' MESSAGE.          DTSCS26
00138 *                                                                 DTSCS26
00139 *                                                                 DTSCS26
00140 *      F9                                                         DTSCS26
00141 *                                                                 DTSCS26
00142 *        IF MAP-BATCH-NO ENTERED                                  DTSCS26
00143 *            IF MAP-ITEM-NO ENTERED                               DTSCS26
00144 *                IF MAP-DOC-NO EXISTS ON THE ACCT TRAN FILE       DTSCS26
00145 *                    IF MAP-DOC-NO ON ACT FILE IS AN AADJ RECORD  DTSCS26
00146 *                        DISPLAY MAP-DOC-NO RECORD FROM ACT FILE  DTSCS26
00147 *                    ELSE                                         DTSCS26
00148 *                        JUMP TO APPROPRIATE SCREEN TO DISPLAY    DTSCS26
00149 *                        A* RECORD TYPE                           DTSCS26
00150 *                ELSE                                             DTSCS26
00151 *                    CLEAR; DISPLAY 'NO RECORD' MESSAGE           DTSCS26
00152 *            ELSE                                                 DTSCS26
00153 *                CLEAR; DISPLAY 'PLEASE ENTER' MESSAGE            DTSCS26
00154 *        ELSE                                                     DTSCS26
00155 *        IF LCCM-BATCH-NO = 0                                     DTSCS26
00156 *            CLEAR; DISPLAY 'PLEASE ENTER' MESSAGE                DTSCS26
00157 *        ELSE                                                     DTSCS26
00158 *            IF LCCM-ITEM-NO = 0                                  DTSCS26
00159 *                CLEAR; DISPLAY 'PLEASE ENTER' MESSAGE            DTSCS26
00160 *            ELSE                                                 DTSCS26
00161 *                IF LCCM-DOC-NO EXISTS ON THE ACCT TRAN FILE      DTSCS26
00162 *                    IF LCCM-DOC-NO ON ACT FILE IS AN AADJ RECORD DTSCS26
00163 *                        DISPLAY LCCM-DOC-NO RECORD FROM ACT FILE DTSCS26
00164 *                    ELSE                                         DTSCS26
00165 *                        JUMP TO TRANSACTION ENTRY SCREEN FOR     DTSCS26
00166 *                        A* RECORD TYPE                           DTSCS26
00167 *                ELSE                                             DTSCS26
00168 *                    CLEAR; DISPLAY 'NO RECORD MESSAGE.           DTSCS26
00169 *                                                                 DTSCS26
00170 *                                                                 DTSCS26
00171 *      F7, F8: DISPLAY PRIOR/NEXT A* RECORD.  BREAK ON            DTSCS26
00172 *              A*-BATCH-NO.  IF THE PRIOR/NEXT RECORD ENCOUNTERED DTSCS26
00173 *              IS NOT AN AADJ RECORD (BUT IS IN MAP-BATCH-NO),    DTSCS26
00174 *              AUTOMATICALLY JUMP TO THE APPROPRIATE SCREEN AND   DTSCS26
00175 *              DISPLAY THE RECORD.                                DTSCS26
00176 *                                                                 DTSCS26
00177 *                                                                 DTSCS26
00178 *    LCCM-CURRENT-VALUES-AREA MAINTENANCE:                        DTSCS26
00179 *                                                                 DTSCS26
00180 *      LCCM-DOC-NO MAINTENANCE.                                   DTSCS26
00181 *                                                                 DTSCS26
00182 *      LCCM-EMP-NO MAINTENANCE.                                   DTSCS26
00183 *                                                                 DTSCS26
00184 *      LCCM-ENTRY-MODE MAINTENANCE.                               DTSCS26
00185 *                                                                 DTSCS26
00186 *                                                                 DTSCS26
00187 *    UPDATE:                                                      DTSCS26
00188 *                                                                 DTSCS26
00189 *      IF THE TRANSACTION HAS BEEN "PROCESSED" (AADJ-PROCESSED    DTSCS26
00190 *       -DATE > +0, THEN THE TRANSACTION RECORD MAY NOT BE        DTSCS26
00191 *      UPDATED.                                                   DTSCS26
00192 *                                                                 DTSCS26
00193 *                                                                 DTSCS26
00194 *      ADD                                                        DTSCS26
00195 *                                                                 DTSCS26
00196 *       THE 'ENTER' KEY INDICATES THE "ADD" FUNCTION.  THE "ADD"  DTSCS26
00197 *       VERIFICATION FUNCTION IS DISABLED.                        DTSCS26
00198 *                                                                 DTSCS26
00199 *       MAP-ITEM-NO IS OPTIONAL (IF NO ENTRY, THE SYSTEM WILL     DTSCS26
00200 *       ASSIGN THE NEXT AVAIABLE ITEM NUMBER TO THE ACCOUNTING    DTSCS26
00201 *       TRANSACTION).                                             DTSCS26
00202 *                                                                 DTSCS26
00203 *                                                                 DTSCS26
00204 *      MOD                                                        DTSCS26
00205 *                                                                 DTSCS26
00206 *        CALL DTSCU372 (WITH L372-UPDATE) TO UPDATE THE BATCH     DTSCS26
00207 *        HEADER RECORD.                                           DTSCS26
00208 *                                                                 DTSCS26
00209 *                                                                 DTSCS26
00210 *      DEL                                                        DTSCS26
00211 *                                                                 DTSCS26
00212 *        CALL DTSCU373 TO DELETE THE TRANSACTION RECORD.  DTSCU373DTSCS26
00213 *        WILL UPDATE THE BATCH HEADER RECORD.                     DTSCS26
00214 *                                                                 DTSCS26
00215 *                                                                 DTSCS26
00216 *    RECORDS READ:                                                DTSCS26
00217 *                                                                 DTSCS26
00218 *      MASTER:                                                    DTSCS26
00219 *                                                                 DTSCS26
00220 *        MPRF                                                     DTSCS26
00221 *        MQTR                                                     DTSCS26
00222 *        MADJ                                                     DTSCS26
00223 *        MPAY                                                     DTSCS26
00224 *        MDST                                                     DTSCS26
00225 *                                                                 DTSCS26
00226 *                                                                 DTSCS26
00227 *      ALTERNATE INDEX:                                           DTSCS26
00228 *                                                                 DTSCS26
00229 *        NONE.                                                    DTSCS26
00230 *                                                                 DTSCS26
00231 *                                                                 DTSCS26
00232 *      REFERENCE:                                                 DTSCS26
00233 *                                                                 DTSCS26
00234 *        NONE.                                                    DTSCS26
00235 *                                                                 DTSCS26
00236 *                                                                 DTSCS26
00237 *      ACCOUNTING TRANSACTION COLLECTION:                         DTSCS26
00238 *                                                                 DTSCS26
00239 *        MADJ                                                     DTSCS26
00240 *                                                                 DTSCS26
00241 *                                                                 DTSCS26
00242 *    RECORDS UPDATED:                                             DTSCS26
00243 *                                                                 DTSCS26
00244 *      MASTER:                                                    DTSCS26
00245 *                                                                 DTSCS26
00246 *        NONE.                                                    DTSCS26
00247 *                                                                 DTSCS26
00248 *                                                                 DTSCS26
00249 *      REFERENCE:                                                 DTSCS26
00250 *                                                                 DTSCS26
00251 *        NONE.                                                    DTSCS26
00252 *                                                                 DTSCS26
00253 *                                                                 DTSCS26
00254 *      ACCOUNTING TRANSACTION COLLECTION:                         DTSCS26
00255 *                                                                 DTSCS26
00256 *        AADJ (WRITE, REWRITE)                                    DTSCS26
00257 *                                                                 DTSCS26
00258 *                                                                 DTSCS26
00259 *    ON-LINE ACTIVITY FILE RECORDS WRITTEN:                       DTSCS26
00260 *                                                                 DTSCS26
00261 *      NONE.                                                      DTSCS26
00262 *                                                                 DTSCS26
00263 *                                                                 DTSCS26
00264 *    TEMPORARY STORAGE USAGE:                                     DTSCS26
00265 *                                                                 DTSCS26
00266 *      NONE.                                                      DTSCS26
00267 *                                                                 DTSCS26
00268 *                                                                 DTSCS26
00269 *    MODULES LINKED TO:                                           DTSCS26
00270 *                                                                 DTSCS26
00271 *      DTSCU001  DATE EDIT/CONVERSION.                            DTSCS26
00272 *      DTSCU004  QUARTER EDIT/CONVERSION.                         DTSCS26
00273 *      DTSCU011  MONEY AMOUNT FROM SCREEN FORMAT/EDIT.            DTSCS26
00274 *      DTSCU015  DATE FROM SCREEN FORMAT/EDIT.                    DTSCS26
00275 *      DTSCU016  QUARTER/YEAR FROM SCREEN FORMAT/EDIT.            DTSCS26
00276 *      DTSCU018  EMP NO FROM SCREEN FORMAT/EDIT.                  DTSCS26
00277 *      DTSCU019  DOCUMENT NO FROM SCREEN FORMAT/EDIT.             DTSCS26
00278 *      DTSCU032  ACCOUNTING CODES EDIT/DESCRIPTION.               DTSCS26
00279 *      DTSCU082  OPERATOR ID EDIT/LOOK UP.                        DTSCS26
00280 *      DTSCU371  ACCOUNTING TRANSACTION FILE TRANSACTION RECORD   DTSCS26
00281 *                DELETION.                                        DTSCS26
00282 *      DTSCU372  ACCOUNTING TRANSACTION FILE BATCH HEADER         DTSCS26
00283 *                RECORD INQUIRY/UPDATE.                           DTSCS26
00284 *      DTSCU381  DETERMINE LIABILITY, DEFAULT DUE DATE, AND UI    DTSCS26
00285 *                RATE FOR A GIVEN QUARTER.                        DTSCS26
00286 *      DTSCU810  MASTER FILE INPUT/OUTPUT.                        DTSCS26
00287 *      DTSCU823  ACCOUNTING TRANSACTION FILE INPUT/OUTPUT.        DTSCS26
00288 *                                                                 DTSCS26
00289 *****                                                             DTSCS26
00290  ENVIRONMENT DIVISION.                                            DTSCS26
00291                                                                   DTSCS26
00292                                                                   DTSCS26
00293  DATA DIVISION.                                                   DTSCS26
00294                                                                   DTSCS26
00295                                                                   DTSCS26
00296  WORKING-STORAGE SECTION.                                         DTSCS26
002965 77  PAN-VALET PICTURE X(24) VALUE '010DTSCS26   11/18/24'.       DTSCS26
00297  77  PAN-VALET PICTURE X(24) VALUE '052DTSCS26   06/20/12'.       DTSCS26
00298                                                                   DTSCS26
00299  01  WRK-AREA.                                                    DTSCS26
00300      05  WRK-ABEND-CD                PIC  X(04)  VALUE 'S26 '.    DTSCS26
00301                                                                   DTSCS26
00302      05  WRK-SCR-ID.                                              DTSCS26
00303          10  WRK-SCR-ID-N            PIC  9(02)  VALUE 26.        DTSCS26
00304                                                                   DTSCS26
00305      05  WRK-F03-SCR-ID              PIC  X(02)  VALUE '20'.      DTSCS26
00306                                                                   DTSCS26
00307      05  ALL-NINES-DATE              PIC S9(09)  COMP-3           DTSCS26
00308                                             VALUE +999999999.     DTSCS26
00309                                                                   DTSCS26
00310      05  NULL-DOC-NO.                                             DTSCS26
00311          10  NULL-BATCH-NO           PIC S9(05)  COMP-3  VALUE +0.DTSCS26
00312          10  NULL-ITEM-NO            PIC S9(03)  COMP-3  VALUE +0.DTSCS26
00313                                                                   DTSCS26
00314                                                                   DTSCS26
00315      05  SCR-ACCESS-IND              PIC X(01).                   DTSCS26
00316          88  SCR-ACCESS-INQ                  VALUE '1'.           DTSCS26
00317          88  SCR-ACCESS-UPDATE               VALUE '2' '3'.       DTSCS26
00318          88  SCR-ACCESS-SUPERVISOR           VALUE '3'.           DTSCS26
00319                                                                   DTSCS26
00320      05  CURSOR-SET-IND              PIC X(01).                   DTSCS26
00321          88  CURSOR-SET-YES                  VALUE 'Y'.           DTSCS26
00322          88  CURSOR-SET-NO                   VALUE 'N'.           DTSCS26
00323          88  CURSOR-SET-GOTO                 VALUE 'G'.           DTSCS26
00324                                                                   DTSCS26
00325      05  REQ-IND                     PIC X(01).                   DTSCS26
00326          88  REQ-CURSOR-TO-GOTO              VALUE 'G'.           DTSCS26
00327          88  REQ-ERROR                       VALUE 'O'.           DTSCS26
00328          88  REQ-JUMP                        VALUE 'J'.           DTSCS26
00329          88  REQ-UPDATE                      VALUE 'U'.           DTSCS26
00330          88  REQ-INQUIRE                     VALUE 'I'.           DTSCS26
00331          88  REQ-CLEAR                       VALUE 'C'.           DTSCS26
00332          88  REQ-EDIT                        VALUE 'E'.           DTSCS26
00333                                                                   DTSCS26
00334      05  RESP-IND                    PIC X(01).                   DTSCS26
00335          88  RESP-SEND-MSGONLY               VALUE 'O'.           DTSCS26
00336          88  RESP-SEND-MAP                   VALUE 'M'.           DTSCS26
00337          88  RESP-JUMP                       VALUE 'J'.           DTSCS26
00338          88  RESP-CURSOR-TO-GOTO             VALUE 'G'.           DTSCS26
00339                                                                   DTSCS26
00340                                                                   DTSCS26
00341      05  WRK-MSG-AREA.                                            DTSCS26
00342          10  WRK-MSG-NUMBER          PIC  X(04).                  DTSCS26
00343          10  WRK-MSG-TEXT            PIC  X(60).                  DTSCS26
00344                                                                   DTSCS26
00345                                                                   DTSCS26
00346      05  WRK-EMP-NO                  PIC  9(07) COMP-3.           DTSCS26
00347                                                                   DTSCS26
00348      05  WRK-BATCH-NO                PIC  9(05) COMP-3.           DTSCS26
00349                                                                   DTSCS26
00350      05  WRK-ITEM-NO                 PIC  9(03) COMP-3.           DTSCS26
00351                                                                   DTSCS26
00352      05  WRK-ATB-AN                  PIC  X(01).                  DTSCS26
00353                                                                   DTSCS26
00354      05  WRK-ATB-NUM                 PIC  X(01).                  DTSCS26
00355                                                                   DTSCS26
00356                                                                   DTSCS26
00357      05  WRK-DISPLAY                 PIC 9(11).                   DTSCS26
00358                                                                   DTSCS26
00359      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS26
00360          10  FILLER                  PIC X(05).                   DTSCS26
00361          10  WRK-DISPLAY-YR          PIC X(02).                   DTSCS26
00362          10  WRK-DISPLAY-MO          PIC X(02).                   DTSCS26
00363          10  WRK-DISPLAY-DA          PIC X(02).                   DTSCS26
00364                                                                   DTSCS26
00365      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS26
00366          10  FILLER                  PIC X(08).                   DTSCS26
00367          10  WRK-DISPLAY-YRQ-YR      PIC X(02).                   DTSCS26
00368          10  WRK-DISPLAY-YRQ-Q       PIC X(01).                   DTSCS26
00369                                                                   DTSCS26
00370      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS26
00371          10  FILLER                  PIC X(05).                   DTSCS26
00372          10  WRK-EMP-NO-1            PIC X(03).                   DTSCS26
00373          10  WRK-EMP-NO-2            PIC X(03).                   DTSCS26
00374                                                                   DTSCS26
00375                                                                   DTSCS26
00376      05  HOLD-KEY-AREA               PIC  X(05).                  DTSCS26
00377                                                                   DTSCS26
00378      05  PAGE-TYPE-IND               PIC  X(01).                  DTSCS26
00379          88  PAGE-FIRST-88                  VALUE 'F'.            DTSCS26
00380          88  PAGE-LAST-88                   VALUE 'L'.            DTSCS26
00381                                                                   DTSCS26
00382                                                                   DTSCS26
00383      05  WRK-CREDIT-AMT              PIC S9(09)V9(02)  COMP-3.    DTSCS26
00384                                                                   DTSCS26
00385      05  WRK-CHARGED-AMT             PIC S9(09)V9(02)  COMP-3.    DTSCS26
00386                                                                   DTSCS26
00387      05  WRK-WAIVED-AMT              PIC S9(09)V9(02)  COMP-3.    DTSCS26
00388                                                                   DTSCS26
00389      05  WRK-TOLER-AMT               PIC S9(09)V9(02)  COMP-3.    DTSCS26
00390                                                                   DTSCS26
00391 *    05  WRK-AMT-REMAIN              PIC S9(09)V9(02)  COMP-3.    DTSCS26
00392                                                                   DTSCS26
00393 *    05  WRK-LARGEST-AMT             PIC S9(09)V9(02)  COMP-3.    DTSCS26
00394 *    05  WRK-LARGEST-YRQ             PIC S9(04)        COMP.      DTSCS26
00395 *    05  WRK-QTR-AMT                 PIC S9(09)V9(02)  COMP-3.    DTSCS26
00396 *    05  WRK-TOT-AMT                 PIC S9(11)V9(02)  COMP-3.    DTSCS26
00397                                                                   DTSCS26
00398 *    05  SUM-FOUR-QTRS-IND           PIC  X(01).                  DTSCS26
00399 *        88  SUM-FOUR-QTRS-YES-88  VALUE 'Y'.                     DTSCS26
00400 *        88  SUM-FOUR-QTRS-NO-88   VALUE 'N'.                     DTSCS26
00401                                                                   DTSCS26
00402      05  ADJ-FOUR-QTRS-IND           PIC  X(01).                  DTSCS26
00403          88  ADJ-FOUR-QTRS-YES-88  VALUE 'Y'.                     DTSCS26
00404          88  ADJ-FOUR-QTRS-NO-88   VALUE 'N'.                     DTSCS26
00405                                                                   DTSCS26
00406 *****05  WRK-BALANCE-AMT             PIC S9(09)V9(02)  COMP-3.    DTSCS26
00407                                                                   DTSCS26
00408      05  WRK-MQTR-EXISTS-IND         PIC  X(01).                  DTSCS26
00409                                                                   DTSCS26
00410      05  WRK-MDST-EXISTS-IND         PIC  X(01).                  DTSCS26
00411                                                                   DTSCS26
00412      05  WRK-PENDING-MCMP-IND        PIC  X(01).                  DTSCS26
00413          88  WRK-PENDING-MCMP-YES-88  VALUE 'Y'.                  DTSCS26
00414          88  WRK-PENDING-MCMP-NO-88   VALUE 'N'.                  DTSCS26
00415                                                                   DTSCS26
00416      05  WRK-YRQ-IND                 PIC  X(01).                  DTSCS26
00417          88  WRK-YRQ-OK-88            VALUE 'Y'.                  DTSCS26
00418          88  WRK-YRQ-NOT-FOUND-88     VALUE 'N'.                  DTSCS26
00419                                                                   DTSCS26
00420 *****05  WRK-ACCT-IND                PIC  X(02).                  DTSCS26
00421                                                                   DTSCS26
00422      05  ACCT-SUB                    PIC S9(04)  COMP.            DTSCS26
00423 *    05  ACCT1-SUB                   PIC S9(04)  COMP.            DTSCS26
00424 *    05  ACCT2-SUB                   PIC S9(04)  COMP.            DTSCS26
00425      05  QTR-SUB                     PIC S9(04)  COMP.            DTSCS26
00426 *    05  TOT-SUB                     PIC S9(04)  COMP             DTSCS26
00427 *                                      VALUE +5.                  DTSCS26
00428      05  WRK-AATH-ACTION             PIC  X(01).                  DTSCS26
00429          88  WRK-AATH-ACTION-ADD-88    VALUE 'A'.                 DTSCS26
00430          88  WRK-AATH-ACTION-UPD-88    VALUE 'U'.                 DTSCS26
00431          88  WRK-AATH-ACTION-DEL-88    VALUE 'D'.                 DTSCS26
00432                                                                   DTSCS26
00433      EJECT                                                        DTSCS26
00434  01  WRK-EDITED-ELEMENTS.                                         DTSCS26
00435      05  WRK-AMT                     PIC S9(09)V9(02) COMP-3.     DTSCS26
00436          88  WRK-AMT-INVALID-88        VALUE -999999999.99.       DTSCS26
00437                                                                   DTSCS26
00438      05  WRK-APPLIC-YRQ             PIC S9(05) COMP-3.            DTSCS26
00439                                                                   DTSCS26
00440      05  WRK-APPLIC-IND             PIC X(02).                    DTSCS26
00441                                                                   DTSCS26
00442      05  WRK-APPLIC-DOC-NO.                                       DTSCS26
00443          10  WRK-APPLIC-BATCH-NO    PIC S9(05) COMP-3.            DTSCS26
00444          10  WRK-APPLIC-ITEM-NO     PIC S9(03) COMP-3.            DTSCS26
00445                                                                   DTSCS26
00446      05  WRK-DATE-1                 PIC S9(09) COMP-3.            DTSCS26
00447                                                                   DTSCS26
00448      05  WRK-DATE-2                 PIC S9(09) COMP-3.            DTSCS26
00449                                                                   DTSCS26
00450      05  WRK-INT-RATE                PIC S9(01)V9(04) COMP-3.     DTSCS26
00451          88  WRK-INT-NO-ENTRY-88       VALUE -9.9999.             DTSCS26
00452                                                                   DTSCS26
00453      05  WRK-RECEIVED-DATE           PIC S9(09)       COMP-3.     DTSCS26
00454      EJECT                                                        DTSCS26
00455  01  WRK-ANN-QTR-AREA.                                            DTSCS26
00456    05  WRK-ANN-QTR-ENTRY OCCURS 4 TIMES.                          DTSCS26
00457      10  WRK-MQTR-YRQ                PIC S9(05)       COMP-3.     DTSCS26
00458      10  WRK-MQTR-BYPASS-IND         PIC  X(01).                  DTSCS26
00459          88  WRK-MQTR-BYPASS-YES-88   VALUE 'Y'.                  DTSCS26
00460          88  WRK-MQTR-BYPASS-NO-88    VALUE 'N'.                  DTSCS26
00461                                                                   DTSCS26
00462  01  MSG-LITERALS.                                                DTSCS26
00463      05  MSG-E261-AREA.                                           DTSCS26
00464          10  FILLER                  PIC  X(04)  VALUE 'E261'.    DTSCS26
00465          10  FILLER                  PIC  X(60) VALUE             DTSCS26
00466        'NEVER SUBJECT EMPLOYER NOT VALID'.                        DTSCS26
00467                                                                   DTSCS26
00468      05  MSG-E262-AREA.                                           DTSCS26
00469          10  FILLER                  PIC  X(04)  VALUE 'E262'.    DTSCS26
00470          10  FILLER                  PIC  X(60) VALUE             DTSCS26
00471        'SPECIFIED APPLIC DOCUMENT DOES NOT EXIST'.                DTSCS26
00472                                                                   DTSCS26
00473      05  MSG-E263-AREA.                                           DTSCS26
00474          10  FILLER                  PIC  X(04)  VALUE 'E263'.    DTSCS26
00475          10  FILLER                  PIC  X(60) VALUE             DTSCS26
00476        'YIELDS INVALID CHARGED AMOUNT'.                           DTSCS26
00477                                                                   DTSCS26
00478      05  MSG-E264-AREA.                                           DTSCS26
00479          10  FILLER                  PIC  X(04)  VALUE 'E264'.    DTSCS26
00480          10  FILLER                  PIC  X(60) VALUE             DTSCS26
00481        'CHARGING IS ALREADY AUTOMATIC'.                           DTSCS26
00482                                                                   DTSCS26
00483      05  MSG-E265-AREA.                                           DTSCS26
00484          10  FILLER                  PIC  X(04)  VALUE 'E265'.    DTSCS26
00485          10  FILLER                  PIC  X(60) VALUE             DTSCS26
00486        'YIELDS INVALID TOLERANCE AMOUNT'.                         DTSCS26
00487                                                                   DTSCS26
00488      05  MSG-E266-AREA.                                           DTSCS26
00489          10  FILLER                  PIC  X(04)  VALUE 'E266'.    DTSCS26
00490          10  FILLER                  PIC  X(60) VALUE             DTSCS26
00491        'CHARGING IS ALREADY MANUAL'.                              DTSCS26
00492                                                                   DTSCS26
00493      05  MSG-E267-AREA.                                           DTSCS26
00494          10  FILLER                  PIC  X(04)  VALUE 'E267'.    DTSCS26
00495          10  FILLER                  PIC  X(60) VALUE             DTSCS26
00496       'NO BALANCES DUE, PURSUED REPORTS, OR CREDITS TO WRITE OFF'.DTSCS26
00497                                                                   DTSCS26
00498      05  MSG-E268-AREA.                                           DTSCS26
00499          10  FILLER                  PIC  X(04)  VALUE 'E268'.    DTSCS26
00500          10  FILLER                  PIC  X(60) VALUE             DTSCS26
00501       'MUST BE FIRST DAY OF CALENDAR MONTH                      '.DTSCS26
00502                                                                   DTSCS26
00503      05  MSG-E269-AREA.                                           DTSCS26
00504          10  FILLER                  PIC  X(04)  VALUE 'E269'.    DTSCS26
00505          10  FILLER                  PIC  X(60) VALUE             DTSCS26
00506       'MUST BE LAST DAY OF CALENDAR MONTH                       '.DTSCS26
00507                                                                   DTSCS26
00508      05  MSG-E26A-AREA.                                           DTSCS26
00509          10  FILLER                  PIC  X(04)  VALUE 'E26A'.    DTSCS26
00510          10  FILLER                  PIC  X(60) VALUE             DTSCS26
00511       'INVALID FOR ANNUAL REPORTS                               '.DTSCS26
00512                                                                   DTSCS26
00513      05  MSG-P26D-AREA.                                           DTSCS26
00514          10  FILLER                  PIC  X(04)  VALUE 'P26D'.    DTSCS26
00515          10  FILLER                  PIC  X(60) VALUE             DTSCS26
00516       'TRANSACTION PROCESSED - MODIFY OR DELETE NOT ALLOWED'.     DTSCS26
00517                                                                   DTSCS26
00518      05  MSG-E26D-AREA.                                           DTSCS26
00519          10  FILLER                  PIC  X(04)  VALUE 'E26D'.    DTSCS26
00520          10  FILLER                  PIC  X(60) VALUE             DTSCS26
00521       'TRANSACTION PROCESSED - MODIFY OR DELETE NOT ALLOWED'.     DTSCS26
00522                                                                   DTSCS26
00523      05  MSG-E26E-AREA.                                           DTSCS26
00524          10  FILLER                  PIC  X(04)  VALUE 'E26E'.    DTSCS26
00525          10  FILLER                  PIC  X(60) VALUE             DTSCS26
00526       'ENTER Y OR N FOR COMPROMISE                         '.     DTSCS26
00527                                                                   DTSCS26
00528      05  MSG-E26F-AREA.                                           DTSCS26
00529          10  FILLER                  PIC  X(04)  VALUE 'E26F'.    DTSCS26
00530          10  FILLER                  PIC  X(60) VALUE             DTSCS26
00531       'NO PENDING COMPROMISE SETTLEMENT FOUND              '.     DTSCS26
00532                                                                   DTSCS26
00533      05  MSG-E26G-AREA.                                           DTSCS26
00534          10  FILLER                  PIC  X(04)  VALUE 'E26G'.    DTSCS26
00535          10  FILLER                  PIC  X(60) VALUE             DTSCS26
00536       'QUARTER NOT PART OF COMPROMISE SETTLEMENT           '.     DTSCS26
00537                                                                   DTSCS26
00538      05  MSG-E26H-AREA.                                           DTSCS26
00539          10  FILLER                  PIC  X(04)  VALUE 'E26H'.    DTSCS26
00540          10  FILLER                  PIC  X(60) VALUE             DTSCS26
00541       'QUARTER PART OF COMPROMISE - CHANGE NOT ALLOWED     '.     DTSCS26
00542      EJECT                                                        DTSCS26
00543  01  L001-COMM-AREA.                                              DTSCS26
00544  ++INCLUDE DTSIL001                                               DTSCS26
00545      EJECT                                                        DTSCS26
00546  01  L004-COMM-AREA.                                              DTSCS26
00547  ++INCLUDE DTSIL004                                               DTSCS26
00548      EJECT                                                        DTSCS26
00549  01  L011-COMM-AREA.                                              DTSCS26
00550  ++INCLUDE DTSIL011                                               DTSCS26
00551      EJECT                                                        DTSCS26
00552  01  L012-COMM-AREA.                                              DTSCS26
00553  ++INCLUDE DTSIL012                                               DTSCS26
00554      EJECT                                                        DTSCS26
00555  01  L015-COMM-AREA.                                              DTSCS26
00556  ++INCLUDE DTSIL015                                               DTSCS26
00557      EJECT                                                        DTSCS26
00558  01  L029-COMM-AREA.                                              DTSCS26
00559  ++INCLUDE DTSIL029                                               DTSCS26
00560      EJECT                                                        DTSCS26
00561  01  L018-COMM-AREA.                                              DTSCS26
00562  ++INCLUDE DTSIL018                                               DTSCS26
00563      EJECT                                                        DTSCS26
00564  01  L019-COMM-AREA.                                              DTSCS26
00565  ++INCLUDE DTSIL019                                               DTSCS26
00566      EJECT                                                        DTSCS26
00567  01  L032-COMM-AREA.                                              DTSCS26
00568  ++INCLUDE DTSIL032                                               DTSCS26
00569      EJECT                                                        DTSCS26
00570  01  L056-COMM-AREA.                                              DTSCS26
00571  ++INCLUDE DTSIL056                                               DTSCS26
00572      EJECT                                                        DTSCS26
00573  01  L084-COMM-AREA.                                                 CL**3
00574  ++INCLUDE DTSIL084                                                  CL**3
00575      EJECT                                                           CL**3
00576  01  L082-COMM-AREA.                                              DTSCS26
00577  ++INCLUDE DTSIL082                                               DTSCS26
00578      EJECT                                                        DTSCS26
00579  01  L221-COMM-AREA.                                              DTSCS26
00580  ++INCLUDE DTSIL221                                               DTSCS26
00581      EJECT                                                        DTSCS26
00582  01  L371-COMM-AREA.                                              DTSCS26
00583  ++INCLUDE DTSIL371                                               DTSCS26
00584      EJECT                                                        DTSCS26
00585  01  L372-COMM-AREA.                                              DTSCS26
00586  ++INCLUDE DTSIL372                                               DTSCS26
00587      EJECT                                                        DTSCS26
00588  01  L381-COMM-AREA.                                              DTSCS26
00589  ++INCLUDE DTSIL381                                               DTSCS26
00590      EJECT                                                        DTSCS26
00591  01  L410-COMM-AREA.                                              DTSCS26
00592  ++INCLUDE DTSIL410                                               DTSCS26
00593      EJECT                                                        DTSCS26
00594  01  L805-COMM-AREA.                                              DTSCS26
00595  ++INCLUDE DTSIL805                                               DTSCS26
00596      EJECT                                                        DTSCS26
00597  01  L810-COMM-AREA.                                              DTSCS26
00598      05  L810-CONTROL-BLOCK.                                      DTSCS26
00599  ++INCLUDE DTSIL810                                               DTSCS26
00600      EJECT                                                        DTSCS26
00601      05  MSKL-REC.                                                DTSCS26
00602  ++INCLUDE DTSIMSKL                                               DTSCS26
00603      EJECT                                                        DTSCS26
00604  01  MPRF-REC.                                                    DTSCS26
00605  ++INCLUDE DTSIMPRF                                               DTSCS26
00606      EJECT                                                        DTSCS26
00607  01  MQTR-REC.                                                    DTSCS26
00608  ++INCLUDE DTSIMQTR                                               DTSCS26
00609      EJECT                                                        DTSCS26
00610  01  MADJ-REC.                                                    DTSCS26
00611  ++INCLUDE DTSIMADJ                                               DTSCS26
00612      EJECT                                                        DTSCS26
00613  01  MDST-REC.                                                    DTSCS26
00614  ++INCLUDE DTSIMDST                                               DTSCS26
00615      EJECT                                                        DTSCS26
00616  01  MCMP-REC.                                                    DTSCS26
00617  ++INCLUDE DTSIMCMP                                               DTSCS26
00618      EJECT                                                        DTSCS26
00619  01  L823-COMM-AREA.                                              DTSCS26
00620      05  L823-CONTROL-BLOCK.                                      DTSCS26
00621  ++INCLUDE DTSIL823                                               DTSCS26
00622      EJECT                                                        DTSCS26
00623      05  ASKL-REC.                                                DTSCS26
00624  ++INCLUDE DTSIASKL                                               DTSCS26
00625      EJECT                                                        DTSCS26
00626  01  AADJ-REC.                                                    DTSCS26
00627  ++INCLUDE DTSIAADJ                                               DTSCS26
00628      EJECT                                                        DTSCS26
00629  01  L826-COMM-AREA.                                              DTSCS26
00630      05  L826-CONTROL-BLOCK.                                      DTSCS26
00631  ++INCLUDE DTSIL826                                               DTSCS26
00632                                                                   DTSCS26
00633      05  AATH-REC.                                                DTSCS26
00634  ++INCLUDE DTSIAATH                                               DTSCS26
00635                                                                   DTSCS26
00636  01  L851-COMM-AREA.                                              DTSCS26
00637  ++INCLUDE DTSIL851                                               DTSCS26
00638                                                                   DTSCS26
00639      05  MAP-AREA REDEFINES L851-MAP-AREA.                        DTSCS26
00640  ++INCLUDE DTSIS26                                                DTSCS26
00641      EJECT                                                        DTSCS26
00642  01  CATB-LITERALS.                                               DTSCS26
00643  ++INCLUDE DTSICATB                                               DTSCS26
00644                                                                   DTSCS26
00645                                                                   DTSCS26
00646                                                                   DTSCS26
00647  01  CFKD-LITERALS.                                               DTSCS26
00648  ++INCLUDE DTSICFKD                                               DTSCS26
00649                                                                   DTSCS26
00650                                                                   DTSCS26
00651                                                                   DTSCS26
00652  01  CECD-LITERALS.                                               DTSCS26
00653  ++INCLUDE DTSICECD                                               DTSCS26
00654                                                                   DTSCS26
00655                                                                   DTSCS26
00656                                                                   DTSCS26
00657  01  CPCD-LITERALS.                                               DTSCS26
00658  ++INCLUDE DTSICPCD                                               DTSCS26
00659      EJECT                                                        DTSCS26
00660  LINKAGE SECTION.                                                 DTSCS26
00661                                                                   DTSCS26
00662  01  DFHCOMMAREA.                                                 DTSCS26
00663  ++INCLUDE DTSILCCM                                               DTSCS26
00664      EJECT                                                        DTSCS26
00665 ******************************************************************DTSCS26
00666 *                                                                *DTSCS26
00667 ******************************************************************DTSCS26
00668                                                                   DTSCS26
00669  PROCEDURE DIVISION.                                              DTSCS26
00670                                                                   DTSCS26
00671      MOVE +0 TO WRK-EMP-NO                                        DTSCS26
00672                 WRK-BATCH-NO                                      DTSCS26
00673                 WRK-ITEM-NO.                                      DTSCS26
00674                                                                   DTSCS26
00675      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS26
00676                                                                   DTSCS26
00677      SET CURSOR-SET-NO TO TRUE.                                   DTSCS26
00678                                                                   DTSCS26
00679                                                                   DTSCS26
00680      MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N)                  DTSCS26
00681        TO SCR-ACCESS-IND.                                         DTSCS26
00682                                                                   DTSCS26
00683                                                                   DTSCS26
00684      MOVE SPACE TO REQ-IND.                                       DTSCS26
00685                                                                   DTSCS26
00686      PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT.               DTSCS26
00687                                                                   DTSCS26
00688                                                                   DTSCS26
00689 *-----------------------------------------------------            DTSCS26
00690 *    P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE           DTSCS26
00691 *    "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT             DTSCS26
00692 *    REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE             DTSCS26
00693 *    OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED.         DTSCS26
00694 *                                                                 DTSCS26
00695 *    THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE                DTSCS26
00696 *    PROCESSED.                                                   DTSCS26
00697 *                                                                 DTSCS26
00698 *    THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND,         DTSCS26
00699 *    INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE            DTSCS26
00700 *    WORK STATION OPERATOR.                                       DTSCS26
00701 *-----------------------------------------------------            DTSCS26
00702                                                                   DTSCS26
00703      MOVE SPACE TO RESP-IND.                                      DTSCS26
00704                                                                   DTSCS26
00705      IF REQ-ERROR                                                 DTSCS26
00706         PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT               DTSCS26
00707      ELSE                                                         DTSCS26
00708      IF REQ-JUMP                                                  DTSCS26
00709         PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT                DTSCS26
00710      ELSE                                                         DTSCS26
00711      IF REQ-CLEAR                                                 DTSCS26
00712         PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT               DTSCS26
00713      ELSE                                                         DTSCS26
00714      IF REQ-CURSOR-TO-GOTO                                        DTSCS26
00715         PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT              DTSCS26
00716      ELSE                                                         DTSCS26
00717      IF REQ-INQUIRE                                               DTSCS26
00718         PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT             DTSCS26
00719      ELSE                                                         DTSCS26
00720      IF REQ-EDIT                                                  DTSCS26
00721         PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT                DTSCS26
00722      ELSE                                                         DTSCS26
00723      IF REQ-UPDATE                                                DTSCS26
00724         PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT              DTSCS26
00725      ELSE                                                         DTSCS26
00726         GO TO S899-ABEND.                                         DTSCS26
00727                                                                   DTSCS26
00728                                                                   DTSCS26
00729 *-----------------------------------------------------            DTSCS26
00730 *    THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED             DTSCS26
00731 *    IN RESP-IND THE TYPE OF RESPONSE TO BE MADE.                 DTSCS26
00732 *-----------------------------------------------------            DTSCS26
00733                                                                   DTSCS26
00734      IF RESP-SEND-MAP                                             DTSCS26
00735          PERFORM S9300-SEND-MAP THRU S9300-EXIT                   DTSCS26
00736          SET LCCM-END-TASK-88 TO TRUE                             DTSCS26
00737      ELSE                                                         DTSCS26
00738      IF RESP-SEND-MSGONLY                                         DTSCS26
00739          PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT              DTSCS26
00740          SET LCCM-END-TASK-88 TO TRUE                             DTSCS26
00741      ELSE                                                         DTSCS26
00742      IF RESP-JUMP                                                 DTSCS26
00743          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS26
00744      ELSE                                                         DTSCS26
00745      IF RESP-CURSOR-TO-GOTO                                       DTSCS26
00746          PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT              DTSCS26
00747          SET LCCM-END-TASK-88 TO TRUE                             DTSCS26
00748      ELSE                                                         DTSCS26
00749          GO TO S899-ABEND.                                        DTSCS26
00750                                                                   DTSCS26
00751                                                                   DTSCS26
00752  MAINLINE-EXIT.                                                   DTSCS26
00753                                                                   DTSCS26
00754      EXEC CICS                                                    DTSCS26
00755          RETURN                                                   DTSCS26
00756      END-EXEC.                                                    DTSCS26
00757                                                                   DTSCS26
00758                                                                   DTSCS26
00759      GOBACK.                                                      DTSCS26
00760 /*****************************************************************DTSCS26
00761 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION         *DTSCS26
00762 ******************************************************************DTSCS26
00763  P1000-ANALYZE-REQUEST.                                           DTSCS26
00764                                                                   DTSCS26
00765 *-----------------------------------------------------            DTSCS26
00766 *     IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE)         DTSCS26
00767 *     THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE               DTSCS26
00768 *     REPLACED WITH F09)                                          DTSCS26
00769 *-----------------------------------------------------            DTSCS26
00770                                                                   DTSCS26
00771      IF LCCM-SCR-ID NOT = WRK-SCR-ID                              DTSCS26
00772          PERFORM P1200-JUMP-IN THRU P1200-EXIT                    DTSCS26
00773          GO TO P1000-EXIT.                                        DTSCS26
00774                                                                   DTSCS26
00775                                                                   DTSCS26
00776 *-----------------------------------------------------            DTSCS26
00777 *      RECEIVE THE MAP                                            DTSCS26
00778 *-----------------------------------------------------            DTSCS26
00779                                                                   DTSCS26
00780      PERFORM S9100-RECEIVE THRU S9100-EXIT.                       DTSCS26
00781                                                                   DTSCS26
00782                                                                   DTSCS26
00783 *-----------------------------------------------------            DTSCS26
00784 *    CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE            DTSCS26
00785 *    WORK STATION                                                 DTSCS26
00786 *-----------------------------------------------------            DTSCS26
00787                                                                   DTSCS26
00788      IF LCCM-CLEAR-88                                             DTSCS26
00789         SET REQ-CLEAR TO TRUE                                     DTSCS26
00790         GO TO P1000-EXIT.                                         DTSCS26
00791                                                                   DTSCS26
00792                                                                   DTSCS26
00793 *-----------------------------------------------------            DTSCS26
00794 *    IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED             DTSCS26
00795 *-----------------------------------------------------            DTSCS26
00796                                                                   DTSCS26
00797      IF LCCM-SCR-UPDATE-LOCKED                                    DTSCS26
00798         PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT               DTSCS26
00799         GO TO P1000-EXIT.                                         DTSCS26
00800                                                                   DTSCS26
00801                                                                   DTSCS26
00802 *-----------------------------------------------------            DTSCS26
00803 *    PA2 IS A REQUEST TO POSITION CURSOR AT GO TO:                DTSCS26
00804 *-----------------------------------------------------            DTSCS26
00805                                                                   DTSCS26
00806      IF LCCM-PA2-88                                               DTSCS26
00807          SET REQ-CURSOR-TO-GOTO TO TRUE                           DTSCS26
00808          GO TO P1000-EXIT.                                        DTSCS26
00809                                                                   DTSCS26
00810                                                                   DTSCS26
00811 *-----------------------------------------------------            DTSCS26
00812 *    ALL OTHER PA KEYS ARE NOT ACTIVE                             DTSCS26
00813 *-----------------------------------------------------            DTSCS26
00814                                                                   DTSCS26
00815      IF LCCM-PA-88                                                DTSCS26
00816        PERFORM S804-INVALID-KEY THRU S804-EXIT                    DTSCS26
00817        SET REQ-ERROR TO TRUE                                      DTSCS26
00818        GO TO P1000-EXIT.                                          DTSCS26
00819                                                                   DTSCS26
00820                                                                   DTSCS26
00821 *-----------------------------------------------------            DTSCS26
00822 *    F12 PRESSED WHEN UPDATE NOT IN PROGRESS IS A                 DTSCS26
00823 *    REQUEST TO CLEAR THE SCREEN.                                 DTSCS26
00824 *-----------------------------------------------------            DTSCS26
00825                                                                   DTSCS26
00826      IF LCCM-F12-88                                               DTSCS26
00827        MOVE LOW-VALUES TO MAP-AREA                                DTSCS26
00828        SET REQ-CLEAR TO TRUE                                      DTSCS26
00829        GO TO P1000-EXIT.                                          DTSCS26
00830                                                                   DTSCS26
00831                                                                   DTSCS26
00832 *-----------------------------------------------------            DTSCS26
00833 *    IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION            DTSCS26
00834 *-----------------------------------------------------            DTSCS26
00835                                                                   DTSCS26
00836      IF LCCM-F03-88                                               DTSCS26
00837         MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID                    DTSCS26
00838         SET REQ-JUMP TO TRUE                                      DTSCS26
00839         GO TO P1000-EXIT.                                         DTSCS26
00840                                                                   DTSCS26
00841                                                                   DTSCS26
00842 *-----------------------------------------------------            DTSCS26
00843 *    IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN         DTSCS26
00844 *-----------------------------------------------------            DTSCS26
00845                                                                   DTSCS26
00846      IF LCCM-F04-88                                               DTSCS26
00847         MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID                 DTSCS26
00848         SET REQ-JUMP TO TRUE                                      DTSCS26
00849         GO TO P1000-EXIT.                                         DTSCS26
00850                                                                   DTSCS26
00851                                                                   DTSCS26
00852 *---------------------------------------------------------        DTSCS26
00853 *    IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO                DTSCS26
00854 *    CORRESPONDENCE SCREEN.                                       DTSCS26
00855 *---------------------------------------------------------        DTSCS26
00856                                                                   DTSCS26
00857      IF LCCM-F14-88                                               DTSCS26
00858         MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID                  DTSCS26
00859         SET REQ-JUMP TO TRUE                                      DTSCS26
00860         GO TO P1000-EXIT.                                         DTSCS26
00861                                                                   DTSCS26
00862                                                                   DTSCS26
00863 *-----------------------------------------------------            DTSCS26
00864 *    IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO               DTSCS26
00865 *    REQUESTED SCREEN TYPE                                        DTSCS26
00866 *-----------------------------------------------------            DTSCS26
00867                                                                   DTSCS26
00868      IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID             DTSCS26
00869         NEXT SENTENCE                                             DTSCS26
00870      ELSE                                                         DTSCS26
00871        MOVE MAP-GOTO TO LCCM-REQ-SCR-ID                           DTSCS26
00872        SET REQ-JUMP TO TRUE                                       DTSCS26
00873        GO TO P1000-EXIT.                                          DTSCS26
00874                                                                   DTSCS26
00875                                                                   DTSCS26
00876 *-----------------------------------------------------            DTSCS26
00877 *    IF REQUEST TO UPDATE THE DATA (ADD,MOD,DEL)                  DTSCS26
00878 *          VERIFY USER ACCESS TO PERFORM UPDATE                   DTSCS26
00879 *-----------------------------------------------------            DTSCS26
00880                                                                   DTSCS26
00881      IF LCCM-ENTER-88                                             DTSCS26
00882          IF SCR-ACCESS-UPDATE                                     DTSCS26
00883              SET REQ-UPDATE TO TRUE                               DTSCS26
00884              GO TO P1000-EXIT                                     DTSCS26
00885          ELSE                                                     DTSCS26
00886              PERFORM S804-INVALID-KEY THRU S804-EXIT              DTSCS26
00887              SET REQ-ERROR TO TRUE                                DTSCS26
00888              GO TO P1000-EXIT.                                    DTSCS26
00889                                                                   DTSCS26
00890                                                                   DTSCS26
00891      IF LCCM-F10-88                                               DTSCS26
00892           OR LCCM-F23-88                                          DTSCS26
00893         IF SCR-ACCESS-UPDATE                                      DTSCS26
00894            SET REQ-EDIT TO TRUE                                   DTSCS26
00895            GO TO P1000-EXIT                                       DTSCS26
00896         ELSE                                                      DTSCS26
00897            PERFORM S804-INVALID-KEY THRU S804-EXIT                DTSCS26
00898            SET REQ-ERROR TO TRUE                                  DTSCS26
00899            GO TO P1000-EXIT.                                      DTSCS26
00900                                                                   DTSCS26
00901                                                                   DTSCS26
00902 *-----------------------------------------------------            DTSCS26
00903 *    IF INQUIRY TYPE KEY PRESSED (F9, F7, OR F8),                 DTSCS26
00904 *        INDICATES INQUIRY REQUEST                                DTSCS26
00905 *-----------------------------------------------------            DTSCS26
00906                                                                   DTSCS26
00907      IF LCCM-F09-88                                               DTSCS26
00908      OR LCCM-F07-88                                               DTSCS26
00909      OR LCCM-F08-88                                               DTSCS26
00910          SET REQ-INQUIRE TO TRUE                                  DTSCS26
00911          GO TO P1000-EXIT.                                        DTSCS26
00912                                                                   DTSCS26
00913                                                                   DTSCS26
00914 *-----------------------------------------------------            DTSCS26
00915 *     ANY OTHER KEY IS INVALID                                    DTSCS26
00916 *-----------------------------------------------------            DTSCS26
00917                                                                   DTSCS26
00918      PERFORM S804-INVALID-KEY THRU S804-EXIT.                     DTSCS26
00919                                                                   DTSCS26
00920      SET REQ-ERROR TO TRUE.                                       DTSCS26
00921  P1000-EXIT.                                                      DTSCS26
00922      EXIT.                                                        DTSCS26
00923      EJECT                                                        DTSCS26
00924 ******************************************************************DTSCS26
00925 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS26
00926 ******************************************************************DTSCS26
00927                                                                   DTSCS26
00928  P1100-UPDATE-LOCKED.                                             DTSCS26
00929                                                                   DTSCS26
00930 *-----------------------------------------------------            DTSCS26
00931 *    IF THE SCREEN IS "LOCKED FOR UPDATE", THEN                   DTSCS26
00932 *    THE ONLY VALID OPERATOR REQUESTS ARE ENTER                   DTSCS26
00933 *    (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE).              DTSCS26
00934 *-----------------------------------------------------            DTSCS26
00935                                                                   DTSCS26
00936      IF LCCM-ENTER-88 OR LCCM-F12-88                              DTSCS26
00937         SET REQ-UPDATE TO TRUE                                    DTSCS26
00938      ELSE                                                         DTSCS26
00939         SET REQ-ERROR TO TRUE                                     DTSCS26
00940 ********IF LCCM-SCR-ADD-LOCKED                                    DTSCS26
00941 ********   MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID                   DTSCS26
00942 ********ELSE                                                      DTSCS26
00943         IF LCCM-SCR-MOD-LOCKED                                    DTSCS26
00944            MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID                   DTSCS26
00945         ELSE                                                      DTSCS26
00946            IF LCCM-SCR-DEL-LOCKED                                 DTSCS26
00947               MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID                DTSCS26
00948            ELSE                                                   DTSCS26
00949               GO TO S899-ABEND.                                   DTSCS26
00950  P1100-EXIT.                                                      DTSCS26
00951      EXIT.                                                        DTSCS26
00952      SKIP3                                                        DTSCS26
00953 *-----------------------------------------------------            DTSCS26
00954 *    IF A DOCUMENT IS INDICATED BY LCCM-BATCH-NO AND              DTSCS26
00955 *    LCCM-ITEM-NO AND THE DOCUMENT EXISTS AND THE                 DTSCS26
00956 *    DOCUMENT IS AN AADJ RECORD, THEN ASSUME WE ARE TO            DTSCS26
00957 *    INQUIRE LCCM-BATCH-NO+LCCM-ITEM-NO;                          DTSCS26
00958 *                                                                 DTSCS26
00959 *    OTHERWISE, ASSUME WE ARE TO SET THE SCREEN TO A              DTSCS26
00960 *    DATA ENTRY MODE (SET SCREEN TO CLEAR).                       DTSCS26
00961 *-----------------------------------------------------            DTSCS26
00962                                                                   DTSCS26
00963  P1200-JUMP-IN.                                                   DTSCS26
00964      MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA.                       DTSCS26
00965                                                                   DTSCS26
00966      SET LCCM-F09-88 TO TRUE.                                     DTSCS26
00967                                                                   DTSCS26
00968      IF LCCM-BATCH-NO = +0                                        DTSCS26
00969          SET REQ-CLEAR TO TRUE                                    DTSCS26
00970          GO TO P1200-EXIT.                                        DTSCS26
00971                                                                   DTSCS26
00972      IF LCCM-ITEM-NO = +0                                         DTSCS26
00973          SET REQ-CLEAR TO TRUE                                    DTSCS26
00974          GO TO P1200-EXIT.                                        DTSCS26
00975                                                                   DTSCS26
00976                                                                   DTSCS26
00977      MOVE LOW-VALUES TO ASKL-KEY-AREA.                            DTSCS26
00978                                                                   DTSCS26
00979      MOVE LCCM-BATCH-NO TO ASKL-BATCH-NO.                         DTSCS26
00980                                                                   DTSCS26
00981      MOVE LCCM-ITEM-NO TO ASKL-ITEM-NO.                           DTSCS26
00982                                                                   DTSCS26
00983      PERFORM S823-READ THRU S823-EXIT.                            DTSCS26
00984                                                                   DTSCS26
00985      IF L823-NO-REC-88                                            DTSCS26
00986          SET REQ-CLEAR TO TRUE                                    DTSCS26
00987      ELSE                                                         DTSCS26
00988      IF ASKL-ADJ-88                                               DTSCS26
00989          SET REQ-INQUIRE TO TRUE                                  DTSCS26
00990          MOVE LCCM-BATCH-NO TO MAP-BATCH-NO-N                     DTSCS26
00991          MOVE LCCM-ITEM-NO TO MAP-ITEM-NO-N                       DTSCS26
00992      ELSE                                                         DTSCS26
00993          SET REQ-CLEAR TO TRUE.                                   DTSCS26
00994  P1200-EXIT.                                                      DTSCS26
00995      EXIT.                                                        DTSCS26
00996 /*****************************************************************DTSCS26
00997 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS26
00998 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN.                      *DTSCS26
00999 ******************************************************************DTSCS26
01000                                                                   DTSCS26
01001  P2000-REQUEST-ERROR.                                             DTSCS26
01002      IF LCCM-MSG                                                  DTSCS26
01003         SET RESP-SEND-MSGONLY TO TRUE                             DTSCS26
01004      ELSE                                                         DTSCS26
01005         GO TO S899-ABEND.                                         DTSCS26
01006  P2000-EXIT.                                                      DTSCS26
01007      EXIT.                                                        DTSCS26
01008 /*****************************************************************DTSCS26
01009 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED                  *DTSCS26
01010 ******************************************************************DTSCS26
01011                                                                   DTSCS26
01012  P3000-REQUEST-JUMP.                                              DTSCS26
01013                                                                   DTSCS26
01014 *-----------------------------------------------------            DTSCS26
01015 *    VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE    DTSCS26
01016 *    BY USER                                                      DTSCS26
01017 *-----------------------------------------------------            DTSCS26
01018                                                                   DTSCS26
01019      PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT.                 DTSCS26
01020                                                                   DTSCS26
01021                                                                   DTSCS26
01022 *-----------------------------------------------------            DTSCS26
01023 *    VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED               DTSCS26
01024 *-----------------------------------------------------            DTSCS26
01025                                                                   DTSCS26
01026      IF LCCM-MSG                                                  DTSCS26
01027         SET RESP-SEND-MSGONLY TO TRUE                             DTSCS26
01028         SET CURSOR-SET-GOTO TO TRUE                               DTSCS26
01029         GO TO P3000-EXIT.                                         DTSCS26
01030                                                                   DTSCS26
01031                                                                   DTSCS26
01032      MOVE MAP-DOC-NO-AREA TO L019-S-DOC-NO.                       DTSCS26
01033                                                                   DTSCS26
01034      PERFORM S019-BATCH-NO-FROM-SCREEN THRU S019-EXIT.            DTSCS26
01035                                                                   DTSCS26
01036      IF L019-VALID                                                DTSCS26
01037          MOVE L019-DOC-NO TO LCCM-DOC-NO.                         DTSCS26
01038                                                                   DTSCS26
01039                                                                   DTSCS26
01040      MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA.                  DTSCS26
01041                                                                   DTSCS26
01042      PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT.              DTSCS26
01043                                                                   DTSCS26
01044      IF L018-VALID                                                DTSCS26
01045          MOVE L018-EMP-NO TO LCCM-EMP-NO                          DTSCS26
01046          MOVE MAP-APPLIC-YRQ-AREA TO L029-S-YRQ-AREA              DTSCS26
01047          PERFORM S029-YRQ-FROM-SCREEN THRU S029-EXIT              DTSCS26
01048          IF L029-VALID                                            DTSCS26
01049              MOVE L029-YRQ TO LCCM-YRQ                            DTSCS26
01050          ELSE                                                     DTSCS26
01051              MOVE +0 TO LCCM-YRQ.                                 DTSCS26
01052                                                                   DTSCS26
01053                                                                   DTSCS26
01054 *-----------------------------------------------------            DTSCS26
01055 *    CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING      DTSCS26
01056 *-----------------------------------------------------            DTSCS26
01057                                                                   DTSCS26
01058      MOVE LOW-VALUES TO LCCM-SCR-STATUS                           DTSCS26
01059                         LCCM-SCR-HOLD-AREA.                       DTSCS26
01060                                                                   DTSCS26
01061      MOVE +0 TO LCCM-SCR-ABSTIME.                                 DTSCS26
01062                                                                   DTSCS26
01063      SET RESP-JUMP TO TRUE.                                       DTSCS26
01064  P3000-EXIT.                                                      DTSCS26
01065      EXIT.                                                        DTSCS26
01066 /*****************************************************************DTSCS26
01067 * CLEAR KEY WAS PRESSED                                          *DTSCS26
01068 ******************************************************************DTSCS26
01069                                                                   DTSCS26
01070  P4000-REQUEST-CLEAR.                                             DTSCS26
01071                                                                   DTSCS26
01072 *-----------------------------------------------------            DTSCS26
01073 *   CLEAN UP INDICATORS AND PAGING STORAGE.  RESET KEY            DTSCS26
01074 *   FIELDS FROM EARLIER REQUESTS                                  DTSCS26
01075 *-----------------------------------------------------            DTSCS26
01076                                                                   DTSCS26
01077      IF LCCM-BATCH-NO > ZERO                                      DTSCS26
01078          MOVE LCCM-BATCH-NO TO MAP-BATCH-NO.                      DTSCS26
01079                                                                   DTSCS26
01080      MOVE +0   TO LCCM-BATCH-NO.                                  DTSCS26
01081                                                                   DTSCS26
01082      MOVE +0   TO LCCM-ITEM-NO.                                   DTSCS26
01083                                                                   DTSCS26
01084                                                                   DTSCS26
01085 *****IF (LCCM-SCR-ID = '23')                                      DTSCS26
01086 ***********AND                                                    DTSCS26
01087 ********(LCCM-EMP-NO > +0)                                        DTSCS26
01088 *********PERFORM P4100-EMP-NO THRU P4100-EXIT.                    DTSCS26
01089                                                                   DTSCS26
01090 *****MOVE LCCM-ENTRY-MODE TO MAP-ENTRY-MODE.                      DTSCS26
01091                                                                   DTSCS26
01092 *****IF MAP-ENTRY-MODE-2                                          DTSCS26
01093 *********PERFORM P4200-ENTRY-MODE-2 THRU P4200-EXIT.              DTSCS26
01094                                                                   DTSCS26
01095      IF SCR-ACCESS-UPDATE AND CURSOR-SET-NO                       DTSCS26
01096          MOVE CATB-CURSOR TO MAP-ADJ-TYPE-L                       DTSCS26
01097          SET CURSOR-SET-YES TO TRUE.                              DTSCS26
01098                                                                   DTSCS26
01099      MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS26
01100                                                                   DTSCS26
01101      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS26
01102                                                                   DTSCS26
01103      IF SCR-ACCESS-UPDATE                                         DTSCS26
01104          PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT           DTSCS26
01105      ELSE                                                         DTSCS26
01106          PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT.             DTSCS26
01107                                                                   DTSCS26
01108      MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA.                       DTSCS26
01109                                                                   DTSCS26
01110      SET RESP-SEND-MAP TO TRUE.                                   DTSCS26
01111  P4000-EXIT.                                                      DTSCS26
01112      EXIT.                                                        DTSCS26
01113      SKIP3                                                        DTSCS26
01114 *P4100-EMP-NO.                                                    DTSCS26
01115 *****MOVE LOW-VALUES TO MPRF-KEY-AREA.                            DTSCS26
01116 *****MOVE LCCM-EMP-NO TO MPRF-EMP-NO.                             DTSCS26
01117 *****SET MPRF-PRF-88 TO TRUE.                                     DTSCS26
01118 *****MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS26
01119 *****PERFORM S810-READ THRU S810-EXIT.                            DTSCS26
01120 *****IF L810-OK-88                                                DTSCS26
01121 *********MOVE MSKL-REC TO MPRF-REC                                DTSCS26
01122 *********MOVE LCCM-EMP-NO TO WRK-DISPLAY                          DTSCS26
01123 *********MOVE WRK-EMP-NO-1 TO MAP-EMP-NO-1                        DTSCS26
01124 *********MOVE WRK-EMP-NO-2 TO MAP-EMP-NO-2                        DTSCS26
01125 *********MOVE MPRF-BUSINESS-NAME (1:4) TO MAP-NAME-CHECK.         DTSCS26
01126 *P4100-EXIT.                                                      DTSCS26
01127 *****EXIT.                                                        DTSCS26
01128                                                                   DTSCS26
01129                                                                   DTSCS26
01130                                                                   DTSCS26
01131 *P4200-ENTRY-MODE-2.                                              DTSCS26
01132 *P4200-EXIT.                                                      DTSCS26
01133 *****EXIT.                                                        DTSCS26
01134 /*****************************************************************DTSCS26
01135 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED                   *DTSCS26
01136 ******************************************************************DTSCS26
01137                                                                   DTSCS26
01138  P5000-CURSOR-TO-GOTO.                                            DTSCS26
01139      SET CURSOR-SET-GOTO TO TRUE.                                 DTSCS26
01140                                                                   DTSCS26
01141      SET RESP-CURSOR-TO-GOTO TO TRUE.                             DTSCS26
01142  P5000-EXIT.                                                      DTSCS26
01143      EXIT.                                                        DTSCS26
01144 /*****************************************************************DTSCS26
01145 * INQUIRY WAS REQUESTED                                          *DTSCS26
01146 ******************************************************************DTSCS26
01147                                                                   DTSCS26
01148  P6000-REQUEST-INQUIRE.                                           DTSCS26
01149      MOVE MAP-DOC-NO-AREA TO L019-S-DOC-NO.                       DTSCS26
01150                                                                   DTSCS26
01151      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS26
01152                                                                   DTSCS26
01153      MOVE L019-S-DOC-NO TO MAP-DOC-NO-AREA.                       DTSCS26
01154                                                                   DTSCS26
01155                                                                   DTSCS26
01156      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS26
01157                                                                   DTSCS26
01158      MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS26
01159                                                                   DTSCS26
01160      SET RESP-SEND-MAP TO TRUE.                                   DTSCS26
01161                                                                   DTSCS26
01162      IF SCR-ACCESS-UPDATE                                         DTSCS26
01163         PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT            DTSCS26
01164      ELSE                                                         DTSCS26
01165         PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT.              DTSCS26
01166                                                                   DTSCS26
01167      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS26
01168                                                                   DTSCS26
01169      IF LCCM-MSG                                                  DTSCS26
01170          GO TO P6000-EXIT.                                        DTSCS26
01171                                                                   DTSCS26
01172      IF WRK-BATCH-NO = LCCM-BATCH-NO                              DTSCS26
01173          NEXT SENTENCE                                            DTSCS26
01174      ELSE                                                         DTSCS26
01175          MOVE WRK-BATCH-NO TO LCCM-BATCH-NO                       DTSCS26
01176          MOVE +0 TO LCCM-ITEM-NO.                                 DTSCS26
01177                                                                   DTSCS26
01178      IF WRK-ITEM-NO = +0                                          DTSCS26
01179          MOVE LCCM-ITEM-NO TO WRK-ITEM-NO.                        DTSCS26
01180                                                                   DTSCS26
01181      PERFORM P6100-LOCATE-REC THRU P6100-EXIT.                    DTSCS26
01182                                                                   DTSCS26
01183      IF LCCM-MSG                                                  DTSCS26
01184          GO TO P6000-EXIT.                                        DTSCS26
01185                                                                   DTSCS26
01186      MOVE ASKL-ITEM-NO TO LCCM-ITEM-NO.                           DTSCS26
01187                                                                   DTSCS26
01188      IF REQ-JUMP                                                  DTSCS26
01189          MOVE LCCM-ITEM-NO TO MAP-ITEM-NO-N                       DTSCS26
01190          PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT               DTSCS26
01191          GO TO P6000-EXIT.                                        DTSCS26
01192                                                                   DTSCS26
01193      PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT               DTSCS26
01194                                                                   DTSCS26
01195      SET LCCM-SCR-INQUIRE TO TRUE.                                DTSCS26
01196  P6000-EXIT.                                                      DTSCS26
01197      EXIT.                                                        DTSCS26
01198      EJECT                                                        DTSCS26
01199  P6100-LOCATE-REC.                                                DTSCS26
01200      PERFORM P6110-START-REC THRU P6110-EXIT.                     DTSCS26
01201                                                                   DTSCS26
01202      IF L823-NO-REC-88                                            DTSCS26
01203          MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                      DTSCS26
01204          PERFORM S1111-ERROR THRU S1111-EXIT                      DTSCS26
01205          GO TO P6100-EXIT.                                        DTSCS26
01206                                                                   DTSCS26
01207      MOVE SPACE TO PAGE-TYPE-IND.                                 DTSCS26
01208                                                                   DTSCS26
01209      IF LCCM-F09-88                                               DTSCS26
01210          PERFORM P6120-PAGE-NONE THRU P6120-EXIT                  DTSCS26
01211      ELSE                                                         DTSCS26
01212      IF LCCM-F07-88                                               DTSCS26
01213          PERFORM P6130-PAGE-BACK THRU P6130-EXIT                  DTSCS26
01214      ELSE                                                         DTSCS26
01215      IF LCCM-F08-88                                               DTSCS26
01216          PERFORM P6140-PAGE-NEXT THRU P6140-EXIT                  DTSCS26
01217      ELSE                                                         DTSCS26
01218          GO TO S899-ABEND.                                        DTSCS26
01219                                                                   DTSCS26
01220      IF LCCM-MSG                                                  DTSCS26
01221          GO TO P6100-EXIT.                                        DTSCS26
01222                                                                   DTSCS26
01223      IF ASKL-ADJ-88                                               DTSCS26
01224          NEXT SENTENCE                                            DTSCS26
01225      ELSE                                                         DTSCS26
01226      IF ASKL-PAY-88                                               DTSCS26
01227          MOVE '25' TO LCCM-REQ-SCR-ID                             DTSCS26
01228          SET REQ-JUMP TO TRUE                                     DTSCS26
01229      ELSE                                                         DTSCS26
01230      IF ASKL-RPT-88                                               DTSCS26
01231          MOVE '24' TO LCCM-REQ-SCR-ID                             DTSCS26
01232          SET REQ-JUMP TO TRUE                                     DTSCS26
01233      ELSE                                                         DTSCS26
01234          GO TO S899-ABEND.                                        DTSCS26
01235  P6100-EXIT.                                                      DTSCS26
01236      EXIT.                                                        DTSCS26
01237      SKIP3                                                        DTSCS26
01238  P6110-START-REC.                                                 DTSCS26
01239      MOVE LOW-VALUES TO ASKL-KEY-AREA.                            DTSCS26
01240                                                                   DTSCS26
01241      MOVE WRK-BATCH-NO TO ASKL-BATCH-NO.                          DTSCS26
01242                                                                   DTSCS26
01243      MOVE WRK-ITEM-NO TO ASKL-ITEM-NO.                            DTSCS26
01244                                                                   DTSCS26
01245      IF ASKL-ITEM-NO = +0                                         DTSCS26
01246          MOVE +1 TO ASKL-ITEM-NO.                                 DTSCS26
01247                                                                   DTSCS26
01248                                                                   DTSCS26
01249      PERFORM S823-START-BROWSE THRU S823-EXIT.                    DTSCS26
01250                                                                   DTSCS26
01251      IF L823-NO-REC-88                                            DTSCS26
01252          NEXT SENTENCE                                            DTSCS26
01253      ELSE                                                         DTSCS26
01254          IF WRK-BATCH-NO = ASKL-BATCH-NO                          DTSCS26
01255              GO TO P6110-EXIT                                     DTSCS26
01256          ELSE                                                     DTSCS26
01257              PERFORM S823-END-BROWSE THRU S823-EXIT.              DTSCS26
01258                                                                   DTSCS26
01259                                                                   DTSCS26
01260      MOVE LOW-VALUES TO ASKL-KEY-AREA.                            DTSCS26
01261                                                                   DTSCS26
01262      MOVE WRK-BATCH-NO TO ASKL-BATCH-NO.                          DTSCS26
01263                                                                   DTSCS26
01264      MOVE +1 TO ASKL-ITEM-NO.                                     DTSCS26
01265                                                                   DTSCS26
01266      PERFORM S823-START-BROWSE THRU S823-EXIT.                    DTSCS26
01267                                                                   DTSCS26
01268      IF L823-NO-REC-88                                            DTSCS26
01269          NEXT SENTENCE                                            DTSCS26
01270      ELSE                                                         DTSCS26
01271          IF WRK-BATCH-NO = ASKL-BATCH-NO                          DTSCS26
01272              PERFORM P6111-POSITION-LAST THRU P6111-EXIT          DTSCS26
01273              GO TO P6110-EXIT                                     DTSCS26
01274          ELSE                                                     DTSCS26
01275              PERFORM S823-END-BROWSE THRU S823-EXIT               DTSCS26
01276              SET L823-NO-REC-88 TO TRUE.                          DTSCS26
01277  P6110-EXIT.                                                      DTSCS26
01278      EXIT.                                                        DTSCS26
01279      SKIP3                                                        DTSCS26
01280  P6111-POSITION-LAST.                                             DTSCS26
01281      PERFORM                                                      DTSCS26
01282        UNTIL L823-NO-REC-88                                       DTSCS26
01283          MOVE ASKL-KEY-AREA TO HOLD-KEY-AREA                      DTSCS26
01284          PERFORM S823-READ-NEXT THRU S823-EXIT                    DTSCS26
01285          IF L823-OK-88                                            DTSCS26
01286              IF WRK-BATCH-NO NOT = ASKL-BATCH-NO                  DTSCS26
01287                  PERFORM S823-END-BROWSE THRU S823-EXIT           DTSCS26
01288                  SET L823-NO-REC-88 TO TRUE                       DTSCS26
01289              END-IF                                               DTSCS26
01290          END-IF                                                   DTSCS26
01291      END-PERFORM.                                                 DTSCS26
01292                                                                   DTSCS26
01293      MOVE HOLD-KEY-AREA TO ASKL-KEY-AREA.                         DTSCS26
01294                                                                   DTSCS26
01295      PERFORM S823-START-BROWSE THRU S823-EXIT.                    DTSCS26
01296                                                                   DTSCS26
01297      IF L823-NO-REC-88                                            DTSCS26
01298          NEXT SENTENCE                                            DTSCS26
01299      ELSE                                                         DTSCS26
01300          IF ASKL-KEY-AREA NOT = HOLD-KEY-AREA                     DTSCS26
01301              PERFORM S823-END-BROWSE THRU S823-EXIT               DTSCS26
01302              SET L823-NO-REC-88 TO TRUE.                          DTSCS26
01303  P6111-EXIT.                                                      DTSCS26
01304      EXIT.                                                        DTSCS26
01305      SKIP3                                                        DTSCS26
01306  P6120-PAGE-NONE.                                                 DTSCS26
01307      PERFORM S823-END-BROWSE THRU S823-EXIT.                      DTSCS26
01308                                                                   DTSCS26
01309      IF WRK-ITEM-NO = +0                                          DTSCS26
01310          NEXT SENTENCE                                            DTSCS26
01311      ELSE                                                         DTSCS26
01312      IF ASKL-ITEM-NO = WRK-ITEM-NO                                DTSCS26
01313          NEXT SENTENCE                                            DTSCS26
01314      ELSE                                                         DTSCS26
01315          MOVE EMSG-NO-DOC TO WRK-MSG-AREA                         DTSCS26
01316          PERFORM S1112-ERROR THRU S1112-EXIT.                     DTSCS26
01317  P6120-EXIT.                                                      DTSCS26
01318      EXIT.                                                        DTSCS26
01319      SKIP3                                                        DTSCS26
01320  P6130-PAGE-BACK.                                                 DTSCS26
01321      IF ASKL-ITEM-NO >= LCCM-ITEM-NO                              DTSCS26
01322          NEXT SENTENCE                                            DTSCS26
01323      ELSE                                                         DTSCS26
01324          PERFORM S823-END-BROWSE THRU S823-EXIT                   DTSCS26
01325          GO TO P6130-EXIT.                                        DTSCS26
01326                                                                   DTSCS26
01327      MOVE ASKL-KEY-AREA TO HOLD-KEY-AREA.                         DTSCS26
01328                                                                   DTSCS26
01329      PERFORM S823-READ-PREV THRU S823-EXIT.                       DTSCS26
01330                                                                   DTSCS26
01331      IF L823-NO-REC-88                                            DTSCS26
01332          SET PAGE-FIRST-88 TO TRUE                                DTSCS26
01333          GO TO P6130-EXIT.                                        DTSCS26
01334                                                                   DTSCS26
01335      PERFORM S823-READ-PREV THRU S823-EXIT.                       DTSCS26
01336                                                                   DTSCS26
01337      IF L823-NO-REC-88                                            DTSCS26
01338          SET PAGE-FIRST-88 TO TRUE                                DTSCS26
01339          GO TO P6130-EXIT.                                        DTSCS26
01340                                                                   DTSCS26
01341      PERFORM S823-END-BROWSE THRU S823-EXIT.                      DTSCS26
01342                                                                   DTSCS26
01343      IF (ASKL-ITEM-NO > +0)                                       DTSCS26
01344             AND                                                   DTSCS26
01345         (ASKL-BATCH-NO = WRK-BATCH-NO)                            DTSCS26
01346          NEXT SENTENCE                                            DTSCS26
01347      ELSE                                                         DTSCS26
01348          SET PAGE-FIRST-88 TO TRUE                                DTSCS26
01349          MOVE HOLD-KEY-AREA TO ASKL-KEY-AREA                      DTSCS26
01350          PERFORM S823-READ THRU S823-EXIT                         DTSCS26
01351          IF L823-NO-REC-88                                        DTSCS26
01352              GO TO S899-ABEND.                                    DTSCS26
01353  P6130-EXIT.                                                      DTSCS26
01354      EXIT.                                                        DTSCS26
01355      SKIP3                                                        DTSCS26
01356  P6140-PAGE-NEXT.                                                 DTSCS26
01357      IF LCCM-ITEM-NO = ASKL-ITEM-NO                               DTSCS26
01358          NEXT SENTENCE                                            DTSCS26
01359      ELSE                                                         DTSCS26
01360          PERFORM S823-END-BROWSE THRU S823-EXIT                   DTSCS26
01361          GO TO P6140-EXIT.                                        DTSCS26
01362                                                                   DTSCS26
01363      MOVE ASKL-KEY-AREA TO HOLD-KEY-AREA.                         DTSCS26
01364                                                                   DTSCS26
01365      PERFORM S823-READ-NEXT THRU S823-EXIT.                       DTSCS26
01366                                                                   DTSCS26
01367      IF L823-NO-REC-88                                            DTSCS26
01368          SET PAGE-LAST-88 TO TRUE                                 DTSCS26
01369          GO TO P6140-EXIT.                                        DTSCS26
01370                                                                   DTSCS26
01371      PERFORM S823-END-BROWSE THRU S823-EXIT.                      DTSCS26
01372                                                                   DTSCS26
01373      IF (ASKL-ITEM-NO > +0)                                       DTSCS26
01374             AND                                                   DTSCS26
01375         (ASKL-BATCH-NO = WRK-BATCH-NO)                            DTSCS26
01376          NEXT SENTENCE                                            DTSCS26
01377      ELSE                                                         DTSCS26
01378          SET PAGE-LAST-88 TO TRUE                                 DTSCS26
01379          MOVE HOLD-KEY-AREA TO ASKL-KEY-AREA                      DTSCS26
01380          PERFORM S823-READ THRU S823-EXIT                         DTSCS26
01381          IF L823-NO-REC-88                                        DTSCS26
01382              GO TO S899-ABEND.                                    DTSCS26
01383  P6140-EXIT.                                                      DTSCS26
01384      EXIT.                                                        DTSCS26
01385 /*****************************************************************DTSCS26
01386 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS            *DTSCS26
01387 ******************************************************************DTSCS26
01388                                                                   DTSCS26
01389  P6900-CONSTRUCT-SCREEN.                                          DTSCS26
01390      IF ASKL-ADJ-88                                               DTSCS26
01391          NEXT SENTENCE                                            DTSCS26
01392      ELSE                                                         DTSCS26
01393          GO TO S899-ABEND.                                        DTSCS26
01394                                                                   DTSCS26
01395      MOVE ASKL-REC TO AADJ-REC.                                   DTSCS26
01396                                                                   DTSCS26
01397      PERFORM P6910-FROM-AADJ THRU P6910-EXIT.                        CL**9
01398                                                                   DTSCS26
01399      IF AADJ-PROCESSED-DATE > +0                                  DTSCS26
01400          MOVE MSG-P26D-AREA TO LCCM-MSG-AREA                      DTSCS26
01401 *********PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT              DTSCS26
01402          GO TO P6900-EXIT.                                        DTSCS26
01403                                                                   DTSCS26
01404      IF PAGE-FIRST-88                                             DTSCS26
01405          MOVE PMSG-FIRST-PAGE TO LCCM-MSG-AREA                    DTSCS26
01406      ELSE                                                         DTSCS26
01407      IF PAGE-LAST-88                                              DTSCS26
01408          MOVE PMSG-LAST-PAGE TO LCCM-MSG-AREA.                    DTSCS26
01409  P6900-EXIT.                                                      DTSCS26
01410      EXIT.                                                        DTSCS26
01411                                                                   DTSCS26
01412  P6910-FROM-AADJ.                                                 DTSCS26
01413      MOVE AADJ-BATCH-NO TO MAP-BATCH-NO-N.                        DTSCS26
01414                                                                   DTSCS26
01415      MOVE AADJ-ITEM-NO TO MAP-ITEM-NO-N.                          DTSCS26
01416                                                                   DTSCS26
01417      MOVE AADJ-NAME-CHECK TO MAP-NAME-CHECK.                      DTSCS26
01418                                                                   DTSCS26
01419      MOVE AADJ-ADJ-TYPE TO MAP-ADJ-TYPE.                          DTSCS26
01420                                                                   DTSCS26
01421      MOVE AADJ-EMP-NO TO LCCM-EMP-NO                              DTSCS26
01422                          WRK-DISPLAY.                             DTSCS26
01423                                                                   DTSCS26
01424      MOVE WRK-EMP-NO-1 TO MAP-EMP-NO-1.                           DTSCS26
01425                                                                   DTSCS26
01426      MOVE WRK-EMP-NO-2 TO MAP-EMP-NO-2.                           DTSCS26
01427                                                                   DTSCS26
01428      MOVE AADJ-AMT TO MAP-AMT-N.                                  DTSCS26
01429                                                                   DTSCS26
01430      IF AADJ-APPLIC-YRQ > 0                                       DTSCS26
01431          IF AADJ-APPLIC-YRQ = LCCM-PICKUP-YRQ                     DTSCS26
01432              MOVE 'PU' TO MAP-APPLIC-YRQ-YR                       DTSCS26
01433              MOVE ' ' TO MAP-APPLIC-YRQ-Q                         DTSCS26
01434          ELSE                                                     DTSCS26
01435              MOVE AADJ-APPLIC-YRQ TO WRK-DISPLAY                  DTSCS26
01436              MOVE WRK-DISPLAY-YRQ-YR TO MAP-APPLIC-YRQ-YR         DTSCS26
01437              MOVE WRK-DISPLAY-YRQ-Q TO MAP-APPLIC-YRQ-Q.          DTSCS26
01438                                                                   DTSCS26
01439      MOVE AADJ-APPLIC-IND TO MAP-APPLIC-IND.                      DTSCS26
01440                                                                   DTSCS26
01441      IF AADJ-APPLIC-DOC-NO = NULL-DOC-NO                          DTSCS26
01442          NEXT SENTENCE                                            DTSCS26
01443      ELSE                                                         DTSCS26
01444          MOVE AADJ-APPLIC-BATCH-NO TO MAP-APPLIC-BATCH-NO-N       DTSCS26
01445          MOVE AADJ-APPLIC-ITEM-NO TO MAP-APPLIC-ITEM-NO-N.        DTSCS26
01446                                                                   DTSCS26
01447      IF AADJ-DATE-1 > +0                                          DTSCS26
01448         MOVE AADJ-DATE-1 TO WRK-DISPLAY                           DTSCS26
01449         MOVE WRK-DISPLAY-MO TO MAP-DATE-1-MO                      DTSCS26
01450         MOVE WRK-DISPLAY-DA TO MAP-DATE-1-DA                      DTSCS26
01451         MOVE WRK-DISPLAY-YR TO MAP-DATE-1-YR.                     DTSCS26
01452                                                                   DTSCS26
01453      IF AADJ-DATE-2 > +0                                          DTSCS26
01454         MOVE AADJ-DATE-2 TO WRK-DISPLAY                           DTSCS26
01455         MOVE WRK-DISPLAY-MO TO MAP-DATE-2-MO                      DTSCS26
01456         MOVE WRK-DISPLAY-DA TO MAP-DATE-2-DA                      DTSCS26
01457         MOVE WRK-DISPLAY-YR TO MAP-DATE-2-YR.                     DTSCS26
01458                                                                   DTSCS26
01459      MOVE AADJ-INT-SPAN-IND TO MAP-INT-SPAN-IND.                  DTSCS26
01460                                                                   DTSCS26
01461      IF (AADJ-INT-DATE-88)                                        DTSCS26
01462              AND                                                  DTSCS26
01463         (AADJ-DATE-1 NOT = ALL-NINES-DATE)                        DTSCS26
01464          MOVE AADJ-INT-RATE TO L056-RATE                          DTSCS26
01465          PERFORM S056-DISP1-LEFT THRU S056-EXIT                   DTSCS26
01466          MOVE L056-DISP-RATE TO MAP-INT-RATE.                     DTSCS26
01467                                                                   DTSCS26
01468      IF AADJ-RECEIVED-DATE > +0                                   DTSCS26
01469         MOVE AADJ-RECEIVED-DATE TO WRK-DISPLAY                    DTSCS26
01470         MOVE WRK-DISPLAY-MO TO MAP-RECEIVED-DATE-MO               DTSCS26
01471         MOVE WRK-DISPLAY-DA TO MAP-RECEIVED-DATE-DA               DTSCS26
01472         MOVE WRK-DISPLAY-YR TO MAP-RECEIVED-DATE-YR.              DTSCS26
01473                                                                   DTSCS26
01474      MOVE AADJ-RESPONSIBLE-ACTIVITY TO MAP-RESPONSIBLE-ACTIVITY.  DTSCS26
01475                                                                   DTSCS26
01476      MOVE AADJ-RESPONSIBLE-OP-ID TO MAP-RESPONSIBLE-OP-ID.        DTSCS26
01477                                                                   DTSCS26
01478      MOVE AADJ-DISREGARD-EDITS-IND   TO MAP-DISREGARD-EDITS-IND.  DTSCS26
01479                                                                   DTSCS26
01480      IF AADJ-PROCESSED-DATE > +0                                  DTSCS26
01481         MOVE AADJ-PROCESSED-DATE TO L001-FED-8-DATE-9             DTSCS26
01482         PERFORM S001-FROM-FED-8 THRU S001-EXIT                    DTSCS26
01483         MOVE L001-SLASH-DATE TO MAP-PROCESSED-DATE                DTSCS26
01484      END-IF.                                                      DTSCS26
01485                                                                   DTSCS26
01486      IF AADJ-CMP-ESTB-ABSTIME > ZERO                              DTSCS26
01487         SET MAP-CMPRMISE-YES-88  TO TRUE                          DTSCS26
01488      END-IF.                                                      DTSCS26
01489  P6910-EXIT.                                                      DTSCS26
01490      EXIT.                                                        DTSCS26
01491 /*****************************************************************DTSCS26
01492 * FUNCTION KEY TO ADD, MOD OR DEL THE RECORD WAS PRESSED.        *DTSCS26
01493 ******************************************************************DTSCS26
01494                                                                   DTSCS26
01495  P7000-REQUEST-EDIT.                                              DTSCS26
01496      PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.              DTSCS26
01497                                                                   DTSCS26
01498 *****IF LCCM-ENTER-88                                             DTSCS26
01499 *****   PERFORM P7100-EDIT-ADD THRU P7100-EXIT                    DTSCS26
01500 *****ELSE                                                         DTSCS26
01501      IF LCCM-F10-88                                               DTSCS26
01502         PERFORM P7200-EDIT-MOD THRU P7200-EXIT                    DTSCS26
01503      ELSE                                                         DTSCS26
01504         IF LCCM-F23-88                                            DTSCS26
01505            PERFORM P7300-EDIT-DEL THRU P7300-EXIT                 DTSCS26
01506         ELSE                                                      DTSCS26
01507            GO TO S899-ABEND.                                      DTSCS26
01508                                                                   DTSCS26
01509                                                                   DTSCS26
01510 *------------------------------------------------------           DTSCS26
01511 *  SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED.          DTSCS26
01512 *  IN ORDER TO CONTINUE TO ATTEMPT A MOD THE SCREEN MUST          DTSCS26
01513 *  REMAIN IN 'INQUIRE' STATUS.                                    DTSCS26
01514 *------------------------------------------------------           DTSCS26
01515                                                                   DTSCS26
01516      IF LCCM-MSG                                                  DTSCS26
01517         NEXT SENTENCE                                             DTSCS26
01518      ELSE                                                         DTSCS26
01519         PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT              DTSCS26
01520 ********IF LCCM-ENTER-88                                          DTSCS26
01521 ***********SET LCCM-SCR-ADD-LOCKED TO TRUE                        DTSCS26
01522 ***********MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID                   DTSCS26
01523 ********ELSE                                                      DTSCS26
01524         IF LCCM-F10-88                                            DTSCS26
01525            SET LCCM-SCR-MOD-LOCKED TO TRUE                        DTSCS26
01526            MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID                   DTSCS26
01527         ELSE                                                      DTSCS26
01528            IF LCCM-F23-88                                         DTSCS26
01529               SET LCCM-SCR-DEL-LOCKED TO TRUE                     DTSCS26
01530               MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID.               DTSCS26
01531                                                                   DTSCS26
01532      SET RESP-SEND-MAP TO TRUE.                                   DTSCS26
01533  P7000-EXIT.                                                      DTSCS26
01534      EXIT.                                                        DTSCS26
01535 /*****************************************************************DTSCS26
01536 * MODIFICATION FUNCTION WAS REQUESTED                            *DTSCS26
01537 ******************************************************************DTSCS26
01538                                                                   DTSCS26
01539  P7200-EDIT-MOD.                                                  DTSCS26
01540                                                                   DTSCS26
01541 *-----------------------------------------------------            DTSCS26
01542 *    MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY         DTSCS26
01543 *    INQUIRED                                                     DTSCS26
01544 *-----------------------------------------------------            DTSCS26
01545                                                                   DTSCS26
01546      IF NOT LCCM-SCR-INQUIRE                                      DTSCS26
01547         MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-ID                     DTSCS26
01548         GO TO P7200-EXIT.                                         DTSCS26
01549                                                                   DTSCS26
01550                                                                   DTSCS26
01551 *-----------------------------------------------------            DTSCS26
01552 *    MAP-BATCH-NO MAY NOT BE CHANGED DURING THE MOD               DTSCS26
01553 *-----------------------------------------------------            DTSCS26
01554                                                                   DTSCS26
01555      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS26
01556                                                                   DTSCS26
01557      IF LCCM-MSG                                                  DTSCS26
01558          GO TO P7200-EXIT.                                        DTSCS26
01559                                                                   DTSCS26
01560                                                                   DTSCS26
01561      IF LCCM-BATCH-NO NOT = WRK-BATCH-NO                          DTSCS26
01562         MOVE EMSG-NO-BATCH-NO-CHANGE TO WRK-MSG-AREA              DTSCS26
01563         PERFORM S1111-ERROR THRU S1111-EXIT                       DTSCS26
01564         GO TO P7200-EXIT.                                         DTSCS26
01565                                                                   DTSCS26
01566                                                                   DTSCS26
01567      IF LCCM-ITEM-NO NOT = WRK-ITEM-NO                            DTSCS26
01568         MOVE EMSG-NO-ITEM-NO-CHANGE TO WRK-MSG-AREA               DTSCS26
01569         PERFORM S1112-ERROR THRU S1112-EXIT                       DTSCS26
01570         GO TO P7200-EXIT.                                         DTSCS26
01571                                                                   DTSCS26
01572                                                                   DTSCS26
01573      PERFORM P7910-EDIT-FOR-PROCESSED THRU P7910-EXIT.            DTSCS26
01574                                                                   DTSCS26
01575      IF LCCM-MSG                                                  DTSCS26
01576          GO TO P7200-EXIT.                                        DTSCS26
01577                                                                   DTSCS26
01578                                                                   DTSCS26
01579      PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT.                  DTSCS26
01580  P7200-EXIT.                                                      DTSCS26
01581      EXIT.                                                        DTSCS26
01582 /*****************************************************************DTSCS26
01583 * DELETE FUNCTION WAS REQUESTED                                  *DTSCS26
01584 ******************************************************************DTSCS26
01585                                                                   DTSCS26
01586  P7300-EDIT-DEL.                                                  DTSCS26
01587                                                                   DTSCS26
01588 *-----------------------------------------------------            DTSCS26
01589 *    DELETION REQUIRES THAT A RECORD WAS SUCCESSFULLY             DTSCS26
01590 *    INQUIRED                                                     DTSCS26
01591 *-----------------------------------------------------            DTSCS26
01592                                                                   DTSCS26
01593      IF NOT LCCM-SCR-INQUIRE                                      DTSCS26
01594         MOVE EMSG-DEL-PRECEDED TO LCCM-MSG-ID                     DTSCS26
01595         GO TO P7300-EXIT.                                         DTSCS26
01596                                                                   DTSCS26
01597                                                                   DTSCS26
01598 *-----------------------------------------------------            DTSCS26
01599 *    MAP-BATCH-NO MAY NOT BE CHANGED DURING THE DEL               DTSCS26
01600 *-----------------------------------------------------            DTSCS26
01601                                                                   DTSCS26
01602      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS26
01603                                                                   DTSCS26
01604      IF LCCM-MSG                                                  DTSCS26
01605          GO TO P7300-EXIT.                                        DTSCS26
01606                                                                   DTSCS26
01607                                                                   DTSCS26
01608      IF LCCM-BATCH-NO NOT = WRK-BATCH-NO                          DTSCS26
01609         MOVE EMSG-NO-BATCH-NO-CHANGE TO WRK-MSG-AREA              DTSCS26
01610         PERFORM S1111-ERROR THRU S1111-EXIT                       DTSCS26
01611         GO TO P7300-EXIT.                                         DTSCS26
01612                                                                   DTSCS26
01613                                                                   DTSCS26
01614      IF LCCM-ITEM-NO NOT = WRK-ITEM-NO                            DTSCS26
01615         MOVE EMSG-NO-ITEM-NO-CHANGE TO WRK-MSG-AREA               DTSCS26
01616         PERFORM S1112-ERROR THRU S1112-EXIT                       DTSCS26
01617         GO TO P7300-EXIT.                                         DTSCS26
01618                                                                   DTSCS26
01619                                                                   DTSCS26
01620      PERFORM P7910-EDIT-FOR-PROCESSED THRU P7910-EXIT.            DTSCS26
01621                                                                   DTSCS26
01622      IF LCCM-MSG                                                  DTSCS26
01623          GO TO P7300-EXIT.                                        DTSCS26
01624  P7300-EXIT.                                                      DTSCS26
01625      EXIT.                                                        DTSCS26
01626      EJECT                                                        DTSCS26
01627  P7910-EDIT-FOR-PROCESSED.                                        DTSCS26
01628      MOVE LOW-VALUES TO ASKL-KEY-AREA.                            DTSCS26
01629                                                                   DTSCS26
01630      MOVE WRK-BATCH-NO TO ASKL-BATCH-NO.                          DTSCS26
01631                                                                   DTSCS26
01632      MOVE WRK-ITEM-NO TO ASKL-ITEM-NO.                            DTSCS26
01633                                                                   DTSCS26
01634      PERFORM S823-READ THRU S823-EXIT.                            DTSCS26
01635                                                                   DTSCS26
01636      IF L823-NO-REC-88                                            DTSCS26
01637          GO TO P7910-EXIT.                                        DTSCS26
01638                                                                   DTSCS26
01639                                                                   DTSCS26
01640      MOVE ASKL-REC TO AADJ-REC.                                   DTSCS26
01641                                                                   DTSCS26
01642                                                                   DTSCS26
01643      IF AADJ-NOT-PROCESSED-88                                     DTSCS26
01644          CONTINUE                                                 DTSCS26
01645      ELSE                                                         DTSCS26
01646          MOVE MSG-E26D-AREA TO WRK-MSG-AREA                       DTSCS26
01647          PERFORM S1111-ERROR THRU S1111-EXIT                      DTSCS26
01648          PERFORM S1112-ERROR THRU S1112-EXIT                      DTSCS26
01649          GO TO P7910-EXIT.                                        DTSCS26
01650  P7910-EXIT.                                                      DTSCS26
01651      EXIT.                                                        DTSCS26
01652 /*****************************************************************DTSCS26
01653 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED       *DTSCS26
01654 ******************************************************************DTSCS26
01655                                                                   DTSCS26
01656  P8000-REQUEST-UPDATE.                                            DTSCS26
01657                                                                   DTSCS26
01658 *****IF LCCM-SCR-ADD-LOCKED                                       DTSCS26
01659 *****   PERFORM P8100-ADD THRU P8100-EXIT                         DTSCS26
01660 *****ELSE                                                         DTSCS26
01661      IF LCCM-SCR-MOD-LOCKED                                       DTSCS26
01662         PERFORM P8200-MOD THRU P8200-EXIT                         DTSCS26
01663      ELSE                                                         DTSCS26
01664      IF LCCM-SCR-DEL-LOCKED                                       DTSCS26
01665         PERFORM P8300-DEL THRU P8300-EXIT                         DTSCS26
01666      ELSE                                                         DTSCS26
01667         PERFORM P8100-ADD THRU P8100-EXIT.                        DTSCS26
01668                                                                   DTSCS26
01669      SET RESP-SEND-MAP TO TRUE.                                   DTSCS26
01670  P8000-EXIT.                                                      DTSCS26
01671      EXIT.                                                        DTSCS26
01672 /*****************************************************************DTSCS26
01673 *                                                                *DTSCS26
01674 ******************************************************************DTSCS26
01675                                                                   DTSCS26
01676  P8100-ADD.                                                       DTSCS26
01677      PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.              DTSCS26
01678                                                                   DTSCS26
01679      IF NOT LCCM-SCR-CLEAR                                        DTSCS26
01680          MOVE EMSG-ADD-PRECEDED TO LCCM-MSG-ID                    DTSCS26
01681          GO TO P8100-EXIT.                                        DTSCS26
01682                                                                   DTSCS26
01683                                                                   DTSCS26
01684      PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT.                  DTSCS26
01685                                                                   DTSCS26
01686      IF (WRK-BATCH-NO = LCCM-BATCH-NO)                            DTSCS26
01687 *************OR                                                   DTSCS26
01688 ********(WRK-BATCH-NO = +0)                                       DTSCS26
01689          NEXT SENTENCE                                            DTSCS26
01690      ELSE                                                         DTSCS26
01691          MOVE WRK-BATCH-NO TO LCCM-BATCH-NO                       DTSCS26
01692          MOVE +0 TO LCCM-ITEM-NO.                                 DTSCS26
01693                                                                   DTSCS26
01694      IF LCCM-MSG                                                  DTSCS26
01695         GO TO P8100-EXIT.                                         DTSCS26
01696                                                                   DTSCS26
01697                                                                   DTSCS26
01698 *---------------------------------------------------              DTSCS26
01699 *    BATCH HEADER RECORD MUST EXIST                               DTSCS26
01700 *---------------------------------------------------              DTSCS26
01701                                                                   DTSCS26
01702 *****IF WRK-BATCH-NO NOT = +0                                     DTSCS26
01703 ********MOVE LCCM-TRAN-MAX TO WRK-TRAN-MAX                        DTSCS26
01704 ********MOVE +999 TO WRK-ITEM-MAX                                 DTSCS26
01705                                                                   DTSCS26
01706      PERFORM P8910-CHECK-BATCH THRU P8910-EXIT.                   DTSCS26
01707                                                                   DTSCS26
01708      IF LCCM-MSG                                                  DTSCS26
01709         GO TO P8100-EXIT.                                         DTSCS26
01710                                                                   DTSCS26
01711                                                                   DTSCS26
01712      IF WRK-ITEM-NO = +0                                          DTSCS26
01713          PERFORM P8102-CHECK-FULL-BATCH THRU P8102-EXIT           DTSCS26
01714      ELSE                                                         DTSCS26
01715          PERFORM P8103-CHECK-DUPLICATE THRU P8103-EXIT.           DTSCS26
01716                                                                   DTSCS26
01717      IF LCCM-MSG                                                  DTSCS26
01718          GO TO P8100-EXIT.                                        DTSCS26
01719                                                                   DTSCS26
01720                                                                   DTSCS26
01721 *--------------------------------------------------------         DTSCS26
01722 *    FOR ANNUAL QUARTERS, WRITE 4 ADJUSTMENT TRANSACTIONS         DTSCS26
01723 *--------------------------------------------------------         DTSCS26
01724      IF MPRF-ORG-HSEHLD-DMSTIC-88                                 DTSCS26
01725         MOVE WRK-APPLIC-YRQ   TO L410-YRQ                         DTSCS26
01726         MOVE WRK-EMP-NO       TO L410-EMP-NO                      DTSCS26
01727         PERFORM S410-FILING-SCHEDULE  THRU S410-EXIT              DTSCS26
01728         IF L410-ANN-SCHED-88                                      DTSCS26
01729            IF ADJ-FOUR-QTRS-YES-88                                DTSCS26
01730               PERFORM P8130-FOUR-QTRS  THRU P8130-EXIT            DTSCS26
01731            ELSE                                                   DTSCS26
01732               PERFORM P8110-ADD-AADJ THRU P8110-EXIT              DTSCS26
01733         ELSE                                                      DTSCS26
01734            PERFORM P8110-ADD-AADJ THRU P8110-EXIT                 DTSCS26
01735      ELSE                                                         DTSCS26
01736         PERFORM P8110-ADD-AADJ THRU P8110-EXIT.                   DTSCS26
01737                                                                   DTSCS26
01738      MOVE 'A'                    TO L221-UPDATE-FUNCTION.         DTSCS26
01739      PERFORM S221-WRITE-R906     THRU S221-EXIT.                  DTSCS26
01740                                                                   DTSCS26
01741 **** PERFORM P8110-ADD-AADJ THRU P8110-EXIT.                      DTSCS26
01742                                                                   DTSCS26
01743 *****IF LCCM-MSG                                                  DTSCS26
01744 *********NEXT SENTENCE                                            DTSCS26
01745 *****ELSE                                                         DTSCS26
01746 *********MOVE PMSG-ADD-SUCCESSFUL  TO LCCM-MSG-ID.                DTSCS26
01747                                                                   DTSCS26
01748      PERFORM P8120-READY-SCREEN THRU P8120-EXIT.                  DTSCS26
01749  P8100-EXIT.                                                      DTSCS26
01750      EXIT.                                                        DTSCS26
01751                                                                   DTSCS26
01752                                                                   DTSCS26
01753                                                                   DTSCS26
01754  P8102-CHECK-FULL-BATCH.                                          DTSCS26
01755      IF L372-LAST-USED-ITEM-MAX-88                                DTSCS26
01756          MOVE EMSG-BATCH-FULL TO WRK-MSG-AREA                     DTSCS26
01757          PERFORM S1111-ERROR THRU S1111-EXIT.                     DTSCS26
01758  P8102-EXIT.                                                      DTSCS26
01759      EXIT.                                                        DTSCS26
01760                                                                   DTSCS26
01761                                                                   DTSCS26
01762                                                                   DTSCS26
01763  P8103-CHECK-DUPLICATE.                                           DTSCS26
01764      IF WRK-ITEM-NO > L372-LAST-USED-ITEM-NO                      DTSCS26
01765          GO TO P8103-EXIT.                                        DTSCS26
01766                                                                   DTSCS26
01767                                                                   DTSCS26
01768      MOVE LOW-VALUES TO ASKL-KEY-AREA.                            DTSCS26
01769                                                                   DTSCS26
01770      MOVE WRK-BATCH-NO TO ASKL-BATCH-NO.                          DTSCS26
01771                                                                   DTSCS26
01772      MOVE WRK-ITEM-NO TO ASKL-ITEM-NO.                            DTSCS26
01773                                                                   DTSCS26
01774      PERFORM S823-READ THRU S823-EXIT.                            DTSCS26
01775                                                                   DTSCS26
01776      IF L823-OK-88                                                DTSCS26
01777          MOVE EMSG-RECORD-EXISTS TO WRK-MSG-AREA                  DTSCS26
01778          PERFORM S1112-ERROR THRU S1112-EXIT.                     DTSCS26
01779  P8103-EXIT.                                                      DTSCS26
01780      EXIT.                                                        DTSCS26
01781                                                                   DTSCS26
01782                                                                   DTSCS26
01783                                                                   DTSCS26
01784  P8110-ADD-AADJ.                                                  DTSCS26
01785 *---------------------------------------------------              DTSCS26
01786 * BUILD A BATCH HEADER ON THE FLY IF NO BATCH-NO SPECIFIED        DTSCS26
01787 *---------------------------------------------------              DTSCS26
01788 *****IF WRK-BATCH-NO = +0                                         DTSCS26
01789 ********MOVE LCCM-OP-ID TO L373-ENTRY-OP-ID                       DTSCS26
01790 ********PERFORM S373-ADD-HDR THRU S373-EXIT                       DTSCS26
01791 ********MOVE L373-BATCH-NO TO MAP-BATCH-NO                        DTSCS26
01792 ******************************LCCM-BATCH-NO                       DTSCS26
01793 ******************************WRK-BATCH-NO.                       DTSCS26
01794                                                                   DTSCS26
01795      MOVE WRK-BATCH-NO TO L372-BATCH-NO.                          DTSCS26
01796                                                                   DTSCS26
01797      MOVE +1 TO L372-CHNG-ATC-FILE-TRAN-CNT.                      DTSCS26
01798                                                                   DTSCS26
01799      MOVE +0 TO L372-CHNG-ATC-FILE-REMIT-AMT.                     DTSCS26
01800                                                                   DTSCS26
01801      IF ADJ-FOUR-QTRS-YES-88                                      DTSCS26
01802          MOVE +0 TO L372-CHNG-LAST-USED-ITEM-NO                   DTSCS26
01803                     WRK-ITEM-NO                                   DTSCS26
01804          SET L372-CHNG-INCR-LAST-USED-Y-88 TO TRUE                DTSCS26
01805      ELSE                                                         DTSCS26
01806      IF WRK-ITEM-NO > +0                                          DTSCS26
01807          MOVE WRK-ITEM-NO TO L372-CHNG-LAST-USED-ITEM-NO          DTSCS26
01808          SET L372-CHNG-INCR-LAST-USED-N-88 TO TRUE                DTSCS26
01809      ELSE                                                         DTSCS26
01810          MOVE +0 TO L372-CHNG-LAST-USED-ITEM-NO                   DTSCS26
01811          SET L372-CHNG-INCR-LAST-USED-Y-88 TO TRUE.               DTSCS26
01812                                                                   DTSCS26
01813      PERFORM S372-BATCH-UPDATE THRU S372-EXIT.                    DTSCS26
01814                                                                   DTSCS26
01815      IF L372-RESULT-OK                                            DTSCS26
01816          NEXT SENTENCE                                            DTSCS26
01817      ELSE                                                         DTSCS26
01818          GO TO S899-ABEND.                                        DTSCS26
01819                                                                   DTSCS26
01820 *****MOVE L372-LAST-USED-ITEM-NO TO LCCM-ITEM-NO                  DTSCS26
01821 *********************************** WRK-ITEM-NO.                  DTSCS26
01822                                                                   DTSCS26
01823      IF WRK-ITEM-NO > +0                                          DTSCS26
01824          MOVE WRK-ITEM-NO TO LCCM-ITEM-NO                         DTSCS26
01825      ELSE                                                         DTSCS26
01826          MOVE L372-LAST-USED-ITEM-NO TO WRK-ITEM-NO               DTSCS26
01827                                         LCCM-ITEM-NO.             DTSCS26
01828                                                                   DTSCS26
01829      PERFORM P8920-CONSTRUCT-AADJ THRU P8920-EXIT.                DTSCS26
01830                                                                   DTSCS26
01831      MOVE AADJ-REC TO ASKL-REC.                                   DTSCS26
01832                                                                   DTSCS26
01833      PERFORM S823-WRITE THRU S823-EXIT.                           DTSCS26
01834                                                                   DTSCS26
01835      SET WRK-AATH-ACTION-ADD-88   TO TRUE.                        DTSCS26
01836      PERFORM S826-WRITE-ATH       THRU S826-EXIT.                 DTSCS26
01837                                                                   DTSCS26
01838  P8110-EXIT.                                                      DTSCS26
01839      EXIT.                                                        DTSCS26
01840                                                                   DTSCS26
01841  P8120-READY-SCREEN.                                              DTSCS26
01842      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS26
01843                                                                   DTSCS26
01844      PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.              DTSCS26
01845                                                                   DTSCS26
01846      MOVE LCCM-BATCH-NO TO MAP-BATCH-NO-N.                        DTSCS26
01847                                                                   DTSCS26
01848      MOVE LCCM-ENTRY-MODE TO MAP-ENTRY-MODE.                      DTSCS26
01849                                                                   DTSCS26
01850      IF MAP-ENTRY-MODE-1                                          DTSCS26
01851         IF CURSOR-SET-NO                                          DTSCS26
01852            MOVE CATB-CURSOR TO MAP-ADJ-TYPE-L                     DTSCS26
01853            SET CURSOR-SET-YES TO TRUE                             DTSCS26
01854         END-IF                                                    DTSCS26
01855      ELSE                                                         DTSCS26
01856      IF MAP-ENTRY-MODE-2 OR MAP-ENTRY-MODE-3                      DTSCS26
01857         MOVE AADJ-NAME-CHECK TO MAP-NAME-CHECK                    DTSCS26
01858         MOVE AADJ-EMP-NO TO LCCM-EMP-NO                           DTSCS26
01859                             WRK-DISPLAY                           DTSCS26
01860         MOVE WRK-EMP-NO-1 TO MAP-EMP-NO-1                         DTSCS26
01861         MOVE WRK-EMP-NO-2 TO MAP-EMP-NO-2                         DTSCS26
01862         MOVE AADJ-ADJ-TYPE TO MAP-ADJ-TYPE                        DTSCS26
01863         MOVE AADJ-RESPONSIBLE-ACTIVITY                            DTSCS26
01864           TO MAP-RESPONSIBLE-ACTIVITY                             DTSCS26
01865         MOVE AADJ-RESPONSIBLE-OP-ID                               DTSCS26
01866           TO MAP-RESPONSIBLE-OP-ID                                DTSCS26
01867         IF AADJ-RECEIVED-DATE > +0                                DTSCS26
01868            MOVE AADJ-RECEIVED-DATE TO WRK-DISPLAY                 DTSCS26
01869            MOVE WRK-DISPLAY-MO TO MAP-RECEIVED-DATE-MO            DTSCS26
01870            MOVE WRK-DISPLAY-DA TO MAP-RECEIVED-DATE-DA            DTSCS26
01871            MOVE WRK-DISPLAY-YR TO MAP-RECEIVED-DATE-YR            DTSCS26
01872         END-IF                                                    DTSCS26
01873         IF AADJ-CMP-ESTB-ABSTIME > ZERO                           DTSCS26
01874            SET MAP-CMPRMISE-YES-88  TO TRUE                       DTSCS26
01875         END-IF                                                    DTSCS26
01876         IF CURSOR-SET-NO                                          DTSCS26
01877            MOVE CATB-CURSOR TO MAP-AMT-L                          DTSCS26
01878            SET CURSOR-SET-YES TO TRUE                             DTSCS26
01879         END-IF                                                    DTSCS26
01880      END-IF.                                                      DTSCS26
01881  P8120-EXIT.                                                      DTSCS26
01882      EXIT.                                                        DTSCS26
01883                                                                   DTSCS26
01884  P8130-FOUR-QTRS.                                                 DTSCS26
01885      PERFORM                                                      DTSCS26
01886         VARYING QTR-SUB FROM +1 BY +1                             DTSCS26
01887         UNTIL QTR-SUB > +4                                        DTSCS26
01888            MOVE WRK-MQTR-YRQ (QTR-SUB) TO WRK-APPLIC-YRQ          DTSCS26
01889            IF WRK-MQTR-BYPASS-NO-88 (QTR-SUB)                     DTSCS26
01890               PERFORM P8110-ADD-AADJ THRU P8110-EXIT              DTSCS26
01891            END-IF                                                 DTSCS26
01892      END-PERFORM.                                                 DTSCS26
01893                                                                   DTSCS26
01894  P8130-EXIT.                                                      DTSCS26
01895      EXIT.                                                        DTSCS26
01896                                                                   DTSCS26
01897 *P8130-FOUR-QTRS.                                                 DTSCS26
01898 *    PERFORM                                                      DTSCS26
01899 *       VARYING QTR-SUB FROM +1 BY +1                             DTSCS26
01900 *       UNTIL QTR-SUB > +4                                        DTSCS26
01901 *          MOVE WRK-MQTR-YRQ (QTR-SUB) TO WRK-APPLIC-YRQ          DTSCS26
01902 *          IF AADJ-AUTO-88 OR AADJ-MANUAL-88                      DTSCS26
01903 *          OR AADJ-DUE-DATE-88 OR AADJ-WAIVE-DATE-88              DTSCS26
01904 *          OR AADJ-INT-DATE-88                                    DTSCS26
01905 *             IF WRK-MQTR-BYPASS-NO-88 (QTR-SUB)                  DTSCS26
01906 *                PERFORM P8110-ADD-AADJ THRU P8110-EXIT           DTSCS26
01907 *             END-IF                                              DTSCS26
01908 *          ELSE                                                   DTSCS26
01909 *             MOVE WRK-MQTR-ADJ-AMT (QTR-SUB) TO WRK-AMT          DTSCS26
01910 *             IF WRK-AMT NOT = ZERO                               DTSCS26
01911 *                PERFORM P8110-ADD-AADJ THRU P8110-EXIT           DTSCS26
01912 *             END-IF                                              DTSCS26
01913 *          END-IF                                                 DTSCS26
01914 *    END-PERFORM.                                                 DTSCS26
01915 *                                                                 DTSCS26
01916 *P8130-EXIT.                                                      DTSCS26
01917 *    EXIT.                                                        DTSCS26
01918 /*****************************************************************DTSCS26
01919 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS        *DTSCS26
01920 ******************************************************************DTSCS26
01921                                                                   DTSCS26
01922  P8200-MOD.                                                       DTSCS26
01923      SET LCCM-SCR-INQUIRE TO TRUE.                                DTSCS26
01924                                                                   DTSCS26
01925      PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.              DTSCS26
01926                                                                   DTSCS26
01927      IF LCCM-F12-88                                               DTSCS26
01928         MOVE PMSG-MOD-CANCELED TO LCCM-MSG-ID                     DTSCS26
01929         GO TO P8200-EXIT.                                         DTSCS26
01930                                                                   DTSCS26
01931                                                                   DTSCS26
01932      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS26
01933                                                                   DTSCS26
01934      IF LCCM-MSG                                                  DTSCS26
01935         GO TO P8200-EXIT.                                         DTSCS26
01936                                                                   DTSCS26
01937                                                                   DTSCS26
01938 *---------------------------------------------------              DTSCS26
01939 *    BATCH HEADER RECORD MUST EXIST.                              DTSCS26
01940 *---------------------------------------------------              DTSCS26
01941 *****IF WRK-BATCH-NO > +0                                         DTSCS26
01942 ********MOVE +1000 TO WRK-TRAN-MAX                                DTSCS26
01943 **********************WRK-ITEM-MAX                                DTSCS26
01944                                                                   DTSCS26
01945      PERFORM P8910-CHECK-BATCH THRU P8910-EXIT.                   DTSCS26
01946                                                                   DTSCS26
01947      IF LCCM-MSG                                                  DTSCS26
01948         GO TO P8200-EXIT.                                         DTSCS26
01949                                                                   DTSCS26
01950      PERFORM P8210-CONSTRUCT-AADJ THRU P8210-EXIT.                DTSCS26
01951                                                                   DTSCS26
01952      MOVE 'M'                    TO L221-UPDATE-FUNCTION.         DTSCS26
01953      PERFORM S221-WRITE-R906     THRU S221-EXIT.                  DTSCS26
01954                                                                   DTSCS26
01955      MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-ID.                     DTSCS26
01956  P8200-EXIT.                                                      DTSCS26
01957      EXIT.                                                        DTSCS26
01958      EJECT                                                        DTSCS26
01959  P8210-CONSTRUCT-AADJ.                                            DTSCS26
01960      MOVE WRK-BATCH-NO TO AADJ-BATCH-NO.                          DTSCS26
01961                                                                   DTSCS26
01962      MOVE WRK-ITEM-NO TO AADJ-ITEM-NO.                            DTSCS26
01963                                                                   DTSCS26
01964      MOVE AADJ-KEY-AREA TO ASKL-REC.                              DTSCS26
01965                                                                   DTSCS26
01966      PERFORM S823-READ THRU S823-EXIT.                            DTSCS26
01967                                                                   DTSCS26
01968      IF L823-NO-REC-88                                            DTSCS26
01969         MOVE EMSG-NO-DOC TO WRK-MSG-AREA                          DTSCS26
01970         PERFORM S1112-ERROR THRU S1112-EXIT                       DTSCS26
01971         GO TO P8210-EXIT.                                         DTSCS26
01972                                                                   DTSCS26
01973                                                                   DTSCS26
01974      MOVE ASKL-REC TO AADJ-REC.                                   DTSCS26
01975                                                                   DTSCS26
01976                                                                   DTSCS26
01977      MOVE MAP-AMT-AREA TO L011-S-AMT-AREA.                        DTSCS26
01978                                                                   DTSCS26
01979      PERFORM S011-AMT-FROM-SCREEN THRU S011-EXIT.                 DTSCS26
01980                                                                   DTSCS26
01981                                                                   DTSCS26
01982 *****MOVE LCCM-BATCH-NO TO L372-BATCH-NO.                         DTSCS26
01983                                                                   DTSCS26
01984 *****COMPUTE L372-CHNG-KEYED-REMIT-AMT = L011-AMT                 DTSCS26
01985 ***************************************- AADJ-AMT.                DTSCS26
01986                                                                   DTSCS26
01987 *****MOVE +0 TO L372-CHNG-KEYED-ITEM-CNT                          DTSCS26
01988 *************** L372-CHNG-KEYED-TRAN-CNT.                         DTSCS26
01989                                                                   DTSCS26
01990 *****IF*MAP-CHECK-YES-88                                          DTSCS26
01991 ******** MOVE +1 TO L372-CHNG-KEYED-CHECK-CNT                     DTSCS26
01992 ******** MOVE L011-AMT TO L372-CHNG-KEYED-CHECK-AMT               DTSCS26
01993 *****ELSE                                                         DTSCS26
01994 ******** MOVE +0 TO L372-CHNG-KEYED-CHECK-CNT                     DTSCS26
01995 ********            L372-CHNG-KEYED-CHECK-AMT.                    DTSCS26
01996                                                                   DTSCS26
01997 *****IF*AADJ-REMIT-AND-CHECK-88                                   DTSCS26
01998 ******** SUBTRACT 1 FROM L372-CHNG-KEYED-CHECK-CNT                DTSCS26
01999 ******** SUBTRACT AADJ-AMT FROM L372-CHNG-KEYED-CHECK-AMT.        DTSCS26
02000                                                                   DTSCS26
02001 *****PERFORM S372-BATCH-UPDATE THRU S372-EXIT.                    DTSCS26
02002 *****IF*L372-REC-NOT-FOUND                                        DTSCS26
02003 ******** GO TO S899-ABEND.                                        DTSCS26
02004                                                                   DTSCS26
02005      PERFORM P8220-CONSTRUCT-WRK-AREA THRU P8220-EXIT.            DTSCS26
02006                                                                   DTSCS26
02007      PERFORM P8920-CONSTRUCT-AADJ THRU P8920-EXIT.                DTSCS26
02008                                                                   DTSCS26
02009      MOVE AADJ-REC TO ASKL-REC.                                   DTSCS26
02010                                                                   DTSCS26
02011      PERFORM S823-REWRITE THRU S823-EXIT.                         DTSCS26
02012                                                                   DTSCS26
02013      SET WRK-AATH-ACTION-UPD-88   TO TRUE.                        DTSCS26
02014      PERFORM S826-WRITE-ATH       THRU S826-EXIT.                 DTSCS26
02015                                                                   DTSCS26
02016  P8210-EXIT.                                                      DTSCS26
02017      EXIT.                                                        DTSCS26
02018                                                                   DTSCS26
02019                                                                   DTSCS26
02020                                                                   DTSCS26
02021  P8220-CONSTRUCT-WRK-AREA.                                        DTSCS26
02022      MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA.                  DTSCS26
02023                                                                   DTSCS26
02024      PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT.              DTSCS26
02025                                                                   DTSCS26
02026      MOVE L018-EMP-NO TO WRK-EMP-NO.                              DTSCS26
02027                                                                   DTSCS26
02028                                                                   DTSCS26
02029      MOVE MAP-AMT-AREA TO L011-S-AMT-AREA.                        DTSCS26
02030                                                                   DTSCS26
02031      PERFORM S011-AMT-FROM-SCREEN THRU S011-EXIT.                 DTSCS26
02032                                                                   DTSCS26
02033      MOVE L011-AMT TO WRK-AMT.                                    DTSCS26
02034                                                                   DTSCS26
02035                                                                   DTSCS26
02036      MOVE MAP-APPLIC-YRQ-AREA TO L029-S-YRQ-AREA.                 DTSCS26
02037                                                                   DTSCS26
02038      PERFORM S029-YRQ-FROM-SCREEN THRU S029-EXIT.                 DTSCS26
02039                                                                   DTSCS26
02040      MOVE L029-YRQ TO WRK-APPLIC-YRQ.                             DTSCS26
02041                                                                   DTSCS26
02042                                                                   DTSCS26
02043      MOVE MAP-APPLIC-IND TO WRK-APPLIC-IND.                       DTSCS26
02044                                                                   DTSCS26
02045                                                                   DTSCS26
02046      MOVE MAP-APPLIC-DOC-NO-AREA TO L019-S-DOC-NO.                DTSCS26
02047                                                                   DTSCS26
02048      PERFORM S019-BATCH-NO-FROM-SCREEN THRU S019-EXIT.            DTSCS26
02049                                                                   DTSCS26
02050      MOVE L019-DOC-NO TO WRK-APPLIC-DOC-NO.                       DTSCS26
02051                                                                   DTSCS26
02052                                                                   DTSCS26
02053      MOVE MAP-DATE-1-AREA TO L015-S-DATE-AREA.                    DTSCS26
02054                                                                   DTSCS26
02055      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS26
02056                                                                   DTSCS26
02057      IF (MAP-DATE-1-MO = '99')                                    DTSCS26
02058            AND                                                    DTSCS26
02059         (MAP-DATE-1-DA = '99')                                    DTSCS26
02060            AND                                                    DTSCS26
02061         (MAP-DATE-1-YR = '99')                                    DTSCS26
02062          MOVE ALL-NINES-DATE TO WRK-DATE-1                        DTSCS26
02063      ELSE                                                         DTSCS26
02064          MOVE L015-DATE TO WRK-DATE-1.                            DTSCS26
02065                                                                   DTSCS26
02066                                                                   DTSCS26
02067      MOVE MAP-DATE-2-AREA TO L015-S-DATE-AREA.                    DTSCS26
02068                                                                   DTSCS26
02069      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS26
02070                                                                   DTSCS26
02071      IF (MAP-DATE-2-MO = '99')                                    DTSCS26
02072            AND                                                    DTSCS26
02073         (MAP-DATE-2-DA = '99')                                    DTSCS26
02074            AND                                                    DTSCS26
02075         (MAP-DATE-2-YR = '99')                                    DTSCS26
02076          MOVE ALL-NINES-DATE TO WRK-DATE-2                        DTSCS26
02077      ELSE                                                         DTSCS26
02078          MOVE L015-DATE TO WRK-DATE-2.                            DTSCS26
02079                                                                   DTSCS26
02080                                                                   DTSCS26
02081      MOVE MAP-INT-RATE-AREA TO L012-S-RATE-AREA.                  DTSCS26
02082                                                                   DTSCS26
02083      PERFORM S012-RATE-FROM-SCREEN THRU S012-EXIT.                DTSCS26
02084                                                                   DTSCS26
02085      IF L012-NO-ENTRY                                             DTSCS26
02086          SET WRK-INT-NO-ENTRY-88 TO TRUE                          DTSCS26
02087      ELSE                                                         DTSCS26
02088          MOVE L012-RATE TO WRK-INT-RATE.                          DTSCS26
02089                                                                   DTSCS26
02090                                                                   DTSCS26
02091      MOVE MAP-RECEIVED-DATE-AREA TO L015-S-DATE-AREA.             DTSCS26
02092                                                                   DTSCS26
02093      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS26
02094                                                                   DTSCS26
02095      MOVE L015-DATE TO WRK-RECEIVED-DATE.                         DTSCS26
02096  P8220-EXIT.                                                      DTSCS26
02097      EXIT.                                                        DTSCS26
02098                                                                   DTSCS26
02099 /*****************************************************************DTSCS26
02100 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS        *DTSCS26
02101 ******************************************************************DTSCS26
02102                                                                   DTSCS26
02103  P8300-DEL.                                                       DTSCS26
02104      SET LCCM-SCR-INQUIRE TO TRUE.                                DTSCS26
02105                                                                   DTSCS26
02106      PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.              DTSCS26
02107                                                                   DTSCS26
02108      IF LCCM-F12-88                                               DTSCS26
02109         MOVE PMSG-DEL-CANCELED TO LCCM-MSG-ID                     DTSCS26
02110         GO TO P8300-EXIT.                                         DTSCS26
02111                                                                   DTSCS26
02112      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS26
02113                                                                   DTSCS26
02114 *---------------------------------------------------              DTSCS26
02115 *    BATCH HEADER RECORD MUST EXIST                               DTSCS26
02116 *---------------------------------------------------              DTSCS26
02117                                                                   DTSCS26
02118 *****IF WRK-BATCH-NO > +0                                         DTSCS26
02119 ********MOVE +1000 TO WRK-TRAN-MAX                                DTSCS26
02120 **********************WRK-ITEM-MAX.                               DTSCS26
02121                                                                   DTSCS26
02122      PERFORM P8910-CHECK-BATCH THRU P8910-EXIT.                   DTSCS26
02123                                                                   DTSCS26
02124 *****MOVE -99999 TO L372-BATCH-NO.                                DTSCS26
02125                                                                   DTSCS26
02126 *****SET L372-REC-NOT-FOUND TO TRUE.                              DTSCS26
02127                                                                   DTSCS26
02128      IF LCCM-MSG                                                  DTSCS26
02129         GO TO P8300-EXIT.                                         DTSCS26
02130                                                                   DTSCS26
02131                                                                   DTSCS26
02132      MOVE WRK-BATCH-NO TO L371-BATCH-NO.                          DTSCS26
02133                                                                   DTSCS26
02134      MOVE WRK-ITEM-NO TO L371-ITEM-NO.                            DTSCS26
02135                                                                   DTSCS26
02136      PERFORM S371-DELETE THRU S371-EXIT.                          DTSCS26
02137                                                                   DTSCS26
02138      SET WRK-AATH-ACTION-DEL-88   TO TRUE.                        DTSCS26
02139      PERFORM S826-WRITE-ATH       THRU S826-EXIT.                 DTSCS26
02140                                                                   DTSCS26
02141 *&   MOVE 'D'                    TO L221-UPDATE-FUNCTION.         DTSCS26
02142 *&   PERFORM S221-WRITE-R906     THRU S221-EXIT.                  DTSCS26
02143                                                                   DTSCS26
02144      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS26
02145                                                                   DTSCS26
02146      PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.              DTSCS26
02147                                                                   DTSCS26
02148      MOVE LCCM-BATCH-NO TO MAP-BATCH-NO.                          DTSCS26
02149                                                                   DTSCS26
02150      MOVE LCCM-ITEM-NO TO MAP-ITEM-NO.                            DTSCS26
02151                                                                   DTSCS26
02152      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS26
02153                                                                   DTSCS26
02154      MOVE PMSG-DEL-SUCCESSFUL TO LCCM-MSG-ID.                     DTSCS26
02155  P8300-EXIT.                                                      DTSCS26
02156      EXIT.                                                        DTSCS26
02157      EJECT                                                        DTSCS26
02158  P8910-CHECK-BATCH.                                               DTSCS26
02159      MOVE WRK-BATCH-NO TO L372-BATCH-NO.                          DTSCS26
02160                                                                   DTSCS26
02161      PERFORM S372-BATCH-INQUIRY THRU S372-EXIT.                   DTSCS26
02162                                                                   DTSCS26
02163      IF L372-REC-NOT-FOUND                                        DTSCS26
02164          MOVE EMSG-NO-BATCH TO WRK-MSG-AREA                       DTSCS26
02165          PERFORM S1111-ERROR THRU S1111-EXIT                      DTSCS26
02166          GO TO P8910-EXIT.                                        DTSCS26
02167  P8910-EXIT.                                                      DTSCS26
02168      EXIT.                                                        DTSCS26
02169      SKIP3                                                        DTSCS26
02170  P8920-CONSTRUCT-AADJ.                                            DTSCS26
02171      MOVE LOW-VALUES TO AADJ-REC.                                 DTSCS26
02172                                                                   DTSCS26
02173                                                                   DTSCS26
02174      MOVE WRK-BATCH-NO TO AADJ-BATCH-NO.                          DTSCS26
02175                                                                   DTSCS26
02176      MOVE WRK-ITEM-NO TO AADJ-ITEM-NO.                            DTSCS26
02177                                                                   DTSCS26
02178      SET AADJ-ADJ-88 TO TRUE.                                     DTSCS26
02179                                                                   DTSCS26
02180                                                                   DTSCS26
02181 *    DATA HAS BEEN EDITED AND STORED INCLUDING DEFAULTS IN WRK-*  DTSCS26
02182                                                                   DTSCS26
02183      MOVE MAP-NAME-CHECK TO AADJ-NAME-CHECK.                      DTSCS26
02184                                                                   DTSCS26
02185      MOVE WRK-EMP-NO TO AADJ-EMP-NO.                              DTSCS26
02186                                                                   DTSCS26
02187      MOVE MAP-ADJ-TYPE TO AADJ-ADJ-TYPE.                          DTSCS26
02188                                                                   DTSCS26
02189      MOVE WRK-AMT TO AADJ-AMT.                                    DTSCS26
02190                                                                   DTSCS26
02191      MOVE WRK-RECEIVED-DATE TO AADJ-RECEIVED-DATE.                DTSCS26
02192                                                                   DTSCS26
02193      MOVE +0 TO AADJ-DEPOSIT-DATE.                                DTSCS26
02194                                                                   DTSCS26
02195      MOVE WRK-APPLIC-YRQ TO AADJ-APPLIC-YRQ.                      DTSCS26
02196                                                                   DTSCS26
02197      MOVE WRK-APPLIC-IND TO AADJ-APPLIC-IND.                      DTSCS26
02198                                                                   DTSCS26
02199      MOVE WRK-APPLIC-DOC-NO TO AADJ-APPLIC-DOC-NO.                DTSCS26
02200                                                                   DTSCS26
02201      MOVE WRK-DATE-1 TO AADJ-DATE-1.                              DTSCS26
02202                                                                   DTSCS26
02203      MOVE WRK-DATE-2 TO AADJ-DATE-2.                              DTSCS26
02204                                                                   DTSCS26
02205      MOVE MAP-INT-SPAN-IND TO AADJ-INT-SPAN-IND.                  DTSCS26
02206                                                                   DTSCS26
02207      MOVE WRK-INT-RATE TO AADJ-INT-RATE.                          DTSCS26
02208                                                                   DTSCS26
02209      MOVE MAP-DISREGARD-EDITS-IND TO AADJ-DISREGARD-EDITS-IND.    DTSCS26
02210                                                                   DTSCS26
02211      MOVE MAP-RESPONSIBLE-ACTIVITY TO AADJ-RESPONSIBLE-ACTIVITY.  DTSCS26
02212                                                                   DTSCS26
02213      MOVE MAP-RESPONSIBLE-OP-ID TO AADJ-RESPONSIBLE-OP-ID.        DTSCS26
02214                                                                   DTSCS26
02215      IF MAP-CMPRMISE-YES-88                                       DTSCS26
02216         IF LCCM-ENTER-88                                          DTSCS26
02217            MOVE MCMP-ESTB-ABSTIME  TO AADJ-CMP-ESTB-ABSTIME       DTSCS26
02218         END-IF                                                    DTSCS26
02219      ELSE                                                         DTSCS26
02220         MOVE ZERO                  TO AADJ-CMP-ESTB-ABSTIME       DTSCS26
02221      END-IF.                                                      DTSCS26
02222                                                                   DTSCS26
02223      SET AADJ-NOT-PROCESSED-88 TO TRUE.                           DTSCS26
02224  P8920-EXIT.                                                      DTSCS26
02225      EXIT.                                                        DTSCS26
02226 /*****************************************************************DTSCS26
02227 * LINKS TO UTILITY MODULES                                        DTSCS26
02228 ******************************************************************DTSCS26
02229                                                                   DTSCS26
02230                                                                   DTSCS26
02231  S001-FROM-FED-8.                                                 DTSCS26
02232      SET L001-FROM-FED-8 TO TRUE.                                 DTSCS26
02233      GO TO S001-DATE.                                             DTSCS26
02234                                                                   DTSCS26
02235  S001-FROM-ABS-DAY.                                               DTSCS26
02236      SET L001-FROM-ABS-DAY TO TRUE.                               DTSCS26
02237      GO TO S001-DATE.                                             DTSCS26
02238                                                                   DTSCS26
02239  S001-DATE.                                                       DTSCS26
02240      EXEC CICS LINK                                               DTSCS26
02241          PROGRAM('DTSCU001')                                      DTSCS26
02242          COMMAREA(L001-COMM-AREA)                                 DTSCS26
02243      END-EXEC.                                                    DTSCS26
02244  S001-EXIT.                                                       DTSCS26
02245      EXIT.                                                        DTSCS26
02246                                                                   DTSCS26
02247                                                                   DTSCS26
02248                                                                   DTSCS26
02249  S011-AMT-FROM-SCREEN.                                            DTSCS26
02250      MOVE  -999999999.98 TO L011-MIN-AMT                          DTSCS26
02251      MOVE  +999999999.99 TO L011-MAX-AMT                          DTSCS26
02252      GO TO S011-MONEY-FROM-SCREEN.                                DTSCS26
02253                                                                   DTSCS26
02254  S011-MONEY-FROM-SCREEN.                                          DTSCS26
02255      EXEC CICS LINK                                               DTSCS26
02256          PROGRAM('DTSCU011')                                      DTSCS26
02257          COMMAREA(L011-COMM-AREA)                                 DTSCS26
02258      END-EXEC.                                                    DTSCS26
02259  S011-EXIT.                                                       DTSCS26
02260      EXIT.                                                        DTSCS26
02261                                                                   DTSCS26
02262                                                                   DTSCS26
02263                                                                   DTSCS26
02264  S012-RATE-FROM-SCREEN.                                           DTSCS26
02265      EXEC CICS LINK                                               DTSCS26
02266          PROGRAM('DTSCU012')                                      DTSCS26
02267          COMMAREA(L012-COMM-AREA)                                 DTSCS26
02268      END-EXEC.                                                    DTSCS26
02269  S012-EXIT.                                                       DTSCS26
02270      EXIT.                                                        DTSCS26
02271                                                                   DTSCS26
02272                                                                   DTSCS26
02273                                                                   DTSCS26
02274  S015-DATE-FROM-SCREEN.                                           DTSCS26
02275      EXEC CICS LINK                                               DTSCS26
02276          PROGRAM('DTSCU015')                                      DTSCS26
02277          COMMAREA(L015-COMM-AREA)                                 DTSCS26
02278      END-EXEC.                                                    DTSCS26
02279  S015-EXIT.                                                       DTSCS26
02280      EXIT.                                                        DTSCS26
02281                                                                   DTSCS26
02282                                                                   DTSCS26
02283                                                                   DTSCS26
02284  S018-EMP-NO-FROM-SCREEN.                                         DTSCS26
02285      EXEC CICS LINK                                               DTSCS26
02286          PROGRAM('DTSCU018')                                      DTSCS26
02287          COMMAREA(L018-COMM-AREA)                                 DTSCS26
02288      END-EXEC.                                                    DTSCS26
02289  S018-EXIT.                                                       DTSCS26
02290      EXIT.                                                        DTSCS26
02291                                                                   DTSCS26
02292                                                                   DTSCS26
02293                                                                   DTSCS26
02294  S019-BATCH-NO-FROM-SCREEN.                                       DTSCS26
02295      EXEC CICS LINK                                               DTSCS26
02296          PROGRAM('DTSCU019')                                      DTSCS26
02297          COMMAREA(L019-COMM-AREA)                                 DTSCS26
02298      END-EXEC.                                                    DTSCS26
02299  S019-EXIT.                                                       DTSCS26
02300      EXIT.                                                        DTSCS26
02301                                                                   DTSCS26
02302                                                                   DTSCS26
02303                                                                   DTSCS26
02304  S029-YRQ-FROM-SCREEN.                                            DTSCS26
02305      EXEC CICS LINK                                               DTSCS26
02306          PROGRAM  ('DTSCU029')                                    DTSCS26
02307          COMMAREA (L029-COMM-AREA)                                DTSCS26
02308      END-EXEC.                                                    DTSCS26
02309  S029-EXIT.                                                       DTSCS26
02310      EXIT.                                                        DTSCS26
02311                                                                   DTSCS26
02312                                                                   DTSCS26
02313                                                                   DTSCS26
02314  S032-AADJ-APPLIC-IND.                                            DTSCS26
02315      SET L032-AADJ-APPLIC-IND TO TRUE.                            DTSCS26
02316      GO TO S032-LINK.                                             DTSCS26
02317                                                                   DTSCS26
02318  S032-AADJ-ADJ-TYPE.                                              DTSCS26
02319      SET L032-AADJ-ADJ-TYPE TO TRUE.                              DTSCS26
02320      GO TO S032-LINK.                                             DTSCS26
02321                                                                   DTSCS26
02322  S032-AADJ-RESPONSIBLE-ACTIVITY.                                  DTSCS26
02323      SET L032-AADJ-RESPONSIBLE-ACTIVITY TO TRUE.                  DTSCS26
02324      GO TO S032-LINK.                                             DTSCS26
02325                                                                   DTSCS26
02326  S032-LINK.                                                       DTSCS26
02327      EXEC CICS LINK                                               DTSCS26
02328          PROGRAM ('DTSCU032')                                     DTSCS26
02329          COMMAREA (L032-COMM-AREA)                                DTSCS26
02330      END-EXEC.                                                    DTSCS26
02331  S032-EXIT.                                                       DTSCS26
02332      EXIT.                                                        DTSCS26
02333                                                                   DTSCS26
02334                                                                   DTSCS26
02335  S084-APPROVAL.                                                      CL**3
02336      EXEC CICS LINK                                                  CL**3
02337          PROGRAM ('DTSCU084')                                        CL**3
02338          COMMAREA (L084-COMM-AREA)                                   CL**3
02339      END-EXEC.                                                       CL**3
02340                                                                      CL**3
02341      IF L084-FILE-CLOSED-88                                          CL**3
02342         SET LCCM-REQ-SCR-SF-88 TO TRUE                               CL**3
02343         SET LCCM-LINK-SCREEN-88 TO TRUE                              CL**3
02344         GO TO MAINLINE-EXIT.                                         CL**3
02345  S084-EXIT.                                                          CL**3
02346      EXIT.                                                           CL**3
02347                                                                   DTSCS26
02348  S056-DISP1-LEFT.                                                 DTSCS26
02349      SET L056-DISP1-LEFT-88 TO TRUE.                              DTSCS26
02350                                                                   DTSCS26
02351      EXEC CICS LINK                                               DTSCS26
02352          PROGRAM ('DTSCU056')                                     DTSCS26
02353          COMMAREA (L056-COMM-AREA)                                DTSCS26
02354      END-EXEC.                                                    DTSCS26
02355  S056-EXIT.                                                       DTSCS26
02356      EXIT.                                                        DTSCS26
02357                                                                   DTSCS26
02358                                                                   DTSCS26
02359                                                                   DTSCS26
02360  S082-OP-ID-LOOKUP.                                               DTSCS26
02361      EXEC CICS LINK                                               DTSCS26
02362          PROGRAM ('DTSCU082')                                     DTSCS26
02363          COMMAREA (L082-COMM-AREA)                                DTSCS26
02364      END-EXEC.                                                    DTSCS26
02365                                                                   DTSCS26
02366      IF L082-FILE-CLOSED                                          DTSCS26
02367          MOVE L082-MSG-AREA TO LCCM-MSG-AREA                      DTSCS26
02368          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS26
02369          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS26
02370          GO TO MAINLINE-EXIT.                                     DTSCS26
02371  S082-EXIT.                                                       DTSCS26
02372      EXIT.                                                        DTSCS26
02373                                                                   DTSCS26
02374  S221-WRITE-R906.                                                 DTSCS26
02375      MOVE AADJ-EMP-NO           TO L221-EMP-NO.                   DTSCS26
02376      MOVE LCCM-SCR-ABSTIME      TO L221-SCR-ABSTIME.              DTSCS26
02377      MOVE LCCM-TASK-ID          TO L221-UPDATE-TASK-ID.           DTSCS26
02378      MOVE LCCM-OP-ID            TO L221-UPDATE-OP-ID.             DTSCS26
02379      MOVE LCCM-CICS-TERM-ID     TO L221-UPDATE-TERMID.            DTSCS26
02380      MOVE LCCM-TASK-NETNAME     TO L221-UPDATE-NETNAME.           DTSCS26
02381      MOVE LCCM-TASK-START-DATE  TO L221-UPDATE-START-DATE.        DTSCS26
02382      MOVE LCCM-TASK-START-TIME  TO L221-UPDATE-START-TIME.        DTSCS26
02383      MOVE WRK-SCR-ID            TO L221-UPDATE-SCR-ID.            DTSCS26
02384      MOVE AADJ-BATCH-NO         TO L221-BATCH-NO.                 DTSCS26
02385      MOVE AADJ-ITEM-NO          TO L221-ITEM-NO.                  DTSCS26
02386                                                                   DTSCS26
02387      SET L221-R906-ONLY         TO TRUE.                          DTSCS26
02388                                                                   DTSCS26
02389      EXEC CICS LINK                                               DTSCS26
02390          PROGRAM  ('DTSCU221')                                    DTSCS26
02391          COMMAREA (L221-COMM-AREA)                                DTSCS26
02392      END-EXEC.                                                    DTSCS26
02393                                                                   DTSCS26
02394      IF L221-FILE-CLOSED                                          DTSCS26
02395          MOVE L221-MSG-AREA TO LCCM-MSG-AREA                      DTSCS26
02396          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS26
02397          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS26
02398          GO TO MAINLINE-EXIT.                                     DTSCS26
02399                                                                   DTSCS26
02400      IF L221-NOT-OK                                               DTSCS26
02401          MOVE L221-MSG-AREA TO LCCM-MSG-AREA.                     DTSCS26
02402                                                                   DTSCS26
02403  S221-EXIT.                                                       DTSCS26
02404      EXIT.                                                        DTSCS26
02405                                                                   DTSCS26
02406  S371-DELETE.                                                     DTSCS26
02407      EXEC CICS LINK                                               DTSCS26
02408          PROGRAM ('DTSCU371')                                     DTSCS26
02409          COMMAREA (L371-COMM-AREA)                                DTSCS26
02410      END-EXEC.                                                    DTSCS26
02411                                                                   DTSCS26
02412      IF L371-FILE-CLOSED                                          DTSCS26
02413          MOVE L371-MSG-AREA TO LCCM-MSG-AREA                      DTSCS26
02414          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS26
02415          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS26
02416          GO TO MAINLINE-EXIT.                                     DTSCS26
02417  S371-EXIT.                                                       DTSCS26
02418      EXIT.                                                        DTSCS26
02419                                                                   DTSCS26
02420                                                                   DTSCS26
02421                                                                   DTSCS26
02422  S372-BATCH-INQUIRY.                                              DTSCS26
02423      SET L372-INQUIRE TO TRUE.                                    DTSCS26
02424      GO TO S372-LINK.                                             DTSCS26
02425                                                                   DTSCS26
02426  S372-BATCH-UPDATE.                                               DTSCS26
02427      SET L372-UPDATE TO TRUE.                                     DTSCS26
02428      GO TO S372-LINK.                                             DTSCS26
02429                                                                   DTSCS26
02430  S372-LINK.                                                       DTSCS26
02431      EXEC CICS LINK                                               DTSCS26
02432          PROGRAM ('DTSCU372')                                     DTSCS26
02433          COMMAREA (L372-COMM-AREA)                                DTSCS26
02434      END-EXEC.                                                    DTSCS26
02435                                                                   DTSCS26
02436      IF L372-FILE-CLOSED                                          DTSCS26
02437          MOVE L372-MSG-AREA TO LCCM-MSG-AREA                      DTSCS26
02438          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS26
02439          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS26
02440          GO TO MAINLINE-EXIT.                                     DTSCS26
02441  S372-EXIT.                                                       DTSCS26
02442      EXIT.                                                        DTSCS26
02443                                                                   DTSCS26
02444                                                                   DTSCS26
02445                                                                   DTSCS26
02446  S381-LOOKUP-LIABILITY.                                           DTSCS26
02447      EXEC CICS LINK                                               DTSCS26
02448          PROGRAM ('DTSCU381')                                     DTSCS26
02449          COMMAREA (L381-COMM-AREA)                                DTSCS26
02450      END-EXEC.                                                    DTSCS26
02451                                                                   DTSCS26
02452      IF L381-FILE-CLOSED-88                                       DTSCS26
02453          MOVE L381-MSG-AREA TO LCCM-MSG-AREA                      DTSCS26
02454          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS26
02455          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS26
02456          GO TO MAINLINE-EXIT.                                     DTSCS26
02457  S381-EXIT.                                                       DTSCS26
02458      EXIT.                                                        DTSCS26
02459                                                                   DTSCS26
02460                                                                   DTSCS26
02461                                                                   DTSCS26
02462  S410-FILING-SCHEDULE.                                            DTSCS26
02463      SET L410-MODE-INPUT-YRQ-88  TO TRUE.                         DTSCS26
02464                                                                   DTSCS26
02465      EXEC CICS LINK                                               DTSCS26
02466          PROGRAM ('DTSCU410')                                     DTSCS26
02467          COMMAREA (L410-COMM-AREA)                                DTSCS26
02468      END-EXEC.                                                    DTSCS26
02469  S410-EXIT.                                                       DTSCS26
02470      EXIT.                                                        DTSCS26
02471                                                                   DTSCS26
02472  S803-REQ-SCR-ID-EDIT.                                            DTSCS26
02473      EXEC CICS LINK                                               DTSCS26
02474          PROGRAM ('DTSCU803')                                     DTSCS26
02475          COMMAREA (DFHCOMMAREA)                                   DTSCS26
02476      END-EXEC.                                                    DTSCS26
02477  S803-EXIT.                                                       DTSCS26
02478      EXIT.                                                        DTSCS26
02479                                                                   DTSCS26
02480                                                                   DTSCS26
02481                                                                   DTSCS26
02482  S804-INVALID-KEY.                                                DTSCS26
02483      EXEC CICS LINK                                               DTSCS26
02484          PROGRAM ('DTSCU804')                                     DTSCS26
02485          COMMAREA (DFHCOMMAREA)                                   DTSCS26
02486      END-EXEC.                                                    DTSCS26
02487  S804-EXIT.                                                       DTSCS26
02488      EXIT.                                                        DTSCS26
02489                                                                   DTSCS26
02490                                                                   DTSCS26
02491                                                                   DTSCS26
02492  S805-MSG-AREA.                                                   DTSCS26
02493      MOVE LCCM-MSG-AREA TO L805-MSG-AREA                          DTSCS26
02494                                                                   DTSCS26
02495      EXEC CICS LINK                                               DTSCS26
02496          PROGRAM ('DTSCU805')                                     DTSCS26
02497          COMMAREA (L805-COMM-AREA)                                DTSCS26
02498      END-EXEC.                                                    DTSCS26
02499                                                                   DTSCS26
02500      MOVE L805-S-MSG-AREA TO MAP-MSG-AREA.                        DTSCS26
02501  S805-EXIT.                                                       DTSCS26
02502      EXIT.                                                        DTSCS26
02503                                                                   DTSCS26
02504                                                                   DTSCS26
02505                                                                   DTSCS26
02506  S810-READ.                                                       DTSCS26
02507      SET L810-READ-88 TO TRUE.                                    DTSCS26
02508      GO TO S810-IO.                                               DTSCS26
02509                                                                   DTSCS26
02510  S810-START-BROWSE.                                               DTSCS26
02511      SET L810-START-BROWSE-88 TO TRUE.                            DTSCS26
02512      GO TO S810-IO.                                               DTSCS26
02513                                                                   DTSCS26
02514  S810-READ-NEXT.                                                  DTSCS26
02515      SET L810-READ-NEXT-88    TO TRUE.                            DTSCS26
02516      GO TO S810-IO.                                               DTSCS26
02517                                                                   DTSCS26
02518  S810-IO.                                                         DTSCS26
02519                                                                   DTSCS26
02520      EXEC CICS LINK                                               DTSCS26
02521          PROGRAM ('DTSCU810')                                     DTSCS26
02522          COMMAREA (L810-COMM-AREA)                                DTSCS26
02523      END-EXEC.                                                    DTSCS26
02524                                                                   DTSCS26
02525      IF L810-FILE-CLOSED-88                                       DTSCS26
02526          MOVE L810-MSG-AREA TO LCCM-MSG-AREA                      DTSCS26
02527          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS26
02528          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS26
02529          GO TO MAINLINE-EXIT.                                     DTSCS26
02530  S810-EXIT.                                                       DTSCS26
02531      EXIT.                                                        DTSCS26
02532                                                                   DTSCS26
02533                                                                   DTSCS26
02534                                                                   DTSCS26
02535  S823-READ.                                                       DTSCS26
02536      SET L823-READ-88 TO TRUE.                                    DTSCS26
02537      GO TO S823-IO.                                               DTSCS26
02538                                                                   DTSCS26
02539  S823-START-BROWSE.                                               DTSCS26
02540      SET L823-START-BROWSE-88 TO TRUE.                            DTSCS26
02541      GO TO S823-IO.                                               DTSCS26
02542                                                                   DTSCS26
02543  S823-READ-NEXT.                                                  DTSCS26
02544      SET L823-READ-NEXT-88 TO TRUE.                               DTSCS26
02545      GO TO S823-IO.                                               DTSCS26
02546                                                                   DTSCS26
02547  S823-READ-PREV.                                                  DTSCS26
02548      SET L823-READ-PREV-88 TO TRUE.                               DTSCS26
02549      GO TO S823-IO.                                               DTSCS26
02550                                                                   DTSCS26
02551  S823-END-BROWSE.                                                 DTSCS26
02552      SET L823-END-BROWSE-88 TO TRUE.                              DTSCS26
02553      GO TO S823-IO.                                               DTSCS26
02554                                                                   DTSCS26
02555  S823-REWRITE.                                                    DTSCS26
02556      SET L823-REWRITE-88 TO TRUE.                                 DTSCS26
02557      GO TO S823-IO.                                               DTSCS26
02558                                                                   DTSCS26
02559  S823-WRITE.                                                      DTSCS26
02560      SET L823-WRITE-88 TO TRUE.                                   DTSCS26
02561      GO TO S823-IO.                                               DTSCS26
02562                                                                   DTSCS26
02563 *S823-DELETE.                                                     DTSCS26
02564 *****SET L823-DELETE-88 TO TRUE.                                  DTSCS26
02565 *****GO TO S823-IO.                                               DTSCS26
02566                                                                   DTSCS26
02567  S823-IO.                                                         DTSCS26
02568      EXEC CICS LINK                                               DTSCS26
02569          PROGRAM ('DTSCU823')                                     DTSCS26
02570          COMMAREA (L823-COMM-AREA)                                DTSCS26
02571      END-EXEC.                                                    DTSCS26
02572                                                                   DTSCS26
02573      IF L823-FILE-CLOSED-88                                       DTSCS26
02574          MOVE L823-MSG-AREA TO LCCM-MSG-AREA                      DTSCS26
02575          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS26
02576          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS26
02577          GO TO MAINLINE-EXIT.                                     DTSCS26
02578  S823-EXIT.                                                       DTSCS26
02579      EXIT.                                                        DTSCS26
02580                                                                   DTSCS26
02581  S826-WRITE-ATH.                                                  DTSCS26
02582      MOVE LOW-VALUES            TO AATH-REC.                      DTSCS26
02583                                                                   DTSCS26
02584      MOVE WRK-BATCH-NO          TO AATH-BATCH-NO.                 DTSCS26
02585      MOVE WRK-ITEM-NO           TO AATH-ITEM-NO.                  DTSCS26
02586      IF WRK-AATH-ACTION-DEL-88                                    DTSCS26
02587         SET AATH-ADJ-88         TO TRUE                           DTSCS26
02588      ELSE                                                         DTSCS26
02589         MOVE AADJ-DATA-AREA     TO AATH-DATA-AREA                 DTSCS26
02590      END-IF.                                                      DTSCS26
02591      MOVE LCCM-OP-ID            TO AATH-OP-ID.                    DTSCS26
02592      MOVE ZERO                  TO AATH-DATE                      DTSCS26
02593                                    AATH-TIME.                     DTSCS26
02594      MOVE WRK-AATH-ACTION       TO AATH-ACTION.                   DTSCS26
02595                                                                   DTSCS26
02596      EXEC CICS LINK                                               DTSCS26
02597          PROGRAM ('DTSCU826')                                     DTSCS26
02598          COMMAREA (L826-COMM-AREA)                                DTSCS26
02599      END-EXEC.                                                    DTSCS26
02600                                                                   DTSCS26
02601      IF L826-FILE-CLOSED-88                                       DTSCS26
02602          MOVE L826-MSG-AREA TO LCCM-MSG-AREA                      DTSCS26
02603          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS26
02604          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS26
02605          GO TO MAINLINE-EXIT.                                     DTSCS26
02606                                                                   DTSCS26
02607  S826-EXIT.                                                       DTSCS26
02608      EXIT.                                                        DTSCS26
02609                                                                   DTSCS26
02610                                                                   DTSCS26
02611  S851-SCREEN-PROCESSING.                                          DTSCS26
02612      EXEC CICS LINK                                               DTSCS26
02613          PROGRAM ('DTSCU851')                                     DTSCS26
02614          COMMAREA (L851-COMM-AREA)                                DTSCS26
02615      END-EXEC.                                                    DTSCS26
02616  S851-EXIT.                                                       DTSCS26
02617      EXIT.                                                        DTSCS26
02618                                                                   DTSCS26
02619                                                                   DTSCS26
02620                                                                   DTSCS26
02621  S899-ABEND.                                                      DTSCS26
02622      EXEC CICS ABEND                                              DTSCS26
02623          ABCODE(WRK-ABEND-CD)                                     DTSCS26
02624      END-EXEC.                                                    DTSCS26
02625  S899-EXIT.                                                       DTSCS26
02626      EXIT.                                                        DTSCS26
02627                                                                   DTSCS26
02628                                                                   DTSCS26
02629                                                                   DTSCS26
02630 *SOUND-ALARM.                                                     DTSCS26
02631 *****EXEC CICS                                                    DTSCS26
02632 *********SEND                                                     DTSCS26
02633 ************CONTROL                                               DTSCS26
02634 ************ALARM                                                 DTSCS26
02635 *****END-EXEC.                                                    DTSCS26
02636 *SOUND-EXIT.                                                      DTSCS26
02637 *****EXIT.                                                        DTSCS26
02638 /*****************************************************************DTSCS26
02639 *    EDIT THE INFORMATION ON THE SCREEN.                         *DTSCS26
02640 ******************************************************************DTSCS26
02641                                                                   DTSCS26
02642  S1000-SCREEN-EDITS.                                              DTSCS26
02643      PERFORM S1001-INITIALIZE-WRK-AREA THRU S1001-EXIT.           DTSCS26
02644                                                                   DTSCS26
02645                                                                   DTSCS26
02646      PERFORM S1110-BATCH-NO THRU S1110-EXIT.                      DTSCS26
02647                                                                   DTSCS26
02648 *****PERFORM S1120-ITEM-NO THRU S1120-EXIT.                       DTSCS26
02649                                                                   DTSCS26
02650      PERFORM S1150-EMP-NO THRU S1150-EXIT.                           CL**5
02651                                                                      CL**5
02652      PERFORM S1200-ADJ-TYPE THRU S1200-EXIT.                      DTSCS26
02653                                                                   DTSCS26
02654      PERFORM S1220-COMPROMISE THRU S1220-EXIT.                    DTSCS26
02655                                                                   DTSCS26
02656      PERFORM S1300-NAME-CHECK THRU S1300-EXIT.                    DTSCS26
02657                                                                   DTSCS26
02658                                                                   DTSCS26
02659      PERFORM S1500-AMT THRU S1500-EXIT.                           DTSCS26
02660                                                                   DTSCS26
02661      PERFORM S1600-APPLIC-YRQ THRU S1600-EXIT.                    DTSCS26
02662                                                                   DTSCS26
02663      PERFORM S1700-APPLIC-IND THRU S1700-EXIT.                    DTSCS26
02664                                                                   DTSCS26
02665      PERFORM S1800-BATCH-ITEM THRU S1800-EXIT.                    DTSCS26
02666                                                                   DTSCS26
02667      PERFORM S1900-DATE-1 THRU S1900-EXIT.                        DTSCS26
02668                                                                   DTSCS26
02669      PERFORM S2000-DATE-2 THRU S2000-EXIT.                        DTSCS26
02670                                                                   DTSCS26
02671      PERFORM S2100-INT-SPAN THRU S2100-EXIT.                      DTSCS26
02672                                                                   DTSCS26
02673      PERFORM S2200-INT-RATE THRU S2200-EXIT.                      DTSCS26
02674                                                                   DTSCS26
02675      PERFORM S2300-RECEIVED-DATE THRU S2300-EXIT.                 DTSCS26
02676                                                                   DTSCS26
02677      PERFORM S2400-RESPONSIBLE-ACTIVITY THRU S2400-EXIT.          DTSCS26
02678                                                                   DTSCS26
02679      PERFORM S2500-RESPONSIBLE-OP-ID THRU S2500-EXIT.             DTSCS26
02680                                                                   DTSCS26
02681      PERFORM S2600-ENTRY-MODE THRU S2600-EXIT.                    DTSCS26
02682                                                                   DTSCS26
02683      PERFORM S2700-DISREGARD-EDITS-IND THRU S2700-EXIT.           DTSCS26
02684                                                                   DTSCS26
02685      IF LCCM-MSG                                                  DTSCS26
02686         GO TO S1000-EXIT.                                         DTSCS26
02687                                                                   DTSCS26
02688                                                                   DTSCS26
02689      PERFORM S4000-CROSS-EDITS THRU S4000-EXIT.                   DTSCS26
02690  S1000-EXIT.                                                      DTSCS26
02691      EXIT.                                                        DTSCS26
02692      EJECT                                                        DTSCS26
02693  S1001-INITIALIZE-WRK-AREA.                                       DTSCS26
02694      MOVE +0 TO WRK-APPLIC-YRQ.                                   DTSCS26
02695                                                                   DTSCS26
02696      MOVE SPACES TO WRK-APPLIC-IND.                               DTSCS26
02697                                                                   DTSCS26
02698      MOVE NULL-DOC-NO TO WRK-APPLIC-DOC-NO.                       DTSCS26
02699                                                                   DTSCS26
02700      SET WRK-AMT-INVALID-88 TO TRUE.                              DTSCS26
02701                                                                   DTSCS26
02702      SET WRK-INT-NO-ENTRY-88 TO TRUE.                             DTSCS26
02703                                                                   DTSCS26
02704      MOVE +0 TO WRK-RECEIVED-DATE                                 DTSCS26
02705                 WRK-DATE-1                                        DTSCS26
02706                 WRK-DATE-2.                                       DTSCS26
02707  S1001-EXIT.                                                      DTSCS26
02708      EXIT.                                                        DTSCS26
02709                                                                   DTSCS26
02710                                                                   DTSCS26
02711                                                                   DTSCS26
02712  S1100-EDIT-KEY.                                                  DTSCS26
02713      PERFORM S1110-BATCH-NO THRU S1110-EXIT.                      DTSCS26
02714  S1100-EXIT.                                                      DTSCS26
02715      EXIT.                                                        DTSCS26
02716 /*****************************************************************DTSCS26
02717 *                                                                 DTSCS26
02718 ******************************************************************DTSCS26
02719  S1110-BATCH-NO.                                                  DTSCS26
02720      MOVE MAP-DOC-NO-AREA TO L019-S-DOC-NO.                       DTSCS26
02721                                                                   DTSCS26
02722      PERFORM S019-BATCH-NO-FROM-SCREEN THRU S019-EXIT.            DTSCS26
02723                                                                   DTSCS26
02724      IF L019-NO-ENTRY                                             DTSCS26
02725 ********IF LCCM-ENTER-88                                          DTSCS26
02726 ***********GO TO S1110-EXIT                                       DTSCS26
02727 ********ELSE                                                      DTSCS26
02728            MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA               DTSCS26
02729            PERFORM S1111-ERROR THRU S1111-EXIT                    DTSCS26
02730            GO TO S1110-EXIT.                                      DTSCS26
02731                                                                   DTSCS26
02732      IF L019-NOT-VALID                                            DTSCS26
02733         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS26
02734         PERFORM S1111-ERROR THRU S1111-EXIT                       DTSCS26
02735         GO TO S1110-EXIT.                                         DTSCS26
02736                                                                   DTSCS26
02737      MOVE L019-BATCH-NO TO WRK-BATCH-NO.                          DTSCS26
02738                                                                   DTSCS26
02739      MOVE L019-ITEM-NO TO WRK-ITEM-NO.                            DTSCS26
02740  S1110-EXIT.                                                      DTSCS26
02741      EXIT.                                                        DTSCS26
02742                                                                   DTSCS26
02743                                                                   DTSCS26
02744                                                                   DTSCS26
02745  S1111-ERROR.                                                     DTSCS26
02746      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-BATCH-NO-A.           DTSCS26
02747                                                                   DTSCS26
02748      IF LCCM-NO-MSG                                               DTSCS26
02749         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS26
02750         MOVE CATB-CURSOR TO MAP-BATCH-NO-L                        DTSCS26
02751         SET CURSOR-SET-YES TO TRUE.                               DTSCS26
02752  S1111-EXIT.                                                      DTSCS26
02753      EXIT.                                                        DTSCS26
02754                                                                   DTSCS26
02755                                                                   DTSCS26
02756                                                                   DTSCS26
02757  S1112-ERROR.                                                     DTSCS26
02758      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-ITEM-NO-A.            DTSCS26
02759                                                                   DTSCS26
02760      IF LCCM-NO-MSG                                               DTSCS26
02761         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS26
02762         MOVE CATB-CURSOR TO MAP-ITEM-NO-L                         DTSCS26
02763         SET CURSOR-SET-YES TO TRUE.                               DTSCS26
02764  S1112-EXIT.                                                      DTSCS26
02765      EXIT.                                                        DTSCS26
02766                                                                   DTSCS26
02767                                                                   DTSCS26
02768                                                                   DTSCS26
02769 *S1120-ITEM-NO.                                                   DTSCS26
02770 *****IF LCCM-ENTER-88                                             DTSCS26
02771 ********IF MAP-ITEM-NO = SPACES OR LOW-VALUES                     DTSCS26
02772 ************NEXT SENTENCE                                         DTSCS26
02773 ********ELSE                                                      DTSCS26
02774 ************MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA           DTSCS26
02775 ************PERFORM S1112-ERROR THRU S1112-EXIT.                  DTSCS26
02776 *S1120-EXIT.                                                      DTSCS26
02777 *****EXIT.                                                        DTSCS26
02778  S1150-EMP-NO.                                                       CL**5
02779      SET WRK-PENDING-MCMP-NO-88   TO TRUE.                           CL**5
02780                                                                      CL**5
02781      MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA.                     CL**5
02782                                                                      CL**5
02783      PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT.                 CL**5
02784                                                                      CL**5
02785      IF L018-NO-ENTRY                                                CL**5
02786            OR L018-NOT-VALID                                         CL**5
02787         MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER                       CL**5
02788         MOVE 'EMP NO' TO WRK-MSG-TEXT                                CL**5
02789         PERFORM S1401-ERROR THRU S1401-EXIT                          CL**5
02790         GO TO S1150-EXIT.                                            CL**5
02791                                                                      CL**5
02792      MOVE L018-EMP-NO TO WRK-EMP-NO.                                 CL**5
02793                                                                      CL**5
02794      PERFORM S1410-READ-MPRF THRU S1410-EXIT.                        CL**5
02795                                                                      CL**5
02796      IF MAP-CMPRMISE-YES-88                                          CL**5
02797         PERFORM S1420-FIND-MCMP  THRU S1420-EXIT                     CL**5
02798      END-IF.                                                         CL**5
02799                                                                      CL**5
02800  S1150-EXIT.                                                         CL**5
02801      EXIT.                                                           CL**5
02802                                                                      CL**5
02803 /*****************************************************************DTSCS26
02804 *                                                                 DTSCS26
02805 ******************************************************************DTSCS26
02806  S1200-ADJ-TYPE.                                                  DTSCS26
02807      INSPECT MAP-ADJ-TYPE                                         DTSCS26
02808         CONVERTING LOW-VALUES TO SPACES.                          DTSCS26
02809                                                                   DTSCS26
02810      MOVE SPACES TO AADJ-ADJ-TYPE.                                DTSCS26
02811                                                                   DTSCS26
02812      IF MAP-ADJ-TYPE = SPACES                                     DTSCS26
02813         MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER                    DTSCS26
02814         MOVE 'RPT/PAY/ADJ TYPE' TO WRK-MSG-TEXT                   DTSCS26
02815         PERFORM S1201-ERROR THRU S1201-EXIT                       DTSCS26
02816         GO TO S1200-EXIT.                                         DTSCS26
02817                                                                   DTSCS26
02818      MOVE MAP-ADJ-TYPE TO L032-CD-2.                              DTSCS26
02819                                                                   DTSCS26
02820      PERFORM S032-AADJ-ADJ-TYPE THRU S032-EXIT.                   DTSCS26
02821                                                                   DTSCS26
02822      IF L032-VALID                                                DTSCS26
02823         MOVE MAP-ADJ-TYPE TO AADJ-ADJ-TYPE                        DTSCS26
02824         IF AADJ-WRITE-OFF-88                                         CL**3
02825         OR AADJ-WRITE-OFF-REV-88                                     CL**3
02826          PERFORM S2111-WRITE-OFF  THRU S2111-EXIT                    CL**4
02827           IF L084-VALID-APPROVAL-88                                  CL**3
02828             GO TO S1200-EXIT                                      DTSCS26
02829           ELSE                                                    DTSCS26
02830            MOVE 'SUPERVISOR APPROVAL NEEDED  ' TO WRK-MSG-TEXT       CL**7
02831            PERFORM S1201-ERROR THRU S1201-EXIT                    DTSCS26
02832            GO TO S1200-EXIT                                       DTSCS26
02833           END-IF                                                  DTSCS26
02834         ELSE                                                      DTSCS26
02835            GO TO S1200-EXIT                                       DTSCS26
02836         END-IF.                                                   DTSCS26
02837                                                                   DTSCS26
02838      MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER.                      DTSCS26
02839                                                                   DTSCS26
02840      MOVE 'RPT/PAY/ADJ TYPE' TO WRK-MSG-TEXT.                     DTSCS26
02841                                                                   DTSCS26
02842      PERFORM S1201-ERROR THRU S1201-EXIT.                         DTSCS26
02843  S1200-EXIT.                                                      DTSCS26
02844      EXIT.                                                        DTSCS26
02845                                                                   DTSCS26
02846                                                                   DTSCS26
02847                                                                   DTSCS26
02848  S1201-ERROR.                                                     DTSCS26
02849      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ADJ-TYPE-A.            DTSCS26
02850                                                                   DTSCS26
02851      IF LCCM-NO-MSG                                               DTSCS26
02852         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS26
02853         MOVE CATB-CURSOR TO MAP-ADJ-TYPE-L                        DTSCS26
02854         SET CURSOR-SET-YES TO TRUE.                               DTSCS26
02855  S1201-EXIT.                                                      DTSCS26
02856      EXIT.                                                        DTSCS26
02857                                                                   DTSCS26
02858  S1220-COMPROMISE.                                                DTSCS26
02859      IF LCCM-OP-IS-FLD-DESK-88                                    DTSCS26
02860      OR LCCM-OP-IS-ACCOUNTING-DESK-88                             DTSCS26
02861         NEXT SENTENCE                                             DTSCS26
02862      ELSE                                                         DTSCS26
02863         SET MAP-CMPRMISE-NO-88  TO TRUE                           DTSCS26
02864         GO TO S1220-EXIT                                          DTSCS26
02865      END-IF.                                                      DTSCS26
02866                                                                   DTSCS26
02867      INSPECT MAP-CMPRMISE-IND                                     DTSCS26
02868         CONVERTING LOW-VALUES TO SPACES.                          DTSCS26
02869                                                                   DTSCS26
02870      IF MAP-CMPRMISE-IND = SPACES                                 DTSCS26
02871         SET MAP-CMPRMISE-NO-88  TO TRUE                           DTSCS26
02872      ELSE                                                         DTSCS26
02873         IF MAP-CMPRMISE-VALID-88                                  DTSCS26
02874            NEXT SENTENCE                                          DTSCS26
02875         ELSE                                                      DTSCS26
02876            MOVE MSG-E26E-AREA TO WRK-MSG-AREA                     DTSCS26
02877            PERFORM S1221-ERROR THRU S1221-EXIT                    DTSCS26
02878         END-IF                                                    DTSCS26
02879      END-IF.                                                      DTSCS26
02880                                                                   DTSCS26
02881  S1220-EXIT.                                                      DTSCS26
02882      EXIT.                                                        DTSCS26
02883                                                                   DTSCS26
02884  S1221-ERROR.                                                     DTSCS26
02885      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-CMPRMISE-IND-A.        DTSCS26
02886                                                                   DTSCS26
02887      IF LCCM-NO-MSG                                               DTSCS26
02888         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS26
02889         MOVE CATB-CURSOR TO MAP-CMPRMISE-IND-L                    DTSCS26
02890         SET CURSOR-SET-YES TO TRUE.                               DTSCS26
02891  S1221-EXIT.                                                      DTSCS26
02892      EXIT.                                                        DTSCS26
02893                                                                   DTSCS26
02894 /*****************************************************************DTSCS26
02895 *                                                                 DTSCS26
02896 ******************************************************************DTSCS26
02897  S1300-NAME-CHECK.                                                DTSCS26
02898      IF MAP-NAME-CHECK = LOW-VALUES OR SPACES                     DTSCS26
02899         MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER                    DTSCS26
02900         MOVE 'NAME' TO WRK-MSG-TEXT                               DTSCS26
02901         PERFORM S1301-ERROR THRU S1301-EXIT                       DTSCS26
02902      ELSE                                                         DTSCS26
02903         NEXT SENTENCE.                                            DTSCS26
02904  S1300-EXIT.                                                      DTSCS26
02905      EXIT.                                                        DTSCS26
02906                                                                   DTSCS26
02907                                                                   DTSCS26
02908                                                                   DTSCS26
02909  S1301-ERROR.                                                     DTSCS26
02910      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-NAME-CHECK-A.          DTSCS26
02911                                                                   DTSCS26
02912      IF LCCM-NO-MSG                                               DTSCS26
02913         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS26
02914         MOVE CATB-CURSOR TO MAP-NAME-CHECK-L                      DTSCS26
02915         SET CURSOR-SET-YES TO TRUE.                               DTSCS26
02916  S1301-EXIT.                                                      DTSCS26
02917      EXIT.                                                        DTSCS26
02918 /*****************************************************************DTSCS26
02919 *                                                                 DTSCS26
02920 ******************************************************************DTSCS26
02921                                                                      CL**5
02922                                                                      CL**5
02923  S1401-ERROR.                                                        CL**5
02924      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A               CL**5
02925                                         MAP-EMP-NO-2-A.              CL**5
02926                                                                      CL**5
02927      IF LCCM-NO-MSG                                                  CL**5
02928         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                           CL**5
02929         MOVE CATB-CURSOR TO MAP-EMP-NO-1-L                           CL**5
02930         SET CURSOR-SET-YES TO TRUE.                                  CL**5
02931  S1401-EXIT.                                                         CL**5
02932      EXIT.                                                           CL**5
02933                                                                      CL**5
02934                                                                   DTSCS26
02935                                                                   DTSCS26
02936  S1410-READ-MPRF.                                                 DTSCS26
02937      MOVE LOW-VALUES TO MPRF-KEY-AREA.                            DTSCS26
02938                                                                   DTSCS26
02939      MOVE WRK-EMP-NO TO MPRF-EMP-NO.                              DTSCS26
02940                                                                   DTSCS26
02941      SET MPRF-PRF-88 TO TRUE.                                     DTSCS26
02942                                                                   DTSCS26
02943      MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS26
02944                                                                   DTSCS26
02945      PERFORM S810-READ THRU S810-EXIT.                            DTSCS26
02946                                                                   DTSCS26
02947      IF L810-NO-REC-88                                            DTSCS26
02948         MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA                     DTSCS26
02949         PERFORM S1401-ERROR THRU S1401-EXIT                       DTSCS26
02950         GO TO S1410-EXIT.                                         DTSCS26
02951                                                                   DTSCS26
02952      MOVE MSKL-REC TO MPRF-REC.                                   DTSCS26
02953                                                                   DTSCS26
02954      MOVE WRK-EMP-NO TO LCCM-EMP-NO.                              DTSCS26
02955                                                                   DTSCS26
02956      IF MPRF-PURGE-ALL-YES-88                                     DTSCS26
02957         MOVE EMSG-EMP-MARKED-FOR-PURGE TO WRK-MSG-AREA            DTSCS26
02958         PERFORM S1401-ERROR THRU S1401-EXIT                       DTSCS26
02959         GO TO S1410-EXIT.                                         DTSCS26
02960                                                                   DTSCS26
02961      IF MAP-NAME-CHECK = LOW-VALUES OR SPACES                     DTSCS26
02962          NEXT SENTENCE                                            DTSCS26
02963      ELSE                                                         DTSCS26
02964      IF (MPRF-PRIMARY-NAME (1:4) = MAP-NAME-CHECK)                DTSCS26
02965              OR                                                   DTSCS26
02966         (MPRF-ENTITY-NAME (1:4) = MAP-NAME-CHECK)                 DTSCS26
02967          NEXT SENTENCE                                            DTSCS26
02968      ELSE                                                         DTSCS26
02969          MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER                   DTSCS26
02970          MOVE 'NAME' TO WRK-MSG-TEXT                              DTSCS26
02971          PERFORM S1301-ERROR THRU S1301-EXIT                      DTSCS26
02972          PERFORM S1401-ERROR THRU S1401-EXIT.                     DTSCS26
02973  S1410-EXIT.                                                      DTSCS26
02974      EXIT.                                                        DTSCS26
02975                                                                   DTSCS26
02976  S1420-FIND-MCMP.                                                 DTSCS26
02977      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSCS26
02978      MOVE WRK-EMP-NO TO MSKL-EMP-NO.                              DTSCS26
02979      SET MSKL-CMP-88 TO TRUE.                                     DTSCS26
02980      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS26
02981      IF L810-NO-REC-88                                            DTSCS26
02982         MOVE MSG-E26F-AREA TO WRK-MSG-AREA                        DTSCS26
02983         PERFORM S1401-ERROR THRU S1401-EXIT                       DTSCS26
02984      ELSE                                                         DTSCS26
02985         PERFORM                                                   DTSCS26
02986           UNTIL L810-NO-REC-88                                    DTSCS26
02987           OR    WRK-PENDING-MCMP-YES-88                           DTSCS26
02988             MOVE MSKL-REC                 TO MCMP-REC             DTSCS26
02989             IF MCMP-STATUS-PENDING-88                             DTSCS26
02990                SET WRK-PENDING-MCMP-YES-88 TO TRUE                DTSCS26
02991             ELSE                                                  DTSCS26
02992                PERFORM S810-READ-NEXT     THRU S810-EXIT          DTSCS26
02993             END-IF                                                DTSCS26
02994         END-PERFORM                                               DTSCS26
02995         IF WRK-PENDING-MCMP-NO-88                                 DTSCS26
02996            MOVE MSG-E26F-AREA TO WRK-MSG-AREA                     DTSCS26
02997            PERFORM S1401-ERROR THRU S1401-EXIT                    DTSCS26
02998         END-IF                                                    DTSCS26
02999      END-IF.                                                      DTSCS26
03000                                                                   DTSCS26
03001  S1420-EXIT.                                                      DTSCS26
03002      EXIT.                                                        DTSCS26
03003                                                                   DTSCS26
03004 /*****************************************************************DTSCS26
03005 *                                                                 DTSCS26
03006 ******************************************************************DTSCS26
03007  S1500-AMT.                                                       DTSCS26
03008      MOVE MAP-AMT-AREA TO L011-S-AMT-AREA                         DTSCS26
03009                                                                   DTSCS26
03010      PERFORM S011-AMT-FROM-SCREEN THRU S011-EXIT.                 DTSCS26
03011                                                                   DTSCS26
03012      IF L011-NO-ENTRY                                             DTSCS26
03013         MOVE +0 TO WRK-AMT                                        DTSCS26
03014                    MAP-AMT-N                                      DTSCS26
03015      ELSE                                                         DTSCS26
03016      IF L011-EXCEEDS-MIN-MAX                                      DTSCS26
03017           OR L011-NOT-VALID                                       DTSCS26
03018         MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER                    DTSCS26
03019         MOVE 'REMIT/CHECK/ADJ AMT' TO WRK-MSG-TEXT                DTSCS26
03020         PERFORM S1501-ERROR THRU S1501-EXIT                       DTSCS26
03021         GO TO S1500-EXIT                                          DTSCS26
03022      ELSE                                                         DTSCS26
03023          MOVE L011-AMT TO MAP-AMT-N                               DTSCS26
03024                           WRK-AMT.                                DTSCS26
03025                                                                   DTSCS26
03026      PERFORM S1510-AMT-ADJ-TYPE-EDITS THRU S1510-EXIT.            DTSCS26
03027  S1500-EXIT.                                                      DTSCS26
03028      EXIT.                                                        DTSCS26
03029                                                                   DTSCS26
03030                                                                   DTSCS26
03031                                                                   DTSCS26
03032  S1501-ERROR.                                                     DTSCS26
03033      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-AMT-A.                DTSCS26
03034                                                                   DTSCS26
03035      IF LCCM-NO-MSG                                               DTSCS26
03036         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS26
03037         MOVE CATB-CURSOR TO MAP-AMT-L                             DTSCS26
03038         SET CURSOR-SET-YES TO TRUE.                               DTSCS26
03039  S1501-EXIT.                                                      DTSCS26
03040      EXIT.                                                        DTSCS26
03041                                                                   DTSCS26
03042                                                                   DTSCS26
03043                                                                   DTSCS26
03044  S1510-AMT-ADJ-TYPE-EDITS.                                        DTSCS26
03045      IF AADJ-ADJ-TYPE = SPACES                                    DTSCS26
03046          GO TO S1510-EXIT.                                        DTSCS26
03047                                                                   DTSCS26
03048      IF AADJ-CHARGE-88 OR AADJ-WAIVE-88 OR AADJ-TOLER-88          DTSCS26
03049         OR AADJ-WRITE-OFF-88                                         CL*10
03050          IF WRK-AMT = +0                                          DTSCS26
03051              MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER               DTSCS26
03052              MOVE 'REMIT/ADJ AMT}{RPT/PAY/ADJ TYPE'               DTSCS26
03053                TO WRK-MSG-TEXT                                    DTSCS26
03054              PERFORM S1501-ERROR THRU S1501-EXIT                  DTSCS26
03055              PERFORM S1201-ERROR THRU S1201-EXIT                  DTSCS26
03056          ELSE                                                     DTSCS26
03057              NEXT SENTENCE                                        DTSCS26
03058      ELSE                                                         DTSCS26
03059          IF WRK-AMT = +0                                          DTSCS26
03060              NEXT SENTENCE                                        DTSCS26
03061          ELSE                                                     DTSCS26
03062              MOVE EMSG-C-VALIDATE    TO WRK-MSG-NUMBER            DTSCS26
03063              MOVE 'REMIT/ADJ AMT}{RPT/PAY/ADJ TYPE'               DTSCS26
03064                TO WRK-MSG-TEXT                                    DTSCS26
03065              PERFORM S1501-ERROR THRU S1501-EXIT                  DTSCS26
03066              PERFORM S1201-ERROR THRU S1201-EXIT.                 DTSCS26
03067  S1510-EXIT.                                                      DTSCS26
03068      EXIT.                                                        DTSCS26
03069 /*****************************************************************DTSCS26
03070 *                                                                 DTSCS26
03071 ******************************************************************DTSCS26
03072  S1600-APPLIC-YRQ.                                                DTSCS26
03073      MOVE MAP-APPLIC-YRQ-AREA TO L029-S-YRQ-AREA.                 DTSCS26
03074                                                                   DTSCS26
03075      PERFORM S029-YRQ-FROM-SCREEN THRU S029-EXIT.                 DTSCS26
03076                                                                   DTSCS26
03077      IF L029-NO-ENTRY                                             DTSCS26
03078         NEXT SENTENCE                                             DTSCS26
03079      ELSE                                                         DTSCS26
03080      IF L029-NOT-VALID                                            DTSCS26
03081         MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER                    DTSCS26
03082         MOVE 'YEAR/QUARTER' TO WRK-MSG-TEXT                       DTSCS26
03083         PERFORM S1601-ERROR THRU S1601-EXIT                       DTSCS26
03084         GO TO S1600-EXIT.                                         DTSCS26
03085                                                                   DTSCS26
03086      MOVE L029-YRQ TO WRK-APPLIC-YRQ                              DTSCS26
03087                       LCCM-YRQ.                                   DTSCS26
03088                                                                   DTSCS26
03089      PERFORM S1610-YRQ-ADJ-TYPE-EDITS THRU S1610-EXIT.            DTSCS26
03090  S1600-EXIT.                                                      DTSCS26
03091      EXIT.                                                        DTSCS26
03092                                                                   DTSCS26
03093                                                                   DTSCS26
03094                                                                   DTSCS26
03095  S1601-ERROR.                                                     DTSCS26
03096      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-APPLIC-YRQ-YR-A        DTSCS26
03097                                        MAP-APPLIC-YRQ-Q-A.        DTSCS26
03098                                                                   DTSCS26
03099      IF LCCM-NO-MSG                                               DTSCS26
03100         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS26
03101         MOVE CATB-CURSOR TO MAP-APPLIC-YRQ-YR-L                   DTSCS26
03102         SET CURSOR-SET-YES TO TRUE.                               DTSCS26
03103  S1601-EXIT.                                                      DTSCS26
03104      EXIT.                                                        DTSCS26
03105                                                                   DTSCS26
03106                                                                   DTSCS26
03107                                                                   DTSCS26
03108  S1610-YRQ-ADJ-TYPE-EDITS.                                        DTSCS26
03109      IF AADJ-ADJ-TYPE = SPACES                                    DTSCS26
03110          GO TO S1610-EXIT.                                        DTSCS26
03111                                                                   DTSCS26
03112      IF (AADJ-WRITE-OFF-88 OR AADJ-WRITE-OFF-REV-88)              DTSCS26
03113            OR                                                     DTSCS26
03114         ((AADJ-TOLER-88) AND (MAP-APPLIC-IND = 'CR'))             DTSCS26
03115          IF WRK-APPLIC-YRQ = +0                                   DTSCS26
03116              NEXT SENTENCE                                        DTSCS26
03117          ELSE                                                     DTSCS26
03118              MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER               DTSCS26
03119              MOVE 'YEAR/QUARTER}{RPT/PAY/ADJ TYPE'                DTSCS26
03120                TO WRK-MSG-TEXT                                    DTSCS26
03121              PERFORM S1601-ERROR THRU S1601-EXIT                  DTSCS26
03122              PERFORM S1201-ERROR THRU S1201-EXIT                  DTSCS26
03123      ELSE                                                         DTSCS26
03124          IF WRK-APPLIC-YRQ = +0                                   DTSCS26
03125              MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER               DTSCS26
03126              MOVE 'YEAR/QUARTER}{RPT/PAY/ADJ TYPE'                DTSCS26
03127                TO WRK-MSG-TEXT                                    DTSCS26
03128              PERFORM S1601-ERROR THRU S1601-EXIT                  DTSCS26
03129              PERFORM S1201-ERROR THRU S1201-EXIT                  DTSCS26
03130          ELSE                                                     DTSCS26
03131              NEXT SENTENCE.                                       DTSCS26
03132                                                                   DTSCS26
03133      IF MAP-CMPRMISE-YES-88                                       DTSCS26
03134         PERFORM S1611-CHK-QTRS   THRU S1611-EXIT                  DTSCS26
03135      END-IF.                                                      DTSCS26
03136                                                                   DTSCS26
03137  S1610-EXIT.                                                      DTSCS26
03138      EXIT.                                                        DTSCS26
03139                                                                   DTSCS26
03140  S1611-CHK-QTRS.                                                  DTSCS26
03141      SET WRK-YRQ-NOT-FOUND-88  TO TRUE.                           DTSCS26
03142      PERFORM                                                      DTSCS26
03143        VARYING MCMP-COV-IDX                                       DTSCS26
03144        FROM +1 BY +1                                              DTSCS26
03145        UNTIL MCMP-COV-IDX > MCMP-COV-CNT                          DTSCS26
03146           IF WRK-APPLIC-YRQ = MCMP-COVERED-YRQ (MCMP-COV-IDX)     DTSCS26
03147              SET WRK-YRQ-OK-88  TO TRUE                           DTSCS26
03148           END-IF                                                  DTSCS26
03149      END-PERFORM.                                                 DTSCS26
03150                                                                   DTSCS26
03151      IF WRK-YRQ-NOT-FOUND-88                                      DTSCS26
03152         MOVE MSG-E26G-AREA TO WRK-MSG-AREA                        DTSCS26
03153         PERFORM S1601-ERROR THRU S1601-EXIT                       DTSCS26
03154      END-IF.                                                      DTSCS26
03155                                                                   DTSCS26
03156  S1611-EXIT.                                                      DTSCS26
03157      EXIT.                                                        DTSCS26
03158 /*****************************************************************DTSCS26
03159 *                                                                 DTSCS26
03160 ******************************************************************DTSCS26
03161  S1700-APPLIC-IND.                                                DTSCS26
03162      INSPECT MAP-APPLIC-IND                                       DTSCS26
03163          CONVERTING LOW-VALUES TO SPACES.                         DTSCS26
03164                                                                   DTSCS26
03165      IF MAP-APPLIC-IND = SPACES                                   DTSCS26
03166         NEXT SENTENCE                                             DTSCS26
03167      ELSE                                                         DTSCS26
03168          MOVE MAP-APPLIC-IND TO L032-CD-2                         DTSCS26
03169          PERFORM S032-AADJ-APPLIC-IND THRU S032-EXIT              DTSCS26
03170          IF NOT L032-VALID                                        DTSCS26
03171             MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA             DTSCS26
03172             PERFORM S1701-ERROR THRU S1701-EXIT                   DTSCS26
03173             GO TO S1700-EXIT.                                     DTSCS26
03174                                                                   DTSCS26
03175      MOVE MAP-APPLIC-IND TO WRK-APPLIC-IND.                       DTSCS26
03176                                                                   DTSCS26
03177      PERFORM S1710-IND-ADJ-TYPE-EDITS THRU S1710-EXIT.            DTSCS26
03178  S1700-EXIT.                                                      DTSCS26
03179      EXIT.                                                        DTSCS26
03180                                                                   DTSCS26
03181                                                                   DTSCS26
03182                                                                   DTSCS26
03183  S1701-ERROR.                                                     DTSCS26
03184      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-APPLIC-IND-A.          DTSCS26
03185                                                                   DTSCS26
03186      IF LCCM-NO-MSG                                               DTSCS26
03187         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS26
03188         MOVE CATB-CURSOR TO MAP-APPLIC-IND-L                      DTSCS26
03189         SET CURSOR-SET-YES TO TRUE.                               DTSCS26
03190  S1701-EXIT.                                                      DTSCS26
03191      EXIT.                                                        DTSCS26
03192                                                                   DTSCS26
03193                                                                   DTSCS26
03194                                                                   DTSCS26
03195  S1710-IND-ADJ-TYPE-EDITS.                                        DTSCS26
03196      IF AADJ-ADJ-TYPE = SPACES                                    DTSCS26
03197          GO TO S1710-EXIT.                                        DTSCS26
03198                                                                   DTSCS26
03199      IF AADJ-CHARGE-88                                            DTSCS26
03200          IF MAP-APPLIC-IND = 'UI' OR 'I ' OR 'LP' OR 'NP' OR 'MP' DTSCS26
03201                              OR 'SU'                              DTSCS26
03202              NEXT SENTENCE                                        DTSCS26
03203          ELSE                                                     DTSCS26
03204              MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER               DTSCS26
03205              MOVE 'RPT/PAY/ADJ TYPE' TO WRK-MSG-TEXT              DTSCS26
03206              PERFORM S1701-ERROR THRU S1701-EXIT                  DTSCS26
03207              PERFORM S1201-ERROR THRU S1201-EXIT                  DTSCS26
03208      ELSE                                                         DTSCS26
03209      IF AADJ-WAIVE-88                                             DTSCS26
03210          IF MAP-APPLIC-IND = 'I ' OR 'LP' OR 'NP' OR 'MP'         DTSCS26
03211              NEXT SENTENCE                                        DTSCS26
03212          ELSE                                                     DTSCS26
03213              IF MAP-APPLIC-IND = 'UI'                             DTSCS26
03214              AND MAP-CMPRMISE-YES-88                              DTSCS26
03215                 NEXT SENTENCE                                     DTSCS26
03216              ELSE                                                 DTSCS26
03217                 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER            DTSCS26
03218                 MOVE 'RPT/PAY/ADJ TYPE' TO WRK-MSG-TEXT           DTSCS26
03219                 PERFORM S1701-ERROR THRU S1701-EXIT               DTSCS26
03220                 PERFORM S1201-ERROR THRU S1201-EXIT               DTSCS26
03221              END-IF                                               DTSCS26
03222          END-IF                                                   DTSCS26
03223      ELSE                                                         DTSCS26
03224      IF AADJ-TOLER-88                                             DTSCS26
03225          IF MAP-APPLIC-IND  = SPACES                              DTSCS26
03226              MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER               DTSCS26
03227              MOVE 'RPT/PAY/ADJ TYPE' TO WRK-MSG-TEXT              DTSCS26
03228              PERFORM S1701-ERROR THRU S1701-EXIT                  DTSCS26
03229              PERFORM S1201-ERROR THRU S1201-EXIT                  DTSCS26
03230          ELSE                                                     DTSCS26
03231              NEXT SENTENCE                                        DTSCS26
03232      ELSE                                                         DTSCS26
03233      IF AADJ-AUTO-88 OR AADJ-MANUAL-88 OR AADJ-WAIVE-DATE-88      DTSCS26
03234          IF MAP-APPLIC-IND = 'I ' OR 'LP' OR 'PI'                 DTSCS26
03235              NEXT SENTENCE                                        DTSCS26
03236          ELSE                                                     DTSCS26
03237              MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER               DTSCS26
03238              MOVE 'RPT/PAY/ADJ TYPE' TO WRK-MSG-TEXT              DTSCS26
03239              PERFORM S1701-ERROR THRU S1701-EXIT                  DTSCS26
03240              PERFORM S1201-ERROR THRU S1201-EXIT                  DTSCS26
03241      ELSE                                                         DTSCS26
03242      IF AADJ-INT-DATE-88                                          DTSCS26
03243          IF MAP-APPLIC-IND = 'I '                                 DTSCS26
03244              NEXT SENTENCE                                        DTSCS26
03245          ELSE                                                     DTSCS26
03246              MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER               DTSCS26
03247              MOVE 'RPT/PAY/ADJ TYPE' TO WRK-MSG-TEXT              DTSCS26
03248              PERFORM S1701-ERROR THRU S1701-EXIT                  DTSCS26
03249              PERFORM S1201-ERROR THRU S1201-EXIT                  DTSCS26
03250      ELSE                                                         DTSCS26
03251      IF MAP-APPLIC-IND = SPACE                                    DTSCS26
03252          NEXT SENTENCE                                            DTSCS26
03253      ELSE                                                         DTSCS26
03254          MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER                   DTSCS26
03255          MOVE 'RPT/PAY/ADJ TYPE' TO WRK-MSG-TEXT                  DTSCS26
03256          PERFORM S1701-ERROR THRU S1701-EXIT                      DTSCS26
03257          PERFORM S1201-ERROR THRU S1201-EXIT.                     DTSCS26
03258  S1710-EXIT.                                                      DTSCS26
03259      EXIT.                                                        DTSCS26
03260 /*****************************************************************DTSCS26
03261 *                                                                 DTSCS26
03262 ******************************************************************DTSCS26
03263  S1800-BATCH-ITEM.                                                DTSCS26
03264      MOVE MAP-APPLIC-DOC-NO-AREA TO L019-S-DOC-NO.                DTSCS26
03265                                                                   DTSCS26
03266      PERFORM S019-BATCH-NO-FROM-SCREEN THRU S019-EXIT.            DTSCS26
03267                                                                   DTSCS26
03268      IF L019-NO-ENTRY                                             DTSCS26
03269            NEXT SENTENCE                                          DTSCS26
03270      ELSE                                                         DTSCS26
03271      IF L019-NOT-VALID                                            DTSCS26
03272         MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER                    DTSCS26
03273         MOVE 'APPLIC DOC NO' TO WRK-MSG-TEXT                      DTSCS26
03274         PERFORM S1801-ERROR THRU S1801-EXIT                       DTSCS26
03275         PERFORM S1802-ERROR THRU S1802-EXIT                       DTSCS26
03276         GO TO S1800-EXIT                                          DTSCS26
03277      ELSE                                                         DTSCS26
03278      IF L019-ITEM-NO = +0                                         DTSCS26
03279         MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA                  DTSCS26
03280         PERFORM S1802-ERROR THRU S1802-EXIT                       DTSCS26
03281         GO TO S1800-EXIT                                          DTSCS26
03282      ELSE                                                         DTSCS26
03283         MOVE L019-DOC-NO TO WRK-APPLIC-DOC-NO.                    DTSCS26
03284                                                                   DTSCS26
03285      PERFORM S1810-DOC-NO-ADJ-TYPE-EDITS THRU S1810-EXIT.         DTSCS26
03286  S1800-EXIT.                                                      DTSCS26
03287      EXIT.                                                        DTSCS26
03288                                                                   DTSCS26
03289                                                                   DTSCS26
03290                                                                   DTSCS26
03291  S1801-ERROR.                                                     DTSCS26
03292      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-APPLIC-BATCH-NO-A.    DTSCS26
03293                                                                   DTSCS26
03294      IF LCCM-NO-MSG                                               DTSCS26
03295         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS26
03296         MOVE CATB-CURSOR TO MAP-APPLIC-BATCH-NO-L                 DTSCS26
03297         SET CURSOR-SET-YES TO TRUE.                               DTSCS26
03298  S1801-EXIT.                                                      DTSCS26
03299      EXIT.                                                        DTSCS26
03300                                                                   DTSCS26
03301                                                                   DTSCS26
03302                                                                   DTSCS26
03303  S1802-ERROR.                                                     DTSCS26
03304      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-APPLIC-ITEM-NO-A.     DTSCS26
03305                                                                   DTSCS26
03306      IF LCCM-NO-MSG                                               DTSCS26
03307         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS26
03308         MOVE CATB-CURSOR TO MAP-APPLIC-ITEM-NO-L                  DTSCS26
03309         SET CURSOR-SET-YES TO TRUE.                               DTSCS26
03310  S1802-EXIT.                                                      DTSCS26
03311      EXIT.                                                        DTSCS26
03312                                                                   DTSCS26
03313                                                                   DTSCS26
03314                                                                   DTSCS26
03315  S1810-DOC-NO-ADJ-TYPE-EDITS.                                     DTSCS26
03316      IF AADJ-ADJ-TYPE = SPACES                                    DTSCS26
03317          GO TO S1810-EXIT.                                        DTSCS26
03318                                                                   DTSCS26
03319      IF ((AADJ-TOLER-88) AND (WRK-APPLIC-IND = 'CR'))             DTSCS26
03320          IF WRK-APPLIC-DOC-NO = NULL-DOC-NO                       DTSCS26
03321              MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER               DTSCS26
03322              MOVE 'RPT/PAY/ADJ TYPE}{APPLIC DOC NO'               DTSCS26
03323                TO WRK-MSG-TEXT                                    DTSCS26
03324              PERFORM S1801-ERROR THRU S1801-EXIT                  DTSCS26
03325              PERFORM S1802-ERROR THRU S1802-EXIT                  DTSCS26
03326              PERFORM S1701-ERROR THRU S1701-EXIT                  DTSCS26
03327              PERFORM S1201-ERROR THRU S1201-EXIT                  DTSCS26
03328          ELSE                                                     DTSCS26
03329              NEXT SENTENCE                                        DTSCS26
03330      ELSE                                                         DTSCS26
03331          IF WRK-APPLIC-DOC-NO = NULL-DOC-NO                       DTSCS26
03332              NEXT SENTENCE                                        DTSCS26
03333          ELSE                                                     DTSCS26
03334              MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER               DTSCS26
03335              MOVE 'RPT/PAY/ADJ TYPE}{APPLIC DOC NO'               DTSCS26
03336                TO WRK-MSG-TEXT                                    DTSCS26
03337              PERFORM S1801-ERROR THRU S1801-EXIT                  DTSCS26
03338              PERFORM S1802-ERROR THRU S1802-EXIT                  DTSCS26
03339              PERFORM S1201-ERROR THRU S1201-EXIT.                 DTSCS26
03340  S1810-EXIT.                                                      DTSCS26
03341      EXIT.                                                        DTSCS26
03342 /*****************************************************************DTSCS26
03343 *                                                                 DTSCS26
03344 ******************************************************************DTSCS26
03345  S1900-DATE-1.                                                    DTSCS26
03346      IF (MAP-DATE-1-MO = '99')                                    DTSCS26
03347           AND (MAP-DATE-1-DA = '99')                              DTSCS26
03348           AND (MAP-DATE-1-YR = '99')                              DTSCS26
03349          MOVE ALL-NINES-DATE TO WRK-DATE-1                        DTSCS26
03350      ELSE                                                         DTSCS26
03351          MOVE MAP-DATE-1-AREA TO L015-S-DATE-AREA                 DTSCS26
03352          PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT             DTSCS26
03353          IF L015-NO-ENTRY                                         DTSCS26
03354              NEXT SENTENCE                                        DTSCS26
03355          ELSE                                                     DTSCS26
03356          IF L015-NOT-VALID                                        DTSCS26
03357              MOVE EMSG-FIELD-NOT-VALID  TO WRK-MSG-AREA           DTSCS26
03358              PERFORM S1901-ERROR THRU S1901-EXIT                  DTSCS26
03359              GO TO S1900-EXIT                                     DTSCS26
03360          ELSE                                                     DTSCS26
03361              MOVE L015-DATE TO WRK-DATE-1.                        DTSCS26
03362                                                                   DTSCS26
03363      PERFORM S1910-DATE-1-ADJ-TYPE-EDIT THRU S1910-EXIT.          DTSCS26
03364  S1900-EXIT.                                                      DTSCS26
03365      EXIT.                                                        DTSCS26
03366                                                                   DTSCS26
03367                                                                   DTSCS26
03368                                                                   DTSCS26
03369  S1901-ERROR.                                                     DTSCS26
03370      MOVE CATB-UNPROT-NORM-NUM-MDTON                              DTSCS26
03371        TO MAP-DATE-1-MO-A                                         DTSCS26
03372           MAP-DATE-1-DA-A                                         DTSCS26
03373           MAP-DATE-1-YR-A.                                        DTSCS26
03374                                                                   DTSCS26
03375      IF LCCM-NO-MSG                                               DTSCS26
03376         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS26
03377         MOVE CATB-CURSOR TO MAP-DATE-1-MO-L                       DTSCS26
03378         SET CURSOR-SET-YES TO TRUE.                               DTSCS26
03379  S1901-EXIT.                                                      DTSCS26
03380      EXIT.                                                        DTSCS26
03381                                                                   DTSCS26
03382                                                                   DTSCS26
03383                                                                   DTSCS26
03384  S1910-DATE-1-ADJ-TYPE-EDIT.                                      DTSCS26
03385      IF AADJ-ADJ-TYPE = SPACES                                    DTSCS26
03386          GO TO S1910-EXIT.                                        DTSCS26
03387                                                                   DTSCS26
03388      IF AADJ-DUE-DATE-88                                          DTSCS26
03389          NEXT SENTENCE                                            DTSCS26
03390      ELSE                                                         DTSCS26
03391      IF AADJ-WAIVE-DATE-88 OR AADJ-INT-DATE-88                    DTSCS26
03392          IF WRK-DATE-1 = +0                                       DTSCS26
03393              MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER               DTSCS26
03394              MOVE 'SPAN INFORMATION' TO WRK-MSG-TEXT              DTSCS26
03395              PERFORM S1901-ERROR THRU S1901-EXIT                  DTSCS26
03396          ELSE                                                     DTSCS26
03397              NEXT SENTENCE                                        DTSCS26
03398      ELSE                                                         DTSCS26
03399      IF AADJ-WRITE-OFF-88                                         DTSCS26
03400          IF WRK-DATE-1 = +0                                       DTSCS26
03401              MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA             DTSCS26
03402              PERFORM S1901-ERROR THRU S1901-EXIT                  DTSCS26
03403          ELSE                                                     DTSCS26
03404          IF WRK-DATE-1 = ALL-NINES-DATE                           DTSCS26
03405              MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA            DTSCS26
03406              PERFORM S1901-ERROR THRU S1901-EXIT                  DTSCS26
03407          ELSE                                                     DTSCS26
03408              NEXT SENTENCE                                        DTSCS26
03409      ELSE                                                         DTSCS26
03410          IF WRK-DATE-1 = +0                                       DTSCS26
03411              NEXT SENTENCE                                        DTSCS26
03412          ELSE                                                     DTSCS26
03413              MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER               DTSCS26
03414              MOVE 'RPT/PAY/ADJ TYPE}{SPAN INFORMATION'            DTSCS26
03415                TO WRK-MSG-TEXT                                    DTSCS26
03416              PERFORM S1901-ERROR THRU S1901-EXIT                  DTSCS26
03417              PERFORM S1201-ERROR THRU S1201-EXIT.                 DTSCS26
03418  S1910-EXIT.                                                      DTSCS26
03419      EXIT.                                                        DTSCS26
03420 /*****************************************************************DTSCS26
03421 *                                                                 DTSCS26
03422 ******************************************************************DTSCS26
03423  S2000-DATE-2.                                                    DTSCS26
03424      IF (MAP-DATE-2-MO = '99')                                    DTSCS26
03425           AND (MAP-DATE-2-DA = '99')                              DTSCS26
03426           AND (MAP-DATE-2-YR = '99')                              DTSCS26
03427          MOVE ALL-NINES-DATE TO WRK-DATE-2                        DTSCS26
03428      ELSE                                                         DTSCS26
03429          MOVE MAP-DATE-2-AREA TO L015-S-DATE-AREA                 DTSCS26
03430          PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT             DTSCS26
03431          IF L015-NO-ENTRY                                         DTSCS26
03432              NEXT SENTENCE                                        DTSCS26
03433          ELSE                                                     DTSCS26
03434          IF L015-NOT-VALID                                        DTSCS26
03435              MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA            DTSCS26
03436              PERFORM S2001-ERROR THRU S2001-EXIT                  DTSCS26
03437              GO TO S2000-EXIT                                     DTSCS26
03438          ELSE                                                     DTSCS26
03439              MOVE L015-DATE TO WRK-DATE-2.                        DTSCS26
03440                                                                   DTSCS26
03441      PERFORM S2010-DATE-2-ADJ-TYPE-EDIT THRU S2010-EXIT.          DTSCS26
03442                                                                   DTSCS26
03443      PERFORM S2020-DATE-1-DATE-2-EDIT THRU S2020-EXIT.            DTSCS26
03444  S2000-EXIT.                                                      DTSCS26
03445      EXIT.                                                        DTSCS26
03446                                                                   DTSCS26
03447                                                                   DTSCS26
03448                                                                   DTSCS26
03449  S2001-ERROR.                                                     DTSCS26
03450      MOVE CATB-UNPROT-NORM-NUM-MDTON                              DTSCS26
03451        TO MAP-DATE-2-MO-A                                         DTSCS26
03452           MAP-DATE-2-DA-A                                         DTSCS26
03453           MAP-DATE-2-YR-A.                                        DTSCS26
03454                                                                   DTSCS26
03455      IF LCCM-NO-MSG                                               DTSCS26
03456         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS26
03457         MOVE CATB-CURSOR TO MAP-DATE-2-MO-L                       DTSCS26
03458         SET CURSOR-SET-YES TO TRUE.                               DTSCS26
03459  S2001-EXIT.                                                      DTSCS26
03460      EXIT.                                                        DTSCS26
03461                                                                   DTSCS26
03462                                                                   DTSCS26
03463                                                                   DTSCS26
03464  S2010-DATE-2-ADJ-TYPE-EDIT.                                      DTSCS26
03465      IF AADJ-ADJ-TYPE = SPACES                                    DTSCS26
03466          GO TO S2010-EXIT.                                        DTSCS26
03467                                                                   DTSCS26
03468      IF AADJ-DUE-DATE-88                                          DTSCS26
03469          NEXT SENTENCE                                            DTSCS26
03470      ELSE                                                         DTSCS26
03471      IF AADJ-WAIVE-DATE-88 OR AADJ-INT-DATE-88                    DTSCS26
03472          IF WRK-DATE-2 = +0                                       DTSCS26
03473              MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER               DTSCS26
03474              MOVE 'SPAN INFORMATION' TO WRK-MSG-TEXT              DTSCS26
03475              PERFORM S2001-ERROR THRU S2001-EXIT                  DTSCS26
03476          ELSE                                                     DTSCS26
03477              NEXT SENTENCE                                        DTSCS26
03478      ELSE                                                         DTSCS26
03479          IF WRK-DATE-2 = +0                                       DTSCS26
03480              NEXT SENTENCE                                        DTSCS26
03481          ELSE                                                     DTSCS26
03482              MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER               DTSCS26
03483              MOVE 'RPT/PAY/ADJ TYPE}{SPAN INFORMATION'            DTSCS26
03484                TO WRK-MSG-TEXT                                    DTSCS26
03485              PERFORM S2001-ERROR THRU S2001-EXIT                  DTSCS26
03486              PERFORM S1201-ERROR THRU S1201-EXIT.                 DTSCS26
03487  S2010-EXIT.                                                      DTSCS26
03488      EXIT.                                                        DTSCS26
03489                                                                   DTSCS26
03490                                                                   DTSCS26
03491                                                                   DTSCS26
03492  S2020-DATE-1-DATE-2-EDIT.                                        DTSCS26
03493      IF AADJ-ADJ-TYPE = SPACES                                    DTSCS26
03494          GO TO S2020-EXIT.                                        DTSCS26
03495                                                                   DTSCS26
03496      IF (MAP-DATE-1-MO-A = CATB-UNPROT-NORM-NUM-MDTON)            DTSCS26
03497            OR                                                     DTSCS26
03498         (MAP-DATE-2-MO-A = CATB-UNPROT-NORM-NUM-MDTON)            DTSCS26
03499          GO TO S2020-EXIT.                                        DTSCS26
03500                                                                   DTSCS26
03501      IF AADJ-DUE-DATE-88                                          DTSCS26
03502          IF ((WRK-DATE-1 = +0) AND (WRK-DATE-2 = +0))             DTSCS26
03503              MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER               DTSCS26
03504              MOVE 'SPAN INFORMATION' TO WRK-MSG-TEXT              DTSCS26
03505              PERFORM S1901-ERROR THRU S1901-EXIT                  DTSCS26
03506              PERFORM S2001-ERROR THRU S2001-EXIT                  DTSCS26
03507              GO TO S2020-EXIT                                     DTSCS26
03508          ELSE                                                     DTSCS26
03509              GO TO S2020-EXIT.                                    DTSCS26
03510                                                                   DTSCS26
03511      IF AADJ-WAIVE-DATE-88 OR AADJ-INT-DATE-88                    DTSCS26
03512          NEXT SENTENCE                                            DTSCS26
03513      ELSE                                                         DTSCS26
03514          GO TO S2020-EXIT.                                        DTSCS26
03515                                                                   DTSCS26
03516      IF WRK-DATE-2 < WRK-DATE-1                                   DTSCS26
03517          MOVE EMSG-C-VALIDATE  TO WRK-MSG-NUMBER                  DTSCS26
03518          MOVE 'SPAN INFORMATION' TO WRK-MSG-TEXT                  DTSCS26
03519          PERFORM S1901-ERROR THRU S1901-EXIT                      DTSCS26
03520          PERFORM S2001-ERROR THRU S2001-EXIT                      DTSCS26
03521          GO TO S2020-EXIT.                                        DTSCS26
03522                                                                   DTSCS26
03523      IF WRK-DATE-1 = ALL-NINES-DATE                               DTSCS26
03524          IF WRK-DATE-2 = ALL-NINES-DATE                           DTSCS26
03525              NEXT SENTENCE                                        DTSCS26
03526          ELSE                                                     DTSCS26
03527              MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER               DTSCS26
03528              MOVE 'SPAN INFORMATION' TO WRK-MSG-TEXT              DTSCS26
03529              PERFORM S1901-ERROR THRU S1901-EXIT                  DTSCS26
03530              PERFORM S2001-ERROR THRU S2001-EXIT                  DTSCS26
03531              GO TO S2020-EXIT                                     DTSCS26
03532      ELSE                                                         DTSCS26
03533          IF WRK-DATE-2 = ALL-NINES-DATE                           DTSCS26
03534              MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER               DTSCS26
03535              MOVE 'SPAN INFORMATION' TO WRK-MSG-TEXT              DTSCS26
03536              PERFORM S1901-ERROR THRU S1901-EXIT                  DTSCS26
03537              PERFORM S2001-ERROR THRU S2001-EXIT                  DTSCS26
03538              GO TO S2020-EXIT                                     DTSCS26
03539          ELSE                                                     DTSCS26
03540              NEXT SENTENCE.                                       DTSCS26
03541  S2020-EXIT.                                                      DTSCS26
03542      EXIT.                                                        DTSCS26
03543 /*****************************************************************DTSCS26
03544 *                                                                 DTSCS26
03545 ******************************************************************DTSCS26
03546  S2100-INT-SPAN.                                                  DTSCS26
03547      IF MAP-INT-SPAN-IND = LOW-VALUES                             DTSCS26
03548          MOVE SPACES TO MAP-INT-SPAN-IND.                         DTSCS26
03549                                                                   DTSCS26
03550      IF MAP-INT-SPAN-IND = SPACES                                 DTSCS26
03551         NEXT SENTENCE                                             DTSCS26
03552      ELSE                                                         DTSCS26
03553      IF NOT MAP-INT-SPAN-IND-VALID                                DTSCS26
03554         MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER                    DTSCS26
03555         MOVE 'SPAN INFORMATION' TO WRK-MSG-TEXT                   DTSCS26
03556         PERFORM S2101-ERROR THRU S2101-EXIT                       DTSCS26
03557         GO TO S2100-EXIT.                                         DTSCS26
03558                                                                   DTSCS26
03559      PERFORM S2110-INT-SPAN-ADJ-TYPE-EDIT THRU S2110-EXIT.        DTSCS26
03560  S2100-EXIT.                                                      DTSCS26
03561      EXIT.                                                        DTSCS26
03562                                                                   DTSCS26
03563                                                                   DTSCS26
03564                                                                   DTSCS26
03565  S2101-ERROR.                                                     DTSCS26
03566      MOVE CATB-UNPROT-NORM-AN-MDTON                               DTSCS26
03567        TO MAP-INT-SPAN-IND-A.                                     DTSCS26
03568                                                                   DTSCS26
03569      IF LCCM-NO-MSG                                               DTSCS26
03570         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS26
03571         MOVE CATB-CURSOR TO MAP-INT-SPAN-IND-L                    DTSCS26
03572         SET CURSOR-SET-YES TO TRUE.                               DTSCS26
03573  S2101-EXIT.                                                      DTSCS26
03574      EXIT.                                                        DTSCS26
03575                                                                   DTSCS26
03576                                                                   DTSCS26
03577                                                                   DTSCS26
03578  S2110-INT-SPAN-ADJ-TYPE-EDIT.                                    DTSCS26
03579      IF AADJ-ADJ-TYPE = SPACES                                    DTSCS26
03580          GO TO S2110-EXIT.                                        DTSCS26
03581                                                                   DTSCS26
03582      IF AADJ-INT-DATE-88                                          DTSCS26
03583          IF MAP-INT-SPAN-IND = SPACES                             DTSCS26
03584              MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER               DTSCS26
03585              MOVE 'RPT/PAY/ADJ TYPE}{SPAN INFORMATION'            DTSCS26
03586                TO WRK-MSG-TEXT                                    DTSCS26
03587              PERFORM S2101-ERROR THRU S2101-EXIT                  DTSCS26
03588              PERFORM S1201-ERROR THRU S1201-EXIT                  DTSCS26
03589          ELSE                                                     DTSCS26
03590              NEXT SENTENCE                                        DTSCS26
03591      ELSE                                                         DTSCS26
03592          IF MAP-INT-SPAN-IND = SPACE                              DTSCS26
03593              NEXT SENTENCE                                        DTSCS26
03594          ELSE                                                     DTSCS26
03595              MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER               DTSCS26
03596              MOVE 'RPT/PAY/ADJ TYPE}{SPAN INFORMATION'            DTSCS26
03597                TO WRK-MSG-TEXT                                    DTSCS26
03598              PERFORM S2101-ERROR THRU S2101-EXIT                  DTSCS26
03599              PERFORM S1201-ERROR THRU S1201-EXIT.                 DTSCS26
03600  S2110-EXIT.                                                      DTSCS26
03601      EXIT.                                                        DTSCS26
03602 /*****************************************************************   CL**3
03603 *                                                                    CL**3
03604 ******************************************************************   CL**3
03605  S2111-WRITE-OFF.                                                    CL**3
03606        MOVE WRK-EMP-NO           TO L084-EMP-NO.                     CL**3
03607        MOVE LCCM-CURR-RUN-DATE   TO L084-CURR-RUN-DATE.              CL**3
03608        SET L084-WRITE-OFF-88     TO TRUE.                            CL**3
03609        PERFORM S084-APPROVAL     THRU S084-EXIT.                     CL**3
03610  S2111-EXIT.                                                         CL**3
03611      EXIT.                                                           CL**3
03612 /*****************************************************************DTSCS26
03613 *                                                                 DTSCS26
03614 ******************************************************************DTSCS26
03615  S2200-INT-RATE.                                                  DTSCS26
03616      MOVE MAP-INT-RATE-AREA TO L012-S-RATE-AREA.                  DTSCS26
03617                                                                   DTSCS26
03618      PERFORM S012-RATE-FROM-SCREEN THRU S012-EXIT.                DTSCS26
03619                                                                   DTSCS26
03620      IF L012-NO-ENTRY                                             DTSCS26
03621         NEXT SENTENCE                                             DTSCS26
03622      ELSE                                                         DTSCS26
03623      IF L012-NOT-VALID                                            DTSCS26
03624         MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER                    DTSCS26
03625         MOVE 'SPAN INFORMATION' TO WRK-MSG-TEXT                   DTSCS26
03626         PERFORM S2201-ERROR THRU S2201-EXIT                       DTSCS26
03627         GO TO S2200-EXIT                                          DTSCS26
03628      ELSE                                                         DTSCS26
03629         MOVE L012-RATE TO L056-RATE                               DTSCS26
03630         PERFORM S056-DISP1-LEFT THRU S056-EXIT                    DTSCS26
03631         MOVE L056-DISP-RATE TO MAP-INT-RATE                       DTSCS26
03632         MOVE L012-RATE TO WRK-INT-RATE.                           DTSCS26
03633                                                                   DTSCS26
03634      PERFORM S2210-INT-RATE-ADJ-TYPE-EDIT THRU S2210-EXIT.        DTSCS26
03635  S2200-EXIT.                                                      DTSCS26
03636      EXIT.                                                        DTSCS26
03637                                                                   DTSCS26
03638                                                                   DTSCS26
03639                                                                   DTSCS26
03640  S2201-ERROR.                                                     DTSCS26
03641      MOVE CATB-UNPROT-NORM-NUM-MDTON                              DTSCS26
03642        TO MAP-INT-RATE-A.                                         DTSCS26
03643                                                                   DTSCS26
03644      IF LCCM-NO-MSG                                               DTSCS26
03645         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS26
03646         MOVE CATB-CURSOR TO MAP-INT-RATE-L                        DTSCS26
03647         SET CURSOR-SET-YES TO TRUE.                               DTSCS26
03648  S2201-EXIT.                                                      DTSCS26
03649      EXIT.                                                        DTSCS26
03650                                                                   DTSCS26
03651                                                                   DTSCS26
03652                                                                   DTSCS26
03653  S2210-INT-RATE-ADJ-TYPE-EDIT.                                    DTSCS26
03654      IF AADJ-ADJ-TYPE = SPACES                                    DTSCS26
03655          GO TO S2210-EXIT.                                        DTSCS26
03656                                                                   DTSCS26
03657      IF AADJ-INT-DATE-88                                          DTSCS26
03658          IF WRK-DATE-1 = ALL-NINES-DATE                           DTSCS26
03659              IF WRK-INT-NO-ENTRY-88                               DTSCS26
03660                  NEXT SENTENCE                                    DTSCS26
03661              ELSE                                                 DTSCS26
03662                  MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER           DTSCS26
03663                  MOVE 'SPAN INFORMATION' TO WRK-MSG-TEXT          DTSCS26
03664                  PERFORM S2201-ERROR THRU S2201-EXIT              DTSCS26
03665                  PERFORM S1901-ERROR THRU S1901-EXIT              DTSCS26
03666          ELSE                                                     DTSCS26
03667              IF WRK-INT-NO-ENTRY-88                               DTSCS26
03668                  MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER           DTSCS26
03669                  MOVE 'RPT/PAY/ADJ TYPE}{SPAN INFORMATION'        DTSCS26
03670                    TO WRK-MSG-TEXT                                DTSCS26
03671                  PERFORM S2201-ERROR THRU S2201-EXIT              DTSCS26
03672                  PERFORM S1201-ERROR THRU S1201-EXIT              DTSCS26
03673              ELSE                                                 DTSCS26
03674                  NEXT SENTENCE                                    DTSCS26
03675      ELSE                                                         DTSCS26
03676          IF WRK-INT-NO-ENTRY-88                                   DTSCS26
03677              NEXT SENTENCE                                        DTSCS26
03678          ELSE                                                     DTSCS26
03679              MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER               DTSCS26
03680              MOVE 'SPAN INFORMATION' TO WRK-MSG-TEXT              DTSCS26
03681              PERFORM S2201-ERROR THRU S2201-EXIT                  DTSCS26
03682              PERFORM S1901-ERROR THRU S1901-EXIT.                 DTSCS26
03683  S2210-EXIT.                                                      DTSCS26
03684      EXIT.                                                        DTSCS26
03685 /*****************************************************************DTSCS26
03686 *                                                                 DTSCS26
03687 ******************************************************************DTSCS26
03688  S2300-RECEIVED-DATE.                                             DTSCS26
03689      MOVE MAP-RECEIVED-DATE-AREA TO L015-S-DATE-AREA.             DTSCS26
03690                                                                   DTSCS26
03691      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS26
03692                                                                   DTSCS26
03693      IF L015-NO-ENTRY                                             DTSCS26
03694         NEXT SENTENCE                                             DTSCS26
03695      ELSE                                                         DTSCS26
03696      IF L015-NOT-VALID                                            DTSCS26
03697          MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER                   DTSCS26
03698          MOVE 'RECEIVED DATE' TO WRK-MSG-TEXT                     DTSCS26
03699          PERFORM S2301-ERROR THRU S2301-EXIT                      DTSCS26
03700      ELSE                                                         DTSCS26
03701          MOVE L015-DATE TO WRK-RECEIVED-DATE.                     DTSCS26
03702  S2300-EXIT.                                                      DTSCS26
03703      EXIT.                                                        DTSCS26
03704                                                                   DTSCS26
03705                                                                   DTSCS26
03706                                                                   DTSCS26
03707  S2301-ERROR.                                                     DTSCS26
03708      MOVE CATB-UNPROT-NORM-NUM-MDTON                              DTSCS26
03709        TO MAP-RECEIVED-DATE-MO-A                                  DTSCS26
03710           MAP-RECEIVED-DATE-DA-A                                  DTSCS26
03711           MAP-RECEIVED-DATE-YR-A.                                 DTSCS26
03712                                                                   DTSCS26
03713      IF LCCM-NO-MSG                                               DTSCS26
03714         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS26
03715         MOVE CATB-CURSOR TO MAP-RECEIVED-DATE-MO-L                DTSCS26
03716         SET CURSOR-SET-YES TO TRUE.                               DTSCS26
03717  S2301-EXIT.                                                      DTSCS26
03718      EXIT.                                                        DTSCS26
03719 /*****************************************************************DTSCS26
03720 *                                                                 DTSCS26
03721 ******************************************************************DTSCS26
03722  S2400-RESPONSIBLE-ACTIVITY.                                      DTSCS26
03723      IF MAP-RESPONSIBLE-ACTIVITY = SPACES OR LOW-VALUES           DTSCS26
03724          SET MAP-RESP-ACTIVITY-VOL-88 TO TRUE.                    DTSCS26
03725                                                                   DTSCS26
03726      IF MAP-RESP-ACTIVITY-VOL-88                                  DTSCS26
03727          GO TO S2400-EXIT.                                        DTSCS26
03728                                                                   DTSCS26
03729      MOVE MAP-RESPONSIBLE-ACTIVITY TO L032-CD-3.                  DTSCS26
03730                                                                   DTSCS26
03731      PERFORM S032-AADJ-RESPONSIBLE-ACTIVITY THRU S032-EXIT.       DTSCS26
03732                                                                   DTSCS26
03733      IF L032-VALID                                                DTSCS26
03734          NEXT SENTENCE                                            DTSCS26
03735      ELSE                                                         DTSCS26
03736          MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER                   DTSCS26
03737          MOVE 'RESPONSIBLE ACTIVITY' TO WRK-MSG-TEXT              DTSCS26
03738          PERFORM S2401-ERROR THRU S2401-EXIT                      DTSCS26
03739          GO TO S2400-EXIT.                                        DTSCS26
03740  S2400-EXIT.                                                      DTSCS26
03741      EXIT.                                                        DTSCS26
03742                                                                   DTSCS26
03743                                                                   DTSCS26
03744                                                                   DTSCS26
03745  S2401-ERROR.                                                     DTSCS26
03746      MOVE CATB-UNPROT-NORM-AN-MDTON                               DTSCS26
03747        TO MAP-RESPONSIBLE-ACTIVITY-A.                             DTSCS26
03748                                                                   DTSCS26
03749      IF LCCM-NO-MSG                                               DTSCS26
03750          MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                       DTSCS26
03751          MOVE CATB-CURSOR TO MAP-RESPONSIBLE-ACTIVITY-L           DTSCS26
03752          SET CURSOR-SET-YES TO TRUE.                              DTSCS26
03753  S2401-EXIT.                                                      DTSCS26
03754      EXIT.                                                        DTSCS26
03755 /*****************************************************************DTSCS26
03756 *                                                                 DTSCS26
03757 ******************************************************************DTSCS26
03758  S2500-RESPONSIBLE-OP-ID.                                         DTSCS26
03759      IF MAP-RESPONSIBLE-OP-ID = SPACES OR LOW-VALUES              DTSCS26
03760          MOVE SPACES TO MAP-RESPONSIBLE-OP-ID                     DTSCS26
03761          GO TO S2500-EXIT.                                        DTSCS26
03762                                                                   DTSCS26
03763      IF MAP-RESP-ACTIVITY-VOL-88                                  DTSCS26
03764          MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER                   DTSCS26
03765          MOVE 'RESPONSIBLE ACT/OPID' TO WRK-MSG-TEXT              DTSCS26
03766          PERFORM S2401-ERROR THRU S2401-EXIT                      DTSCS26
03767          PERFORM S2501-ERROR THRU S2501-EXIT                      DTSCS26
03768          GO TO S2500-EXIT.                                        DTSCS26
03769                                                                   DTSCS26
03770      MOVE MAP-RESPONSIBLE-OP-ID TO L082-OP-ID.                    DTSCS26
03771                                                                   DTSCS26
03772      PERFORM S082-OP-ID-LOOKUP THRU S082-EXIT.                    DTSCS26
03773                                                                   DTSCS26
03774      IF L082-NOT-VALID-OP                                         DTSCS26
03775            OR L082-INTERNAL-88                                    DTSCS26
03776          MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER                   DTSCS26
03777          MOVE 'RESPONSIBLE OPID' TO WRK-MSG-TEXT                  DTSCS26
03778          PERFORM S2501-ERROR THRU S2501-EXIT                      DTSCS26
03779          GO TO S2500-EXIT.                                        DTSCS26
03780  S2500-EXIT.                                                      DTSCS26
03781      EXIT.                                                        DTSCS26
03782                                                                   DTSCS26
03783                                                                   DTSCS26
03784                                                                   DTSCS26
03785  S2501-ERROR.                                                     DTSCS26
03786      MOVE CATB-UNPROT-NORM-AN-MDTON                               DTSCS26
03787        TO MAP-RESPONSIBLE-OP-ID-A.                                DTSCS26
03788                                                                   DTSCS26
03789      IF LCCM-NO-MSG                                               DTSCS26
03790          MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                       DTSCS26
03791          MOVE CATB-CURSOR TO MAP-RESPONSIBLE-OP-ID-L              DTSCS26
03792          SET CURSOR-SET-YES TO TRUE.                              DTSCS26
03793  S2501-EXIT.                                                      DTSCS26
03794      EXIT.                                                        DTSCS26
03795 /*****************************************************************DTSCS26
03796 *                                                                 DTSCS26
03797 ******************************************************************DTSCS26
03798  S2600-ENTRY-MODE.                                                DTSCS26
03799      IF MAP-ENTRY-MODE = LOW-VALUES OR SPACES                     DTSCS26
03800         SET MAP-ENTRY-MODE-DEFAULT-88 TO TRUE                     DTSCS26
03801         MOVE MAP-ENTRY-MODE TO LCCM-ENTRY-MODE                    DTSCS26
03802      ELSE                                                         DTSCS26
03803      IF MAP-ENTRY-MODE-VALID                                      DTSCS26
03804         MOVE MAP-ENTRY-MODE TO LCCM-ENTRY-MODE                    DTSCS26
03805      ELSE                                                         DTSCS26
03806         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS26
03807         PERFORM S2601-ERROR THRU S2601-EXIT.                      DTSCS26
03808  S2600-EXIT.                                                      DTSCS26
03809      EXIT.                                                        DTSCS26
03810                                                                   DTSCS26
03811                                                                   DTSCS26
03812                                                                   DTSCS26
03813  S2601-ERROR.                                                     DTSCS26
03814      MOVE CATB-UNPROT-NORM-NUM-MDTON                              DTSCS26
03815        TO MAP-ENTRY-MODE-A.                                       DTSCS26
03816                                                                   DTSCS26
03817      IF LCCM-NO-MSG                                               DTSCS26
03818         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS26
03819         MOVE CATB-CURSOR TO MAP-ENTRY-MODE-L                      DTSCS26
03820         SET CURSOR-SET-YES TO TRUE.                               DTSCS26
03821  S2601-EXIT.                                                      DTSCS26
03822      EXIT.                                                        DTSCS26
03823 /*****************************************************************DTSCS26
03824 *                                                                 DTSCS26
03825 ******************************************************************DTSCS26
03826  S2700-DISREGARD-EDITS-IND.                                       DTSCS26
03827      IF MAP-DISREGARD-EDITS-IND = LOW-VALUES OR SPACES            DTSCS26
03828         SET MAP-DISREGARD-EDITS-NO-88 TO TRUE                     DTSCS26
03829      ELSE                                                         DTSCS26
03830      IF MAP-DISREGARD-EDITS-VALID-88                              DTSCS26
03831         NEXT SENTENCE                                             DTSCS26
03832      ELSE                                                         DTSCS26
03833         MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER                    DTSCS26
03834         MOVE 'DISREGARD EDITS' TO WRK-MSG-TEXT                    DTSCS26
03835         PERFORM S2701-ERROR THRU S2701-EXIT.                      DTSCS26
03836  S2700-EXIT.                                                      DTSCS26
03837      EXIT.                                                        DTSCS26
03838                                                                   DTSCS26
03839                                                                   DTSCS26
03840                                                                   DTSCS26
03841  S2701-ERROR.                                                     DTSCS26
03842      MOVE CATB-UNPROT-NORM-AN-MDTON                               DTSCS26
03843        TO MAP-DISREGARD-EDITS-IND-A.                              DTSCS26
03844                                                                   DTSCS26
03845      IF LCCM-NO-MSG                                               DTSCS26
03846         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS26
03847         MOVE CATB-CURSOR TO MAP-DISREGARD-EDITS-IND-L             DTSCS26
03848         SET CURSOR-SET-YES TO TRUE.                               DTSCS26
03849  S2701-EXIT.                                                      DTSCS26
03850      EXIT.                                                        DTSCS26
03851 /*****************************************************************DTSCS26
03852 *                                                                *DTSCS26
03853 ******************************************************************DTSCS26
03854  S4000-CROSS-EDITS.                                               DTSCS26
03855      MOVE MAP-ADJ-TYPE TO AADJ-ADJ-TYPE.                          DTSCS26
03856                                                                   DTSCS26
03857      MOVE WRK-APPLIC-IND TO AADJ-APPLIC-IND.                      DTSCS26
03858                                                                   DTSCS26
03859      MOVE WRK-APPLIC-DOC-NO TO AADJ-APPLIC-DOC-NO.                DTSCS26
03860                                                                   DTSCS26
03861      MOVE WRK-AMT TO AADJ-AMT.                                    DTSCS26
03862                                                                   DTSCS26
03863      MOVE WRK-DATE-1 TO AADJ-DATE-1.                              DTSCS26
03864                                                                   DTSCS26
03865      MOVE WRK-DATE-2 TO AADJ-DATE-2.                              DTSCS26
03866                                                                   DTSCS26
03867                                                                   DTSCS26
03868      IF AADJ-CHARGE-88                                            DTSCS26
03869          PERFORM S4100-CHARGE-EDIT THRU S4100-EXIT                DTSCS26
03870      ELSE                                                         DTSCS26
03871      IF AADJ-WAIVE-88                                             DTSCS26
03872          PERFORM S4200-WAIVE-EDIT THRU S4200-EXIT                 DTSCS26
03873      ELSE                                                         DTSCS26
03874      IF AADJ-TOLER-88                                             DTSCS26
03875          PERFORM S4300-TOLER-EDIT THRU S4300-EXIT                 DTSCS26
03876      ELSE                                                         DTSCS26
03877      IF AADJ-AUTO-88                                              DTSCS26
03878          PERFORM S4400-AUTO-EDIT THRU S4400-EXIT                  DTSCS26
03879      ELSE                                                         DTSCS26
03880      IF AADJ-MANUAL-88                                            DTSCS26
03881          PERFORM S4500-MANUAL-EDIT THRU S4500-EXIT                DTSCS26
03882      ELSE                                                         DTSCS26
03883      IF AADJ-DUE-DATE-88                                          DTSCS26
03884          PERFORM S4600-DUE-DATE-EDIT THRU S4600-EXIT              DTSCS26
03885      ELSE                                                         DTSCS26
03886      IF AADJ-WAIVE-DATE-88                                        DTSCS26
03887          PERFORM S4700-WAIVE-DATE-EDIT THRU S4700-EXIT            DTSCS26
03888      ELSE                                                         DTSCS26
03889      IF AADJ-INT-DATE-88                                          DTSCS26
03890          PERFORM S4800-INT-DATE-EDIT THRU S4800-EXIT              DTSCS26
03891      ELSE                                                         DTSCS26
03892      IF AADJ-WRITE-OFF-88                                         DTSCS26
03893          PERFORM S6100-WRITE-OFF-EDIT THRU S6100-EXIT             DTSCS26
03894      ELSE                                                         DTSCS26
03895      IF AADJ-WRITE-OFF-REV-88                                     DTSCS26
03896          PERFORM S6200-WRITE-OFF-REV-EDIT THRU S6200-EXIT         DTSCS26
03897      ELSE                                                         DTSCS26
03898      IF AADJ-WAGE-RPT-88                                          DTSCS26
03899          PERFORM S4900-WAGE-RPT-EDIT THRU S4900-EXIT              DTSCS26
03900      ELSE                                                         DTSCS26
03901          GO TO S899-ABEND.                                        DTSCS26
03902                                                                   DTSCS26
03903                                                                   DTSCS26
03904      PERFORM S6300-RCV-DATE-EDITS THRU S6300-EXIT.                DTSCS26
03905                                                                   DTSCS26
03906                                                                   DTSCS26
03907      PERFORM S6700-LAST-ARCHIVED-YRQ-EDIT THRU S6700-EXIT.        DTSCS26
03908                                                                   DTSCS26
03909                                                                   DTSCS26
03910      PERFORM S6800-NEVER-SUBJECT-EDIT THRU S6800-EXIT.            DTSCS26
03911                                                                   DTSCS26
03912      IF AADJ-WRITE-OFF-88 OR AADJ-WRITE-OFF-REV-88                DTSCS26
03913          NEXT SENTENCE                                            DTSCS26
03914      ELSE                                                         DTSCS26
03915          PERFORM S6900-WRITTEN-OFF-EDIT THRU S6900-EXIT.          DTSCS26
03916  S4000-EXIT.                                                      DTSCS26
03917      EXIT.                                                        DTSCS26
03918      EJECT                                                        DTSCS26
03919  S4100-CHARGE-EDIT.                                               DTSCS26
03920      PERFORM S7100-READ-APPLIC-YRQ THRU S7100-EXIT.               DTSCS26
03921      IF LCCM-MSG                                                  DTSCS26
03922         GO TO S4100-EXIT                                          DTSCS26
03923      END-IF.                                                      DTSCS26
03924                                                                   DTSCS26
03925      IF WRK-MQTR-EXISTS-IND = 'N'                                 DTSCS26
03926          PERFORM S4110-NO-MQTR-REC THRU S4110-EXIT                DTSCS26
03927      ELSE                                                         DTSCS26
03928          PERFORM S4120-MQTR-REC THRU S4120-EXIT.                  DTSCS26
03929  S4100-EXIT.                                                      DTSCS26
03930      EXIT.                                                        DTSCS26
03931                                                                   DTSCS26
03932                                                                   DTSCS26
03933                                                                   DTSCS26
03934  S4110-NO-MQTR-REC.                                               DTSCS26
03935      IF AADJ-AMT > +0                                             DTSCS26
03936          NEXT SENTENCE                                            DTSCS26
03937      ELSE                                                         DTSCS26
03938          MOVE MSG-E263-AREA TO WRK-MSG-AREA                       DTSCS26
03939          PERFORM S1501-ERROR THRU S1501-EXIT                      DTSCS26
03940          GO TO S4110-EXIT.                                        DTSCS26
03941                                                                   DTSCS26
03942      IF WRK-APPLIC-YRQ = LCCM-PICKUP-YRQ                          DTSCS26
03943          GO TO S4110-EXIT.                                        DTSCS26
03944                                                                   DTSCS26
03945      IF AADJ-UI-88 OR AADJ-NSF-PEN-88 OR AADJ-MISC-PEN-88         DTSCS26
03946            OR AADJ-LATE-PEN-88                                    DTSCS26
03947          NEXT SENTENCE                                            DTSCS26
03948      ELSE                                                         DTSCS26
03949          MOVE MSG-E263-AREA TO WRK-MSG-AREA                       DTSCS26
03950          PERFORM S1701-ERROR THRU S1701-EXIT                      DTSCS26
03951          GO TO S4110-EXIT.                                        DTSCS26
03952                                                                   DTSCS26
03953      IF AADJ-UI-88                                                DTSCS26
03954          IF MPRF-CLASS-SELF-INS-88                                DTSCS26
03955              NEXT SENTENCE                                        DTSCS26
03956          ELSE                                                     DTSCS26
03957              MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER               DTSCS26
03958              MOVE 'RPT/PAY/ADJ TYPE' TO WRK-MSG-TEXT              DTSCS26
03959              PERFORM S1701-ERROR THRU S1701-EXIT                  DTSCS26
03960              GO TO S4110-EXIT.                                    DTSCS26
03961  S4110-EXIT.                                                      DTSCS26
03962      EXIT.                                                        DTSCS26
03963                                                                   DTSCS26
03964                                                                   DTSCS26
03965                                                                   DTSCS26
03966  S4120-MQTR-REC.                                                  DTSCS26
03967      IF WRK-APPLIC-YRQ = LCCM-PICKUP-YRQ                          DTSCS26
03968          NEXT SENTENCE                                            DTSCS26
03969      ELSE                                                         DTSCS26
03970      IF AADJ-UI-88 OR AADJ-INT-88 OR AADJ-LATE-PEN-88             DTSCS26
03971            OR AADJ-NSF-PEN-88 OR AADJ-MISC-PEN-88                 DTSCS26
03972            OR AADJ-SUR-88                                         DTSCS26
03973          NEXT SENTENCE                                            DTSCS26
03974      ELSE                                                         DTSCS26
03975          MOVE MSG-E263-AREA TO WRK-MSG-AREA                       DTSCS26
03976          PERFORM S1701-ERROR THRU S1701-EXIT                      DTSCS26
03977          GO TO S4120-EXIT.                                        DTSCS26
03978                                                                   DTSCS26
03979                                                                   DTSCS26
03980      MOVE AADJ-AMT TO WRK-CHARGED-AMT.                            DTSCS26
03981                                                                   DTSCS26
03982      PERFORM S4121-MQTR-ACCT-SCAN THRU S4121-EXIT                 DTSCS26
03983          VARYING MQTR-ACCT-IDX FROM 1 BY 1                        DTSCS26
03984          UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT.                     DTSCS26
03985                                                                   DTSCS26
03986      IF WRK-CHARGED-AMT < +0                                      DTSCS26
03987          MOVE MSG-E263-AREA TO WRK-MSG-AREA                       DTSCS26
03988          PERFORM S1701-ERROR THRU S1701-EXIT                      DTSCS26
03989          GO TO S4120-EXIT.                                        DTSCS26
03990                                                                   DTSCS26
03991                                                                   DTSCS26
03992      IF MPRF-CLASS-SELF-INS-88                                    DTSCS26
03993          PERFORM S4122-SELF-INS-EDIT THRU S4122-EXIT              DTSCS26
03994      ELSE                                                         DTSCS26
03995          PERFORM S4123-TAXED-EDIT THRU S4123-EXIT.                DTSCS26
03996  S4120-EXIT.                                                      DTSCS26
03997      EXIT.                                                        DTSCS26
03998                                                                   DTSCS26
03999                                                                   DTSCS26
04000                                                                   DTSCS26
04001  S4121-MQTR-ACCT-SCAN.                                            DTSCS26
04002      IF MQTR-ACCT-IND (MQTR-ACCT-IDX) = AADJ-APPLIC-IND           DTSCS26
04003          ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX)                     DTSCS26
04004           TO WRK-CHARGED-AMT.                                     DTSCS26
04005  S4121-EXIT.                                                      DTSCS26
04006      EXIT.                                                        DTSCS26
04007                                                                   DTSCS26
04008                                                                   DTSCS26
04009                                                                   DTSCS26
04010  S4122-SELF-INS-EDIT.                                             DTSCS26
04011      IF WRK-CHARGED-AMT = +0                                      DTSCS26
04012          GO TO S4122-EXIT.                                        DTSCS26
04013                                                                   DTSCS26
04014      IF WRK-APPLIC-YRQ = LCCM-PICKUP-YRQ                          DTSCS26
04015          GO TO S4122-EXIT.                                        DTSCS26
04016                                                                   DTSCS26
04017      MOVE +0 TO WRK-CHARGED-AMT.                                  DTSCS26
04018                                                                   DTSCS26
04019      PERFORM                                                      DTSCS26
04020        VARYING MQTR-ACCT-IDX FROM 1 BY 1                          DTSCS26
04021        UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT                        DTSCS26
04022          IF MQTR-ACCT-TAX-88 (MQTR-ACCT-IDX)                      DTSCS26
04023              MOVE MQTR-CHARGED-AMT (MQTR-ACCT-IDX)                DTSCS26
04024                TO WRK-CHARGED-AMT                                 DTSCS26
04025          END-IF                                                   DTSCS26
04026      END-PERFORM.                                                 DTSCS26
04027                                                                   DTSCS26
04028      IF WRK-CHARGED-AMT = +0                                      DTSCS26
04029          IF AADJ-INT-88                                           DTSCS26
04030              MOVE MSG-E263-AREA TO WRK-MSG-AREA                   DTSCS26
04031              PERFORM S1701-ERROR THRU S1701-EXIT                  DTSCS26
04032              GO TO S4122-EXIT.                                    DTSCS26
04033  S4122-EXIT.                                                      DTSCS26
04034      EXIT.                                                        DTSCS26
04035                                                                   DTSCS26
04036                                                                   DTSCS26
04037                                                                   DTSCS26
04038  S4123-TAXED-EDIT.                                                DTSCS26
04039      IF WRK-APPLIC-YRQ = LCCM-PICKUP-YRQ                          DTSCS26
04040          GO TO S4123-EXIT.                                        DTSCS26
04041                                                                   DTSCS26
04042      IF AADJ-UI-88                                                DTSCS26
04043      OR AADJ-SUR-88                                               DTSCS26
04044          MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER                   DTSCS26
04045          MOVE 'RPT/PAY/ADJ TYPE' TO WRK-MSG-TEXT                  DTSCS26
04046          PERFORM S1701-ERROR THRU S1701-EXIT                      DTSCS26
04047          GO TO S4123-EXIT.                                        DTSCS26
04048                                                                   DTSCS26
04049      IF WRK-CHARGED-AMT = +0                                      DTSCS26
04050          GO TO S4123-EXIT.                                        DTSCS26
04051                                                                   DTSCS26
04052      MOVE +0 TO WRK-CHARGED-AMT.                                  DTSCS26
04053                                                                   DTSCS26
04054      PERFORM                                                      DTSCS26
04055        VARYING MQTR-ACCT-IDX FROM 1 BY 1                          DTSCS26
04056        UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT                        DTSCS26
04057          IF MQTR-ACCT-TAX-88 (MQTR-ACCT-IDX)                      DTSCS26
04058              MOVE MQTR-CHARGED-AMT (MQTR-ACCT-IDX)                DTSCS26
04059                TO WRK-CHARGED-AMT                                 DTSCS26
04060          END-IF                                                   DTSCS26
04061      END-PERFORM.                                                 DTSCS26
04062                                                                   DTSCS26
04063      IF WRK-CHARGED-AMT = +0                                      DTSCS26
04064          IF AADJ-INT-88                                           DTSCS26
04065              MOVE MSG-E263-AREA TO WRK-MSG-AREA                   DTSCS26
04066              PERFORM S1701-ERROR THRU S1701-EXIT                  DTSCS26
04067              GO TO S4123-EXIT.                                    DTSCS26
04068  S4123-EXIT.                                                      DTSCS26
04069      EXIT.                                                        DTSCS26
04070      EJECT                                                        DTSCS26
04071  S4200-WAIVE-EDIT.                                                DTSCS26
04072      PERFORM S7100-READ-APPLIC-YRQ THRU S7100-EXIT.               DTSCS26
04073      IF LCCM-MSG                                                  DTSCS26
04074         GO TO S4200-EXIT                                          DTSCS26
04075      END-IF.                                                      DTSCS26
04076                                                                   DTSCS26
04077      IF WRK-MQTR-EXISTS-IND = 'N'                                 DTSCS26
04078          MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER                   DTSCS26
04079          MOVE 'YEAR/QUARTER' TO WRK-MSG-TEXT                      DTSCS26
04080          PERFORM S1601-ERROR THRU S1601-EXIT                      DTSCS26
04081          GO TO S4200-EXIT.                                        DTSCS26
04082                                                                   DTSCS26
04083      MOVE +0 TO ACCT-SUB.                                         DTSCS26
04084                                                                   DTSCS26
04085      PERFORM S4210-MQTR-ACCT-SCAN THRU S4210-EXIT                 DTSCS26
04086          VARYING MQTR-ACCT-IDX FROM 1 BY 1                        DTSCS26
04087          UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT.                     DTSCS26
04088                                                                   DTSCS26
04089      IF ACCT-SUB = +0                                             DTSCS26
04090          MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER                   DTSCS26
04091          MOVE 'WAIVE' TO WRK-MSG-TEXT                             DTSCS26
04092          PERFORM S1501-ERROR THRU S1501-EXIT                      DTSCS26
04093          GO TO S4200-EXIT.                                        DTSCS26
04094                                                                   DTSCS26
04095      COMPUTE WRK-WAIVED-AMT                                       DTSCS26
04096        = MQTR-WAIVED-AMT (ACCT-SUB) + AADJ-AMT.                   DTSCS26
04097                                                                   DTSCS26
04098      IF (WRK-WAIVED-AMT < +0)                                     DTSCS26
04099             OR                                                    DTSCS26
04100         (WRK-WAIVED-AMT > MQTR-CHARGED-AMT (ACCT-SUB))            DTSCS26
04101          MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER                   DTSCS26
04102          MOVE 'WAIVE' TO WRK-MSG-TEXT                             DTSCS26
04103          PERFORM S1501-ERROR THRU S1501-EXIT                      DTSCS26
04104          GO TO S4200-EXIT.                                        DTSCS26
04105  S4200-EXIT.                                                      DTSCS26
04106      EXIT.                                                        DTSCS26
04107                                                                   DTSCS26
04108                                                                   DTSCS26
04109                                                                   DTSCS26
04110  S4210-MQTR-ACCT-SCAN.                                            DTSCS26
04111      IF MQTR-ACCT-IND (MQTR-ACCT-IDX) = AADJ-APPLIC-IND           DTSCS26
04112          SET ACCT-SUB TO MQTR-ACCT-IDX.                           DTSCS26
04113  S4210-EXIT.                                                      DTSCS26
04114      EXIT.                                                        DTSCS26
04115      EJECT                                                        DTSCS26
04116  S4300-TOLER-EDIT.                                                DTSCS26
04117      IF AADJ-CREDIT-88                                            DTSCS26
04118          PERFORM S4310-CREDIT-TOLER THRU S4310-EXIT               DTSCS26
04119      ELSE                                                         DTSCS26
04120          PERFORM S4320-MQTR-TOLER THRU S4320-EXIT.                DTSCS26
04121  S4300-EXIT.                                                      DTSCS26
04122      EXIT.                                                        DTSCS26
04123                                                                   DTSCS26
04124                                                                   DTSCS26
04125                                                                   DTSCS26
04126  S4310-CREDIT-TOLER.                                              DTSCS26
04127      PERFORM S7200-READ-APPLIC-MDST THRU S7200-EXIT.              DTSCS26
04128                                                                   DTSCS26
04129      IF WRK-MDST-EXISTS-IND = 'N'                                 DTSCS26
04130          MOVE MSG-E262-AREA TO WRK-MSG-AREA                       DTSCS26
04131          PERFORM S1801-ERROR THRU S1801-EXIT                      DTSCS26
04132          PERFORM S1802-ERROR THRU S1802-EXIT                      DTSCS26
04133          GO TO S4310-EXIT.                                        DTSCS26
04134                                                                   DTSCS26
04135      MOVE +0 TO WRK-CREDIT-AMT                                    DTSCS26
04136                 WRK-TOLER-AMT.                                    DTSCS26
04137                                                                   DTSCS26
04138      PERFORM                                                      DTSCS26
04139        VARYING MDST-ACCT-IDX FROM 1 BY 1                          DTSCS26
04140        UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT                        DTSCS26
04141          IF MDST-ACCT-CR-AVAIL-88 (MDST-ACCT-IDX)                 DTSCS26
04142              ADD MDST-AMT (MDST-ACCT-IDX) TO WRK-CREDIT-AMT       DTSCS26
04143          END-IF                                                   DTSCS26
04144          IF MDST-ACCT-CR-TOL-88 (MDST-ACCT-IDX)                   DTSCS26
04145              ADD MDST-AMT (MDST-ACCT-IDX) TO WRK-TOLER-AMT        DTSCS26
04146          END-IF                                                   DTSCS26
04147      END-PERFORM.                                                 DTSCS26
04148                                                                   DTSCS26
04149      ADD AADJ-AMT TO WRK-TOLER-AMT.                               DTSCS26
04150                                                                   DTSCS26
04151      IF WRK-TOLER-AMT < +0                                        DTSCS26
04152          MOVE MSG-E265-AREA TO WRK-MSG-AREA                       DTSCS26
04153          PERFORM S1501-ERROR THRU S1501-EXIT                      DTSCS26
04154          GO TO S4310-EXIT.                                        DTSCS26
04155                                                                   DTSCS26
04156      IF AADJ-AMT > WRK-CREDIT-AMT                                 DTSCS26
04157          MOVE MSG-E265-AREA TO WRK-MSG-AREA                       DTSCS26
04158          PERFORM S1501-ERROR THRU S1501-EXIT                      DTSCS26
04159          GO TO S4310-EXIT.                                        DTSCS26
04160  S4310-EXIT.                                                      DTSCS26
04161      EXIT.                                                        DTSCS26
04162      SKIP3                                                        DTSCS26
04163  S4320-MQTR-TOLER.                                                DTSCS26
04164      PERFORM S7100-READ-APPLIC-YRQ THRU S7100-EXIT.               DTSCS26
04165      IF LCCM-MSG                                                  DTSCS26
04166         GO TO S4320-EXIT                                          DTSCS26
04167      END-IF.                                                      DTSCS26
04168                                                                   DTSCS26
04169      IF WRK-MQTR-EXISTS-IND = 'N'                                 DTSCS26
04170          MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER                   DTSCS26
04171          MOVE 'YEAR/QUARTER'  TO WRK-MSG-TEXT                     DTSCS26
04172          PERFORM S1601-ERROR THRU S1601-EXIT                      DTSCS26
04173          GO TO S4320-EXIT.                                        DTSCS26
04174                                                                   DTSCS26
04175      MOVE +0 TO ACCT-SUB.                                         DTSCS26
04176                                                                   DTSCS26
04177      PERFORM                                                      DTSCS26
04178        VARYING MQTR-ACCT-IDX FROM 1 BY 1                          DTSCS26
04179        UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT                        DTSCS26
04180          IF MQTR-ACCT-IND (MQTR-ACCT-IDX) = AADJ-APPLIC-IND       DTSCS26
04181              SET ACCT-SUB TO MQTR-ACCT-IDX                        DTSCS26
04182          END-IF                                                   DTSCS26
04183      END-PERFORM.                                                 DTSCS26
04184                                                                   DTSCS26
04185      IF ACCT-SUB = +0                                             DTSCS26
04186          MOVE MSG-E265-AREA TO WRK-MSG-AREA                       DTSCS26
04187          PERFORM S1501-ERROR THRU S1501-EXIT                      DTSCS26
04188          GO TO S4320-EXIT.                                        DTSCS26
04189                                                                   DTSCS26
04190      COMPUTE WRK-TOLER-AMT                                        DTSCS26
04191        = MQTR-TOLER-AMT (ACCT-SUB) + AADJ-AMT.                    DTSCS26
04192                                                                   DTSCS26
04193      IF (WRK-TOLER-AMT < +0)                                      DTSCS26
04194             OR                                                    DTSCS26
04195         (WRK-TOLER-AMT > MQTR-CHARGED-AMT (ACCT-SUB))             DTSCS26
04196          MOVE MSG-E265-AREA TO WRK-MSG-AREA                       DTSCS26
04197          PERFORM S1501-ERROR THRU S1501-EXIT                      DTSCS26
04198          GO TO S4320-EXIT.                                        DTSCS26
04199  S4320-EXIT.                                                      DTSCS26
04200      EXIT.                                                        DTSCS26
04201      EJECT                                                        DTSCS26
04202  S4400-AUTO-EDIT.                                                 DTSCS26
04203      PERFORM S7100-READ-APPLIC-YRQ THRU S7100-EXIT.               DTSCS26
04204      IF LCCM-MSG                                                  DTSCS26
04205         GO TO S4400-EXIT                                          DTSCS26
04206      END-IF.                                                      DTSCS26
04207                                                                   DTSCS26
04208      IF (WRK-MQTR-EXISTS-IND = 'N')                               DTSCS26
04209              OR                                                   DTSCS26
04210         (WRK-APPLIC-YRQ = LCCM-PICKUP-YRQ)                        DTSCS26
04211          MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER                   DTSCS26
04212          MOVE 'YEAR/QUARTER' TO WRK-MSG-TEXT                      DTSCS26
04213          PERFORM S1601-ERROR THRU S1601-EXIT                      DTSCS26
04214          GO TO S4400-EXIT.                                        DTSCS26
04215                                                                   DTSCS26
04216      IF AADJ-LATE-PEN-88                                          DTSCS26
04217          IF MQTR-PEN-CHARGE-MANUAL-88                             DTSCS26
04218              NEXT SENTENCE                                        DTSCS26
04219          ELSE                                                     DTSCS26
04220              MOVE MSG-E264-AREA TO WRK-MSG-AREA                   DTSCS26
04221              PERFORM S1701-ERROR THRU S1701-EXIT                  DTSCS26
04222              GO TO S4400-EXIT                                     DTSCS26
04223      ELSE                                                         DTSCS26
04224      IF AADJ-INT-88                                               DTSCS26
04225          IF MQTR-INT-CHARGE-MANUAL-88                             DTSCS26
04226              NEXT SENTENCE                                        DTSCS26
04227          ELSE                                                     DTSCS26
04228              MOVE MSG-E264-AREA TO WRK-MSG-AREA                   DTSCS26
04229              PERFORM S1701-ERROR THRU S1701-EXIT                  DTSCS26
04230              GO TO S4400-EXIT                                     DTSCS26
04231      ELSE                                                         DTSCS26
04232      IF AADJ-LP-INT-88                                            DTSCS26
04233          IF MQTR-PEN-CHARGE-MANUAL-88                             DTSCS26
04234                AND                                                DTSCS26
04235             MQTR-INT-CHARGE-MANUAL-88                             DTSCS26
04236              NEXT SENTENCE                                        DTSCS26
04237          ELSE                                                     DTSCS26
04238              MOVE MSG-E264-AREA TO WRK-MSG-AREA                   DTSCS26
04239              PERFORM S1701-ERROR THRU S1701-EXIT                  DTSCS26
04240              GO TO S4400-EXIT.                                    DTSCS26
04241  S4400-EXIT.                                                      DTSCS26
04242      EXIT.                                                        DTSCS26
04243      EJECT                                                        DTSCS26
04244  S4500-MANUAL-EDIT.                                               DTSCS26
04245      PERFORM S7100-READ-APPLIC-YRQ THRU S7100-EXIT.               DTSCS26
04246      IF LCCM-MSG                                                  DTSCS26
04247         GO TO S4500-EXIT                                          DTSCS26
04248      END-IF.                                                      DTSCS26
04249                                                                   DTSCS26
04250      IF WRK-MQTR-EXISTS-IND = 'N'                                 DTSCS26
04251          PERFORM S4510-NO-MQTR-REC THRU S4510-EXIT                DTSCS26
04252      ELSE                                                         DTSCS26
04253          PERFORM S4520-MQTR-REC THRU S4520-EXIT.                  DTSCS26
04254  S4500-EXIT.                                                      DTSCS26
04255      EXIT.                                                        DTSCS26
04256      SKIP3                                                        DTSCS26
04257  S4510-NO-MQTR-REC.                                               DTSCS26
04258      IF AADJ-INT-88 OR AADJ-LATE-PEN-88 OR AADJ-LP-INT-88         DTSCS26
04259          NEXT SENTENCE                                            DTSCS26
04260      ELSE                                                         DTSCS26
04261          MOVE MSG-E266-AREA TO WRK-MSG-AREA                       DTSCS26
04262          PERFORM S1601-ERROR THRU S1601-EXIT                      DTSCS26
04263          GO TO S4510-EXIT.                                        DTSCS26
04264  S4510-EXIT.                                                      DTSCS26
04265      EXIT.                                                        DTSCS26
04266      SKIP3                                                        DTSCS26
04267  S4520-MQTR-REC.                                                  DTSCS26
04268      IF AADJ-LATE-PEN-88                                          DTSCS26
04269          IF MQTR-PEN-CHARGE-AUTO-88                               DTSCS26
04270              NEXT SENTENCE                                        DTSCS26
04271          ELSE                                                     DTSCS26
04272              MOVE MSG-E266-AREA TO WRK-MSG-AREA                   DTSCS26
04273              PERFORM S1601-ERROR THRU S1601-EXIT                  DTSCS26
04274              GO TO S4520-EXIT                                     DTSCS26
04275      ELSE                                                         DTSCS26
04276      IF AADJ-INT-88                                               DTSCS26
04277          IF MQTR-INT-CHARGE-AUTO-88                               DTSCS26
04278              NEXT SENTENCE                                        DTSCS26
04279          ELSE                                                     DTSCS26
04280              MOVE MSG-E266-AREA TO WRK-MSG-AREA                   DTSCS26
04281              PERFORM S1601-ERROR THRU S1601-EXIT                  DTSCS26
04282              GO TO S4520-EXIT                                     DTSCS26
04283      ELSE                                                         DTSCS26
04284      IF AADJ-LP-INT-88                                            DTSCS26
04285          IF MQTR-PEN-CHARGE-AUTO-88 AND MQTR-INT-CHARGE-AUTO-88   DTSCS26
04286              NEXT SENTENCE                                        DTSCS26
04287          ELSE                                                     DTSCS26
04288              MOVE MSG-E266-AREA TO WRK-MSG-AREA                   DTSCS26
04289              PERFORM S1601-ERROR THRU S1601-EXIT                  DTSCS26
04290              GO TO S4520-EXIT.                                    DTSCS26
04291  S4520-EXIT.                                                      DTSCS26
04292      EXIT.                                                        DTSCS26
04293      EJECT                                                        DTSCS26
04294  S4600-DUE-DATE-EDIT.                                             DTSCS26
04295      IF WRK-APPLIC-YRQ = LCCM-PICKUP-YRQ                          DTSCS26
04296          MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER                   DTSCS26
04297          MOVE 'YEAR/QUARTER' TO WRK-MSG-TEXT                      DTSCS26
04298          PERFORM S1601-ERROR THRU S1601-EXIT                      DTSCS26
04299          GO TO S4600-EXIT.                                        DTSCS26
04300                                                                   DTSCS26
04301      PERFORM S7100-READ-APPLIC-YRQ THRU S7100-EXIT.               DTSCS26
04302      IF LCCM-MSG                                                  DTSCS26
04303         GO TO S4600-EXIT                                          DTSCS26
04304      END-IF.                                                      DTSCS26
04305                                                                   DTSCS26
04306      IF WRK-MQTR-EXISTS-IND = 'N'                                 DTSCS26
04307          PERFORM S4610-NO-MQTR-REC THRU S4610-EXIT                DTSCS26
04308      ELSE                                                         DTSCS26
04309          NEXT SENTENCE.                                           DTSCS26
04310                                                                   DTSCS26
04311      IF AADJ-DATE-2 = +0 OR ALL-NINES-DATE                        DTSCS26
04312          NEXT SENTENCE                                            DTSCS26
04313      ELSE                                                         DTSCS26
04314          PERFORM S4620-TAX-DUE-DATE-EDIT THRU S4620-EXIT.         DTSCS26
04315  S4600-EXIT.                                                      DTSCS26
04316      EXIT.                                                        DTSCS26
04317                                                                   DTSCS26
04318                                                                   DTSCS26
04319                                                                   DTSCS26
04320  S4610-NO-MQTR-REC.                                               DTSCS26
04321      IF (AADJ-DATE-1 = +0 OR ALL-NINES-DATE)                      DTSCS26
04322             AND                                                   DTSCS26
04323         (AADJ-DATE-2 = +0 OR ALL-NINES-DATE)                      DTSCS26
04324          MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER                   DTSCS26
04325          MOVE 'YEAR/QUARTER' TO WRK-MSG-TEXT                      DTSCS26
04326          PERFORM S1601-ERROR THRU S1601-EXIT                      DTSCS26
04327          GO TO S4610-EXIT.                                        DTSCS26
04328  S4610-EXIT.                                                      DTSCS26
04329      EXIT.                                                        DTSCS26
04330                                                                   DTSCS26
04331                                                                   DTSCS26
04332                                                                   DTSCS26
04333  S4620-TAX-DUE-DATE-EDIT.                                         DTSCS26
04334      MOVE WRK-EMP-NO TO L381-EMP-NO.                              DTSCS26
04335                                                                   DTSCS26
04336      MOVE WRK-APPLIC-YRQ TO L381-YRQ.                             DTSCS26
04337                                                                   DTSCS26
04338      MOVE MPRF-EMP-CLASS TO L381-EMP-CLASS.                       DTSCS26
04339                                                                   DTSCS26
04340      PERFORM S381-LOOKUP-LIABILITY THRU S381-EXIT.                DTSCS26
04341                                                                   DTSCS26
04342      IF AADJ-DATE-2 > L381-DEFAULT-TAX-DUE-DATE                   DTSCS26
04343          MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER                   DTSCS26
04344          MOVE 'TAX DUE DATE' TO WRK-MSG-TEXT                      DTSCS26
04345          PERFORM S2001-ERROR THRU S2001-EXIT.                     DTSCS26
04346  S4620-EXIT.                                                      DTSCS26
04347      EXIT.                                                        DTSCS26
04348      EJECT                                                        DTSCS26
04349  S4700-WAIVE-DATE-EDIT.                                           DTSCS26
04350      IF WRK-APPLIC-YRQ = LCCM-PICKUP-YRQ                          DTSCS26
04351          MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER                   DTSCS26
04352          MOVE 'YEAR/QUARTER' TO WRK-MSG-TEXT                      DTSCS26
04353          PERFORM S1601-ERROR THRU S1601-EXIT                      DTSCS26
04354          GO TO S4700-EXIT.                                        DTSCS26
04355                                                                   DTSCS26
04356      PERFORM S7100-READ-APPLIC-YRQ THRU S7100-EXIT.               DTSCS26
04357      IF LCCM-MSG                                                  DTSCS26
04358         GO TO S4700-EXIT                                          DTSCS26
04359      END-IF.                                                      DTSCS26
04360                                                                   DTSCS26
04361      IF WRK-MQTR-EXISTS-IND = 'N'                                 DTSCS26
04362          PERFORM S4710-NO-MQTR-REC THRU S4710-EXIT.               DTSCS26
04363  S4700-EXIT.                                                      DTSCS26
04364      EXIT.                                                        DTSCS26
04365                                                                   DTSCS26
04366                                                                   DTSCS26
04367                                                                   DTSCS26
04368  S4710-NO-MQTR-REC.                                               DTSCS26
04369      IF AADJ-DATE-1 = ALL-NINES-DATE                              DTSCS26
04370          MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER                   DTSCS26
04371          MOVE 'YEAR/QUARTER' TO WRK-MSG-TEXT                      DTSCS26
04372          PERFORM S1601-ERROR THRU S1601-EXIT                      DTSCS26
04373          GO TO S4710-EXIT.                                        DTSCS26
04374  S4710-EXIT.                                                      DTSCS26
04375      EXIT.                                                        DTSCS26
04376      EJECT                                                        DTSCS26
04377  S4800-INT-DATE-EDIT.                                             DTSCS26
04378      IF WRK-APPLIC-YRQ = LCCM-PICKUP-YRQ                          DTSCS26
04379          MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER                   DTSCS26
04380          MOVE 'YEAR/QUARTER' TO WRK-MSG-TEXT                      DTSCS26
04381          PERFORM S1601-ERROR THRU S1601-EXIT                      DTSCS26
04382          GO TO S4800-EXIT.                                        DTSCS26
04383                                                                   DTSCS26
04384      PERFORM S7100-READ-APPLIC-YRQ THRU S7100-EXIT.               DTSCS26
04385      IF LCCM-MSG                                                  DTSCS26
04386         GO TO S4800-EXIT                                          DTSCS26
04387      END-IF.                                                      DTSCS26
04388                                                                   DTSCS26
04389      IF WRK-MQTR-EXISTS-IND = 'N'                                 DTSCS26
04390          PERFORM S4810-NO-MQTR-REC THRU S4810-EXIT                DTSCS26
04391      ELSE                                                         DTSCS26
04392          NEXT SENTENCE.                                           DTSCS26
04393                                                                   DTSCS26
04394      PERFORM S4820-DAY-OF-MONTH-EDIT THRU S4820-EXIT.             DTSCS26
04395  S4800-EXIT.                                                      DTSCS26
04396      EXIT.                                                        DTSCS26
04397                                                                   DTSCS26
04398                                                                   DTSCS26
04399                                                                   DTSCS26
04400  S4810-NO-MQTR-REC.                                               DTSCS26
04401      IF AADJ-DATE-1 = ALL-NINES-DATE                              DTSCS26
04402          MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER                   DTSCS26
04403          MOVE 'YEAR/QUARTER' TO WRK-MSG-TEXT                      DTSCS26
04404          PERFORM S1601-ERROR THRU S1601-EXIT                      DTSCS26
04405          GO TO S4810-EXIT.                                        DTSCS26
04406  S4810-EXIT.                                                      DTSCS26
04407      EXIT.                                                        DTSCS26
04408                                                                   DTSCS26
04409                                                                   DTSCS26
04410                                                                   DTSCS26
04411  S4820-DAY-OF-MONTH-EDIT.                                         DTSCS26
04412      IF AADJ-DATE-1 = ALL-NINES-DATE OR ZERO                      DTSCS26
04413          CONTINUE                                                 DTSCS26
04414      ELSE                                                         DTSCS26
04415          PERFORM S4821-FIRST-DAY-OF-MONTH THRU S4821-EXIT.        DTSCS26
04416                                                                   DTSCS26
04417      IF AADJ-DATE-2 = ALL-NINES-DATE OR ZERO                      DTSCS26
04418          CONTINUE                                                 DTSCS26
04419      ELSE                                                         DTSCS26
04420          PERFORM S4822-LAST-DAY-OF-MONTH THRU S4822-EXIT.         DTSCS26
04421  S4820-EXIT.                                                      DTSCS26
04422      EXIT.                                                        DTSCS26
04423                                                                   DTSCS26
04424                                                                   DTSCS26
04425                                                                   DTSCS26
04426  S4821-FIRST-DAY-OF-MONTH.                                        DTSCS26
04427      MOVE AADJ-DATE-1 TO L001-FED-8-DATE-9.                       DTSCS26
04428                                                                   DTSCS26
04429      IF L001-FED-8-DA = 01                                        DTSCS26
04430          NEXT SENTENCE                                            DTSCS26
04431      ELSE                                                         DTSCS26
04432          MOVE MSG-E268-AREA TO WRK-MSG-AREA                       DTSCS26
04433          PERFORM S1901-ERROR THRU S1901-EXIT.                     DTSCS26
04434  S4821-EXIT.                                                      DTSCS26
04435      EXIT.                                                        DTSCS26
04436                                                                   DTSCS26
04437                                                                   DTSCS26
04438                                                                   DTSCS26
04439  S4822-LAST-DAY-OF-MONTH.                                         DTSCS26
04440      MOVE AADJ-DATE-2 TO L001-FED-8-DATE-9                        DTSCS26
04441                          WRK-DISPLAY.                             DTSCS26
04442                                                                   DTSCS26
04443      PERFORM S001-FROM-FED-8 THRU S001-EXIT.                      DTSCS26
04444                                                                   DTSCS26
04445      IF L001-INVALID-DATE                                         DTSCS26
04446          GO TO S4822-EXIT.                                        DTSCS26
04447                                                                   DTSCS26
04448      ADD +1 TO L001-JUL-ABS-DAY.                                  DTSCS26
04449                                                                   DTSCS26
04450      PERFORM S001-FROM-ABS-DAY THRU S001-EXIT.                    DTSCS26
04451                                                                   DTSCS26
04452      IF L001-INVALID-DATE                                         DTSCS26
04453          GO TO S4822-EXIT.                                        DTSCS26
04454                                                                   DTSCS26
04455      IF L001-FED-8-MO = WRK-DISPLAY-MO                            DTSCS26
04456          MOVE MSG-E269-AREA TO WRK-MSG-AREA                       DTSCS26
04457          PERFORM S2001-ERROR THRU S2001-EXIT.                     DTSCS26
04458  S4822-EXIT.                                                      DTSCS26
04459      EXIT.                                                        DTSCS26
04460      EJECT                                                        DTSCS26
04461  S4900-WAGE-RPT-EDIT.                                             DTSCS26
04462      IF WRK-APPLIC-YRQ = LCCM-PICKUP-YRQ                          DTSCS26
04463          MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER                   DTSCS26
04464          MOVE 'YEAR/QUARTER' TO WRK-MSG-TEXT                      DTSCS26
04465          PERFORM S1601-ERROR THRU S1601-EXIT                      DTSCS26
04466          GO TO S4900-EXIT.                                        DTSCS26
04467                                                                   DTSCS26
04468 ***  PERFORM S7100-READ-APPLIC-YRQ THRU S7100-EXIT.               DTSCS26
04469                                                                   DTSCS26
04470      IF MPRF-ORG-HSEHLD-DMSTIC-88                                 DTSCS26
04471         MOVE WRK-APPLIC-YRQ   TO L410-YRQ                         DTSCS26
04472         MOVE WRK-EMP-NO       TO L410-EMP-NO                      DTSCS26
04473         PERFORM S410-FILING-SCHEDULE  THRU S410-EXIT              DTSCS26
04474         IF L410-ANN-SCHED-88                                      DTSCS26
04475             MOVE MSG-E26A-AREA TO WRK-MSG-AREA                    DTSCS26
04476             PERFORM S1601-ERROR THRU S1601-EXIT                   DTSCS26
04477             GO TO S4900-EXIT.                                     DTSCS26
04478                                                                   DTSCS26
04479 *****IF WRK-MQTR-EXISTS-IND = 'Y'                                 DTSCS26
04480 *********PERFORM S4910-MQTR-REC THRU S4910-EXIT                   DTSCS26
04481 *****ELSE                                                         DTSCS26
04482 *********PERFORM S4920-NO-MQTR-REC THRU S4920-EXIT.               DTSCS26
04483  S4900-EXIT.                                                      DTSCS26
04484      EXIT.                                                        DTSCS26
04485                                                                   DTSCS26
04486                                                                   DTSCS26
04487                                                                   DTSCS26
04488 *S4910-MQTR-REC.                                                  DTSCS26
04489 *S4910-EXIT.                                                      DTSCS26
04490 *****EXIT.                                                        DTSCS26
04491                                                                   DTSCS26
04492                                                                   DTSCS26
04493                                                                   DTSCS26
04494 *S4920-NO-MQTR-REC.                                               DTSCS26
04495 *S4920-EXIT.                                                      DTSCS26
04496 *****EXIT.                                                        DTSCS26
04497      EJECT                                                        DTSCS26
04498  S6100-WRITE-OFF-EDIT.                                            DTSCS26
04499      IF MPRF-NOT-WRITTEN-OFF-88                                   DTSCS26
04500          NEXT SENTENCE                                            DTSCS26
04501      ELSE                                                         DTSCS26
04502          MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER                   DTSCS26
04503          MOVE 'WRITTEN OFF' TO WRK-MSG-TEXT                       DTSCS26
04504          PERFORM S1401-ERROR THRU S1401-EXIT                      DTSCS26
04505          GO TO S6100-EXIT.                                        DTSCS26
04506                                                                   DTSCS26
04507      IF (MPRF-TOT-BALANCE-AMT > +0)                               DTSCS26
04508              OR                                                   DTSCS26
04509         (MPRF-PURSUED-RPT-CNT > +0)                               DTSCS26
04510              OR                                                   DTSCS26
04511         (MPRF-TOT-CREDIT-AMT > +0)                                DTSCS26
04512          NEXT SENTENCE                                            DTSCS26
04513      ELSE                                                         DTSCS26
04514          MOVE MSG-E267-AREA TO WRK-MSG-AREA                       DTSCS26
04515          PERFORM S1401-ERROR THRU S1401-EXIT                      DTSCS26
04516          GO TO S6100-EXIT.                                        DTSCS26
04517                                                                   DTSCS26
04518      IF MPRF-STATUS-ACT-88                                        DTSCS26
04519          MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER                   DTSCS26
04520          MOVE 'WRITE OFF' TO WRK-MSG-TEXT                         DTSCS26
04521          PERFORM S1401-ERROR THRU S1401-EXIT                      DTSCS26
04522          GO TO S6100-EXIT.                                        DTSCS26
04523  S6100-EXIT.                                                      DTSCS26
04524      EXIT.                                                        DTSCS26
04525      EJECT                                                        DTSCS26
04526  S6200-WRITE-OFF-REV-EDIT.                                        DTSCS26
04527      IF MPRF-NOT-WRITTEN-OFF-88                                   DTSCS26
04528          MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER                   DTSCS26
04529          MOVE 'WRITE OFF' TO WRK-MSG-TEXT                         DTSCS26
04530          PERFORM S1401-ERROR THRU S1401-EXIT                      DTSCS26
04531          GO TO S6200-EXIT.                                        DTSCS26
04532  S6200-EXIT.                                                      DTSCS26
04533      EXIT.                                                        DTSCS26
04534      EJECT                                                        DTSCS26
04535  S6300-RCV-DATE-EDITS.                                            DTSCS26
04536      IF WRK-RECEIVED-DATE = +0                                    DTSCS26
04537          GO TO S6300-EXIT.                                        DTSCS26
04538                                                                   DTSCS26
04539      IF WRK-RECEIVED-DATE > LCCM-CURR-RUN-DATE                    DTSCS26
04540          MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER                   DTSCS26
04541          MOVE 'RECEIVED DATE' TO WRK-MSG-TEXT                     DTSCS26
04542          PERFORM S2301-ERROR THRU S2301-EXIT                      DTSCS26
04543          GO TO S6300-EXIT.                                        DTSCS26
04544                                                                   DTSCS26
04545      MOVE LCCM-CURR-RUN-DATE TO L001-FED-8-DATE-9.                DTSCS26
04546                                                                   DTSCS26
04547      SUBTRACT 1 FROM L001-FED-8-YR.                               DTSCS26
04548                                                                   DTSCS26
04549      IF (WRK-RECEIVED-DATE > L001-FED-8-DATE-9)                   DTSCS26
04550            OR                                                     DTSCS26
04551         (MAP-DISREGARD-EDITS-YES-88)                              DTSCS26
04552          NEXT SENTENCE                                            DTSCS26
04553      ELSE                                                         DTSCS26
04554          MOVE EMSG-OLD-RCVD-DATE TO WRK-MSG-AREA                  DTSCS26
04555          PERFORM S2301-ERROR THRU S2301-EXIT                      DTSCS26
04556          GO TO S6300-EXIT.                                        DTSCS26
04557  S6300-EXIT.                                                      DTSCS26
04558      EXIT.                                                        DTSCS26
04559      EJECT                                                        DTSCS26
04560  S6700-LAST-ARCHIVED-YRQ-EDIT.                                    DTSCS26
04561      IF WRK-APPLIC-YRQ = +0                                       DTSCS26
04562          GO TO S6700-EXIT.                                        DTSCS26
04563                                                                   DTSCS26
04564      IF MAP-DISREGARD-EDITS-YES-88                                DTSCS26
04565          GO TO S6700-EXIT.                                        DTSCS26
04566                                                                   DTSCS26
04567      IF (WRK-APPLIC-YRQ > MPRF-LAST-ARCHIVED-YRQ)                 DTSCS26
04568              OR                                                   DTSCS26
04569         (WRK-APPLIC-YRQ = LCCM-PICKUP-YRQ)                        DTSCS26
04570          GO TO S6700-EXIT.                                        DTSCS26
04571                                                                   DTSCS26
04572                                                                   DTSCS26
04573      MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER.                      DTSCS26
04574                                                                   DTSCS26
04575      MOVE 'YEAR/QUARTER' TO WRK-MSG-TEXT.                         DTSCS26
04576                                                                   DTSCS26
04577      PERFORM S2701-ERROR THRU S2701-EXIT.                         DTSCS26
04578  S6700-EXIT.                                                      DTSCS26
04579      EXIT.                                                        DTSCS26
04580      SKIP3                                                        DTSCS26
04581  S6800-NEVER-SUBJECT-EDIT.                                        DTSCS26
04582      IF MPRF-STATUS-SUB-88                                        DTSCS26
04583          GO TO S6800-EXIT.                                        DTSCS26
04584                                                                   DTSCS26
04585                                                                   DTSCS26
04586      MOVE MSG-E261-AREA TO WRK-MSG-AREA.                          DTSCS26
04587                                                                   DTSCS26
04588      PERFORM S1401-ERROR THRU S1401-EXIT.                         DTSCS26
04589  S6800-EXIT.                                                      DTSCS26
04590      EXIT.                                                        DTSCS26
04591      SKIP3                                                        DTSCS26
04592  S6900-WRITTEN-OFF-EDIT.                                          DTSCS26
04593      IF MPRF-NOT-WRITTEN-OFF-88                                   DTSCS26
04594          GO TO S6900-EXIT.                                        DTSCS26
04595                                                                   DTSCS26
04596                                                                   DTSCS26
04597      MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER.                      DTSCS26
04598                                                                   DTSCS26
04599      MOVE 'WRITTEN OFF' TO WRK-MSG-TEXT.                          DTSCS26
04600                                                                   DTSCS26
04601      PERFORM S1401-ERROR THRU S1401-EXIT.                         DTSCS26
04602  S6900-EXIT.                                                      DTSCS26
04603      EXIT.                                                        DTSCS26
04604      EJECT                                                        DTSCS26
04605  S7100-READ-APPLIC-YRQ.                                           DTSCS26
04606      MOVE LOW-VALUES TO MQTR-KEY-AREA.                            DTSCS26
04607                                                                   DTSCS26
04608      MOVE WRK-EMP-NO TO MQTR-EMP-NO.                              DTSCS26
04609                                                                   DTSCS26
04610      SET MQTR-QTR-88 TO TRUE.                                     DTSCS26
04611                                                                   DTSCS26
04612      MOVE WRK-APPLIC-YRQ TO MQTR-YRQ.                             DTSCS26
04613                                                                   DTSCS26
04614      MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS26
04615                                                                   DTSCS26
04616      PERFORM S810-READ THRU S810-EXIT.                            DTSCS26
04617                                                                   DTSCS26
04618      MOVE MSKL-REC TO MQTR-REC.                                   DTSCS26
04619                                                                   DTSCS26
04620      IF L810-OK-88                                                DTSCS26
04621          MOVE 'Y' TO WRK-MQTR-EXISTS-IND                          DTSCS26
04622          IF MQTR-CMP-ESTB-ABSTIME > ZERO                          DTSCS26
04623             IF WRK-PENDING-MCMP-NO-88                             DTSCS26
04624                IF MAP-APPLIC-IND = 'I '                           DTSCS26
04625                   NEXT SENTENCE                                   DTSCS26
04626                ELSE                                               DTSCS26
04627                   MOVE MSG-E26H-AREA TO WRK-MSG-AREA              DTSCS26
04628                   PERFORM S1601-ERROR THRU S1601-EXIT             DTSCS26
04629                END-IF                                             DTSCS26
04630             END-IF                                                DTSCS26
04631          END-IF                                                   DTSCS26
04632      ELSE                                                         DTSCS26
04633          MOVE 'N' TO WRK-MQTR-EXISTS-IND.                         DTSCS26
04634                                                                   DTSCS26
04635      IF MPRF-ORG-HSEHLD-DMSTIC-88                                 DTSCS26
04636         MOVE WRK-APPLIC-YRQ   TO L410-YRQ                         DTSCS26
04637         MOVE WRK-EMP-NO       TO L410-EMP-NO                      DTSCS26
04638         PERFORM S410-FILING-SCHEDULE  THRU S410-EXIT              DTSCS26
04639         IF L410-ANN-SCHED-88                                      DTSCS26
04640            PERFORM S7105-CHK-ADJ-TYPE THRU S7105-EXIT             DTSCS26
04641            IF ADJ-FOUR-QTRS-YES-88                                DTSCS26
04642               PERFORM S7110-SET-QTRS     THRU S7110-EXIT          DTSCS26
04643            END-IF                                                 DTSCS26
04644         END-IF.                                                   DTSCS26
04645 *          IF SUM-FOUR-QTRS-YES-88                                DTSCS26
04646 *          OR ADJ-FOUR-QTRS-YES-88                                DTSCS26
04647 *             PERFORM S7110-SUM-ANN-QTR  THRU S7110-EXIT          DTSCS26
04648 *             PERFORM S7120-DISTRIB-ADJ  THRU S7120-EXIT.         DTSCS26
04649                                                                   DTSCS26
04650  S7100-EXIT.                                                      DTSCS26
04651      EXIT.                                                        DTSCS26
04652                                                                   DTSCS26
04653 *************************************************************     DTSCS26
04654 *  DETERMINE WHETHER THE EDITS REQUIRE THAT THE ACCOUNTING        DTSCS26
04655 *  DATA FROM  ALL QUARTERS COVERED BY THE ANNUAL REPORT           DTSCS26
04656 *  MUST BE SUMMED TO PRODUCE A SINGLE ANNUAL TOTAL.               DTSCS26
04657 *  THIS IS NECESSARY FOR CHARGE AND WAIVER EDITS.  SET            DTSCS26
04658 *  SUM-FOUR-QTRS-YES-88 TO TRUE FOR THESE ADJUSTMENTS.            DTSCS26
04659 *                                                                 DTSCS26
04660 *                                                                 DTSCS26
04661 *  DETERMINE WHETHER THE ADJUSTMENT REQUIRES SEPARATE             DTSCS26
04662 *  ACCOUNTING TRANSACTIONS FOR EACH QUARTER COVERED BY AN         DTSCS26
04663 *  ANNUAL REPORT. SET ADJ-FOUR-QTRS-YES-88 TO TRUE FOR            DTSCS26
04664 *  THESE ADJUSTMENTS.                                             DTSCS26
04665 *************************************************************     DTSCS26
04666  S7105-CHK-ADJ-TYPE.                                              DTSCS26
04667 *&   SET SUM-FOUR-QTRS-NO-88 TO TRUE.                             DTSCS26
04668      SET ADJ-FOUR-QTRS-NO-88 TO TRUE.                             DTSCS26
04669                                                                   DTSCS26
04670 *&   IF AADJ-CHARGE-88                                            DTSCS26
04671 *       IF AADJ-LATE-PEN-88 OR AADJ-MISC-PEN-88                   DTSCS26
04672 *          SET SUM-FOUR-QTRS-YES-88 TO TRUE                       DTSCS26
04673 *          SET ADJ-FOUR-QTRS-YES-88 TO TRUE                       DTSCS26
04674 *       END-IF                                                    DTSCS26
04675 *    ELSE                                                         DTSCS26
04676 *    IF AADJ-WAIVE-88                                             DTSCS26
04677 *       SET SUM-FOUR-QTRS-YES-88 TO TRUE                          DTSCS26
04678 *       SET ADJ-FOUR-QTRS-YES-88 TO TRUE                          DTSCS26
04679 *&   ELSE                                                         DTSCS26
04680      IF AADJ-AUTO-88                                              DTSCS26
04681      OR AADJ-MANUAL-88                                            DTSCS26
04682      OR AADJ-DUE-DATE-88                                          DTSCS26
04683      OR AADJ-WAIVE-DATE-88                                        DTSCS26
04684      OR AADJ-INT-DATE-88                                          DTSCS26
04685         SET ADJ-FOUR-QTRS-YES-88 TO TRUE.                         DTSCS26
04686                                                                   DTSCS26
04687  S7105-EXIT.                                                      DTSCS26
04688      EXIT.                                                        DTSCS26
04689                                                                   DTSCS26
04690  S7110-SET-QTRS.                                                  DTSCS26
04691      PERFORM S7111-INIT-MQTR-TBL  THRU S7111-EXIT.                DTSCS26
04692                                                                   DTSCS26
04693      MOVE MQTR-YRQ               TO L004-QTR-5-9.                 DTSCS26
04694      MOVE 1                      TO L004-QTR-5-Q                  DTSCS26
04695                                     QTR-SUB.                      DTSCS26
04696      MOVE L004-QTR-5-9           TO WRK-MQTR-YRQ (QTR-SUB).       DTSCS26
04697            PERFORM S7150-CHK-FOR-BYPASS  THRU S7150-EXIT.         DTSCS26
04698                                                                   DTSCS26
04699      MOVE MQTR-YRQ               TO L004-QTR-5-9.                 DTSCS26
04700      MOVE 2                      TO L004-QTR-5-Q                  DTSCS26
04701                                     QTR-SUB.                      DTSCS26
04702      MOVE L004-QTR-5-9           TO WRK-MQTR-YRQ (QTR-SUB).       DTSCS26
04703            PERFORM S7150-CHK-FOR-BYPASS  THRU S7150-EXIT.         DTSCS26
04704                                                                   DTSCS26
04705      MOVE MQTR-YRQ               TO L004-QTR-5-9.                 DTSCS26
04706      MOVE 3                      TO L004-QTR-5-Q                  DTSCS26
04707                                     QTR-SUB.                      DTSCS26
04708      MOVE L004-QTR-5-9           TO WRK-MQTR-YRQ (QTR-SUB).       DTSCS26
04709            PERFORM S7150-CHK-FOR-BYPASS  THRU S7150-EXIT.         DTSCS26
04710                                                                   DTSCS26
04711      MOVE MQTR-YRQ               TO L004-QTR-5-9.                 DTSCS26
04712      MOVE 4                      TO L004-QTR-5-Q                  DTSCS26
04713                                     QTR-SUB.                      DTSCS26
04714      MOVE L004-QTR-5-9           TO WRK-MQTR-YRQ (QTR-SUB).       DTSCS26
04715            PERFORM S7150-CHK-FOR-BYPASS  THRU S7150-EXIT.         DTSCS26
04716                                                                   DTSCS26
04717  S7110-EXIT.                                                      DTSCS26
04718      EXIT.                                                        DTSCS26
04719                                                                   DTSCS26
04720 *************************************************************     DTSCS26
04721 *  FOR QUARTERS REPORTED ANNUALLY, READ ALL 4 QUARTERS            DTSCS26
04722 *  COVERED BY THE ANNUAL REPORT AND BUILD A COMBINED MQTR         DTSCS26
04723 *  RECORD, SUMMING THE VALUES IN THE MATRIX OF ACCOUNTS.          DTSCS26
04724 *************************************************************     DTSCS26
04725 *S7110-SUM-ANN-QTR.                                               DTSCS26
04726 *    PERFORM S7111-INIT-MQTR-TBL  THRU S7111-EXIT.                DTSCS26
04727 *                                                                 DTSCS26
04728 *    MOVE MQTR-YRQ               TO L004-QTR-5-9.                 DTSCS26
04729 *    MOVE 1                      TO L004-QTR-5-Q                  DTSCS26
04730 *                                   QTR-SUB.                      DTSCS26
04731 *    MOVE L004-QTR-5-9           TO WRK-MQTR-YRQ (QTR-SUB).       DTSCS26
04732 *    IF SUM-FOUR-QTRS-YES-88                                      DTSCS26
04733 *       PERFORM S7112-GET-ACCT-DATA THRU S7112-EXIT               DTSCS26
04734 *    ELSE                                                         DTSCS26
04735 *       IF ADJ-FOUR-QTRS-YES-88                                   DTSCS26
04736 *          PERFORM S7150-CHK-FOR-BYPASS  THRU S7150-EXIT.         DTSCS26
04737 *                                                                 DTSCS26
04738 *    MOVE 2                      TO L004-QTR-5-Q                  DTSCS26
04739 *                                   QTR-SUB.                      DTSCS26
04740 *    MOVE L004-QTR-5-9           TO WRK-MQTR-YRQ (QTR-SUB).       DTSCS26
04741 *    IF SUM-FOUR-QTRS-YES-88                                      DTSCS26
04742 *       PERFORM S7112-GET-ACCT-DATA THRU S7112-EXIT               DTSCS26
04743 *    ELSE                                                         DTSCS26
04744 *       IF ADJ-FOUR-QTRS-YES-88                                   DTSCS26
04745 *          PERFORM S7150-CHK-FOR-BYPASS  THRU S7150-EXIT.         DTSCS26
04746 *                                                                 DTSCS26
04747 *    MOVE 3                      TO L004-QTR-5-Q                  DTSCS26
04748 *                                   QTR-SUB.                      DTSCS26
04749 *    MOVE L004-QTR-5-9           TO WRK-MQTR-YRQ (QTR-SUB).       DTSCS26
04750 *    IF SUM-FOUR-QTRS-YES-88                                      DTSCS26
04751 *       PERFORM S7112-GET-ACCT-DATA THRU S7112-EXIT               DTSCS26
04752 *    ELSE                                                         DTSCS26
04753 *       IF ADJ-FOUR-QTRS-YES-88                                   DTSCS26
04754 *          PERFORM S7150-CHK-FOR-BYPASS  THRU S7150-EXIT.         DTSCS26
04755 *                                                                 DTSCS26
04756 *    MOVE 4                      TO L004-QTR-5-Q                  DTSCS26
04757 *                                   QTR-SUB.                      DTSCS26
04758 *    MOVE L004-QTR-5-9           TO WRK-MQTR-YRQ (QTR-SUB).       DTSCS26
04759 *    IF SUM-FOUR-QTRS-YES-88                                      DTSCS26
04760 *       PERFORM S7112-GET-ACCT-DATA THRU S7112-EXIT               DTSCS26
04761 *    ELSE                                                         DTSCS26
04762 *       IF ADJ-FOUR-QTRS-YES-88                                   DTSCS26
04763 *          PERFORM S7150-CHK-FOR-BYPASS  THRU S7150-EXIT.         DTSCS26
04764 *                                                                 DTSCS26
04765 *    IF SUM-FOUR-QTRS-YES-88                                      DTSCS26
04766 *       MOVE WRK-MQTR-ACCT-CNT (TOT-SUB) TO MQTR-ACCT-CNT         DTSCS26
04767 *       MOVE WRK-ANN-ACCT-AREA (TOT-SUB) TO MQTR-ACCT-AREA.       DTSCS26
04768 *                                                                 DTSCS26
04769 *S7110-EXIT.                                                      DTSCS26
04770 *    EXIT.                                                        DTSCS26
04771 *                                                                 DTSCS26
04772  S7111-INIT-MQTR-TBL.                                             DTSCS26
04773      PERFORM                                                      DTSCS26
04774         VARYING QTR-SUB FROM +1 BY +1                             DTSCS26
04775         UNTIL QTR-SUB > +4                                        DTSCS26
04776            MOVE +0      TO WRK-MQTR-YRQ (QTR-SUB)                 DTSCS26
04777 ***                        WRK-MQTR-ADJ-AMT (QTR-SUB)             DTSCS26
04778 ***                        WRK-MQTR-ACCT-CNT (QTR-SUB)            DTSCS26
04779            SET WRK-MQTR-BYPASS-NO-88 (QTR-SUB) TO TRUE            DTSCS26
04780 ***        PERFORM S7111A-INIT-ACCT-AREA  THRU S7111A-EXIT        DTSCS26
04781      END-PERFORM.                                                 DTSCS26
04782                                                                   DTSCS26
04783  S7111-EXIT.                                                      DTSCS26
04784      EXIT.                                                        DTSCS26
04785 *                                                                 DTSCS26
04786 *S7111A-INIT-ACCT-AREA.                                           DTSCS26
04787 *    PERFORM                                                      DTSCS26
04788 *      VARYING ACCT-SUB FROM +1 BY +1                             DTSCS26
04789 *      UNTIL ACCT-SUB > +10                                       DTSCS26
04790 *        MOVE +0 TO                                               DTSCS26
04791 *          WRK-MQTR-CHARGED-AMT (QTR-SUB, ACCT-SUB)               DTSCS26
04792 *          WRK-MQTR-PAID-AMT (QTR-SUB, ACCT-SUB)                  DTSCS26
04793 *          WRK-MQTR-WAIVED-AMT (QTR-SUB, ACCT-SUB)                DTSCS26
04794 *          WRK-MQTR-WRITTEN-OFF-AMT (QTR-SUB, ACCT-SUB)           DTSCS26
04795 *          WRK-MQTR-TOLER-AMT (QTR-SUB, ACCT-SUB)                 DTSCS26
04796 *          WRK-MQTR-BALANCE-AMT (QTR-SUB, ACCT-SUB)               DTSCS26
04797 *        MOVE SPACE TO                                            DTSCS26
04798 *          WRK-MQTR-ACCT-IND (QTR-SUB, ACCT-SUB)                  DTSCS26
04799 *    END-PERFORM.                                                 DTSCS26
04800 *S7111A-EXIT.                                                     DTSCS26
04801 *    EXIT.                                                        DTSCS26
04802 *                                                                 DTSCS26
04803 *S7112-GET-ACCT-DATA.                                             DTSCS26
04804 *    MOVE L004-QTR-5-9    TO MQTR-YRQ.                            DTSCS26
04805 *    MOVE MQTR-KEY-AREA   TO MSKL-KEY-AREA.                       DTSCS26
04806 *    PERFORM S810-READ    THRU S810-EXIT.                         DTSCS26
04807 *    IF L810-OK-88                                                DTSCS26
04808 *     MOVE MSKL-REC       TO MQTR-REC                             DTSCS26
04809 *     MOVE MQTR-ACCT-CNT                                          DTSCS26
04810 *                       TO WRK-MQTR-ACCT-CNT (QTR-SUB)            DTSCS26
04811 *     MOVE MQTR-ACCT-AREA                                         DTSCS26
04812 *                       TO WRK-ANN-ACCT-AREA (QTR-SUB).           DTSCS26
04813 *                                                                 DTSCS26
04814 *    PERFORM                                                      DTSCS26
04815 *      VARYING ACCT-SUB FROM +1 BY +1                             DTSCS26
04816 *      UNTIL ACCT-SUB > WRK-MQTR-ACCT-CNT (QTR-SUB)               DTSCS26
04817 *        PERFORM S7119-TOT-ACCT-SUB    THRU S7119-EXIT            DTSCS26
04818 *        MOVE WRK-MQTR-ACCT-IND (QTR-SUB, ACCT-SUB) TO            DTSCS26
04819 *          WRK-MQTR-ACCT-IND (TOT-SUB, ACCT1-SUB)                 DTSCS26
04820 *        ADD WRK-MQTR-CHARGED-AMT (QTR-SUB, ACCT-SUB) TO          DTSCS26
04821 *          WRK-MQTR-CHARGED-AMT (TOT-SUB, ACCT1-SUB)              DTSCS26
04822 *        ADD WRK-MQTR-PAID-AMT (QTR-SUB, ACCT-SUB) TO             DTSCS26
04823 *          WRK-MQTR-PAID-AMT (TOT-SUB, ACCT1-SUB)                 DTSCS26
04824 *        ADD WRK-MQTR-WAIVED-AMT (QTR-SUB, ACCT-SUB) TO           DTSCS26
04825 *          WRK-MQTR-WAIVED-AMT (TOT-SUB, ACCT1-SUB)               DTSCS26
04826 *        ADD WRK-MQTR-WRITTEN-OFF-AMT (QTR-SUB, ACCT-SUB) TO      DTSCS26
04827 *          WRK-MQTR-WRITTEN-OFF-AMT (TOT-SUB, ACCT1-SUB)          DTSCS26
04828 *        ADD WRK-MQTR-TOLER-AMT (QTR-SUB, ACCT-SUB) TO            DTSCS26
04829 *          WRK-MQTR-TOLER-AMT (TOT-SUB, ACCT1-SUB)                DTSCS26
04830 *        ADD WRK-MQTR-BALANCE-AMT (QTR-SUB, ACCT-SUB) TO          DTSCS26
04831 *          WRK-MQTR-BALANCE-AMT (TOT-SUB, ACCT1-SUB)              DTSCS26
04832 *    END-PERFORM.                                                 DTSCS26
04833 *                                                                 DTSCS26
04834 *S7112-EXIT.                                                      DTSCS26
04835 *    EXIT.                                                        DTSCS26
04836 *                                                                 DTSCS26
04837 *S7119-TOT-ACCT-SUB.                                              DTSCS26
04838 *    MOVE ZERO                TO ACCT1-SUB.                       DTSCS26
04839 *                                                                 DTSCS26
04840 *    PERFORM                                                      DTSCS26
04841 *     VARYING ACCT2-SUB FROM +1 BY +1                             DTSCS26
04842 *     UNTIL ACCT2-SUB > WRK-MQTR-ACCT-CNT (TOT-SUB)               DTSCS26
04843 *       IF WRK-MQTR-ACCT-IND (TOT-SUB, ACCT2-SUB) =               DTSCS26
04844 *          WRK-MQTR-ACCT-IND (QTR-SUB, ACCT-SUB)                  DTSCS26
04845 *            MOVE ACCT2-SUB TO ACCT1-SUB                          DTSCS26
04846 *       END-IF                                                    DTSCS26
04847 *    END-PERFORM.                                                 DTSCS26
04848 *                                                                 DTSCS26
04849 *    IF ACCT1-SUB = ZERO                                          DTSCS26
04850 *       ADD +1 TO WRK-MQTR-ACCT-CNT (TOT-SUB)                     DTSCS26
04851 *       MOVE WRK-MQTR-ACCT-CNT (TOT-SUB) TO ACCT1-SUB.            DTSCS26
04852 *                                                                 DTSCS26
04853 *S7119-EXIT.                                                      DTSCS26
04854 *    EXIT.                                                        DTSCS26
04855 *                                                                 DTSCS26
04856 *                                                                 DTSCS26
04857 *S7120-DISTRIB-ADJ.                                               DTSCS26
04858 *    IF WRK-AMT = ZERO                                            DTSCS26
04859 *       GO TO S7120-EXIT.                                         DTSCS26
04860 *                                                                 DTSCS26
04861 *    MOVE WRK-AMT TO WRK-AMT-REMAIN.                              DTSCS26
04862 *    MOVE ZERO    TO WRK-LARGEST-AMT                              DTSCS26
04863 *                    WRK-LARGEST-YRQ.                             DTSCS26
04864 *                                                                 DTSCS26
04865 *                                                                 DTSCS26
04866 *&   IF AADJ-CHARGE-88                                            DTSCS26
04867 *        PERFORM S7121-DISTRIB-CHARGE THRU S7121-EXIT.            DTSCS26
04868 *&   ELSE                                                         DTSCS26
04869 *&   IF AADJ-WAIVE-88                                             DTSCS26
04870 *&       PERFORM S7122-DISTRIB-WAIVE  THRU S7122-EXIT.            DTSCS26
04871 *                                                                 DTSCS26
04872 *S7120-EXIT.                                                      DTSCS26
04873 *    EXIT.                                                        DTSCS26
04874 *                                                                 DTSCS26
04875 *S7121-DISTRIB-CHARGE.                                            DTSCS26
04876 *    MOVE ZERO TO WRK-TOT-AMT.                                    DTSCS26
04877 *    PERFORM S7128-TOT-SUB  THRU S7128-EXIT.                      DTSCS26
04878 *    IF ACCT2-SUB = ZERO                                          DTSCS26
04879 *       GO TO S7121-EXIT.                                         DTSCS26
04880 *                                                                 DTSCS26
04881 *    ADD WRK-MQTR-CHARGED-AMT (TOT-SUB, ACCT2-SUB)                DTSCS26
04882 *             TO WRK-TOT-AMT.                                     DTSCS26
04883 *    IF WRK-TOT-AMT = ZERO                                        DTSCS26
04884 *       GO TO S7121-EXIT.                                         DTSCS26
04885 *                                                                 DTSCS26
04886 *    PERFORM                                                      DTSCS26
04887 *       VARYING QTR-SUB FROM +1 BY +1                             DTSCS26
04888 *       UNTIL QTR-SUB > +4                                        DTSCS26
04889 *          MOVE ZERO TO WRK-QTR-AMT                               DTSCS26
04890 *          PERFORM S7129-ACCT-SUB  THRU S7129-EXIT                DTSCS26
04891 *          IF ACCT1-SUB > ZERO                                    DTSCS26
04892 *             ADD WRK-MQTR-CHARGED-AMT (QTR-SUB, ACCT1-SUB)       DTSCS26
04893 *                TO WRK-QTR-AMT                                   DTSCS26
04894 *             PERFORM S7127-CALC-AMT THRU S7127-EXIT              DTSCS26
04895 *          END-IF                                                 DTSCS26
04896 *    END-PERFORM.                                                 DTSCS26
04897 *                                                                 DTSCS26
04898 *    IF WRK-AMT-REMAIN NOT = ZERO                                 DTSCS26
04899 *       ADD WRK-AMT-REMAIN TO                                     DTSCS26
04900 *          WRK-MQTR-ADJ-AMT (WRK-LARGEST-YRQ).                    DTSCS26
04901 *                                                                 DTSCS26
04902 *S7121-EXIT.                                                      DTSCS26
04903 *    EXIT.                                                        DTSCS26
04904 *                                                                 DTSCS26
04905 *S7122-DISTRIB-WAIVE.                                             DTSCS26
04906 *    MOVE ZERO TO WRK-TOT-AMT.                                    DTSCS26
04907 *    PERFORM S7128-TOT-SUB  THRU S7128-EXIT.                      DTSCS26
04908 *    IF ACCT2-SUB = ZERO                                          DTSCS26
04909 *       GO TO S7122-EXIT.                                         DTSCS26
04910 *                                                                 DTSCS26
04911 *    ADD WRK-MQTR-WAIVED-AMT (TOT-SUB, ACCT2-SUB)                 DTSCS26
04912 *             TO WRK-TOT-AMT.                                     DTSCS26
04913 *    IF WRK-TOT-AMT = ZERO                                        DTSCS26
04914 *       GO TO S7122-EXIT.                                         DTSCS26
04915 *                                                                 DTSCS26
04916 *    PERFORM                                                      DTSCS26
04917 *       VARYING QTR-SUB FROM +1 BY +1                             DTSCS26
04918 *       UNTIL QTR-SUB > +4                                        DTSCS26
04919 *          MOVE ZERO TO WRK-QTR-AMT                               DTSCS26
04920 *          PERFORM S7129-ACCT-SUB  THRU S7129-EXIT                DTSCS26
04921 *          IF ACCT1-SUB > ZERO                                    DTSCS26
04922 *             ADD WRK-MQTR-WAIVED-AMT (QTR-SUB, ACCT1-SUB)        DTSCS26
04923 *                TO WRK-QTR-AMT                                   DTSCS26
04924 *             PERFORM S7127-CALC-AMT THRU S7127-EXIT              DTSCS26
04925 *          END-IF                                                 DTSCS26
04926 *    END-PERFORM.                                                 DTSCS26
04927 *                                                                 DTSCS26
04928 *    IF WRK-AMT-REMAIN NOT = ZERO                                 DTSCS26
04929 *       ADD WRK-AMT-REMAIN TO                                     DTSCS26
04930 *          WRK-MQTR-ADJ-AMT (WRK-LARGEST-YRQ).                    DTSCS26
04931 *                                                                 DTSCS26
04932 *S7122-EXIT.                                                      DTSCS26
04933 *    EXIT.                                                        DTSCS26
04934 *                                                                 DTSCS26
04935 *                                                                 DTSCS26
04936 *S7127-CALC-AMT.                                                  DTSCS26
04937 *    COMPUTE WRK-MQTR-ADJ-AMT (QTR-SUB) =                         DTSCS26
04938 *       WRK-AMT * (WRK-QTR-AMT / WRK-TOT-AMT).                    DTSCS26
04939 *                                                                 DTSCS26
04940 *    IF WRK-AMT > ZERO                                            DTSCS26
04941 *       SUBTRACT WRK-MQTR-ADJ-AMT (QTR-SUB) FROM                  DTSCS26
04942 *          WRK-AMT-REMAIN                                         DTSCS26
04943 *    ELSE                                                         DTSCS26
04944 *       COMPUTE WRK-AMT-REMAIN = WRK-AMT-REMAIN +                 DTSCS26
04945 *          (WRK-MQTR-ADJ-AMT (QTR-SUB) * -1)                      DTSCS26
04946 *    END-IF.                                                      DTSCS26
04947 *                                                                 DTSCS26
04948 *    IF WRK-MQTR-ADJ-AMT (QTR-SUB) > WRK-LARGEST-AMT              DTSCS26
04949 *       MOVE WRK-MQTR-ADJ-AMT (QTR-SUB)                           DTSCS26
04950 *                                  TO WRK-LARGEST-YRQ             DTSCS26
04951 *    END-IF.                                                      DTSCS26
04952 *                                                                 DTSCS26
04953 *S7127-EXIT.                                                      DTSCS26
04954 *    EXIT.                                                        DTSCS26
04955 *                                                                 DTSCS26
04956 *S7128-TOT-SUB.                                                   DTSCS26
04957 *    MOVE +0  TO ACCT2-SUB.                                       DTSCS26
04958 *                                                                 DTSCS26
04959 *    PERFORM                                                      DTSCS26
04960 *     VARYING ACCT-SUB FROM 1 BY 1                                DTSCS26
04961 *     UNTIL ACCT-SUB > WRK-MQTR-ACCT-CNT (TOT-SUB)                DTSCS26
04962 *       IF WRK-MQTR-ACCT-IND (TOT-SUB, ACCT-SUB)                  DTSCS26
04963 *                                      = AADJ-APPLIC-IND          DTSCS26
04964 *         MOVE ACCT-SUB TO ACCT2-SUB                              DTSCS26
04965 *       END-IF                                                    DTSCS26
04966 *    END-PERFORM.                                                 DTSCS26
04967 *                                                                 DTSCS26
04968 *S7128-EXIT.                                                      DTSCS26
04969 *    EXIT.                                                        DTSCS26
04970 *                                                                 DTSCS26
04971 *S7129-ACCT-SUB.                                                  DTSCS26
04972 *    MOVE +0   TO ACCT1-SUB.                                      DTSCS26
04973 *                                                                 DTSCS26
04974 *    PERFORM                                                      DTSCS26
04975 *     VARYING ACCT-SUB FROM 1 BY 1                                DTSCS26
04976 *     UNTIL ACCT-SUB > WRK-MQTR-ACCT-CNT (QTR-SUB)                DTSCS26
04977 *       IF WRK-MQTR-ACCT-IND (QTR-SUB, ACCT-SUB)                  DTSCS26
04978 *                                      = AADJ-APPLIC-IND          DTSCS26
04979 *          MOVE ACCT-SUB TO ACCT1-SUB                             DTSCS26
04980 *       END-IF                                                    DTSCS26
04981 *    END-PERFORM.                                                 DTSCS26
04982 *                                                                 DTSCS26
04983 *S7129-EXIT.                                                      DTSCS26
04984 *    EXIT.                                                        DTSCS26
04985 *                                                                 DTSCS26
04986  S7150-CHK-FOR-BYPASS.                                            DTSCS26
04987      IF AADJ-AUTO-88                                              DTSCS26
04988      OR AADJ-DUE-DATE-88                                          DTSCS26
04989      OR AADJ-WAIVE-DATE-88                                        DTSCS26
04990      OR AADJ-INT-DATE-88                                          DTSCS26
04991         NEXT SENTENCE                                             DTSCS26
04992      ELSE                                                         DTSCS26
04993         GO TO S7150-EXIT.                                         DTSCS26
04994                                                                   DTSCS26
04995      MOVE L004-QTR-5-9    TO MQTR-YRQ.                            DTSCS26
04996      MOVE MQTR-KEY-AREA   TO MSKL-KEY-AREA.                       DTSCS26
04997      PERFORM S810-READ    THRU S810-EXIT.                         DTSCS26
04998      IF L810-NO-REC-88                                            DTSCS26
04999         IF AADJ-AUTO-88                                           DTSCS26
05000            SET WRK-MQTR-BYPASS-YES-88 (QTR-SUB) TO TRUE           DTSCS26
05001         IF (AADJ-DUE-DATE-88                                      DTSCS26
05002         OR AADJ-WAIVE-DATE-88                                     DTSCS26
05003         OR AADJ-INT-DATE-88)                                      DTSCS26
05004            IF (AADJ-DATE-1 = +0 OR ALL-NINES-DATE)                DTSCS26
05005            AND (AADJ-DATE-2 = +0 OR ALL-NINES-DATE)               DTSCS26
05006               SET WRK-MQTR-BYPASS-YES-88 (QTR-SUB) TO TRUE.       DTSCS26
05007                                                                   DTSCS26
05008  S7150-EXIT.                                                      DTSCS26
05009      EXIT.                                                        DTSCS26
05010                                                                   DTSCS26
05011  S7200-READ-APPLIC-MDST.                                          DTSCS26
05012      MOVE LOW-VALUES TO MDST-KEY-AREA.                            DTSCS26
05013                                                                   DTSCS26
05014      MOVE WRK-EMP-NO TO MDST-EMP-NO.                              DTSCS26
05015                                                                   DTSCS26
05016      SET MDST-DST-88 TO TRUE.                                     DTSCS26
05017                                                                   DTSCS26
05018      SET MDST-CREDIT-REC-88 TO TRUE.                              DTSCS26
05019                                                                   DTSCS26
05020      MOVE WRK-APPLIC-DOC-NO TO MDST-DOC-NO.                       DTSCS26
05021                                                                   DTSCS26
05022      MOVE MDST-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS26
05023                                                                   DTSCS26
05024      PERFORM S810-READ THRU S810-EXIT.                            DTSCS26
05025                                                                   DTSCS26
05026      MOVE MSKL-REC TO MDST-REC.                                   DTSCS26
05027                                                                   DTSCS26
05028      IF L810-OK-88                                                DTSCS26
05029          MOVE 'Y' TO WRK-MDST-EXISTS-IND                          DTSCS26
05030      ELSE                                                         DTSCS26
05031          MOVE 'N' TO WRK-MDST-EXISTS-IND.                         DTSCS26
05032  S7200-EXIT.                                                      DTSCS26
05033      EXIT.                                                        DTSCS26
05034 /*****************************************************************DTSCS26
05035 * LOCK SCREEN FOR UPDATE CONFIRMATION                            *DTSCS26
05036 ******************************************************************DTSCS26
05037  S5100-SET-LOCK-ATTRB.                                            DTSCS26
05038      MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN                      DTSCS26
05039                                   WRK-ATB-NUM.                    DTSCS26
05040                                                                   DTSCS26
05041      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCS26
05042                                                                   DTSCS26
05043      MOVE CATB-ASKIP-BRT-MDTON TO MAP-BATCH-NO-A                  DTSCS26
05044                                   MAP-ITEM-NO-A                   DTSCS26
05045                                   MAP-GOTO-A.                     DTSCS26
05046  S5100-EXIT.                                                      DTSCS26
05047      EXIT.                                                        DTSCS26
05048                                                                   DTSCS26
05049                                                                   DTSCS26
05050                                                                   DTSCS26
05051 ******************************************************************DTSCS26
05052 * SET ATTIBUTE BYTES FOR UPDATE ACCESS                           *DTSCS26
05053 ******************************************************************DTSCS26
05054                                                                   DTSCS26
05055  S5200-SET-UPDATE-ATTRB.                                          DTSCS26
05056      MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN.                 DTSCS26
05057                                                                   DTSCS26
05058      MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM.               DTSCS26
05059                                                                   DTSCS26
05060      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCS26
05061  S5200-EXIT.                                                      DTSCS26
05062      EXIT.                                                        DTSCS26
05063                                                                   DTSCS26
05064                                                                   DTSCS26
05065                                                                   DTSCS26
05066 ******************************************************************DTSCS26
05067 *  SET ATTRIBUTE BYTES FOR INQUIRY STATUS                        *DTSCS26
05068 ******************************************************************DTSCS26
05069                                                                   DTSCS26
05070  S5300-SET-INQ-ATTRB.                                             DTSCS26
05071      MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN                     DTSCS26
05072                                    WRK-ATB-NUM.                   DTSCS26
05073                                                                   DTSCS26
05074      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCS26
05075  S5300-EXIT.                                                      DTSCS26
05076      EXIT.                                                        DTSCS26
05077                                                                   DTSCS26
05078                                                                   DTSCS26
05079                                                                   DTSCS26
05080  S5900-SET-ATTRB.                                                 DTSCS26
05081      MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-BATCH-NO-A             DTSCS26
05082                                        MAP-ITEM-NO-A.             DTSCS26
05083                                                                   DTSCS26
05084      MOVE WRK-ATB-AN                                              DTSCS26
05085        TO MAP-APPLIC-IND-A                                        DTSCS26
05086           MAP-DISREGARD-EDITS-IND-A                               DTSCS26
05087           MAP-NAME-CHECK-A                                        DTSCS26
05088           MAP-RESPONSIBLE-ACTIVITY-A                              DTSCS26
05089           MAP-RESPONSIBLE-OP-ID-A                                 DTSCS26
05090           MAP-ADJ-TYPE-A                                          DTSCS26
05091           MAP-INT-SPAN-IND-A                                      DTSCS26
05092           MAP-APPLIC-YRQ-Q-A                                      DTSCS26
05093           MAP-APPLIC-YRQ-YR-A.                                    DTSCS26
05094                                                                   DTSCS26
05095      MOVE WRK-ATB-NUM                                             DTSCS26
05096        TO MAP-EMP-NO-1-A                                          DTSCS26
05097           MAP-EMP-NO-2-A                                          DTSCS26
05098           MAP-RECEIVED-DATE-DA-A                                  DTSCS26
05099           MAP-RECEIVED-DATE-MO-A                                  DTSCS26
05100           MAP-RECEIVED-DATE-YR-A                                  DTSCS26
05101           MAP-DATE-1-DA-A                                         DTSCS26
05102           MAP-DATE-1-MO-A                                         DTSCS26
05103           MAP-DATE-1-YR-A                                         DTSCS26
05104           MAP-DATE-2-DA-A                                         DTSCS26
05105           MAP-DATE-2-MO-A                                         DTSCS26
05106           MAP-DATE-2-YR-A                                         DTSCS26
05107           MAP-ENTRY-MODE-A                                        DTSCS26
05108           MAP-AMT-A                                               DTSCS26
05109           MAP-APPLIC-BATCH-NO-A                                   DTSCS26
05110           MAP-APPLIC-ITEM-NO-A                                    DTSCS26
05111           MAP-INT-RATE-A.                                         DTSCS26
05112                                                                   DTSCS26
05113      MOVE CATB-ASKIP-NORM-MDTOFF  TO MAP-CMPRMISE-LABEL-A.        DTSCS26
05114      IF LCCM-OP-IS-FLD-DESK-88                                    DTSCS26
05115      OR LCCM-OP-IS-ACCOUNTING-DESK-88                             DTSCS26
05116         MOVE WRK-ATB-AN           TO MAP-CMPRMISE-IND-A           DTSCS26
05117      ELSE                                                         DTSCS26
05118         MOVE CATB-ASKIP-BRT-MDTON TO MAP-CMPRMISE-IND-A           DTSCS26
05119      END-IF.                                                      DTSCS26
05120                                                                   DTSCS26
05121      MOVE CATB-ASKIP-BRT-MDTON TO MAP-PROCESSED-DATE-A.           DTSCS26
05122                                                                   DTSCS26
05123      MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A.                 DTSCS26
05124  S5900-EXIT.                                                      DTSCS26
05125      EXIT.                                                        DTSCS26
05126 /*****************************************************************DTSCS26
05127 * MAP ROUTINES                                                   *DTSCS26
05128 ******************************************************************DTSCS26
05129                                                                   DTSCS26
05130  S9100-RECEIVE.                                                   DTSCS26
05131      SET L851-RECEIVE-88 TO TRUE.                                 DTSCS26
05132                                                                   DTSCS26
05133      MOVE WRK-SCR-ID TO L851-SCR-ID.                              DTSCS26
05134                                                                   DTSCS26
05135      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS26
05136                                                                   DTSCS26
05137      MOVE L851-AID TO LCCM-AID.                                   DTSCS26
05138                                                                   DTSCS26
05139      MOVE L851-CURSOR TO LCCM-CURSOR.                             DTSCS26
05140  S9100-EXIT.                                                      DTSCS26
05141      EXIT.                                                        DTSCS26
05142                                                                   DTSCS26
05143                                                                   DTSCS26
05144                                                                   DTSCS26
05145  S9200-SEND-DATAONLY.                                             DTSCS26
05146      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS26
05147                                                                   DTSCS26
05148      IF LCCM-NO-MSG                                               DTSCS26
05149          NEXT SENTENCE                                            DTSCS26
05150      ELSE                                                         DTSCS26
05151          PERFORM S805-MSG-AREA THRU S805-EXIT.                    DTSCS26
05152                                                                   DTSCS26
05153      IF CURSOR-SET-GOTO                                           DTSCS26
05154          MOVE CATB-CURSOR TO MAP-GOTO-L                           DTSCS26
05155      ELSE                                                         DTSCS26
05156          MOVE CATB-CURSOR TO MAP-BATCH-NO-L.                      DTSCS26
05157                                                                   DTSCS26
05158      SET L851-SEND-DATAONLY-88 TO TRUE.                           DTSCS26
05159                                                                   DTSCS26
05160      PERFORM S9900-PREPARE-SEND THRU S9900-EXIT.                  DTSCS26
05161                                                                   DTSCS26
05162      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS26
05163  S9200-EXIT.                                                      DTSCS26
05164      EXIT.                                                        DTSCS26
05165                                                                   DTSCS26
05166                                                                   DTSCS26
05167                                                                   DTSCS26
05168  S9300-SEND-MAP.                                                  DTSCS26
05169      MOVE  LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE.             DTSCS26
05170                                                                   DTSCS26
05171      MOVE  LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME.             DTSCS26
05172                                                                   DTSCS26
05173      MOVE  LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME.         DTSCS26
05174                                                                   DTSCS26
05175      IF SCR-ACCESS-UPDATE                                         DTSCS26
05176          PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT               DTSCS26
05177      ELSE                                                         DTSCS26
05178          PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT.             DTSCS26
05179                                                                   DTSCS26
05180      PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT.                   DTSCS26
05181                                                                   DTSCS26
05182      PERFORM S805-MSG-AREA THRU S805-EXIT.                        DTSCS26
05183                                                                   DTSCS26
05184      IF CURSOR-SET-NO                                             DTSCS26
05185          MOVE CATB-CURSOR TO MAP-BATCH-NO-L.                      DTSCS26
05186                                                                   DTSCS26
05187      SET L851-SEND-88 TO TRUE.                                    DTSCS26
05188                                                                   DTSCS26
05189      PERFORM S9900-PREPARE-SEND THRU S9900-EXIT.                  DTSCS26
05190                                                                   DTSCS26
05191      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS26
05192  S9300-EXIT.                                                      DTSCS26
05193      EXIT.                                                        DTSCS26
05194                                                                   DTSCS26
05195                                                                   DTSCS26
05196                                                                   DTSCS26
05197  S9310-UPDATE-FKEYS.                                              DTSCS26
05198      PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT.                 DTSCS26
05199                                                                   DTSCS26
05200      IF LCCM-SCR-CLEAR                                            DTSCS26
05201          MOVE 'ENTER=ADD' TO MAP-KEY-ENTER                        DTSCS26
05202      ELSE                                                         DTSCS26
05203      IF LCCM-SCR-INQUIRE                                          DTSCS26
05204          MOVE CFKD-MOD TO MAP-KEY-MOD                             DTSCS26
05205          MOVE CFKD-DEL TO MAP-KEY-DEL                             DTSCS26
05206      ELSE                                                         DTSCS26
05207      IF LCCM-SCR-UPDATE-LOCKED                                    DTSCS26
05208         MOVE LOW-VALUES TO MAP-KEY-BACK                           DTSCS26
05209                            MAP-KEY-FWRD                           DTSCS26
05210                            MAP-KEY-INQ.                           DTSCS26
05211  S9310-EXIT.                                                      DTSCS26
05212      EXIT.                                                        DTSCS26
05213                                                                   DTSCS26
05214                                                                   DTSCS26
05215                                                                   DTSCS26
05216  S9320-INQUIRY-FKEYS.                                             DTSCS26
05217      MOVE CFKD-BACKWARD TO MAP-KEY-BACK.                          DTSCS26
05218                                                                   DTSCS26
05219      MOVE CFKD-FORWARD TO MAP-KEY-FWRD.                           DTSCS26
05220                                                                   DTSCS26
05221      MOVE 'F9=INQ' TO MAP-KEY-INQ.                                DTSCS26
05222                                                                   DTSCS26
05223      MOVE LOW-VALUES TO MAP-KEY-ENTER                             DTSCS26
05224                         MAP-KEY-MOD                               DTSCS26
05225                         MAP-KEY-DEL.                              DTSCS26
05226  S9320-EXIT.                                                      DTSCS26
05227      EXIT.                                                        DTSCS26
05228                                                                   DTSCS26
05229                                                                   DTSCS26
05230                                                                   DTSCS26
05231  S9330-DSCR-FIELDS.                                               DTSCS26
05232      IF MAP-ENTRY-MODE-A = CATB-UNPROT-NORM-NUM-MDTON             DTSCS26
05233          NEXT SENTENCE                                            DTSCS26
05234      ELSE                                                         DTSCS26
05235          MOVE LCCM-ENTRY-MODE TO MAP-ENTRY-MODE.                  DTSCS26
05236                                                                   DTSCS26
05237      IF LCCM-OP-IS-FLD-DESK-88                                    DTSCS26
05238      OR LCCM-OP-IS-ACCOUNTING-DESK-88                             DTSCS26
05239         MOVE 'COMPROMISE?'    TO MAP-CMPRMISE-LABEL               DTSCS26
05240      END-IF.                                                      DTSCS26
05241                                                                   DTSCS26
05242 *****MOVE MAP-DOC-NO-AREA TO L019-S-DOC-NO.                       DTSCS26
05243                                                                   DTSCS26
05244 *****PERFORM S019-BATCH-NO-FROM-SCREEN THRU S019-EXIT.            DTSCS26
05245                                                                   DTSCS26
05246 *****IF L019-VALID                                                DTSCS26
05247 *********IF L372-BATCH-NO = L019-BATCH-NO                         DTSCS26
05248 *************NEXT SENTENCE                                        DTSCS26
05249 *********ELSE                                                     DTSCS26
05250 *************MOVE L019-BATCH-NO TO L372-BATCH-NO                  DTSCS26
05251 *************PERFORM S372-BATCH-INQUIRY THRU S372-EXIT.           DTSCS26
05252  S9330-EXIT.                                                      DTSCS26
05253      EXIT.                                                        DTSCS26
05254                                                                   DTSCS26
05255                                                                   DTSCS26
05256                                                                   DTSCS26
05257  S9900-PREPARE-SEND.                                              DTSCS26
05258      MOVE WRK-SCR-ID TO L851-SCR-ID                               DTSCS26
05259                         LCCM-SCR-ID.                              DTSCS26
05260                                                                   DTSCS26
05261      MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND.                    DTSCS26
05262                                                                   DTSCS26
05263      MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE.                         DTSCS26
05264  S9900-EXIT.                                                      DTSCS26
05265      EXIT.                                                        DTSCS26
