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