1782 lines
139 KiB
COBOL
1782 lines
139 KiB
COBOL
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
|