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