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