00001 IDENTIFICATION DIVISION. 09/07/06 00002 PROGRAM-ID. DTSCS7C. DTSCS7C 00003 AUTHOR. TRW. LV013 00004 DATE-WRITTEN. OCTOBER 2001. DTSCS7C 00005 DATE-COMPILED. DTSCS7C 00006 SKIP3 DTSCS7C 00007 ***** DTSCS7C 00008 * DTSCS7C 00009 * FUNCTION: FILING SCHEDULE INQUIRY/UPDATE DTSCS7C 00010 * SCREEN PROCESSOR. DTSCS7C 00011 * DTSCS7C 00012 * DTSCS7C 00013 * MODIFICATION LOG: DTSCS7C 00014 * DTSCS7C 00015 * 10/12/2001 INITIAL DEVELOPMENT. DTSCS7C 00016 * REFERENCE RFP: PROGRAMMER: GD DTSCS7C 00017 * DTSCS7C 00018 * 03/02/2004 CORRECTED PROBLEM: END DATE OF PRIOR MFSC NOT DTSCS7C 00019 * SET CORRECTLY WHEN START YRQ OF CURRENT MFSC IS DTSCS7C 00020 * CHANGED. REMOVED TEST IN P8200 WHICH ADJUSTED DTSCS7C 00021 * END DATE ONLY IF THERE WAS A CHANGE TO THE DTSCS7C 00022 * STATUS CODE. ADDED TEST IN P8921 TO UPDATE DTSCS7C 00023 * PRIOR MFSC ONLY IF THE END DATE IS NOT EQUAL DTSCS7C 00024 * TO THE NEWLY CALCULATED END DATE. DTSCS7C 00025 * REFERENCE RFP: PROGRAMMER: GD DTSCS7C 00026 * DTSCS7C 00027 * 09/07/2006 ALLOW DELETION OF MFSC WHEN EMPLOYER IS NOT DTSCS7C 00028 * HOUSEHOLD. DTSCS7C 00029 * REFERENCE RFP: PROGRAMMER: GD DTSCS7C 00030 * DTSCS7C 00031 * 09/07/2006 ALLOW WITHDRAWAL OF DUPLICATE MFSC RECORD. DTSCS7C 00032 * REFERENCE RFP: PROGRAMMER: GD DTSCS7C 00033 * DTSCS7C 00034 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS7C 00035 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS7C 00036 * WORK ORDER: PROGRAMMER: XXX DTSCS7C 00037 * DTSCS7C 00038 * DTSCS7C 00039 * DESCRIPTION: DTSCS7C 00040 * DTSCS7C 00041 * CLEAR: DTSCS7C 00042 * DTSCS7C 00043 * FIELD DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO). DTSCS7C 00044 * DTSCS7C 00045 * DTSCS7C 00046 * JUMP: DTSCS7C 00047 * DTSCS7C 00048 * DTSCS7C 00049 * DTSCS7C 00050 * INQUIRY: DTSCS7C 00051 * DTSCS7C 00052 * CONTROL FIELD(S): MAP-EMP-NO DTSCS7C 00053 * MAP-STATUS-CD DTSCS7C 00054 * MAP-START-YRQ DTSCS7C 00055 * DTSCS7C 00056 * JUMP IN: IF LCCM-EMP-NO = LCCM-SCR47-HOLD-AREA EMP-NO DTSCS7C 00057 * DISPLAY RECORD INDICATED BY DTSCS7C 00058 * LCCM-SCR47-HOLD-AREA. DTSCS7C 00059 * DTSCS7C 00060 * DTSCS7C 00061 * DTSCS7C 00062 * DTSCS7C 00063 * DTSCS7C 00064 * JUMP OUT: STANDARD LCCM-EMP-NO MAINTENANCE. DTSCS7C 00065 * DTSCS7C 00066 * STORE INFORMATION REPRESENTING PAGE DTSCS7C 00067 * CURRENTLY DISPLAYED IN LCCM-SCR43-HOLD-AREA. DTSCS7C 00068 * DTSCS7C 00069 * DTSCS7C 00070 * STORE PAGING CONTROL INFORMATION IN LCCM-SCR-HOLD-AREA. DTSCS7C 00071 * DTSCS7C 00072 * DTSCS7C 00073 * UPDATE: DTSCS7C 00074 * DTSCS7C 00075 * ADD DTSCS7C 00076 * MOD DTSCS7C 00077 * DTSCS7C 00078 * DTSCS7C 00079 * RECORDS READ: DTSCS7C 00080 * DTSCS7C 00081 * MASTER: DTSCS7C 00082 * DTSCS7C 00083 * MPRF DTSCS7C 00084 * MFSC DTSCS7C 00085 * DTSCS7C 00086 * ALTERNATE INDEX: DTSCS7C 00087 * DTSCS7C 00088 * NONE. DTSCS7C 00089 * DTSCS7C 00090 * DTSCS7C 00091 * REFERENCE: DTSCS7C 00092 * DTSCS7C 00093 * NONE. DTSCS7C 00094 * DTSCS7C 00095 * DTSCS7C 00096 * ACCOUNTING TRANSACTION COLLECTION: DTSCS7C 00097 * DTSCS7C 00098 * NONE. DTSCS7C 00099 * DTSCS7C 00100 * DTSCS7C 00101 * RECORDS UPDATED: DTSCS7C 00102 * DTSCS7C 00103 * MASTER: DTSCS7C 00104 * DTSCS7C 00105 * MFSC (WRITE, REWRITE) DTSCS7C 00106 * DTSCS7C 00107 * DTSCS7C 00108 * REFERENCE: DTSCS7C 00109 * DTSCS7C 00110 * NONE. DTSCS7C 00111 * DTSCS7C 00112 * DTSCS7C 00113 * ACCOUNTING TRANSACTION COLLECTION: DTSCS7C 00114 * DTSCS7C 00115 * NONE. DTSCS7C 00116 * DTSCS7C 00117 * DTSCS7C 00118 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCS7C 00119 * DTSCS7C 00120 * T003. DTSCS7C 00121 * DTSCS7C 00122 * DTSCS7C 00123 * TEMPORARY STORAGE USAGE: DTSCS7C 00124 * DTSCS7C 00125 * NONE DTSCS7C 00126 * DTSCS7C 00127 * DTSCS7C 00128 * MODULES LINKED TO: DTSCS7C 00129 * DTSCS7C 00130 * DTSCU001 DATE EDIT/CONVERSION. DTSCS7C 00131 * DTSCU004 QUARTER EDIT/CONVERSION. DTSCS7C 00132 * DTSCU015 DATE FROM SCREEN FORMAT/EDIT. DTSCS7C 00133 * DTSCU018 EMPLOYER NUMBER FROM SCREEN FORMAT/EDIT. DTSCS7C 00134 * DTSCU034 FILING SCHEDULE CODES EDIT/DESCRIPTION. DTSCS7C 00135 * DTSCU221 MPRF-UPDATE DATA ELEMENT MAINTENANCE. DTSCS7C 00136 * DTSCU810 MASTER FILE INPUT/OUTPUT. DTSCS7C 00137 * DTSCS7C 00138 * DTSCS7C 00139 ***** DTSCS7C 00140 DTSCS7C 00141 ENVIRONMENT DIVISION. DTSCS7C 00142 DTSCS7C 00143 DATA DIVISION. DTSCS7C 00144 DTSCS7C 00145 WORKING-STORAGE SECTION. DTSCS7C 001455 77 PAN-VALET PICTURE X(24) VALUE '013DTSCS7C 09/07/06'. DTSCS7C 00146 DTSCS7C 00147 01 WRK-AREA. DTSCS7C 00148 05 WRK-ABEND-CD PIC X(04) VALUE 'S7C '. DTSCS7C 00149 DTSCS7C 00150 05 WRK-SCR-ID. DTSCS7C 00151 10 WRK-SCR-ID-A PIC X(02) VALUE '7C'. DTSCS7C 00152 DTSCS7C 00153 05 WRK-F03-SCR-ID PIC X(02) VALUE '70'. DTSCS7C 00154 DTSCS7C 00155 05 SCR-ACCESS-IND PIC X(01). DTSCS7C 00156 88 SCR-ACCESS-INQ VALUE '1'. DTSCS7C 00157 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS7C 00158 DTSCS7C 00159 05 CURSOR-SET-IND PIC X(01). DTSCS7C 00160 88 CURSOR-SET-YES VALUE 'Y'. DTSCS7C 00161 88 CURSOR-SET-NO VALUE 'N'. DTSCS7C 00162 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS7C 00163 DTSCS7C 00164 05 REQ-IND PIC X(01). DTSCS7C 00165 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS7C 00166 88 REQ-ERROR VALUE 'O'. DTSCS7C 00167 88 REQ-JUMP VALUE 'J'. DTSCS7C 00168 88 REQ-UPDATE VALUE 'U'. DTSCS7C 00169 88 REQ-INQUIRE VALUE 'I'. DTSCS7C 00170 88 REQ-CLEAR VALUE 'C'. DTSCS7C 00171 88 REQ-EDIT VALUE 'E'. DTSCS7C 00172 DTSCS7C 00173 05 RESP-IND PIC X(01). DTSCS7C 00174 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS7C 00175 88 RESP-SEND-MAP VALUE 'M'. DTSCS7C 00176 88 RESP-JUMP VALUE 'J'. DTSCS7C 00177 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS7C 00178 DTSCS7C 00179 05 WRK-MSG-AREA PIC X(64). DTSCS7C 00180 DTSCS7C 00181 05 WRK-ATB-AN PIC X(01). DTSCS7C 00182 05 WRK-ATB-NUM PIC X(01). DTSCS7C 00183 DTSCS7C 00184 05 WRK-OCC PIC S9(04) COMP. DTSCS7C 00185 DTSCS7C 00186 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSCS7C 00187 DTSCS7C 00188 05 WRK-STATUS-CD PIC X(01). DTSCS7C 00189 DTSCS7C 00190 05 WRK-START-YRQ PIC S9(05) COMP-3. DTSCS7C 00191 05 WRK-START-YEAR PIC 9(04). DTSCS7C 00192 05 WRK-ABS-QTR PIC S9(04) COMP. DTSCS7C 00193 DTSCS7C 00194 05 WRK-ALL-NINES-YRQ PIC S9(05) COMP-3 DTSCS7C 00195 VALUE +99999. DTSCS7C 00196 DTSCS7C 00197 05 WRK-PRIOR-YRQ PIC S9(05) COMP-3. DTSCS7C 00198 05 WRK-PRIOR-ABS-QTR PIC S9(04) COMP. DTSCS7C 00199 05 WRK-PRIOR-SCHED PIC X(01). DTSCS7C 00200 88 WRK-PRIOR-SCHED-QTR-88 VALUE 'Q'. DTSCS7C 00201 88 WRK-PRIOR-SCHED-ANN-88 VALUE 'A'. DTSCS7C 00202 05 WRK-NEXT-YRQ PIC S9(05) COMP-3. DTSCS7C 00203 05 WRK-NEXT-ABS-QTR PIC S9(04) COMP. DTSCS7C 00204 05 WRK-OPEN-MFSC-CNT PIC S9(04) COMP. DTSCS7C 00205 DTSCS7C 00206 05 WRK-FIRST-ANN-FILING-YRQ PIC S9(05) COMP-3 DTSCS7C 00207 VALUE +20021. DTSCS7C 00208 DTSCS7C 00209 05 WRK-MIN-ANN-DURATION PIC S9(04) COMP DTSCS7C 00210 VALUE +4. DTSCS7C 00211 DTSCS7C 00212 * 05 WRK-FILTER-IND PIC X(01). DTSCS7C 00213 * 88 WRK-FILTER-YES-88 VALUE 'Y'. DTSCS7C 00214 * 88 WRK-FILTER-NO-88 VALUE 'N'. DTSCS7C 00215 DTSCS7C 00216 05 INQUIRY-CONTROL-AREA. DTSCS7C 00217 10 LAST-REC-NUM PIC S9(02) COMP-3. DTSCS7C 00218 10 LAST-REC-NUM-DISP PIC 9(02). DTSCS7C 00219 10 WRK-REC-NUM PIC S9(02) COMP-3. DTSCS7C 00220 10 WRK-REC-NUM-DISP PIC 9(02). DTSCS7C 00221 10 CURR-REC-NUM PIC S9(02) COMP-3. DTSCS7C 00222 DTSCS7C 00223 10 WRK-PROG-NAME PIC X(07) DTSCS7C 00224 VALUE 'DTSCS7C'. DTSCS7C 00225 DTSCS7C 00226 10 LAST-REC-KEY-AREA PIC X(16). DTSCS7C 00227 10 PRIOR-REC-KEY-AREA PIC X(16). DTSCS7C 00228 DTSCS7C 00229 10 SCR-HOLD-AREA. DTSCS7C 00230 15 SCR-REC-KEY-AREA PIC X(16). DTSCS7C 00231 15 FILLER REDEFINES SCR-REC-KEY-AREA. DTSCS7C 00232 20 SCR-REC-EMP-NO PIC S9(07) COMP-3. DTSCS7C 00233 20 SCR-REC-TYPE PIC S9(04) COMP. DTSCS7C 00234 20 SCR-REC-ABS-QTR PIC S9(04) COMP. DTSCS7C 00235 20 SCR-REC-ABSTIME PIC S9(15) COMP-3. DTSCS7C 00236 DTSCS7C 00237 10 WRK-KEY-FOUND-IND PIC X(01). DTSCS7C 00238 88 WRK-KEY-FOUND-YES-88 VALUE 'Y'. DTSCS7C 00239 88 WRK-KEY-FOUND-NO-88 VALUE 'N'. DTSCS7C 00240 DTSCS7C 00241 05 WRK-RPTS-FOUND-IND PIC X(01). DTSCS7C 00242 88 WRK-RPTS-FOUND-YES-88 VALUE 'Y'. DTSCS7C 00243 88 WRK-RPTS-FOUND-NO-88 VALUE 'N'. DTSCS7C 00244 DTSCS7C 00245 05 WRK-DUP-FOUND-IND PIC X(01). DTSCS7C 00246 88 WRK-DUP-FOUND-YES-88 VALUE 'Y'. DTSCS7C 00247 88 WRK-DUP-FOUND-NO-88 VALUE 'N'. DTSCS7C 00248 DTSCS7C 00249 05 WRK-INCONSIST-RPTS-IND PIC X(01). DTSCS7C 00250 88 WRK-INCONSIST-RPTS-YES-88 VALUE 'Y'. DTSCS7C 00251 88 WRK-INCONSIST-RPTS-NO-88 VALUE 'N'. DTSCS7C 00252 DTSCS7C 00253 05 WRK-CURR-DATE PIC 9(08). DTSCS7C 00254 05 FILLER REDEFINES WRK-CURR-DATE. DTSCS7C 00255 10 WRK-CURR-YEAR PIC 9(04). DTSCS7C 00256 10 WRK-CURR-MONTH PIC 9(02). DTSCS7C 00257 88 WRK-CURR-MONTH-JAN-88 VALUE 01. DTSCS7C 00258 10 WRK-CURR-DAY PIC 9(02). DTSCS7C 00259 DTSCS7C 00260 05 WRK-NEXT-YEAR PIC 9(04). DTSCS7C 00261 DTSCS7C 00262 05 WRK-MPRF-IND PIC X(01). DTSCS7C 00263 88 WRK-MPRF-YES-88 VALUE 'Y'. DTSCS7C 00264 88 WRK-MPRF-NO-88 VALUE 'N'. DTSCS7C 00265 DTSCS7C 00266 05 WRK-MFSC-IND PIC X(01). DTSCS7C 00267 88 WRK-MFSC-FOUND-YES-88 VALUE 'Y'. DTSCS7C 00268 88 WRK-MFSC-FOUND-NO-88 VALUE 'N'. DTSCS7C 00269 DTSCS7C 00270 05 WRK-MSOL-IND PIC X(01). DTSCS7C 00271 88 WRK-MSOL-FOUND-YES-88 VALUE 'Y'. DTSCS7C 00272 88 WRK-MSOL-FOUND-NO-88 VALUE 'N'. DTSCS7C 00273 DTSCS7C 00274 05 WRK-T001-RPT-TYPE PIC X(02). DTSCS7C 00275 88 WRK-T001-NULL-88 VALUE SPACES. DTSCS7C 00276 88 WRK-T001-EMP-REQUEST-88 VALUE '02'. DTSCS7C 00277 88 WRK-T001-CONFIRM-QTR-88 VALUE '10'. DTSCS7C 00278 88 WRK-T001-CONFIRM-ANN-88 VALUE '11'. DTSCS7C 00279 DTSCS7C 00280 05 WRK-DISPLAY PIC 9(11). DTSCS7C 00281 DTSCS7C 00282 05 FILLER REDEFINES WRK-DISPLAY. DTSCS7C 00283 10 FILLER PIC X(05). DTSCS7C 00284 10 WRK-DISPLAY-EMP-NO-1 PIC X(03). DTSCS7C 00285 10 WRK-DISPLAY-EMP-NO-2 PIC X(03). DTSCS7C 00286 DTSCS7C 00287 05 FILLER REDEFINES WRK-DISPLAY. DTSCS7C 00288 10 FILLER PIC X(05). DTSCS7C 00289 10 WRK-DISPLAY-YR PIC 9(02). DTSCS7C 00290 10 WRK-DISPLAY-MO PIC 9(02). DTSCS7C 00291 10 WRK-DISPLAY-DA PIC 9(02). DTSCS7C 00292 DTSCS7C 00293 05 FILLER REDEFINES WRK-DISPLAY. DTSCS7C 00294 10 FILLER PIC X(08). DTSCS7C 00295 10 WRK-DISPLAY-YRQ-YY PIC X(02). DTSCS7C 00296 10 WRK-DISPLAY-YRQ-Q PIC X(01). DTSCS7C 00297 DTSCS7C 00298 01 NOTE-LITERALS. DTSCS7C 00299 05 NOTE-WITHDRAW. DTSCS7C 00300 10 FILLER PIC X(50) VALUE DTSCS7C 00301 'SYSTEM ADDED: WITHDRAWAL LEFT NO SCHEDULE RECORD O'. DTSCS7C 00302 10 FILLER PIC X(22) VALUE DTSCS7C 00303 'N FILE '. DTSCS7C 00304 EJECT DTSCS7C 00305 01 MSG-LITERALS. DTSCS7C 00306 05 MSG-E7C1-AREA. DTSCS7C 00307 10 FILLER PIC X(04) VALUE 'E7C1'. DTSCS7C 00308 10 FILLER PIC X(60) VALUE DTSCS7C 00309 'NO CHANGE ALLOWED IF WITHDRAWN '.DTSCS7C 00310 05 MSG-E7C2-AREA. DTSCS7C 00311 10 FILLER PIC X(04) VALUE 'E7C2'. DTSCS7C 00312 10 FILLER PIC X(60) VALUE DTSCS7C 00313 'START YRQ MUST BE THE FIRST QUARTER OF THE YEAR '.DTSCS7C 00314 05 MSG-E7C3-AREA. DTSCS7C 00315 10 FILLER PIC X(04) VALUE 'E7C3'. DTSCS7C 00316 10 FILLER PIC X(60) VALUE DTSCS7C 00317 'MUST BE OPEN (O) OR WITHDRAWN (W) '.DTSCS7C 00318 05 MSG-E7C4-AREA. DTSCS7C 00319 10 FILLER PIC X(04) VALUE 'E7C4'. DTSCS7C 00320 10 FILLER PIC X(60) VALUE DTSCS7C 00321 'START YEAR MAY NOT BE GREATER THAN NEXT YEAR '.DTSCS7C 00322 05 MSG-E7C5-AREA. DTSCS7C 00323 10 FILLER PIC X(04) VALUE 'E7C5'. DTSCS7C 00324 10 FILLER PIC X(60) VALUE DTSCS7C 00325 'START DATE MAY NOT BE EARLIER THAN 2002/1 '.DTSCS7C 00326 05 MSG-E7C7-AREA. DTSCS7C 00327 10 FILLER PIC X(04) VALUE 'E7C7'. DTSCS7C 00328 10 FILLER PIC X(60) VALUE DTSCS7C 00329 '*** NOT A HOUSEHOLD EMPLOYER. SCREEN 7C NOT VALID *** '.DTSCS7C 00330 05 MSG-E7C8-AREA. DTSCS7C 00331 10 FILLER PIC X(04) VALUE 'E7C8'. DTSCS7C 00332 10 FILLER PIC X(60) VALUE DTSCS7C 00333 'EMPLOYER IS NOT LIABLE IN START YRQ '.DTSCS7C 00334 05 MSG-E7C9-AREA. DTSCS7C 00335 10 FILLER PIC X(04) VALUE 'E7C9'. DTSCS7C 00336 10 FILLER PIC X(60) VALUE DTSCS7C 00337 'REPORTS ON FILE INCONSISTENT WITH NEW FILING SCHEDULE '.DTSCS7C 00338 05 MSG-E7CA-AREA. DTSCS7C 00339 10 FILLER PIC X(04) VALUE 'E7CA'. DTSCS7C 00340 10 FILLER PIC X(60) VALUE DTSCS7C 00341 'NEW SCHEDULE OVERLAPS EXISTING SCHEDULE '.DTSCS7C 00342 05 MSG-E7CB-AREA. DTSCS7C 00343 10 FILLER PIC X(04) VALUE 'E7CB'. DTSCS7C 00344 10 FILLER PIC X(60) VALUE DTSCS7C 00345 'SCHEDULE MAY NOT BE WITHDRAWN: REPORTS ON FILE '.DTSCS7C 00346 05 MSG-E7CC-AREA. DTSCS7C 00347 10 FILLER PIC X(04) VALUE 'E7CC'. DTSCS7C 00348 10 FILLER PIC X(60) VALUE DTSCS7C 00349 'NOT ALLOWED: MORE RECENT SCHEDULE EXISTS '.DTSCS7C 00350 05 MSG-E7CD-AREA. DTSCS7C 00351 10 FILLER PIC X(04) VALUE 'E7CD'. DTSCS7C 00352 10 FILLER PIC X(60) VALUE DTSCS7C 00353 'NOT ALLOWED - SCHEDULE EXISTS WITH SAME START YRQ '.DTSCS7C 00354 DTSCS7C 00355 05 MSG-E7CE-AREA. DTSCS7C 00356 10 FILLER PIC X(04) VALUE 'E7CE'. DTSCS7C 00357 10 FILLER PIC X(60) VALUE DTSCS7C 00358 'ERROR - OPEN MUST BE WITHDRAWN BEFORE ADDING NEW SCHEDULE '.DTSCS7C 00359 DTSCS7C 00360 05 MSG-E7CF-AREA. DTSCS7C 00361 10 FILLER PIC X(04) VALUE 'E7CF'. DTSCS7C 00362 10 FILLER PIC X(60) VALUE DTSCS7C 00363 'ESTIMATED RATE WILL BECOME FINAL. VERIFY?'. DTSCS7C 00364 DTSCS7C 00365 05 MSG-E7CG-AREA. DTSCS7C 00366 10 FILLER PIC X(04) VALUE 'E7CG'. DTSCS7C 00367 10 FILLER PIC X(60) VALUE DTSCS7C 00368 'DELETE ONLY ALLOWED IF NOT HOUSEHOLD. '. DTSCS7C 00369 EJECT DTSCS7C 00370 01 L001-COMM-AREA. DTSCS7C 00371 ++INCLUDE DTSIL001 DTSCS7C 00372 EJECT DTSCS7C 00373 01 L004-COMM-AREA. DTSCS7C 00374 ++INCLUDE DTSIL004 DTSCS7C 00375 EJECT DTSCS7C 00376 01 L006-COMM-AREA. DTSCS7C 00377 ++INCLUDE DTSIL006 DTSCS7C 00378 EJECT DTSCS7C 00379 01 L015-COMM-AREA. DTSCS7C 00380 ++INCLUDE DTSIL015 DTSCS7C 00381 EJECT DTSCS7C 00382 01 L016-COMM-AREA. DTSCS7C 00383 ++INCLUDE DTSIL016 DTSCS7C 00384 EJECT DTSCS7C 00385 01 L018-COMM-AREA. DTSCS7C 00386 ++INCLUDE DTSIL018 DTSCS7C 00387 EJECT DTSCS7C 00388 01 L042-COMM-AREA. DTSCS7C 00389 ++INCLUDE DTSIL042 DTSCS7C 00390 EJECT DTSCS7C 00391 01 L221-COMM-AREA. DTSCS7C 00392 ++INCLUDE DTSIL221 DTSCS7C 00393 EJECT DTSCS7C 00394 01 L331-COMM-AREA. DTSCS7C 00395 ++INCLUDE DTSIL331 DTSCS7C 00396 EJECT DTSCS7C 00397 01 L805-COMM-AREA. DTSCS7C 00398 ++INCLUDE DTSIL805 DTSCS7C 00399 EJECT DTSCS7C 00400 01 L810-COMM-AREA. DTSCS7C 00401 05 L810-CONTROL-BLOCK. DTSCS7C 00402 ++INCLUDE DTSIL810 DTSCS7C 00403 EJECT DTSCS7C 00404 05 MSKL-REC. DTSCS7C 00405 ++INCLUDE DTSIMSKL DTSCS7C 00406 EJECT DTSCS7C 00407 * DTSCS7C 00408 01 MPRF-REC. DTSCS7C 00409 ++INCLUDE DTSIMPRF DTSCS7C 00410 EJECT DTSCS7C 00411 01 MFSC-REC. DTSCS7C 00412 ++INCLUDE DTSIMFSC DTSCS7C 00413 EJECT DTSCS7C 00414 01 MQTR-REC. DTSCS7C 00415 ++INCLUDE DTSIMQTR DTSCS7C 00416 EJECT DTSCS7C 00417 01 MSOL-REC. DTSCS7C 00418 ++INCLUDE DTSIMSOL DTSCS7C 00419 EJECT DTSCS7C 00420 01 MRTE-REC. DTSCS7C 00421 ++INCLUDE DTSIMRTE DTSCS7C 00422 EJECT DTSCS7C 00423 01 L825-COMM-AREA. DTSCS7C 00424 05 L825-CONTROL-BLOCK. DTSCS7C 00425 ++INCLUDE DTSIL825 DTSCS7C 00426 DTSCS7C 00427 05 RSKL-REC. DTSCS7C 00428 ++INCLUDE DTSIRSK1 DTSCS7C 00429 DTSCS7C 00430 01 T001-REC. DTSCS7C 00431 ++INCLUDE DTSIT001 DTSCS7C 00432 DTSCS7C 00433 01 T006-REC. DTSCS7C 00434 ++INCLUDE DTSIT006 DTSCS7C 00435 DTSCS7C 00436 01 T031-REC. DTSCS7C 00437 ++INCLUDE DTSIT031 DTSCS7C 00438 DTSCS7C 00439 01 L851-COMM-AREA. DTSCS7C 00440 ++INCLUDE DTSIL851 DTSCS7C 00441 DTSCS7C 00442 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS7C 00443 ++INCLUDE DTSIS7C DTSCS7C 00444 EJECT DTSCS7C 00445 01 CATB-LITERALS. DTSCS7C 00446 ++INCLUDE DTSICATB DTSCS7C 00447 DTSCS7C 00448 01 CFKD-LITERALS. DTSCS7C 00449 ++INCLUDE DTSICFKD DTSCS7C 00450 DTSCS7C 00451 01 CECD-LITERALS. DTSCS7C 00452 ++INCLUDE DTSICECD DTSCS7C 00453 DTSCS7C 00454 01 CPCD-LITERALS. DTSCS7C 00455 ++INCLUDE DTSICPCD DTSCS7C 00456 DTSCS7C 00457 01 MMAX-LITERALS. DTSCS7C 00458 ++INCLUDE DTSIMMAX DTSCS7C 00459 DTSCS7C 00460 LINKAGE SECTION. DTSCS7C 00461 DTSCS7C 00462 01 DFHCOMMAREA. DTSCS7C 00463 ++INCLUDE DTSILCCM DTSCS7C 00464 DTSCS7C 00465 15 FILLER REDEFINES LCCM-SCR-HOLD-AREA. DTSCS7C 00466 20 LCCM-SCR-HOLD-PROG-NAME PIC X(07). DTSCS7C 00467 20 LCCM-SCR-HOLD-KEY PIC X(16). DTSCS7C 00468 EJECT DTSCS7C 00469 ******************************************************************DTSCS7C 00470 * *DTSCS7C 00471 ******************************************************************DTSCS7C 00472 DTSCS7C 00473 PROCEDURE DIVISION. DTSCS7C 00474 DTSCS7C 00475 MOVE +0 TO WRK-EMP-NO. DTSCS7C 00476 SET WRK-MPRF-NO-88 TO TRUE. DTSCS7C 00477 DTSCS7C 00478 SET WRK-KEY-FOUND-NO-88 TO TRUE. DTSCS7C 00479 DTSCS7C 00480 MOVE LOW-VALUES TO MAP-AREA. DTSCS7C 00481 DTSCS7C 00482 SET CURSOR-SET-NO TO TRUE. DTSCS7C 00483 DTSCS7C 00484 PERFORM P0100-ACCESS-SEARCH THRU P0100-EXIT DTSCS7C 00485 VARYING LCCM-NONUM-IDX FROM +1 BY +1 DTSCS7C 00486 UNTIL LCCM-NONUM-IDX > LCCM-SCR-NONUM-CNT. DTSCS7C 00487 DTSCS7C 00488 MOVE SPACE TO REQ-IND. DTSCS7C 00489 DTSCS7C 00490 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS7C 00491 DTSCS7C 00492 *----------------------------------------------------- DTSCS7C 00493 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS7C 00494 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS7C 00495 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS7C 00496 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS7C 00497 * DTSCS7C 00498 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS7C 00499 * PROCESSED. DTSCS7C 00500 * DTSCS7C 00501 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS7C 00502 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS7C 00503 * WORK STATION OPERATOR. DTSCS7C 00504 *----------------------------------------------------- DTSCS7C 00505 DTSCS7C 00506 MOVE SPACE TO RESP-IND. DTSCS7C 00507 DTSCS7C 00508 IF REQ-ERROR DTSCS7C 00509 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS7C 00510 ELSE DTSCS7C 00511 IF REQ-JUMP DTSCS7C 00512 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS7C 00513 ELSE DTSCS7C 00514 IF REQ-CLEAR DTSCS7C 00515 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS7C 00516 ELSE DTSCS7C 00517 IF REQ-CURSOR-TO-GOTO DTSCS7C 00518 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS7C 00519 ELSE DTSCS7C 00520 IF REQ-INQUIRE DTSCS7C 00521 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS7C 00522 ELSE DTSCS7C 00523 IF REQ-EDIT DTSCS7C 00524 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS7C 00525 ELSE DTSCS7C 00526 IF REQ-UPDATE DTSCS7C 00527 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS7C 00528 ELSE DTSCS7C 00529 GO TO S899-ABEND. DTSCS7C 00530 DTSCS7C 00531 *----------------------------------------------------- DTSCS7C 00532 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS7C 00533 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS7C 00534 *----------------------------------------------------- DTSCS7C 00535 DTSCS7C 00536 IF RESP-SEND-MAP DTSCS7C 00537 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS7C 00538 SET LCCM-END-TASK-88 TO TRUE DTSCS7C 00539 ELSE DTSCS7C 00540 IF RESP-SEND-MSGONLY DTSCS7C 00541 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS7C 00542 SET LCCM-END-TASK-88 TO TRUE DTSCS7C 00543 ELSE DTSCS7C 00544 IF RESP-JUMP DTSCS7C 00545 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS7C 00546 ELSE DTSCS7C 00547 IF RESP-CURSOR-TO-GOTO DTSCS7C 00548 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS7C 00549 SET LCCM-END-TASK-88 TO TRUE DTSCS7C 00550 ELSE DTSCS7C 00551 GO TO S899-ABEND. DTSCS7C 00552 DTSCS7C 00553 MAINLINE-EXIT. DTSCS7C 00554 DTSCS7C 00555 EXEC CICS DTSCS7C 00556 RETURN DTSCS7C 00557 END-EXEC. DTSCS7C 00558 DTSCS7C 00559 GOBACK. DTSCS7C 00560 EJECT DTSCS7C 00561 P0100-ACCESS-SEARCH. DTSCS7C 00562 IF LCCM-SCR-NONUM-ID (LCCM-NONUM-IDX) = WRK-SCR-ID-A DTSCS7C 00563 MOVE LCCM-SCR-NONUM-ACCESS-IND (LCCM-NONUM-IDX) DTSCS7C 00564 TO SCR-ACCESS-IND. DTSCS7C 00565 DTSCS7C 00566 P0100-EXIT. DTSCS7C 00567 EXIT. DTSCS7C 00568 DTSCS7C 00569 /*****************************************************************DTSCS7C 00570 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS7C 00571 ******************************************************************DTSCS7C 00572 P1000-ANALYZE-REQUEST. DTSCS7C 00573 DTSCS7C 00574 *----------------------------------------------------- DTSCS7C 00575 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS7C 00576 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS7C 00577 * REPLACED WITH ENTER) DTSCS7C 00578 *----------------------------------------------------- DTSCS7C 00579 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS7C 00580 SET LCCM-ENTER-88 TO TRUE DTSCS7C 00581 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA DTSCS7C 00582 IF LCCM-EMP-NO > ZERO DTSCS7C 00583 SET REQ-INQUIRE TO TRUE DTSCS7C 00584 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS7C 00585 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS7C 00586 ELSE DTSCS7C 00587 SET REQ-INQUIRE TO TRUE DTSCS7C 00588 END-IF DTSCS7C 00589 GO TO P1000-EXIT. DTSCS7C 00590 DTSCS7C 00591 *----------------------------------------------------- DTSCS7C 00592 * MAP IS RECEIVED DTSCS7C 00593 *----------------------------------------------------- DTSCS7C 00594 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS7C 00595 DTSCS7C 00596 *----------------------------------------------------- DTSCS7C 00597 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS7C 00598 * WORK STATION DTSCS7C 00599 *----------------------------------------------------- DTSCS7C 00600 IF LCCM-CLEAR-88 DTSCS7C 00601 SET REQ-CLEAR TO TRUE DTSCS7C 00602 GO TO P1000-EXIT. DTSCS7C 00603 DTSCS7C 00604 *----------------------------------------------------- DTSCS7C 00605 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS7C 00606 *----------------------------------------------------- DTSCS7C 00607 IF LCCM-SCR-UPDATE-LOCKED DTSCS7C 00608 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS7C 00609 GO TO P1000-EXIT. DTSCS7C 00610 DTSCS7C 00611 *----------------------------------------------------- DTSCS7C 00612 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS7C 00613 *----------------------------------------------------- DTSCS7C 00614 IF LCCM-PA2-88 DTSCS7C 00615 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS7C 00616 GO TO P1000-EXIT. DTSCS7C 00617 DTSCS7C 00618 *----------------------------------------------------- DTSCS7C 00619 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS7C 00620 *----------------------------------------------------- DTSCS7C 00621 IF LCCM-PA-88 DTSCS7C 00622 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS7C 00623 SET REQ-ERROR TO TRUE DTSCS7C 00624 GO TO P1000-EXIT. DTSCS7C 00625 DTSCS7C 00626 *----------------------------------------------------- DTSCS7C 00627 * IF F12 IS PRESS AND UPDATE NOT IN PROGRESS THEN DTSCS7C 00628 * CLEAR SCREEN DTSCS7C 00629 *----------------------------------------------------- DTSCS7C 00630 IF LCCM-F12-88 DTSCS7C 00631 MOVE LOW-VALUES TO MAP-AREA DTSCS7C 00632 SET REQ-CLEAR TO TRUE DTSCS7C 00633 GO TO P1000-EXIT. DTSCS7C 00634 DTSCS7C 00635 *----------------------------------------------------- DTSCS7C 00636 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS7C 00637 *----------------------------------------------------- DTSCS7C 00638 IF LCCM-F03-88 DTSCS7C 00639 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS7C 00640 SET REQ-JUMP TO TRUE DTSCS7C 00641 GO TO P1000-EXIT. DTSCS7C 00642 DTSCS7C 00643 *----------------------------------------------------- DTSCS7C 00644 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS7C 00645 *----------------------------------------------------- DTSCS7C 00646 IF LCCM-F04-88 DTSCS7C 00647 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS7C 00648 SET REQ-JUMP TO TRUE DTSCS7C 00649 GO TO P1000-EXIT. DTSCS7C 00650 DTSCS7C 00651 *----------------------------------------------------- DTSCS7C 00652 * IF CORRESPNDENCE SCREEN KEY PRESSED, THEN JUMP TO DTSCS7C 00653 * CORRESPONDENCE SCREEN. DTSCS7C 00654 *----------------------------------------------------- DTSCS7C 00655 IF LCCM-F14-88 DTSCS7C 00656 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS7C 00657 SET REQ-JUMP TO TRUE DTSCS7C 00658 GO TO P1000-EXIT. DTSCS7C 00659 DTSCS7C 00660 *----------------------------------------------------- DTSCS7C 00661 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS7C 00662 * REQUESTED SCREEN TYPE DTSCS7C 00663 *----------------------------------------------------- DTSCS7C 00664 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS7C 00665 NEXT SENTENCE DTSCS7C 00666 ELSE DTSCS7C 00667 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS7C 00668 SET REQ-JUMP TO TRUE DTSCS7C 00669 GO TO P1000-EXIT. DTSCS7C 00670 DTSCS7C 00671 *----------------------------------------------------- DTSCS7C 00672 * IF REQUEST TO UPDATE THE DATA (ADD,MOD) DTSCS7C 00673 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS7C 00674 *----------------------------------------------------- DTSCS7C 00675 IF LCCM-F09-88 DTSCS7C 00676 OR LCCM-F10-88 DTSCS7C 00677 OR LCCM-F23-88 DTSCS7C 00678 IF SCR-ACCESS-UPDATE DTSCS7C 00679 SET REQ-EDIT TO TRUE DTSCS7C 00680 GO TO P1000-EXIT DTSCS7C 00681 ELSE DTSCS7C 00682 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS7C 00683 SET REQ-ERROR TO TRUE DTSCS7C 00684 GO TO P1000-EXIT. DTSCS7C 00685 DTSCS7C 00686 *----------------------------------------------------- DTSCS7C 00687 * IF INQUIRY TYPE KEY PRESSED (ENTER, F5, F6, F7, DTSCS7C 00688 * OR F8), INDICATE INQUIRY REQUEST DTSCS7C 00689 *----------------------------------------------------- DTSCS7C 00690 IF LCCM-ENTER-88 DTSCS7C 00691 OR LCCM-F05-88 DTSCS7C 00692 OR LCCM-F06-88 DTSCS7C 00693 OR LCCM-F07-88 DTSCS7C 00694 OR LCCM-F08-88 DTSCS7C 00695 SET REQ-INQUIRE TO TRUE DTSCS7C 00696 GO TO P1000-EXIT. DTSCS7C 00697 DTSCS7C 00698 *----------------------------------------------------- DTSCS7C 00699 * ANY OTHER KEY IS INVALID DTSCS7C 00700 *----------------------------------------------------- DTSCS7C 00701 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS7C 00702 SET REQ-ERROR TO TRUE. DTSCS7C 00703 P1000-EXIT. DTSCS7C 00704 EXIT. DTSCS7C 00705 DTSCS7C 00706 ******************************************************************DTSCS7C 00707 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS7C 00708 ******************************************************************DTSCS7C 00709 DTSCS7C 00710 P1100-UPDATE-LOCKED. DTSCS7C 00711 *----------------------------------------------------- DTSCS7C 00712 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS7C 00713 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCS7C 00714 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS7C 00715 *----------------------------------------------------- DTSCS7C 00716 IF LCCM-ENTER-88 OR LCCM-F12-88 DTSCS7C 00717 SET REQ-UPDATE TO TRUE DTSCS7C 00718 ELSE DTSCS7C 00719 SET REQ-ERROR TO TRUE DTSCS7C 00720 IF LCCM-SCR-ADD-LOCKED DTSCS7C 00721 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS7C 00722 ELSE DTSCS7C 00723 IF LCCM-SCR-MOD-LOCKED DTSCS7C 00724 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS7C 00725 ELSE DTSCS7C 00726 GO TO S899-ABEND. DTSCS7C 00727 P1100-EXIT. DTSCS7C 00728 EXIT. DTSCS7C 00729 /*****************************************************************DTSCS7C 00730 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS7C 00731 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS7C 00732 ******************************************************************DTSCS7C 00733 DTSCS7C 00734 P2000-REQUEST-ERROR. DTSCS7C 00735 IF LCCM-MSG DTSCS7C 00736 SET RESP-SEND-MSGONLY TO TRUE DTSCS7C 00737 ELSE DTSCS7C 00738 GO TO S899-ABEND. DTSCS7C 00739 P2000-EXIT. DTSCS7C 00740 EXIT. DTSCS7C 00741 /*****************************************************************DTSCS7C 00742 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS7C 00743 ******************************************************************DTSCS7C 00744 DTSCS7C 00745 P3000-REQUEST-JUMP. DTSCS7C 00746 *----------------------------------------------------- DTSCS7C 00747 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS7C 00748 * BY USER DTSCS7C 00749 *----------------------------------------------------- DTSCS7C 00750 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS7C 00751 DTSCS7C 00752 *----------------------------------------------------- DTSCS7C 00753 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS7C 00754 *----------------------------------------------------- DTSCS7C 00755 IF LCCM-MSG DTSCS7C 00756 SET RESP-SEND-MSGONLY TO TRUE DTSCS7C 00757 SET CURSOR-SET-GOTO TO TRUE DTSCS7C 00758 GO TO P3000-EXIT. DTSCS7C 00759 SKIP3 DTSCS7C 00760 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS7C 00761 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS7C 00762 IF L018-VALID DTSCS7C 00763 MOVE L018-EMP-NO TO LCCM-EMP-NO. DTSCS7C 00764 DTSCS7C 00765 *----------------------------------------------------- DTSCS7C 00766 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS7C 00767 *----------------------------------------------------- DTSCS7C 00768 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS7C 00769 LCCM-SCR-HOLD-AREA. DTSCS7C 00770 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS7C 00771 SET RESP-JUMP TO TRUE. DTSCS7C 00772 P3000-EXIT. DTSCS7C 00773 EXIT. DTSCS7C 00774 /*****************************************************************DTSCS7C 00775 * CLEAR KEY WAS PRESSED *DTSCS7C 00776 ******************************************************************DTSCS7C 00777 DTSCS7C 00778 P4000-REQUEST-CLEAR. DTSCS7C 00779 DTSCS7C 00780 *----------------------------------------------------- DTSCS7C 00781 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS7C 00782 * FIELDS FROM EARLIER REQUESTS DTSCS7C 00783 *----------------------------------------------------- DTSCS7C 00784 IF LCCM-EMP-NO > ZERO DTSCS7C 00785 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS7C 00786 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS7C 00787 DTSCS7C 00788 MOVE ZERO TO LCCM-EMP-NO. DTSCS7C 00789 DTSCS7C 00790 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA. DTSCS7C 00791 DTSCS7C 00792 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS7C 00793 DTSCS7C 00794 SET LCCM-SCR-CLEAR TO TRUE. DTSCS7C 00795 DTSCS7C 00796 IF SCR-ACCESS-UPDATE DTSCS7C 00797 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS7C 00798 ELSE DTSCS7C 00799 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS7C 00800 DTSCS7C 00801 SET RESP-SEND-MAP TO TRUE. DTSCS7C 00802 P4000-EXIT. DTSCS7C 00803 EXIT. DTSCS7C 00804 /*****************************************************************DTSCS7C 00805 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS7C 00806 ******************************************************************DTSCS7C 00807 DTSCS7C 00808 P5000-CURSOR-TO-GOTO. DTSCS7C 00809 SET CURSOR-SET-GOTO TO TRUE. DTSCS7C 00810 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS7C 00811 P5000-EXIT. DTSCS7C 00812 EXIT. DTSCS7C 00813 /*****************************************************************DTSCS7C 00814 * INQUIRY WAS REQUESTED *DTSCS7C 00815 ******************************************************************DTSCS7C 00816 DTSCS7C 00817 P6000-REQUEST-INQUIRE. DTSCS7C 00818 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS7C 00819 MOVE MAP-STATUS-CD TO WRK-STATUS-CD. DTSCS7C 00820 MOVE MAP-START-YY TO WRK-DISPLAY-YRQ-YY. DTSCS7C 00821 MOVE MAP-START-Q TO WRK-DISPLAY-YRQ-Q. DTSCS7C 00822 DTSCS7C 00823 MOVE MAP-START-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS7C 00824 DTSCS7C 00825 MOVE LOW-VALUES TO MAP-AREA. DTSCS7C 00826 DTSCS7C 00827 MOVE L018-S-EMP-NO-AREA TO MAP-EMP-NO-AREA. DTSCS7C 00828 MOVE WRK-STATUS-CD TO MAP-STATUS-CD. DTSCS7C 00829 MOVE WRK-DISPLAY-YRQ-YY TO MAP-START-YY. DTSCS7C 00830 MOVE WRK-DISPLAY-YRQ-Q TO MAP-START-Q. DTSCS7C 00831 DTSCS7C 00832 MOVE L016-S-YRQ-AREA TO MAP-START-YRQ-AREA. DTSCS7C 00833 DTSCS7C 00834 SET LCCM-SCR-CLEAR TO TRUE. DTSCS7C 00835 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS7C 00836 DTSCS7C 00837 SET RESP-SEND-MAP TO TRUE. DTSCS7C 00838 DTSCS7C 00839 IF SCR-ACCESS-UPDATE DTSCS7C 00840 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS7C 00841 ELSE DTSCS7C 00842 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS7C 00843 DTSCS7C 00844 MOVE LOW-VALUES TO SCR-REC-KEY-AREA. DTSCS7C 00845 DTSCS7C 00846 PERFORM S1101-EMP-NO THRU S1101-EXIT. DTSCS7C 00847 IF LCCM-MSG DTSCS7C 00848 GO TO P6000-EXIT. DTSCS7C 00849 DTSCS7C 00850 IF WRK-EMP-NO = LCCM-EMP-NO DTSCS7C 00851 IF LCCM-SCR-HOLD-PROG-NAME = WRK-PROG-NAME DTSCS7C 00852 MOVE LCCM-SCR-HOLD-KEY TO SCR-REC-KEY-AREA DTSCS7C 00853 MFSC-KEY-AREA. DTSCS7C 00854 DTSCS7C 00855 IF LCCM-MSG DTSCS7C 00856 GO TO P6000-EXIT. DTSCS7C 00857 DTSCS7C 00858 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA. DTSCS7C 00859 DTSCS7C 00860 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS7C 00861 DTSCS7C 00862 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS7C 00863 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS7C 00864 SET MSKL-FSC-88 TO TRUE. DTSCS7C 00865 PERFORM S810-COUNT THRU S810-EXIT. DTSCS7C 00866 DTSCS7C 00867 IF L810-RECORD-CNT = +0 DTSCS7C 00868 IF MPRF-CLASS-UNK-88 DTSCS7C 00869 OR MPRF-CLASS-CHG-ONLY-88 DTSCS7C 00870 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS7C 00871 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS7C 00872 GO TO P6000-EXIT DTSCS7C 00873 ELSE DTSCS7C 00874 IF MPRF-CLASS-SUB-88 DTSCS7C 00875 AND NOT MPRF-ORG-HSEHLD-DMSTIC-88 DTSCS7C 00876 MOVE MSG-E7C7-AREA TO WRK-MSG-AREA DTSCS7C 00877 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS7C 00878 GO TO P6000-EXIT. DTSCS7C 00879 DTSCS7C 00880 MOVE L810-RECORD-CNT TO LAST-REC-NUM. DTSCS7C 00881 MOVE MSKL-KEY-AREA TO LAST-REC-KEY-AREA. DTSCS7C 00882 DTSCS7C 00883 PERFORM P6100-LOCATE-REC THRU P6100-EXIT. DTSCS7C 00884 IF CURSOR-SET-YES DTSCS7C 00885 GO TO P6000-EXIT. DTSCS7C 00886 DTSCS7C 00887 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS7C 00888 DTSCS7C 00889 IF WRK-MFSC-FOUND-YES-88 DTSCS7C 00890 MOVE WRK-PROG-NAME TO LCCM-SCR-HOLD-PROG-NAME DTSCS7C 00891 MOVE SCR-REC-KEY-AREA TO LCCM-SCR-HOLD-KEY DTSCS7C 00892 DTSCS7C 00893 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS7C 00894 P6000-EXIT. DTSCS7C 00895 EXIT. DTSCS7C 00896 EJECT DTSCS7C 00897 DTSCS7C 00898 P6100-LOCATE-REC. DTSCS7C 00899 *------------------------------------------------------------ DTSCS7C 00900 * IF, AT THE LAST USE OF THIS SCREEN, A RECORD FOR DTSCS7C 00901 * EMPLOYER NUMBER LCCM-EMP-NO WAS DISPLAYED ON THE DTSCS7C 00902 * SCREEN, THEN BASE THE PAGING LOGIC ON THE LAST RECORD DTSCS7C 00903 * DISPLAYED ON THIS SCREEN; OTHERWISE, DISPLAY THE DTSCS7C 00904 * RECORD WITH THE GREATEST MFSC-ESTB-DATE DTSCS7C 00905 *------------------------------------------------------------ DTSCS7C 00906 DTSCS7C 00907 SET WRK-MFSC-FOUND-NO-88 TO TRUE. DTSCS7C 00908 DTSCS7C 00909 IF SCR-REC-KEY-AREA = LOW-VALUES DTSCS7C 00910 PERFORM P6110-DEFAULT-PAGE THRU P6110-EXIT DTSCS7C 00911 ELSE DTSCS7C 00912 IF LCCM-ENTER-88 DTSCS7C 00913 PERFORM P6140-READ-FROM-KEY THRU P6140-EXIT DTSCS7C 00914 ELSE DTSCS7C 00915 PERFORM P6130-PAGING THRU P6130-EXIT DTSCS7C 00916 END-IF DTSCS7C 00917 END-IF. DTSCS7C 00918 DTSCS7C 00919 P6100-EXIT. DTSCS7C 00920 EXIT. DTSCS7C 00921 DTSCS7C 00922 P6110-DEFAULT-PAGE. DTSCS7C 00923 MOVE LOW-VALUES TO MFSC-KEY-AREA. DTSCS7C 00924 MOVE WRK-EMP-NO TO MFSC-EMP-NO. DTSCS7C 00925 SET MFSC-FSC-88 TO TRUE. DTSCS7C 00926 MOVE MFSC-KEY-AREA TO MSKL-KEY-AREA. DTSCS7C 00927 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS7C 00928 IF L810-NO-REC-88 DTSCS7C 00929 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS7C 00930 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS7C 00931 GO TO P6110-EXIT DTSCS7C 00932 ELSE DTSCS7C 00933 MOVE +0 TO WRK-REC-NUM DTSCS7C 00934 CURR-REC-NUM DTSCS7C 00935 PERFORM P6111-FIND-RECORD THRU P6111-EXIT DTSCS7C 00936 UNTIL L810-NO-REC-88. DTSCS7C 00937 DTSCS7C 00938 IF SCR-REC-KEY-AREA NOT = LOW-VALUES DTSCS7C 00939 MOVE SCR-REC-KEY-AREA TO MSKL-KEY-AREA DTSCS7C 00940 PERFORM S810-READ THRU S810-EXIT DTSCS7C 00941 MOVE MSKL-REC TO MFSC-REC DTSCS7C 00942 SET WRK-MFSC-FOUND-YES-88 TO TRUE DTSCS7C 00943 ELSE DTSCS7C 00944 MOVE LAST-REC-KEY-AREA TO MSKL-KEY-AREA DTSCS7C 00945 PERFORM S810-READ THRU S810-EXIT DTSCS7C 00946 IF L810-NO-REC-88 DTSCS7C 00947 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS7C 00948 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS7C 00949 ELSE DTSCS7C 00950 MOVE MSKL-REC TO MFSC-REC DTSCS7C 00951 MOVE MSKL-KEY-AREA TO SCR-REC-KEY-AREA DTSCS7C 00952 MOVE LAST-REC-NUM TO WRK-REC-NUM DTSCS7C 00953 SET WRK-MFSC-FOUND-YES-88 TO TRUE. DTSCS7C 00954 DTSCS7C 00955 P6110-EXIT. DTSCS7C 00956 EXIT. DTSCS7C 00957 DTSCS7C 00958 P6111-FIND-RECORD. DTSCS7C 00959 ADD +1 TO CURR-REC-NUM. DTSCS7C 00960 MOVE MSKL-REC TO MFSC-REC. DTSCS7C 00961 DTSCS7C 00962 IF MFSC-STATUS-OPEN-88 DTSCS7C 00963 IF LCCM-YRQ > ZERO DTSCS7C 00964 IF LCCM-YRQ >= MFSC-START-YRQ DTSCS7C 00965 MOVE MSKL-KEY-AREA TO SCR-REC-KEY-AREA DTSCS7C 00966 MOVE CURR-REC-NUM TO WRK-REC-NUM DTSCS7C 00967 END-IF DTSCS7C 00968 ELSE DTSCS7C 00969 MOVE MSKL-KEY-AREA TO SCR-REC-KEY-AREA DTSCS7C 00970 MOVE CURR-REC-NUM TO WRK-REC-NUM DTSCS7C 00971 END-IF DTSCS7C 00972 END-IF. DTSCS7C 00973 DTSCS7C 00974 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS7C 00975 DTSCS7C 00976 P6111-EXIT. DTSCS7C 00977 EXIT. DTSCS7C 00978 DTSCS7C 00979 P6130-PAGING. DTSCS7C 00980 IF LCCM-F05-88 DTSCS7C 00981 PERFORM P6131-READ-FIRST THRU P6131-EXIT DTSCS7C 00982 GO TO P6130-EXIT DTSCS7C 00983 ELSE DTSCS7C 00984 IF LCCM-F06-88 DTSCS7C 00985 PERFORM P6132-READ-LAST THRU P6132-EXIT DTSCS7C 00986 GO TO P6130-EXIT. DTSCS7C 00987 DTSCS7C 00988 PERFORM P6139-FIND-CURRENT THRU P6139-EXIT. DTSCS7C 00989 IF WRK-MFSC-FOUND-NO-88 DTSCS7C 00990 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS7C 00991 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS7C 00992 GO TO P6130-EXIT. DTSCS7C 00993 DTSCS7C 00994 SET WRK-MFSC-FOUND-NO-88 TO TRUE. DTSCS7C 00995 DTSCS7C 00996 IF LCCM-F07-88 DTSCS7C 00997 PERFORM P6133-READ-PREV THRU P6133-EXIT DTSCS7C 00998 ELSE DTSCS7C 00999 IF LCCM-F08-88 DTSCS7C 01000 PERFORM P6134-READ-NEXT THRU P6134-EXIT. DTSCS7C 01001 DTSCS7C 01002 P6130-EXIT. DTSCS7C 01003 EXIT. DTSCS7C 01004 DTSCS7C 01005 P6131-READ-FIRST. DTSCS7C 01006 MOVE LOW-VALUES TO MFSC-KEY-AREA. DTSCS7C 01007 MOVE WRK-EMP-NO TO MFSC-EMP-NO. DTSCS7C 01008 SET MFSC-FSC-88 TO TRUE. DTSCS7C 01009 MOVE MFSC-KEY-AREA TO MSKL-KEY-AREA. DTSCS7C 01010 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS7C 01011 IF L810-NO-REC-88 DTSCS7C 01012 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS7C 01013 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS7C 01014 ELSE DTSCS7C 01015 MOVE +1 TO WRK-REC-NUM DTSCS7C 01016 MOVE MSKL-REC TO MFSC-REC DTSCS7C 01017 MOVE MSKL-KEY-AREA TO SCR-REC-KEY-AREA DTSCS7C 01018 SET WRK-MFSC-FOUND-YES-88 TO TRUE. DTSCS7C 01019 DTSCS7C 01020 P6131-EXIT. DTSCS7C 01021 EXIT. DTSCS7C 01022 DTSCS7C 01023 P6132-READ-LAST. DTSCS7C 01024 MOVE LAST-REC-KEY-AREA TO MSKL-KEY-AREA. DTSCS7C 01025 PERFORM S810-READ THRU S810-EXIT. DTSCS7C 01026 IF L810-NO-REC-88 DTSCS7C 01027 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS7C 01028 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS7C 01029 ELSE DTSCS7C 01030 MOVE MSKL-REC TO MFSC-REC DTSCS7C 01031 MOVE MSKL-KEY-AREA TO SCR-REC-KEY-AREA DTSCS7C 01032 MOVE LAST-REC-NUM TO WRK-REC-NUM DTSCS7C 01033 SET WRK-MFSC-FOUND-YES-88 TO TRUE. DTSCS7C 01034 DTSCS7C 01035 P6132-EXIT. DTSCS7C 01036 EXIT. DTSCS7C 01037 DTSCS7C 01038 P6133-READ-PREV. DTSCS7C 01039 PERFORM S810-READ-PREV THRU S810-EXIT DTSCS7C 01040 IF L810-NO-REC-88 DTSCS7C 01041 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS7C 01042 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS7C 01043 GO TO P6133-EXIT DTSCS7C 01044 ELSE DTSCS7C 01045 PERFORM S810-READ-PREV THRU S810-EXIT DTSCS7C 01046 IF L810-OK-88 DTSCS7C 01047 MOVE MSKL-REC TO MFSC-REC DTSCS7C 01048 SUBTRACT +1 FROM WRK-REC-NUM DTSCS7C 01049 * IF WRK-FILTER-YES-88 DTSCS7C 01050 * PERFORM P6135-FILTER THRU P6135-EXIT DTSCS7C 01051 * END-IF DTSCS7C 01052 ELSE DTSCS7C 01053 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-ID. DTSCS7C 01054 DTSCS7C 01055 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS7C 01056 DTSCS7C 01057 * IF WRK-FILTER-YES-88 DTSCS7C 01058 * IF WRK-MFSC-FOUND-YES-88 DTSCS7C 01059 * MOVE MFSC-KEY-AREA TO SCR-REC-KEY-AREA DTSCS7C 01060 * ELSE DTSCS7C 01061 * PERFORM P6139-FIND-CURRENT THRU P6139-EXIT DTSCS7C 01062 * MOVE PMSG-FIRST-PAGE TO LCCM-MSG-ID DTSCS7C 01063 * END-IF DTSCS7C 01064 * ELSE DTSCS7C 01065 SET WRK-MFSC-FOUND-YES-88 TO TRUE DTSCS7C 01066 MOVE MFSC-KEY-AREA TO SCR-REC-KEY-AREA. DTSCS7C 01067 DTSCS7C 01068 P6133-EXIT. DTSCS7C 01069 EXIT. DTSCS7C 01070 DTSCS7C 01071 DTSCS7C 01072 P6134-READ-NEXT. DTSCS7C 01073 PERFORM S810-READ-NEXT THRU S810-EXIT DTSCS7C 01074 IF L810-OK-88 DTSCS7C 01075 MOVE MSKL-REC TO MFSC-REC DTSCS7C 01076 ADD +1 TO WRK-REC-NUM DTSCS7C 01077 * IF WRK-FILTER-YES-88 DTSCS7C 01078 * PERFORM P6135-FILTER THRU P6135-EXIT DTSCS7C 01079 * END-IF DTSCS7C 01080 ELSE DTSCS7C 01081 MOVE PMSG-LAST-PAGE TO LCCM-MSG-ID. DTSCS7C 01082 DTSCS7C 01083 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS7C 01084 DTSCS7C 01085 * IF WRK-FILTER-YES-88 DTSCS7C 01086 * IF WRK-MFSC-FOUND-YES-88 DTSCS7C 01087 * MOVE MFSC-KEY-AREA TO SCR-REC-KEY-AREA DTSCS7C 01088 * ELSE DTSCS7C 01089 * PERFORM P6139-FIND-CURRENT THRU P6139-EXIT DTSCS7C 01090 * MOVE PMSG-LAST-PAGE TO LCCM-MSG-ID DTSCS7C 01091 * END-IF DTSCS7C 01092 * ELSE DTSCS7C 01093 SET WRK-MFSC-FOUND-YES-88 TO TRUE DTSCS7C 01094 MOVE MFSC-KEY-AREA TO SCR-REC-KEY-AREA. DTSCS7C 01095 P6134-EXIT. DTSCS7C 01096 EXIT. DTSCS7C 01097 DTSCS7C 01098 *P6135-FILTER. DTSCS7C 01099 * IF WRK-STATUS-CD NOT = SPACES DTSCS7C 01100 * IF WRK-STATUS-CD = MFSC-STATUS-CD DTSCS7C 01101 * SET WRK-MFSC-FOUND-YES-88 TO TRUE DTSCS7C 01102 * END-IF DTSCS7C 01103 * END-IF. DTSCS7C 01104 * DTSCS7C 01105 * IF WRK-ABS-QTR NOT = ZERO DTSCS7C 01106 * IF WRK-MFSC-FOUND-YES-88 DTSCS7C 01107 * OR WRK-STATUS-CD = SPACES DTSCS7C 01108 * IF WRK-ABS-QTR = MFSC-ABS-QTR DTSCS7C 01109 * SET WRK-MFSC-FOUND-YES-88 TO TRUE DTSCS7C 01110 * ELSE DTSCS7C 01111 * SET WRK-MFSC-FOUND-NO-88 TO TRUE DTSCS7C 01112 * END-IF DTSCS7C 01113 * END-IF DTSCS7C 01114 * END-IF. DTSCS7C 01115 * DTSCS7C 01116 *P6135-EXIT. DTSCS7C 01117 * EXIT. DTSCS7C 01118 ******************************************************************DTSCS7C 01119 * SCAN MFSC TO FIND CURRENT RECORD (WHOSE VALUE IS IN *DTSCS7C 01120 * SCR-REC-KEY-AREA). THIS PARAGRAPH SETS WRK-REC-NUM, WHICH DTSCS7C 01121 * IS USED TO DISPLAY THE CURRENT PAGE NUMBER. DTSCS7C 01122 ******************************************************************DTSCS7C 01123 P6139-FIND-CURRENT. DTSCS7C 01124 DTSCS7C 01125 MOVE LOW-VALUES TO MFSC-KEY-AREA. DTSCS7C 01126 MOVE WRK-EMP-NO TO MFSC-EMP-NO. DTSCS7C 01127 SET MFSC-FSC-88 TO TRUE. DTSCS7C 01128 MOVE MFSC-KEY-AREA TO MSKL-KEY-AREA. DTSCS7C 01129 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS7C 01130 IF L810-NO-REC-88 DTSCS7C 01131 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS7C 01132 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS7C 01133 GO TO P6139-EXIT. DTSCS7C 01134 DTSCS7C 01135 MOVE +1 TO WRK-REC-NUM. DTSCS7C 01136 PERFORM DTSCS7C 01137 UNTIL MSKL-KEY-AREA = SCR-REC-KEY-AREA DTSCS7C 01138 OR L810-NO-REC-88 DTSCS7C 01139 PERFORM S810-READ-NEXT THRU S810-EXIT DTSCS7C 01140 IF L810-OK-88 DTSCS7C 01141 ADD +1 TO WRK-REC-NUM DTSCS7C 01142 END-IF DTSCS7C 01143 END-PERFORM. DTSCS7C 01144 DTSCS7C 01145 IF MSKL-KEY-AREA = SCR-REC-KEY-AREA DTSCS7C 01146 SET WRK-MFSC-FOUND-YES-88 TO TRUE DTSCS7C 01147 MOVE MSKL-REC TO MFSC-REC DTSCS7C 01148 END-IF. DTSCS7C 01149 DTSCS7C 01150 P6139-EXIT. DTSCS7C 01151 EXIT. DTSCS7C 01152 DTSCS7C 01153 P6140-READ-FROM-KEY. DTSCS7C 01154 PERFORM P6139-FIND-CURRENT THRU P6139-EXIT. DTSCS7C 01155 IF WRK-MFSC-FOUND-NO-88 DTSCS7C 01156 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS7C 01157 PERFORM S1199-ERROR THRU S1199-EXIT. DTSCS7C 01158 DTSCS7C 01159 P6140-EXIT. DTSCS7C 01160 EXIT. DTSCS7C 01161 DTSCS7C 01162 /*****************************************************************DTSCS7C 01163 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCS7C 01164 ******************************************************************DTSCS7C 01165 DTSCS7C 01166 P6900-CONSTRUCT-SCREEN. DTSCS7C 01167 PERFORM P6910-FROM-MPRF THRU P6910-EXIT. DTSCS7C 01168 PERFORM P6920-FROM-MFSC THRU P6920-EXIT. DTSCS7C 01169 PERFORM P6990-PAGE-NUMBER THRU P6990-EXIT. DTSCS7C 01170 DTSCS7C 01171 P6900-EXIT. DTSCS7C 01172 EXIT. DTSCS7C 01173 DTSCS7C 01174 P6910-FROM-MPRF. DTSCS7C 01175 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME. DTSCS7C 01176 DTSCS7C 01177 ** THE FOLLOWING FIELDS REMOVED. THE GENERAL CONSEL DECIDED DTSCS7C 01178 ** THAT ANNUAL FILING CANNOT BE DENIED BECAUSE OF DELINQUENCY DTSCS7C 01179 ** 1/17/2002 - GD DTSCS7C 01180 * IF MPRF-TOT-BALANCE-AMT > +0 DTSCS7C 01181 * MOVE MPRF-TOT-BALANCE-AMT TO MAP-BAL-DUE-Z DTSCS7C 01182 * ELSE DTSCS7C 01183 * MOVE SPACES TO MAP-BAL-DUE. DTSCS7C 01184 * DTSCS7C 01185 * IF MPRF-PURSUED-RPT-CNT > +0 DTSCS7C 01186 * MOVE MPRF-PURSUED-RPT-CNT TO MAP-RPT-DUE-Z DTSCS7C 01187 * ELSE DTSCS7C 01188 * MOVE SPACES TO MAP-RPT-DUE. DTSCS7C 01189 DTSCS7C 01190 P6910-EXIT. DTSCS7C 01191 EXIT. DTSCS7C 01192 DTSCS7C 01193 P6920-FROM-MFSC. DTSCS7C 01194 MOVE MFSC-STATUS-CD TO MAP-STATUS-CD. DTSCS7C 01195 DTSCS7C 01196 IF MFSC-START-YRQ > 0 DTSCS7C 01197 MOVE MFSC-START-YRQ TO WRK-DISPLAY DTSCS7C 01198 MOVE WRK-DISPLAY-YRQ-YY TO MAP-START-YY DTSCS7C 01199 MOVE WRK-DISPLAY-YRQ-Q TO MAP-START-Q. DTSCS7C 01200 DTSCS7C 01201 IF MFSC-END-YRQ > 0 AND < WRK-ALL-NINES-YRQ DTSCS7C 01202 MOVE MFSC-END-YRQ TO WRK-DISPLAY DTSCS7C 01203 MOVE WRK-DISPLAY-YRQ-YY TO MAP-END-YY DTSCS7C 01204 MOVE WRK-DISPLAY-YRQ-Q TO MAP-END-Q. DTSCS7C 01205 DTSCS7C 01206 MOVE MFSC-FILING-SCHEDULE-CD DTSCS7C 01207 TO MAP-FILE-SCHED. DTSCS7C 01208 DTSCS7C 01209 MOVE MFSC-REQUEST-TYPE-CD TO MAP-REQ-TYPE-CD. DTSCS7C 01210 DTSCS7C 01211 ** MOVE MFSC-CHANGE-REASON-CD TO MAP-CHNG-REASN-CD. DTSCS7C 01212 DTSCS7C 01213 IF MFSC-INITIAL-MAIL-DATE > ZERO DTSCS7C 01214 MOVE MFSC-INITIAL-MAIL-DATE TO WRK-DISPLAY DTSCS7C 01215 MOVE WRK-DISPLAY-YR TO MAP-INIT-MAIL-YY DTSCS7C 01216 MOVE WRK-DISPLAY-MO TO MAP-INIT-MAIL-MM DTSCS7C 01217 MOVE WRK-DISPLAY-DA TO MAP-INIT-MAIL-DD. DTSCS7C 01218 DTSCS7C 01219 MOVE MFSC-INIT-NOTICE-TYPE TO MAP-INIT-LTR-TYPE. DTSCS7C 01220 DTSCS7C 01221 IF MFSC-CONFIRM-MAIL-DATE > ZERO DTSCS7C 01222 MOVE MFSC-CONFIRM-MAIL-DATE TO WRK-DISPLAY DTSCS7C 01223 MOVE WRK-DISPLAY-YR TO MAP-CONF-MAIL-YY DTSCS7C 01224 MOVE WRK-DISPLAY-MO TO MAP-CONF-MAIL-MM DTSCS7C 01225 MOVE WRK-DISPLAY-DA TO MAP-CONF-MAIL-DD. DTSCS7C 01226 DTSCS7C 01227 MOVE MFSC-CONFIRM-NOTICE-TYPE TO MAP-CONF-LTR-TYPE. DTSCS7C 01228 DTSCS7C 01229 *& IF MFSC-DENIAL-MAIL-DATE > ZERO DTSCS7C 01230 * MOVE MFSC-DENIAL-MAIL-DATE TO WRK-DISPLAY DTSCS7C 01231 * MOVE WRK-DISPLAY-YR TO MAP-DENY-MAIL-YY DTSCS7C 01232 * MOVE WRK-DISPLAY-MO TO MAP-DENY-MAIL-MM DTSCS7C 01233 * MOVE WRK-DISPLAY-DA TO MAP-DENY-MAIL-DD. DTSCS7C 01234 * DTSCS7C 01235 * MOVE MFSC-DENIAL-NOTICE-TYPE TO MAP-DENY-LTR-TYPE. DTSCS7C 01236 DTSCS7C 01237 PERFORM DTSCS7C 01238 VARYING WRK-OCC FROM 1 BY 1 DTSCS7C 01239 UNTIL WRK-OCC > MFSC-NOTE-CNT DTSCS7C 01240 MOVE MFSC-NOTE (WRK-OCC) TO MAP-TEXT(WRK-OCC) DTSCS7C 01241 END-PERFORM. DTSCS7C 01242 DTSCS7C 01243 P6920-EXIT. DTSCS7C 01244 EXIT. DTSCS7C 01245 DTSCS7C 01246 P6990-PAGE-NUMBER. DTSCS7C 01247 MOVE WRK-REC-NUM TO WRK-REC-NUM-DISP. DTSCS7C 01248 MOVE LAST-REC-NUM TO LAST-REC-NUM-DISP. DTSCS7C 01249 MOVE WRK-REC-NUM-DISP TO MAP-PAGE-NO. DTSCS7C 01250 MOVE LAST-REC-NUM-DISP TO MAP-TOT-PAGES. DTSCS7C 01251 DTSCS7C 01252 P6990-EXIT. DTSCS7C 01253 EXIT. DTSCS7C 01254 DTSCS7C 01255 /*****************************************************************DTSCS7C 01256 * FUNCTION KEY TO ADD OR MOD THE RECORD WAS PRESSED. *DTSCS7C 01257 ******************************************************************DTSCS7C 01258 DTSCS7C 01259 P7000-REQUEST-EDIT. DTSCS7C 01260 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS7C 01261 DTSCS7C 01262 IF LCCM-F09-88 DTSCS7C 01263 PERFORM P7100-EDIT-ADD THRU P7100-EXIT DTSCS7C 01264 ELSE DTSCS7C 01265 IF LCCM-F10-88 DTSCS7C 01266 PERFORM P7200-EDIT-MOD THRU P7200-EXIT DTSCS7C 01267 ELSE DTSCS7C 01268 IF LCCM-F23-88 DTSCS7C 01269 PERFORM P7300-EDIT-DEL THRU P7300-EXIT DTSCS7C 01270 ELSE DTSCS7C 01271 GO TO S899-ABEND. DTSCS7C 01272 DTSCS7C 01273 *------------------------------------------------------ DTSCS7C 01274 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCS7C 01275 * IN ORDER TO CONTINUE TO ATTEMPT A MOD THE SCREEN MUST DTSCS7C 01276 * REMAIN IN 'INQUIRE' STATUS. DTSCS7C 01277 *------------------------------------------------------ DTSCS7C 01278 DTSCS7C 01279 IF LCCM-MSG DTSCS7C 01280 NEXT SENTENCE DTSCS7C 01281 ELSE DTSCS7C 01282 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCS7C 01283 IF LCCM-F09-88 DTSCS7C 01284 SET LCCM-SCR-ADD-LOCKED TO TRUE DTSCS7C 01285 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS7C 01286 ELSE DTSCS7C 01287 IF LCCM-F10-88 DTSCS7C 01288 SET LCCM-SCR-MOD-LOCKED TO TRUE DTSCS7C 01289 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS7C 01290 ELSE DTSCS7C 01291 IF LCCM-F23-88 DTSCS7C 01292 SET LCCM-SCR-DEL-LOCKED TO TRUE DTSCS7C 01293 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID. DTSCS7C 01294 DTSCS7C 01295 SET RESP-SEND-MAP TO TRUE. DTSCS7C 01296 P7000-EXIT. DTSCS7C 01297 EXIT. DTSCS7C 01298 /*****************************************************************DTSCS7C 01299 * ADD FUNCTION WAS REQUESTED *DTSCS7C 01300 ******************************************************************DTSCS7C 01301 DTSCS7C 01302 P7100-EDIT-ADD. DTSCS7C 01303 *----------------------------------------------------- DTSCS7C 01304 * ADDITION REQUIRES THAT THE SCREEN WAS CLEARED FIRST DTSCS7C 01305 *----------------------------------------------------- DTSCS7C 01306 IF NOT LCCM-SCR-CLEAR DTSCS7C 01307 MOVE EMSG-ADD-PRECEDED TO LCCM-MSG-ID DTSCS7C 01308 GO TO P7100-EXIT. DTSCS7C 01309 DTSCS7C 01310 PERFORM S1101-EMP-NO THRU S1101-EXIT. DTSCS7C 01311 IF LCCM-MSG DTSCS7C 01312 GO TO P7100-EXIT. DTSCS7C 01313 DTSCS7C 01314 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS7C 01315 DTSCS7C 01316 P7100-EXIT. DTSCS7C 01317 EXIT. DTSCS7C 01318 /*****************************************************************DTSCS7C 01319 * MODIFICATION FUNCTION WAS REQUESTED *DTSCS7C 01320 ******************************************************************DTSCS7C 01321 DTSCS7C 01322 P7200-EDIT-MOD. DTSCS7C 01323 *----------------------------------------------------- DTSCS7C 01324 * MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS7C 01325 * INQUIRED DTSCS7C 01326 *----------------------------------------------------- DTSCS7C 01327 IF NOT LCCM-SCR-INQUIRE DTSCS7C 01328 MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-ID DTSCS7C 01329 GO TO P7200-EXIT. DTSCS7C 01330 DTSCS7C 01331 PERFORM S1101-EMP-NO THRU S1101-EXIT. DTSCS7C 01332 IF LCCM-MSG DTSCS7C 01333 GO TO P7200-EXIT. DTSCS7C 01334 DTSCS7C 01335 MOVE LCCM-SCR-HOLD-KEY TO SCR-REC-KEY-AREA. DTSCS7C 01336 DTSCS7C 01337 PERFORM S1120-READ-MFSC THRU S1120-EXIT. DTSCS7C 01338 IF LCCM-MSG DTSCS7C 01339 GO TO P7200-EXIT. DTSCS7C 01340 DTSCS7C 01341 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS7C 01342 DTSCS7C 01343 P7200-EXIT. DTSCS7C 01344 EXIT. DTSCS7C 01345 /*****************************************************************DTSCS7C 01346 * DELETE FUNCTION WAS REQUESTED * DTSCS7C 01347 ******************************************************************DTSCS7C 01348 DTSCS7C 01349 P7300-EDIT-DEL. DTSCS7C 01350 *----------------------------------------------------- DTSCS7C 01351 * DELETE REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS7C 01352 * INQUIRED DTSCS7C 01353 *----------------------------------------------------- DTSCS7C 01354 IF NOT LCCM-SCR-INQUIRE DTSCS7C 01355 MOVE EMSG-DEL-PRECEDED TO LCCM-MSG-ID DTSCS7C 01356 GO TO P7300-EXIT. DTSCS7C 01357 DTSCS7C 01358 *----------------------------------------------------- DTSCS7C 01359 * MAP-EMP-NO MAY NOT BE CHANGED DURING THE DELETE DTSCS7C 01360 *----------------------------------------------------- DTSCS7C 01361 PERFORM S1101-EMP-NO THRU S1101-EXIT. DTSCS7C 01362 IF LCCM-MSG DTSCS7C 01363 GO TO P7300-EXIT. DTSCS7C 01364 DTSCS7C 01365 IF LCCM-EMP-NO NOT = WRK-EMP-NO DTSCS7C 01366 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS7C 01367 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS7C 01368 GO TO P7300-EXIT. DTSCS7C 01369 DTSCS7C 01370 IF MPRF-ORG-HSEHLD-DMSTIC-88 DTSCS7C 01371 MOVE MSG-E7CG-AREA TO WRK-MSG-AREA DTSCS7C 01372 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS7C 01373 END-IF. DTSCS7C 01374 DTSCS7C 01375 P7300-EXIT. DTSCS7C 01376 EXIT. DTSCS7C 01377 /*****************************************************************DTSCS7C 01378 * THE UPDATE/ADD FUNCTION WAS CONFIRMED OR CANCELED * DTSCS7C 01379 ******************************************************************DTSCS7C 01380 DTSCS7C 01381 P8000-REQUEST-UPDATE. DTSCS7C 01382 IF LCCM-SCR-ADD-LOCKED DTSCS7C 01383 PERFORM P8100-ADD THRU P8100-EXIT DTSCS7C 01384 ELSE DTSCS7C 01385 IF LCCM-SCR-MOD-LOCKED DTSCS7C 01386 PERFORM P8200-MOD THRU P8200-EXIT DTSCS7C 01387 ELSE DTSCS7C 01388 IF LCCM-SCR-DEL-LOCKED DTSCS7C 01389 PERFORM P8300-DEL THRU P8300-EXIT DTSCS7C 01390 ELSE DTSCS7C 01391 GO TO S899-ABEND. DTSCS7C 01392 DTSCS7C 01393 SET RESP-SEND-MAP TO TRUE. DTSCS7C 01394 P8000-EXIT. DTSCS7C 01395 EXIT. DTSCS7C 01396 /*****************************************************************DTSCS7C 01397 * *DTSCS7C 01398 ******************************************************************DTSCS7C 01399 DTSCS7C 01400 P8100-ADD. DTSCS7C 01401 SET LCCM-SCR-CLEAR TO TRUE. DTSCS7C 01402 DTSCS7C 01403 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS7C 01404 DTSCS7C 01405 IF LCCM-F12-88 DTSCS7C 01406 MOVE PMSG-ADD-CANCELED TO LCCM-MSG-ID DTSCS7C 01407 GO TO P8100-EXIT. DTSCS7C 01408 DTSCS7C 01409 PERFORM S1101-EMP-NO THRU S1101-EXIT. DTSCS7C 01410 IF LCCM-MSG DTSCS7C 01411 GO TO P8100-EXIT. DTSCS7C 01412 DTSCS7C 01413 PERFORM S1103-START-YRQ THRU S1103-EXIT. DTSCS7C 01414 IF LCCM-MSG DTSCS7C 01415 GO TO P8100-EXIT. DTSCS7C 01416 DTSCS7C 01417 MOVE LOW-VALUES TO PRIOR-REC-KEY-AREA. DTSCS7C 01418 PERFORM P8110-FIND-PRIOR-MFSC THRU P8110-EXIT. DTSCS7C 01419 DTSCS7C 01420 MOVE 'A' TO L221-UPDATE-FUNCTION. DTSCS7C 01421 DTSCS7C 01422 PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS7C 01423 DTSCS7C 01424 IF LCCM-MSG DTSCS7C 01425 GO TO P8100-EXIT. DTSCS7C 01426 DTSCS7C 01427 PERFORM P8120-CONSTRUCT-MFSC THRU P8120-EXIT. DTSCS7C 01428 DTSCS7C 01429 PERFORM P8130-ADD-T001 THRU P8130-EXIT. DTSCS7C 01430 DTSCS7C 01431 PERFORM P8940-CHK-ESTIM-RATE THRU P8940-EXIT. DTSCS7C 01432 DTSCS7C 01433 MOVE MFSC-KEY-AREA TO SCR-REC-KEY-AREA. DTSCS7C 01434 MOVE WRK-PROG-NAME TO LCCM-SCR-HOLD-PROG-NAME. DTSCS7C 01435 MOVE SCR-REC-KEY-AREA TO LCCM-SCR-HOLD-KEY. DTSCS7C 01436 DTSCS7C 01437 IF PRIOR-REC-KEY-AREA NOT = LOW-VALUES DTSCS7C 01438 PERFORM P8920-UPD-PRIOR-MFSC THRU P8920-EXIT. DTSCS7C 01439 DTSCS7C 01440 PERFORM P8910-CHK-T031 THRU P8910-EXIT. DTSCS7C 01441 DTSCS7C 01442 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS7C 01443 DTSCS7C 01444 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS7C 01445 SET LCCM-ENTER-88 TO TRUE. DTSCS7C 01446 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT. DTSCS7C 01447 DTSCS7C 01448 MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS7C 01449 DTSCS7C 01450 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS7C 01451 DTSCS7C 01452 P8100-EXIT. DTSCS7C 01453 EXIT. DTSCS7C 01454 DTSCS7C 01455 P8110-FIND-PRIOR-MFSC. DTSCS7C 01456 MOVE LOW-VALUES TO PRIOR-REC-KEY-AREA. DTSCS7C 01457 MOVE ZERO TO WRK-PRIOR-YRQ DTSCS7C 01458 WRK-PRIOR-SCHED. DTSCS7C 01459 DTSCS7C 01460 IF MAP-STATUS-OPEN-88 DTSCS7C 01461 NEXT SENTENCE DTSCS7C 01462 ELSE DTSCS7C 01463 GO TO P8110-EXIT. DTSCS7C 01464 DTSCS7C 01465 MOVE LOW-VALUES TO MFSC-KEY-AREA. DTSCS7C 01466 MOVE WRK-EMP-NO TO MFSC-EMP-NO. DTSCS7C 01467 SET MFSC-FSC-88 TO TRUE. DTSCS7C 01468 MOVE MFSC-KEY-AREA TO MSKL-KEY-AREA. DTSCS7C 01469 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS7C 01470 IF L810-NO-REC-88 DTSCS7C 01471 GO TO P8110-EXIT. DTSCS7C 01472 DTSCS7C 01473 PERFORM DTSCS7C 01474 UNTIL L810-NO-REC-88 DTSCS7C 01475 MOVE MSKL-REC TO MFSC-REC DTSCS7C 01476 IF MFSC-STATUS-OPEN-88 DTSCS7C 01477 MOVE MFSC-KEY-AREA TO PRIOR-REC-KEY-AREA DTSCS7C 01478 MOVE MFSC-START-YRQ TO WRK-PRIOR-YRQ DTSCS7C 01479 MOVE MFSC-FILING-SCHEDULE-CD DTSCS7C 01480 TO WRK-PRIOR-SCHED DTSCS7C 01481 END-IF DTSCS7C 01482 PERFORM S810-READ-NEXT THRU S810-EXIT DTSCS7C 01483 END-PERFORM. DTSCS7C 01484 DTSCS7C 01485 P8110-EXIT. DTSCS7C 01486 EXIT. DTSCS7C 01487 DTSCS7C 01488 P8120-CONSTRUCT-MFSC. DTSCS7C 01489 MOVE LOW-VALUES TO MFSC-REC. DTSCS7C 01490 DTSCS7C 01491 MOVE WRK-EMP-NO TO MFSC-EMP-NO. DTSCS7C 01492 DTSCS7C 01493 SET MFSC-FSC-88 TO TRUE. DTSCS7C 01494 DTSCS7C 01495 MOVE WRK-ABS-QTR TO MFSC-ABS-QTR. DTSCS7C 01496 DTSCS7C 01497 MOVE LCCM-TASK-START-ABSTIME TO MFSC-ABSTIME. DTSCS7C 01498 DTSCS7C 01499 MOVE +0 TO MFSC-PURGE-DATE. DTSCS7C 01500 DTSCS7C 01501 MOVE MAP-STATUS-CD TO MFSC-STATUS-CD. DTSCS7C 01502 DTSCS7C 01503 MOVE WRK-START-YRQ TO MFSC-START-YRQ. DTSCS7C 01504 DTSCS7C 01505 MOVE WRK-ALL-NINES-YRQ TO MFSC-END-YRQ. DTSCS7C 01506 DTSCS7C 01507 MOVE MAP-FILE-SCHED TO MFSC-FILING-SCHEDULE-CD. DTSCS7C 01508 DTSCS7C 01509 MOVE MAP-REQ-TYPE-CD TO MFSC-REQUEST-TYPE-CD. DTSCS7C 01510 DTSCS7C 01511 MOVE SPACES TO MFSC-CHANGE-REASON-CD DTSCS7C 01512 MFSC-INIT-NOTICE-TYPE DTSCS7C 01513 MFSC-CONFIRM-NOTICE-TYPE DTSCS7C 01514 MFSC-DENIAL-NOTICE-TYPE. DTSCS7C 01515 DTSCS7C 01516 MOVE ZERO TO MFSC-INITIAL-MAIL-DATE DTSCS7C 01517 MFSC-CONFIRM-MAIL-DATE DTSCS7C 01518 MFSC-DENIAL-MAIL-DATE. DTSCS7C 01519 DTSCS7C 01520 MOVE LCCM-CURR-RUN-DATE TO MFSC-ESTB-DATE. DTSCS7C 01521 DTSCS7C 01522 MOVE LCCM-CURR-RUN-DATE TO MFSC-CHNG-DATE. DTSCS7C 01523 DTSCS7C 01524 MOVE LCCM-OP-ID TO MFSC-CHNG-OP-ID. DTSCS7C 01525 DTSCS7C 01526 MOVE +0 TO MFSC-NOTE-CNT. DTSCS7C 01527 DTSCS7C 01528 PERFORM DTSCS7C 01529 VARYING WRK-OCC FROM 1 BY 1 DTSCS7C 01530 UNTIL WRK-OCC > MMAX-FSC-TEXT-MAX DTSCS7C 01531 MOVE MAP-TEXT(WRK-OCC) DTSCS7C 01532 TO MFSC-NOTE(WRK-OCC) DTSCS7C 01533 IF MAP-TEXT(WRK-OCC) NOT = SPACES DTSCS7C 01534 MOVE WRK-OCC TO MFSC-NOTE-CNT DTSCS7C 01535 END-IF DTSCS7C 01536 END-PERFORM. DTSCS7C 01537 DTSCS7C 01538 MOVE MFSC-REC TO MSKL-REC. DTSCS7C 01539 DTSCS7C 01540 PERFORM S810-WRITE THRU S810-EXIT. DTSCS7C 01541 DTSCS7C 01542 P8120-EXIT. DTSCS7C 01543 EXIT. DTSCS7C 01544 DTSCS7C 01545 P8130-ADD-T001. DTSCS7C 01546 IF MFSC-STATUS-PENDING-88 DTSCS7C 01547 SET WRK-T001-EMP-REQUEST-88 TO TRUE DTSCS7C 01548 PERFORM S825-WRITE-T001 THRU S825-EXIT DTSCS7C 01549 ELSE DTSCS7C 01550 IF MFSC-STATUS-OPEN-88 DTSCS7C 01551 IF MFSC-FILING-SCHED-QTR-88 DTSCS7C 01552 SET WRK-T001-CONFIRM-QTR-88 TO TRUE DTSCS7C 01553 PERFORM S825-WRITE-T001 THRU S825-EXIT DTSCS7C 01554 ELSE DTSCS7C 01555 IF MFSC-FILING-SCHED-ANN-88 DTSCS7C 01556 SET WRK-T001-CONFIRM-ANN-88 TO TRUE DTSCS7C 01557 PERFORM S825-WRITE-T001 THRU S825-EXIT DTSCS7C 01558 END-IF DTSCS7C 01559 END-IF DTSCS7C 01560 ELSE DTSCS7C 01561 GO TO P8130-EXIT DTSCS7C 01562 END-IF. DTSCS7C 01563 DTSCS7C 01564 DTSCS7C 01565 P8130-EXIT. DTSCS7C 01566 EXIT. DTSCS7C 01567 DTSCS7C 01568 /*****************************************************************DTSCS7C 01569 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS7C 01570 ******************************************************************DTSCS7C 01571 DTSCS7C 01572 P8200-MOD. DTSCS7C 01573 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS7C 01574 DTSCS7C 01575 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS7C 01576 DTSCS7C 01577 IF LCCM-F12-88 DTSCS7C 01578 MOVE PMSG-MOD-CANCELED TO LCCM-MSG-ID DTSCS7C 01579 GO TO P8200-EXIT. DTSCS7C 01580 DTSCS7C 01581 MOVE LCCM-SCR-HOLD-KEY TO SCR-REC-KEY-AREA. DTSCS7C 01582 PERFORM S1120-READ-MFSC THRU S1120-EXIT. DTSCS7C 01583 IF LCCM-MSG DTSCS7C 01584 GO TO P8200-EXIT. DTSCS7C 01585 DTSCS7C 01586 PERFORM S1101-EMP-NO THRU S1101-EXIT. DTSCS7C 01587 PERFORM S1103-START-YRQ THRU S1103-EXIT. DTSCS7C 01588 DTSCS7C 01589 MOVE LOW-VALUES TO PRIOR-REC-KEY-AREA. DTSCS7C 01590 *** IF MFSC-STATUS-CD NOT = MAP-STATUS-CD DTSCS7C 01591 IF MAP-STATUS-OPEN-88 DTSCS7C 01592 OR MAP-STATUS-WITHDRAWN-88 DTSCS7C 01593 PERFORM P8210-FIND-PRIOR-MFSC THRU P8210-EXIT. DTSCS7C 01594 DTSCS7C 01595 MOVE 'M' TO L221-UPDATE-FUNCTION. DTSCS7C 01596 PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS7C 01597 IF LCCM-MSG DTSCS7C 01598 GO TO P8200-EXIT. DTSCS7C 01599 DTSCS7C 01600 PERFORM S1120-READ-MFSC THRU S1120-EXIT. DTSCS7C 01601 IF LCCM-MSG DTSCS7C 01602 PERFORM S221-EMP-UNLOCK THRU S221-EXIT DTSCS7C 01603 GO TO P8200-EXIT. DTSCS7C 01604 DTSCS7C 01605 SET WRK-T001-NULL-88 TO TRUE. DTSCS7C 01606 PERFORM P8220-CHECK-T001 THRU P8220-EXIT. DTSCS7C 01607 DTSCS7C 01608 PERFORM P8230-MODIFY-MFSC THRU P8230-EXIT. DTSCS7C 01609 DTSCS7C 01610 PERFORM P8940-CHK-ESTIM-RATE THRU P8940-EXIT. DTSCS7C 01611 DTSCS7C 01612 IF NOT WRK-T001-NULL-88 DTSCS7C 01613 PERFORM S825-WRITE-T001 THRU S825-EXIT. DTSCS7C 01614 DTSCS7C 01615 IF PRIOR-REC-KEY-AREA NOT = LOW-VALUES DTSCS7C 01616 PERFORM P8920-UPD-PRIOR-MFSC THRU P8920-EXIT DTSCS7C 01617 ELSE DTSCS7C 01618 IF MAP-STATUS-WITHDRAWN-88 DTSCS7C 01619 PERFORM P8930-ADD-MFSC THRU P8930-EXIT. DTSCS7C 01620 DTSCS7C 01621 PERFORM P8910-CHK-T031 THRU P8910-EXIT. DTSCS7C 01622 DTSCS7C 01623 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS7C 01624 DTSCS7C 01625 MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS7C 01626 DTSCS7C 01627 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS7C 01628 P8200-EXIT. DTSCS7C 01629 EXIT. DTSCS7C 01630 EJECT DTSCS7C 01631 P8210-FIND-PRIOR-MFSC. DTSCS7C 01632 MOVE ZERO TO WRK-PRIOR-YRQ DTSCS7C 01633 WRK-PRIOR-SCHED. DTSCS7C 01634 DTSCS7C 01635 MOVE LOW-VALUES TO MFSC-KEY-AREA. DTSCS7C 01636 MOVE WRK-EMP-NO TO MFSC-EMP-NO. DTSCS7C 01637 SET MFSC-FSC-88 TO TRUE. DTSCS7C 01638 MOVE MFSC-KEY-AREA TO MSKL-KEY-AREA. DTSCS7C 01639 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS7C 01640 IF L810-NO-REC-88 DTSCS7C 01641 GO TO P8210-EXIT. DTSCS7C 01642 DTSCS7C 01643 PERFORM DTSCS7C 01644 UNTIL L810-NO-REC-88 DTSCS7C 01645 MOVE MSKL-REC TO MFSC-REC DTSCS7C 01646 IF MFSC-STATUS-OPEN-88 DTSCS7C 01647 IF MFSC-ABS-QTR < WRK-ABS-QTR DTSCS7C 01648 MOVE MFSC-KEY-AREA TO PRIOR-REC-KEY-AREA DTSCS7C 01649 MOVE MFSC-START-YRQ TO WRK-PRIOR-YRQ DTSCS7C 01650 MOVE MFSC-FILING-SCHEDULE-CD DTSCS7C 01651 TO WRK-PRIOR-SCHED DTSCS7C 01652 END-IF DTSCS7C 01653 END-IF DTSCS7C 01654 PERFORM S810-READ-NEXT THRU S810-EXIT DTSCS7C 01655 END-PERFORM. DTSCS7C 01656 DTSCS7C 01657 P8210-EXIT. DTSCS7C 01658 EXIT. DTSCS7C 01659 DTSCS7C 01660 P8220-CHECK-T001. DTSCS7C 01661 IF MAP-STATUS-CD = MFSC-STATUS-CD DTSCS7C 01662 GO TO P8220-EXIT. DTSCS7C 01663 DTSCS7C 01664 IF MAP-STATUS-OPEN-88 DTSCS7C 01665 IF MAP-FILE-SCHED-QTR-88 DTSCS7C 01666 SET WRK-T001-CONFIRM-QTR-88 TO TRUE DTSCS7C 01667 ELSE DTSCS7C 01668 IF MAP-FILE-SCHED-ANN-88 DTSCS7C 01669 SET WRK-T001-CONFIRM-ANN-88 TO TRUE DTSCS7C 01670 END-IF DTSCS7C 01671 END-IF DTSCS7C 01672 *& ELSE DTSCS7C 01673 * IF MAP-STATUS-DENIED-88 DTSCS7C 01674 * SET WRK-T001-ADMIN-DELQNT-88 TO TRUE DTSCS7C 01675 * END-IF DTSCS7C 01676 END-IF. DTSCS7C 01677 DTSCS7C 01678 DTSCS7C 01679 P8220-EXIT. DTSCS7C 01680 EXIT. DTSCS7C 01681 DTSCS7C 01682 P8230-MODIFY-MFSC. DTSCS7C 01683 PERFORM P8700-COMMON-MOVES THRU P8700-EXIT. DTSCS7C 01684 DTSCS7C 01685 MOVE LCCM-CURR-RUN-DATE TO MFSC-CHNG-DATE. DTSCS7C 01686 MOVE LCCM-OP-ID TO MFSC-CHNG-OP-ID. DTSCS7C 01687 DTSCS7C 01688 MOVE MFSC-REC TO MSKL-REC. DTSCS7C 01689 DTSCS7C 01690 PERFORM S810-REWRITE THRU S810-EXIT. DTSCS7C 01691 P8230-EXIT. DTSCS7C 01692 EXIT. DTSCS7C 01693 DTSCS7C 01694 P8300-DEL. DTSCS7C 01695 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS7C 01696 DTSCS7C 01697 IF LCCM-F12-88 DTSCS7C 01698 MOVE PMSG-DEL-CANCELED TO LCCM-MSG-ID DTSCS7C 01699 GO TO P8300-EXIT. DTSCS7C 01700 DTSCS7C 01701 PERFORM S1101-EMP-NO THRU S1101-EXIT. DTSCS7C 01702 DTSCS7C 01703 MOVE 'D' TO L221-UPDATE-FUNCTION. DTSCS7C 01704 PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS7C 01705 IF LCCM-MSG DTSCS7C 01706 GO TO P8300-EXIT. DTSCS7C 01707 DTSCS7C 01708 PERFORM S810-DELETE THRU S810-EXIT. DTSCS7C 01709 DTSCS7C 01710 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS7C 01711 DTSCS7C 01712 SET LCCM-SCR-CLEAR TO TRUE. DTSCS7C 01713 MOVE LOW-VALUE TO MAP-AREA. DTSCS7C 01714 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS7C 01715 DTSCS7C 01716 MOVE WRK-EMP-NO TO WRK-DISPLAY. DTSCS7C 01717 MOVE WRK-DISPLAY-EMP-NO-1 TO MAP-EMP-NO-1. DTSCS7C 01718 MOVE WRK-DISPLAY-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS7C 01719 DTSCS7C 01720 MOVE PMSG-DEL-SUCCESSFUL TO LCCM-MSG-ID. DTSCS7C 01721 DTSCS7C 01722 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS7C 01723 DTSCS7C 01724 P8300-EXIT. DTSCS7C 01725 EXIT. DTSCS7C 01726 DTSCS7C 01727 P8700-COMMON-MOVES. DTSCS7C 01728 PERFORM P8990-INITIALIZE-MLOG THRU P8990-EXIT. DTSCS7C 01729 DTSCS7C 01730 IF MAP-STATUS-CD = MFSC-STATUS-CD DTSCS7C 01731 NEXT SENTENCE DTSCS7C 01732 ELSE DTSCS7C 01733 MOVE 'MFSC-STATUS-CD' TO L331-FIELD-NAME DTSCS7C 01734 MOVE MFSC-STATUS-CD TO L331-FROM-VALUE DTSCS7C 01735 MOVE MAP-STATUS-CD TO L331-TO-VALUE DTSCS7C 01736 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSCS7C 01737 MOVE MAP-STATUS-CD TO MFSC-STATUS-CD. DTSCS7C 01738 DTSCS7C 01739 MOVE MAP-START-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS7C 01740 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT. DTSCS7C 01741 IF L016-YRQ NOT = MFSC-START-YRQ DTSCS7C 01742 MOVE L016-YRQ TO MFSC-START-YRQ. DTSCS7C 01743 DTSCS7C 01744 DTSCS7C 01745 IF MAP-FILE-SCHED NOT = MFSC-FILING-SCHEDULE-CD DTSCS7C 01746 MOVE MAP-FILE-SCHED TO MFSC-FILING-SCHEDULE-CD. DTSCS7C 01747 DTSCS7C 01748 ** IF MAP-CHNG-REASN-CD NOT = MFSC-CHANGE-REASON-CD DTSCS7C 01749 ** MOVE MAP-CHNG-REASN-CD TO MFSC-CHANGE-REASON-CD. DTSCS7C 01750 DTSCS7C 01751 DTSCS7C 01752 MOVE +0 TO MFSC-NOTE-CNT. DTSCS7C 01753 DTSCS7C 01754 PERFORM DTSCS7C 01755 VARYING WRK-OCC FROM 1 BY 1 DTSCS7C 01756 UNTIL WRK-OCC > MMAX-FSC-TEXT-MAX DTSCS7C 01757 MOVE MAP-TEXT(WRK-OCC) DTSCS7C 01758 TO MFSC-NOTE(WRK-OCC) DTSCS7C 01759 IF MAP-TEXT(WRK-OCC) NOT = SPACES DTSCS7C 01760 MOVE WRK-OCC TO MFSC-NOTE-CNT DTSCS7C 01761 END-IF DTSCS7C 01762 END-PERFORM. DTSCS7C 01763 DTSCS7C 01764 P8700-EXIT. DTSCS7C 01765 EXIT. DTSCS7C 01766 DTSCS7C 01767 DTSCS7C 01768 P8810-LOCK-EMPLOYER. DTSCS7C 01769 MOVE WRK-EMP-NO TO L221-EMP-NO. DTSCS7C 01770 MOVE LCCM-SCR-ABSTIME TO L221-SCR-ABSTIME. DTSCS7C 01771 MOVE LCCM-TASK-ID TO L221-UPDATE-TASK-ID. DTSCS7C 01772 MOVE LCCM-OP-ID TO L221-UPDATE-OP-ID. DTSCS7C 01773 MOVE LCCM-CICS-TERM-ID TO L221-UPDATE-TERMID. DTSCS7C 01774 MOVE LCCM-TASK-NETNAME TO L221-UPDATE-NETNAME. DTSCS7C 01775 MOVE LCCM-TASK-START-DATE TO L221-UPDATE-START-DATE. DTSCS7C 01776 MOVE LCCM-TASK-START-TIME TO L221-UPDATE-START-TIME. DTSCS7C 01777 MOVE WRK-SCR-ID TO L221-UPDATE-SCR-ID. DTSCS7C 01778 DTSCS7C 01779 PERFORM S221-EMP-LOCK THRU S221-EXIT. DTSCS7C 01780 P8810-EXIT. DTSCS7C 01781 EXIT. DTSCS7C 01782 DTSCS7C 01783 DTSCS7C 01784 P8910-CHK-T031. DTSCS7C 01785 IF MFSC-STATUS-OPEN-88 DTSCS7C 01786 OR MFSC-STATUS-WITHDRAWN-88 DTSCS7C 01787 NEXT SENTENCE DTSCS7C 01788 ELSE DTSCS7C 01789 GO TO P8910-EXIT. DTSCS7C 01790 DTSCS7C 01791 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSCS7C 01792 MOVE WRK-EMP-NO TO MQTR-EMP-NO. DTSCS7C 01793 SET MQTR-QTR-88 TO TRUE. DTSCS7C 01794 MOVE WRK-START-YRQ TO MQTR-YRQ. DTSCS7C 01795 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSCS7C 01796 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS7C 01797 IF L810-OK-88 DTSCS7C 01798 PERFORM P8911-ADD-T031 THRU P8911-EXIT. DTSCS7C 01799 DTSCS7C 01800 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS7C 01801 DTSCS7C 01802 P8910-EXIT. DTSCS7C 01803 EXIT. DTSCS7C 01804 DTSCS7C 01805 P8911-ADD-T031. DTSCS7C 01806 MOVE WRK-EMP-NO TO T031-EMP-NO DTSCS7C 01807 SET T031-AUTO-PROCESS TO TRUE DTSCS7C 01808 MOVE WRK-START-YRQ TO T031-START-YRQ DTSCS7C 01809 MOVE WRK-ALL-NINES-YRQ TO T031-END-YRQ DTSCS7C 01810 DTSCS7C 01811 PERFORM S825-WRITE-T031 THRU S825-EXIT. DTSCS7C 01812 DTSCS7C 01813 P8911-EXIT. DTSCS7C 01814 EXIT. DTSCS7C 01815 DTSCS7C 01816 P8920-UPD-PRIOR-MFSC. DTSCS7C 01817 IF PRIOR-REC-KEY-AREA = LOW-VALUES DTSCS7C 01818 GO TO P8920-EXIT. DTSCS7C 01819 DTSCS7C 01820 IF MFSC-STATUS-OPEN-88 DTSCS7C 01821 PERFORM P8921-CLOSE-PRIOR THRU P8921-EXIT DTSCS7C 01822 ELSE DTSCS7C 01823 IF MFSC-STATUS-WITHDRAWN-88 DTSCS7C 01824 PERFORM P8922-REOPEN-PRIOR THRU P8922-EXIT DTSCS7C 01825 ELSE DTSCS7C 01826 GO TO P8920-EXIT. DTSCS7C 01827 DTSCS7C 01828 P8920-EXIT. DTSCS7C 01829 EXIT. DTSCS7C 01830 DTSCS7C 01831 P8921-CLOSE-PRIOR. DTSCS7C 01832 MOVE WRK-ABS-QTR TO L004-ABS-QTR. DTSCS7C 01833 SUBTRACT 1 FROM L004-ABS-QTR. DTSCS7C 01834 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSCS7C 01835 DTSCS7C 01836 MOVE LOW-VALUES TO MFSC-KEY-AREA. DTSCS7C 01837 MOVE PRIOR-REC-KEY-AREA TO MFSC-KEY-AREA. DTSCS7C 01838 MOVE MFSC-KEY-AREA TO MSKL-KEY-AREA. DTSCS7C 01839 PERFORM S810-READ THRU S810-EXIT. DTSCS7C 01840 IF L810-NO-REC-88 DTSCS7C 01841 GO TO P8921-EXIT DTSCS7C 01842 ELSE DTSCS7C 01843 MOVE MSKL-REC TO MFSC-REC DTSCS7C 01844 IF MFSC-END-YRQ NOT = L004-QTR-5-9 DTSCS7C 01845 MOVE L004-QTR-5-9 TO MFSC-END-YRQ DTSCS7C 01846 MOVE MFSC-REC TO MSKL-REC DTSCS7C 01847 PERFORM S810-REWRITE THRU S810-EXIT. DTSCS7C 01848 DTSCS7C 01849 P8921-EXIT. DTSCS7C 01850 EXIT. DTSCS7C 01851 DTSCS7C 01852 P8922-REOPEN-PRIOR. DTSCS7C 01853 MOVE LOW-VALUES TO MFSC-KEY-AREA. DTSCS7C 01854 MOVE PRIOR-REC-KEY-AREA TO MFSC-KEY-AREA. DTSCS7C 01855 MOVE MFSC-KEY-AREA TO MSKL-KEY-AREA. DTSCS7C 01856 PERFORM S810-READ THRU S810-EXIT. DTSCS7C 01857 IF L810-NO-REC-88 DTSCS7C 01858 GO TO P8921-EXIT DTSCS7C 01859 ELSE DTSCS7C 01860 MOVE MSKL-REC TO MFSC-REC DTSCS7C 01861 MOVE WRK-ALL-NINES-YRQ TO MFSC-END-YRQ DTSCS7C 01862 MOVE MFSC-REC TO MSKL-REC DTSCS7C 01863 PERFORM S810-REWRITE THRU S810-EXIT. DTSCS7C 01864 DTSCS7C 01865 P8922-EXIT. DTSCS7C 01866 EXIT. DTSCS7C 01867 DTSCS7C 01868 ************************************************************* DTSCS7C 01869 * THE ONLY MFSC RECORD ON FILE HAS BEEN WITHDRAWN. ADD A DTSCS7C 01870 * PENDING MFSC DTSCS7C 01871 ************************************************************* DTSCS7C 01872 P8930-ADD-MFSC. DTSCS7C 01873 MOVE LOW-VALUES TO MFSC-REC. DTSCS7C 01874 DTSCS7C 01875 MOVE WRK-EMP-NO TO MFSC-EMP-NO. DTSCS7C 01876 DTSCS7C 01877 SET MFSC-FSC-88 TO TRUE. DTSCS7C 01878 DTSCS7C 01879 MOVE WRK-ABS-QTR TO MFSC-ABS-QTR. DTSCS7C 01880 DTSCS7C 01881 MOVE LCCM-TASK-START-ABSTIME TO MFSC-ABSTIME. DTSCS7C 01882 DTSCS7C 01883 MOVE +0 TO MFSC-PURGE-DATE. DTSCS7C 01884 DTSCS7C 01885 SET MFSC-STATUS-PENDING-88 TO TRUE. DTSCS7C 01886 DTSCS7C 01887 MOVE WRK-START-YRQ TO MFSC-START-YRQ. DTSCS7C 01888 DTSCS7C 01889 MOVE WRK-ALL-NINES-YRQ TO MFSC-END-YRQ. DTSCS7C 01890 DTSCS7C 01891 SET MFSC-FILING-SCHED-QTR-88 TO TRUE. DTSCS7C 01892 DTSCS7C 01893 SET MFSC-REQ-ADMIN-88 TO TRUE. DTSCS7C 01894 DTSCS7C 01895 MOVE SPACES TO MFSC-CHANGE-REASON-CD DTSCS7C 01896 MFSC-INIT-NOTICE-TYPE DTSCS7C 01897 MFSC-CONFIRM-NOTICE-TYPE DTSCS7C 01898 MFSC-DENIAL-NOTICE-TYPE. DTSCS7C 01899 DTSCS7C 01900 MOVE ZERO TO MFSC-INITIAL-MAIL-DATE DTSCS7C 01901 MFSC-CONFIRM-MAIL-DATE DTSCS7C 01902 MFSC-DENIAL-MAIL-DATE. DTSCS7C 01903 DTSCS7C 01904 MOVE LCCM-CURR-RUN-DATE TO MFSC-ESTB-DATE. DTSCS7C 01905 DTSCS7C 01906 MOVE LCCM-CURR-RUN-DATE TO MFSC-CHNG-DATE. DTSCS7C 01907 DTSCS7C 01908 MOVE LCCM-OP-ID TO MFSC-CHNG-OP-ID. DTSCS7C 01909 DTSCS7C 01910 DTSCS7C 01911 MOVE +0 TO MFSC-NOTE-CNT. DTSCS7C 01912 DTSCS7C 01913 PERFORM DTSCS7C 01914 VARYING WRK-OCC FROM 1 BY 1 DTSCS7C 01915 UNTIL WRK-OCC > MMAX-FSC-TEXT-MAX DTSCS7C 01916 MOVE MAP-TEXT(WRK-OCC) DTSCS7C 01917 TO MFSC-NOTE(WRK-OCC) DTSCS7C 01918 IF MAP-TEXT(WRK-OCC) NOT = SPACES DTSCS7C 01919 MOVE WRK-OCC TO MFSC-NOTE-CNT DTSCS7C 01920 END-IF DTSCS7C 01921 END-PERFORM. DTSCS7C 01922 DTSCS7C 01923 IF MFSC-NOTE-CNT = +0 DTSCS7C 01924 MOVE +1 TO MFSC-NOTE-CNT DTSCS7C 01925 MOVE NOTE-WITHDRAW TO MFSC-NOTE (1). DTSCS7C 01926 DTSCS7C 01927 MOVE MFSC-REC TO MSKL-REC. DTSCS7C 01928 DTSCS7C 01929 PERFORM S810-WRITE THRU S810-EXIT. DTSCS7C 01930 DTSCS7C 01931 P8930-EXIT. DTSCS7C 01932 EXIT. DTSCS7C 01933 DTSCS7C 01934 P8940-CHK-ESTIM-RATE. DTSCS7C 01935 IF MAP-VERIFY-YES-88 DTSCS7C 01936 GO TO P8940-EXIT. DTSCS7C 01937 DTSCS7C 01938 IF (MFSC-STATUS-OPEN-88 DTSCS7C 01939 AND MFSC-FILING-SCHED-QTR-88) DTSCS7C 01940 OR (MFSC-STATUS-WITHDRAWN-88 DTSCS7C 01941 AND WRK-PRIOR-SCHED-QTR-88) DTSCS7C 01942 NEXT SENTENCE DTSCS7C 01943 ELSE DTSCS7C 01944 GO TO P8940-EXIT DTSCS7C 01945 END-IF. DTSCS7C 01946 DTSCS7C 01947 MOVE LOW-VALUES TO MRTE-KEY-AREA. DTSCS7C 01948 MOVE WRK-EMP-NO TO MRTE-EMP-NO. DTSCS7C 01949 SET MRTE-RTE-88 TO TRUE. DTSCS7C 01950 IF MFSC-STATUS-WITHDRAWN-88 DTSCS7C 01951 MOVE WRK-PRIOR-YRQ TO L006-YRQ DTSCS7C 01952 ELSE DTSCS7C 01953 MOVE WRK-START-YRQ TO L006-YRQ. DTSCS7C 01954 SET L006-FROM-QTR TO TRUE. DTSCS7C 01955 PERFORM S006-RATING-YRQ THRU S006-EXIT. DTSCS7C 01956 MOVE L006-RTE-YR-START-YRQ TO MRTE-EFF-YRQ. DTSCS7C 01957 MOVE MRTE-KEY-AREA TO MSKL-KEY-AREA. DTSCS7C 01958 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS7C 01959 IF L810-NO-REC-88 DTSCS7C 01960 GO TO P8940-EXIT. DTSCS7C 01961 DTSCS7C 01962 PERFORM DTSCS7C 01963 UNTIL L810-NO-REC-88 DTSCS7C 01964 MOVE MSKL-REC TO MRTE-REC DTSCS7C 01965 IF MRTE-RATE-TYPE-ESTIM-88 DTSCS7C 01966 PERFORM S825-WRITE-T006-FINAL THRU S825-EXIT DTSCS7C 01967 ELSE DTSCS7C 01968 IF MRTE-NOTICE-DATE = ZERO DTSCS7C 01969 PERFORM S825-WRITE-T006-PRINT THRU S825-EXIT DTSCS7C 01970 END-IF DTSCS7C 01971 END-IF DTSCS7C 01972 PERFORM S810-READ-NEXT THRU S810-EXIT DTSCS7C 01973 END-PERFORM. DTSCS7C 01974 DTSCS7C 01975 P8940-EXIT. DTSCS7C 01976 EXIT. DTSCS7C 01977 DTSCS7C 01978 P8990-INITIALIZE-MLOG. DTSCS7C 01979 MOVE WRK-EMP-NO TO L331-EMP-NO. DTSCS7C 01980 DTSCS7C 01981 MOVE LCCM-CURR-RUN-DATE TO L331-CURR-RUN-DATE. DTSCS7C 01982 DTSCS7C 01983 MOVE LCCM-TASK-START-ABSTIME TO L331-UPDATE-ABSTIME. DTSCS7C 01984 DTSCS7C 01985 MOVE LCCM-OP-ID TO L331-OP-ID. DTSCS7C 01986 DTSCS7C 01987 MOVE SPACES TO L331-REC-OCC-ID. DTSCS7C 01988 P8990-EXIT. DTSCS7C 01989 EXIT. DTSCS7C 01990 /*****************************************************************DTSCS7C 01991 * LINKS TO UTILITY MODULES DTSCS7C 01992 ******************************************************************DTSCS7C 01993 DTSCS7C 01994 S001-FROM-FED-8. DTSCS7C 01995 SET L001-FROM-FED-8 TO TRUE. DTSCS7C 01996 GO TO S001-DATE. DTSCS7C 01997 DTSCS7C 01998 *S001-FROM-ABS-DATE. DTSCS7C 01999 *****SET L001-FROM-ABS-DAY TO TRUE. DTSCS7C 02000 *****GO TO S001-DATE. DTSCS7C 02001 DTSCS7C 02002 S001-DATE. DTSCS7C 02003 EXEC CICS LINK DTSCS7C 02004 PROGRAM('DTSCU001') DTSCS7C 02005 COMMAREA(L001-COMM-AREA) DTSCS7C 02006 END-EXEC. DTSCS7C 02007 S001-EXIT. DTSCS7C 02008 EXIT. DTSCS7C 02009 DTSCS7C 02010 S004-FROM-5. DTSCS7C 02011 SET L004-FROM-5 TO TRUE. DTSCS7C 02012 GO TO S004-LINK. DTSCS7C 02013 DTSCS7C 02014 S004-FROM-3. DTSCS7C 02015 SET L004-FROM-3 TO TRUE. DTSCS7C 02016 GO TO S004-LINK. DTSCS7C 02017 DTSCS7C 02018 S004-FROM-ABS. DTSCS7C 02019 SET L004-FROM-ABS TO TRUE. DTSCS7C 02020 GO TO S004-LINK. DTSCS7C 02021 DTSCS7C 02022 S004-LINK. DTSCS7C 02023 EXEC CICS LINK DTSCS7C 02024 PROGRAM('DTSCU004') DTSCS7C 02025 COMMAREA(L004-COMM-AREA) DTSCS7C 02026 END-EXEC. DTSCS7C 02027 S004-EXIT. DTSCS7C 02028 EXIT. DTSCS7C 02029 DTSCS7C 02030 S006-RATING-YRQ. DTSCS7C 02031 EXEC CICS LINK DTSCS7C 02032 PROGRAM('DTSCU006') DTSCS7C 02033 COMMAREA(L006-COMM-AREA) DTSCS7C 02034 END-EXEC. DTSCS7C 02035 S006-EXIT. DTSCS7C 02036 EXIT. DTSCS7C 02037 DTSCS7C 02038 S015-DATE-FROM-SCREEN. DTSCS7C 02039 EXEC CICS LINK DTSCS7C 02040 PROGRAM('DTSCU015') DTSCS7C 02041 COMMAREA(L015-COMM-AREA) DTSCS7C 02042 END-EXEC. DTSCS7C 02043 S015-EXIT. DTSCS7C 02044 EXIT. DTSCS7C 02045 DTSCS7C 02046 S016-YRQ-FROM-SCREEN. DTSCS7C 02047 EXEC CICS LINK DTSCS7C 02048 PROGRAM('DTSCU016') DTSCS7C 02049 COMMAREA(L016-COMM-AREA) DTSCS7C 02050 END-EXEC. DTSCS7C 02051 S016-EXIT. DTSCS7C 02052 EXIT. DTSCS7C 02053 DTSCS7C 02054 S018-EMP-NO-FROM-SCREEN. DTSCS7C 02055 EXEC CICS LINK DTSCS7C 02056 PROGRAM('DTSCU018') DTSCS7C 02057 COMMAREA(L018-COMM-AREA) DTSCS7C 02058 END-EXEC. DTSCS7C 02059 S018-EXIT. DTSCS7C 02060 EXIT. DTSCS7C 02061 DTSCS7C 02062 S042-MFSC-CODES. DTSCS7C 02063 EXEC CICS LINK DTSCS7C 02064 PROGRAM ('DTSCU042') DTSCS7C 02065 COMMAREA (L042-COMM-AREA) DTSCS7C 02066 END-EXEC. DTSCS7C 02067 S042-EXIT. DTSCS7C 02068 EXIT. DTSCS7C 02069 DTSCS7C 02070 S221-EMP-LOCK. DTSCS7C 02071 SET L221-START-UPDATE TO TRUE. DTSCS7C 02072 GO TO S221-EMP-LOCK-UNLOCK. DTSCS7C 02073 DTSCS7C 02074 S221-EMP-UNLOCK. DTSCS7C 02075 SET L221-END-UPDATE TO TRUE. DTSCS7C 02076 GO TO S221-EMP-LOCK-UNLOCK. DTSCS7C 02077 DTSCS7C 02078 S221-EMP-LOCK-UNLOCK. DTSCS7C 02079 EXEC CICS LINK DTSCS7C 02080 PROGRAM('DTSCU221') DTSCS7C 02081 COMMAREA(L221-COMM-AREA) DTSCS7C 02082 END-EXEC. DTSCS7C 02083 DTSCS7C 02084 IF L221-FILE-CLOSED DTSCS7C 02085 MOVE L221-MSG-AREA TO LCCM-MSG-AREA DTSCS7C 02086 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS7C 02087 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS7C 02088 GO TO MAINLINE-EXIT. DTSCS7C 02089 DTSCS7C 02090 IF L221-NOT-OK DTSCS7C 02091 MOVE L221-MSG-AREA TO LCCM-MSG-AREA. DTSCS7C 02092 S221-EXIT. DTSCS7C 02093 EXIT. DTSCS7C 02094 DTSCS7C 02095 DTSCS7C 02096 S331-WRITE-MLOG. DTSCS7C 02097 EXEC CICS DTSCS7C 02098 LINK DTSCS7C 02099 PROGRAM ('DTSCU331') DTSCS7C 02100 COMMAREA (L331-COMM-AREA) DTSCS7C 02101 END-EXEC. DTSCS7C 02102 DTSCS7C 02103 IF L331-FILE-CLOSED DTSCS7C 02104 MOVE L331-MSG-AREA TO LCCM-MSG-AREA DTSCS7C 02105 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS7C 02106 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS7C 02107 GO TO MAINLINE-EXIT. DTSCS7C 02108 S331-EXIT. DTSCS7C 02109 EXIT. DTSCS7C 02110 DTSCS7C 02111 DTSCS7C 02112 S803-REQ-SCR-ID-EDIT. DTSCS7C 02113 EXEC CICS LINK DTSCS7C 02114 PROGRAM ('DTSCU803') DTSCS7C 02115 COMMAREA (DFHCOMMAREA) DTSCS7C 02116 END-EXEC. DTSCS7C 02117 S803-EXIT. DTSCS7C 02118 EXIT. DTSCS7C 02119 DTSCS7C 02120 S804-INVALID-KEY. DTSCS7C 02121 EXEC CICS LINK DTSCS7C 02122 PROGRAM ('DTSCU804') DTSCS7C 02123 COMMAREA (DFHCOMMAREA) DTSCS7C 02124 END-EXEC. DTSCS7C 02125 S804-EXIT. DTSCS7C 02126 EXIT. DTSCS7C 02127 DTSCS7C 02128 S805-MSG-AREA. DTSCS7C 02129 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS7C 02130 DTSCS7C 02131 EXEC CICS LINK DTSCS7C 02132 PROGRAM ('DTSCU805') DTSCS7C 02133 COMMAREA (L805-COMM-AREA) DTSCS7C 02134 END-EXEC. DTSCS7C 02135 DTSCS7C 02136 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS7C 02137 S805-EXIT. DTSCS7C 02138 EXIT. DTSCS7C 02139 EJECT DTSCS7C 02140 S810-READ. DTSCS7C 02141 SET L810-READ-88 TO TRUE. DTSCS7C 02142 GO TO S810-IO. DTSCS7C 02143 DTSCS7C 02144 S810-READ-UPDATE. DTSCS7C 02145 SET L810-READ-UPDATE-88 TO TRUE. DTSCS7C 02146 GO TO S810-IO. DTSCS7C 02147 DTSCS7C 02148 S810-START-BROWSE. DTSCS7C 02149 SET L810-START-BROWSE-88 TO TRUE. DTSCS7C 02150 GO TO S810-IO. DTSCS7C 02151 DTSCS7C 02152 S810-READ-NEXT. DTSCS7C 02153 SET L810-READ-NEXT-88 TO TRUE. DTSCS7C 02154 GO TO S810-IO. DTSCS7C 02155 DTSCS7C 02156 S810-READ-PREV. DTSCS7C 02157 SET L810-READ-PREV-88 TO TRUE. DTSCS7C 02158 GO TO S810-IO. DTSCS7C 02159 DTSCS7C 02160 S810-END-BROWSE. DTSCS7C 02161 SET L810-END-BROWSE-88 TO TRUE. DTSCS7C 02162 GO TO S810-IO. DTSCS7C 02163 DTSCS7C 02164 S810-COUNT. DTSCS7C 02165 SET L810-COUNT-88 TO TRUE. DTSCS7C 02166 GO TO S810-IO. DTSCS7C 02167 DTSCS7C 02168 S810-REWRITE. DTSCS7C 02169 SET L810-REWRITE-88 TO TRUE. DTSCS7C 02170 GO TO S810-IO. DTSCS7C 02171 DTSCS7C 02172 S810-REWRITE-UPDATE. DTSCS7C 02173 SET L810-REWRITE-UPDATE-88 TO TRUE. DTSCS7C 02174 GO TO S810-IO. DTSCS7C 02175 DTSCS7C 02176 S810-WRITE. DTSCS7C 02177 SET L810-WRITE-88 TO TRUE. DTSCS7C 02178 GO TO S810-IO. DTSCS7C 02179 DTSCS7C 02180 S810-DELETE. DTSCS7C 02181 SET L810-DELETE-88 TO TRUE. DTSCS7C 02182 GO TO S810-IO. DTSCS7C 02183 DTSCS7C 02184 S810-IO. DTSCS7C 02185 DTSCS7C 02186 EXEC CICS LINK DTSCS7C 02187 PROGRAM ('DTSCU810') DTSCS7C 02188 COMMAREA (L810-COMM-AREA) DTSCS7C 02189 END-EXEC. DTSCS7C 02190 DTSCS7C 02191 IF L810-FILE-CLOSED-88 DTSCS7C 02192 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS7C 02193 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS7C 02194 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS7C 02195 GO TO MAINLINE-EXIT. DTSCS7C 02196 S810-EXIT. DTSCS7C 02197 EXIT. DTSCS7C 02198 EJECT DTSCS7C 02199 S825-WRITE-T001. DTSCS7C 02200 MOVE '001' TO T001-REC-TYPE. DTSCS7C 02201 MOVE LENGTH OF T001-REC TO T001-LENGTH. DTSCS7C 02202 MOVE WRK-EMP-NO TO T001-EMP-NO. DTSCS7C 02203 MOVE LCCM-OP-ID TO T001-OP-ID DTSCS7C 02204 T001-RESP-OP-ID. DTSCS7C 02205 MOVE '7C' TO T001-SCR-ID DTSCS7C 02206 MOVE LCCM-TASK-START-DATE TO T001-SYS-DATE. DTSCS7C 02207 MOVE LCCM-TASK-START-TIME TO T001-SYS-TIME. DTSCS7C 02208 SET T001-HSEHLD-NOTICES TO TRUE. DTSCS7C 02209 MOVE WRK-T001-RPT-TYPE TO T001-HSEHLD-RPT-TYPE. DTSCS7C 02210 MOVE WRK-START-YRQ TO T001-HH-START-YRQ. DTSCS7C 02211 MOVE SPACES TO T001-INACT-LTR-TYPE DTSCS7C 02212 T001-NOT-LIABLE-LTR-TYPE DTSCS7C 02213 T001-WELCOME-LTR-IND. DTSCS7C 02214 MOVE T001-REC TO RSKL-REC. DTSCS7C 02215 SET L825-WRITE-88 TO TRUE. DTSCS7C 02216 GO TO S825-O. DTSCS7C 02217 DTSCS7C 02218 S825-WRITE-T006-FINAL. DTSCS7C 02219 MOVE '006' TO T006-REC-TYPE. DTSCS7C 02220 MOVE LENGTH OF T006-REC TO T006-LENGTH. DTSCS7C 02221 MOVE WRK-EMP-NO TO T006-EMP-NO. DTSCS7C 02222 MOVE LCCM-OP-ID TO T006-OP-ID DTSCS7C 02223 T006-RESP-OP-ID. DTSCS7C 02224 MOVE '7C' TO T006-SCR-ID DTSCS7C 02225 MOVE LCCM-TASK-START-DATE TO T006-SYS-DATE. DTSCS7C 02226 MOVE LCCM-TASK-START-TIME TO T006-SYS-TIME. DTSCS7C 02227 SET T006-FINAL-RATE TO TRUE. DTSCS7C 02228 MOVE MRTE-EFF-YRQ TO T006-START-YRQ. DTSCS7C 02229 MOVE ZERO TO T006-END-YRQ. DTSCS7C 02230 MOVE T006-REC TO RSKL-REC. DTSCS7C 02231 SET L825-WRITE-88 TO TRUE. DTSCS7C 02232 GO TO S825-O. DTSCS7C 02233 DTSCS7C 02234 S825-WRITE-T006-PRINT. DTSCS7C 02235 MOVE '006' TO T006-REC-TYPE. DTSCS7C 02236 MOVE LENGTH OF T006-REC TO T006-LENGTH. DTSCS7C 02237 MOVE WRK-EMP-NO TO T006-EMP-NO. DTSCS7C 02238 MOVE LCCM-OP-ID TO T006-OP-ID DTSCS7C 02239 T006-RESP-OP-ID. DTSCS7C 02240 MOVE '7C' TO T006-SCR-ID DTSCS7C 02241 MOVE LCCM-TASK-START-DATE TO T006-SYS-DATE. DTSCS7C 02242 MOVE LCCM-TASK-START-TIME TO T006-SYS-TIME. DTSCS7C 02243 SET T006-UIRTE-NOTICE TO TRUE. DTSCS7C 02244 MOVE MRTE-EFF-YRQ TO T006-START-YRQ. DTSCS7C 02245 MOVE ZERO TO T006-END-YRQ. DTSCS7C 02246 MOVE T006-REC TO RSKL-REC. DTSCS7C 02247 SET L825-WRITE-88 TO TRUE. DTSCS7C 02248 GO TO S825-O. DTSCS7C 02249 DTSCS7C 02250 S825-WRITE-T031. DTSCS7C 02251 MOVE '031' TO T031-REC-TYPE. DTSCS7C 02252 MOVE LENGTH OF T031-REC TO T031-LENGTH. DTSCS7C 02253 MOVE WRK-EMP-NO TO T031-EMP-NO. DTSCS7C 02254 MOVE LCCM-OP-ID TO T031-OP-ID. DTSCS7C 02255 MOVE '7C' TO T031-SCR-ID DTSCS7C 02256 MOVE LCCM-TASK-START-DATE TO T031-SYS-DATE. DTSCS7C 02257 MOVE LCCM-TASK-START-TIME TO T031-SYS-TIME. DTSCS7C 02258 DTSCS7C 02259 MOVE +0 TO T031-WAIVER-START-YRQ DTSCS7C 02260 T031-WAIVER-END-YRQ DTSCS7C 02261 T031-WAIVER-EXT-DATE. DTSCS7C 02262 SET T031-TRANSFER-NO-88 TO TRUE. DTSCS7C 02263 MOVE +0 TO T031-TRANSFER-TO-EMP-NO. DTSCS7C 02264 DTSCS7C 02265 MOVE T031-REC TO RSKL-REC. DTSCS7C 02266 SET L825-WRITE-88 TO TRUE. DTSCS7C 02267 GO TO S825-O. DTSCS7C 02268 DTSCS7C 02269 S825-O. DTSCS7C 02270 DTSCS7C 02271 EXEC CICS LINK DTSCS7C 02272 PROGRAM ('DTSCU825') DTSCS7C 02273 COMMAREA (L825-COMM-AREA) DTSCS7C 02274 END-EXEC. DTSCS7C 02275 DTSCS7C 02276 IF L825-FILE-CLOSED-88 DTSCS7C 02277 MOVE L825-MSG-AREA TO LCCM-MSG-AREA DTSCS7C 02278 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS7C 02279 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS7C 02280 GO TO MAINLINE-EXIT. DTSCS7C 02281 S825-EXIT. DTSCS7C 02282 EXIT. DTSCS7C 02283 EJECT DTSCS7C 02284 S851-SCREEN-PROCESSING. DTSCS7C 02285 EXEC CICS LINK DTSCS7C 02286 PROGRAM ('DTSCU851') DTSCS7C 02287 COMMAREA (L851-COMM-AREA) DTSCS7C 02288 END-EXEC. DTSCS7C 02289 S851-EXIT. DTSCS7C 02290 EXIT. DTSCS7C 02291 DTSCS7C 02292 S899-ABEND. DTSCS7C 02293 EXEC CICS ABEND DTSCS7C 02294 ABCODE(WRK-ABEND-CD) DTSCS7C 02295 END-EXEC. DTSCS7C 02296 S899-EXIT. DTSCS7C 02297 EXIT. DTSCS7C 02298 /*****************************************************************DTSCS7C 02299 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS7C 02300 ******************************************************************DTSCS7C 02301 DTSCS7C 02302 S1000-SCREEN-EDITS. DTSCS7C 02303 PERFORM S1200-STATUS THRU S1200-EXIT. DTSCS7C 02304 DTSCS7C 02305 IF REQ-INQUIRE DTSCS7C 02306 NEXT SENTENCE DTSCS7C 02307 ELSE DTSCS7C 02308 PERFORM S1300-START-YRQ THRU S1300-EXIT. DTSCS7C 02309 DTSCS7C 02310 PERFORM S1400-FILING-SCHEDULE THRU S1400-EXIT. DTSCS7C 02311 DTSCS7C 02312 IF LCCM-MSG DTSCS7C 02313 GO TO S1000-EXIT. DTSCS7C 02314 DTSCS7C 02315 PERFORM S1500-REQUEST-TYPE THRU S1500-EXIT. DTSCS7C 02316 DTSCS7C 02317 ** CHANGE REASON NO LONGER USED. THE GENERAL CONSEL DECIDED DTSCS7C 02318 ** THAT ANNUAL FILING CANNOT BE DENIED BECAUSE OF DELINQUENCY DTSCS7C 02319 ** 1/17/2002 - GD DTSCS7C 02320 *****PERFORM S1600-CHANGE-REASON THRU S1600-EXIT. DTSCS7C 02321 DTSCS7C 02322 PERFORM S1700-TEXT THRU S1700-EXIT DTSCS7C 02323 VARYING WRK-OCC FROM 1 BY 1 DTSCS7C 02324 UNTIL WRK-OCC > MMAX-FSC-TEXT-MAX. DTSCS7C 02325 DTSCS7C 02326 PERFORM S1800-CROSS-EDITS THRU S1800-EXIT. DTSCS7C 02327 IF LCCM-MSG DTSCS7C 02328 GO TO S1000-EXIT. DTSCS7C 02329 DTSCS7C 02330 PERFORM S2000-CHECK-RATES THRU S2000-EXIT. DTSCS7C 02331 DTSCS7C 02332 S1000-EXIT. EXIT. DTSCS7C 02333 EJECT DTSCS7C 02334 *S1100-EDIT-FILTER. DTSCS7C 02335 * PERFORM S1102-STATUS THRU S1102-EXIT. DTSCS7C 02336 * DTSCS7C 02337 * PERFORM S1103-START-YRQ THRU S1103-EXIT. DTSCS7C 02338 * DTSCS7C 02339 *S1100-EXIT. EXIT. DTSCS7C 02340 /*****************************************************************DTSCS7C 02341 * DTSCS7C 02342 ******************************************************************DTSCS7C 02343 S1101-EMP-NO. DTSCS7C 02344 MOVE ZERO TO WRK-EMP-NO. DTSCS7C 02345 DTSCS7C 02346 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS7C 02347 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS7C 02348 DTSCS7C 02349 IF L018-NO-ENTRY DTSCS7C 02350 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS7C 02351 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS7C 02352 GO TO S1101-EXIT. DTSCS7C 02353 DTSCS7C 02354 IF L018-NOT-VALID DTSCS7C 02355 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS7C 02356 PERFORM S1101-ERROR THRU S1101-ERR-EXIT DTSCS7C 02357 GO TO S1101-EXIT. DTSCS7C 02358 DTSCS7C 02359 MOVE L018-EMP-NO TO WRK-EMP-NO. DTSCS7C 02360 DTSCS7C 02361 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS7C 02362 S1101-EXIT. EXIT. DTSCS7C 02363 DTSCS7C 02364 S1101-ERROR. DTSCS7C 02365 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS7C 02366 MAP-EMP-NO-2-A. DTSCS7C 02367 IF LCCM-NO-MSG DTSCS7C 02368 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS7C 02369 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L DTSCS7C 02370 SET CURSOR-SET-YES TO TRUE. DTSCS7C 02371 S1101-ERR-EXIT. EXIT. DTSCS7C 02372 DTSCS7C 02373 /*****************************************************************DTSCS7C 02374 * DTSCS7C 02375 ******************************************************************DTSCS7C 02376 *S1102-STATUS. DTSCS7C 02377 * MOVE SPACES TO WRK-STATUS-CD. DTSCS7C 02378 * DTSCS7C 02379 * IF MAP-STATUS-CD = LOW-VALUES OR SPACES DTSCS7C 02380 * GO TO S1102-EXIT. DTSCS7C 02381 * DTSCS7C 02382 * MOVE MAP-STATUS-CD TO MFSC-STATUS-CD. DTSCS7C 02383 * IF NOT MFSC-STATUS-VALID-88 DTSCS7C 02384 * MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS7C 02385 * PERFORM S1102-ERROR THRU S1102-ERR-EXIT DTSCS7C 02386 * GO TO S1102-EXIT. DTSCS7C 02387 * DTSCS7C 02388 * MOVE MAP-STATUS-CD TO WRK-STATUS-CD. DTSCS7C 02389 * SET WRK-FILTER-YES-88 TO TRUE. DTSCS7C 02390 * DTSCS7C 02391 *S1102-EXIT. EXIT. DTSCS7C 02392 * DTSCS7C 02393 *S1102-ERROR. DTSCS7C 02394 * MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-STATUS-A. DTSCS7C 02395 * IF LCCM-NO-MSG DTSCS7C 02396 * MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS7C 02397 * MOVE CATB-CURSOR TO MAP-STATUS-L DTSCS7C 02398 * SET CURSOR-SET-YES TO TRUE. DTSCS7C 02399 *S1102-ERR-EXIT. EXIT. DTSCS7C 02400 DTSCS7C 02401 /*****************************************************************DTSCS7C 02402 * DTSCS7C 02403 ******************************************************************DTSCS7C 02404 S1103-START-YRQ. DTSCS7C 02405 MOVE ZERO TO WRK-START-YRQ DTSCS7C 02406 WRK-START-YEAR DTSCS7C 02407 WRK-ABS-QTR. DTSCS7C 02408 DTSCS7C 02409 MOVE MAP-START-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS7C 02410 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT. DTSCS7C 02411 DTSCS7C 02412 IF L016-NO-ENTRY DTSCS7C 02413 IF REQ-INQUIRE DTSCS7C 02414 GO TO S1103-EXIT DTSCS7C 02415 ELSE DTSCS7C 02416 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS7C 02417 PERFORM S1103-ERROR THRU S1103-ERR-EXIT DTSCS7C 02418 GO TO S1103-EXIT. DTSCS7C 02419 DTSCS7C 02420 IF L016-NOT-VALID DTSCS7C 02421 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS7C 02422 PERFORM S1103-ERROR THRU S1103-ERR-EXIT DTSCS7C 02423 GO TO S1103-EXIT. DTSCS7C 02424 DTSCS7C 02425 MOVE L016-YRQ TO L004-QTR-5-9 DTSCS7C 02426 WRK-START-YRQ. DTSCS7C 02427 MOVE L004-QTR-5-YR TO WRK-START-YEAR. DTSCS7C 02428 DTSCS7C 02429 IF L004-QTR-5-Q NOT = 1 DTSCS7C 02430 MOVE MSG-E7C2-AREA TO WRK-MSG-AREA DTSCS7C 02431 PERFORM S1103-ERROR THRU S1103-ERR-EXIT DTSCS7C 02432 GO TO S1103-EXIT. DTSCS7C 02433 DTSCS7C 02434 PERFORM S004-FROM-5 THRU S004-EXIT. DTSCS7C 02435 MOVE L004-ABS-QTR TO WRK-ABS-QTR. DTSCS7C 02436 * SET WRK-FILTER-YES-88 TO TRUE. DTSCS7C 02437 DTSCS7C 02438 S1103-EXIT. EXIT. DTSCS7C 02439 DTSCS7C 02440 S1103-ERROR. DTSCS7C 02441 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-START-YY-A DTSCS7C 02442 MAP-START-Q-A. DTSCS7C 02443 IF LCCM-NO-MSG DTSCS7C 02444 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS7C 02445 MOVE CATB-CURSOR TO MAP-START-YY-L DTSCS7C 02446 SET CURSOR-SET-YES TO TRUE. DTSCS7C 02447 S1103-ERR-EXIT. EXIT. DTSCS7C 02448 DTSCS7C 02449 S1110-READ-MPRF. DTSCS7C 02450 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS7C 02451 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS7C 02452 SET MPRF-PRF-88 TO TRUE. DTSCS7C 02453 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS7C 02454 PERFORM S810-READ THRU S810-EXIT. DTSCS7C 02455 IF L810-NO-REC-88 DTSCS7C 02456 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS7C 02457 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS7C 02458 GO TO S1110-EXIT DTSCS7C 02459 ELSE DTSCS7C 02460 MOVE MSKL-REC TO MPRF-REC DTSCS7C 02461 SET WRK-MPRF-YES-88 TO TRUE. DTSCS7C 02462 DTSCS7C 02463 S1110-EXIT. DTSCS7C 02464 EXIT. DTSCS7C 02465 DTSCS7C 02466 DTSCS7C 02467 S1120-READ-MFSC. DTSCS7C 02468 MOVE LOW-VALUES TO MFSC-KEY-AREA. DTSCS7C 02469 MOVE SCR-REC-KEY-AREA TO MFSC-KEY-AREA. DTSCS7C 02470 MOVE MFSC-KEY-AREA TO MSKL-KEY-AREA. DTSCS7C 02471 PERFORM S810-READ THRU S810-EXIT. DTSCS7C 02472 IF L810-NO-REC-88 DTSCS7C 02473 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS7C 02474 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS7C 02475 ELSE DTSCS7C 02476 MOVE MSKL-REC TO MFSC-REC. DTSCS7C 02477 S1120-EXIT. DTSCS7C 02478 EXIT. DTSCS7C 02479 DTSCS7C 02480 S1199-ERROR. DTSCS7C 02481 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS7C 02482 MAP-EMP-NO-2-A. DTSCS7C 02483 IF LCCM-NO-MSG DTSCS7C 02484 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS7C 02485 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L DTSCS7C 02486 SET CURSOR-SET-YES TO TRUE. DTSCS7C 02487 S1199-EXIT. EXIT. DTSCS7C 02488 DTSCS7C 02489 /*****************************************************************DTSCS7C 02490 * DTSCS7C 02491 ******************************************************************DTSCS7C 02492 S1200-STATUS. DTSCS7C 02493 MOVE SPACES TO WRK-STATUS-CD. DTSCS7C 02494 DTSCS7C 02495 IF MAP-STATUS-CD = LOW-VALUES OR SPACES DTSCS7C 02496 IF LCCM-F09-88 DTSCS7C 02497 *** OR LCCM-SCR-ADD-LOCKED DTSCS7C 02498 SET MFSC-STATUS-PENDING-88 TO TRUE DTSCS7C 02499 MOVE MFSC-STATUS-CD TO MAP-STATUS-CD DTSCS7C 02500 WRK-STATUS-CD DTSCS7C 02501 GO TO S1200-EXIT DTSCS7C 02502 ELSE DTSCS7C 02503 IF LCCM-F10-88 DTSCS7C 02504 MOVE MFSC-STATUS-CD TO MAP-STATUS-CD DTSCS7C 02505 WRK-STATUS-CD DTSCS7C 02506 GO TO S1200-EXIT DTSCS7C 02507 ELSE DTSCS7C 02508 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS7C 02509 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS7C 02510 GO TO S1200-EXIT DTSCS7C 02511 END-IF DTSCS7C 02512 END-IF DTSCS7C 02513 END-IF. DTSCS7C 02514 DTSCS7C 02515 SET L042-MFSC-STATUS-CD TO TRUE. DTSCS7C 02516 MOVE MAP-STATUS-CD TO L042-CD. DTSCS7C 02517 PERFORM S042-MFSC-CODES THRU S042-EXIT. DTSCS7C 02518 IF NOT L042-VALID DTSCS7C 02519 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS7C 02520 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS7C 02521 GO TO S1200-EXIT. DTSCS7C 02522 DTSCS7C 02523 IF LCCM-F09-88 DTSCS7C 02524 OR LCCM-SCR-ADD-LOCKED DTSCS7C 02525 MOVE MAP-STATUS-CD TO WRK-STATUS-CD DTSCS7C 02526 GO TO S1200-EXIT. DTSCS7C 02527 DTSCS7C 02528 IF MFSC-STATUS-WITHDRAWN-88 DTSCS7C 02529 IF MAP-STATUS-CD NOT = MFSC-STATUS-CD DTSCS7C 02530 MOVE MSG-E7C1-AREA TO WRK-MSG-AREA DTSCS7C 02531 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS7C 02532 GO TO S1200-EXIT. DTSCS7C 02533 DTSCS7C 02534 IF MFSC-STATUS-PENDING-88 DTSCS7C 02535 IF MAP-STATUS-CD = MFSC-STATUS-CD DTSCS7C 02536 NEXT SENTENCE DTSCS7C 02537 ELSE DTSCS7C 02538 IF MAP-STATUS-OPEN-88 DTSCS7C 02539 OR MAP-STATUS-WITHDRAWN-88 DTSCS7C 02540 NEXT SENTENCE DTSCS7C 02541 ELSE DTSCS7C 02542 MOVE MSG-E7C3-AREA TO WRK-MSG-AREA DTSCS7C 02543 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS7C 02544 GO TO S1200-EXIT. DTSCS7C 02545 DTSCS7C 02546 IF MFSC-STATUS-OPEN-88 DTSCS7C 02547 IF MAP-STATUS-WITHDRAWN-88 DTSCS7C 02548 NEXT SENTENCE DTSCS7C 02549 ELSE DTSCS7C 02550 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS7C 02551 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS7C 02552 GO TO S1200-EXIT. DTSCS7C 02553 DTSCS7C 02554 MOVE MAP-STATUS-CD TO WRK-STATUS-CD. DTSCS7C 02555 DTSCS7C 02556 S1200-EXIT. DTSCS7C 02557 EXIT. DTSCS7C 02558 DTSCS7C 02559 S1201-ERROR. DTSCS7C 02560 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-STATUS-A DTSCS7C 02561 IF LCCM-NO-MSG DTSCS7C 02562 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS7C 02563 MOVE CATB-CURSOR TO MAP-STATUS-L DTSCS7C 02564 SET CURSOR-SET-YES TO TRUE. DTSCS7C 02565 S1201-EXIT. EXIT. DTSCS7C 02566 DTSCS7C 02567 /*****************************************************************DTSCS7C 02568 * DTSCS7C 02569 ******************************************************************DTSCS7C 02570 S1300-START-YRQ. DTSCS7C 02571 MOVE ZERO TO WRK-START-YRQ DTSCS7C 02572 WRK-START-YEAR DTSCS7C 02573 WRK-ABS-QTR. DTSCS7C 02574 DTSCS7C 02575 MOVE MAP-START-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS7C 02576 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT. DTSCS7C 02577 DTSCS7C 02578 IF L016-NO-ENTRY DTSCS7C 02579 IF LCCM-F10-88 DTSCS7C 02580 IF MFSC-START-YRQ > 0 DTSCS7C 02581 MOVE MFSC-START-YRQ TO WRK-DISPLAY DTSCS7C 02582 L016-YRQ DTSCS7C 02583 MOVE WRK-DISPLAY-YRQ-YY TO MAP-START-YY DTSCS7C 02584 MOVE WRK-DISPLAY-YRQ-Q TO MAP-START-Q DTSCS7C 02585 ELSE DTSCS7C 02586 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS7C 02587 PERFORM S1301-ERROR THRU S1301-ERR-EXIT DTSCS7C 02588 GO TO S1300-EXIT DTSCS7C 02589 END-IF DTSCS7C 02590 ELSE DTSCS7C 02591 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS7C 02592 PERFORM S1301-ERROR THRU S1301-ERR-EXIT DTSCS7C 02593 GO TO S1300-EXIT. DTSCS7C 02594 DTSCS7C 02595 IF L016-NOT-VALID DTSCS7C 02596 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS7C 02597 PERFORM S1301-ERROR THRU S1301-ERR-EXIT DTSCS7C 02598 GO TO S1300-EXIT. DTSCS7C 02599 DTSCS7C 02600 MOVE L016-YRQ TO L004-QTR-5-9 DTSCS7C 02601 WRK-START-YRQ. DTSCS7C 02602 MOVE L004-QTR-5-YR TO WRK-START-YEAR. DTSCS7C 02603 DTSCS7C 02604 IF L004-QTR-5-Q NOT = 1 DTSCS7C 02605 MOVE MSG-E7C2-AREA TO WRK-MSG-AREA DTSCS7C 02606 PERFORM S1301-ERROR THRU S1301-ERR-EXIT DTSCS7C 02607 GO TO S1300-EXIT. DTSCS7C 02608 DTSCS7C 02609 PERFORM S004-FROM-5 THRU S004-EXIT. DTSCS7C 02610 MOVE L004-ABS-QTR TO WRK-ABS-QTR. DTSCS7C 02611 DTSCS7C 02612 MOVE LCCM-CURR-RUN-DATE TO WRK-CURR-DATE. DTSCS7C 02613 COMPUTE WRK-NEXT-YEAR = WRK-CURR-YEAR + 1. DTSCS7C 02614 IF L004-QTR-5-YR > WRK-NEXT-YEAR DTSCS7C 02615 MOVE MSG-E7C4-AREA TO WRK-MSG-AREA DTSCS7C 02616 PERFORM S1301-ERROR THRU S1301-ERR-EXIT DTSCS7C 02617 GO TO S1300-EXIT. DTSCS7C 02618 DTSCS7C 02619 IF LCCM-F09-88 DTSCS7C 02620 *** OR LCCM-SCR-ADD-LOCKED DTSCS7C 02621 PERFORM S1310-CHK-DUP-YRQ THRU S1310-EXIT. DTSCS7C 02622 DTSCS7C 02623 S1300-EXIT. EXIT. DTSCS7C 02624 DTSCS7C 02625 S1301-ERROR. DTSCS7C 02626 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-START-YY-A DTSCS7C 02627 MAP-START-Q-A. DTSCS7C 02628 IF LCCM-NO-MSG DTSCS7C 02629 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS7C 02630 MOVE CATB-CURSOR TO MAP-START-YY-L DTSCS7C 02631 SET CURSOR-SET-YES TO TRUE. DTSCS7C 02632 S1301-ERR-EXIT. EXIT. DTSCS7C 02633 DTSCS7C 02634 S1310-CHK-DUP-YRQ. DTSCS7C 02635 MOVE LOW-VALUES TO MFSC-KEY-AREA. DTSCS7C 02636 MOVE WRK-EMP-NO TO MFSC-EMP-NO. DTSCS7C 02637 SET MFSC-FSC-88 TO TRUE. DTSCS7C 02638 MOVE WRK-ABS-QTR TO MFSC-ABS-QTR. DTSCS7C 02639 MOVE MFSC-KEY-AREA TO MSKL-KEY-AREA. DTSCS7C 02640 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS7C 02641 IF L810-OK-88 DTSCS7C 02642 MOVE MSKL-REC TO MFSC-REC DTSCS7C 02643 IF MFSC-START-YRQ = WRK-START-YRQ DTSCS7C 02644 IF MFSC-STATUS-WITHDRAWN-88 DTSCS7C 02645 NEXT SENTENCE DTSCS7C 02646 ELSE DTSCS7C 02647 MOVE MSG-E7CD-AREA TO WRK-MSG-AREA DTSCS7C 02648 PERFORM S1301-ERROR THRU S1301-ERR-EXIT. DTSCS7C 02649 DTSCS7C 02650 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS7C 02651 DTSCS7C 02652 S1310-EXIT. DTSCS7C 02653 EXIT. DTSCS7C 02654 DTSCS7C 02655 /*****************************************************************DTSCS7C 02656 * DTSCS7C 02657 ******************************************************************DTSCS7C 02658 S1400-FILING-SCHEDULE. DTSCS7C 02659 IF MAP-FILE-SCHED = LOW-VALUES OR SPACES DTSCS7C 02660 IF MAP-STATUS-OPEN-88 DTSCS7C 02661 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS7C 02662 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS7C 02663 GO TO S1400-EXIT DTSCS7C 02664 ELSE DTSCS7C 02665 GO TO S1400-EXIT. DTSCS7C 02666 DTSCS7C 02667 SET L042-MFSC-FILING-SCHEDULE-CD TO TRUE. DTSCS7C 02668 MOVE MAP-FILE-SCHED TO L042-CD. DTSCS7C 02669 PERFORM S042-MFSC-CODES THRU S042-EXIT. DTSCS7C 02670 IF L042-VALID DTSCS7C 02671 IF MAP-STATUS-PENDING-88 DTSCS7C 02672 GO TO S1400-EXIT DTSCS7C 02673 END-IF DTSCS7C 02674 ELSE DTSCS7C 02675 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS7C 02676 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS7C 02677 GO TO S1400-EXIT. DTSCS7C 02678 DTSCS7C 02679 IF MAP-FILE-SCHED-ANN-88 DTSCS7C 02680 IF WRK-START-YRQ < WRK-FIRST-ANN-FILING-YRQ DTSCS7C 02681 MOVE MSG-E7C5-AREA TO WRK-MSG-AREA DTSCS7C 02682 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS7C 02683 GO TO S1400-EXIT. DTSCS7C 02684 DTSCS7C 02685 IF LCCM-F09-88 DTSCS7C 02686 *** OR LCCM-SCR-ADD-LOCKED DTSCS7C 02687 GO TO S1400-EXIT. DTSCS7C 02688 DTSCS7C 02689 IF MAP-STATUS-WITHDRAWN-88 DTSCS7C 02690 IF MAP-FILE-SCHED NOT = MFSC-FILING-SCHEDULE-CD DTSCS7C 02691 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS7C 02692 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS7C 02693 GO TO S1400-EXIT. DTSCS7C 02694 DTSCS7C 02695 IF LCCM-F10-88 DTSCS7C 02696 IF MFSC-STATUS-OPEN-88 DTSCS7C 02697 IF MAP-FILE-SCHED NOT = MFSC-FILING-SCHEDULE-CD DTSCS7C 02698 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS7C 02699 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS7C 02700 GO TO S1400-EXIT. DTSCS7C 02701 DTSCS7C 02702 S1400-EXIT. DTSCS7C 02703 EXIT. DTSCS7C 02704 DTSCS7C 02705 S1401-ERROR. DTSCS7C 02706 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-FILE-SCHED-A. DTSCS7C 02707 DTSCS7C 02708 IF LCCM-NO-MSG DTSCS7C 02709 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS7C 02710 MOVE CATB-CURSOR TO MAP-FILE-SCHED-L DTSCS7C 02711 SET CURSOR-SET-YES TO TRUE. DTSCS7C 02712 S1401-EXIT. EXIT. DTSCS7C 02713 DTSCS7C 02714 /*****************************************************************DTSCS7C 02715 * DTSCS7C 02716 ******************************************************************DTSCS7C 02717 S1500-REQUEST-TYPE. DTSCS7C 02718 IF MAP-REQ-TYPE-CD = LOW-VALUES OR SPACES DTSCS7C 02719 SET MFSC-REQ-EMP-88 TO TRUE DTSCS7C 02720 MOVE MFSC-REQUEST-TYPE-CD TO MAP-REQ-TYPE-CD DTSCS7C 02721 GO TO S1500-EXIT. DTSCS7C 02722 DTSCS7C 02723 SET L042-MFSC-REQUEST-TYPE TO TRUE. DTSCS7C 02724 MOVE MAP-REQ-TYPE-CD TO L042-CD. DTSCS7C 02725 PERFORM S042-MFSC-CODES THRU S042-EXIT. DTSCS7C 02726 IF L042-NOT-VALID DTSCS7C 02727 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS7C 02728 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS7C 02729 END-IF. DTSCS7C 02730 DTSCS7C 02731 S1500-EXIT. DTSCS7C 02732 EXIT. DTSCS7C 02733 DTSCS7C 02734 S1501-ERROR. DTSCS7C 02735 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-REQ-TYPE-A. DTSCS7C 02736 DTSCS7C 02737 IF LCCM-NO-MSG DTSCS7C 02738 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS7C 02739 MOVE CATB-CURSOR TO MAP-REQ-TYPE-L DTSCS7C 02740 SET CURSOR-SET-YES TO TRUE. DTSCS7C 02741 S1501-EXIT. EXIT. DTSCS7C 02742 DTSCS7C 02743 /*****************************************************************DTSCS7C 02744 * DTSCS7C 02745 ** CHANGE REASON NO LONGER USED. THE GENERAL CONSEL DECIDED DTSCS7C 02746 ** THAT ANNUAL FILING CANNOT BE DENIED BECAUSE OF DELINQUENCY DTSCS7C 02747 ** 1/17/2002 - GD DTSCS7C 02748 ******************************************************************DTSCS7C 02749 *S1600-CHANGE-REASON. DTSCS7C 02750 * IF MAP-CHNG-REASN-CD = LOW-VALUES OR SPACES DTSCS7C 02751 * IF MAP-STATUS-DENIED-88 DTSCS7C 02752 * MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS7C 02753 * PERFORM S1601-ERROR THRU S1601-EXIT DTSCS7C 02754 * GO TO S1600-EXIT DTSCS7C 02755 * ELSE DTSCS7C 02756 * GO TO S1600-EXIT DTSCS7C 02757 * END-IF DTSCS7C 02758 * ELSE DTSCS7C 02759 * IF NOT MAP-STATUS-DENIED-88 DTSCS7C 02760 * MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS7C 02761 * PERFORM S1601-ERROR THRU S1601-EXIT DTSCS7C 02762 * GO TO S1600-EXIT DTSCS7C 02763 * END-IF DTSCS7C 02764 * END-IF. DTSCS7C 02765 * DTSCS7C 02766 * SET L042-MFSC-CHANGE-REASON TO TRUE. DTSCS7C 02767 * MOVE MAP-CHNG-REASN-CD TO L042-CD. DTSCS7C 02768 * PERFORM S042-MFSC-CODES THRU S042-EXIT. DTSCS7C 02769 * IF L042-NOT-VALID DTSCS7C 02770 * MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS7C 02771 * PERFORM S1601-ERROR THRU S1601-EXIT DTSCS7C 02772 * END-IF. DTSCS7C 02773 * DTSCS7C 02774 *S1600-EXIT. DTSCS7C 02775 * EXIT. DTSCS7C 02776 * DTSCS7C 02777 *S1601-ERROR. DTSCS7C 02778 * MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-CHNG-REASN-A. DTSCS7C 02779 * DTSCS7C 02780 * IF LCCM-NO-MSG DTSCS7C 02781 * MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS7C 02782 * MOVE CATB-CURSOR TO MAP-CHNG-REASN-L DTSCS7C 02783 * SET CURSOR-SET-YES TO TRUE. DTSCS7C 02784 *S1601-EXIT. EXIT. DTSCS7C 02785 * DTSCS7C 02786 /*****************************************************************DTSCS7C 02787 * DTSCS7C 02788 ******************************************************************DTSCS7C 02789 S1700-TEXT. DTSCS7C 02790 INSPECT MAP-TEXT(WRK-OCC) CONVERTING LOW-VALUES TO SPACES. DTSCS7C 02791 S1700-EXIT. DTSCS7C 02792 EXIT. DTSCS7C 02793 DTSCS7C 02794 S1800-CROSS-EDITS. DTSCS7C 02795 DTSCS7C 02796 PERFORM S1810-FIND-PRIOR-NEXT-MFSC THRU S1810-EXIT. DTSCS7C 02797 DTSCS7C 02798 ************************************************************* DTSCS7C 02799 * DO NOT ALLOW ENTRY OF A NEW OPEN MFSC IF THERE IS ALREADY DTSCS7C 02800 * ONE ON FILE WITH THE START START YRQ. DTSCS7C 02801 ************************************************************* DTSCS7C 02802 IF MAP-STATUS-OPEN-88 DTSCS7C 02803 IF ((LCCM-F09-88) DTSCS7C 02804 OR (LCCM-F10-88 DTSCS7C 02805 AND MFSC-STATUS-CD NOT = MAP-STATUS-CD)) DTSCS7C 02806 IF WRK-PRIOR-YRQ = WRK-START-YRQ DTSCS7C 02807 MOVE MSG-E7CE-AREA TO WRK-MSG-AREA DTSCS7C 02808 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS7C 02809 GO TO S1800-EXIT. DTSCS7C 02810 DTSCS7C 02811 ************************************************************* DTSCS7C 02812 * DO NOT ALLOW ENTRY OF A NEW OPEN MFSC PRIOR TO AN DTSCS7C 02813 * EXISTING MFSC. THIS EDIT ONLY APPLIES WHEN ADDING AN DTSCS7C 02814 * MFSC OR CHANGING THE STATUS OF AN EXISTING RECORD TO OPEN DTSCS7C 02815 ************************************************************* DTSCS7C 02816 IF MAP-STATUS-OPEN-88 DTSCS7C 02817 IF ((LCCM-F09-88) DTSCS7C 02818 OR (LCCM-F10-88 DTSCS7C 02819 AND MFSC-STATUS-CD NOT = MAP-STATUS-CD)) DTSCS7C 02820 IF WRK-NEXT-YRQ < WRK-ALL-NINES-YRQ DTSCS7C 02821 MOVE MSG-E7CC-AREA TO WRK-MSG-AREA DTSCS7C 02822 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS7C 02823 GO TO S1800-EXIT. DTSCS7C 02824 DTSCS7C 02825 *& PERFORM S1820-DELINQUENCY THRU S1820-EXIT DTSCS7C 02826 * IF LCCM-MSG DTSCS7C 02827 * GO TO S1800-EXIT. DTSCS7C 02828 DTSCS7C 02829 IF MAP-STATUS-OPEN-88 DTSCS7C 02830 PERFORM S1830-LIABLE THRU S1830-EXIT. DTSCS7C 02831 IF LCCM-MSG DTSCS7C 02832 GO TO S1800-EXIT. DTSCS7C 02833 DTSCS7C 02834 *** THE FOLLOWING PARAGRAPH NOT NEEDED UNLESS MFSC *** DTSCS7C 02835 *** RECORDS MAY BE ADDED RETROACTIVELY. *** DTSCS7C 02836 DTSCS7C 02837 ** IF (MAP-STATUS-PENDING-88 DTSCS7C 02838 ** OR MAP-STATUS-OPEN-88) DTSCS7C 02839 ** PERFORM S1840-OVERLAP THRU S1840-EXIT DTSCS7C 02840 ** IF LCCM-MSG DTSCS7C 02841 ** GO TO S1800-EXIT. DTSCS7C 02842 DTSCS7C 02843 PERFORM S1850-CHECK-REPORTS THRU S1850-EXIT. DTSCS7C 02844 DTSCS7C 02845 IF MAP-STATUS-WITHDRAWN-88 DTSCS7C 02846 PERFORM S1860-CHECK-WITHDRAWN THRU S1860-EXIT. DTSCS7C 02847 DTSCS7C 02848 S1800-EXIT. DTSCS7C 02849 EXIT. DTSCS7C 02850 DTSCS7C 02851 S1810-FIND-PRIOR-NEXT-MFSC. DTSCS7C 02852 MOVE ZERO TO WRK-OPEN-MFSC-CNT. DTSCS7C 02853 MOVE ZERO TO WRK-PRIOR-YRQ DTSCS7C 02854 WRK-PRIOR-ABS-QTR DTSCS7C 02855 WRK-NEXT-ABS-QTR. DTSCS7C 02856 MOVE WRK-ALL-NINES-YRQ TO WRK-NEXT-YRQ. DTSCS7C 02857 MOVE SPACES TO WRK-PRIOR-SCHED. DTSCS7C 02858 DTSCS7C 02859 MOVE LOW-VALUES TO MFSC-KEY-AREA. DTSCS7C 02860 MOVE WRK-EMP-NO TO MFSC-EMP-NO. DTSCS7C 02861 SET MFSC-FSC-88 TO TRUE. DTSCS7C 02862 MOVE MFSC-KEY-AREA TO MSKL-KEY-AREA. DTSCS7C 02863 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS7C 02864 IF L810-NO-REC-88 DTSCS7C 02865 GO TO S1810-EXIT. DTSCS7C 02866 DTSCS7C 02867 PERFORM DTSCS7C 02868 UNTIL L810-NO-REC-88 DTSCS7C 02869 MOVE MSKL-REC TO MFSC-REC DTSCS7C 02870 IF MFSC-STATUS-OPEN-88 DTSCS7C 02871 ADD +1 TO WRK-OPEN-MFSC-CNT DTSCS7C 02872 IF MFSC-START-YRQ < WRK-START-YRQ DTSCS7C 02873 MOVE MFSC-START-YRQ TO WRK-PRIOR-YRQ DTSCS7C 02874 MOVE MFSC-FILING-SCHEDULE-CD DTSCS7C 02875 TO WRK-PRIOR-SCHED DTSCS7C 02876 END-IF DTSCS7C 02877 IF WRK-NEXT-YRQ = WRK-ALL-NINES-YRQ DTSCS7C 02878 IF MFSC-START-YRQ > WRK-START-YRQ DTSCS7C 02879 MOVE MFSC-START-YRQ TO WRK-NEXT-YRQ DTSCS7C 02880 END-IF DTSCS7C 02881 END-IF DTSCS7C 02882 END-IF DTSCS7C 02883 DTSCS7C 02884 PERFORM S810-READ-NEXT THRU S810-EXIT DTSCS7C 02885 END-PERFORM. DTSCS7C 02886 DTSCS7C 02887 IF WRK-PRIOR-YRQ > ZERO DTSCS7C 02888 MOVE WRK-PRIOR-YRQ TO L004-QTR-5-9. DTSCS7C 02889 PERFORM S004-FROM-5 THRU S004-EXIT DTSCS7C 02890 MOVE L004-ABS-QTR TO WRK-PRIOR-ABS-QTR. DTSCS7C 02891 DTSCS7C 02892 IF WRK-NEXT-YRQ < WRK-ALL-NINES-YRQ DTSCS7C 02893 MOVE WRK-NEXT-YRQ TO L004-QTR-5-9 DTSCS7C 02894 PERFORM S004-FROM-5 THRU S004-EXIT DTSCS7C 02895 MOVE L004-ABS-QTR TO WRK-NEXT-ABS-QTR. DTSCS7C 02896 DTSCS7C 02897 S1810-EXIT. DTSCS7C 02898 EXIT. DTSCS7C 02899 DTSCS7C 02900 ** THE FOLLOWING FIELDS REMOVED. THE GENERAL CONSEL DECIDED DTSCS7C 02901 ** THAT ANNUAL FILING CANNOT BE DENIED BECAUSE OF DELINQUENCY DTSCS7C 02902 ** 1/17/2002 - GD DTSCS7C 02903 *S1820-DELINQUENCY. DTSCS7C 02904 * IF ((LCCM-F09-88) DTSCS7C 02905 * OR (MAP-STATUS-OPEN-88 DTSCS7C 02906 * AND NOT MFSC-STATUS-OPEN-88)) DTSCS7C 02907 * IF MAP-FILE-SCHED-ANN-88 DTSCS7C 02908 * IF MPRF-TOT-BALANCE-AMT > +0 DTSCS7C 02909 * OR MPRF-PURSUED-RPT-CNT > +0 DTSCS7C 02910 * MOVE MSG-E7CE-AREA TO WRK-MSG-AREA DTSCS7C 02911 * PERFORM S1199-ERROR THRU S1199-EXIT. DTSCS7C 02912 * DTSCS7C 02913 *S1820-EXIT. DTSCS7C 02914 * EXIT. DTSCS7C 02915 DTSCS7C 02916 S1830-LIABLE. DTSCS7C 02917 SET WRK-MSOL-FOUND-NO-88 TO TRUE. DTSCS7C 02918 DTSCS7C 02919 MOVE LOW-VALUES TO MSOL-KEY-AREA. DTSCS7C 02920 MOVE WRK-EMP-NO TO MSOL-EMP-NO. DTSCS7C 02921 SET MSOL-SOL-88 TO TRUE. DTSCS7C 02922 MOVE ZEROS TO MSOL-LIAB-DATE. DTSCS7C 02923 MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA. DTSCS7C 02924 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS7C 02925 PERFORM S1831-SCAN-MSOL THRU S1831-EXIT DTSCS7C 02926 UNTIL L810-NO-REC-88 DTSCS7C 02927 OR WRK-MSOL-FOUND-YES-88. DTSCS7C 02928 DTSCS7C 02929 IF WRK-MSOL-FOUND-NO-88 DTSCS7C 02930 IF MAP-STATUS-OPEN-88 DTSCS7C 02931 MOVE MSG-E7C8-AREA TO WRK-MSG-AREA DTSCS7C 02932 PERFORM S1301-ERROR THRU S1301-ERR-EXIT DTSCS7C 02933 END-IF DTSCS7C 02934 ELSE DTSCS7C 02935 IF NOT MPRF-ORG-HSEHLD-DMSTIC-88 DTSCS7C 02936 MOVE MSG-E7C7-AREA TO WRK-MSG-AREA DTSCS7C 02937 PERFORM S1199-ERROR THRU S1199-EXIT. DTSCS7C 02938 DTSCS7C 02939 S1830-EXIT. DTSCS7C 02940 EXIT. DTSCS7C 02941 DTSCS7C 02942 S1831-SCAN-MSOL. DTSCS7C 02943 MOVE MSKL-REC TO MSOL-REC. DTSCS7C 02944 IF MSOL-INACT-ACTIVE-88 DTSCS7C 02945 IF WRK-START-YRQ > MSOL-FIRST-LIAB-YRQ DTSCS7C 02946 SET WRK-MSOL-FOUND-YES-88 TO TRUE DTSCS7C 02947 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS7C 02948 GO TO S1831-EXIT DTSCS7C 02949 ELSE DTSCS7C 02950 MOVE MSOL-FIRST-LIAB-YRQ TO L004-QTR-5-9 DTSCS7C 02951 IF WRK-START-YEAR = L004-QTR-5-YR DTSCS7C 02952 SET WRK-MSOL-FOUND-YES-88 TO TRUE DTSCS7C 02953 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS7C 02954 GO TO S1831-EXIT. DTSCS7C 02955 DTSCS7C 02956 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS7C 02957 DTSCS7C 02958 S1831-EXIT. DTSCS7C 02959 EXIT. DTSCS7C 02960 DTSCS7C 02961 /*****************************************************************DTSCS7C 02962 * CHECK THAT NEW START YRQ IS AT LEAST ONE YEAR GREATER THAN *DTSCS7C 02963 * THE START YRQ ANY PREVIOUS FILING SCHEDULE RECORD AND *DTSCS7C 02964 * AT LEAST ONE YEAR LESS THAN THE START YRQ OF ANY FOLLOWING *DTSCS7C 02965 * FILING SCHEDULE. *DTSCS7C 02966 * DTSCS7C 02967 * *** THIS EDIT NOT NEEDED UNLESS MFSC RECORDS *** *DTSCS7C 02968 * *** MAY BE ADDED RETROACTIVELY. *** *DTSCS7C 02969 ******************************************************************DTSCS7C 02970 *S1840-OVERLAP. DTSCS7C 02971 * IF WRK-PRIOR-ABS-QTR > ZERO DTSCS7C 02972 * IF (WRK-ABS-QTR - WRK-PRIOR-ABS-QTR) < +4 DTSCS7C 02973 * MOVE MSG-E7CA-AREA TO WRK-MSG-AREA DTSCS7C 02974 * PERFORM S1199-ERROR THRU S1199-EXIT. DTSCS7C 02975 * DTSCS7C 02976 * IF WRK-NEXT-ABS-QTR > ZERO DTSCS7C 02977 * IF (WRK-NEXT-ABS-QTR - WRK-ABS-QTR) < +4 DTSCS7C 02978 * MOVE MSG-E7CA-AREA TO WRK-MSG-AREA DTSCS7C 02979 * PERFORM S1199-ERROR THRU S1199-EXIT. DTSCS7C 02980 * DTSCS7C 02981 *S1840-EXIT. DTSCS7C 02982 * EXIT. DTSCS7C 02983 DTSCS7C 02984 /*****************************************************************DTSCS7C 02985 * IF THERE ARE ANY REPORTS ON FILE DURING THE PERIOD COVERED *DTSCS7C 02986 * BY THE NEW SCHEDULE, THEY MUST BE CONSISTENT WITH THE *DTSCS7C 02987 * FILING SCHEDULE TYPE. *DTSCS7C 02988 * *DTSCS7C 02989 ******************************************************************DTSCS7C 02990 S1850-CHECK-REPORTS. DTSCS7C 02991 SET WRK-RPTS-FOUND-NO-88 TO TRUE. DTSCS7C 02992 SET WRK-INCONSIST-RPTS-NO-88 TO TRUE. DTSCS7C 02993 DTSCS7C 02994 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSCS7C 02995 MOVE WRK-EMP-NO TO MQTR-EMP-NO. DTSCS7C 02996 SET MQTR-QTR-88 TO TRUE. DTSCS7C 02997 MOVE WRK-START-YRQ TO MQTR-YRQ. DTSCS7C 02998 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSCS7C 02999 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS7C 03000 IF L810-NO-REC-88 DTSCS7C 03001 GO TO S1850-EXIT. DTSCS7C 03002 DTSCS7C 03003 PERFORM DTSCS7C 03004 UNTIL L810-NO-REC-88 DTSCS7C 03005 MOVE MSKL-REC TO MQTR-REC DTSCS7C 03006 IF (MQTR-YRQ >= WRK-START-YRQ DTSCS7C 03007 AND MQTR-YRQ <= WRK-NEXT-YRQ) DTSCS7C 03008 IF MQTR-CURR-RCVD-88 DTSCS7C 03009 OR MQTR-CURR-ESTIM-88 DTSCS7C 03010 SET WRK-RPTS-FOUND-YES-88 TO TRUE DTSCS7C 03011 PERFORM S1851-CHK-RPT-TYPE THRU S1851-EXIT DTSCS7C 03012 END-IF DTSCS7C 03013 END-IF DTSCS7C 03014 DTSCS7C 03015 PERFORM S810-READ-NEXT THRU S810-EXIT DTSCS7C 03016 END-PERFORM. DTSCS7C 03017 DTSCS7C 03018 IF MAP-STATUS-OPEN-88 DTSCS7C 03019 IF ((LCCM-F09-88) DTSCS7C 03020 OR (LCCM-F10-88 DTSCS7C 03021 AND MFSC-STATUS-CD NOT = MAP-STATUS-CD)) DTSCS7C 03022 IF WRK-INCONSIST-RPTS-YES-88 DTSCS7C 03023 MOVE MSG-E7C9-AREA TO WRK-MSG-AREA DTSCS7C 03024 PERFORM S1199-ERROR THRU S1199-EXIT. DTSCS7C 03025 DTSCS7C 03026 S1850-EXIT. DTSCS7C 03027 EXIT. DTSCS7C 03028 DTSCS7C 03029 S1851-CHK-RPT-TYPE. DTSCS7C 03030 IF MQTR-ANNUAL-YES-88 DTSCS7C 03031 IF MAP-FILE-SCHED-ANN-88 DTSCS7C 03032 NEXT SENTENCE DTSCS7C 03033 ELSE DTSCS7C 03034 SET WRK-INCONSIST-RPTS-YES-88 TO TRUE DTSCS7C 03035 END-IF DTSCS7C 03036 ELSE DTSCS7C 03037 IF MAP-FILE-SCHED-ANN-88 DTSCS7C 03038 SET WRK-INCONSIST-RPTS-YES-88 TO TRUE DTSCS7C 03039 END-IF DTSCS7C 03040 END-IF. DTSCS7C 03041 DTSCS7C 03042 S1851-EXIT. DTSCS7C 03043 EXIT. DTSCS7C 03044 DTSCS7C 03045 /*****************************************************************DTSCS7C 03046 * A FILING SCHEDULE MAY NOT BE WITHDRAWN IF THERE ARE REPORTS *DTSCS7C 03047 * ON FILE FOR THE PERIOD COVERED BY THE SCHEDULE. IF THE *DTSCS7C 03048 * SCHEDULE MUST BE WITHDRAWN, FIRST WITHDRAW THE REPORTS. *DTSCS7C 03049 ******************************************************************DTSCS7C 03050 S1860-CHECK-WITHDRAWN. DTSCS7C 03051 IF MAP-STATUS-WITHDRAWN-88 DTSCS7C 03052 AND NOT MFSC-STATUS-WITHDRAWN-88 DTSCS7C 03053 NEXT SENTENCE DTSCS7C 03054 ELSE DTSCS7C 03055 GO TO S1860-EXIT. DTSCS7C 03056 DTSCS7C 03057 DTSCS7C 03058 IF WRK-RPTS-FOUND-YES-88 DTSCS7C 03059 SET WRK-DUP-FOUND-NO-88 TO TRUE DTSCS7C 03060 PERFORM S1861-CHECK-DUP THRU S1861-EXIT DTSCS7C 03061 IF WRK-DUP-FOUND-NO-88 DTSCS7C 03062 MOVE MSG-E7CB-AREA TO WRK-MSG-AREA DTSCS7C 03063 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS7C 03064 END-IF DTSCS7C 03065 END-IF. DTSCS7C 03066 DTSCS7C 03067 S1860-EXIT. DTSCS7C 03068 EXIT. DTSCS7C 03069 DTSCS7C 03070 S1861-CHECK-DUP. DTSCS7C 03071 MOVE LOW-VALUES TO MFSC-KEY-AREA. DTSCS7C 03072 MOVE WRK-EMP-NO TO MFSC-EMP-NO. DTSCS7C 03073 SET MFSC-FSC-88 TO TRUE. DTSCS7C 03074 MOVE MFSC-KEY-AREA TO MSKL-KEY-AREA. DTSCS7C 03075 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS7C 03076 IF L810-NO-REC-88 DTSCS7C 03077 GO TO S1861-EXIT. DTSCS7C 03078 DTSCS7C 03079 PERFORM DTSCS7C 03080 UNTIL L810-NO-REC-88 DTSCS7C 03081 OR WRK-DUP-FOUND-YES-88 DTSCS7C 03082 MOVE MSKL-REC TO MFSC-REC DTSCS7C 03083 IF MFSC-STATUS-OPEN-88 DTSCS7C 03084 IF MFSC-START-YRQ = WRK-START-YRQ DTSCS7C 03085 SET WRK-DUP-FOUND-YES-88 TO TRUE DTSCS7C 03086 END-IF DTSCS7C 03087 END-IF DTSCS7C 03088 DTSCS7C 03089 PERFORM S810-READ-NEXT THRU S810-EXIT DTSCS7C 03090 END-PERFORM. DTSCS7C 03091 DTSCS7C 03092 S1861-EXIT. DTSCS7C 03093 EXIT. DTSCS7C 03094 DTSCS7C 03095 S2000-CHECK-RATES. DTSCS7C 03096 IF MAP-VERIFY-YES-88 DTSCS7C 03097 GO TO S2000-EXIT. DTSCS7C 03098 DTSCS7C 03099 IF (MAP-STATUS-OPEN-88 DTSCS7C 03100 AND MAP-FILE-SCHED-QTR-88) DTSCS7C 03101 OR (MAP-STATUS-WITHDRAWN-88 DTSCS7C 03102 AND WRK-PRIOR-SCHED-QTR-88) DTSCS7C 03103 NEXT SENTENCE DTSCS7C 03104 ELSE DTSCS7C 03105 GO TO S2000-EXIT DTSCS7C 03106 END-IF. DTSCS7C 03107 DTSCS7C 03108 DTSCS7C 03109 MOVE LOW-VALUES TO MRTE-KEY-AREA. DTSCS7C 03110 MOVE WRK-EMP-NO TO MRTE-EMP-NO. DTSCS7C 03111 SET MRTE-RTE-88 TO TRUE. DTSCS7C 03112 DTSCS7C 03113 IF MAP-STATUS-WITHDRAWN-88 DTSCS7C 03114 MOVE WRK-PRIOR-YRQ TO L006-YRQ DTSCS7C 03115 ELSE DTSCS7C 03116 MOVE WRK-START-YRQ TO L006-YRQ. DTSCS7C 03117 SET L006-FROM-QTR TO TRUE. DTSCS7C 03118 PERFORM S006-RATING-YRQ THRU S006-EXIT. DTSCS7C 03119 MOVE L006-RTE-YR-START-YRQ TO MRTE-EFF-YRQ. DTSCS7C 03120 DTSCS7C 03121 MOVE MRTE-KEY-AREA TO MSKL-KEY-AREA. DTSCS7C 03122 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS7C 03123 IF L810-NO-REC-88 DTSCS7C 03124 GO TO S2000-EXIT. DTSCS7C 03125 DTSCS7C 03126 PERFORM DTSCS7C 03127 UNTIL L810-NO-REC-88 DTSCS7C 03128 MOVE MSKL-REC TO MRTE-REC DTSCS7C 03129 IF MRTE-RATE-TYPE-ESTIM-88 DTSCS7C 03130 MOVE MSG-E7CF-AREA TO WRK-MSG-AREA DTSCS7C 03131 PERFORM S2001-ERROR THRU S2001-EXIT DTSCS7C 03132 END-IF DTSCS7C 03133 PERFORM S810-READ-NEXT THRU S810-EXIT DTSCS7C 03134 END-PERFORM. DTSCS7C 03135 DTSCS7C 03136 S2000-EXIT. DTSCS7C 03137 EXIT. DTSCS7C 03138 DTSCS7C 03139 S2001-ERROR. DTSCS7C 03140 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-VERIFY-A. DTSCS7C 03141 MOVE CATB-ASKIP-BRT-MDTOFF TO MAP-VERIFY-LIT-A. DTSCS7C 03142 MOVE 'VERIFY?' TO MAP-VERIFY-LIT. DTSCS7C 03143 DTSCS7C 03144 IF LCCM-NO-MSG DTSCS7C 03145 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS7C 03146 MOVE CATB-CURSOR TO MAP-VERIFY-L DTSCS7C 03147 SET CURSOR-SET-YES TO TRUE. DTSCS7C 03148 DTSCS7C 03149 S2001-EXIT. EXIT. DTSCS7C 03150 DTSCS7C 03151 /*****************************************************************DTSCS7C 03152 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCS7C 03153 ******************************************************************DTSCS7C 03154 S5100-SET-LOCK-ATTRB. DTSCS7C 03155 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS7C 03156 WRK-ATB-NUM. DTSCS7C 03157 DTSCS7C 03158 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS7C 03159 DTSCS7C 03160 MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-NO-1-A DTSCS7C 03161 MAP-EMP-NO-2-A DTSCS7C 03162 MAP-STATUS-A DTSCS7C 03163 MAP-START-YY-A DTSCS7C 03164 MAP-START-Q-A DTSCS7C 03165 MAP-GOTO-A. DTSCS7C 03166 S5100-EXIT. DTSCS7C 03167 EXIT. DTSCS7C 03168 DTSCS7C 03169 ******************************************************************DTSCS7C 03170 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS7C 03171 ******************************************************************DTSCS7C 03172 S5200-SET-UPDATE-ATTRB. DTSCS7C 03173 MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN. DTSCS7C 03174 MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM. DTSCS7C 03175 DTSCS7C 03176 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS7C 03177 DTSCS7C 03178 S5200-EXIT. DTSCS7C 03179 EXIT. DTSCS7C 03180 DTSCS7C 03181 ******************************************************************DTSCS7C 03182 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS7C 03183 ******************************************************************DTSCS7C 03184 S5300-SET-INQ-ATTRB. DTSCS7C 03185 MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN DTSCS7C 03186 WRK-ATB-NUM. DTSCS7C 03187 DTSCS7C 03188 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS7C 03189 S5300-EXIT. DTSCS7C 03190 EXIT. DTSCS7C 03191 DTSCS7C 03192 S5900-SET-ATTRB. DTSCS7C 03193 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS7C 03194 MAP-EMP-NO-2-A. DTSCS7C 03195 DTSCS7C 03196 IF REQ-INQUIRE DTSCS7C 03197 MOVE CATB-UNPROT-BRT-AN-MDTOFF TO MAP-STATUS-A DTSCS7C 03198 MOVE CATB-UNPROT-BRT-NUM-MDTOFF TO MAP-START-YY-A DTSCS7C 03199 MAP-START-Q-A DTSCS7C 03200 ELSE DTSCS7C 03201 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-STATUS-A DTSCS7C 03202 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-START-YY-A DTSCS7C 03203 MAP-START-Q-A. DTSCS7C 03204 DTSCS7C 03205 MOVE CATB-ASKIP-DRK-MDTOFF TO MAP-VERIFY-A. DTSCS7C 03206 MOVE CATB-ASKIP-DRK-MDTOFF TO MAP-VERIFY-LIT-A. DTSCS7C 03207 DTSCS7C 03208 MOVE WRK-ATB-AN TO DTSCS7C 03209 MAP-FILE-SCHED-A DTSCS7C 03210 MAP-REQ-TYPE-A. DTSCS7C 03211 DTSCS7C 03212 PERFORM DTSCS7C 03213 VARYING WRK-OCC FROM 1 BY 1 DTSCS7C 03214 UNTIL WRK-OCC > MMAX-FSC-TEXT-MAX DTSCS7C 03215 MOVE WRK-ATB-AN TO DTSCS7C 03216 MAP-TEXT-A(WRK-OCC) DTSCS7C 03217 END-PERFORM. DTSCS7C 03218 DTSCS7C 03219 MOVE CATB-ASKIP-BRT-MDTON TO DTSCS7C 03220 MAP-PAGE-NO-A DTSCS7C 03221 MAP-TOT-PAGES-A DTSCS7C 03222 MAP-PRIMARY-NAME-A. DTSCS7C 03223 DTSCS7C 03224 MOVE CATB-ASKIP-NORM-MDTON TO DTSCS7C 03225 MAP-STATUS-DSCR-A DTSCS7C 03226 MAP-REQ-TYPE-DESC-A DTSCS7C 03227 MAP-FILE-SCHED-DESC-A DTSCS7C 03228 MAP-INIT-LTR-TYPE-A DTSCS7C 03229 MAP-CONF-LTR-TYPE-A DTSCS7C 03230 MAP-END-YY-A DTSCS7C 03231 MAP-END-Q-A DTSCS7C 03232 MAP-INIT-MAIL-MM-A DTSCS7C 03233 MAP-INIT-MAIL-DD-A DTSCS7C 03234 MAP-INIT-MAIL-YY-A DTSCS7C 03235 MAP-CONF-MAIL-MM-A DTSCS7C 03236 MAP-CONF-MAIL-DD-A DTSCS7C 03237 MAP-CONF-MAIL-YY-A. DTSCS7C 03238 DTSCS7C 03239 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS7C 03240 S5900-EXIT. DTSCS7C 03241 EXIT. DTSCS7C 03242 EJECT DTSCS7C 03243 /*****************************************************************DTSCS7C 03244 * MAP ROUTINES *DTSCS7C 03245 ******************************************************************DTSCS7C 03246 S9100-RECEIVE. DTSCS7C 03247 SET L851-RECEIVE-88 TO TRUE. DTSCS7C 03248 DTSCS7C 03249 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS7C 03250 DTSCS7C 03251 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS7C 03252 DTSCS7C 03253 MOVE L851-AID TO LCCM-AID. DTSCS7C 03254 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS7C 03255 S9100-EXIT. DTSCS7C 03256 EXIT. DTSCS7C 03257 DTSCS7C 03258 S9200-SEND-DATAONLY. DTSCS7C 03259 MOVE LOW-VALUES TO MAP-AREA. DTSCS7C 03260 DTSCS7C 03261 IF LCCM-NO-MSG DTSCS7C 03262 NEXT SENTENCE DTSCS7C 03263 ELSE DTSCS7C 03264 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS7C 03265 DTSCS7C 03266 IF CURSOR-SET-GOTO DTSCS7C 03267 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS7C 03268 ELSE DTSCS7C 03269 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS7C 03270 DTSCS7C 03271 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS7C 03272 DTSCS7C 03273 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS7C 03274 DTSCS7C 03275 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS7C 03276 S9200-EXIT. DTSCS7C 03277 EXIT. DTSCS7C 03278 DTSCS7C 03279 S9300-SEND-MAP. DTSCS7C 03280 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS7C 03281 MOVE SPACES TO MAP-SYS-TIME. DTSCS7C 03282 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS7C 03283 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS7C 03284 DTSCS7C 03285 IF SCR-ACCESS-UPDATE DTSCS7C 03286 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS7C 03287 ELSE DTSCS7C 03288 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS7C 03289 DTSCS7C 03290 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCS7C 03291 DTSCS7C 03292 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS7C 03293 DTSCS7C 03294 IF CURSOR-SET-NO DTSCS7C 03295 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS7C 03296 DTSCS7C 03297 SET L851-SEND-88 TO TRUE. DTSCS7C 03298 DTSCS7C 03299 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS7C 03300 DTSCS7C 03301 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS7C 03302 S9300-EXIT. DTSCS7C 03303 EXIT. DTSCS7C 03304 DTSCS7C 03305 S9310-UPDATE-FKEYS. DTSCS7C 03306 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS7C 03307 DTSCS7C 03308 DTSCS7C 03309 IF LCCM-SCR-CLEAR DTSCS7C 03310 MOVE CFKD-ADD TO MAP-KEY-ADD DTSCS7C 03311 ELSE DTSCS7C 03312 IF LCCM-SCR-INQUIRE DTSCS7C 03313 MOVE CFKD-MOD TO MAP-KEY-MOD DTSCS7C 03314 ELSE DTSCS7C 03315 IF LCCM-SCR-UPDATE-LOCKED DTSCS7C 03316 MOVE LOW-VALUES TO MAP-KEY-FIRST DTSCS7C 03317 MAP-KEY-LAST DTSCS7C 03318 MAP-KEY-BACK DTSCS7C 03319 MAP-KEY-FWRD. DTSCS7C 03320 DTSCS7C 03321 S9310-EXIT. DTSCS7C 03322 EXIT. DTSCS7C 03323 DTSCS7C 03324 S9320-INQUIRY-FKEYS. DTSCS7C 03325 MOVE CFKD-FIRST TO MAP-KEY-FIRST. DTSCS7C 03326 MOVE CFKD-LAST TO MAP-KEY-LAST. DTSCS7C 03327 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS7C 03328 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS7C 03329 DTSCS7C 03330 MOVE LOW-VALUES TO MAP-KEY-MOD DTSCS7C 03331 MAP-KEY-DEL DTSCS7C 03332 MAP-KEY-ADD. DTSCS7C 03333 DTSCS7C 03334 S9320-EXIT. EXIT. DTSCS7C 03335 DTSCS7C 03336 S9330-DSCR-FIELDS. DTSCS7C 03337 IF WRK-MPRF-YES-88 DTSCS7C 03338 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME DTSCS7C 03339 ELSE DTSCS7C 03340 MOVE SPACES TO MAP-PRIMARY-NAME. DTSCS7C 03341 DTSCS7C 03342 IF MAP-STATUS-CD = LOW-VALUES OR SPACES DTSCS7C 03343 MOVE LOW-VALUES TO MAP-STATUS-DSCR DTSCS7C 03344 ELSE DTSCS7C 03345 SET L042-MFSC-STATUS-CD TO TRUE DTSCS7C 03346 MOVE MAP-STATUS-CD TO L042-CD DTSCS7C 03347 PERFORM S042-MFSC-CODES THRU S042-EXIT DTSCS7C 03348 MOVE L042-SHORT-DSCR TO MAP-STATUS-DSCR. DTSCS7C 03349 DTSCS7C 03350 IF MAP-FILE-SCHED = LOW-VALUES OR SPACES DTSCS7C 03351 MOVE LOW-VALUES TO MAP-FILE-SCHED-DESC DTSCS7C 03352 ELSE DTSCS7C 03353 SET L042-MFSC-FILING-SCHEDULE-CD TO TRUE DTSCS7C 03354 MOVE MAP-FILE-SCHED TO L042-CD DTSCS7C 03355 PERFORM S042-MFSC-CODES THRU S042-EXIT DTSCS7C 03356 MOVE L042-SHORT-DSCR TO MAP-FILE-SCHED-DESC. DTSCS7C 03357 DTSCS7C 03358 IF MAP-REQ-TYPE-CD = LOW-VALUES OR SPACES DTSCS7C 03359 MOVE LOW-VALUES TO MAP-REQ-TYPE-DESC DTSCS7C 03360 ELSE DTSCS7C 03361 SET L042-MFSC-REQUEST-TYPE TO TRUE DTSCS7C 03362 MOVE MAP-REQ-TYPE-CD TO L042-CD DTSCS7C 03363 PERFORM S042-MFSC-CODES THRU S042-EXIT DTSCS7C 03364 MOVE L042-LONG-DSCR TO MAP-REQ-TYPE-DESC. DTSCS7C 03365 DTSCS7C 03366 DTSCS7C 03367 IF MFSC-INIT-NOTICE-TYPE = LOW-VALUES OR SPACES DTSCS7C 03368 MOVE LOW-VALUES TO MAP-INIT-LTR-TYPE DTSCS7C 03369 ELSE DTSCS7C 03370 SET L042-MFSC-INIT-NOTICE-TYPE TO TRUE DTSCS7C 03371 MOVE MFSC-INIT-NOTICE-TYPE TO L042-CD DTSCS7C 03372 PERFORM S042-MFSC-CODES THRU S042-EXIT DTSCS7C 03373 MOVE L042-LONG-DSCR TO MAP-INIT-LTR-TYPE. DTSCS7C 03374 DTSCS7C 03375 IF MFSC-CONFIRM-NOTICE-TYPE = LOW-VALUES OR SPACES DTSCS7C 03376 MOVE LOW-VALUES TO MAP-CONF-LTR-TYPE DTSCS7C 03377 ELSE DTSCS7C 03378 SET L042-MFSC-CONF-NOTICE-TYPE TO TRUE DTSCS7C 03379 MOVE MFSC-CONFIRM-NOTICE-TYPE TO L042-CD DTSCS7C 03380 PERFORM S042-MFSC-CODES THRU S042-EXIT DTSCS7C 03381 MOVE L042-LONG-DSCR TO MAP-CONF-LTR-TYPE. DTSCS7C 03382 DTSCS7C 03383 S9330-EXIT. EXIT. DTSCS7C 03384 DTSCS7C 03385 S9900-PREPARE-SEND. DTSCS7C 03386 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS7C 03387 LCCM-SCR-ID. DTSCS7C 03388 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS7C 03389 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS7C 03390 S9900-EXIT. DTSCS7C 03391 EXIT. DTSCS7C