00001 IDENTIFICATION DIVISION. 05/21/13 00002 PROGRAM-ID. DTSCS33. DTSCS33 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV014 00004 DATE-WRITTEN. JUNE 1994. DTSCS33 00005 DATE-COMPILED. DTSCS33 00006 SKIP3 DTSCS33 00007 ***** DTSCS33 00008 * DTSCS33 00009 * FUNCTION: REPORT INQUIRY SCREEN PROCESSOR. DTSCS33 00010 * DTSCS33 00011 * DTSCS33 00012 * MODIFICATION LOG: DTSCS33 00013 * DTSCS33 00014 * 12/28/98 INITIAL DEVELOPMENT COPIED FROM MACCS33 DTSCS33 00015 * WORK ORDER: PROGRAMMER: ZL1 DTSCS33 00016 * DTSCS33 00017 * 05/18/1999 PICKUP MODIFICATIONS. DTSCS33 00018 * REFERENCE: PICKUP DIR PROGRAMMER: EHH DTSCS33 00019 * DTSCS33 00020 * 04/09/2002 MODIFIED FOR ANNUAL REPORTS. DTSCS33 00021 * REFERENCE: HOUSEHOLD PROGRAMMER: GD DTSCS33 00022 * DTSCS33 00023 * 08/23/2011 MODIFIED SCAN OF QUARTERS TO CORRECT PROBLEM WITHDTSCS33 00024 * DUPLICATE DISPLAY OF ANNUAL REPORT AFTER A SWTICHDTSCS33 00025 * FROM QUARTERLY TO ANNUAL. MODIFIED DTSCS33 00026 * P7110-PRIOR-QUARTER TO CHECK WRK-ANNUAL-IND DTSCS33 00027 * INSTEAD OF MRPT-ANNUAL-IND. THE VALUE IN THE DTSCS33 00028 * MRPT RECORD DOES NO EXIST AT THIS POINT, SINCE DTSCS33 00029 * THE NEXT (NON-ANNUAL) QUARTER HAS BEEN READ. DTSCS33 00030 * REFERENCE: HOUSEHOLD PROGRAMMER: GD DTSCS33 00031 * DTSCS33 00032 * 02/27/2013 MODIFIED TO DISPLAY ANNUAL REPORTS IN THE SAME DTSCS33 00033 * AS QUARTERLY REPORTS. IF THE REPORT IS FILED DTSCS33 00034 * ANNUALLY, A LABEL (ANN) WILL APPEAR BEFORE DTSCS33 00035 * THE QUATER. DTSCS33 00036 * REFERENCE: HOUSEHOLD PROGRAMMER: GD DTSCS33 00037 * DTSCS33 00038 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS33 00039 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS33 00040 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSCS33 00041 * DTSCS33 00042 * DESCRIPTION: DTSCS33 00043 * DTSCS33 00044 * CLEAR: DTSCS33 00045 * DTSCS33 00046 * FIELD DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO). DTSCS33 00047 * DTSCS33 00048 * DTSCS33 00049 * JUMP: DTSCS33 00050 * DTSCS33 00051 * F09 QUARTER INQUIRY (31). DTSCS33 00052 * F11 PAYMENT INQUIRY (34). DTSCS33 00053 * F12 ADJUSTMENT INQUIRY (35). DTSCS33 00054 * DTSCS33 00055 * DTSCS33 00056 * INQUIRY: DTSCS33 00057 * DTSCS33 00058 * CONTROL FIELD(S): MAP-EMP-NO DTSCS33 00059 * MAP-YRQ. DTSCS33 00060 * DTSCS33 00061 * DTSCS33 00062 * JUMP IN: IF LCCM-EMP-NO = LCCM-SCR33-HOLD-AREA EMP-NO DTSCS33 00063 * IF LCCM-YRQ = LCCM-SCR33-HOLD-AREA YRQ DTSCS33 00064 * DISPLAY THE PAGE INDICATED IN DTSCS33 00065 * LCCM-SCR33-HOLD-AREA DTSCS33 00066 * ELSE DTSCS33 00067 * IF LCCM-YRQ = 0 DTSCS33 00068 * DISPLAY PAGE 1 OF "ALL QUARTERS" DTSCS33 00069 * ELSE DTSCS33 00070 * DISPLAY PAGE 1 OF "LCCM-YRQ" DTSCS33 00071 * ELSE DTSCS33 00072 * IF LCCM-EMP-NO = 0 DTSCS33 00073 * DISPLAY 'PLEASE ENTER' MESSAGE DTSCS33 00074 * ELSE DTSCS33 00075 * IF LCCM-YRQ = 0 DTSCS33 00076 * DISPLAY PAGE 1 OF "ALL QUARTERS" DTSCS33 00077 * ELSE DTSCS33 00078 * DISPLAY PAGE 1 OF "LCCM-YRQ". DTSCS33 00079 * DTSCS33 00080 * DTSCS33 00081 * ENTER, F05, F06, F07, F08: DTSCS33 00082 * DTSCS33 00083 * DISPLAY SEQUENCE: SEE SCREEN DESCRIPTION. DTSCS33 00084 * DTSCS33 00085 * PAGE INITIALLY DISPLAYED: FIRST. DTSCS33 00086 * DTSCS33 00087 * DTSCS33 00088 * CONSTRUCTION OF THE PAGES IS SO COMPLEX THAT IT DTSCS33 00089 * WILL PROBABLY BE NECESSARY TO CONSTRUCT PAGES DTSCS33 00090 * OF INFORMATION IN TS Q 'S'. DTSCS33 00091 * DTSCS33 00092 * DTSCS33 00093 * JUMP OUT: STORE INFORMATION REPRESENTING PAGE DTSCS33 00094 * CURRENTLY DISPLAYED IN LCCM-SCR33-HOLD-AREA. DTSCS33 00095 * DTSCS33 00096 * DELETE TEMPORARY STORAGE QUEUE 'S'. DTSCS33 00097 * DTSCS33 00098 * DTSCS33 00099 * LCCM-MISC-CONTROL-AREA MAINTENANCE: DTSCS33 00100 * DTSCS33 00101 * LCCM-EMP-NO DTSCS33 00102 * DTSCS33 00103 * LCCM-YRQ DTSCS33 00104 * DTSCS33 00105 * ANNUAL REPORT PROCESSING. DTSCS33 00106 * DATA FROM ANNUAL REPORTS ARE STORED INTERNALLY AS FOUR DTSCS33 00107 * SEPARATE QUARTERLY REPORTS. THE PROGRAM SUMS THE DATA DTSCS33 00108 * IN THE FOUR MRPT RECORDS AND DISPLAYS A SINGLE ANNUAL DTSCS33 00109 * REPORT. DTSCS33 00110 * DTSCS33 00111 * P7911 HAS BEEN MODIFIED TO DETECT MRPT RECORDS FOR DTSCS33 00112 * ANNUAL REPORTS, AND TO CALL P7911A TO SUM THE DATA. DTSCS33 00113 * P7911A READS ALL FOUR MRPT RECORDS (WHICH ALL SHARE DTSCS33 00114 * THE SAME DOCUMENT NUMBER) AND SUMS THE WAGE, DTSCS33 00115 * UI CHARGED AND REMITTANCE AMOUNTS. IT THEN STARTS THE DTSCS33 00116 * FILE BROWSE OPERATION WHERE IT LEFT OFF. DTSCS33 00117 * DTSCS33 00118 * P7910 ALSO NEEDED MODIFICATION. P7911A HAS READ THE DTSCS33 00119 * MRPT RECORDS FOR ALL FOUR QUARTERS. IT THEN RESTARTS DTSCS33 00120 * THE BROWSE BEGINNING WHERE IT HAD LEFT OFF, SO THE DTSCS33 00121 * NEXT RECORD READ WILL BE THE ANNUAL REPORT MRPT FOR DTSCS33 00122 * THE SECOND QUARTER. P7910 CHECKS WHETHER IT HAS DTSCS33 00123 * ALREADY PROCESSED THE DOCUMENT NUMBER. IF SO, IT DTSCS33 00124 * BYPASSES THE MRPT. RESTARTING THE BROWSE FROM WHERE DTSCS33 00125 * IT HAS LEFT OFF IS NECESSARY IN ORDER TO FIND ANY DTSCS33 00126 * SUPPLEMENTAL REPORTS. IF THE BROWSE RESTARTS AT THE DTSCS33 00127 * FOURTH QUARTER, IT WILL NOT SEE ANY SUPPLEMENTAL DTSCS33 00128 * REPORTS. DTSCS33 00129 * DTSCS33 00130 * UPDATE: DTSCS33 00131 * DTSCS33 00132 * NONE. DTSCS33 00133 * DTSCS33 00134 * DTSCS33 00135 * RECORDS READ: DTSCS33 00136 * DTSCS33 00137 * MASTER: DTSCS33 00138 * DTSCS33 00139 * MPRF DTSCS33 00140 * MRPT DTSCS33 00141 * DTSCS33 00142 * DTSCS33 00143 * ALTERNATE INDEX: DTSCS33 00144 * DTSCS33 00145 * NONE. DTSCS33 00146 * DTSCS33 00147 * DTSCS33 00148 * REFERENCE: DTSCS33 00149 * DTSCS33 00150 * NONE. DTSCS33 00151 * DTSCS33 00152 * DTSCS33 00153 * ACCOUNTING TRANSACTION COLLECTION: DTSCS33 00154 * DTSCS33 00155 * NONE. DTSCS33 00156 * DTSCS33 00157 * DTSCS33 00158 * RECORDS UPDATED: DTSCS33 00159 * DTSCS33 00160 * MASTER: DTSCS33 00161 * DTSCS33 00162 * NONE. DTSCS33 00163 * DTSCS33 00164 * DTSCS33 00165 * REFERENCE: DTSCS33 00166 * DTSCS33 00167 * NONE. DTSCS33 00168 * DTSCS33 00169 * DTSCS33 00170 * ACCOUNTING TRANSACTION COLLECTION: DTSCS33 00171 * DTSCS33 00172 * NONE. DTSCS33 00173 * DTSCS33 00174 * DTSCS33 00175 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCS33 00176 * DTSCS33 00177 * NONE. DTSCS33 00178 * DTSCS33 00179 * DTSCS33 00180 * TEMPORARY STORAGE USAGE: DTSCS33 00181 * DTSCS33 00182 * S IF NECESSARY FOR PAGE CONSTRUCTION/CONTROL. DTSCS33 00183 * DTSCS33 00184 * DTSCS33 00185 * MODULES LINKED TO: DTSCS33 00186 * DTSCS33 00187 * DTSCU001 DATE EDIT/CONVERSION. DTSCS33 00188 * DTSCU004 QUARTER EDIT/CONVERSION. DTSCS33 00189 * DTSCU029 YEAR/QUARTER FROM SCREEN FORMAT/EDIT. DTSCS33 00190 * DTSCU018 EMPLOYER NUMBER FROM SCREEN FORMAT/EDIT. DTSCS33 00191 * DTSCU032 ACCOUNTING CODES EDIT/DESCRIPTION. DTSCS33 00192 * DTSCU056 RATE DISPLAY. DTSCS33 00193 * DTSCU810 MASTER FILE INPUT/OUTPUT. DTSCS33 00194 * DTSCU829 TEMPORARY STORAGE INPUT/OUTPUT. DTSCS33 00195 * DTSCS33 00196 * DTSCS33 00197 * VERMONT REFERENCE: DTSCS33 00198 * DTSCS33 00199 * TXC220C. DTSCS33 00200 * DTSCS33 00201 ***** DTSCS33 00202 SKIP3 DTSCS33 00203 ENVIRONMENT DIVISION. DTSCS33 00204 SKIP3 DTSCS33 00205 DATA DIVISION. DTSCS33 00206 SKIP3 DTSCS33 00207 WORKING-STORAGE SECTION. DTSCS33 002075 77 PAN-VALET PICTURE X(24) VALUE '014DTSCS33 05/21/13'. DTSCS33 00208 77 PAN-VALET PICTURE X(24) VALUE '001DTSCS33 05/21/13'. DTSCS33 00209 77 PAN-VALET PICTURE X(24) VALUE '014DTSCS33 02/27/13'. DTSCS33 00210 SKIP3 DTSCS33 00211 01 WRK-AREA. DTSCS33 00212 05 WRK-ABEND-CD PIC X(04) VALUE 'S33 '. DTSCS33 00213 SKIP1 DTSCS33 00214 05 WRK-SCR-ID. DTSCS33 00215 10 WRK-SCR-ID-N PIC 9(02) VALUE 33. DTSCS33 00216 SKIP1 DTSCS33 00217 05 WRK-F03-SCR-ID PIC X(02) VALUE '30'. DTSCS33 00218 DTSCS33 00219 05 COLUMNS-PER-PAGE PIC S9(04) COMP VALUE +4. DTSCS33 00220 DTSCS33 00221 05 ALL-NINES-YRQ PIC S9(05) COMP-3 DTSCS33 00222 VALUE +99999. DTSCS33 00223 SKIP3 DTSCS33 00224 05 SCR-ACCESS-IND PIC X(01). DTSCS33 00225 88 SCR-ACCESS-INQ VALUE '1'. DTSCS33 00226 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS33 00227 SKIP1 DTSCS33 00228 05 CURSOR-SET-IND PIC X(01). DTSCS33 00229 88 CURSOR-SET-YES VALUE 'Y'. DTSCS33 00230 88 CURSOR-SET-NO VALUE 'N'. DTSCS33 00231 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS33 00232 SKIP1 DTSCS33 00233 05 REQ-IND PIC X(01). DTSCS33 00234 88 REQ-ERROR VALUE 'O'. DTSCS33 00235 88 REQ-JUMP VALUE 'J'. DTSCS33 00236 88 REQ-INQUIRE VALUE 'I'. DTSCS33 00237 88 REQ-CLEAR VALUE 'C'. DTSCS33 00238 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS33 00239 SKIP1 DTSCS33 00240 05 RESP-IND PIC X(01). DTSCS33 00241 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS33 00242 88 RESP-SEND-MAP VALUE 'M'. DTSCS33 00243 88 RESP-JUMP VALUE 'J'. DTSCS33 00244 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS33 00245 SKIP1 DTSCS33 00246 05 WRK-MSG-AREA PIC X(64). DTSCS33 00247 SKIP1 DTSCS33 00248 05 WRK-ATB-AN PIC X(01). DTSCS33 00249 05 WRK-ATB-NUM PIC X(01). DTSCS33 00250 SKIP3 DTSCS33 00251 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSCS33 00252 DTSCS33 00253 05 WRK-MPRF-IND PIC X(01). DTSCS33 00254 88 WRK-MPRF-YES-88 VALUE 'Y'. DTSCS33 00255 88 WRK-MPRF-NO-88 VALUE 'N'. DTSCS33 00256 DTSCS33 00257 05 WRK-ANNUAL-IND PIC X(01). DTSCS33 00258 88 WRK-ANNUAL-YES-88 VALUE 'Y'. DTSCS33 00259 88 WRK-ANNUAL-NO-88 VALUE 'N'. DTSCS33 00260 DTSCS33 00261 05 WRK-YRQ PIC S9(05) COMP-3. DTSCS33 00262 SKIP3 DTSCS33 00263 05 PROCESS-YRQ PIC S9(05) COMP-3. DTSCS33 00264 SKIP3 DTSCS33 00265 05 WRK-DISPLAY PIC 9(11). DTSCS33 00266 SKIP1 DTSCS33 00267 05 FILLER REDEFINES WRK-DISPLAY. DTSCS33 00268 10 FILLER PIC X(05). DTSCS33 00269 10 WRK-DISPLAY-EMP-NO-1 PIC X(03). DTSCS33 00270 10 WRK-DISPLAY-EMP-NO-2 PIC X(03). DTSCS33 00271 SKIP1 DTSCS33 00272 05 FILLER REDEFINES WRK-DISPLAY. DTSCS33 00273 10 FILLER PIC X(08). DTSCS33 00274 10 WRK-DISPLAY-YRQ-YR PIC X(02). DTSCS33 00275 10 WRK-DISPLAY-YRQ-Q PIC X(01). DTSCS33 00276 SKIP3 DTSCS33 00277 05 COL-OCC PIC S9(04) COMP. DTSCS33 00278 SKIP3 DTSCS33 00279 05 SCR-HOLD-AREA. DTSCS33 00280 10 SCR-HOLD-EMP-NO PIC S9(07) COMP-3. DTSCS33 00281 10 SCR-HOLD-YRQ PIC S9(05) COMP-3. DTSCS33 00282 10 SCR-HOLD-CURR-PAGE-NUM PIC S9(04) COMP. DTSCS33 00283 SKIP3 DTSCS33 00284 05 ANN-RPT-AREA. DTSCS33 00285 10 WRK-MRPT-KEY PIC X(16). DTSCS33 00286 10 FILLER REDEFINES WRK-MRPT-KEY. DTSCS33 00287 15 WRK-MRPT-EMP-NO PIC S9(07) COMP-3. DTSCS33 00288 15 WRK-MRPT-REC-TYPE PIC S9(04) COMP. DTSCS33 00289 15 WRK-MRPT-YRQ PIC S9(05) COMP-3. DTSCS33 00290 15 FILLER PIC X(07). DTSCS33 00291 10 WRK-BATCH-NO PIC S9(05) COMP-3. DTSCS33 00292 10 WRK-ITEM-NO PIC S9(03) COMP-3. DTSCS33 00293 10 WRK-TOT-WAGE PIC S9(11)V99 COMP-3. DTSCS33 00294 10 WRK-TAX-WAGE PIC S9(11)V99 COMP-3. DTSCS33 00295 10 WRK-EXCESS-WAGE PIC S9(11)V99 COMP-3. DTSCS33 00296 10 WRK-REMIT-AMT PIC S9(11)V99 COMP-3. DTSCS33 00297 10 WRK-UI-CHG PIC S9(11)V99 COMP-3. DTSCS33 00298 10 WRK-SUR-CHG PIC S9(11)V99 COMP-3. DTSCS33 00299 SKIP3 DTSCS33 00300 05 INQUIRY-CONTROL-AREA. DTSCS33 00301 10 ITEM-LENGTH PIC S9(04) COMP VALUE +330. DTSCS33 00302 DTSCS33 00303 10 ITEM-MAX PIC S9(05) COMP VALUE +32760. DTSCS33 00304 DTSCS33 00305 10 ITEM-MAX-LCCM PIC S9(04) COMP VALUE +6. DTSCS33 00306 DTSCS33 00307 10 CURR-PAGE-NUM PIC S9(04) COMP. DTSCS33 00308 DTSCS33 00309 10 ITEM-SUB PIC S9(04) COMP. DTSCS33 00310 DTSCS33 00311 10 ITEM-CNT PIC S9(04) COMP. DTSCS33 00312 SKIP3 DTSCS33 00313 ***** DTSCS33 00314 * DTSCS33 00315 * IF THE LENGTH OF PAGE-AREA IS MODIFIED, THEN MAKE DTSCS33 00316 * CORRESPONDING MODIFICATIONS TO ITEM-LENGTH, L829-REC, DTSCS33 00317 * AND LCCM-SCR-HOLD-PAGE-AREA. DTSCS33 00318 * DTSCS33 00319 ***** DTSCS33 00320 DTSCS33 00321 05 PAGE-AREA PIC X(330). DTSCS33 00322 DTSCS33 00323 05 FILLER REDEFINES PAGE-AREA. DTSCS33 00324 10 PAGE-COL-CNT PIC S9(04) COMP. DTSCS33 00325 DTSCS33 00326 10 PAGE-COLUMN OCCURS 4 TIMES. DTSCS33 00327 15 PAGE-YRQ PIC S9(05) COMP-3.DTSCS33 00328 15 PAGE-YRQ-LABEL PIC X(04). DTSCS33 00329 88 PAGE-YRQ-LABEL-BLANK-88 VALUE SPACES. DTSCS33 00330 88 PAGE-YRQ-LABEL-ANN-88 VALUE 'ANN:'. DTSCS33 00331 15 PAGE-RPT-TYPE PIC X(02). DTSCS33 00332 15 PAGE-TOT-WAGE PIC S9(11)V9(02) COMP-3.DTSCS33 00333 15 PAGE-EXCESS-WAGE PIC S9(11)V9(02) COMP-3.DTSCS33 00334 15 PAGE-TAX-WAGE PIC S9(11)V9(02) COMP-3.DTSCS33 00335 15 PAGE-UI-RATE PIC S9(01)V9(04) COMP-3.DTSCS33 00336 15 PAGE-UI-TAX-AMT PIC S9(09)V9(02) COMP-3.DTSCS33 00337 15 PAGE-SUR-CHARGED-AMT PIC S9(09)V9(02) COMP-3.DTSCS33 00338 15 PAGE-DOC-NO. DTSCS33 00339 20 PAGE-BATCH-NO PIC S9(05) COMP-3.DTSCS33 00340 20 PAGE-ITEM-NO PIC S9(03) COMP-3.DTSCS33 00341 15 PAGE-INT-WAIVE-IND PIC X(01). DTSCS33 00342 15 PAGE-PEN-WAIVE-IND PIC X(01). DTSCS33 00343 15 PAGE-WAGE-RPT PIC X(01). DTSCS33 00344 15 PAGE-RESP-ACTV PIC X(03). DTSCS33 00345 15 PAGE-RESPONSIBLE-OP-ID PIC X(08). DTSCS33 00346 15 PAGE-PROCESSED-DATE PIC S9(09) COMP-3.DTSCS33 00347 15 PAGE-RECEIVED-DATE PIC S9(09) COMP-3.DTSCS33 00348 15 PAGE-REMIT-AMT PIC S9(09)V9(02) COMP-3.DTSCS33 00349 *****EJECT DTSCS33 00350 *01 MSG-LITERALS. DTSCS33 00351 *****05 MSG-E331-AREA. DTSCS33 00352 ***** 10 FILLER PIC X(04) VALUE 'E331'. DTSCS33 00353 ***** 10 FILLER PIC X(30) DTSCS33 00354 ***** VALUE ' '. DTSCS33 00355 ***** 10 FILLER PIC X(30) DTSCS33 00356 ***** VALUE ' '. DTSCS33 00357 EJECT DTSCS33 00358 01 L001-COMM-AREA. DTSCS33 00359 ++INCLUDE DTSIL001 DTSCS33 00360 EJECT DTSCS33 00361 01 L004-COMM-AREA. DTSCS33 00362 ++INCLUDE DTSIL004 DTSCS33 00363 EJECT DTSCS33 00364 01 L018-COMM-AREA. DTSCS33 00365 ++INCLUDE DTSIL018 DTSCS33 00366 EJECT DTSCS33 00367 01 L029-COMM-AREA. DTSCS33 00368 ++INCLUDE DTSIL029 DTSCS33 00369 EJECT DTSCS33 00370 01 L032-COMM-AREA. DTSCS33 00371 ++INCLUDE DTSIL032 DTSCS33 00372 EJECT DTSCS33 00373 01 L056-COMM-AREA. DTSCS33 00374 ++INCLUDE DTSIL056 DTSCS33 00375 EJECT DTSCS33 00376 01 L805-COMM-AREA. DTSCS33 00377 ++INCLUDE DTSIL805 DTSCS33 00378 EJECT DTSCS33 00379 01 L810-COMM-AREA. DTSCS33 00380 05 L810-CONTROL-BLOCK. DTSCS33 00381 ++INCLUDE DTSIL810 DTSCS33 00382 EJECT DTSCS33 00383 05 MSKL-REC. DTSCS33 00384 ++INCLUDE DTSIMSKL DTSCS33 00385 EJECT DTSCS33 00386 01 MPRF-REC. DTSCS33 00387 ++INCLUDE DTSIMPRF DTSCS33 00388 EJECT DTSCS33 00389 01 MRPT-REC. DTSCS33 00390 ++INCLUDE DTSIMRPT DTSCS33 00391 EJECT DTSCS33 00392 01 L829-COMM-AREA. DTSCS33 00393 05 L829-CONTROL-BLOCK. DTSCS33 00394 ++INCLUDE DTSIL829 DTSCS33 00395 SKIP3 DTSCS33 00396 05 L829-REC PIC X(330). DTSCS33 00397 EJECT DTSCS33 00398 01 L851-COMM-AREA. DTSCS33 00399 ++INCLUDE DTSIL851 DTSCS33 00400 SKIP3 DTSCS33 00401 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS33 00402 ++INCLUDE DTSIS33 DTSCS33 00403 EJECT DTSCS33 00404 01 CATB-LITERALS. DTSCS33 00405 ++INCLUDE DTSICATB DTSCS33 00406 SKIP3 DTSCS33 00407 01 CFKD-LITERALS. DTSCS33 00408 ++INCLUDE DTSICFKD DTSCS33 00409 SKIP3 DTSCS33 00410 01 CECD-LITERALS. DTSCS33 00411 ++INCLUDE DTSICECD DTSCS33 00412 SKIP3 DTSCS33 00413 01 CPCD-LITERALS. DTSCS33 00414 ++INCLUDE DTSICPCD DTSCS33 00415 EJECT DTSCS33 00416 LINKAGE SECTION. DTSCS33 00417 SKIP3 DTSCS33 00418 01 DFHCOMMAREA. DTSCS33 00419 ++INCLUDE DTSILCCM DTSCS33 00420 SKIP3 DTSCS33 00421 15 FILLER REDEFINES LCCM-SCR-HOLD-AREA. DTSCS33 00422 20 LCCM-SCR-HOLD-CONTROL-AREA. DTSCS33 00423 25 LCCM-SCR-HOLD-EMP-NO PIC S9(07) COMP-3.DTSCS33 00424 25 LCCM-SCR-HOLD-YRQ PIC S9(05) COMP-3.DTSCS33 00425 25 LCCM-SCR-HOLD-ABSTIME PIC S9(15) COMP-3.DTSCS33 00426 25 LCCM-SCR-HOLD-LAST-PAGE-NUM DTSCS33 00427 PIC S9(04) COMP. DTSCS33 00428 DTSCS33 00429 20 LCCM-SCR-HOLD-PAGE-AREA OCCURS 6 TIMES DTSCS33 00430 PIC X(330). DTSCS33 00431 EJECT DTSCS33 00432 ******************************************************************DTSCS33 00433 * *DTSCS33 00434 ******************************************************************DTSCS33 00435 SKIP1 DTSCS33 00436 PROCEDURE DIVISION. DTSCS33 00437 SKIP2 DTSCS33 00438 MOVE +0 TO WRK-EMP-NO. DTSCS33 00439 DTSCS33 00440 SET WRK-MPRF-NO-88 TO TRUE. DTSCS33 00441 DTSCS33 00442 MOVE +0 TO WRK-YRQ. DTSCS33 00443 SKIP1 DTSCS33 00444 MOVE LOW-VALUES TO MAP-AREA. DTSCS33 00445 SKIP1 DTSCS33 00446 SET CURSOR-SET-NO TO TRUE. DTSCS33 00447 SKIP1 DTSCS33 00448 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N) DTSCS33 00449 TO SCR-ACCESS-IND. DTSCS33 00450 SKIP3 DTSCS33 00451 MOVE SPACE TO REQ-IND. DTSCS33 00452 SKIP1 DTSCS33 00453 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS33 00454 SKIP1 DTSCS33 00455 *----------------------------------------------------- DTSCS33 00456 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS33 00457 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS33 00458 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS33 00459 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS33 00460 * DTSCS33 00461 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS33 00462 * PROCESSED. DTSCS33 00463 * DTSCS33 00464 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS33 00465 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS33 00466 * WORK STATION OPERATOR. DTSCS33 00467 *----------------------------------------------------- DTSCS33 00468 SKIP1 DTSCS33 00469 MOVE SPACE TO RESP-IND. DTSCS33 00470 SKIP1 DTSCS33 00471 IF REQ-ERROR DTSCS33 00472 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS33 00473 ELSE DTSCS33 00474 IF REQ-JUMP DTSCS33 00475 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS33 00476 ELSE DTSCS33 00477 IF REQ-CLEAR DTSCS33 00478 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS33 00479 ELSE DTSCS33 00480 IF REQ-CURSOR-TO-GOTO DTSCS33 00481 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS33 00482 ELSE DTSCS33 00483 IF REQ-INQUIRE DTSCS33 00484 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS33 00485 ELSE DTSCS33 00486 *****IF REQ-EDIT DTSCS33 00487 ***** PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS33 00488 *****ELSE DTSCS33 00489 *****IF REQ-UPDATE DTSCS33 00490 ***** PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS33 00491 *****ELSE DTSCS33 00492 GO TO S899-ABEND. DTSCS33 00493 SKIP3 DTSCS33 00494 *----------------------------------------------------- DTSCS33 00495 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS33 00496 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS33 00497 *----------------------------------------------------- DTSCS33 00498 SKIP1 DTSCS33 00499 IF RESP-SEND-MAP DTSCS33 00500 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS33 00501 SET LCCM-END-TASK-88 TO TRUE DTSCS33 00502 ELSE DTSCS33 00503 IF RESP-SEND-MSGONLY DTSCS33 00504 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS33 00505 SET LCCM-END-TASK-88 TO TRUE DTSCS33 00506 ELSE DTSCS33 00507 IF RESP-JUMP DTSCS33 00508 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS33 00509 ELSE DTSCS33 00510 IF RESP-CURSOR-TO-GOTO DTSCS33 00511 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS33 00512 SET LCCM-END-TASK-88 TO TRUE DTSCS33 00513 ELSE DTSCS33 00514 GO TO S899-ABEND. DTSCS33 00515 SKIP3 DTSCS33 00516 MAINLINE-EXIT. DTSCS33 00517 SKIP1 DTSCS33 00518 EXEC CICS DTSCS33 00519 RETURN DTSCS33 00520 END-EXEC. DTSCS33 00521 SKIP2 DTSCS33 00522 GOBACK. DTSCS33 00523 EJECT DTSCS33 00524 /*****************************************************************DTSCS33 00525 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS33 00526 ******************************************************************DTSCS33 00527 P1000-ANALYZE-REQUEST. DTSCS33 00528 SKIP1 DTSCS33 00529 *----------------------------------------------------- DTSCS33 00530 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS33 00531 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS33 00532 * REPLACED WITH ENTER) DTSCS33 00533 *----------------------------------------------------- DTSCS33 00534 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS33 00535 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA DTSCS33 00536 SET LCCM-ENTER-88 TO TRUE DTSCS33 00537 IF LCCM-EMP-NO = +0 DTSCS33 00538 MOVE +0 TO LCCM-YRQ DTSCS33 00539 MOVE PMSG-KEY-EMP-NO TO LCCM-MSG-AREA DTSCS33 00540 SET REQ-CLEAR TO TRUE DTSCS33 00541 ELSE DTSCS33 00542 SET REQ-INQUIRE TO TRUE DTSCS33 00543 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS33 00544 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS33 00545 PERFORM P1100-CHECK-LCCM-YRQ THRU P1100-EXIT DTSCS33 00546 END-IF DTSCS33 00547 GO TO P1000-EXIT. DTSCS33 00548 SKIP3 DTSCS33 00549 *----------------------------------------------------- DTSCS33 00550 * MAP IS RECEIVED DTSCS33 00551 *----------------------------------------------------- DTSCS33 00552 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS33 00553 SKIP3 DTSCS33 00554 *----------------------------------------------------- DTSCS33 00555 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS33 00556 * WORK STATION DTSCS33 00557 *----------------------------------------------------- DTSCS33 00558 IF LCCM-CLEAR-88 DTSCS33 00559 SET REQ-CLEAR TO TRUE DTSCS33 00560 GO TO P1000-EXIT. DTSCS33 00561 SKIP3 DTSCS33 00562 *----------------------------------------------------- DTSCS33 00563 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS33 00564 *----------------------------------------------------- DTSCS33 00565 IF LCCM-PA2-88 DTSCS33 00566 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS33 00567 GO TO P1000-EXIT. DTSCS33 00568 SKIP3 DTSCS33 00569 *----------------------------------------------------- DTSCS33 00570 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS33 00571 *----------------------------------------------------- DTSCS33 00572 IF LCCM-PA-88 DTSCS33 00573 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS33 00574 SET REQ-ERROR TO TRUE DTSCS33 00575 GO TO P1000-EXIT. DTSCS33 00576 SKIP3 DTSCS33 00577 *----------------------------------------------------- DTSCS33 00578 * IF PF12 KEY IS PRESSED THEN CLEAR SCREEN DTSCS33 00579 *----------------------------------------------------- DTSCS33 00580 IF LCCM-F12-88 DTSCS33 00581 MOVE LOW-VALUES TO MAP-AREA DTSCS33 00582 SET REQ-CLEAR TO TRUE DTSCS33 00583 GO TO P1000-EXIT. DTSCS33 00584 SKIP3 DTSCS33 00585 *----------------------------------------------------- DTSCS33 00586 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS33 00587 *----------------------------------------------------- DTSCS33 00588 IF LCCM-F03-88 DTSCS33 00589 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS33 00590 SET REQ-JUMP TO TRUE DTSCS33 00591 GO TO P1000-EXIT. DTSCS33 00592 SKIP3 DTSCS33 00593 *----------------------------------------------------- DTSCS33 00594 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS33 00595 *----------------------------------------------------- DTSCS33 00596 IF LCCM-F04-88 DTSCS33 00597 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS33 00598 SET REQ-JUMP TO TRUE DTSCS33 00599 GO TO P1000-EXIT. DTSCS33 00600 SKIP3 DTSCS33 00601 *----------------------------------------------------- DTSCS33 00602 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS33 00603 * CORRESPONDENCE SCREEN DTSCS33 00604 *----------------------------------------------------- DTSCS33 00605 IF LCCM-F14-88 DTSCS33 00606 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS33 00607 SET REQ-JUMP TO TRUE DTSCS33 00608 GO TO P1000-EXIT. DTSCS33 00609 SKIP3 DTSCS33 00610 * IF LCCM-F09-88 DTSCS33 00611 * MOVE '31' TO LCCM-REQ-SCR-ID DTSCS33 00612 * SET REQ-JUMP TO TRUE DTSCS33 00613 * GO TO P1000-EXIT. DTSCS33 00614 * DTSCS33 00615 * IF LCCM-F11-88 DTSCS33 00616 * MOVE '34' TO LCCM-REQ-SCR-ID DTSCS33 00617 * SET REQ-JUMP TO TRUE DTSCS33 00618 * GO TO P1000-EXIT. DTSCS33 00619 * DTSCS33 00620 * IF LCCM-F12-88 DTSCS33 00621 * MOVE '35' TO LCCM-REQ-SCR-ID DTSCS33 00622 * SET REQ-JUMP TO TRUE DTSCS33 00623 * GO TO P1000-EXIT. DTSCS33 00624 * SKIP3 DTSCS33 00625 *----------------------------------------------------- DTSCS33 00626 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS33 00627 * REQUESTED SCREEN TYPE DTSCS33 00628 *----------------------------------------------------- DTSCS33 00629 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS33 00630 NEXT SENTENCE DTSCS33 00631 ELSE DTSCS33 00632 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS33 00633 SET REQ-JUMP TO TRUE DTSCS33 00634 GO TO P1000-EXIT. DTSCS33 00635 SKIP3 DTSCS33 00636 *----------------------------------------------------- DTSCS33 00637 * IF INQUIRY TYPE KEY PRESSED (ENTER, F5, F6, F7, DTSCS33 00638 * F8), INDICATE INQUIRY REQUEST DTSCS33 00639 *----------------------------------------------------- DTSCS33 00640 IF LCCM-INQUIRY-88 DTSCS33 00641 SET REQ-INQUIRE TO TRUE DTSCS33 00642 GO TO P1000-EXIT. DTSCS33 00643 SKIP3 DTSCS33 00644 *----------------------------------------------------- DTSCS33 00645 * ANY OTHER KEY IS INVALID DTSCS33 00646 *----------------------------------------------------- DTSCS33 00647 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS33 00648 SET REQ-ERROR TO TRUE. DTSCS33 00649 P1000-EXIT. DTSCS33 00650 EXIT. DTSCS33 00651 SKIP3 DTSCS33 00652 P1100-CHECK-LCCM-YRQ. DTSCS33 00653 IF LCCM-YRQ = ALL-NINES-YRQ DTSCS33 00654 MOVE +0 TO LCCM-YRQ DTSCS33 00655 GO TO P1100-EXIT. DTSCS33 00656 DTSCS33 00657 IF LCCM-YRQ <= LCCM-PICKUP-YRQ DTSCS33 00658 MOVE +0 TO LCCM-YRQ DTSCS33 00659 GO TO P1100-EXIT. DTSCS33 00660 DTSCS33 00661 IF LCCM-YRQ > +0 DTSCS33 00662 PERFORM P1110-DISPLAY-YRQ THRU P1110-EXIT DTSCS33 00663 GO TO P1100-EXIT. DTSCS33 00664 DTSCS33 00665 *****MOVE LCCM-SCR33-HOLD-AREA TO SCR-HOLD-AREA. DTSCS33 00666 *****IF SCR-HOLD-AREA NOT = LOW-VALUES DTSCS33 00667 ***** IF SCR-HOLD-EMP-NO = LCCM-EMP-NO DTSCS33 00668 ***** IF SCR-HOLD-YRQ > +0 DTSCS33 00669 ***** MOVE SCR-HOLD-YRQ TO LCCM-YRQ DTSCS33 00670 ***** PERFORM P1110-DISPLAY-YRQ THRU P1110-EXIT. DTSCS33 00671 P1100-EXIT. DTSCS33 00672 EXIT. DTSCS33 00673 SKIP3 DTSCS33 00674 P1110-DISPLAY-YRQ. DTSCS33 00675 IF LCCM-YRQ = LCCM-PICKUP-YRQ DTSCS33 00676 MOVE 'PU' TO MAP-YRQ-YR DTSCS33 00677 MOVE ' ' TO MAP-YRQ-Q DTSCS33 00678 ELSE DTSCS33 00679 MOVE LCCM-YRQ TO WRK-DISPLAY DTSCS33 00680 MOVE WRK-DISPLAY-YRQ-YR TO MAP-YRQ-YR DTSCS33 00681 MOVE WRK-DISPLAY-YRQ-Q TO MAP-YRQ-Q. DTSCS33 00682 P1110-EXIT. DTSCS33 00683 EXIT. DTSCS33 00684 /*****************************************************************DTSCS33 00685 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS33 00686 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS33 00687 ******************************************************************DTSCS33 00688 SKIP1 DTSCS33 00689 P2000-REQUEST-ERROR. DTSCS33 00690 IF LCCM-MSG DTSCS33 00691 SET RESP-SEND-MSGONLY TO TRUE DTSCS33 00692 ELSE DTSCS33 00693 GO TO S899-ABEND. DTSCS33 00694 P2000-EXIT. DTSCS33 00695 EXIT. DTSCS33 00696 /*****************************************************************DTSCS33 00697 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS33 00698 ******************************************************************DTSCS33 00699 SKIP1 DTSCS33 00700 P3000-REQUEST-JUMP. DTSCS33 00701 *----------------------------------------------------- DTSCS33 00702 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS33 00703 * BY USER DTSCS33 00704 *----------------------------------------------------- DTSCS33 00705 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS33 00706 SKIP3 DTSCS33 00707 *----------------------------------------------------- DTSCS33 00708 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS33 00709 *----------------------------------------------------- DTSCS33 00710 IF LCCM-MSG DTSCS33 00711 SET RESP-SEND-MSGONLY TO TRUE DTSCS33 00712 SET CURSOR-SET-GOTO TO TRUE DTSCS33 00713 GO TO P3000-EXIT. DTSCS33 00714 SKIP3 DTSCS33 00715 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS33 00716 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS33 00717 IF L018-VALID DTSCS33 00718 MOVE L018-EMP-NO TO LCCM-EMP-NO DTSCS33 00719 DTSCS33 00720 MOVE MAP-YRQ-AREA TO L029-S-YRQ-AREA DTSCS33 00721 PERFORM S029-YRQ-FROM-SCREEN THRU S029-EXIT DTSCS33 00722 IF L029-VALID DTSCS33 00723 MOVE L029-YRQ TO LCCM-YRQ. DTSCS33 00724 SKIP3 DTSCS33 00725 *----------------------------------------------------- DTSCS33 00726 * IF PAGES OF INFORMATION ARE IN TS, THEN BEFORE DTSCS33 00727 * JUMPING OUT OF THIS MODULE, DELETE THE TS QUEUE. DTSCS33 00728 *----------------------------------------------------- DTSCS33 00729 DTSCS33 00730 IF LCCM-SCR-HOLD-CONTROL-AREA = LOW-VALUES DTSCS33 00731 NEXT SENTENCE DTSCS33 00732 ELSE DTSCS33 00733 IF LCCM-SCR-HOLD-LAST-PAGE-NUM > ITEM-MAX-LCCM DTSCS33 00734 PERFORM S829-DELETE-QUEUE THRU S829-EXIT. DTSCS33 00735 SKIP3 DTSCS33 00736 *----------------------------------------------------- DTSCS33 00737 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS33 00738 *----------------------------------------------------- DTSCS33 00739 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS33 00740 LCCM-SCR-HOLD-AREA. DTSCS33 00741 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS33 00742 SET RESP-JUMP TO TRUE. DTSCS33 00743 P3000-EXIT. DTSCS33 00744 EXIT. DTSCS33 00745 /*****************************************************************DTSCS33 00746 * CLEAR KEY WAS PRESSED *DTSCS33 00747 ******************************************************************DTSCS33 00748 SKIP1 DTSCS33 00749 P4000-REQUEST-CLEAR. DTSCS33 00750 *----------------------------------------------------- DTSCS33 00751 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS33 00752 * FIELDS FROM EARLIER REQUESTS DTSCS33 00753 *----------------------------------------------------- DTSCS33 00754 IF LCCM-EMP-NO > ZERO DTSCS33 00755 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS33 00756 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS33 00757 DTSCS33 00758 DTSCS33 00759 MOVE ZERO TO LCCM-EMP-NO DTSCS33 00760 LCCM-YRQ. DTSCS33 00761 DTSCS33 00762 MOVE LOW-VALUES TO LCCM-SCR33-HOLD-AREA. DTSCS33 00763 DTSCS33 00764 DTSCS33 00765 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS33 00766 DTSCS33 00767 SET LCCM-SCR-CLEAR TO TRUE. DTSCS33 00768 DTSCS33 00769 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS33 00770 DTSCS33 00771 SET RESP-SEND-MAP TO TRUE. DTSCS33 00772 P4000-EXIT. DTSCS33 00773 EXIT. DTSCS33 00774 /*****************************************************************DTSCS33 00775 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS33 00776 ******************************************************************DTSCS33 00777 SKIP1 DTSCS33 00778 P5000-CURSOR-TO-GOTO. DTSCS33 00779 SET CURSOR-SET-GOTO TO TRUE. DTSCS33 00780 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS33 00781 P5000-EXIT. DTSCS33 00782 EXIT. DTSCS33 00783 /*****************************************************************DTSCS33 00784 * INQUIRY WAS REQUESTED *DTSCS33 00785 ******************************************************************DTSCS33 00786 SKIP1 DTSCS33 00787 P6000-REQUEST-INQUIRE. DTSCS33 00788 *------------------------------------------------------------ DTSCS33 00789 * CLEAR MAP-AREA WHILE PRESERVING MAP-EMP-NO-AREA AND DTSCS33 00790 * MAP-YRQ-AREA. DTSCS33 00791 *------------------------------------------------------------ DTSCS33 00792 DTSCS33 00793 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS33 00794 DTSCS33 00795 MOVE MAP-YRQ-AREA TO L029-S-YRQ-AREA. DTSCS33 00796 DTSCS33 00797 MOVE LOW-VALUES TO MAP-AREA. DTSCS33 00798 DTSCS33 00799 MOVE L018-S-EMP-NO-AREA TO MAP-EMP-NO-AREA. DTSCS33 00800 DTSCS33 00801 MOVE L029-S-YRQ-AREA TO MAP-YRQ-AREA. DTSCS33 00802 DTSCS33 00803 DTSCS33 00804 SET LCCM-SCR-CLEAR TO TRUE. DTSCS33 00805 DTSCS33 00806 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS33 00807 DTSCS33 00808 SET RESP-SEND-MAP TO TRUE. DTSCS33 00809 DTSCS33 00810 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS33 00811 DTSCS33 00812 DTSCS33 00813 *------------------------------------------------------------ DTSCS33 00814 * IF LAST ACTION WAS A SCREEN 33 DISPLAY, THEN LCCM-SCR33 DTSCS33 00815 * HOLD-AREA CONTAINS EMP NO, YRQ AND PAGE NUMBER LAST DTSCS33 00816 * DISPLAYED. DTSCS33 00817 *------------------------------------------------------------ DTSCS33 00818 DTSCS33 00819 MOVE LCCM-SCR33-HOLD-AREA TO SCR-HOLD-AREA. DTSCS33 00820 DTSCS33 00821 MOVE LOW-VALUES TO LCCM-SCR33-HOLD-AREA. DTSCS33 00822 DTSCS33 00823 DTSCS33 00824 *------------------------------------------------------------ DTSCS33 00825 * EDIT MAP-EMP-NO-AREA AND MAP-YRQ-AREA FOR VALIDITY. DTSCS33 00826 *------------------------------------------------------------ DTSCS33 00827 DTSCS33 00828 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS33 00829 IF LCCM-MSG DTSCS33 00830 NEXT SENTENCE DTSCS33 00831 ELSE DTSCS33 00832 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS33 00833 DTSCS33 00834 PERFORM S1200-YRQ THRU S1200-EXIT. DTSCS33 00835 IF LCCM-MSG DTSCS33 00836 GO TO P6000-EXIT. DTSCS33 00837 DTSCS33 00838 MOVE WRK-YRQ TO LCCM-YRQ. DTSCS33 00839 DTSCS33 00840 DTSCS33 00841 *------------------------------------------------------------ DTSCS33 00842 * THIS MODULE CONSTRUCTS PAGES OF INFORMATION INTO DTSCS33 00843 * LCCM-SCR-HOLD-AREA (WITH ANY OVERFLOW STORED IN TS) DTSCS33 00844 * AND RETAINS THIS INFORMATION BETWEEN TASKS. DTSCS33 00845 * DTSCS33 00846 * IF LCCM-SCR-HOLD-AREA CONTAINS INFORMATION FOR THE EMP-NO DTSCS33 00847 * AND YRQ SPECIFIED ON THE SCREEN AND THE EMPLOYER'S DTSCS33 00848 * RECORDS HAVE NOT BEEN UPDATED SINCE THE LCCM-SCR-HOLD-AREA DTSCS33 00849 * WAS CONSTRUCTED, THEN THE INFORMATION IN LCCM-SCR-HOLD-AREA DTSCS33 00850 * MAY BE USED FOR PAGING AND DISPLAY - IT IS NOT NECESSARY DTSCS33 00851 * TO REBUILD LCCM-SCR-HOLD-AREA. DTSCS33 00852 *------------------------------------------------------------ DTSCS33 00853 DTSCS33 00854 IF (LCCM-SCR-HOLD-CONTROL-AREA = LOW-VALUES) DTSCS33 00855 OR DTSCS33 00856 (WRK-EMP-NO NOT = LCCM-SCR-HOLD-EMP-NO) DTSCS33 00857 OR DTSCS33 00858 (WRK-YRQ NOT = LCCM-SCR-HOLD-YRQ) DTSCS33 00859 OR DTSCS33 00860 (LCCM-SCR-HOLD-ABSTIME < MPRF-UPDATE-END-ABSTIME) DTSCS33 00861 PERFORM P7000-CONSTRUCT-PAGES THRU P7000-EXIT. DTSCS33 00862 DTSCS33 00863 DTSCS33 00864 *------------------------------------------------------------ DTSCS33 00865 * IF NO INFORMATION IS AVAILABLE FOR DISPLAY, THEN YOU DTSCS33 00866 * ARE DONE. DTSCS33 00867 *------------------------------------------------------------ DTSCS33 00868 DTSCS33 00869 IF LCCM-SCR-HOLD-LAST-PAGE-NUM = +0 DTSCS33 00870 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS33 00871 PERFORM S1299-ERROR THRU S1299-EXIT DTSCS33 00872 GO TO P6000-EXIT. DTSCS33 00873 DTSCS33 00874 DTSCS33 00875 *------------------------------------------------------------ DTSCS33 00876 * DETERMINE WHICH PAGE TO DISPLAY. DTSCS33 00877 *------------------------------------------------------------ DTSCS33 00878 DTSCS33 00879 PERFORM P6200-LOCATE-PAGE THRU P6200-EXIT. DTSCS33 00880 IF LCCM-MSG DTSCS33 00881 GO TO P6000-EXIT. DTSCS33 00882 DTSCS33 00883 DTSCS33 00884 *------------------------------------------------------------ DTSCS33 00885 * PLACE INFORMATION INTO MAP-AREA. DTSCS33 00886 *------------------------------------------------------------ DTSCS33 00887 DTSCS33 00888 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS33 00889 DTSCS33 00890 DTSCS33 00891 MOVE WRK-EMP-NO TO SCR-HOLD-EMP-NO. DTSCS33 00892 DTSCS33 00893 MOVE WRK-YRQ TO SCR-HOLD-YRQ. DTSCS33 00894 DTSCS33 00895 MOVE CURR-PAGE-NUM TO SCR-HOLD-CURR-PAGE-NUM. DTSCS33 00896 DTSCS33 00897 MOVE SCR-HOLD-AREA TO LCCM-SCR33-HOLD-AREA. DTSCS33 00898 DTSCS33 00899 DTSCS33 00900 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS33 00901 P6000-EXIT. DTSCS33 00902 EXIT. DTSCS33 00903 EJECT DTSCS33 00904 P6200-LOCATE-PAGE. DTSCS33 00905 IF (SCR-HOLD-AREA = LOW-VALUES) DTSCS33 00906 OR DTSCS33 00907 (SCR-HOLD-EMP-NO NOT = WRK-EMP-NO) DTSCS33 00908 OR DTSCS33 00909 (SCR-HOLD-YRQ NOT = WRK-YRQ) DTSCS33 00910 MOVE +1 TO CURR-PAGE-NUM DTSCS33 00911 GO TO P6200-EXIT. DTSCS33 00912 DTSCS33 00913 IF LCCM-ENTER-88 DTSCS33 00914 MOVE SCR-HOLD-CURR-PAGE-NUM TO CURR-PAGE-NUM DTSCS33 00915 ELSE DTSCS33 00916 IF LCCM-F05-88 DTSCS33 00917 MOVE +1 TO CURR-PAGE-NUM DTSCS33 00918 ELSE DTSCS33 00919 IF LCCM-F06-88 DTSCS33 00920 MOVE LCCM-SCR-HOLD-LAST-PAGE-NUM TO CURR-PAGE-NUM DTSCS33 00921 ELSE DTSCS33 00922 IF LCCM-F07-88 DTSCS33 00923 COMPUTE CURR-PAGE-NUM = SCR-HOLD-CURR-PAGE-NUM - 1 DTSCS33 00924 ELSE DTSCS33 00925 IF LCCM-F08-88 DTSCS33 00926 COMPUTE CURR-PAGE-NUM = SCR-HOLD-CURR-PAGE-NUM + 1 DTSCS33 00927 ELSE DTSCS33 00928 GO TO S899-ABEND. DTSCS33 00929 DTSCS33 00930 IF CURR-PAGE-NUM < +1 DTSCS33 00931 MOVE +1 TO CURR-PAGE-NUM DTSCS33 00932 ELSE DTSCS33 00933 IF CURR-PAGE-NUM > LCCM-SCR-HOLD-LAST-PAGE-NUM DTSCS33 00934 MOVE LCCM-SCR-HOLD-LAST-PAGE-NUM TO CURR-PAGE-NUM. DTSCS33 00935 P6200-EXIT. DTSCS33 00936 EXIT. DTSCS33 00937 /*****************************************************************DTSCS33 00938 * *DTSCS33 00939 ******************************************************************DTSCS33 00940 SKIP1 DTSCS33 00941 P6900-CONSTRUCT-SCREEN. DTSCS33 00942 *-------------------------------------------------------------- DTSCS33 00943 * PAGES OF INFORMATION HAVE BEEN ASSEMBLED AND PLACED INTO DTSCS33 00944 * LCCM-SCR-HOLD-AREA AND A PAGE (CURR-PAGE-NUM) HAS BEEN DTSCS33 00945 * SELECTED FOR DISPLAY. THUS, ALL THAT IS LEFT IS TO RETRIEVE DTSCS33 00946 * THE SELECTED PAGE OF INFORMATION FROM LCCM-SCR-HOLD-AREA DTSCS33 00947 * (OR THE TS OVERFLOW) INTO PAGE-AREA AND MOVE DATA ELEMENTS DTSCS33 00948 * FROM PAGE-AREA TO MAP-AREA. DTSCS33 00949 *-------------------------------------------------------------- DTSCS33 00950 DTSCS33 00951 MOVE CURR-PAGE-NUM TO ITEM-SUB. DTSCS33 00952 DTSCS33 00953 PERFORM P8200-RETREIVE-PAGE-AREA THRU P8200-EXIT. DTSCS33 00954 DTSCS33 00955 PERFORM P6910-PAGE-AREA-TO-MAP THRU P6910-EXIT DTSCS33 00956 VARYING COL-OCC FROM 1 BY 1 DTSCS33 00957 UNTIL COL-OCC > PAGE-COL-CNT. DTSCS33 00958 DTSCS33 00959 PERFORM P6990-PAGE-NUMBER THRU P6990-EXIT. DTSCS33 00960 P6900-EXIT. DTSCS33 00961 EXIT. DTSCS33 00962 SKIP3 DTSCS33 00963 P6910-PAGE-AREA-TO-MAP. DTSCS33 00964 MOVE PAGE-YRQ-LABEL (COL-OCC) DTSCS33 00965 TO MAP-YRQ-LABEL (COL-OCC). DTSCS33 00966 DTSCS33 00967 MOVE PAGE-YRQ (COL-OCC) TO L004-QTR-5-9. DTSCS33 00968 ** IF PAGE-YRQ-LABEL-ANN-88 (COL-OCC) DTSCS33 00969 * MOVE L004-QTR-5-YR TO MAP-YRQ-DISPLAY (COL-OCC) DTSCS33 00970 * ELSE DTSCS33 00971 * PERFORM P6911-SLASH-YRQ THRU P6911-EXIT DTSCS33 00972 ** MOVE L004-SLASH-QTR TO MAP-YRQ-DISPLAY (COL-OCC). DTSCS33 00973 DTSCS33 00974 PERFORM P6911-SLASH-YRQ THRU P6911-EXIT. DTSCS33 00975 MOVE L004-SLASH-QTR TO MAP-YRQ-DISPLAY (COL-OCC). DTSCS33 00976 DTSCS33 00977 IF PAGE-YRQ (COL-OCC) = LCCM-PICKUP-YRQ DTSCS33 00978 MOVE 'PKUP' TO MAP-YRQ-DISPLAY (COL-OCC). DTSCS33 00979 DTSCS33 00980 MOVE PAGE-RPT-TYPE (COL-OCC) TO L032-CD. DTSCS33 00981 PERFORM S032-MRPT-RPT-TYPE-RIGHT THRU S032-EXIT. DTSCS33 00982 MOVE L032-SHORT-DSCR TO MAP-RPT-TYPE-DSCR (COL-OCC). DTSCS33 00983 DTSCS33 00984 MOVE PAGE-TOT-WAGE (COL-OCC) TO MAP-TOT-WAGE-Z (COL-OCC). DTSCS33 00985 MOVE PAGE-EXCESS-WAGE (COL-OCC) DTSCS33 00986 TO MAP-EXCESS-WAGE-Z (COL-OCC). DTSCS33 00987 MOVE PAGE-TAX-WAGE (COL-OCC) TO MAP-TAX-WAGE-Z (COL-OCC). DTSCS33 00988 DTSCS33 00989 MOVE PAGE-UI-RATE (COL-OCC) TO L056-RATE. DTSCS33 00990 PERFORM S056-DISP1-RIGHT THRU S056-EXIT. DTSCS33 00991 MOVE L056-DISP-RATE TO MAP-UI-RATE (COL-OCC). DTSCS33 00992 DTSCS33 00993 MOVE PAGE-UI-TAX-AMT (COL-OCC) DTSCS33 00994 TO MAP-UI-TAX-AMT-Z (COL-OCC). DTSCS33 00995 MOVE PAGE-SUR-CHARGED-AMT (COL-OCC) DTSCS33 00996 TO MAP-SUR-CHARGED-AMT-Z (COL-OCC). DTSCS33 00997 DTSCS33 00998 MOVE PAGE-INT-WAIVE-IND (COL-OCC) TO MAP-INT-IND (COL-OCC). DTSCS33 00999 MOVE '/' TO MAP-INT-PEN-SLASH(COL-OCC). DTSCS33 01000 MOVE PAGE-PEN-WAIVE-IND (COL-OCC) TO MAP-PEN-IND (COL-OCC). DTSCS33 01001 MOVE PAGE-WAGE-RPT(COL-OCC) TO MAP-WAGE-RPT(COL-OCC). DTSCS33 01002 MOVE PAGE-RESP-ACTV (COL-OCC) TO MAP-RESP-ACTV (COL-OCC). DTSCS33 01003 DTSCS33 01004 MOVE PAGE-BATCH-NO (COL-OCC) TO MAP-BATCH-NO (COL-OCC). DTSCS33 01005 MOVE PAGE-ITEM-NO (COL-OCC) TO MAP-ITEM-NO (COL-OCC). DTSCS33 01006 DTSCS33 01007 MOVE PAGE-RESPONSIBLE-OP-ID (COL-OCC) DTSCS33 01008 TO MAP-RESPONSIBLE-OP-ID (COL-OCC). DTSCS33 01009 DTSCS33 01010 MOVE PAGE-PROCESSED-DATE (COL-OCC) TO L001-FED-8-DATE-9. DTSCS33 01011 PERFORM P6912-SLASH-DATE THRU P6912-EXIT. DTSCS33 01012 MOVE L001-SLASH-DATE TO MAP-PROCESSED-DATE (COL-OCC). DTSCS33 01013 DTSCS33 01014 MOVE PAGE-RECEIVED-DATE (COL-OCC) TO L001-FED-8-DATE-9. DTSCS33 01015 PERFORM P6912-SLASH-DATE THRU P6912-EXIT. DTSCS33 01016 MOVE L001-SLASH-DATE TO MAP-RECEIVED-DATE (COL-OCC). DTSCS33 01017 DTSCS33 01018 MOVE PAGE-REMIT-AMT (COL-OCC) TO MAP-REMIT-AMT-Z (COL-OCC). DTSCS33 01019 P6910-EXIT. DTSCS33 01020 EXIT. DTSCS33 01021 SKIP3 DTSCS33 01022 P6911-SLASH-YRQ. DTSCS33 01023 IF L004-QTR-5-9 = +0 DTSCS33 01024 MOVE SPACES TO L004-SLASH-QTR DTSCS33 01025 ELSE DTSCS33 01026 MOVE L004-QTR-5-YR TO L004-SLASH-YR DTSCS33 01027 MOVE '/' TO L004-SLASH-LIT DTSCS33 01028 MOVE L004-QTR-5-Q TO L004-SLASH-Q. DTSCS33 01029 P6911-EXIT. DTSCS33 01030 EXIT. DTSCS33 01031 SKIP3 DTSCS33 01032 P6912-SLASH-DATE. DTSCS33 01033 IF L001-FED-8-DATE-9 = +0 DTSCS33 01034 MOVE SPACES TO L001-SLASH-DATE DTSCS33 01035 ELSE DTSCS33 01036 MOVE ' / / ' TO L001-SLASH-DATE DTSCS33 01037 MOVE L001-FED-8-MO TO L001-SLASH-MO DTSCS33 01038 MOVE L001-FED-8-DA TO L001-SLASH-DA DTSCS33 01039 MOVE L001-FED-8-YR TO L001-SLASH-YR. DTSCS33 01040 P6912-EXIT. DTSCS33 01041 EXIT. DTSCS33 01042 SKIP3 DTSCS33 01043 P6990-PAGE-NUMBER. DTSCS33 01044 MOVE CURR-PAGE-NUM TO MAP-CURR-PAGE. DTSCS33 01045 MOVE LCCM-SCR-HOLD-LAST-PAGE-NUM TO MAP-LAST-PAGE. DTSCS33 01046 DTSCS33 01047 IF CURR-PAGE-NUM = +1 DTSCS33 01048 IF LCCM-SCR-HOLD-LAST-PAGE-NUM = +1 DTSCS33 01049 MOVE PMSG-ONLY-PAGE TO LCCM-MSG-AREA DTSCS33 01050 ELSE DTSCS33 01051 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-AREA DTSCS33 01052 ELSE DTSCS33 01053 IF CURR-PAGE-NUM = LCCM-SCR-HOLD-LAST-PAGE-NUM DTSCS33 01054 MOVE PMSG-LAST-PAGE TO LCCM-MSG-AREA. DTSCS33 01055 P6990-EXIT. DTSCS33 01056 EXIT. DTSCS33 01057 EJECT DTSCS33 01058 P7000-CONSTRUCT-PAGES. DTSCS33 01059 *-------------------------------------------------------------- DTSCS33 01060 * INQUIRY FOR WRK-EMP-NO AND WRK-YRQ HAS BEEN REQUESTED. DTSCS33 01061 * P7000 ASSEMBLES PAGES OF INFORMATION INTO LCCM-SCR-HOLD-AREA DTSCS33 01062 * (WITH OVERFLOW INTO TS). DTSCS33 01063 * DTSCS33 01064 * THE PRINCIPLE DIFFICULTY IS WITH THE SEQUENCE IN WHICH MRPT DTSCS33 01065 * RECORDS MUST BE DISPLAYED: ASCENDING ON DOC NO WITHIN DTSCS33 01066 * DESCENDING ON YR/Q. DTSCS33 01067 * DTSCS33 01068 * IF WRK-YRQ IS EQUAL TO ZERO, THEN ALL MRPT RECORDS FOR EMP DTSCS33 01069 * NO MUST BE DISPLAYED (P7100). THIS IS A BIT MESSY. DTSCS33 01070 * DTSCS33 01071 * IF WRK-YRQ IS NOT EQUAL TO ZERO, THEN ONLY THOSE MRPT DTSCS33 01072 * RECORDS WITH MRPT-YRQ EQUAL TO WRK-YRQ ARE DISPLAYED DTSCS33 01073 * (P7200). THIS IS A SNAP. DTSCS33 01074 *-------------------------------------------------------------- DTSCS33 01075 IF LCCM-SCR-HOLD-CONTROL-AREA = LOW-VALUES DTSCS33 01076 NEXT SENTENCE DTSCS33 01077 ELSE DTSCS33 01078 IF LCCM-SCR-HOLD-LAST-PAGE-NUM > ITEM-MAX-LCCM DTSCS33 01079 PERFORM S829-DELETE-QUEUE THRU S829-EXIT. DTSCS33 01080 DTSCS33 01081 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA. DTSCS33 01082 DTSCS33 01083 MOVE WRK-EMP-NO TO LCCM-SCR-HOLD-EMP-NO. DTSCS33 01084 MOVE WRK-YRQ TO LCCM-SCR-HOLD-YRQ. DTSCS33 01085 MOVE MPRF-UPDATE-END-ABSTIME TO LCCM-SCR-HOLD-ABSTIME. DTSCS33 01086 MOVE +0 TO LCCM-SCR-HOLD-LAST-PAGE-NUM. DTSCS33 01087 DTSCS33 01088 MOVE +0 TO ITEM-CNT. DTSCS33 01089 DTSCS33 01090 IF WRK-YRQ = +0 DTSCS33 01091 PERFORM P7100-ALL-QUARTERS THRU P7100-EXIT DTSCS33 01092 ELSE DTSCS33 01093 PERFORM P7200-ONE-QUARTER THRU P7200-EXIT. DTSCS33 01094 DTSCS33 01095 MOVE ITEM-CNT TO LCCM-SCR-HOLD-LAST-PAGE-NUM. DTSCS33 01096 P7000-EXIT. DTSCS33 01097 EXIT. DTSCS33 01098 SKIP3 DTSCS33 01099 P7100-ALL-QUARTERS. DTSCS33 01100 *-------------------------------------------------------------- DTSCS33 01101 * PROCESS ALL MRPT RECORDS, WHILE MEETING THE "DESCENDING DTSCS33 01102 * ON YRQ" REQUIREMENT. DTSCS33 01103 *-------------------------------------------------------------- DTSCS33 01104 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS33 01105 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS33 01106 SET MSKL-RPT-88 TO TRUE. DTSCS33 01107 PERFORM S810-COUNT THRU S810-EXIT. DTSCS33 01108 IF L810-RECORD-CNT = +0 DTSCS33 01109 GO TO P7100-EXIT. DTSCS33 01110 DTSCS33 01111 MOVE +0 TO PAGE-COL-CNT. DTSCS33 01112 SET WRK-ANNUAL-NO-88 TO TRUE. DTSCS33 01113 DTSCS33 01114 MOVE MSKL-KEY-AREA TO MRPT-KEY-AREA. DTSCS33 01115 DTSCS33 01116 MOVE MRPT-YRQ TO PROCESS-YRQ. DTSCS33 01117 DTSCS33 01118 PERFORM P7900-PROCESS-YRQ THRU P7900-EXIT. DTSCS33 01119 DTSCS33 01120 PERFORM P7110-PRIOR-QUARTER THRU P7110-EXIT DTSCS33 01121 UNTIL PROCESS-YRQ = +0. DTSCS33 01122 DTSCS33 01123 IF PAGE-COL-CNT > +0 DTSCS33 01124 PERFORM P8100-STORE-PAGE-AREA THRU P8100-EXIT. DTSCS33 01125 P7100-EXIT. DTSCS33 01126 EXIT. DTSCS33 01127 SKIP3 DTSCS33 01128 P7110-PRIOR-QUARTER. DTSCS33 01129 ** IF WRK-ANNUAL-YES-88 DTSCS33 01130 * SET WRK-ANNUAL-NO-88 TO TRUE DTSCS33 01131 * MOVE PROCESS-YRQ TO L004-QTR-5-9 DTSCS33 01132 * MOVE 1 TO L004-QTR-5-Q DTSCS33 01133 ** MOVE L004-QTR-5-9 TO PROCESS-YRQ. DTSCS33 01134 DTSCS33 01135 MOVE LOW-VALUES TO MRPT-KEY-AREA. DTSCS33 01136 MOVE WRK-EMP-NO TO MRPT-EMP-NO. DTSCS33 01137 SET MRPT-RPT-88 TO TRUE. DTSCS33 01138 MOVE PROCESS-YRQ TO MRPT-YRQ. DTSCS33 01139 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. DTSCS33 01140 DTSCS33 01141 MOVE +0 TO PROCESS-YRQ. DTSCS33 01142 DTSCS33 01143 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS33 01144 IF L810-NO-REC-88 DTSCS33 01145 GO TO P7110-EXIT. DTSCS33 01146 DTSCS33 01147 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCS33 01148 IF L810-NO-REC-88 DTSCS33 01149 GO TO P7110-EXIT. DTSCS33 01150 DTSCS33 01151 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCS33 01152 IF L810-NO-REC-88 DTSCS33 01153 GO TO P7110-EXIT. DTSCS33 01154 DTSCS33 01155 MOVE MSKL-KEY-AREA TO MRPT-KEY-AREA. DTSCS33 01156 DTSCS33 01157 MOVE MRPT-YRQ TO PROCESS-YRQ. DTSCS33 01158 DTSCS33 01159 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS33 01160 DTSCS33 01161 PERFORM P7900-PROCESS-YRQ THRU P7900-EXIT. DTSCS33 01162 P7110-EXIT. DTSCS33 01163 EXIT. DTSCS33 01164 SKIP3 DTSCS33 01165 P7200-ONE-QUARTER. DTSCS33 01166 MOVE +0 TO PAGE-COL-CNT. DTSCS33 01167 DTSCS33 01168 MOVE WRK-YRQ TO PROCESS-YRQ. DTSCS33 01169 DTSCS33 01170 PERFORM P7900-PROCESS-YRQ THRU P7900-EXIT. DTSCS33 01171 DTSCS33 01172 IF PAGE-COL-CNT > +0 DTSCS33 01173 PERFORM P8100-STORE-PAGE-AREA THRU P8100-EXIT. DTSCS33 01174 P7200-EXIT. DTSCS33 01175 EXIT. DTSCS33 01176 SKIP3 DTSCS33 01177 P7900-PROCESS-YRQ. DTSCS33 01178 MOVE ZERO TO WRK-BATCH-NO DTSCS33 01179 WRK-ITEM-NO. DTSCS33 01180 DTSCS33 01181 MOVE LOW-VALUES TO MRPT-KEY-AREA. DTSCS33 01182 MOVE WRK-EMP-NO TO MRPT-EMP-NO. DTSCS33 01183 SET MRPT-RPT-88 TO TRUE. DTSCS33 01184 MOVE PROCESS-YRQ TO MRPT-YRQ. DTSCS33 01185 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. DTSCS33 01186 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS33 01187 PERFORM P7910-SCAN-MRPT THRU P7910-EXIT DTSCS33 01188 UNTIL L810-NO-REC-88. DTSCS33 01189 P7900-EXIT. DTSCS33 01190 EXIT. DTSCS33 01191 SKIP3 DTSCS33 01192 P7910-SCAN-MRPT. DTSCS33 01193 MOVE MSKL-REC TO MRPT-REC. DTSCS33 01194 DTSCS33 01195 IF MRPT-YRQ = PROCESS-YRQ DTSCS33 01196 NEXT SENTENCE DTSCS33 01197 ELSE DTSCS33 01198 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS33 01199 SET L810-NO-REC-88 TO TRUE DTSCS33 01200 GO TO P7910-EXIT. DTSCS33 01201 DTSCS33 01202 IF MRPT-BATCH-NO = WRK-BATCH-NO DTSCS33 01203 AND MRPT-ITEM-NO = WRK-ITEM-NO DTSCS33 01204 NEXT SENTENCE DTSCS33 01205 ELSE DTSCS33 01206 IF PAGE-COL-CNT >= COLUMNS-PER-PAGE DTSCS33 01207 PERFORM P8100-STORE-PAGE-AREA THRU P8100-EXIT DTSCS33 01208 MOVE +0 TO PAGE-COL-CNT DTSCS33 01209 END-IF DTSCS33 01210 PERFORM P7911-MRPT-TO-PAGE-AREA THRU P7911-EXIT. DTSCS33 01211 DTSCS33 01212 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS33 01213 P7910-EXIT. DTSCS33 01214 EXIT. DTSCS33 01215 SKIP3 DTSCS33 01216 P7911-MRPT-TO-PAGE-AREA. DTSCS33 01217 ADD +1 TO PAGE-COL-CNT. DTSCS33 01218 DTSCS33 01219 IF MRPT-ANNUAL-YES-88 DTSCS33 01220 SET WRK-ANNUAL-YES-88 TO TRUE DTSCS33 01221 ***** PERFORM P7911A-ANNUAL-RPT THRU P7911A-EXIT DTSCS33 01222 SET PAGE-YRQ-LABEL-ANN-88 (PAGE-COL-CNT) TO TRUE DTSCS33 01223 ELSE DTSCS33 01224 SET PAGE-YRQ-LABEL-BLANK-88 (PAGE-COL-CNT) TO TRUE. DTSCS33 01225 DTSCS33 01226 MOVE MRPT-YRQ TO PAGE-YRQ (PAGE-COL-CNT). DTSCS33 01227 MOVE MRPT-RPT-TYPE TO PAGE-RPT-TYPE (PAGE-COL-CNT). DTSCS33 01228 MOVE MRPT-TOT-WAGE TO PAGE-TOT-WAGE (PAGE-COL-CNT). DTSCS33 01229 MOVE MRPT-EXCESS-WAGE TO PAGE-EXCESS-WAGE (PAGE-COL-CNT). DTSCS33 01230 MOVE MRPT-TAX-WAGE TO PAGE-TAX-WAGE (PAGE-COL-CNT). DTSCS33 01231 MOVE MRPT-UI-RATE TO PAGE-UI-RATE (PAGE-COL-CNT). DTSCS33 01232 MOVE MRPT-UI-CHARGED-AMT DTSCS33 01233 TO PAGE-UI-TAX-AMT (PAGE-COL-CNT). DTSCS33 01234 MOVE MRPT-SUR-CHARGED-AMT DTSCS33 01235 TO PAGE-SUR-CHARGED-AMT (PAGE-COL-CNT). DTSCS33 01236 MOVE MRPT-DOC-NO TO PAGE-DOC-NO (PAGE-COL-CNT). DTSCS33 01237 MOVE MRPT-WAIVE-INT-IND TO PAGE-INT-WAIVE-IND(PAGE-COL-CNT). DTSCS33 01238 MOVE MRPT-WAIVE-LATE-PEN-IND DTSCS33 01239 TO PAGE-PEN-WAIVE-IND(PAGE-COL-CNT). DTSCS33 01240 MOVE MRPT-WAGE-RPT-IND TO PAGE-WAGE-RPT (PAGE-COL-CNT). DTSCS33 01241 MOVE MRPT-RESPONSIBLE-ACTIVITY DTSCS33 01242 TO PAGE-RESP-ACTV(PAGE-COL-CNT) DTSCS33 01243 MOVE MRPT-RESPONSIBLE-OP-ID DTSCS33 01244 TO PAGE-RESPONSIBLE-OP-ID (PAGE-COL-CNT). DTSCS33 01245 MOVE MRPT-ESTB-DATE DTSCS33 01246 TO PAGE-PROCESSED-DATE (PAGE-COL-CNT). DTSCS33 01247 MOVE MRPT-RECEIVED-DATE DTSCS33 01248 TO PAGE-RECEIVED-DATE (PAGE-COL-CNT). DTSCS33 01249 MOVE MRPT-REMIT-AMT TO PAGE-REMIT-AMT (PAGE-COL-CNT). DTSCS33 01250 P7911-EXIT. DTSCS33 01251 EXIT. DTSCS33 01252 DTSCS33 01253 *P7911A-ANNUAL-RPT. DTSCS33 01254 * PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS33 01255 * MOVE MRPT-KEY-AREA TO WRK-MRPT-KEY. DTSCS33 01256 * DTSCS33 01257 * MOVE PROCESS-YRQ TO L004-QTR-5-9. DTSCS33 01258 * MOVE 1 TO L004-QTR-5-Q. DTSCS33 01259 * MOVE MRPT-BATCH-NO TO WRK-BATCH-NO. DTSCS33 01260 * MOVE MRPT-ITEM-NO TO WRK-ITEM-NO. DTSCS33 01261 * MOVE ZERO TO WRK-TOT-WAGE DTSCS33 01262 * WRK-TAX-WAGE DTSCS33 01263 * WRK-EXCESS-WAGE DTSCS33 01264 * WRK-REMIT-AMT DTSCS33 01265 * WRK-UI-CHG DTSCS33 01266 * WRK-SUR-CHG. DTSCS33 01267 * DTSCS33 01268 * MOVE LOW-VALUES TO MRPT-KEY-AREA. DTSCS33 01269 * MOVE WRK-EMP-NO TO MRPT-EMP-NO. DTSCS33 01270 * SET MRPT-RPT-88 TO TRUE. DTSCS33 01271 * MOVE L004-QTR-5-9 TO MRPT-YRQ. DTSCS33 01272 * MOVE WRK-BATCH-NO TO MRPT-BATCH-NO. DTSCS33 01273 * MOVE WRK-ITEM-NO TO MRPT-ITEM-NO. DTSCS33 01274 * MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. DTSCS33 01275 * PERFORM S810-READ THRU S810-EXIT. DTSCS33 01276 * IF L810-OK-88 DTSCS33 01277 * MOVE MSKL-REC TO MRPT-REC DTSCS33 01278 * ADD MRPT-TOT-WAGE TO WRK-TOT-WAGE DTSCS33 01279 * ADD MRPT-TAX-WAGE TO WRK-TAX-WAGE DTSCS33 01280 * ADD MRPT-EXCESS-WAGE TO WRK-EXCESS-WAGE DTSCS33 01281 * ADD MRPT-REMIT-AMT TO WRK-REMIT-AMT DTSCS33 01282 * ADD MRPT-UI-CHARGED-AMT TO WRK-UI-CHG DTSCS33 01283 * ADD MRPT-SUR-CHARGED-AMT TO WRK-SUR-CHG. DTSCS33 01284 * DTSCS33 01285 * ADD 1 TO L004-QTR-5-9. DTSCS33 01286 * MOVE L004-QTR-5-9 TO MRPT-YRQ. DTSCS33 01287 * MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. DTSCS33 01288 * PERFORM S810-READ THRU S810-EXIT. DTSCS33 01289 * IF L810-OK-88 DTSCS33 01290 * MOVE MSKL-REC TO MRPT-REC DTSCS33 01291 * ADD MRPT-TOT-WAGE TO WRK-TOT-WAGE DTSCS33 01292 * ADD MRPT-TAX-WAGE TO WRK-TAX-WAGE DTSCS33 01293 * ADD MRPT-EXCESS-WAGE TO WRK-EXCESS-WAGE DTSCS33 01294 * ADD MRPT-REMIT-AMT TO WRK-REMIT-AMT DTSCS33 01295 * ADD MRPT-UI-CHARGED-AMT TO WRK-UI-CHG DTSCS33 01296 * ADD MRPT-SUR-CHARGED-AMT TO WRK-SUR-CHG. DTSCS33 01297 * DTSCS33 01298 * ADD 1 TO L004-QTR-5-9. DTSCS33 01299 * MOVE L004-QTR-5-9 TO MRPT-YRQ. DTSCS33 01300 * MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. DTSCS33 01301 * PERFORM S810-READ THRU S810-EXIT. DTSCS33 01302 * IF L810-OK-88 DTSCS33 01303 * MOVE MSKL-REC TO MRPT-REC DTSCS33 01304 * ADD MRPT-TOT-WAGE TO WRK-TOT-WAGE DTSCS33 01305 * ADD MRPT-TAX-WAGE TO WRK-TAX-WAGE DTSCS33 01306 * ADD MRPT-EXCESS-WAGE TO WRK-EXCESS-WAGE DTSCS33 01307 * ADD MRPT-REMIT-AMT TO WRK-REMIT-AMT DTSCS33 01308 * ADD MRPT-UI-CHARGED-AMT TO WRK-UI-CHG DTSCS33 01309 * ADD MRPT-SUR-CHARGED-AMT TO WRK-SUR-CHG. DTSCS33 01310 * DTSCS33 01311 * ADD 1 TO L004-QTR-5-9. DTSCS33 01312 * MOVE L004-QTR-5-9 TO MRPT-YRQ. DTSCS33 01313 * MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. DTSCS33 01314 * PERFORM S810-READ THRU S810-EXIT. DTSCS33 01315 * IF L810-OK-88 DTSCS33 01316 * MOVE MSKL-REC TO MRPT-REC DTSCS33 01317 * ADD MRPT-TOT-WAGE TO WRK-TOT-WAGE DTSCS33 01318 * ADD MRPT-TAX-WAGE TO WRK-TAX-WAGE DTSCS33 01319 * ADD MRPT-EXCESS-WAGE TO WRK-EXCESS-WAGE DTSCS33 01320 * ADD MRPT-REMIT-AMT TO WRK-REMIT-AMT DTSCS33 01321 * ADD MRPT-UI-CHARGED-AMT TO WRK-UI-CHG DTSCS33 01322 * ADD MRPT-SUR-CHARGED-AMT TO WRK-SUR-CHG. DTSCS33 01323 * DTSCS33 01324 * MOVE PROCESS-YRQ TO MRPT-YRQ. DTSCS33 01325 * MOVE WRK-BATCH-NO TO MRPT-BATCH-NO. DTSCS33 01326 * MOVE WRK-ITEM-NO TO MRPT-ITEM-NO. DTSCS33 01327 * MOVE WRK-TOT-WAGE TO MRPT-TOT-WAGE. DTSCS33 01328 * MOVE WRK-TAX-WAGE TO MRPT-TAX-WAGE. DTSCS33 01329 * MOVE WRK-EXCESS-WAGE TO MRPT-EXCESS-WAGE. DTSCS33 01330 * MOVE WRK-REMIT-AMT TO MRPT-REMIT-AMT. DTSCS33 01331 * MOVE WRK-UI-CHG TO MRPT-UI-CHARGED-AMT. DTSCS33 01332 * MOVE WRK-SUR-CHG TO MRPT-SUR-CHARGED-AMT. DTSCS33 01333 * DTSCS33 01334 *& MOVE L004-QTR-5-9 TO WRK-MRPT-YRQ. DTSCS33 01335 * MOVE WRK-MRPT-KEY TO MSKL-KEY-AREA. DTSCS33 01336 * PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS33 01337 * DTSCS33 01338 *P7911A-EXIT. DTSCS33 01339 * EXIT. DTSCS33 01340 * EJECT DTSCS33 01341 P8100-STORE-PAGE-AREA. DTSCS33 01342 IF ITEM-CNT < ITEM-MAX-LCCM DTSCS33 01343 ADD +1 TO ITEM-CNT DTSCS33 01344 MOVE PAGE-AREA TO LCCM-SCR-HOLD-PAGE-AREA (ITEM-CNT) DTSCS33 01345 GO TO P8100-EXIT. DTSCS33 01346 DTSCS33 01347 IF ITEM-CNT < ITEM-MAX DTSCS33 01348 ADD +1 TO ITEM-CNT DTSCS33 01349 MOVE PAGE-AREA TO L829-REC DTSCS33 01350 PERFORM S829-WRITE THRU S829-EXIT. DTSCS33 01351 P8100-EXIT. DTSCS33 01352 EXIT. DTSCS33 01353 SKIP3 DTSCS33 01354 P8200-RETREIVE-PAGE-AREA. DTSCS33 01355 IF ITEM-SUB > ITEM-MAX-LCCM DTSCS33 01356 COMPUTE L829-ITEM-NO = ITEM-SUB - ITEM-MAX-LCCM DTSCS33 01357 PERFORM S829-READ-ITEM THRU S829-EXIT DTSCS33 01358 IF L829-NO-REC-88 DTSCS33 01359 GO TO S899-ABEND DTSCS33 01360 ELSE DTSCS33 01361 MOVE L829-REC TO PAGE-AREA DTSCS33 01362 ELSE DTSCS33 01363 MOVE LCCM-SCR-HOLD-PAGE-AREA (ITEM-SUB) TO PAGE-AREA. DTSCS33 01364 P8200-EXIT. DTSCS33 01365 EXIT. DTSCS33 01366 /*****************************************************************DTSCS33 01367 * LINKS TO UTILITY MODULES DTSCS33 01368 ******************************************************************DTSCS33 01369 SKIP1 DTSCS33 01370 S001-FROM-FED-8. DTSCS33 01371 SET L001-FROM-FED-8 TO TRUE. DTSCS33 01372 GO TO S001-DATE. DTSCS33 01373 SKIP1 DTSCS33 01374 *S001-FROM-ABS-DATE. DTSCS33 01375 *****SET L001-FROM-ABS-DAY TO TRUE. DTSCS33 01376 *****GO TO S001-DATE. DTSCS33 01377 *****SKIP1 DTSCS33 01378 S001-DATE. DTSCS33 01379 EXEC CICS LINK DTSCS33 01380 PROGRAM('DTSCU001') DTSCS33 01381 COMMAREA(L001-COMM-AREA) DTSCS33 01382 END-EXEC. DTSCS33 01383 S001-EXIT. DTSCS33 01384 EXIT. DTSCS33 01385 SKIP3 DTSCS33 01386 S004-FROM-5. DTSCS33 01387 SET L004-FROM-5 TO TRUE. DTSCS33 01388 GO TO S004-QTR. DTSCS33 01389 SKIP1 DTSCS33 01390 S004-FROM-ABS. DTSCS33 01391 SET L004-FROM-ABS TO TRUE. DTSCS33 01392 GO TO S004-QTR. DTSCS33 01393 SKIP1 DTSCS33 01394 S004-QTR. DTSCS33 01395 EXEC CICS LINK DTSCS33 01396 PROGRAM('DTSCU004') DTSCS33 01397 COMMAREA(L004-COMM-AREA) DTSCS33 01398 END-EXEC. DTSCS33 01399 S004-EXIT. DTSCS33 01400 EXIT. DTSCS33 01401 SKIP3 DTSCS33 01402 S018-EMP-NO-FROM-SCREEN. DTSCS33 01403 EXEC CICS LINK DTSCS33 01404 PROGRAM('DTSCU018') DTSCS33 01405 COMMAREA(L018-COMM-AREA) DTSCS33 01406 END-EXEC. DTSCS33 01407 S018-EXIT. DTSCS33 01408 EXIT. DTSCS33 01409 SKIP3 DTSCS33 01410 S029-YRQ-FROM-SCREEN. DTSCS33 01411 EXEC CICS LINK DTSCS33 01412 PROGRAM('DTSCU029') DTSCS33 01413 COMMAREA(L029-COMM-AREA) DTSCS33 01414 END-EXEC. DTSCS33 01415 S029-EXIT. DTSCS33 01416 EXIT. DTSCS33 01417 SKIP3 DTSCS33 01418 S032-MRPT-RPT-TYPE-RIGHT. DTSCS33 01419 SET L032-MRPT-RPT-TYPE-RIGHT TO TRUE. DTSCS33 01420 GO TO S032-ACCT-CD. DTSCS33 01421 DTSCS33 01422 S032-ACCT-CD. DTSCS33 01423 EXEC CICS LINK DTSCS33 01424 PROGRAM('DTSCU032') DTSCS33 01425 COMMAREA(L032-COMM-AREA) DTSCS33 01426 END-EXEC. DTSCS33 01427 S032-EXIT. DTSCS33 01428 EXIT. DTSCS33 01429 SKIP3 DTSCS33 01430 S056-DISP1-RIGHT. DTSCS33 01431 SET L056-DISP1-RIGHT-88 TO TRUE. DTSCS33 01432 GO TO S056-RATE-DISPLAY. DTSCS33 01433 DTSCS33 01434 S056-RATE-DISPLAY. DTSCS33 01435 EXEC CICS LINK DTSCS33 01436 PROGRAM('DTSCU056') DTSCS33 01437 COMMAREA(L056-COMM-AREA) DTSCS33 01438 END-EXEC. DTSCS33 01439 S056-EXIT. DTSCS33 01440 EXIT. DTSCS33 01441 SKIP3 DTSCS33 01442 S803-REQ-SCR-ID-EDIT. DTSCS33 01443 EXEC CICS LINK DTSCS33 01444 PROGRAM ('DTSCU803') DTSCS33 01445 COMMAREA (DFHCOMMAREA) DTSCS33 01446 END-EXEC. DTSCS33 01447 S803-EXIT. DTSCS33 01448 EXIT. DTSCS33 01449 SKIP3 DTSCS33 01450 S804-INVALID-KEY. DTSCS33 01451 EXEC CICS LINK DTSCS33 01452 PROGRAM ('DTSCU804') DTSCS33 01453 COMMAREA (DFHCOMMAREA) DTSCS33 01454 END-EXEC. DTSCS33 01455 S804-EXIT. DTSCS33 01456 EXIT. DTSCS33 01457 SKIP3 DTSCS33 01458 S805-MSG-AREA. DTSCS33 01459 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS33 01460 SKIP1 DTSCS33 01461 EXEC CICS LINK DTSCS33 01462 PROGRAM ('DTSCU805') DTSCS33 01463 COMMAREA (L805-COMM-AREA) DTSCS33 01464 END-EXEC. DTSCS33 01465 SKIP1 DTSCS33 01466 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS33 01467 S805-EXIT. DTSCS33 01468 EXIT. DTSCS33 01469 EJECT DTSCS33 01470 S810-READ. DTSCS33 01471 SET L810-READ-88 TO TRUE. DTSCS33 01472 GO TO S810-IO. DTSCS33 01473 SKIP1 DTSCS33 01474 S810-START-BROWSE. DTSCS33 01475 SET L810-START-BROWSE-88 TO TRUE. DTSCS33 01476 GO TO S810-IO. DTSCS33 01477 SKIP1 DTSCS33 01478 S810-READ-NEXT. DTSCS33 01479 SET L810-READ-NEXT-88 TO TRUE. DTSCS33 01480 GO TO S810-IO. DTSCS33 01481 SKIP1 DTSCS33 01482 S810-READ-PREV. DTSCS33 01483 SET L810-READ-PREV-88 TO TRUE. DTSCS33 01484 GO TO S810-IO. DTSCS33 01485 SKIP1 DTSCS33 01486 S810-END-BROWSE. DTSCS33 01487 SET L810-END-BROWSE-88 TO TRUE. DTSCS33 01488 GO TO S810-IO. DTSCS33 01489 SKIP1 DTSCS33 01490 S810-COUNT. DTSCS33 01491 SET L810-COUNT-88 TO TRUE. DTSCS33 01492 GO TO S810-IO. DTSCS33 01493 SKIP1 DTSCS33 01494 *S810-REWRITE. DTSCS33 01495 *****SET L810-REWRITE-88 TO TRUE. DTSCS33 01496 *****GO TO S810-IO. DTSCS33 01497 *****SKIP1 DTSCS33 01498 *S810-WRITE. DTSCS33 01499 *****SET L810-WRITE-88 TO TRUE. DTSCS33 01500 *****GO TO S810-IO. DTSCS33 01501 *****SKIP1 DTSCS33 01502 *S810-DELETE. DTSCS33 01503 *****SET L810-DELETE-88 TO TRUE. DTSCS33 01504 *****GO TO S810-IO. DTSCS33 01505 SKIP1 DTSCS33 01506 S810-IO. DTSCS33 01507 SKIP1 DTSCS33 01508 EXEC CICS LINK DTSCS33 01509 PROGRAM ('DTSCU810') DTSCS33 01510 COMMAREA (L810-COMM-AREA) DTSCS33 01511 END-EXEC. DTSCS33 01512 SKIP1 DTSCS33 01513 IF L810-FILE-CLOSED-88 DTSCS33 01514 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS33 01515 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS33 01516 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS33 01517 GO TO MAINLINE-EXIT. DTSCS33 01518 S810-EXIT. DTSCS33 01519 EXIT. DTSCS33 01520 EJECT DTSCS33 01521 S829-READ-ITEM. DTSCS33 01522 SET L829-READ-ITEM-88 TO TRUE. DTSCS33 01523 GO TO S829-IO. DTSCS33 01524 DTSCS33 01525 S829-WRITE. DTSCS33 01526 SET L829-WRITE-88 TO TRUE. DTSCS33 01527 GO TO S829-IO. DTSCS33 01528 DTSCS33 01529 S829-DELETE-QUEUE. DTSCS33 01530 SET L829-DELETE-QUEUE-88 TO TRUE. DTSCS33 01531 GO TO S829-IO. DTSCS33 01532 DTSCS33 01533 S829-IO. DTSCS33 01534 MOVE LCCM-TS-NAME-PREFIX TO L829-QUEUE-NAME-PREFIX. DTSCS33 01535 MOVE 'S' TO L829-QUEUE-NAME-SUFFIX. DTSCS33 01536 MOVE ITEM-LENGTH TO L829-REC-LENGTH. DTSCS33 01537 SET L829-DEFAULT-STORAGE-88 TO TRUE. DTSCS33 01538 DTSCS33 01539 EXEC CICS DTSCS33 01540 LINK DTSCS33 01541 PROGRAM ('DTSCU829') DTSCS33 01542 COMMAREA (L829-COMM-AREA) DTSCS33 01543 END-EXEC. DTSCS33 01544 S829-EXIT. DTSCS33 01545 EXIT. DTSCS33 01546 EJECT DTSCS33 01547 S851-SCREEN-PROCESSING. DTSCS33 01548 EXEC CICS LINK DTSCS33 01549 PROGRAM ('DTSCU851') DTSCS33 01550 COMMAREA (L851-COMM-AREA) DTSCS33 01551 END-EXEC. DTSCS33 01552 S851-EXIT. DTSCS33 01553 EXIT. DTSCS33 01554 SKIP3 DTSCS33 01555 S899-ABEND. DTSCS33 01556 EXEC CICS ABEND DTSCS33 01557 ABCODE(WRK-ABEND-CD) DTSCS33 01558 END-EXEC. DTSCS33 01559 S899-EXIT. DTSCS33 01560 EXIT. DTSCS33 01561 EJECT DTSCS33 01562 S1100-EDIT-KEY. DTSCS33 01563 PERFORM S1101-EMP-NO THRU S1101-EXIT. DTSCS33 01564 S1100-EXIT. EXIT. DTSCS33 01565 /*****************************************************************DTSCS33 01566 * DTSCS33 01567 ******************************************************************DTSCS33 01568 S1101-EMP-NO. DTSCS33 01569 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS33 01570 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS33 01571 DTSCS33 01572 IF L018-NO-ENTRY DTSCS33 01573 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS33 01574 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS33 01575 GO TO S1101-EXIT. DTSCS33 01576 DTSCS33 01577 IF L018-NOT-VALID DTSCS33 01578 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS33 01579 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS33 01580 GO TO S1101-EXIT. DTSCS33 01581 DTSCS33 01582 MOVE L018-EMP-NO TO WRK-EMP-NO. DTSCS33 01583 DTSCS33 01584 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS33 01585 S1101-EXIT. EXIT. DTSCS33 01586 SKIP3 DTSCS33 01587 S1110-READ-MPRF. DTSCS33 01588 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS33 01589 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS33 01590 SET MPRF-PRF-88 TO TRUE. DTSCS33 01591 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS33 01592 PERFORM S810-READ THRU S810-EXIT. DTSCS33 01593 IF L810-NO-REC-88 DTSCS33 01594 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS33 01595 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS33 01596 ELSE DTSCS33 01597 MOVE MSKL-REC TO MPRF-REC DTSCS33 01598 SET WRK-MPRF-YES-88 TO TRUE. DTSCS33 01599 S1110-EXIT. DTSCS33 01600 EXIT. DTSCS33 01601 SKIP3 DTSCS33 01602 S1199-ERROR. DTSCS33 01603 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS33 01604 MAP-EMP-NO-2-A. DTSCS33 01605 IF LCCM-NO-MSG DTSCS33 01606 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS33 01607 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L DTSCS33 01608 SET CURSOR-SET-YES TO TRUE. DTSCS33 01609 S1199-EXIT. EXIT. DTSCS33 01610 /*****************************************************************DTSCS33 01611 * DTSCS33 01612 ******************************************************************DTSCS33 01613 S1200-YRQ. DTSCS33 01614 MOVE MAP-YRQ-AREA TO L029-S-YRQ-AREA. DTSCS33 01615 PERFORM S029-YRQ-FROM-SCREEN THRU S029-EXIT. DTSCS33 01616 DTSCS33 01617 IF L029-NO-ENTRY DTSCS33 01618 MOVE +0 TO WRK-YRQ DTSCS33 01619 ELSE DTSCS33 01620 IF L029-VALID DTSCS33 01621 IF L029-YRQ = LCCM-PICKUP-YRQ DTSCS33 01622 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS33 01623 PERFORM S1299-ERROR THRU S1299-EXIT DTSCS33 01624 ELSE DTSCS33 01625 MOVE L029-YRQ TO WRK-YRQ DTSCS33 01626 ELSE DTSCS33 01627 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS33 01628 PERFORM S1299-ERROR THRU S1299-EXIT. DTSCS33 01629 S1200-EXIT. DTSCS33 01630 EXIT. DTSCS33 01631 SKIP3 DTSCS33 01632 S1299-ERROR. DTSCS33 01633 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-YRQ-YR-A DTSCS33 01634 MAP-YRQ-Q-A. DTSCS33 01635 DTSCS33 01636 IF LCCM-NO-MSG DTSCS33 01637 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS33 01638 MOVE CATB-CURSOR TO MAP-YRQ-YR-L DTSCS33 01639 SET CURSOR-SET-YES TO TRUE. DTSCS33 01640 S1299-EXIT. DTSCS33 01641 EXIT. DTSCS33 01642 /*****************************************************************DTSCS33 01643 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS33 01644 ******************************************************************DTSCS33 01645 S5300-SET-INQ-ATTRB. DTSCS33 01646 MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN DTSCS33 01647 WRK-ATB-NUM. DTSCS33 01648 DTSCS33 01649 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS33 01650 S5300-EXIT. DTSCS33 01651 EXIT. DTSCS33 01652 SKIP3 DTSCS33 01653 S5900-SET-ATTRB. DTSCS33 01654 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS33 01655 MAP-EMP-NO-2-A. DTSCS33 01656 DTSCS33 01657 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-YRQ-YR-A DTSCS33 01658 MAP-YRQ-Q-A. DTSCS33 01659 DTSCS33 01660 MOVE CATB-ASKIP-BRT-MDTOFF TO MAP-PRIMARY-NAME-A DTSCS33 01661 MAP-CURR-PAGE-A DTSCS33 01662 MAP-LAST-PAGE-A. DTSCS33 01663 DTSCS33 01664 PERFORM DTSCS33 01665 VARYING COL-OCC FROM 1 BY 1 DTSCS33 01666 UNTIL COL-OCC > COLUMNS-PER-PAGE DTSCS33 01667 MOVE CATB-ASKIP-BRT-MDTOFF DTSCS33 01668 TO MAP-YRQ-DISPLAY-A (COL-OCC) DTSCS33 01669 MAP-YRQ-LABEL-A (COL-OCC) DTSCS33 01670 MAP-RPT-TYPE-DSCR-A (COL-OCC) DTSCS33 01671 MAP-TOT-WAGE-A (COL-OCC) DTSCS33 01672 MAP-EXCESS-WAGE-A (COL-OCC) DTSCS33 01673 MAP-TAX-WAGE-A (COL-OCC) DTSCS33 01674 MAP-UI-RATE-A (COL-OCC) DTSCS33 01675 MAP-UI-TAX-AMT-A (COL-OCC) DTSCS33 01676 MAP-SUR-CHARGED-AMT-A (COL-OCC) DTSCS33 01677 MAP-BATCH-NO-A (COL-OCC) DTSCS33 01678 MAP-ITEM-NO-A (COL-OCC) DTSCS33 01679 MAP-INT-PEN-WAIVE-A (COL-OCC) DTSCS33 01680 MAP-WAGE-RPT-A (COL-OCC) DTSCS33 01681 MAP-RESP-ACTV-A (COL-OCC) DTSCS33 01682 MAP-RESPONSIBLE-OP-ID-A (COL-OCC) DTSCS33 01683 MAP-PROCESSED-DATE-A (COL-OCC) DTSCS33 01684 MAP-RECEIVED-DATE-A (COL-OCC) DTSCS33 01685 MAP-REMIT-AMT-A (COL-OCC) DTSCS33 01686 END-PERFORM. DTSCS33 01687 DTSCS33 01688 MOVE CATB-UNPROT-BRT-AN-MDTOFF TO MAP-GOTO-A. DTSCS33 01689 S5900-EXIT. DTSCS33 01690 EXIT. DTSCS33 01691 /*****************************************************************DTSCS33 01692 * MAP ROUTINES *DTSCS33 01693 ******************************************************************DTSCS33 01694 S9100-RECEIVE. DTSCS33 01695 SET L851-RECEIVE-88 TO TRUE. DTSCS33 01696 SKIP1 DTSCS33 01697 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS33 01698 SKIP1 DTSCS33 01699 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS33 01700 SKIP1 DTSCS33 01701 MOVE L851-AID TO LCCM-AID. DTSCS33 01702 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS33 01703 S9100-EXIT. DTSCS33 01704 EXIT. DTSCS33 01705 SKIP3 DTSCS33 01706 S9200-SEND-DATAONLY. DTSCS33 01707 MOVE LOW-VALUES TO MAP-AREA. DTSCS33 01708 SKIP1 DTSCS33 01709 IF LCCM-NO-MSG DTSCS33 01710 NEXT SENTENCE DTSCS33 01711 ELSE DTSCS33 01712 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS33 01713 SKIP1 DTSCS33 01714 IF CURSOR-SET-GOTO DTSCS33 01715 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS33 01716 ELSE DTSCS33 01717 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS33 01718 SKIP1 DTSCS33 01719 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS33 01720 SKIP1 DTSCS33 01721 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS33 01722 SKIP1 DTSCS33 01723 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS33 01724 S9200-EXIT. DTSCS33 01725 EXIT. DTSCS33 01726 SKIP3 DTSCS33 01727 S9300-SEND-MAP. DTSCS33 01728 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS33 01729 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS33 01730 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS33 01731 SKIP1 DTSCS33 01732 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS33 01733 SKIP1 DTSCS33 01734 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCS33 01735 SKIP1 DTSCS33 01736 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS33 01737 SKIP1 DTSCS33 01738 IF CURSOR-SET-NO DTSCS33 01739 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS33 01740 SKIP1 DTSCS33 01741 SET L851-SEND-88 TO TRUE. DTSCS33 01742 SKIP1 DTSCS33 01743 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS33 01744 SKIP1 DTSCS33 01745 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS33 01746 S9300-EXIT. DTSCS33 01747 EXIT. DTSCS33 01748 SKIP3 DTSCS33 01749 S9320-INQUIRY-FKEYS. DTSCS33 01750 MOVE CFKD-FIRST TO MAP-KEY-FIRST. DTSCS33 01751 MOVE CFKD-LAST TO MAP-KEY-LAST. DTSCS33 01752 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS33 01753 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS33 01754 SKIP1 DTSCS33 01755 * PERFORM S9321-JUMP-KEYS THRU S9321-EXIT. DTSCS33 01756 S9320-EXIT. DTSCS33 01757 EXIT. DTSCS33 01758 SKIP3 DTSCS33 01759 *S9321-JUMP-KEYS. DTSCS33 01760 * MOVE 'F9=QTR' TO MAP-KEY-QTR-INQ. DTSCS33 01761 * MOVE 'F11=PAY' TO MAP-KEY-PAY-INQ. DTSCS33 01762 * MOVE 'F12=ADJ' TO MAP-KEY-ADJ-INQ. DTSCS33 01763 *S9321-EXIT. DTSCS33 01764 * EXIT. DTSCS33 01765 SKIP3 DTSCS33 01766 S9330-DSCR-FIELDS. DTSCS33 01767 IF WRK-MPRF-YES-88 DTSCS33 01768 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME DTSCS33 01769 ELSE DTSCS33 01770 MOVE LOW-VALUES TO MAP-PRIMARY-NAME. DTSCS33 01771 S9330-EXIT. DTSCS33 01772 EXIT. DTSCS33 01773 SKIP3 DTSCS33 01774 S9900-PREPARE-SEND. DTSCS33 01775 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS33 01776 LCCM-SCR-ID. DTSCS33 01777 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS33 01778 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS33 01779 S9900-EXIT. DTSCS33 01780 EXIT. DTSCS33