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