giteaadmin/DUTAS
4
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
Dutas-Dev-Update
DUTAS/CICS/DTSCS31.cob
Neeraj Kumar ca3572c5df DUTAS re-platformed to Raincode - Initial Source Code
2025-07-21 11:20:11 -04:00

2824 lines
220 KiB
COBOL
Raw Permalink Blame History

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
Reference in New Issue View Git Blame Copy Permalink