00001 IDENTIFICATION DIVISION. 07/28/14 00002 PROGRAM-ID. DTSCS31. DTSCS31 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV031 00004 DATE-WRITTEN. JUNE 1994. DTSCS31 00005 DATE-COMPILED. DTSCS31 00006 SKIP3 DTSCS31 00007 ***** DTSCS31 00008 * DTSCS31 00009 * FUNCTION: QUARTER INQUIRY SCREEN PROCESSOR. DTSCS31 00010 * DTSCS31 00011 * DTSCS31 00012 * MODIFICATION LOG: DTSCS31 00013 * DTSCS31 00014 * 12/22/98 INITIAL DEVELOPMENT. COPIED FROM MACCS31. DTSCS31 00015 * WORK ORDER: PROGRAMMER: ZL1 DTSCS31 00016 * DTSCS31 00017 * DTSCS31 00018 * 05/17/1999 PICKUP MODIFICATIONS. DTSCS31 00019 * REFERENCE: PICKUP DIR PROGRAMMER: EHH DTSCS31 00020 * DTSCS31 00021 * 11/20/2003 CORRECTED PAGING PROBLEM (F8 WHEN ANNUAL QUARTER DTSCS31 00022 * DISPLAYED. ADDED CODE TO P6000 TO RESET DTSCS31 00023 * WRK-FROM-YRQ TO QUARTER FOLLOWING END OF ANNUAL DTSCS31 00024 * REPORT. DTSCS31 00025 * REFERENCE: PROGRAMMER: GD DTSCS31 00026 * DTSCS31 00027 * DTSCS31 00028 * 06/08/2005 COMPROMISE SETTLEMENT PROBLEM - WHEN QUARTER DTSCS31 00029 * DID NOT EXIST, P6910 ABENDED WHILE REFERENCING DTSCS31 00030 * MQTR-CMP-ESTB-ABSTIME. DTSCS31 00031 * REFERENCE: PROGRAMMER: GD DTSCS31 00032 * DTSCS31 00033 * 02/20/2006 INTEREST CALCULATION MODIFIED - ONLY UI TAX DTSCS31 00034 * BALANCE USED IN CALCULATION - P6922, P7310. DTSCS31 00035 * REFERENCE: ADMIN ASSESSMENT PROGRAMMER: GD DTSCS31 00036 * DTSCS31 00037 * 02/12/2008 INTEREST CALCULATION MODIFIED TO INCLUDE DTSCS31 00038 * SUR TAX IN CALCULATION - P6922, P7310. DTSCS31 00039 * REFERENCE: ADMIN ASSESSMENT PROGRAMMER: ZL1 DTSCS31 00040 * DTSCS31 00041 * DTSCS31 00042 * 07/07/2014 MODIFIED P7100 NOT TO COUNT INACTIVE WIDTHDRAWN DTSCS31 00043 * SPANS OF LIABILITY IN #SPANS FIELD. DTSCS31 00044 * REFERENCE: SOL PROGRAMMER: ZL1 DTSCS31 00045 * DTSCS31 00046 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS31 00047 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS31 00048 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSCS31 00049 * DTSCS31 00050 * DTSCS31 00051 * DESCRIPTION: DTSCS31 00052 * DTSCS31 00053 * CLEAR: DTSCS31 00054 * DTSCS31 00055 * FIELD DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO). DTSCS31 00056 * DTSCS31 00057 * DTSCS31 00058 * JUMP: DTSCS31 00059 * DTSCS31 00060 * F09 NOTE PAD INQUIRY/UPDATE (71). DTSCS31 00061 * F10 REPORT INQUIRY (33). DTSCS31 00062 * F11 PAYMENT INQUIRY (34). DTSCS31 00063 * F12 ADJUSTMENT INQUIRY (35). DTSCS31 00064 * F17 REGISTRATION INQUIRY (11). DTSCS31 00065 * F20 COLLECTIONS INQUIRY (41). DTSCS31 00066 * DTSCS31 00067 * DTSCS31 00068 * INQUIRY: DTSCS31 00069 * DTSCS31 00070 * CONTROL FIELD(S): MAP-EMP-NO DTSCS31 00071 * MAP-START-YRQ DTSCS31 00072 * MAP-END-YRQ. DTSCS31 00073 * DTSCS31 00074 * DTSCS31 00075 * JUMP IN: IF LCCM-EMP-NO = +0 DTSCS31 00076 * DISPLAY 'PLEASE ENTER' MESSAGE DTSCS31 00077 * ELSE DTSCS31 00078 * IF LCCM-YRQ = +0 DTSCS31 00079 * DISPLAY LAST PAGE OF DATA ASSOCIATED DTSCS31 00080 * WITH LCCM-EMP-NO DTSCS31 00081 * ELSE DTSCS31 00082 * IF LCCM-YRQ MQTR RECORD EXISTS DTSCS31 00083 * DISPLAY THE LCCM-YRQ MQTR RECORD DTSCS31 00084 * ELSE DTSCS31 00085 * DISPLAY LAST PAGE OF DATA ASSOCIATED DTSCS31 00086 * WITH LCCM-EMP-NO. DTSCS31 00087 * DTSCS31 00088 * DTSCS31 00089 * DTSCS31 00090 * ENTER, F05, F06, F07, F08: PAGE THRU MQTR RECORD. DTSCS31 00091 * DTSCS31 00092 * MAP-END-YRQ HAS NO EFFECT WHEN DTSCS31 00093 * A PAGING FUNCTION KEY IS DTSCS31 00094 * PRESSED. DTSCS31 00095 * DTSCS31 00096 * DISPLAY SEQUENCE: ASCENDING ON MQTR-YRQ DTSCS31 00097 * (SEE SCREEN DESCRIPTION DTSCS31 00098 * FOR DETAILS). DTSCS31 00099 * DTSCS31 00100 * PAGE INITIALLY DISPLAYED: LAST. DTSCS31 00101 * DTSCS31 00102 * DTSCS31 00103 * TRY FOR SOME EFFICIENCY. DTSCS31 00104 * DTSCS31 00105 * . CONSTRUCT EMPLOYER LEVEL INFORMATION IN DTSCS31 00106 * LCCM-SCR-HOLD-AREA AND/OR IN TS. DTSCS31 00107 * DTSCS31 00108 * . SCAN MQTR RECORDS ONCE (RATHER THAN TWICE: ONCE DTSCS31 00109 * WHILE BUILDING EMPLOYER LEVEL INFORMATION; AND DTSCS31 00110 * ONCE WHILE BUILDING QUARTER LEVEL INFORMATION). DTSCS31 00111 * DTSCS31 00112 * . UNTIL EMP-NO CHANGES, COMP-DATE CHANGES, OR THE DTSCS31 00113 * HELD INFOMATION IS OUT OF DATE, DISPLAY SCREENS FROM DTSCS31 00114 * INFORMATION STORED IN LCCM-SCR-HOLD-AREA AND/OR TS. DTSCS31 00115 * DTSCS31 00116 * DTSCS31 00117 * JUMP OUT: STORE INFORMATION REPRESENTING PAGE DTSCS31 00118 * CURRENTLY DISPLAYED IN LCCM-SCR31-HOLD-AREA. DTSCS31 00119 * DTSCS31 00120 * DELETE TEMPORARY STORAGE QUEUE 'S'. DTSCS31 00121 * DTSCS31 00122 * DTSCS31 00123 * LCCM-MISC-CONTROL-AREA MAINTENANCE: DTSCS31 00124 * DTSCS31 00125 * LCCM-EMP-NO DTSCS31 00126 * DTSCS31 00127 * LCCM-YRQ DTSCS31 00128 * DTSCS31 00129 * LCCM-COMP-DATE DTSCS31 00130 * DTSCS31 00131 * DTSCS31 00132 * UPDATE: DTSCS31 00133 * DTSCS31 00134 * NONE. DTSCS31 00135 * DTSCS31 00136 * DTSCS31 00137 * RECORDS READ: DTSCS31 00138 * DTSCS31 00139 * MASTER: DTSCS31 00140 * DTSCS31 00141 * MPRF DTSCS31 00142 * MSOL DTSCS31 00143 * MQTR DTSCS31 00144 * MAPL DTSCS31 00145 * MLIN DTSCS31 00146 * MDPC DTSCS31 00147 * MCOL DTSCS31 00148 * DTSCS31 00149 * DTSCS31 00150 * ALTERNATE INDEX: DTSCS31 00151 * DTSCS31 00152 * NONE. DTSCS31 00153 * DTSCS31 00154 * DTSCS31 00155 * REFERENCE: DTSCS31 00156 * DTSCS31 00157 * NONE. DTSCS31 00158 * DTSCS31 00159 * DTSCS31 00160 * ACCOUNTING TRANSACTION COLLECTION: DTSCS31 00161 * DTSCS31 00162 * NONE. DTSCS31 00163 * DTSCS31 00164 * DTSCS31 00165 * RECORDS UPDATED: DTSCS31 00166 * DTSCS31 00167 * MASTER: DTSCS31 00168 * DTSCS31 00169 * NONE. DTSCS31 00170 * DTSCS31 00171 * DTSCS31 00172 * REFERENCE: DTSCS31 00173 * DTSCS31 00174 * NONE. DTSCS31 00175 * DTSCS31 00176 * DTSCS31 00177 * ACCOUNTING TRANSACTION COLLECTION: DTSCS31 00178 * DTSCS31 00179 * NONE. DTSCS31 00180 * DTSCS31 00181 * DTSCS31 00182 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCS31 00183 * DTSCS31 00184 * NONE. DTSCS31 00185 * DTSCS31 00186 * DTSCS31 00187 * TEMPORARY STORAGE USAGE: DTSCS31 00188 * DTSCS31 00189 * S IF NECESSARY FOR PAGE CONSTRUCTION/CONTROL. DTSCS31 00190 * DTSCS31 00191 * DTSCS31 00192 * MODULES LINKED TO: DTSCS31 00193 * DTSCS31 00194 * DTSCU001 DATE EDIT/CONVERSION. DTSCS31 00195 * DTSCU004 QUARTER EDIT/CONVERSION. DTSCS31 00196 * DTSCU015 DATE FROM SCREEN FORMAT/EDIT. DTSCS31 00197 * DTSCU016 YEAR/QUARTER FROM SCREEN FORMAT/EDIT. DTSCS31 00198 * DTSCU018 EMPLOYER NUMBER FROM SCREEN FORMAT/EDIT. DTSCS31 00199 * DTSCU031 EMPLOYER REGISTRATION CODES EDIT/DESCRIPTION. DTSCS31 00200 * DTSCU032 ACCOUNTING CODES EDIT/DESCRIPTION. DTSCS31 00201 * DTSCU033 REPORT TYPE/PURSUED DESCRIPTION. DTSCS31 00202 * DTSCU056 RATE DISPLAY. DTSCS31 00203 * DTSCU061 FIELD ZIP / FIELD REP ID. DTSCS31 00204 * DTSCU101 INTEREST AND PENALTY CHARGE/ABATEMENT DTSCS31 00205 * CALCULATION. DTSCS31 00206 * DTSCU109 AFT, FLA, SUR RATE LOOKUP. DTSCS31 00207 * DTSCU810 MASTER FILE INPUT/OUTPUT. DTSCS31 00208 * DTSCS31 00209 * DTSCS31 00210 * VERMONT REFERENCE: DTSCS31 00211 * DTSCS31 00212 * TXC210C. DTSCS31 00213 * DTSCS31 00214 ***** DTSCS31 00215 DTSCS31 00216 ENVIRONMENT DIVISION. DTSCS31 00217 DTSCS31 00218 DATA DIVISION. DTSCS31 00219 DTSCS31 00220 WORKING-STORAGE SECTION. DTSCS31 002205 77 PAN-VALET PICTURE X(24) VALUE '031DTSCS31 07/28/14'. DTSCS31 00221 77 PAN-VALET PICTURE X(24) VALUE '003DTSCS31 07/07/14'. DTSCS31 00222 77 PAN-VALET PICTURE X(24) VALUE '029DTSCS31 05/19/08'. DTSCS31 00223 DTSCS31 00224 01 WRK-LITS. DTSCS31 00225 05 LIT-UI-SUB PIC S9(04) COMP VALUE +1. DTSCS31 00226 05 LIT-SUR-SUB PIC S9(04) COMP VALUE +2. DTSCS31 00227 05 LIT-TAX-SUB PIC S9(04) COMP VALUE +3. DTSCS31 00228 05 LIT-INT-SUB PIC S9(04) COMP VALUE +4. DTSCS31 00229 05 LIT-LATE-PEN-SUB PIC S9(04) COMP VALUE +5. DTSCS31 00230 05 LIT-NSF-PEN-SUB PIC S9(04) COMP VALUE +6. DTSCS31 00231 05 LIT-MISC-PEN-SUB PIC S9(04) COMP VALUE +7. DTSCS31 00232 05 LIT-TOT-SUB PIC S9(04) COMP VALUE +8. DTSCS31 00233 DTSCS31 00234 05 LIT-CHARGED PIC S9(04) COMP VALUE +1. DTSCS31 00235 05 LIT-PAID PIC S9(04) COMP VALUE +2. DTSCS31 00236 05 LIT-WAIVED PIC S9(04) COMP VALUE +3. DTSCS31 00237 05 LIT-WOFF-TOLER PIC S9(04) COMP VALUE +4. DTSCS31 00238 05 LIT-BALANCE PIC S9(04) COMP VALUE +5. DTSCS31 00239 DTSCS31 00240 05 LIT-ZERO-YRQ PIC S9(05) COMP-3 VALUE +0. DTSCS31 00241 DTSCS31 00242 05 LIT-9-YRQ PIC S9(05) COMP-3 VALUE +99999. DTSCS31 00243 DTSCS31 00244 01 WRK-AREA. DTSCS31 00245 05 WRK-ABEND-CD PIC X(04) VALUE 'S31 '. DTSCS31 00246 DTSCS31 00247 05 WRK-SCR-ID. DTSCS31 00248 10 WRK-SCR-ID-N PIC 9(02) VALUE 31. DTSCS31 00249 DTSCS31 00250 05 WRK-F03-SCR-ID PIC X(02) VALUE '30'. DTSCS31 00251 DTSCS31 00252 05 ALL-NINES-DATE PIC S9(09) COMP-3 DTSCS31 00253 VALUE +999999999. DTSCS31 00254 DTSCS31 00255 05 SCR-ACCESS-IND PIC X(01). DTSCS31 00256 88 SCR-ACCESS-INQ VALUE '1'. DTSCS31 00257 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS31 00258 DTSCS31 00259 05 CURSOR-SET-IND PIC X(01). DTSCS31 00260 88 CURSOR-SET-YES VALUE 'Y'. DTSCS31 00261 88 CURSOR-SET-NO VALUE 'N'. DTSCS31 00262 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS31 00263 DTSCS31 00264 05 REQ-IND PIC X(01). DTSCS31 00265 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS31 00266 88 REQ-ERROR VALUE 'O'. DTSCS31 00267 88 REQ-JUMP VALUE 'J'. DTSCS31 00268 88 REQ-UPDATE VALUE 'U'. DTSCS31 00269 88 REQ-INQUIRE VALUE 'I'. DTSCS31 00270 88 REQ-CLEAR VALUE 'C'. DTSCS31 00271 88 REQ-EDIT VALUE 'E'. DTSCS31 00272 DTSCS31 00273 05 RESP-IND PIC X(01). DTSCS31 00274 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS31 00275 88 RESP-SEND-MAP VALUE 'M'. DTSCS31 00276 88 RESP-JUMP VALUE 'J'. DTSCS31 00277 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS31 00278 DTSCS31 00279 05 WRK-MSG-AREA PIC X(64). DTSCS31 00280 DTSCS31 00281 05 WRK-ATB-AN PIC X(01). DTSCS31 00282 DTSCS31 00283 05 WRK-ATB-NUM PIC X(01). DTSCS31 00284 DTSCS31 00285 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSCS31 00286 DTSCS31 00287 05 WRK-KEY-AREA PIC X(16). DTSCS31 00288 DTSCS31 00289 05 WRK-ROW PIC S9(04) COMP. DTSCS31 00290 DTSCS31 00291 05 WRK-COL PIC S9(04) COMP. DTSCS31 00292 DTSCS31 00293 05 WRK-FROM-YRQ PIC S9(05) COMP-3. DTSCS31 00294 88 WRK-FROM-NO-ENTRY VALUE +99998. DTSCS31 00295 DTSCS31 00296 05 WRK-TO-YRQ PIC S9(05) COMP-3. DTSCS31 00297 88 WRK-TO-NO-ENTRY VALUE +1. DTSCS31 00298 DTSCS31 00299 05 WRK-HOLD-FROM-YRQ-AREA PIC X(09). DTSCS31 00300 05 WRK-HOLD-TO-YRQ-AREA PIC X(09). DTSCS31 00301 DTSCS31 00302 05 WRK-MPRF-IND PIC X(01). DTSCS31 00303 88 WRK-MPRF-YES-88 VALUE 'Y'. DTSCS31 00304 88 WRK-MPRF-NO-88 VALUE 'N'. DTSCS31 00305 DTSCS31 00306 05 WRK-MQTR-IND PIC X(01). DTSCS31 00307 88 WRK-MQTR-YES-88 VALUE 'Y'. DTSCS31 00308 88 WRK-MQTR-NO-88 VALUE 'N'. DTSCS31 00309 DTSCS31 00310 05 WRK-RANGE-IND PIC X(01). DTSCS31 00311 88 WRK-RANGE-YES VALUE 'Y' 'A'. DTSCS31 00312 88 WRK-RANGE-NO VALUE 'N'. DTSCS31 00313 88 WRK-RANGE-ANNUAL VALUE 'A'. DTSCS31 00314 DTSCS31 00315 05 WRK-SUPPRESS-ANN-RANGE-IND PIC X(01). DTSCS31 00316 88 WRK-SUPPRESS-ANN-RANGE-YES VALUE 'Y'. DTSCS31 00317 88 WRK-SUPPRESS-ANN-RANGE-NO VALUE 'N'. DTSCS31 00318 DTSCS31 00319 05 WRK-DISPLAY-ZEROS-IND PIC X(01). DTSCS31 00320 88 WRK-DISPLAY-ZEROS-YES VALUE 'Y'. DTSCS31 00321 88 WRK-DISPLAY-ZEROS-NO VALUE 'N'. DTSCS31 00322 DTSCS31 00323 05 WRK-DISPLAY PIC 9(11). DTSCS31 00324 DTSCS31 00325 05 FILLER REDEFINES WRK-DISPLAY. DTSCS31 00326 10 FILLER PIC X(05). DTSCS31 00327 10 WRK-DISPLAY-EMP-NO-1 PIC X(03). DTSCS31 00328 10 WRK-DISPLAY-EMP-NO-2 PIC X(03). DTSCS31 00329 DTSCS31 00330 05 FILLER REDEFINES WRK-DISPLAY. DTSCS31 00331 10 FILLER PIC X(05). DTSCS31 00332 10 WRK-DISPLAY-YR PIC X(02). DTSCS31 00333 10 WRK-DISPLAY-MO PIC X(02). DTSCS31 00334 10 WRK-DISPLAY-DA PIC X(02). DTSCS31 00335 DTSCS31 00336 05 FILLER REDEFINES WRK-DISPLAY. DTSCS31 00337 10 FILLER PIC X(08). DTSCS31 00338 10 WRK-DISPLAY-YRQ-YR PIC X(02). DTSCS31 00339 10 WRK-DISPLAY-YRQ-Q PIC X(01). DTSCS31 00340 DTSCS31 00341 DTSCS31 00342 05 HOLD-EMP-AREA. DTSCS31 00343 10 HOLD-EMP-EMP-NO PIC S9(07) COMP-3. DTSCS31 00344 10 HOLD-EMP-COMP-DATE PIC S9(09) COMP-3. DTSCS31 00345 10 HOLD-EMP-ABSTIME PIC S9(15) COMP-3. DTSCS31 00346 DTSCS31 00347 10 HOLD-EMP-CLASS-DSCR PIC X(10). DTSCS31 00348 10 HOLD-EMP-STATUS-DSCR PIC X(10). DTSCS31 00349 DTSCS31 00350 10 HOLD-EMP-RECENT-SOL. DTSCS31 00351 15 HOLD-EMP-RECENT-FROM-YRQ PIC X(04). DTSCS31 00352 15 HOLD-EMP-RECENT-COLON PIC X(01). DTSCS31 00353 15 HOLD-EMP-RECENT-TO-YRQ PIC X(04). DTSCS31 00354 DTSCS31 00355 10 HOLD-EMP-NBR-SPANS PIC S9(04) COMP. DTSCS31 00356 DTSCS31 00357 10 HOLD-EMP-FLD-REP-ID PIC X(02). DTSCS31 00358 DTSCS31 00359 10 HOLD-EMP-OPEN-APL-IND PIC X(01). DTSCS31 00360 88 HOLD-EMP-OPEN-APL-YES-88 VALUE 'A'. DTSCS31 00361 10 HOLD-EMP-OPEN-LIN-IND PIC X(01). DTSCS31 00362 88 HOLD-EMP-OPEN-LIN-YES-88 VALUE 'L'. DTSCS31 00363 10 HOLD-EMP-OPEN-DPC-IND PIC X(01). DTSCS31 00364 88 HOLD-EMP-OPEN-DPC-YES-88 VALUE 'D'. DTSCS31 00365 DTSCS31 00366 10 HOLD-EMP-PICKUP-DUE-IND PIC X(01). DTSCS31 00367 88 HOLD-EMP-PICKUP-DUE-YES-88 VALUE 'Y'. DTSCS31 00368 DTSCS31 00369 10 HOLD-EMP-SUBPOENA-CD PIC X(01). DTSCS31 00370 10 HOLD-EMP-SUBPOENA-DATE PIC X(08). DTSCS31 00371 DTSCS31 00372 10 HOLD-EMP-TOT-DUE-AMT PIC S9(09)V9(02) COMP-3. DTSCS31 00373 DTSCS31 00374 10 HOLD-EMP-PER-MONTH-INT PIC S9(05)V9(02) COMP-3. DTSCS31 00375 DTSCS31 00376 10 HOLD-EMP-LAST-KEY-AREA PIC X(16). DTSCS31 00377 DTSCS31 00378 10 HOLD-EMP-LAST-PAGE PIC S9(04) COMP. DTSCS31 00379 DTSCS31 00380 DTSCS31 00381 05 HOLD-SCR-AREA. DTSCS31 00382 10 HOLD-SCR-KEY-AREA PIC X(16). DTSCS31 00383 10 HOLD-SCR-PAGE PIC S9(04) COMP. DTSCS31 00384 10 HOLD-SCR-ANN-RANGE-IND PIC X(01). DTSCS31 00385 88 HOLD-SCR-ANN-RANGE-YES VALUE 'Y'. DTSCS31 00386 88 HOLD-SCR-ANN-RANGE-NO VALUE 'N'. DTSCS31 00387 DTSCS31 00388 DTSCS31 00389 05 WRK-REC-FOUND-IND PIC X(01). DTSCS31 00390 DTSCS31 00391 05 WRK-CURR-PAGE PIC S9(04) COMP. DTSCS31 00392 DTSCS31 00393 DTSCS31 00394 05 RECS-IN-RANGE-CNT PIC S9(04) COMP. DTSCS31 00395 DTSCS31 00396 05 FIRST-REC-IN-RANGE-YRQ PIC S9(05) COMP-3. DTSCS31 00397 DTSCS31 00398 05 LAST-REC-IN-RANGE-YRQ PIC S9(05) COMP-3. DTSCS31 00399 DTSCS31 00400 DTSCS31 00401 05 WRK-QTR-OPEN-APL-IND PIC X(01). DTSCS31 00402 88 WRK-QTR-OPEN-APL-YES-88 VALUE 'A'. DTSCS31 00403 DTSCS31 00404 05 WRK-QTR-OPEN-LIN-IND PIC X(01). DTSCS31 00405 88 WRK-QTR-OPEN-LIN-YES-88 VALUE 'L'. DTSCS31 00406 DTSCS31 00407 05 WRK-QTR-OPEN-DPC-IND PIC X(01). DTSCS31 00408 88 WRK-QTR-OPEN-DPC-YES-88 VALUE 'D'. DTSCS31 00409 DTSCS31 00410 05 WRK-CURR-RPT-TYPE PIC X(01). DTSCS31 00411 88 WRK-CURR-RPT-TYPE-NULL-88 VALUE SPACES. DTSCS31 00412 DTSCS31 00413 DTSCS31 00414 01 WRK-BUCKETS. DTSCS31 00415 05 WRK-BUCKET-ROWS OCCURS 8 TIMES. DTSCS31 00416 10 WRK-BUCKET-COLS OCCURS 5 TIMES. DTSCS31 00417 15 WRK-BUCKET PIC S9(09)V9(02) COMP-3. DTSCS31 00418 DTSCS31 00419 01 WRK-WAGE-BUCKETS. DTSCS31 00420 05 WRK-TOT-WAGE-BUCKET PIC S9(09)V9(02) COMP-3. DTSCS31 00421 05 WRK-TAX-WAGE-BUCKET PIC S9(09)V9(02) COMP-3. DTSCS31 00422 05 WRK-EXCESS-WAGE-BUCKET PIC S9(09)V9(02) COMP-3. DTSCS31 00423 EJECT DTSCS31 00424 01 SCREEN-TITLE-AREA. DTSCS31 00425 05 WRK-SCREEN-TITLE PIC X(30). DTSCS31 00426 88 WRK-ANNUAL-SCREEN-TITLE DTSCS31 00427 VALUE '** ANNUAL QUARTER INQUIRY ** '. DTSCS31 00428 88 WRK-QTRLY-SCREEN-TITLE DTSCS31 00429 VALUE 'QUARTER INQUIRY '. DTSCS31 00430 DTSCS31 00431 01 MSG-LITERALS. DTSCS31 00432 DTSCS31 00433 05 MSG-E311-AREA. DTSCS31 00434 10 FILLER PIC X(04) VALUE 'E311'. DTSCS31 00435 10 FILLER PIC X(30) DTSCS31 00436 VALUE 'NO QUARTERS WITHIN SELECTED RA'. DTSCS31 00437 10 FILLER PIC X(30) DTSCS31 00438 VALUE 'NGE '. DTSCS31 00439 DTSCS31 00440 05 MSG-E312-AREA. DTSCS31 00441 10 FILLER PIC X(04) VALUE 'E312'. DTSCS31 00442 10 FILLER PIC X(30) DTSCS31 00443 VALUE 'IF RANGE OF QUARTERS REQUESTED'. DTSCS31 00444 10 FILLER PIC X(30) DTSCS31 00445 VALUE ', THEN PAGING IS NOT VALID '. DTSCS31 00446 EJECT DTSCS31 00447 01 L001-COMM-AREA. DTSCS31 00448 ++INCLUDE DTSIL001 DTSCS31 00449 EJECT DTSCS31 00450 01 L004-COMM-AREA. DTSCS31 00451 ++INCLUDE DTSIL004 DTSCS31 00452 EJECT DTSCS31 00453 01 L015-COMM-AREA. DTSCS31 00454 ++INCLUDE DTSIL015 DTSCS31 00455 EJECT DTSCS31 00456 *01 L016-COMM-AREA. DTSCS31 00457 ***INCLUDE DTSIL016 DTSCS31 00458 EJECT DTSCS31 00459 01 L018-COMM-AREA. DTSCS31 00460 ++INCLUDE DTSIL018 DTSCS31 00461 EJECT DTSCS31 00462 01 L029-COMM-AREA. DTSCS31 00463 ++INCLUDE DTSIL029 DTSCS31 00464 EJECT DTSCS31 00465 01 L031-COMM-AREA. DTSCS31 00466 ++INCLUDE DTSIL031 DTSCS31 00467 EJECT DTSCS31 00468 01 L032-COMM-AREA. DTSCS31 00469 ++INCLUDE DTSIL032 DTSCS31 00470 EJECT DTSCS31 00471 01 L033-COMM-AREA. DTSCS31 00472 ++INCLUDE DTSIL033 DTSCS31 00473 EJECT DTSCS31 00474 01 L056-COMM-AREA. DTSCS31 00475 ++INCLUDE DTSIL056 DTSCS31 00476 EJECT DTSCS31 00477 01 L061-COMM-AREA. DTSCS31 00478 ++INCLUDE DTSIL061 DTSCS31 00479 EJECT DTSCS31 00480 01 L101-COMM-AREA. DTSCS31 00481 ++INCLUDE DTSIL101 DTSCS31 00482 EJECT DTSCS31 00483 01 L109-COMM-AREA. DTSCS31 00484 ++INCLUDE DTSIL109 DTSCS31 00485 EJECT DTSCS31 00486 01 L410-COMM-AREA. DTSCS31 00487 ++INCLUDE DTSIL410 DTSCS31 00488 EJECT DTSCS31 00489 01 L805-COMM-AREA. DTSCS31 00490 ++INCLUDE DTSIL805 DTSCS31 00491 EJECT DTSCS31 00492 01 L810-COMM-AREA. DTSCS31 00493 05 L810-CONTROL-BLOCK. DTSCS31 00494 ++INCLUDE DTSIL810 DTSCS31 00495 EJECT DTSCS31 00496 05 MSKL-REC. DTSCS31 00497 ++INCLUDE DTSIMSKL DTSCS31 00498 EJECT DTSCS31 00499 01 MPRF-REC. DTSCS31 00500 ++INCLUDE DTSIMPRF DTSCS31 00501 EJECT DTSCS31 00502 01 MSOL-REC. DTSCS31 00503 ++INCLUDE DTSIMSOL DTSCS31 00504 EJECT DTSCS31 00505 01 MQTR-REC. DTSCS31 00506 ++INCLUDE DTSIMQTR DTSCS31 00507 EJECT DTSCS31 00508 01 MAPL-REC. DTSCS31 00509 ++INCLUDE DTSIMAPL DTSCS31 00510 EJECT DTSCS31 00511 01 MLIN-REC. DTSCS31 00512 ++INCLUDE DTSIMLIN DTSCS31 00513 EJECT DTSCS31 00514 01 MDPC-REC. DTSCS31 00515 ++INCLUDE DTSIMDPC DTSCS31 00516 EJECT DTSCS31 00517 01 MCOL-REC. DTSCS31 00518 ++INCLUDE DTSIMCOL DTSCS31 00519 EJECT DTSCS31 00520 01 L851-COMM-AREA. DTSCS31 00521 ++INCLUDE DTSIL851 DTSCS31 00522 DTSCS31 00523 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS31 00524 ++INCLUDE DTSIS31 DTSCS31 00525 EJECT DTSCS31 00526 01 CATB-LITERALS. DTSCS31 00527 ++INCLUDE DTSICATB DTSCS31 00528 DTSCS31 00529 01 CFKD-LITERALS. DTSCS31 00530 ++INCLUDE DTSICFKD DTSCS31 00531 DTSCS31 00532 01 CECD-LITERALS. DTSCS31 00533 ++INCLUDE DTSICECD DTSCS31 00534 DTSCS31 00535 01 CPCD-LITERALS. DTSCS31 00536 ++INCLUDE DTSICPCD DTSCS31 00537 EJECT DTSCS31 00538 LINKAGE SECTION. DTSCS31 00539 DTSCS31 00540 01 DFHCOMMAREA. DTSCS31 00541 ++INCLUDE DTSILCCM DTSCS31 00542 EJECT DTSCS31 00543 ******************************************************************DTSCS31 00544 * *DTSCS31 00545 ******************************************************************DTSCS31 00546 DTSCS31 00547 PROCEDURE DIVISION. DTSCS31 00548 DTSCS31 00549 MOVE +0 TO WRK-EMP-NO. DTSCS31 00550 DTSCS31 00551 SET WRK-MPRF-NO-88 TO TRUE. DTSCS31 00552 DTSCS31 00553 MOVE LOW-VALUES TO MAP-AREA. DTSCS31 00554 DTSCS31 00555 SET CURSOR-SET-NO TO TRUE. DTSCS31 00556 DTSCS31 00557 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N) DTSCS31 00558 TO SCR-ACCESS-IND. DTSCS31 00559 DTSCS31 00560 MOVE SPACE TO REQ-IND. DTSCS31 00561 DTSCS31 00562 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS31 00563 DTSCS31 00564 *----------------------------------------------------- DTSCS31 00565 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS31 00566 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS31 00567 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS31 00568 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS31 00569 * DTSCS31 00570 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS31 00571 * PROCESSED. DTSCS31 00572 * DTSCS31 00573 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS31 00574 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS31 00575 * WORK STATION OPERATOR. DTSCS31 00576 *----------------------------------------------------- DTSCS31 00577 DTSCS31 00578 MOVE SPACE TO RESP-IND. DTSCS31 00579 DTSCS31 00580 IF REQ-ERROR DTSCS31 00581 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS31 00582 ELSE DTSCS31 00583 IF REQ-JUMP DTSCS31 00584 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS31 00585 ELSE DTSCS31 00586 IF REQ-CLEAR DTSCS31 00587 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS31 00588 ELSE DTSCS31 00589 IF REQ-CURSOR-TO-GOTO DTSCS31 00590 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS31 00591 ELSE DTSCS31 00592 IF REQ-INQUIRE DTSCS31 00593 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS31 00594 ELSE DTSCS31 00595 GO TO S899-ABEND. DTSCS31 00596 DTSCS31 00597 *----------------------------------------------------- DTSCS31 00598 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS31 00599 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS31 00600 *----------------------------------------------------- DTSCS31 00601 DTSCS31 00602 IF RESP-SEND-MAP DTSCS31 00603 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS31 00604 SET LCCM-END-TASK-88 TO TRUE DTSCS31 00605 ELSE DTSCS31 00606 IF RESP-SEND-MSGONLY DTSCS31 00607 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS31 00608 SET LCCM-END-TASK-88 TO TRUE DTSCS31 00609 ELSE DTSCS31 00610 IF RESP-JUMP DTSCS31 00611 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS31 00612 ELSE DTSCS31 00613 IF RESP-CURSOR-TO-GOTO DTSCS31 00614 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS31 00615 SET LCCM-END-TASK-88 TO TRUE DTSCS31 00616 ELSE DTSCS31 00617 GO TO S899-ABEND. DTSCS31 00618 DTSCS31 00619 MAINLINE-EXIT. DTSCS31 00620 DTSCS31 00621 EXEC CICS DTSCS31 00622 RETURN DTSCS31 00623 END-EXEC. DTSCS31 00624 DTSCS31 00625 GOBACK. DTSCS31 00626 EJECT DTSCS31 00627 /*****************************************************************DTSCS31 00628 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS31 00629 ******************************************************************DTSCS31 00630 P1000-ANALYZE-REQUEST. DTSCS31 00631 DTSCS31 00632 *----------------------------------------------------- DTSCS31 00633 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS31 00634 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS31 00635 * REPLACED WITH ENTER) DTSCS31 00636 *----------------------------------------------------- DTSCS31 00637 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS31 00638 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA DTSCS31 00639 SET LCCM-ENTER-88 TO TRUE DTSCS31 00640 IF LCCM-EMP-NO = +0 DTSCS31 00641 MOVE +0 TO LCCM-YRQ DTSCS31 00642 MOVE PMSG-KEY-EMP-NO TO LCCM-MSG-AREA DTSCS31 00643 SET REQ-CLEAR TO TRUE DTSCS31 00644 ELSE DTSCS31 00645 SET REQ-INQUIRE TO TRUE DTSCS31 00646 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS31 00647 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS31 00648 PERFORM P1100-CHECK-LCCM-YRQ THRU P1100-EXIT DTSCS31 00649 END-IF DTSCS31 00650 GO TO P1000-EXIT. DTSCS31 00651 DTSCS31 00652 *----------------------------------------------------- DTSCS31 00653 * MAP IS RECEIVED DTSCS31 00654 *----------------------------------------------------- DTSCS31 00655 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS31 00656 DTSCS31 00657 *----------------------------------------------------- DTSCS31 00658 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS31 00659 * WORK STATION DTSCS31 00660 *----------------------------------------------------- DTSCS31 00661 IF LCCM-CLEAR-88 DTSCS31 00662 SET REQ-CLEAR TO TRUE DTSCS31 00663 GO TO P1000-EXIT. DTSCS31 00664 DTSCS31 00665 *----------------------------------------------------- DTSCS31 00666 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS31 00667 *----------------------------------------------------- DTSCS31 00668 IF LCCM-PA2-88 DTSCS31 00669 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS31 00670 GO TO P1000-EXIT. DTSCS31 00671 DTSCS31 00672 *----------------------------------------------------- DTSCS31 00673 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS31 00674 *----------------------------------------------------- DTSCS31 00675 IF LCCM-PA-88 DTSCS31 00676 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS31 00677 SET REQ-ERROR TO TRUE DTSCS31 00678 GO TO P1000-EXIT. DTSCS31 00679 DTSCS31 00680 *----------------------------------------------------- DTSCS31 00681 * IF F12 KEY IS PRESSED AND UPDATE NOT IN PROGRESS DTSCS31 00682 * CLEAR SCREEN DTSCS31 00683 *----------------------------------------------------- DTSCS31 00684 IF LCCM-F12-88 DTSCS31 00685 MOVE LOW-VALUES TO MAP-AREA DTSCS31 00686 SET REQ-CLEAR TO TRUE DTSCS31 00687 GO TO P1000-EXIT. DTSCS31 00688 DTSCS31 00689 *----------------------------------------------------- DTSCS31 00690 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS31 00691 *----------------------------------------------------- DTSCS31 00692 IF LCCM-F03-88 DTSCS31 00693 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS31 00694 SET REQ-JUMP TO TRUE DTSCS31 00695 GO TO P1000-EXIT. DTSCS31 00696 DTSCS31 00697 *----------------------------------------------------- DTSCS31 00698 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS31 00699 *----------------------------------------------------- DTSCS31 00700 IF LCCM-F04-88 DTSCS31 00701 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS31 00702 SET REQ-JUMP TO TRUE DTSCS31 00703 GO TO P1000-EXIT. DTSCS31 00704 DTSCS31 00705 *--------------------------------------------------------- DTSCS31 00706 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS31 00707 * CORRESPONDENCE SCREEN. DTSCS31 00708 *--------------------------------------------------------- DTSCS31 00709 DTSCS31 00710 IF LCCM-F14-88 DTSCS31 00711 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS31 00712 SET REQ-JUMP TO TRUE DTSCS31 00713 GO TO P1000-EXIT. DTSCS31 00714 DTSCS31 00715 *----------------------------------------------------- DTSCS31 00716 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS31 00717 * REQUESTED SCREEN TYPE DTSCS31 00718 *----------------------------------------------------- DTSCS31 00719 * DTSCS31 00720 * IF LCCM-F09-88 DTSCS31 00721 * MOVE '71' TO LCCM-REQ-SCR-ID DTSCS31 00722 * SET REQ-JUMP TO TRUE DTSCS31 00723 * GO TO P1000-EXIT. DTSCS31 00724 * DTSCS31 00725 * IF LCCM-F10-88 DTSCS31 00726 * MOVE '33' TO LCCM-REQ-SCR-ID DTSCS31 00727 * SET REQ-JUMP TO TRUE DTSCS31 00728 * GO TO P1000-EXIT. DTSCS31 00729 * DTSCS31 00730 * IF LCCM-F11-88 DTSCS31 00731 * MOVE '34' TO LCCM-REQ-SCR-ID DTSCS31 00732 * SET REQ-JUMP TO TRUE DTSCS31 00733 * GO TO P1000-EXIT. DTSCS31 00734 * DTSCS31 00735 * IF LCCM-F12-88 DTSCS31 00736 * MOVE '35' TO LCCM-REQ-SCR-ID DTSCS31 00737 * SET REQ-JUMP TO TRUE DTSCS31 00738 * GO TO P1000-EXIT. DTSCS31 00739 * DTSCS31 00740 * IF LCCM-F17-88 DTSCS31 00741 * MOVE '11' TO LCCM-REQ-SCR-ID DTSCS31 00742 * SET REQ-JUMP TO TRUE DTSCS31 00743 * GO TO P1000-EXIT. DTSCS31 00744 * DTSCS31 00745 * IF LCCM-F20-88 DTSCS31 00746 * MOVE '41' TO LCCM-REQ-SCR-ID DTSCS31 00747 * SET REQ-JUMP TO TRUE DTSCS31 00748 * GO TO P1000-EXIT. DTSCS31 00749 * DTSCS31 00750 *----------------------------------------------------- DTSCS31 00751 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS31 00752 * REQUESTED SCREEN TYPE DTSCS31 00753 *----------------------------------------------------- DTSCS31 00754 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS31 00755 NEXT SENTENCE DTSCS31 00756 ELSE DTSCS31 00757 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS31 00758 SET REQ-JUMP TO TRUE DTSCS31 00759 GO TO P1000-EXIT. DTSCS31 00760 DTSCS31 00761 *----------------------------------------------------- DTSCS31 00762 * IF INQUIRY TYPE KEY PRESSED (ENTER, F5, F6, F7, DTSCS31 00763 * OR F8), INDICATE INQUIRY REQUEST DTSCS31 00764 *----------------------------------------------------- DTSCS31 00765 IF LCCM-INQUIRY-88 DTSCS31 00766 SET REQ-INQUIRE TO TRUE DTSCS31 00767 GO TO P1000-EXIT. DTSCS31 00768 DTSCS31 00769 *----------------------------------------------------- DTSCS31 00770 * ANY OTHER KEY IS INVALID DTSCS31 00771 *----------------------------------------------------- DTSCS31 00772 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS31 00773 SET REQ-ERROR TO TRUE. DTSCS31 00774 P1000-EXIT. DTSCS31 00775 EXIT. DTSCS31 00776 DTSCS31 00777 DTSCS31 00778 P1100-CHECK-LCCM-YRQ. DTSCS31 00779 IF LCCM-YRQ = LIT-9-YRQ DTSCS31 00780 MOVE +0 TO LCCM-YRQ DTSCS31 00781 GO TO P1100-EXIT. DTSCS31 00782 DTSCS31 00783 IF LCCM-YRQ < LCCM-PICKUP-YRQ DTSCS31 00784 MOVE +0 TO LCCM-YRQ DTSCS31 00785 GO TO P1100-EXIT. DTSCS31 00786 DTSCS31 00787 IF LCCM-YRQ > +0 DTSCS31 00788 PERFORM P1110-DISPLAY-YRQ THRU P1110-EXIT DTSCS31 00789 GO TO P1100-EXIT. DTSCS31 00790 DTSCS31 00791 *****MOVE LCCM-SCR31-HOLD-AREA TO HOLD-SCR-AREA. DTSCS31 00792 *****IF HOLD-SCR-KEY-AREA NOT = LOW-VALUES DTSCS31 00793 ***** MOVE HOLD-SCR-KEY-AREA TO MQTR-KEY-AREA DTSCS31 00794 ***** IF MQTR-EMP-NO = LCCM-EMP-NO DTSCS31 00795 ***** IF MQTR-YRQ > +0 DTSCS31 00796 ***** MOVE MQTR-YRQ TO LCCM-YRQ DTSCS31 00797 ***** PERFORM P1110-DISPLAY-YRQ THRU P1110-EXIT. DTSCS31 00798 P1100-EXIT. DTSCS31 00799 EXIT. DTSCS31 00800 DTSCS31 00801 DTSCS31 00802 P1110-DISPLAY-YRQ. DTSCS31 00803 IF LCCM-YRQ = LCCM-PICKUP-YRQ DTSCS31 00804 MOVE 'PU' TO MAP-FROM-YRQ-YR DTSCS31 00805 MOVE ' ' TO MAP-FROM-YRQ-Q DTSCS31 00806 GO TO P1110-EXIT. DTSCS31 00807 DTSCS31 00808 MOVE LCCM-YRQ TO WRK-DISPLAY. DTSCS31 00809 MOVE WRK-DISPLAY-YRQ-YR TO MAP-FROM-YRQ-YR. DTSCS31 00810 MOVE WRK-DISPLAY-YRQ-Q TO MAP-FROM-YRQ-Q. DTSCS31 00811 P1110-EXIT. DTSCS31 00812 EXIT. DTSCS31 00813 /*****************************************************************DTSCS31 00814 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS31 00815 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS31 00816 ******************************************************************DTSCS31 00817 DTSCS31 00818 P2000-REQUEST-ERROR. DTSCS31 00819 IF LCCM-MSG DTSCS31 00820 SET RESP-SEND-MSGONLY TO TRUE DTSCS31 00821 ELSE DTSCS31 00822 GO TO S899-ABEND. DTSCS31 00823 P2000-EXIT. DTSCS31 00824 EXIT. DTSCS31 00825 /*****************************************************************DTSCS31 00826 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS31 00827 ******************************************************************DTSCS31 00828 DTSCS31 00829 P3000-REQUEST-JUMP. DTSCS31 00830 *----------------------------------------------------- DTSCS31 00831 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS31 00832 * BY USER DTSCS31 00833 *----------------------------------------------------- DTSCS31 00834 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS31 00835 DTSCS31 00836 *----------------------------------------------------- DTSCS31 00837 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS31 00838 *----------------------------------------------------- DTSCS31 00839 IF LCCM-MSG DTSCS31 00840 SET RESP-SEND-MSGONLY TO TRUE DTSCS31 00841 SET CURSOR-SET-GOTO TO TRUE DTSCS31 00842 GO TO P3000-EXIT. DTSCS31 00843 SKIP3 DTSCS31 00844 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS31 00845 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS31 00846 IF L018-VALID DTSCS31 00847 MOVE L018-EMP-NO TO LCCM-EMP-NO DTSCS31 00848 DTSCS31 00849 MOVE MAP-FROM-YRQ-AREA TO L029-S-YRQ-AREA DTSCS31 00850 PERFORM S029-YRQ-WITH-PU-FROM-SCREEN THRU S029-EXIT DTSCS31 00851 IF L029-VALID DTSCS31 00852 MOVE L029-YRQ TO LCCM-YRQ. DTSCS31 00853 DTSCS31 00854 *----------------------------------------------------- DTSCS31 00855 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS31 00856 *----------------------------------------------------- DTSCS31 00857 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS31 00858 LCCM-SCR-HOLD-AREA. DTSCS31 00859 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS31 00860 SET RESP-JUMP TO TRUE. DTSCS31 00861 P3000-EXIT. DTSCS31 00862 EXIT. DTSCS31 00863 /*****************************************************************DTSCS31 00864 * CLEAR KEY WAS PRESSED *DTSCS31 00865 ******************************************************************DTSCS31 00866 DTSCS31 00867 P4000-REQUEST-CLEAR. DTSCS31 00868 DTSCS31 00869 *----------------------------------------------------- DTSCS31 00870 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS31 00871 * FIELDS FROM EARLIER REQUESTS DTSCS31 00872 *----------------------------------------------------- DTSCS31 00873 IF LCCM-EMP-NO > ZERO DTSCS31 00874 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS31 00875 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS31 00876 DTSCS31 00877 MOVE ZERO TO LCCM-EMP-NO DTSCS31 00878 LCCM-YRQ. DTSCS31 00879 DTSCS31 00880 MOVE LOW-VALUES TO LCCM-SCR31-HOLD-AREA DTSCS31 00881 LCCM-SCR-HOLD-AREA. DTSCS31 00882 DTSCS31 00883 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS31 00884 DTSCS31 00885 SET LCCM-SCR-CLEAR TO TRUE. DTSCS31 00886 DTSCS31 00887 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS31 00888 DTSCS31 00889 SET RESP-SEND-MAP TO TRUE. DTSCS31 00890 P4000-EXIT. DTSCS31 00891 EXIT. DTSCS31 00892 /*****************************************************************DTSCS31 00893 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS31 00894 ******************************************************************DTSCS31 00895 DTSCS31 00896 P5000-CURSOR-TO-GOTO. DTSCS31 00897 SET CURSOR-SET-GOTO TO TRUE. DTSCS31 00898 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS31 00899 P5000-EXIT. DTSCS31 00900 EXIT. DTSCS31 00901 /*****************************************************************DTSCS31 00902 * INQUIRY WAS REQUESTED *DTSCS31 00903 ******************************************************************DTSCS31 00904 DTSCS31 00905 P6000-REQUEST-INQUIRE. DTSCS31 00906 * *-------------------------------- DTSCS31 00907 * * SAVE 'KEY' INFORMATION FROM THE DTSCS31 00908 *------------------------------ * SCREEN PRIOR TO CLEARING IT DTSCS31 00909 * * THEN PUT IT BACK DTSCS31 00910 * *-------------------------------- DTSCS31 00911 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS31 00912 MOVE MAP-COMP-DATE-AREA TO L015-S-DATE-AREA. DTSCS31 00913 MOVE MAP-FROM-YRQ-AREA TO WRK-HOLD-FROM-YRQ-AREA. DTSCS31 00914 MOVE MAP-TO-YRQ-AREA TO WRK-HOLD-TO-YRQ-AREA. DTSCS31 00915 DTSCS31 00916 MOVE LOW-VALUES TO MAP-AREA. DTSCS31 00917 DTSCS31 00918 MOVE L018-S-EMP-NO-AREA TO MAP-EMP-NO-AREA. DTSCS31 00919 MOVE L015-S-DATE-AREA TO MAP-COMP-DATE-AREA. DTSCS31 00920 MOVE WRK-HOLD-FROM-YRQ-AREA TO MAP-FROM-YRQ-AREA. DTSCS31 00921 MOVE WRK-HOLD-TO-YRQ-AREA TO MAP-TO-YRQ-AREA. DTSCS31 00922 DTSCS31 00923 * *-------------------------------- DTSCS31 00924 *------------------------------ * SCREEN AREA INITIALIZATION DTSCS31 00925 * *-------------------------------- DTSCS31 00926 SET LCCM-SCR-CLEAR TO TRUE. DTSCS31 00927 DTSCS31 00928 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS31 00929 DTSCS31 00930 SET RESP-SEND-MAP TO TRUE. DTSCS31 00931 DTSCS31 00932 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS31 00933 DTSCS31 00934 MOVE LCCM-SCR31-HOLD-AREA TO HOLD-SCR-AREA. DTSCS31 00935 DTSCS31 00936 MOVE LOW-VALUES TO LCCM-SCR31-HOLD-AREA. DTSCS31 00937 DTSCS31 00938 MOVE LCCM-SCR-HOLD-AREA TO HOLD-EMP-AREA. DTSCS31 00939 DTSCS31 00940 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA. DTSCS31 00941 DTSCS31 00942 SET WRK-CURR-RPT-TYPE-NULL-88 TO TRUE. DTSCS31 00943 DTSCS31 00944 * *-------------------------------- DTSCS31 00945 *------------------------------ * EDIT SCREEN KEY AREAS DTSCS31 00946 * *-------------------------------- DTSCS31 00947 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS31 00948 DTSCS31 00949 IF LCCM-MSG DTSCS31 00950 NEXT SENTENCE DTSCS31 00951 ELSE DTSCS31 00952 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS31 00953 DTSCS31 00954 PERFORM S1200-FROM-TO-YRQ THRU S1200-EXIT. DTSCS31 00955 DTSCS31 00956 PERFORM S1300-COMP-DATE THRU S1300-EXIT. DTSCS31 00957 DTSCS31 00958 IF LCCM-MSG DTSCS31 00959 GO TO P6000-EXIT. DTSCS31 00960 DTSCS31 00961 * *-------------------------------- DTSCS31 00962 *------------------------------ * RANGE ONLY ALLOWED ON ENTER DTSCS31 00963 * *-------------------------------- DTSCS31 00964 DTSCS31 00965 IF HOLD-SCR-ANN-RANGE-YES DTSCS31 00966 NEXT SENTENCE DTSCS31 00967 ELSE DTSCS31 00968 IF WRK-RANGE-YES DTSCS31 00969 IF LCCM-ENTER-88 DTSCS31 00970 NEXT SENTENCE DTSCS31 00971 ELSE DTSCS31 00972 MOVE MSG-E312-AREA TO WRK-MSG-AREA DTSCS31 00973 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS31 00974 PERFORM S1202-ERROR THRU S1202-EXIT DTSCS31 00975 GO TO P6000-EXIT. DTSCS31 00976 DTSCS31 00977 * *-------------------------------- DTSCS31 00978 * * DETERMINE IF EMPLOYER LEVEL DTSCS31 00979 * * INFORMATION MUST BE ASSEMBLED DTSCS31 00980 *------------------------------ * INTO HOLD-EMP-AREA. IF THE DTSCS31 00981 * * EMPLOYER LEVEL INFORMATION MUST DTSCS31 00982 * * BE ASSEMBLED, THEN DO SO. DTSCS31 00983 * *-------------------------------- DTSCS31 00984 DTSCS31 00985 IF (HOLD-EMP-AREA = LOW-VALUES) DTSCS31 00986 OR DTSCS31 00987 (WRK-EMP-NO NOT = HOLD-EMP-EMP-NO) DTSCS31 00988 OR DTSCS31 00989 (LCCM-COMP-DATE NOT = HOLD-EMP-COMP-DATE) DTSCS31 00990 OR DTSCS31 00991 (HOLD-EMP-ABSTIME < MPRF-UPDATE-END-ABSTIME) DTSCS31 00992 PERFORM P7000-REFRESH-HOLD-EMP-AREA THRU P7000-EXIT. DTSCS31 00993 DTSCS31 00994 MOVE HOLD-EMP-AREA TO LCCM-SCR-HOLD-AREA. DTSCS31 00995 DTSCS31 00996 IF HOLD-EMP-LAST-PAGE = +0 DTSCS31 00997 PERFORM P6910-TOP-OF-SCREEN THRU P6910-EXIT DTSCS31 00998 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS31 00999 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS31 01000 GO TO P6000-EXIT. DTSCS31 01001 DTSCS31 01002 IF HOLD-SCR-ANN-RANGE-YES DTSCS31 01003 IF (LCCM-F05-88 DTSCS31 01004 OR LCCM-F06-88 DTSCS31 01005 OR LCCM-F07-88 DTSCS31 01006 OR LCCM-F08-88) DTSCS31 01007 SET WRK-RANGE-NO TO TRUE DTSCS31 01008 IF LCCM-F08-88 DTSCS31 01009 MOVE WRK-TO-YRQ TO L004-QTR-5-9 DTSCS31 01010 PERFORM S004-FROM-5 THRU S004-EXIT DTSCS31 01011 ADD +1 TO L004-ABS-QTR DTSCS31 01012 PERFORM S004-FROM-ABS THRU S004-EXIT DTSCS31 01013 MOVE L004-QTR-5-9 TO WRK-FROM-YRQ. DTSCS31 01014 DTSCS31 01015 IF WRK-RANGE-YES DTSCS31 01016 PERFORM P6200-LOCATE-RANGE THRU P6200-EXIT DTSCS31 01017 IF LCCM-MSG DTSCS31 01018 PERFORM P6910-TOP-OF-SCREEN THRU P6910-EXIT DTSCS31 01019 GO TO P6000-EXIT. DTSCS31 01020 DTSCS31 01021 IF WRK-RANGE-NO DTSCS31 01022 PERFORM P6100-LOCATE-REC THRU P6100-EXIT DTSCS31 01023 IF LCCM-MSG DTSCS31 01024 PERFORM P6910-TOP-OF-SCREEN THRU P6910-EXIT DTSCS31 01025 GO TO P6000-EXIT DTSCS31 01026 ELSE DTSCS31 01027 MOVE MQTR-YRQ TO WRK-FROM-YRQ DTSCS31 01028 WRK-TO-YRQ. DTSCS31 01029 DTSCS31 01030 SET WRK-QTRLY-SCREEN-TITLE TO TRUE. DTSCS31 01031 MOVE WRK-SCREEN-TITLE TO MAP-SCREEN-TITLE. DTSCS31 01032 DTSCS31 01033 IF WRK-SUPPRESS-ANN-RANGE-YES DTSCS31 01034 NEXT SENTENCE DTSCS31 01035 ELSE DTSCS31 01036 IF MQTR-ANNUAL-YES-88 DTSCS31 01037 PERFORM P6010-SET-ANN-RANGE THRU P6010-EXIT DTSCS31 01038 PERFORM P6200-LOCATE-RANGE THRU P6200-EXIT DTSCS31 01039 IF LCCM-MSG DTSCS31 01040 PERFORM P6910-TOP-OF-SCREEN THRU P6910-EXIT DTSCS31 01041 GO TO P6000-EXIT DTSCS31 01042 ELSE DTSCS31 01043 SET WRK-ANNUAL-SCREEN-TITLE TO TRUE DTSCS31 01044 MOVE WRK-SCREEN-TITLE TO MAP-SCREEN-TITLE DTSCS31 01045 MOVE CATB-ASKIP-BRT-MDTOFF DTSCS31 01046 TO MAP-SCREEN-TITLE-A. DTSCS31 01047 DTSCS31 01048 DTSCS31 01049 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS31 01050 DTSCS31 01051 MOVE WRK-FROM-YRQ TO LCCM-YRQ. DTSCS31 01052 DTSCS31 01053 IF WRK-RANGE-ANNUAL DTSCS31 01054 SET HOLD-SCR-ANN-RANGE-YES TO TRUE DTSCS31 01055 PERFORM P6940-SET-RPT-TYPE THRU P6940-EXIT DTSCS31 01056 ELSE DTSCS31 01057 SET HOLD-SCR-ANN-RANGE-NO TO TRUE. DTSCS31 01058 DTSCS31 01059 SET WRK-CURR-RPT-TYPE-NULL-88 TO TRUE. DTSCS31 01060 DTSCS31 01061 MOVE HOLD-SCR-AREA TO LCCM-SCR31-HOLD-AREA. DTSCS31 01062 DTSCS31 01063 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS31 01064 DTSCS31 01065 P6000-EXIT. DTSCS31 01066 EXIT. DTSCS31 01067 DTSCS31 01068 P6010-SET-ANN-RANGE. DTSCS31 01069 SET WRK-RANGE-ANNUAL TO TRUE. DTSCS31 01070 DTSCS31 01071 MOVE MQTR-YRQ TO L004-QTR-5-9. DTSCS31 01072 MOVE 1 TO L004-QTR-5-Q. DTSCS31 01073 MOVE L004-QTR-5-9 TO WRK-FROM-YRQ. DTSCS31 01074 MOVE 4 TO L004-QTR-5-Q. DTSCS31 01075 MOVE L004-QTR-5-9 TO WRK-TO-YRQ. DTSCS31 01076 DTSCS31 01077 P6010-EXIT. DTSCS31 01078 EXIT. DTSCS31 01079 /*****************************************************************DTSCS31 01080 * A RANGE OF QUARTERS WAS NOT REQUESED. *DTSCS31 01081 ******************************************************************DTSCS31 01082 P6100-LOCATE-REC. DTSCS31 01083 *------------------------------------------------------------ DTSCS31 01084 * DTSCS31 01085 *------------------------------------------------------------ DTSCS31 01086 DTSCS31 01087 IF LCCM-F05-88 DTSCS31 01088 PERFORM P6110-FIRST-REC THRU P6110-EXIT DTSCS31 01089 GO TO P6100-EXIT. DTSCS31 01090 DTSCS31 01091 IF LCCM-F06-88 DTSCS31 01092 PERFORM P6140-LAST-REC THRU P6140-EXIT DTSCS31 01093 GO TO P6100-EXIT. DTSCS31 01094 DTSCS31 01095 IF WRK-FROM-NO-ENTRY DTSCS31 01096 PERFORM P6140-LAST-REC THRU P6140-EXIT DTSCS31 01097 GO TO P6100-EXIT. DTSCS31 01098 DTSCS31 01099 DTSCS31 01100 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSCS31 01101 MOVE WRK-EMP-NO TO MQTR-EMP-NO. DTSCS31 01102 SET MQTR-QTR-88 TO TRUE. DTSCS31 01103 MOVE WRK-FROM-YRQ TO MQTR-YRQ. DTSCS31 01104 DTSCS31 01105 IF HOLD-SCR-KEY-AREA = MQTR-KEY-AREA DTSCS31 01106 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA DTSCS31 01107 PERFORM S810-START-BROWSE THRU S810-EXIT DTSCS31 01108 IF L810-OK-88 DTSCS31 01109 IF MSKL-KEY-AREA = MQTR-KEY-AREA DTSCS31 01110 MOVE HOLD-SCR-PAGE TO WRK-CURR-PAGE DTSCS31 01111 MOVE MSKL-REC TO MQTR-REC DTSCS31 01112 IF LCCM-ENTER-88 DTSCS31 01113 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS31 01114 GO TO P6100-EXIT DTSCS31 01115 ELSE DTSCS31 01116 IF LCCM-F07-88 DTSCS31 01117 PERFORM P6120-PREV-REC THRU P6120-EXIT DTSCS31 01118 GO TO P6100-EXIT DTSCS31 01119 ELSE DTSCS31 01120 IF LCCM-F08-88 DTSCS31 01121 PERFORM P6130-NEXT-REC THRU P6130-EXIT DTSCS31 01122 GO TO P6100-EXIT DTSCS31 01123 ELSE DTSCS31 01124 GO TO S899-ABEND DTSCS31 01125 ELSE DTSCS31 01126 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS31 01127 DTSCS31 01128 DTSCS31 01129 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS31 01130 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS31 01131 SET MSKL-QTR-88 TO TRUE. DTSCS31 01132 DTSCS31 01133 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS31 01134 DTSCS31 01135 IF L810-NO-REC-88 DTSCS31 01136 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS31 01137 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS31 01138 GO TO P6100-EXIT. DTSCS31 01139 DTSCS31 01140 MOVE +0 TO WRK-CURR-PAGE. DTSCS31 01141 DTSCS31 01142 MOVE 'N' TO WRK-REC-FOUND-IND. DTSCS31 01143 DTSCS31 01144 PERFORM P6190-BROWSE-MQTR THRU P6190-EXIT DTSCS31 01145 UNTIL (L810-NO-REC-88) DTSCS31 01146 OR DTSCS31 01147 (WRK-REC-FOUND-IND = 'Y'). DTSCS31 01148 DTSCS31 01149 IF L810-NO-REC-88 DTSCS31 01150 IF LCCM-ENTER-88 DTSCS31 01151 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS31 01152 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS31 01153 ELSE DTSCS31 01154 PERFORM P6140-LAST-REC THRU P6140-EXIT DTSCS31 01155 ELSE DTSCS31 01156 IF LCCM-ENTER-88 DTSCS31 01157 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS31 01158 IF MQTR-YRQ = WRK-FROM-YRQ DTSCS31 01159 NEXT SENTENCE DTSCS31 01160 ELSE DTSCS31 01161 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS31 01162 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS31 01163 ELSE DTSCS31 01164 IF LCCM-F07-88 DTSCS31 01165 PERFORM P6120-PREV-REC THRU P6120-EXIT DTSCS31 01166 ELSE DTSCS31 01167 IF LCCM-F08-88 DTSCS31 01168 PERFORM P6130-NEXT-REC THRU P6130-EXIT DTSCS31 01169 ELSE DTSCS31 01170 GO TO S899-ABEND. DTSCS31 01171 P6100-EXIT. DTSCS31 01172 EXIT. DTSCS31 01173 DTSCS31 01174 /*****************************************************************DTSCS31 01175 * *DTSCS31 01176 ******************************************************************DTSCS31 01177 P6110-FIRST-REC. DTSCS31 01178 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS31 01179 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS31 01180 SET MSKL-QTR-88 TO TRUE. DTSCS31 01181 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS31 01182 IF L810-NO-REC-88 DTSCS31 01183 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS31 01184 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS31 01185 GO TO P6110-EXIT. DTSCS31 01186 DTSCS31 01187 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS31 01188 DTSCS31 01189 MOVE MSKL-REC TO MQTR-REC. DTSCS31 01190 DTSCS31 01191 MOVE +1 TO WRK-CURR-PAGE. DTSCS31 01192 P6110-EXIT. DTSCS31 01193 EXIT. DTSCS31 01194 DTSCS31 01195 P6120-PREV-REC. DTSCS31 01196 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCS31 01197 IF L810-NO-REC-88 DTSCS31 01198 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS31 01199 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS31 01200 GO TO P6120-EXIT. DTSCS31 01201 DTSCS31 01202 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCS31 01203 IF L810-NO-REC-88 DTSCS31 01204 GO TO P6120-EXIT. DTSCS31 01205 DTSCS31 01206 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS31 01207 DTSCS31 01208 SUBTRACT 1 FROM WRK-CURR-PAGE. DTSCS31 01209 DTSCS31 01210 MOVE MSKL-REC TO MQTR-REC. DTSCS31 01211 P6120-EXIT. DTSCS31 01212 EXIT. DTSCS31 01213 DTSCS31 01214 P6130-NEXT-REC. DTSCS31 01215 IF MQTR-YRQ > WRK-FROM-YRQ DTSCS31 01216 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS31 01217 GO TO P6130-EXIT. DTSCS31 01218 DTSCS31 01219 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS31 01220 DTSCS31 01221 IF L810-NO-REC-88 DTSCS31 01222 GO TO P6130-EXIT. DTSCS31 01223 DTSCS31 01224 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS31 01225 DTSCS31 01226 ADD +1 TO WRK-CURR-PAGE. DTSCS31 01227 DTSCS31 01228 MOVE MSKL-REC TO MQTR-REC. DTSCS31 01229 P6130-EXIT. DTSCS31 01230 EXIT. DTSCS31 01231 DTSCS31 01232 P6140-LAST-REC. DTSCS31 01233 MOVE HOLD-EMP-LAST-KEY-AREA TO MSKL-KEY-AREA. DTSCS31 01234 PERFORM S810-READ THRU S810-EXIT. DTSCS31 01235 IF L810-NO-REC-88 DTSCS31 01236 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS31 01237 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS31 01238 GO TO P6140-EXIT. DTSCS31 01239 DTSCS31 01240 MOVE MSKL-REC TO MQTR-REC. DTSCS31 01241 DTSCS31 01242 MOVE HOLD-EMP-LAST-PAGE TO WRK-CURR-PAGE. DTSCS31 01243 P6140-EXIT. DTSCS31 01244 EXIT. DTSCS31 01245 DTSCS31 01246 DTSCS31 01247 P6190-BROWSE-MQTR. DTSCS31 01248 MOVE MSKL-REC TO MQTR-REC. DTSCS31 01249 DTSCS31 01250 ADD +1 TO WRK-CURR-PAGE. DTSCS31 01251 DTSCS31 01252 IF MQTR-YRQ NOT < WRK-FROM-YRQ DTSCS31 01253 MOVE 'Y' TO WRK-REC-FOUND-IND DTSCS31 01254 ELSE DTSCS31 01255 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS31 01256 P6190-EXIT. DTSCS31 01257 EXIT. DTSCS31 01258 /*****************************************************************DTSCS31 01259 * A RANGE OF QUARTERS WAS REQUESTED *DTSCS31 01260 ******************************************************************DTSCS31 01261 DTSCS31 01262 P6200-LOCATE-RANGE. DTSCS31 01263 MOVE +0 TO RECS-IN-RANGE-CNT. DTSCS31 01264 DTSCS31 01265 MOVE +0 TO FIRST-REC-IN-RANGE-YRQ DTSCS31 01266 LAST-REC-IN-RANGE-YRQ. DTSCS31 01267 DTSCS31 01268 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSCS31 01269 MOVE WRK-EMP-NO TO MQTR-EMP-NO. DTSCS31 01270 SET MQTR-QTR-88 TO TRUE. DTSCS31 01271 MOVE WRK-FROM-YRQ TO MQTR-YRQ. DTSCS31 01272 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSCS31 01273 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS31 01274 DTSCS31 01275 PERFORM P6210-SCAN-MQTR THRU P6210-EXIT DTSCS31 01276 UNTIL L810-NO-REC-88. DTSCS31 01277 DTSCS31 01278 IF RECS-IN-RANGE-CNT = +0 DTSCS31 01279 MOVE MSG-E311-AREA TO WRK-MSG-AREA DTSCS31 01280 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS31 01281 PERFORM S1202-ERROR THRU S1202-EXIT DTSCS31 01282 GO TO P6200-EXIT. DTSCS31 01283 DTSCS31 01284 IF RECS-IN-RANGE-CNT = +1 DTSCS31 01285 MOVE FIRST-REC-IN-RANGE-YRQ TO WRK-FROM-YRQ DTSCS31 01286 WRK-TO-YRQ DTSCS31 01287 SET WRK-RANGE-NO TO TRUE DTSCS31 01288 ELSE DTSCS31 01289 MOVE FIRST-REC-IN-RANGE-YRQ TO WRK-FROM-YRQ DTSCS31 01290 MOVE LAST-REC-IN-RANGE-YRQ TO WRK-TO-YRQ. DTSCS31 01291 P6200-EXIT. DTSCS31 01292 EXIT. DTSCS31 01293 DTSCS31 01294 DTSCS31 01295 P6210-SCAN-MQTR. DTSCS31 01296 MOVE MSKL-REC TO MQTR-REC. DTSCS31 01297 DTSCS31 01298 IF NOT MQTR-CURR-NOT-LIABLE-88 DTSCS31 01299 MOVE MQTR-CURR-RPT-TYPE TO WRK-CURR-RPT-TYPE. DTSCS31 01300 DTSCS31 01301 IF MQTR-YRQ > WRK-TO-YRQ DTSCS31 01302 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS31 01303 SET L810-NO-REC-88 TO TRUE DTSCS31 01304 GO TO P6210-EXIT. DTSCS31 01305 DTSCS31 01306 ADD +1 TO RECS-IN-RANGE-CNT. DTSCS31 01307 DTSCS31 01308 IF FIRST-REC-IN-RANGE-YRQ = +0 DTSCS31 01309 MOVE MQTR-YRQ TO FIRST-REC-IN-RANGE-YRQ. DTSCS31 01310 DTSCS31 01311 MOVE MQTR-YRQ TO LAST-REC-IN-RANGE-YRQ. DTSCS31 01312 DTSCS31 01313 IF MQTR-YRQ = WRK-TO-YRQ DTSCS31 01314 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS31 01315 SET L810-NO-REC-88 TO TRUE DTSCS31 01316 GO TO P6210-EXIT. DTSCS31 01317 DTSCS31 01318 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS31 01319 P6210-EXIT. DTSCS31 01320 EXIT. DTSCS31 01321 /*****************************************************************DTSCS31 01322 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCS31 01323 ******************************************************************DTSCS31 01324 DTSCS31 01325 P6900-CONSTRUCT-SCREEN. DTSCS31 01326 PERFORM S109-SUR-TAX-QTR THRU S109-EXIT. DTSCS31 01327 DTSCS31 01328 PERFORM P6901-TO-FROM-YRQ THRU P6901-EXIT. DTSCS31 01329 DTSCS31 01330 PERFORM P6910-TOP-OF-SCREEN THRU P6910-EXIT. DTSCS31 01331 DTSCS31 01332 PERFORM P6920-CENTER-OF-SCREEN THRU P6920-EXIT. DTSCS31 01333 DTSCS31 01334 IF WRK-RANGE-NO DTSCS31 01335 OR WRK-RANGE-ANNUAL DTSCS31 01336 PERFORM P6930-BOTTOM-OF-SCREEN THRU P6930-EXIT. DTSCS31 01337 DTSCS31 01338 IF WRK-RANGE-NO DTSCS31 01339 PERFORM P6990-PAGE-NUMBER THRU P6990-EXIT DTSCS31 01340 MOVE MQTR-KEY-AREA TO HOLD-SCR-KEY-AREA DTSCS31 01341 MOVE WRK-CURR-PAGE TO HOLD-SCR-PAGE DTSCS31 01342 ELSE DTSCS31 01343 MOVE LOW-VALUES TO HOLD-SCR-AREA DTSCS31 01344 MOVE +0 TO HOLD-SCR-PAGE. DTSCS31 01345 P6900-EXIT. DTSCS31 01346 EXIT. DTSCS31 01347 SKIP3 DTSCS31 01348 P6901-TO-FROM-YRQ. DTSCS31 01349 IF WRK-FROM-YRQ = LCCM-PICKUP-YRQ DTSCS31 01350 MOVE 'PU' TO MAP-FROM-YRQ-YR DTSCS31 01351 MOVE SPACE TO MAP-FROM-YRQ-Q DTSCS31 01352 ELSE DTSCS31 01353 MOVE WRK-FROM-YRQ TO WRK-DISPLAY DTSCS31 01354 MOVE WRK-DISPLAY-YRQ-YR TO MAP-FROM-YRQ-YR DTSCS31 01355 MOVE WRK-DISPLAY-YRQ-Q TO MAP-FROM-YRQ-Q. DTSCS31 01356 DTSCS31 01357 IF WRK-RANGE-YES DTSCS31 01358 IF WRK-TO-YRQ = LCCM-PICKUP-YRQ DTSCS31 01359 MOVE 'PU' TO MAP-TO-YRQ-YR DTSCS31 01360 MOVE SPACE TO MAP-TO-YRQ-Q DTSCS31 01361 ELSE DTSCS31 01362 MOVE WRK-TO-YRQ TO WRK-DISPLAY DTSCS31 01363 MOVE WRK-DISPLAY-YRQ-YR TO MAP-TO-YRQ-YR DTSCS31 01364 MOVE WRK-DISPLAY-YRQ-Q TO MAP-TO-YRQ-Q DTSCS31 01365 ELSE DTSCS31 01366 MOVE LOW-VALUES TO MAP-TO-YRQ-YR DTSCS31 01367 MAP-TO-YRQ-Q. DTSCS31 01368 P6901-EXIT. DTSCS31 01369 EXIT. DTSCS31 01370 /*****************************************************************DTSCS31 01371 * *DTSCS31 01372 ******************************************************************DTSCS31 01373 P6910-TOP-OF-SCREEN. DTSCS31 01374 MOVE HOLD-EMP-CLASS-DSCR TO MAP-EMP-CLASS-DSCR. DTSCS31 01375 DTSCS31 01376 MOVE MPRF-BANKRUPTCY-OPEN-IND TO MAP-BANKRUPTCY-OPEN-IND. DTSCS31 01377 DTSCS31 01378 MOVE HOLD-EMP-PICKUP-DUE-IND TO MAP-PICKUP-DUE-IND. DTSCS31 01379 DTSCS31 01380 MOVE HOLD-EMP-STATUS-DSCR TO MAP-EMP-STATUS-DSCR. DTSCS31 01381 DTSCS31 01382 IF MPRF-WRITE-OFF-DATE > +0 DTSCS31 01383 MOVE MPRF-WRITE-OFF-DATE TO L001-FED-8-DATE-9 DTSCS31 01384 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCS31 01385 MOVE L001-SLASH-DATE TO MAP-WRITEOFF-DATE. DTSCS31 01386 DTSCS31 01387 IF MPRF-WRITE-OFF-DATE > +0 DTSCS31 01388 MOVE ' WRITTEN OFF' TO MAP-TOT-DUE-AMT DTSCS31 01389 ELSE DTSCS31 01390 MOVE HOLD-EMP-TOT-DUE-AMT TO MAP-TOT-DUE-AMT-Z. DTSCS31 01391 DTSCS31 01392 IF HOLD-EMP-LAST-PAGE = +0 DTSCS31 01393 MOVE SPACES TO MAP-COMPROMISE DTSCS31 01394 ELSE DTSCS31 01395 IF MQTR-CMP-ESTB-ABSTIME > ZERO DTSCS31 01396 MOVE '** COMPROMISE **' TO MAP-COMPROMISE DTSCS31 01397 ELSE DTSCS31 01398 MOVE SPACES TO MAP-COMPROMISE DTSCS31 01399 END-IF DTSCS31 01400 END-IF. DTSCS31 01401 DTSCS31 01402 MOVE HOLD-EMP-RECENT-SOL TO MAP-RECENT-SOL. DTSCS31 01403 DTSCS31 01404 STRING HOLD-EMP-OPEN-APL-IND DELIMITED BY SIZE DTSCS31 01405 '/' DELIMITED BY SIZE DTSCS31 01406 HOLD-EMP-OPEN-LIN-IND DELIMITED BY SIZE DTSCS31 01407 '/' DELIMITED BY SIZE DTSCS31 01408 HOLD-EMP-OPEN-DPC-IND DELIMITED BY SIZE DTSCS31 01409 INTO MAP-ALD-INDS. DTSCS31 01410 DTSCS31 01411 MOVE HOLD-EMP-PER-MONTH-INT TO MAP-INT-MONTH-Z. DTSCS31 01412 DTSCS31 01413 MOVE HOLD-EMP-FLD-REP-ID TO MAP-FLD-REP-ID. DTSCS31 01414 DTSCS31 01415 MOVE HOLD-EMP-NBR-SPANS TO MAP-SOL-CNT. DTSCS31 01416 DTSCS31 01417 MOVE HOLD-EMP-SUBPOENA-CD TO MAP-SUBPOENA-CD. DTSCS31 01418 MOVE HOLD-EMP-SUBPOENA-DATE TO MAP-SUBPOENA-DATE. DTSCS31 01419 DTSCS31 01420 MOVE MPRF-PURSUED-RPT-CNT TO MAP-PURSUED-RPT-CNT-Z. DTSCS31 01421 DTSCS31 01422 IF MPRF-NOT-WRITTEN-OFF-88 DTSCS31 01423 MOVE ' TOLERATED' TO MAP-SUSP-TOL-COL-LIT DTSCS31 01424 ELSE DTSCS31 01425 MOVE ' WRITTEN OFF' TO MAP-SUSP-TOL-COL-LIT. DTSCS31 01426 P6910-EXIT. DTSCS31 01427 EXIT. DTSCS31 01428 /*****************************************************************DTSCS31 01429 * * DTSCS31 01430 ******************************************************************DTSCS31 01431 P6920-CENTER-OF-SCREEN. DTSCS31 01432 INITIALIZE WRK-BUCKETS DTSCS31 01433 WRK-WAGE-BUCKETS. DTSCS31 01434 DTSCS31 01435 IF WRK-RANGE-YES DTSCS31 01436 MOVE LOW-VALUES TO MQTR-KEY-AREA DTSCS31 01437 MOVE WRK-EMP-NO TO MQTR-EMP-NO DTSCS31 01438 SET MQTR-QTR-88 TO TRUE DTSCS31 01439 MOVE WRK-FROM-YRQ TO MQTR-YRQ DTSCS31 01440 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA DTSCS31 01441 PERFORM S810-START-BROWSE THRU S810-EXIT DTSCS31 01442 PERFORM P6921-SCAN-MQTR THRU P6921-EXIT DTSCS31 01443 UNTIL L810-NO-REC-88 DTSCS31 01444 ELSE DTSCS31 01445 PERFORM P6922-PROCESS-MQTR THRU P6922-EXIT. DTSCS31 01446 DTSCS31 01447 IF WRK-RANGE-YES DTSCS31 01448 SET WRK-DISPLAY-ZEROS-YES TO TRUE DTSCS31 01449 ELSE DTSCS31 01450 IF MQTR-CURR-NOT-LIABLE-88 DTSCS31 01451 OR MQTR-CURR-NOT-DUE-88 DTSCS31 01452 OR MQTR-CURR-DELINQ-88 DTSCS31 01453 SET WRK-DISPLAY-ZEROS-NO TO TRUE DTSCS31 01454 ELSE DTSCS31 01455 SET WRK-DISPLAY-ZEROS-YES TO TRUE. DTSCS31 01456 DTSCS31 01457 PERFORM DTSCS31 01458 VARYING WRK-ROW FROM 1 BY 1 DTSCS31 01459 UNTIL WRK-ROW > LIT-TOT-SUB DTSCS31 01460 PERFORM DTSCS31 01461 VARYING WRK-COL FROM 1 BY 1 DTSCS31 01462 UNTIL WRK-COL > LIT-BALANCE DTSCS31 01463 IF (WRK-BUCKET (WRK-ROW WRK-COL) NOT = +0) DTSCS31 01464 OR (WRK-DISPLAY-ZEROS-YES) DTSCS31 01465 MOVE WRK-BUCKET (WRK-ROW WRK-COL) DTSCS31 01466 TO MAP-AMT-Z (WRK-ROW WRK-COL) DTSCS31 01467 END-IF DTSCS31 01468 END-PERFORM DTSCS31 01469 END-PERFORM. DTSCS31 01470 P6920-EXIT. DTSCS31 01471 EXIT. DTSCS31 01472 DTSCS31 01473 DTSCS31 01474 P6921-SCAN-MQTR. DTSCS31 01475 MOVE MSKL-REC TO MQTR-REC. DTSCS31 01476 DTSCS31 01477 PERFORM P6922-PROCESS-MQTR THRU P6922-EXIT. DTSCS31 01478 DTSCS31 01479 IF MQTR-YRQ NOT < WRK-TO-YRQ DTSCS31 01480 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS31 01481 SET L810-NO-REC-88 TO TRUE DTSCS31 01482 GO TO P6921-EXIT. DTSCS31 01483 DTSCS31 01484 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS31 01485 P6921-EXIT. DTSCS31 01486 EXIT. DTSCS31 01487 DTSCS31 01488 DTSCS31 01489 P6922-PROCESS-MQTR. DTSCS31 01490 MOVE +0 TO L101-PAID-CHNG. DTSCS31 01491 * L101-PEN-CHARGED-AMT. DTSCS31 01492 DTSCS31 01493 ************************************************************ DTSCS31 01494 * ONLY UI TAX BALANCE USED TO COMPUTE INTEREST DTSCS31 01495 ************************************************************ DTSCS31 01496 PERFORM DTSCS31 01497 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSCS31 01498 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSCS31 01499 PERFORM P6923-ASSIGN-SUB THRU P6923-EXIT DTSCS31 01500 PERFORM P6924-ACCUM THRU P6924-EXIT DTSCS31 01501 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSCS31 01502 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS31 01503 TO L101-PAID-CHNG DTSCS31 01504 END-IF DTSCS31 01505 IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) AND DTSCS31 01506 MQTR-YRQ >= L109-FIRST-PEN-INT-YRQ DTSCS31 01507 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS31 01508 TO L101-PAID-CHNG DTSCS31 01509 END-IF DTSCS31 01510 * IF MQTR-ACCT-PEN-88 (MQTR-ACCT-IDX) DTSCS31 01511 * ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSCS31 01512 * TO L101-PEN-CHARGED-AMT DTSCS31 01513 * END-IF DTSCS31 01514 END-PERFORM. DTSCS31 01515 DTSCS31 01516 ADD MQTR-TOT-WAGE TO WRK-TOT-WAGE-BUCKET. DTSCS31 01517 ADD MQTR-TAX-WAGE TO WRK-TAX-WAGE-BUCKET. DTSCS31 01518 ADD MQTR-EXCESS-WAGE TO WRK-EXCESS-WAGE-BUCKET. DTSCS31 01519 DTSCS31 01520 IF L101-PAID-CHNG > +0 DTSCS31 01521 NEXT SENTENCE DTSCS31 01522 ELSE DTSCS31 01523 GO TO P6922-EXIT. DTSCS31 01524 DTSCS31 01525 IF LCCM-COMP-DATE = ALL-NINES-DATE DTSCS31 01526 GO TO P6922-EXIT. DTSCS31 01527 DTSCS31 01528 MOVE LCCM-COMP-DATE TO L101-RECEIVED-DATE. DTSCS31 01529 SET L101-WAIVE-INT-NO-88 TO TRUE. DTSCS31 01530 MOVE MQTR-TAX-DUE-DATE TO L101-TAX-DUE-DATE. DTSCS31 01531 MOVE MQTR-INT-AREA TO L101-INT-AREA. DTSCS31 01532 DTSCS31 01533 SET L101-PER-MONTH-NO-88 TO TRUE. DTSCS31 01534 DTSCS31 01535 PERFORM S101-PER-MONTH-NO THRU S101-EXIT. DTSCS31 01536 DTSCS31 01537 ADD L101-INT-CHARGE-CHNG DTSCS31 01538 TO WRK-BUCKET (LIT-INT-SUB LIT-CHARGED) DTSCS31 01539 WRK-BUCKET (LIT-TOT-SUB LIT-CHARGED) DTSCS31 01540 WRK-BUCKET (LIT-INT-SUB LIT-BALANCE) DTSCS31 01541 WRK-BUCKET (LIT-TOT-SUB LIT-BALANCE). DTSCS31 01542 DTSCS31 01543 ADD L101-INT-WAIVE-CHNG DTSCS31 01544 TO WRK-BUCKET (LIT-INT-SUB LIT-WAIVED) DTSCS31 01545 WRK-BUCKET (LIT-TOT-SUB LIT-WAIVED). DTSCS31 01546 SUBTRACT L101-INT-WAIVE-CHNG DTSCS31 01547 FROM WRK-BUCKET (LIT-INT-SUB LIT-BALANCE) DTSCS31 01548 WRK-BUCKET (LIT-TOT-SUB LIT-BALANCE). DTSCS31 01549 DTSCS31 01550 * ADD L101-PEN-CHARGE-CHNG DTSCS31 01551 * TO WRK-BUCKET (LIT-PEN-SUB LIT-CHARGED) DTSCS31 01552 * WRK-BUCKET (LIT-TOT-SUB LIT-CHARGED) DTSCS31 01553 * WRK-BUCKET (LIT-PEN-SUB LIT-BALANCE) DTSCS31 01554 * WRK-BUCKET (LIT-TOT-SUB LIT-BALANCE). DTSCS31 01555 * DTSCS31 01556 * ADD L101-PEN-ABATE-CHNG DTSCS31 01557 * TO WRK-BUCKET (LIT-PEN-SUB LIT-ABATED) DTSCS31 01558 * WRK-BUCKET (LIT-TOT-SUB LIT-ABATED). DTSCS31 01559 * SUBTRACT L101-PEN-ABATE-CHNG DTSCS31 01560 * FROM WRK-BUCKET (LIT-PEN-SUB LIT-BALANCE) DTSCS31 01561 * WRK-BUCKET (LIT-TOT-SUB LIT-BALANCE). DTSCS31 01562 P6922-EXIT. DTSCS31 01563 EXIT. DTSCS31 01564 DTSCS31 01565 DTSCS31 01566 P6923-ASSIGN-SUB. DTSCS31 01567 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSCS31 01568 MOVE LIT-UI-SUB TO WRK-ROW DTSCS31 01569 ELSE DTSCS31 01570 IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) DTSCS31 01571 MOVE LIT-SUR-SUB TO WRK-ROW DTSCS31 01572 ELSE DTSCS31 01573 IF MQTR-ACCT-TAX-88 (MQTR-ACCT-IDX) DTSCS31 01574 MOVE LIT-TAX-SUB TO WRK-ROW DTSCS31 01575 ELSE DTSCS31 01576 IF MQTR-ACCT-INT-88 (MQTR-ACCT-IDX) DTSCS31 01577 MOVE LIT-INT-SUB TO WRK-ROW DTSCS31 01578 ELSE DTSCS31 01579 IF MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX) DTSCS31 01580 MOVE LIT-LATE-PEN-SUB TO WRK-ROW DTSCS31 01581 ELSE DTSCS31 01582 IF MQTR-ACCT-NSF-PEN-88 (MQTR-ACCT-IDX) DTSCS31 01583 MOVE LIT-NSF-PEN-SUB TO WRK-ROW DTSCS31 01584 ELSE DTSCS31 01585 IF MQTR-ACCT-MISC-PEN-88 (MQTR-ACCT-IDX) DTSCS31 01586 MOVE LIT-MISC-PEN-SUB TO WRK-ROW DTSCS31 01587 ELSE DTSCS31 01588 GO TO S899-ABEND. DTSCS31 01589 P6923-EXIT. DTSCS31 01590 EXIT. DTSCS31 01591 DTSCS31 01592 DTSCS31 01593 P6924-ACCUM. DTSCS31 01594 ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSCS31 01595 TO WRK-BUCKET (WRK-ROW LIT-CHARGED) DTSCS31 01596 WRK-BUCKET (LIT-TOT-SUB LIT-CHARGED). DTSCS31 01597 DTSCS31 01598 ADD MQTR-PAID-AMT (MQTR-ACCT-IDX) DTSCS31 01599 TO WRK-BUCKET (WRK-ROW LIT-PAID) DTSCS31 01600 WRK-BUCKET (LIT-TOT-SUB LIT-PAID). DTSCS31 01601 DTSCS31 01602 ADD MQTR-WAIVED-AMT (MQTR-ACCT-IDX) DTSCS31 01603 TO WRK-BUCKET (WRK-ROW LIT-WAIVED) DTSCS31 01604 WRK-BUCKET (LIT-TOT-SUB LIT-WAIVED). DTSCS31 01605 DTSCS31 01606 IF MPRF-NOT-WRITTEN-OFF-88 DTSCS31 01607 ADD MQTR-TOLER-AMT (MQTR-ACCT-IDX) DTSCS31 01608 TO WRK-BUCKET (WRK-ROW LIT-WOFF-TOLER) DTSCS31 01609 WRK-BUCKET (LIT-TOT-SUB LIT-WOFF-TOLER) DTSCS31 01610 ELSE DTSCS31 01611 ADD MQTR-WRITTEN-OFF-AMT (MQTR-ACCT-IDX) DTSCS31 01612 TO WRK-BUCKET (WRK-ROW LIT-WOFF-TOLER) DTSCS31 01613 WRK-BUCKET (LIT-TOT-SUB LIT-WOFF-TOLER). DTSCS31 01614 DTSCS31 01615 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS31 01616 TO WRK-BUCKET (WRK-ROW LIT-BALANCE) DTSCS31 01617 WRK-BUCKET (LIT-TOT-SUB LIT-BALANCE). DTSCS31 01618 DTSCS31 01619 IF WRK-ROW < LIT-TAX-SUB DTSCS31 01620 ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSCS31 01621 TO WRK-BUCKET (LIT-TAX-SUB LIT-CHARGED) DTSCS31 01622 ADD MQTR-PAID-AMT (MQTR-ACCT-IDX) DTSCS31 01623 TO WRK-BUCKET (LIT-TAX-SUB LIT-PAID) DTSCS31 01624 ADD MQTR-WAIVED-AMT (MQTR-ACCT-IDX) DTSCS31 01625 TO WRK-BUCKET (LIT-TAX-SUB LIT-WAIVED) DTSCS31 01626 IF NOT MPRF-NOT-WRITTEN-OFF-88 DTSCS31 01627 ADD MQTR-WRITTEN-OFF-AMT (MQTR-ACCT-IDX) DTSCS31 01628 TO WRK-BUCKET (LIT-TAX-SUB LIT-WOFF-TOLER) DTSCS31 01629 END-IF DTSCS31 01630 IF MPRF-NOT-WRITTEN-OFF-88 DTSCS31 01631 ADD MQTR-TOLER-AMT (MQTR-ACCT-IDX) DTSCS31 01632 TO WRK-BUCKET (LIT-TAX-SUB LIT-WOFF-TOLER) DTSCS31 01633 END-IF DTSCS31 01634 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS31 01635 TO WRK-BUCKET (LIT-TAX-SUB LIT-BALANCE). DTSCS31 01636 P6924-EXIT. DTSCS31 01637 EXIT. DTSCS31 01638 /*****************************************************************DTSCS31 01639 * ONLY IF WE ARE DISPLAYING AN INDOIVIDUAL RECORD * DTSCS31 01640 ******************************************************************DTSCS31 01641 P6930-BOTTOM-OF-SCREEN. DTSCS31 01642 IF (MQTR-RPT-DUE-DATE = +0) DTSCS31 01643 OR DTSCS31 01644 (MQTR-YRQ = LCCM-PICKUP-YRQ) DTSCS31 01645 NEXT SENTENCE DTSCS31 01646 ELSE DTSCS31 01647 MOVE MQTR-RPT-DUE-DATE TO L001-FED-8-DATE-9 DTSCS31 01648 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCS31 01649 MOVE L001-SLASH-DATE TO MAP-RPT-DUE-DATE. DTSCS31 01650 DTSCS31 01651 IF (MQTR-TAX-DUE-DATE = +0) DTSCS31 01652 OR DTSCS31 01653 (MQTR-YRQ = LCCM-PICKUP-YRQ) DTSCS31 01654 NEXT SENTENCE DTSCS31 01655 ELSE DTSCS31 01656 MOVE MQTR-TAX-DUE-DATE TO L001-FED-8-DATE-9 DTSCS31 01657 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCS31 01658 MOVE L001-SLASH-DATE TO MAP-TAX-DUE-DATE. DTSCS31 01659 DTSCS31 01660 MOVE MQTR-CURR-RPT-TYPE TO L033-CURR-RPT-TYPE. DTSCS31 01661 MOVE MQTR-PURSUED-RPT-IND TO L033-PURSUED-RPT-IND. DTSCS31 01662 PERFORM S033-RPT-PURSUED-DSCR THRU S033-EXIT. DTSCS31 01663 MOVE L033-SHORT-DSCR TO MAP-CURR-RPT-TYPE-DSCR. DTSCS31 01664 DTSCS31 01665 IF MQTR-YRQ = LCCM-PICKUP-YRQ DTSCS31 01666 NEXT SENTENCE DTSCS31 01667 ELSE DTSCS31 01668 MOVE MQTR-MISS-RPT-CUTOFF-CD TO L032-CD DTSCS31 01669 PERFORM S032-MISS-RPT-CUTOFF-CD THRU S032-EXIT DTSCS31 01670 MOVE L032-SHORT-DSCR TO MAP-MISS-RPT-CUTOFF-CD-DSCR. DTSCS31 01671 DTSCS31 01672 MOVE MQTR-INT-CHARGE-IND TO MAP-INT-CHARGE-IND. DTSCS31 01673 MOVE '/' TO MAP-INTPEN-SLASH. DTSCS31 01674 MOVE MQTR-PEN-CHARGE-IND TO MAP-PEN-CHARGE-IND. DTSCS31 01675 DTSCS31 01676 DTSCS31 01677 IF MQTR-YRQ = LCCM-PICKUP-YRQ DTSCS31 01678 NEXT SENTENCE DTSCS31 01679 ELSE DTSCS31 01680 IF WRK-RANGE-ANNUAL DTSCS31 01681 IF (WRK-TOT-WAGE-BUCKET NOT = +0 DTSCS31 01682 OR WRK-DISPLAY-ZEROS-YES) DTSCS31 01683 MOVE WRK-TOT-WAGE-BUCKET TO MAP-TOT-WAGE-Z DTSCS31 01684 END-IF DTSCS31 01685 ELSE DTSCS31 01686 IF (MQTR-TOT-WAGE NOT = +0) DTSCS31 01687 OR (WRK-DISPLAY-ZEROS-YES) DTSCS31 01688 MOVE MQTR-TOT-WAGE TO MAP-TOT-WAGE-Z. DTSCS31 01689 DTSCS31 01690 IF MQTR-YRQ = LCCM-PICKUP-YRQ DTSCS31 01691 NEXT SENTENCE DTSCS31 01692 ELSE DTSCS31 01693 IF WRK-RANGE-ANNUAL DTSCS31 01694 IF (WRK-EXCESS-WAGE-BUCKET NOT = +0 DTSCS31 01695 OR WRK-DISPLAY-ZEROS-YES) DTSCS31 01696 MOVE WRK-EXCESS-WAGE-BUCKET TO MAP-EXCESS-WAGE-Z DTSCS31 01697 END-IF DTSCS31 01698 ELSE DTSCS31 01699 IF (MQTR-EXCESS-WAGE NOT = +0) DTSCS31 01700 OR (WRK-DISPLAY-ZEROS-YES) DTSCS31 01701 MOVE MQTR-EXCESS-WAGE TO MAP-EXCESS-WAGE-Z. DTSCS31 01702 DTSCS31 01703 IF MQTR-YRQ = LCCM-PICKUP-YRQ DTSCS31 01704 NEXT SENTENCE DTSCS31 01705 ELSE DTSCS31 01706 IF WRK-RANGE-ANNUAL DTSCS31 01707 IF (WRK-TAX-WAGE-BUCKET NOT = +0 DTSCS31 01708 OR WRK-DISPLAY-ZEROS-YES) DTSCS31 01709 MOVE WRK-TAX-WAGE-BUCKET TO MAP-TAX-WAGE-Z DTSCS31 01710 END-IF DTSCS31 01711 ELSE DTSCS31 01712 IF (MQTR-TAX-WAGE NOT = +0) DTSCS31 01713 OR (WRK-DISPLAY-ZEROS-YES) DTSCS31 01714 MOVE MQTR-TAX-WAGE TO MAP-TAX-WAGE-Z. DTSCS31 01715 DTSCS31 01716 IF MQTR-YRQ = LCCM-PICKUP-YRQ DTSCS31 01717 NEXT SENTENCE DTSCS31 01718 ELSE DTSCS31 01719 IF MQTR-NO-UI-RATE-88 DTSCS31 01720 MOVE +0 TO L056-RATE DTSCS31 01721 ELSE DTSCS31 01722 MOVE MQTR-UI-RATE TO L056-RATE DTSCS31 01723 PERFORM S056-DISP1-RIGHT THRU S056-EXIT DTSCS31 01724 MOVE L056-DISP-RATE TO MAP-UI-RATE. DTSCS31 01725 DTSCS31 01726 *****IF MPRF-CLASS-SUB-88 DTSCS31 01727 *********MOVE MPRF-EMP-CLASS TO L109-EMP-CLASS DTSCS31 01728 *********MOVE MQTR-YRQ TO L109-YRQ DTSCS31 01729 *********PERFORM S109-LOOKUP-RATE THRU S109-EXIT DTSCS31 01730 *********ADD L109-AFT-RATE TO L056-RATE DTSCS31 01731 *********ADD L109-FLA-RATE TO L056-RATE DTSCS31 01732 *********ADD L109-SUR-RATE TO L056-RATE DTSCS31 01733 *********PERFORM S056-DISP1-LEFT THRU S056-EXIT DTSCS31 01734 *********MOVE L056-DISP-RATE TO MAP-TOT-RATE. DTSCS31 01735 DTSCS31 01736 MOVE SPACE TO WRK-QTR-OPEN-APL-IND DTSCS31 01737 WRK-QTR-OPEN-LIN-IND DTSCS31 01738 WRK-QTR-OPEN-DPC-IND. DTSCS31 01739 IF HOLD-EMP-OPEN-APL-YES-88 DTSCS31 01740 MOVE LOW-VALUES TO MSKL-KEY-AREA DTSCS31 01741 MOVE WRK-EMP-NO TO MSKL-EMP-NO DTSCS31 01742 SET MSKL-APL-88 TO TRUE DTSCS31 01743 PERFORM S810-START-BROWSE THRU S810-EXIT DTSCS31 01744 PERFORM P6931-SCAN-MAPL THRU P6931-EXIT DTSCS31 01745 UNTIL L810-NO-REC-88. DTSCS31 01746 IF HOLD-EMP-OPEN-LIN-YES-88 DTSCS31 01747 MOVE LOW-VALUES TO MSKL-KEY-AREA DTSCS31 01748 MOVE WRK-EMP-NO TO MSKL-EMP-NO DTSCS31 01749 SET MSKL-LIN-88 TO TRUE DTSCS31 01750 PERFORM S810-START-BROWSE THRU S810-EXIT DTSCS31 01751 PERFORM P6932-SCAN-MLIN THRU P6932-EXIT DTSCS31 01752 UNTIL L810-NO-REC-88. DTSCS31 01753 IF HOLD-EMP-OPEN-DPC-YES-88 DTSCS31 01754 MOVE LOW-VALUES TO MSKL-KEY-AREA DTSCS31 01755 MOVE WRK-EMP-NO TO MSKL-EMP-NO DTSCS31 01756 SET MSKL-DPC-88 TO TRUE DTSCS31 01757 PERFORM S810-START-BROWSE THRU S810-EXIT DTSCS31 01758 PERFORM P6933-SCAN-MDPC THRU P6933-EXIT DTSCS31 01759 UNTIL L810-NO-REC-88. DTSCS31 01760 STRING WRK-QTR-OPEN-APL-IND DELIMITED BY SIZE DTSCS31 01761 '/' DELIMITED BY SIZE DTSCS31 01762 WRK-QTR-OPEN-LIN-IND DELIMITED BY SIZE DTSCS31 01763 '/' DELIMITED BY SIZE DTSCS31 01764 WRK-QTR-OPEN-DPC-IND DELIMITED BY SIZE DTSCS31 01765 INTO MAP-QTR-ALD. DTSCS31 01766 DTSCS31 01767 IF MQTR-YRQ = LCCM-PICKUP-YRQ DTSCS31 01768 NEXT SENTENCE DTSCS31 01769 ELSE DTSCS31 01770 IF MQTR-WAGE-RPT-IND > SPACES DTSCS31 01771 MOVE MQTR-WAGE-RPT-IND TO MAP-WAGE-RPT. DTSCS31 01772 DTSCS31 01773 IF MQTR-WAIVE-PEN-START-DATE NOT = +0 DTSCS31 01774 MOVE MQTR-WAIVE-PEN-START-DATE TO L001-FED-8-DATE-9 DTSCS31 01775 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCS31 01776 MOVE L001-SLASH-DATE TO MAP-WAIVE-PEN-START-DATE. DTSCS31 01777 DTSCS31 01778 IF MQTR-WAIVE-PEN-END-DATE NOT = +0 DTSCS31 01779 MOVE MQTR-WAIVE-PEN-END-DATE TO L001-FED-8-DATE-9 DTSCS31 01780 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCS31 01781 MOVE L001-SLASH-DATE TO MAP-WAIVE-PEN-END-DATE. DTSCS31 01782 DTSCS31 01783 IF MQTR-WAIVE-INT-START-DATE NOT = +0 DTSCS31 01784 MOVE MQTR-WAIVE-INT-START-DATE TO L001-FED-8-DATE-9 DTSCS31 01785 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCS31 01786 MOVE L001-SLASH-DATE TO MAP-WAIVE-INT-START-DATE. DTSCS31 01787 DTSCS31 01788 IF MQTR-WAIVE-INT-END-DATE NOT = +0 DTSCS31 01789 MOVE MQTR-WAIVE-INT-END-DATE TO L001-FED-8-DATE-9 DTSCS31 01790 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCS31 01791 MOVE L001-SLASH-DATE TO MAP-WAIVE-INT-END-DATE. DTSCS31 01792 DTSCS31 01793 IF MQTR-INT-CNT > +0 DTSCS31 01794 MOVE MQTR-INT-START-DATE (1) TO L001-FED-8-DATE-9 DTSCS31 01795 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCS31 01796 MOVE L001-SLASH-DATE TO MAP-INT-START-DATE-1 DTSCS31 01797 MOVE MQTR-INT-END-DATE (1) TO L001-FED-8-DATE-9 DTSCS31 01798 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCS31 01799 MOVE L001-SLASH-DATE TO MAP-INT-END-DATE-1 DTSCS31 01800 MOVE MQTR-INT-RATE (1) TO L056-RATE DTSCS31 01801 PERFORM S056-DISP1-LEFT THRU S056-EXIT DTSCS31 01802 MOVE L056-DISP-RATE TO MAP-INT-RATE-1. DTSCS31 01803 DTSCS31 01804 IF MQTR-INT-CNT > +1 DTSCS31 01805 MOVE MQTR-INT-START-DATE (2) TO L001-FED-8-DATE-9 DTSCS31 01806 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCS31 01807 MOVE L001-SLASH-DATE TO MAP-INT-START-DATE-2 DTSCS31 01808 MOVE MQTR-INT-END-DATE (2) TO L001-FED-8-DATE-9 DTSCS31 01809 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCS31 01810 MOVE L001-SLASH-DATE TO MAP-INT-END-DATE-2 DTSCS31 01811 MOVE MQTR-INT-RATE (2) TO L056-RATE DTSCS31 01812 PERFORM S056-DISP1-LEFT THRU S056-EXIT DTSCS31 01813 MOVE L056-DISP-RATE TO MAP-INT-RATE-2. DTSCS31 01814 P6930-EXIT. DTSCS31 01815 EXIT. DTSCS31 01816 DTSCS31 01817 DTSCS31 01818 P6931-SCAN-MAPL. DTSCS31 01819 MOVE MSKL-REC TO MAPL-REC. DTSCS31 01820 DTSCS31 01821 IF MAPL-STATUS-OPEN-88 DTSCS31 01822 PERFORM DTSCS31 01823 VARYING MAPL-COV-IDX FROM 1 BY 1 DTSCS31 01824 UNTIL MAPL-COV-IDX > MAPL-COVERED-CNT DTSCS31 01825 IF MQTR-YRQ = MAPL-COVERED-YRQ (MAPL-COV-IDX) DTSCS31 01826 SET WRK-QTR-OPEN-APL-YES-88 TO TRUE DTSCS31 01827 END-IF DTSCS31 01828 END-PERFORM. DTSCS31 01829 DTSCS31 01830 IF WRK-QTR-OPEN-APL-YES-88 DTSCS31 01831 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS31 01832 SET L810-NO-REC-88 TO TRUE DTSCS31 01833 GO TO P6931-EXIT. DTSCS31 01834 DTSCS31 01835 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS31 01836 P6931-EXIT. DTSCS31 01837 EXIT. DTSCS31 01838 DTSCS31 01839 DTSCS31 01840 P6932-SCAN-MLIN. DTSCS31 01841 MOVE MSKL-REC TO MLIN-REC. DTSCS31 01842 DTSCS31 01843 IF MLIN-STATUS-ACTIVE-88 DTSCS31 01844 PERFORM DTSCS31 01845 VARYING MLIN-COV-IDX FROM 1 BY 1 DTSCS31 01846 UNTIL MLIN-COV-IDX > MLIN-COV-CNT DTSCS31 01847 IF MQTR-YRQ = MLIN-COVERED-YRQ (MLIN-COV-IDX) DTSCS31 01848 SET WRK-QTR-OPEN-LIN-YES-88 TO TRUE DTSCS31 01849 END-IF DTSCS31 01850 END-PERFORM. DTSCS31 01851 DTSCS31 01852 IF WRK-QTR-OPEN-LIN-YES-88 DTSCS31 01853 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS31 01854 SET L810-NO-REC-88 TO TRUE DTSCS31 01855 GO TO P6932-EXIT. DTSCS31 01856 DTSCS31 01857 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS31 01858 P6932-EXIT. DTSCS31 01859 EXIT. DTSCS31 01860 DTSCS31 01861 DTSCS31 01862 P6933-SCAN-MDPC. DTSCS31 01863 MOVE MSKL-REC TO MDPC-REC. DTSCS31 01864 DTSCS31 01865 IF MDPC-STATUS-ACTIVE-88 DTSCS31 01866 PERFORM DTSCS31 01867 VARYING MDPC-COV-IDX FROM 1 BY 1 DTSCS31 01868 UNTIL MDPC-COV-IDX > MDPC-COV-CNT DTSCS31 01869 IF MQTR-YRQ = MDPC-COVERED-YRQ (MDPC-COV-IDX) DTSCS31 01870 SET WRK-QTR-OPEN-DPC-YES-88 TO TRUE DTSCS31 01871 END-IF DTSCS31 01872 END-PERFORM. DTSCS31 01873 DTSCS31 01874 IF WRK-QTR-OPEN-DPC-YES-88 DTSCS31 01875 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS31 01876 SET L810-NO-REC-88 TO TRUE DTSCS31 01877 GO TO P6933-EXIT. DTSCS31 01878 DTSCS31 01879 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS31 01880 P6933-EXIT. DTSCS31 01881 EXIT. DTSCS31 01882 EJECT DTSCS31 01883 P6940-SET-RPT-TYPE. DTSCS31 01884 IF WRK-CURR-RPT-TYPE-NULL-88 DTSCS31 01885 GO TO P6940-EXIT. DTSCS31 01886 DTSCS31 01887 MOVE WRK-CURR-RPT-TYPE TO L033-CURR-RPT-TYPE. DTSCS31 01888 MOVE MQTR-PURSUED-RPT-IND TO L033-PURSUED-RPT-IND. DTSCS31 01889 PERFORM S033-RPT-PURSUED-DSCR THRU S033-EXIT. DTSCS31 01890 MOVE L033-SHORT-DSCR TO MAP-CURR-RPT-TYPE-DSCR. DTSCS31 01891 DTSCS31 01892 P6940-EXIT. DTSCS31 01893 EXIT. DTSCS31 01894 EJECT DTSCS31 01895 P6990-PAGE-NUMBER. DTSCS31 01896 MOVE WRK-CURR-PAGE TO MAP-CURR-PAGE. DTSCS31 01897 MOVE HOLD-EMP-LAST-PAGE TO MAP-LAST-PAGE. DTSCS31 01898 DTSCS31 01899 IF WRK-CURR-PAGE = +1 DTSCS31 01900 IF HOLD-EMP-LAST-PAGE = +1 DTSCS31 01901 MOVE PMSG-ONLY-PAGE TO LCCM-MSG-AREA DTSCS31 01902 ELSE DTSCS31 01903 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-AREA DTSCS31 01904 ELSE DTSCS31 01905 IF WRK-CURR-PAGE = HOLD-EMP-LAST-PAGE DTSCS31 01906 MOVE PMSG-LAST-PAGE TO LCCM-MSG-AREA. DTSCS31 01907 P6990-EXIT. DTSCS31 01908 EXIT. DTSCS31 01909 /*****************************************************************DTSCS31 01910 * DTSCS31 01911 ******************************************************************DTSCS31 01912 P7000-REFRESH-HOLD-EMP-AREA. DTSCS31 01913 MOVE WRK-EMP-NO TO HOLD-EMP-EMP-NO. DTSCS31 01914 MOVE LCCM-COMP-DATE TO HOLD-EMP-COMP-DATE. DTSCS31 01915 MOVE LCCM-TASK-START-ABSTIME TO HOLD-EMP-ABSTIME. DTSCS31 01916 DTSCS31 01917 MOVE MPRF-EMP-CLASS TO L031-CD. DTSCS31 01918 PERFORM S031-MPRF-EMP-CLASS THRU S031-EXIT. DTSCS31 01919 MOVE L031-SHORT-DSCR TO HOLD-EMP-CLASS-DSCR. DTSCS31 01920 DTSCS31 01921 MOVE MPRF-EMP-STATUS TO L031-CD. DTSCS31 01922 PERFORM S031-MPRF-EMP-STATUS THRU S031-EXIT. DTSCS31 01923 MOVE L031-SHORT-DSCR TO HOLD-EMP-STATUS-DSCR. DTSCS31 01924 DTSCS31 01925 PERFORM P7100-RECENT-MSOL THRU P7100-EXIT. DTSCS31 01926 DTSCS31 01927 MOVE MPRF-FLD-ZIP TO L061-FLD-ZIP. DTSCS31 01928 MOVE MPRF-EMP-NO TO L061-EMP-NO. DTSCS31 01929 MOVE MPRF-FLD-ST TO L061-FLD-ST. DTSCS31 01930 PERFORM S061-FLD-REP-FROM-ZIP THRU S061-EXIT. DTSCS31 01931 MOVE L061-FLD-REP-ID TO HOLD-EMP-FLD-REP-ID. DTSCS31 01932 DTSCS31 01933 MOVE SPACES TO HOLD-EMP-OPEN-APL-IND. DTSCS31 01934 IF MPRF-MAPL-EXISTS-88 DTSCS31 01935 MOVE LOW-VALUES TO MSKL-KEY-AREA DTSCS31 01936 MOVE WRK-EMP-NO TO MSKL-EMP-NO DTSCS31 01937 SET MSKL-APL-88 TO TRUE DTSCS31 01938 PERFORM S810-START-BROWSE THRU S810-EXIT DTSCS31 01939 PERFORM P7210-MAPL-SCAN THRU P7210-EXIT DTSCS31 01940 UNTIL L810-NO-REC-88. DTSCS31 01941 DTSCS31 01942 MOVE SPACES TO HOLD-EMP-OPEN-LIN-IND. DTSCS31 01943 IF MPRF-MLIN-EXISTS-88 DTSCS31 01944 MOVE LOW-VALUES TO MSKL-KEY-AREA DTSCS31 01945 MOVE WRK-EMP-NO TO MSKL-EMP-NO DTSCS31 01946 SET MSKL-LIN-88 TO TRUE DTSCS31 01947 PERFORM S810-START-BROWSE THRU S810-EXIT DTSCS31 01948 PERFORM P7220-MLIN-SCAN THRU P7220-EXIT DTSCS31 01949 UNTIL L810-NO-REC-88. DTSCS31 01950 DTSCS31 01951 MOVE SPACES TO HOLD-EMP-OPEN-DPC-IND. DTSCS31 01952 IF MPRF-MDPC-EXISTS-88 DTSCS31 01953 MOVE LOW-VALUES TO MSKL-KEY-AREA DTSCS31 01954 MOVE WRK-EMP-NO TO MSKL-EMP-NO DTSCS31 01955 SET MSKL-DPC-88 TO TRUE DTSCS31 01956 PERFORM S810-START-BROWSE THRU S810-EXIT DTSCS31 01957 PERFORM P7230-MDPC-SCAN THRU P7230-EXIT DTSCS31 01958 UNTIL L810-NO-REC-88. DTSCS31 01959 DTSCS31 01960 MOVE SPACE TO HOLD-EMP-SUBPOENA-CD DTSCS31 01961 HOLD-EMP-SUBPOENA-DATE. DTSCS31 01962 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS31 01963 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS31 01964 SET MSKL-COL-88 TO TRUE. DTSCS31 01965 PERFORM S810-READ THRU S810-EXIT. DTSCS31 01966 IF L810-OK-88 DTSCS31 01967 MOVE MSKL-REC TO MCOL-REC DTSCS31 01968 MOVE MCOL-SUBPOENA-ACTIVITY-CD TO HOLD-EMP-SUBPOENA-CD DTSCS31 01969 IF MCOL-SUBPOENA-ACTIVITY-DATE > +0 DTSCS31 01970 MOVE MCOL-SUBPOENA-ACTIVITY-DATE TO L001-FED-8-DATE-9DTSCS31 01971 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCS31 01972 MOVE L001-SLASH-DATE TO HOLD-EMP-SUBPOENA-DATE. DTSCS31 01973 DTSCS31 01974 MOVE +0 TO HOLD-EMP-TOT-DUE-AMT DTSCS31 01975 HOLD-EMP-PER-MONTH-INT. DTSCS31 01976 DTSCS31 01977 MOVE LOW-VALUES TO HOLD-EMP-LAST-KEY-AREA. DTSCS31 01978 DTSCS31 01979 MOVE +0 TO HOLD-EMP-LAST-PAGE. DTSCS31 01980 DTSCS31 01981 MOVE SPACE TO HOLD-EMP-PICKUP-DUE-IND. DTSCS31 01982 DTSCS31 01983 IF MPRF-TOT-BALANCE-AMT > +0 DTSCS31 01984 MOVE LOW-VALUES TO MSKL-KEY-AREA DTSCS31 01985 MOVE WRK-EMP-NO TO MSKL-EMP-NO DTSCS31 01986 SET MSKL-QTR-88 TO TRUE DTSCS31 01987 PERFORM S810-START-BROWSE THRU S810-EXIT DTSCS31 01988 PERFORM P7300-MQTR-SCAN THRU P7300-EXIT DTSCS31 01989 UNTIL L810-NO-REC-88 DTSCS31 01990 ELSE DTSCS31 01991 PERFORM P7010-EMP-TOT-DUE-AMT THRU P7010-EXIT DTSCS31 01992 MOVE LOW-VALUES TO MSKL-KEY-AREA DTSCS31 01993 MOVE WRK-EMP-NO TO MSKL-EMP-NO DTSCS31 01994 SET MSKL-QTR-88 TO TRUE DTSCS31 01995 PERFORM S810-COUNT THRU S810-EXIT DTSCS31 01996 IF L810-RECORD-CNT > +0 DTSCS31 01997 MOVE L810-RECORD-CNT TO HOLD-EMP-LAST-PAGE DTSCS31 01998 MOVE MSKL-KEY-AREA TO HOLD-EMP-LAST-KEY-AREA. DTSCS31 01999 P7000-EXIT. DTSCS31 02000 EXIT. DTSCS31 02001 SKIP3 DTSCS31 02002 P7010-EMP-TOT-DUE-AMT. DTSCS31 02003 IF MPRF-TOT-CREDIT-AMT > +0 DTSCS31 02004 COMPUTE HOLD-EMP-TOT-DUE-AMT = MPRF-TOT-CREDIT-AMT * -1 DTSCS31 02005 ELSE DTSCS31 02006 MOVE +0 TO HOLD-EMP-TOT-DUE-AMT. DTSCS31 02007 P7010-EXIT. DTSCS31 02008 EXIT. DTSCS31 02009 EJECT DTSCS31 02010 P7100-RECENT-MSOL. DTSCS31 02011 MOVE SPACES TO HOLD-EMP-RECENT-SOL. DTSCS31 02012 MOVE ':' TO HOLD-EMP-RECENT-COLON. DTSCS31 02013 DTSCS31 02014 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS31 02015 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS31 02016 SET MSKL-SOL-88 TO TRUE. DTSCS31 02017 DTSCS31 02018 PERFORM S810-COUNT THRU S810-EXIT. DTSCS31 02019 DTSCS31 02020 MOVE L810-RECORD-CNT TO HOLD-EMP-NBR-SPANS. DTSCS31 02021 DTSCS31 02022 IF L810-RECORD-CNT = +0 DTSCS31 02023 GO TO P7100-EXIT. DTSCS31 02024 DTSCS31 02025 PERFORM S810-READ THRU S810-EXIT. DTSCS31 02026 MOVE MSKL-REC TO MSOL-REC. DTSCS31 02027 DTSCS31 02028 IF MSOL-INACT-WITHDRAWN-88 DTSCS31 02029 AND HOLD-EMP-NBR-SPANS > +1 DTSCS31 02030 SUBTRACT 1 FROM HOLD-EMP-NBR-SPANS DTSCS31 02031 PERFORM P7110-LOCATE-MSOL THRU P7110-EXIT. DTSCS31 02032 DTSCS31 02033 PERFORM P7120-FIRST-LIAB-YRQ THRU P7120-EXIT. DTSCS31 02034 PERFORM P7130-LAST-LIAB-YRQ THRU P7130-EXIT. DTSCS31 02035 P7100-EXIT. DTSCS31 02036 EXIT. DTSCS31 02037 DTSCS31 02038 DTSCS31 02039 P7110-LOCATE-MSOL. DTSCS31 02040 MOVE MSKL-KEY-AREA TO WRK-KEY-AREA. DTSCS31 02041 DTSCS31 02042 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS31 02043 MOVE MSKL-REC TO MSOL-REC. DTSCS31 02044 DTSCS31 02045 PERFORM UNTIL L810-NO-REC-88 DTSCS31 02046 OR NOT MSOL-INACT-WITHDRAWN-88 DTSCS31 02047 PERFORM S810-READ-PREV THRU S810-EXIT DTSCS31 02048 MOVE MSKL-REC TO MSOL-REC DTSCS31 02049 END-PERFORM. DTSCS31 02050 DTSCS31 02051 IF L810-OK-88 DTSCS31 02052 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS31 02053 ELSE DTSCS31 02054 MOVE WRK-KEY-AREA TO MSKL-KEY-AREA DTSCS31 02055 PERFORM S810-READ THRU S810-EXIT DTSCS31 02056 MOVE MSKL-REC TO MSOL-REC. DTSCS31 02057 P7110-EXIT. EXIT. DTSCS31 02058 DTSCS31 02059 DTSCS31 02060 P7120-FIRST-LIAB-YRQ. DTSCS31 02061 IF MSOL-FIRST-LIAB-YRQ = +0 DTSCS31 02062 NEXT SENTENCE DTSCS31 02063 ELSE DTSCS31 02064 MOVE MSOL-FIRST-LIAB-YRQ TO L004-QTR-5-9 DTSCS31 02065 PERFORM S004-FROM-5 THRU S004-EXIT DTSCS31 02066 MOVE L004-SLASH-QTR TO HOLD-EMP-RECENT-FROM-YRQ. DTSCS31 02067 P7120-EXIT. DTSCS31 02068 EXIT. DTSCS31 02069 DTSCS31 02070 P7130-LAST-LIAB-YRQ. DTSCS31 02071 IF MSOL-LAST-LIAB-YRQ = +0 OR LIT-9-YRQ DTSCS31 02072 NEXT SENTENCE DTSCS31 02073 ELSE DTSCS31 02074 MOVE MSOL-LAST-LIAB-YRQ TO L004-QTR-5-9 DTSCS31 02075 PERFORM S004-FROM-5 THRU S004-EXIT DTSCS31 02076 MOVE L004-SLASH-QTR TO HOLD-EMP-RECENT-TO-YRQ. DTSCS31 02077 P7130-EXIT. DTSCS31 02078 EXIT. DTSCS31 02079 EJECT DTSCS31 02080 P7210-MAPL-SCAN. DTSCS31 02081 MOVE MSKL-REC TO MAPL-REC. DTSCS31 02082 DTSCS31 02083 IF MAPL-STATUS-OPEN-88 DTSCS31 02084 SET HOLD-EMP-OPEN-APL-YES-88 TO TRUE DTSCS31 02085 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS31 02086 SET L810-NO-REC-88 TO TRUE DTSCS31 02087 GO TO P7210-EXIT. DTSCS31 02088 DTSCS31 02089 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS31 02090 P7210-EXIT. DTSCS31 02091 EXIT. DTSCS31 02092 DTSCS31 02093 DTSCS31 02094 P7220-MLIN-SCAN. DTSCS31 02095 MOVE MSKL-REC TO MLIN-REC. DTSCS31 02096 DTSCS31 02097 IF MLIN-STATUS-ACTIVE-88 DTSCS31 02098 SET HOLD-EMP-OPEN-LIN-YES-88 TO TRUE DTSCS31 02099 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS31 02100 SET L810-NO-REC-88 TO TRUE DTSCS31 02101 GO TO P7220-EXIT. DTSCS31 02102 DTSCS31 02103 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS31 02104 P7220-EXIT. DTSCS31 02105 EXIT. DTSCS31 02106 DTSCS31 02107 DTSCS31 02108 P7230-MDPC-SCAN. DTSCS31 02109 MOVE MSKL-REC TO MDPC-REC. DTSCS31 02110 DTSCS31 02111 IF MDPC-STATUS-ACTIVE-88 DTSCS31 02112 SET HOLD-EMP-OPEN-DPC-YES-88 TO TRUE DTSCS31 02113 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS31 02114 SET L810-NO-REC-88 TO TRUE DTSCS31 02115 GO TO P7230-EXIT. DTSCS31 02116 DTSCS31 02117 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS31 02118 P7230-EXIT. DTSCS31 02119 EXIT. DTSCS31 02120 EJECT DTSCS31 02121 P7300-MQTR-SCAN. DTSCS31 02122 MOVE MSKL-REC TO MQTR-REC. DTSCS31 02123 DTSCS31 02124 MOVE MQTR-KEY-AREA TO HOLD-EMP-LAST-KEY-AREA. DTSCS31 02125 DTSCS31 02126 ADD +1 TO HOLD-EMP-LAST-PAGE. DTSCS31 02127 DTSCS31 02128 PERFORM P7310-PROCESS-MQTR THRU P7310-EXIT. DTSCS31 02129 DTSCS31 02130 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS31 02131 P7300-EXIT. DTSCS31 02132 EXIT. DTSCS31 02133 DTSCS31 02134 DTSCS31 02135 P7310-PROCESS-MQTR. DTSCS31 02136 MOVE +0 TO L101-PAID-CHNG DTSCS31 02137 * L101-PEN-CHARGED-AMT. DTSCS31 02138 DTSCS31 02139 IF MQTR-YRQ = LCCM-PICKUP-YRQ DTSCS31 02140 PERFORM DTSCS31 02141 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSCS31 02142 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSCS31 02143 IF MQTR-BALANCE-AMT (MQTR-ACCT-IDX) > +0 DTSCS31 02144 SET HOLD-EMP-PICKUP-DUE-YES-88 TO TRUE DTSCS31 02145 END-IF DTSCS31 02146 END-PERFORM. DTSCS31 02147 DTSCS31 02148 ******************************************************** DTSCS31 02149 * ONLY UI TAX BALANCE USED TO COMPUTE INTEREST DTSCS31 02150 ******************************************************** DTSCS31 02151 PERFORM DTSCS31 02152 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSCS31 02153 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSCS31 02154 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS31 02155 TO HOLD-EMP-TOT-DUE-AMT DTSCS31 02156 * IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSCS31 02157 IF MQTR-ACCT-TAX-88 (MQTR-ACCT-IDX) DTSCS31 02158 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS31 02159 TO L101-PAID-CHNG DTSCS31 02160 END-IF DTSCS31 02161 *********IF MQTR-ACCT-PEN-88 (MQTR-ACCT-IDX) DTSCS31 02162 *************ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSCS31 02163 **************TO L101-PEN-CHARGED-AMT DTSCS31 02164 *********END-IF DTSCS31 02165 END-PERFORM. DTSCS31 02166 DTSCS31 02167 IF LCCM-COMP-DATE = ALL-NINES-DATE DTSCS31 02168 GO TO P7310-EXIT. DTSCS31 02169 DTSCS31 02170 IF L101-PAID-CHNG > +0 DTSCS31 02171 NEXT SENTENCE DTSCS31 02172 ELSE DTSCS31 02173 GO TO P7310-EXIT. DTSCS31 02174 DTSCS31 02175 MOVE LCCM-COMP-DATE TO L101-RECEIVED-DATE. DTSCS31 02176 DTSCS31 02177 SET L101-WAIVE-INT-NO-88 TO TRUE. DTSCS31 02178 * SET L101-ABATE-PEN-NO-88 TO TRUE. DTSCS31 02179 DTSCS31 02180 MOVE MQTR-TAX-DUE-DATE TO L101-TAX-DUE-DATE. DTSCS31 02181 DTSCS31 02182 MOVE MQTR-INT-AREA TO L101-INT-AREA. DTSCS31 02183 DTSCS31 02184 PERFORM S101-PER-MONTH-YES THRU S101-EXIT. DTSCS31 02185 DTSCS31 02186 ADD L101-INT-CHARGE-CHNG TO HOLD-EMP-TOT-DUE-AMT. DTSCS31 02187 DTSCS31 02188 SUBTRACT L101-INT-WAIVE-CHNG FROM HOLD-EMP-TOT-DUE-AMT. DTSCS31 02189 DTSCS31 02190 * ADD L101-PEN-CHARGE-CHNG TO HOLD-EMP-TOT-DUE-AMT. DTSCS31 02191 DTSCS31 02192 * SUBTRACT L101-PEN-ABATE-CHNG FROM HOLD-EMP-TOT-DUE-AMT. DTSCS31 02193 DTSCS31 02194 ADD L101-INT-PER-MONTH TO HOLD-EMP-PER-MONTH-INT. DTSCS31 02195 P7310-EXIT. DTSCS31 02196 EXIT. DTSCS31 02197 /*****************************************************************DTSCS31 02198 * LINKS TO UTILITY MODULES DTSCS31 02199 ******************************************************************DTSCS31 02200 DTSCS31 02201 S001-FROM-FED-8. DTSCS31 02202 SET L001-FROM-FED-8 TO TRUE. DTSCS31 02203 GO TO S001-DATE. DTSCS31 02204 DTSCS31 02205 *S001-FROM-ABS-DATE. DTSCS31 02206 *****SET L001-FROM-ABS-DAY TO TRUE. DTSCS31 02207 *****GO TO S001-DATE. DTSCS31 02208 DTSCS31 02209 S001-DATE. DTSCS31 02210 EXEC CICS LINK DTSCS31 02211 PROGRAM('DTSCU001') DTSCS31 02212 COMMAREA(L001-COMM-AREA) DTSCS31 02213 END-EXEC. DTSCS31 02214 S001-EXIT. DTSCS31 02215 EXIT. DTSCS31 02216 DTSCS31 02217 S004-FROM-5. DTSCS31 02218 SET L004-FROM-5 TO TRUE. DTSCS31 02219 GO TO S004-LINK. DTSCS31 02220 DTSCS31 02221 S004-FROM-ABS. DTSCS31 02222 SET L004-FROM-ABS TO TRUE. DTSCS31 02223 GO TO S004-LINK. DTSCS31 02224 DTSCS31 02225 S004-LINK. DTSCS31 02226 EXEC CICS LINK DTSCS31 02227 PROGRAM ('DTSCU004') DTSCS31 02228 COMMAREA (L004-COMM-AREA) DTSCS31 02229 END-EXEC. DTSCS31 02230 S004-EXIT. DTSCS31 02231 EXIT. DTSCS31 02232 DTSCS31 02233 S015-DATE-FROM-SCREEN. DTSCS31 02234 EXEC CICS LINK DTSCS31 02235 PROGRAM('DTSCU015') DTSCS31 02236 COMMAREA(L015-COMM-AREA) DTSCS31 02237 END-EXEC. DTSCS31 02238 S015-EXIT. DTSCS31 02239 EXIT. DTSCS31 02240 DTSCS31 02241 *S016-YRQ-FROM-SCREEN. DTSCS31 02242 *****EXEC CICS LINK DTSCS31 02243 *********PROGRAM('DTSCU016') DTSCS31 02244 *********COMMAREA(L016-COMM-AREA) DTSCS31 02245 *****END-EXEC. DTSCS31 02246 *S016-EXIT. DTSCS31 02247 *****EXIT. DTSCS31 02248 DTSCS31 02249 DTSCS31 02250 S018-EMP-NO-FROM-SCREEN. DTSCS31 02251 EXEC CICS LINK DTSCS31 02252 PROGRAM('DTSCU018') DTSCS31 02253 COMMAREA(L018-COMM-AREA) DTSCS31 02254 END-EXEC. DTSCS31 02255 S018-EXIT. DTSCS31 02256 EXIT. DTSCS31 02257 DTSCS31 02258 DTSCS31 02259 S029-YRQ-WITH-PU-FROM-SCREEN. DTSCS31 02260 EXEC CICS LINK DTSCS31 02261 PROGRAM('DTSCU029') DTSCS31 02262 COMMAREA(L029-COMM-AREA) DTSCS31 02263 END-EXEC. DTSCS31 02264 S029-EXIT. DTSCS31 02265 EXIT. DTSCS31 02266 DTSCS31 02267 DTSCS31 02268 S031-MPRF-EMP-CLASS. DTSCS31 02269 SET L031-MPRF-EMP-CLASS TO TRUE. DTSCS31 02270 GO TO S031-LINK. DTSCS31 02271 DTSCS31 02272 S031-MPRF-EMP-STATUS. DTSCS31 02273 SET L031-MPRF-EMP-STATUS TO TRUE. DTSCS31 02274 GO TO S031-LINK. DTSCS31 02275 DTSCS31 02276 S031-LINK. DTSCS31 02277 EXEC CICS LINK DTSCS31 02278 PROGRAM ('DTSCU031') DTSCS31 02279 COMMAREA (L031-COMM-AREA) DTSCS31 02280 END-EXEC. DTSCS31 02281 S031-EXIT. DTSCS31 02282 EXIT. DTSCS31 02283 DTSCS31 02284 S032-MISS-RPT-CUTOFF-CD. DTSCS31 02285 SET L032-MQTR-MISS-RPT-CUOFF-CD TO TRUE. DTSCS31 02286 EXEC CICS LINK DTSCS31 02287 PROGRAM ('DTSCU032') DTSCS31 02288 COMMAREA (L032-COMM-AREA) DTSCS31 02289 END-EXEC. DTSCS31 02290 S032-EXIT. DTSCS31 02291 EXIT. DTSCS31 02292 DTSCS31 02293 S033-RPT-PURSUED-DSCR. DTSCS31 02294 SET L033-MQTR-RPT-PURSUE TO TRUE. DTSCS31 02295 EXEC CICS LINK DTSCS31 02296 PROGRAM ('DTSCU033') DTSCS31 02297 COMMAREA (L033-COMM-AREA) DTSCS31 02298 END-EXEC. DTSCS31 02299 S033-EXIT. DTSCS31 02300 EXIT. DTSCS31 02301 DTSCS31 02302 S056-DISP1-LEFT. DTSCS31 02303 SET L056-DISP1-LEFT-88 TO TRUE. DTSCS31 02304 GO TO S056-LINK. DTSCS31 02305 DTSCS31 02306 S056-DISP1-RIGHT. DTSCS31 02307 SET L056-DISP1-RIGHT-88 TO TRUE. DTSCS31 02308 GO TO S056-LINK. DTSCS31 02309 DTSCS31 02310 S056-LINK. DTSCS31 02311 EXEC CICS LINK DTSCS31 02312 PROGRAM ('DTSCU056') DTSCS31 02313 COMMAREA (L056-COMM-AREA) DTSCS31 02314 END-EXEC. DTSCS31 02315 S056-EXIT. DTSCS31 02316 EXIT. DTSCS31 02317 DTSCS31 02318 S061-FLD-REP-FROM-ZIP. DTSCS31 02319 EXEC CICS LINK DTSCS31 02320 PROGRAM ('DTSCU061') DTSCS31 02321 COMMAREA (L061-COMM-AREA) DTSCS31 02322 END-EXEC. DTSCS31 02323 DTSCS31 02324 IF L061-FILE-CLOSED DTSCS31 02325 MOVE L061-MSG-AREA TO LCCM-MSG-AREA DTSCS31 02326 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS31 02327 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS31 02328 GO TO MAINLINE-EXIT. DTSCS31 02329 S061-EXIT. DTSCS31 02330 EXIT. DTSCS31 02331 DTSCS31 02332 S101-PER-MONTH-NO. DTSCS31 02333 SET L101-PER-MONTH-NO-88 TO TRUE. DTSCS31 02334 GO TO S101-INT-PEN-COMP. DTSCS31 02335 DTSCS31 02336 S101-PER-MONTH-YES. DTSCS31 02337 SET L101-PER-MONTH-YES-88 TO TRUE. DTSCS31 02338 GO TO S101-INT-PEN-COMP. DTSCS31 02339 DTSCS31 02340 S101-INT-PEN-COMP. DTSCS31 02341 EXEC CICS LINK DTSCS31 02342 PROGRAM ('DTSCU101') DTSCS31 02343 COMMAREA (L101-COMM-AREA) DTSCS31 02344 END-EXEC. DTSCS31 02345 S101-EXIT. DTSCS31 02346 EXIT. DTSCS31 02347 DTSCS31 02348 S109-SUR-TAX-QTR. DTSCS31 02349 SET L109-CMND-PEN-INT-QTR-88 TO TRUE. DTSCS31 02350 DTSCS31 02351 EXEC CICS LINK DTSCS31 02352 PROGRAM ('DTSCU109') DTSCS31 02353 COMMAREA (L109-COMM-AREA) DTSCS31 02354 END-EXEC. DTSCS31 02355 S109-EXIT. DTSCS31 02356 EXIT. DTSCS31 02357 DTSCS31 02358 S410-FILING-SCHEDULE. DTSCS31 02359 SET L410-MODE-INPUT-YRQ-88 TO TRUE. DTSCS31 02360 MOVE MPRF-EMP-NO TO L410-EMP-NO. DTSCS31 02361 MOVE MQTR-YRQ TO L410-YRQ. DTSCS31 02362 DTSCS31 02363 EXEC CICS LINK DTSCS31 02364 PROGRAM ('DTSCU410') DTSCS31 02365 COMMAREA (L410-COMM-AREA) DTSCS31 02366 END-EXEC. DTSCS31 02367 DTSCS31 02368 S410-EXIT. DTSCS31 02369 EXIT. DTSCS31 02370 DTSCS31 02371 S803-REQ-SCR-ID-EDIT. DTSCS31 02372 EXEC CICS LINK DTSCS31 02373 PROGRAM ('DTSCU803') DTSCS31 02374 COMMAREA (DFHCOMMAREA) DTSCS31 02375 END-EXEC. DTSCS31 02376 S803-EXIT. DTSCS31 02377 EXIT. DTSCS31 02378 DTSCS31 02379 S804-INVALID-KEY. DTSCS31 02380 EXEC CICS LINK DTSCS31 02381 PROGRAM ('DTSCU804') DTSCS31 02382 COMMAREA (DFHCOMMAREA) DTSCS31 02383 END-EXEC. DTSCS31 02384 S804-EXIT. DTSCS31 02385 EXIT. DTSCS31 02386 DTSCS31 02387 S805-MSG-AREA. DTSCS31 02388 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS31 02389 DTSCS31 02390 EXEC CICS LINK DTSCS31 02391 PROGRAM ('DTSCU805') DTSCS31 02392 COMMAREA (L805-COMM-AREA) DTSCS31 02393 END-EXEC. DTSCS31 02394 DTSCS31 02395 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS31 02396 S805-EXIT. DTSCS31 02397 EXIT. DTSCS31 02398 EJECT DTSCS31 02399 DTSCS31 02400 S810-COUNT. DTSCS31 02401 SET L810-COUNT-88 TO TRUE. DTSCS31 02402 GO TO S810-IO. DTSCS31 02403 DTSCS31 02404 S810-READ. DTSCS31 02405 SET L810-READ-88 TO TRUE. DTSCS31 02406 GO TO S810-IO. DTSCS31 02407 DTSCS31 02408 S810-START-BROWSE. DTSCS31 02409 SET L810-START-BROWSE-88 TO TRUE. DTSCS31 02410 GO TO S810-IO. DTSCS31 02411 DTSCS31 02412 S810-READ-NEXT. DTSCS31 02413 SET L810-READ-NEXT-88 TO TRUE. DTSCS31 02414 GO TO S810-IO. DTSCS31 02415 DTSCS31 02416 S810-READ-PREV. DTSCS31 02417 SET L810-READ-PREV-88 TO TRUE. DTSCS31 02418 GO TO S810-IO. DTSCS31 02419 DTSCS31 02420 S810-END-BROWSE. DTSCS31 02421 SET L810-END-BROWSE-88 TO TRUE. DTSCS31 02422 GO TO S810-IO. DTSCS31 02423 DTSCS31 02424 S810-IO. DTSCS31 02425 DTSCS31 02426 EXEC CICS LINK DTSCS31 02427 PROGRAM ('DTSCU810') DTSCS31 02428 COMMAREA (L810-COMM-AREA) DTSCS31 02429 END-EXEC. DTSCS31 02430 DTSCS31 02431 IF L810-FILE-CLOSED-88 DTSCS31 02432 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS31 02433 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS31 02434 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS31 02435 GO TO MAINLINE-EXIT. DTSCS31 02436 S810-EXIT. DTSCS31 02437 EXIT. DTSCS31 02438 EJECT DTSCS31 02439 S851-SCREEN-PROCESSING. DTSCS31 02440 EXEC CICS LINK DTSCS31 02441 PROGRAM ('DTSCU851') DTSCS31 02442 COMMAREA (L851-COMM-AREA) DTSCS31 02443 END-EXEC. DTSCS31 02444 S851-EXIT. DTSCS31 02445 EXIT. DTSCS31 02446 DTSCS31 02447 S899-ABEND. DTSCS31 02448 EXEC CICS ABEND DTSCS31 02449 ABCODE(WRK-ABEND-CD) DTSCS31 02450 END-EXEC. DTSCS31 02451 S899-EXIT. DTSCS31 02452 EXIT. DTSCS31 02453 /*****************************************************************DTSCS31 02454 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS31 02455 ******************************************************************DTSCS31 02456 S1100-EDIT-KEY. DTSCS31 02457 PERFORM S1101-EMP-NO THRU S1101-EXIT. DTSCS31 02458 S1100-EXIT. EXIT. DTSCS31 02459 /*****************************************************************DTSCS31 02460 * DTSCS31 02461 ******************************************************************DTSCS31 02462 S1101-EMP-NO. DTSCS31 02463 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS31 02464 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS31 02465 DTSCS31 02466 IF L018-NO-ENTRY DTSCS31 02467 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS31 02468 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS31 02469 GO TO S1101-EXIT. DTSCS31 02470 DTSCS31 02471 IF L018-NOT-VALID DTSCS31 02472 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS31 02473 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS31 02474 GO TO S1101-EXIT. DTSCS31 02475 DTSCS31 02476 MOVE L018-EMP-NO TO WRK-EMP-NO. DTSCS31 02477 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS31 02478 S1101-EXIT. EXIT. DTSCS31 02479 DTSCS31 02480 S1110-READ-MPRF. DTSCS31 02481 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS31 02482 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS31 02483 SET MPRF-PRF-88 TO TRUE. DTSCS31 02484 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS31 02485 PERFORM S810-READ THRU S810-EXIT. DTSCS31 02486 IF L810-NO-REC-88 DTSCS31 02487 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS31 02488 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS31 02489 ELSE DTSCS31 02490 MOVE MSKL-REC TO MPRF-REC DTSCS31 02491 SET WRK-MPRF-YES-88 TO TRUE. DTSCS31 02492 S1110-EXIT. DTSCS31 02493 EXIT. DTSCS31 02494 DTSCS31 02495 S1199-ERROR. DTSCS31 02496 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS31 02497 MAP-EMP-NO-2-A. DTSCS31 02498 IF LCCM-NO-MSG DTSCS31 02499 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS31 02500 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L DTSCS31 02501 SET CURSOR-SET-YES TO TRUE. DTSCS31 02502 S1199-EXIT. EXIT. DTSCS31 02503 DTSCS31 02504 /*****************************************************************DTSCS31 02505 * *DTSCS31 02506 ******************************************************************DTSCS31 02507 S1200-FROM-TO-YRQ. DTSCS31 02508 SET WRK-SUPPRESS-ANN-RANGE-NO TO TRUE. DTSCS31 02509 SET WRK-RANGE-NO TO TRUE. DTSCS31 02510 SET WRK-FROM-NO-ENTRY TO TRUE. DTSCS31 02511 SET WRK-TO-NO-ENTRY TO TRUE. DTSCS31 02512 DTSCS31 02513 MOVE MAP-FROM-YRQ-AREA TO L029-S-YRQ-AREA. DTSCS31 02514 PERFORM S029-YRQ-WITH-PU-FROM-SCREEN THRU S029-EXIT. DTSCS31 02515 IF L029-NOT-VALID DTSCS31 02516 IF MAP-FROM-YRQ-YR = '00' DTSCS31 02517 AND MAP-FROM-YRQ-Q = '0' DTSCS31 02518 SET WRK-RANGE-YES TO TRUE DTSCS31 02519 MOVE LIT-ZERO-YRQ TO WRK-FROM-YRQ DTSCS31 02520 ELSE DTSCS31 02521 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS31 02522 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS31 02523 ELSE DTSCS31 02524 IF L029-NO-ENTRY DTSCS31 02525 SET WRK-FROM-NO-ENTRY TO TRUE DTSCS31 02526 ELSE DTSCS31 02527 MOVE L029-YRQ TO WRK-FROM-YRQ. DTSCS31 02528 DTSCS31 02529 MOVE MAP-TO-YRQ-AREA TO L029-S-YRQ-AREA. DTSCS31 02530 PERFORM S029-YRQ-WITH-PU-FROM-SCREEN THRU S029-EXIT. DTSCS31 02531 IF L029-NOT-VALID DTSCS31 02532 IF MAP-TO-YRQ-YR = '99' DTSCS31 02533 AND MAP-TO-YRQ-Q = '9' DTSCS31 02534 SET WRK-RANGE-YES TO TRUE DTSCS31 02535 MOVE LIT-9-YRQ TO WRK-TO-YRQ DTSCS31 02536 ELSE DTSCS31 02537 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS31 02538 PERFORM S1202-ERROR THRU S1202-EXIT DTSCS31 02539 ELSE DTSCS31 02540 IF L029-NO-ENTRY DTSCS31 02541 SET WRK-TO-NO-ENTRY TO TRUE DTSCS31 02542 ELSE DTSCS31 02543 MOVE L029-YRQ TO WRK-TO-YRQ. DTSCS31 02544 DTSCS31 02545 IF LCCM-MSG DTSCS31 02546 GO TO S1200-EXIT. DTSCS31 02547 DTSCS31 02548 IF WRK-FROM-NO-ENTRY DTSCS31 02549 AND WRK-TO-NO-ENTRY DTSCS31 02550 GO TO S1200-EXIT. DTSCS31 02551 DTSCS31 02552 IF WRK-FROM-NO-ENTRY DTSCS31 02553 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS31 02554 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS31 02555 GO TO S1200-EXIT. DTSCS31 02556 DTSCS31 02557 IF WRK-TO-NO-ENTRY DTSCS31 02558 GO TO S1200-EXIT. DTSCS31 02559 DTSCS31 02560 IF WRK-TO-YRQ < WRK-FROM-YRQ DTSCS31 02561 MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS31 02562 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS31 02563 PERFORM S1202-ERROR THRU S1202-EXIT DTSCS31 02564 GO TO S1200-EXIT. DTSCS31 02565 DTSCS31 02566 IF WRK-TO-YRQ > WRK-FROM-YRQ DTSCS31 02567 SET WRK-RANGE-YES TO TRUE. DTSCS31 02568 DTSCS31 02569 IF WRK-TO-YRQ = WRK-FROM-YRQ DTSCS31 02570 SET WRK-SUPPRESS-ANN-RANGE-YES TO TRUE. DTSCS31 02571 DTSCS31 02572 S1200-EXIT. DTSCS31 02573 EXIT. DTSCS31 02574 DTSCS31 02575 S1201-ERROR. DTSCS31 02576 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS31 02577 TO MAP-FROM-YRQ-YR-A DTSCS31 02578 MAP-FROM-YRQ-Q-A. DTSCS31 02579 DTSCS31 02580 IF LCCM-NO-MSG DTSCS31 02581 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS31 02582 MOVE CATB-CURSOR TO MAP-FROM-YRQ-YR-L DTSCS31 02583 SET CURSOR-SET-YES TO TRUE. DTSCS31 02584 S1201-EXIT. EXIT. DTSCS31 02585 DTSCS31 02586 S1202-ERROR. DTSCS31 02587 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS31 02588 TO MAP-TO-YRQ-YR-A DTSCS31 02589 MAP-TO-YRQ-Q-A. DTSCS31 02590 DTSCS31 02591 IF LCCM-NO-MSG DTSCS31 02592 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS31 02593 MOVE CATB-CURSOR TO MAP-TO-YRQ-YR-L DTSCS31 02594 SET CURSOR-SET-YES TO TRUE. DTSCS31 02595 S1202-EXIT. EXIT. DTSCS31 02596 DTSCS31 02597 /*****************************************************************DTSCS31 02598 * *DTSCS31 02599 ******************************************************************DTSCS31 02600 S1300-COMP-DATE. DTSCS31 02601 MOVE MAP-COMP-DATE-AREA TO L015-S-DATE-AREA. DTSCS31 02602 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS31 02603 DTSCS31 02604 IF MAP-COMP-MO = '99' DTSCS31 02605 AND MAP-COMP-DA = '99' DTSCS31 02606 AND MAP-COMP-YR = '99' DTSCS31 02607 MOVE ALL-NINES-DATE TO LCCM-COMP-DATE DTSCS31 02608 GO TO S1300-EXIT. DTSCS31 02609 DTSCS31 02610 IF L015-NO-ENTRY DTSCS31 02611 MOVE LCCM-COMP-DATE TO WRK-DISPLAY DTSCS31 02612 MOVE WRK-DISPLAY-MO TO MAP-COMP-MO DTSCS31 02613 MOVE WRK-DISPLAY-DA TO MAP-COMP-DA DTSCS31 02614 MOVE WRK-DISPLAY-YR TO MAP-COMP-YR DTSCS31 02615 ELSE DTSCS31 02616 IF L015-NOT-VALID DTSCS31 02617 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS31 02618 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS31 02619 ELSE DTSCS31 02620 MOVE L015-DATE TO LCCM-COMP-DATE. DTSCS31 02621 S1300-EXIT. DTSCS31 02622 EXIT. DTSCS31 02623 S1301-ERROR. DTSCS31 02624 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS31 02625 TO MAP-COMP-MO-A DTSCS31 02626 MAP-COMP-DA-A DTSCS31 02627 MAP-COMP-YR-A. DTSCS31 02628 IF LCCM-NO-MSG DTSCS31 02629 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS31 02630 MOVE CATB-CURSOR TO MAP-COMP-MO-L DTSCS31 02631 SET CURSOR-SET-YES TO TRUE. DTSCS31 02632 S1301-EXIT. EXIT. DTSCS31 02633 DTSCS31 02634 ******************************************************************DTSCS31 02635 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS31 02636 ******************************************************************DTSCS31 02637 S5300-SET-INQ-ATTRB. DTSCS31 02638 MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN DTSCS31 02639 WRK-ATB-NUM. DTSCS31 02640 DTSCS31 02641 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS31 02642 S5300-EXIT. DTSCS31 02643 EXIT. DTSCS31 02644 DTSCS31 02645 S5900-SET-ATTRB. DTSCS31 02646 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS31 02647 MAP-EMP-NO-2-A. DTSCS31 02648 DTSCS31 02649 MOVE CATB-ASKIP-BRT-MDTOFF TO DTSCS31 02650 MAP-PRIMARY-NAME-A DTSCS31 02651 MAP-CURR-PAGE-A DTSCS31 02652 MAP-LAST-PAGE-A DTSCS31 02653 MAP-WAIVE-INT-END-DATE-A DTSCS31 02654 MAP-WAIVE-INT-START-DATE-A DTSCS31 02655 MAP-WAIVE-PEN-END-DATE-A DTSCS31 02656 MAP-WAIVE-PEN-START-DATE-A DTSCS31 02657 MAP-ALD-INDS-A DTSCS31 02658 MAP-BANKRUPTCY-OPEN-IND-A DTSCS31 02659 MAP-PICKUP-DUE-IND-A DTSCS31 02660 MAP-CURR-RPT-TYPE-DSCR-A DTSCS31 02661 MAP-EMP-CLASS-DSCR-A DTSCS31 02662 MAP-EMP-STATUS-DSCR-A DTSCS31 02663 MAP-EXCESS-WAGE-A DTSCS31 02664 MAP-FLD-REP-ID-A DTSCS31 02665 MAP-INT-END-DATE-1-A DTSCS31 02666 MAP-INT-END-DATE-2-A DTSCS31 02667 MAP-INT-RATE-1-A DTSCS31 02668 MAP-INT-RATE-2-A DTSCS31 02669 MAP-INT-START-DATE-1-A DTSCS31 02670 MAP-INT-START-DATE-2-A DTSCS31 02671 MAP-INTPEN-INDS-A DTSCS31 02672 MAP-MISS-RPT-CUTOFF-CD-DSCR-A DTSCS31 02673 MAP-INT-MONTH-A DTSCS31 02674 MAP-PURSUED-RPT-CNT-A DTSCS31 02675 MAP-QTR-ALD-A DTSCS31 02676 MAP-SUBPOENA-CD-A DTSCS31 02677 MAP-SUBPOENA-DATE-A DTSCS31 02678 MAP-RECENT-SOL-A DTSCS31 02679 MAP-RPT-DUE-DATE-A DTSCS31 02680 MAP-SOL-CNT-A DTSCS31 02681 MAP-WRITEOFF-DATE-A DTSCS31 02682 MAP-TAX-DUE-DATE-A DTSCS31 02683 MAP-TAX-WAGE-A DTSCS31 02684 MAP-TOT-DUE-AMT-A DTSCS31 02685 MAP-TOT-WAGE-A DTSCS31 02686 MAP-UI-RATE-A DTSCS31 02687 MAP-WAGE-RPT-A. DTSCS31 02688 DTSCS31 02689 MOVE CATB-ASKIP-NORM-MDTOFF TO MAP-SUSP-TOL-COL-LIT-A. DTSCS31 02690 DTSCS31 02691 MOVE CATB-UNPROT-BRT-AN-MDTON TO DTSCS31 02692 MAP-FROM-YRQ-YR-A DTSCS31 02693 MAP-FROM-YRQ-Q-A DTSCS31 02694 MAP-TO-YRQ-YR-A DTSCS31 02695 MAP-TO-YRQ-Q-A. DTSCS31 02696 DTSCS31 02697 MOVE CATB-UNPROT-BRT-NUM-MDTON TO DTSCS31 02698 MAP-COMP-DA-A DTSCS31 02699 MAP-COMP-MO-A DTSCS31 02700 MAP-COMP-YR-A. DTSCS31 02701 DTSCS31 02702 PERFORM VARYING WRK-ROW FROM 1 BY 1 DTSCS31 02703 UNTIL WRK-ROW > LIT-TOT-SUB DTSCS31 02704 MOVE SPACE TO MAP-LINE (WRK-ROW) DTSCS31 02705 MOVE CATB-ASKIP-BRT-MDTOFF TO MAP-LINE-A (WRK-ROW) DTSCS31 02706 END-PERFORM. DTSCS31 02707 DTSCS31 02708 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS31 02709 S5900-EXIT. DTSCS31 02710 EXIT. DTSCS31 02711 EJECT DTSCS31 02712 /*****************************************************************DTSCS31 02713 * MAP ROUTINES *DTSCS31 02714 ******************************************************************DTSCS31 02715 S9100-RECEIVE. DTSCS31 02716 SET L851-RECEIVE-88 TO TRUE. DTSCS31 02717 DTSCS31 02718 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS31 02719 DTSCS31 02720 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS31 02721 DTSCS31 02722 MOVE L851-AID TO LCCM-AID. DTSCS31 02723 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS31 02724 S9100-EXIT. DTSCS31 02725 EXIT. DTSCS31 02726 DTSCS31 02727 S9200-SEND-DATAONLY. DTSCS31 02728 MOVE LOW-VALUES TO MAP-AREA. DTSCS31 02729 DTSCS31 02730 IF LCCM-NO-MSG DTSCS31 02731 NEXT SENTENCE DTSCS31 02732 ELSE DTSCS31 02733 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS31 02734 DTSCS31 02735 IF CURSOR-SET-GOTO DTSCS31 02736 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS31 02737 ELSE DTSCS31 02738 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS31 02739 DTSCS31 02740 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS31 02741 DTSCS31 02742 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS31 02743 DTSCS31 02744 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS31 02745 S9200-EXIT. DTSCS31 02746 EXIT. DTSCS31 02747 DTSCS31 02748 S9300-SEND-MAP. DTSCS31 02749 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS31 02750 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS31 02751 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS31 02752 DTSCS31 02753 IF SCR-ACCESS-UPDATE DTSCS31 02754 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS31 02755 ELSE DTSCS31 02756 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS31 02757 DTSCS31 02758 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCS31 02759 DTSCS31 02760 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS31 02761 DTSCS31 02762 IF CURSOR-SET-NO DTSCS31 02763 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS31 02764 DTSCS31 02765 SET L851-SEND-88 TO TRUE. DTSCS31 02766 DTSCS31 02767 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS31 02768 DTSCS31 02769 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS31 02770 S9300-EXIT. DTSCS31 02771 EXIT. DTSCS31 02772 DTSCS31 02773 S9310-UPDATE-FKEYS. DTSCS31 02774 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS31 02775 DTSCS31 02776 S9310-EXIT. DTSCS31 02777 EXIT. DTSCS31 02778 DTSCS31 02779 S9320-INQUIRY-FKEYS. DTSCS31 02780 MOVE 'F5=FRST' TO MAP-KEY-FIRST. DTSCS31 02781 MOVE CFKD-LAST TO MAP-KEY-LAST. DTSCS31 02782 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS31 02783 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS31 02784 DTSCS31 02785 * PERFORM S9321-JUMP-KEYS THRU S9321-EXIT. DTSCS31 02786 S9320-EXIT. DTSCS31 02787 EXIT. DTSCS31 02788 DTSCS31 02789 S9321-JUMP-KEYS. DTSCS31 02790 * MOVE 'F9=NOTE' TO MAP-KEY-NOTE DTSCS31 02791 * MOVE 'F10=RPT' TO MAP-KEY-RPT-INQ DTSCS31 02792 * MOVE 'F11=PAY' TO MAP-KEY-PAY DTSCS31 02793 * MOVE 'F12=ADJ' TO MAP-KEY-ADJ DTSCS31 02794 * MOVE CFKD-REG-INQ TO MAP-KEY-REG-INQ DTSCS31 02795 * MOVE CFKD-COLL-INQ TO MAP-KEY-COLL-INQ. DTSCS31 02796 S9321-EXIT. DTSCS31 02797 EXIT. DTSCS31 02798 * DTSCS31 02799 S9330-DSCR-FIELDS. DTSCS31 02800 IF WRK-MPRF-YES-88 DTSCS31 02801 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME DTSCS31 02802 ELSE DTSCS31 02803 MOVE LOW-VALUES TO MAP-PRIMARY-NAME. DTSCS31 02804 DTSCS31 02805 MOVE ' UI' TO MAP-LBL(LIT-UI-SUB). DTSCS31 02806 MOVE 'SUR' TO MAP-LBL(LIT-SUR-SUB). DTSCS31 02807 MOVE 'TAX' TO MAP-LBL(LIT-TAX-SUB). DTSCS31 02808 MOVE 'INT' TO MAP-LBL(LIT-INT-SUB). DTSCS31 02809 MOVE 'LPN' TO MAP-LBL(LIT-LATE-PEN-SUB). DTSCS31 02810 MOVE 'NPN' TO MAP-LBL(LIT-NSF-PEN-SUB). DTSCS31 02811 MOVE 'MPN' TO MAP-LBL(LIT-MISC-PEN-SUB). DTSCS31 02812 MOVE 'TOT' TO MAP-LBL(LIT-TOT-SUB). DTSCS31 02813 DTSCS31 02814 S9330-EXIT. EXIT. DTSCS31 02815 DTSCS31 02816 S9900-PREPARE-SEND. DTSCS31 02817 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS31 02818 LCCM-SCR-ID. DTSCS31 02819 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS31 02820 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS31 02821 S9900-EXIT. DTSCS31 02822 EXIT. DTSCS31