giteaadmin/DUTAS
4
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
ef98c08de5fbfa133def68d439cb1d035e2bc620
DUTAS/CICS/DTSCS7C.cob
Neeraj Kumar ca3572c5df DUTAS re-platformed to Raincode - Initial Source Code
2025-07-21 11:20:11 -04:00

3393 lines
265 KiB
COBOL
Raw Blame History

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
Reference in New Issue View Git Blame Copy Permalink