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