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