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