00001 IDENTIFICATION DIVISION. 02/07/12 00002 PROGRAM-ID. DTSCS61. DTSCS61 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV041 00004 DATE-WRITTEN. MAY 1994. DTSCS61 00005 DATE-COMPILED. DTSCS61 00006 SKIP3 DTSCS61 00007 ***** DTSCS61 00008 * DTSCS61 00009 * FUNCTION: FIELD ASSIGNMENT INITIATION DTSCS61 00010 * SCREEN PROCESSOR. DTSCS61 00011 * DTSCS61 00012 * DTSCS61 00013 * MODIFICATION LOG: DTSCS61 00014 * DTSCS61 00015 * 11/11/98 INITIAL DEVELOPMENT. COPIED FROM MACCS61 DTSCS61 00016 * WORK ORDER: PROGRAMMER: ZL1 DTSCS61 00017 * DTSCS61 00018 * DTSCS61 00019 * 02/23/2000 ALLOW AN AUDIT ASSINMENT TO BE ATTACHED TO AN DTSCS61 00020 * MPRF-CLASS-UNK-88 EMPLOYER. DTSCS61 00021 * REFERENCE: UIPL 03-99 PROGRAMMER: EHH DTSCS61 00022 * DTSCS61 00023 * DTSCS61 00024 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS61 00025 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS61 00026 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSCS61 00027 * DTSCS61 00028 * DESCRIPTION: DTSCS61 00029 * DTSCS61 00030 * DTSCS61 00031 * CLEAR: DTSCS61 00032 * DTSCS61 00033 * FIELD DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO). DTSCS61 00034 * DTSCS61 00035 * DTSCS61 00036 * JUMP: DTSCS61 00037 * DTSCS61 00038 * F17 REGISTRATION INQUIRY/UPDATE (11) DTSCS61 00039 * DTSCS61 00040 * DTSCS61 00041 * INQUIRY: DTSCS61 00042 * DTSCS61 00043 * CONTROL FIELD: MAP-EMP-NO DTSCS61 00044 * DTSCS61 00045 * JUMP IN: DISPLAY PRIMARY NAME ASSOCIATED WITH LCCM-EMP-NO. DTSCS61 00046 * DTSCS61 00047 * ENTER: DISPLAY PRIMARY NAME ASSOCIATED WITH LCCM-EMP-NO. DTSCS61 00048 * DTSCS61 00049 * JUMP OUT: NO SPECIAL PROCESSING. DTSCS61 00050 * DTSCS61 00051 * DTSCS61 00052 * LCCM DATA ELEMENT MAINTENANCE. DTSCS61 00053 * DTSCS61 00054 * STANDARD LCCM-EMP-NO MAINTENANCE. DTSCS61 00055 * DTSCS61 00056 * STANDARD LCCM-ASSIGN-NO MAINTENANCE. DTSCS61 00057 * DTSCS61 00058 * STANDARD LCCM-RESP-OP-ID MAINTENANCE. DTSCS61 00059 * DTSCS61 00060 * STANDARD LCCM-OP-PRINTER-ID MAINTENANCE. DTSCS61 00061 * DTSCS61 00062 * DTSCS61 00063 * UPDATE: DTSCS61 00064 * DTSCS61 00065 * ADD DTSCS61 00066 * DTSCS61 00067 * ADD A MFAS RECORD TO THE MASTER FILE. READ UPDATE/ DTSCS61 00068 * REWRITE THE MASTER FILE MHDR RECORD TO OBTAIN AN DTSCS61 00069 * ASSIGNMENT NUMBER. DTSCS61 00070 * DTSCS61 00071 * IF MAP-COPY-CNT IS GREATER THAN ZERO (IF MAP-COPY-CNT DTSCS61 00072 * IS NOT ENTERED, THEN MAP-COPY-CNT DEFAULTS TO 0), DTSCS61 00073 * THEN LINK TO MACCU351 FOR ON-LINE PRINT OF THE FIELD DTSCS61 00074 * ASSIGNMENT MEMORANDUM. DTSCS61 00075 * DTSCS61 00076 * MOVE 'Y' TO MPRF-MFAS-IND. DTSCS61 00077 * DTSCS61 00078 * IF THE ASSIGNMENT IS AN AUDIT ASSIGNMENT, THEN WRITE DTSCS61 00079 * AN MEVL RECORD TO COMMEMORATE THE EVENT (FOR DTSCS61 00080 * EXAMPLE, SEE MACCS1A). DTSCS61 00081 * DTSCS61 00082 * DTSCS61 00083 * RECORDS READ: DTSCS61 00084 * DTSCS61 00085 * MASTER: DTSCS61 00086 * DTSCS61 00087 * MHDR DTSCS61 00088 * MPRF DTSCS61 00089 * MFAS DTSCS61 00090 * DTSCS61 00091 * DTSCS61 00092 * ALTERNATE INDEX: DTSCS61 00093 * DTSCS61 00094 * NONE. DTSCS61 00095 * DTSCS61 00096 * DTSCS61 00097 * REFERENCE: DTSCS61 00098 * DTSCS61 00099 * NONE. DTSCS61 00100 * DTSCS61 00101 * DTSCS61 00102 * ACCOUNTING TRANSACTION COLLECTION: DTSCS61 00103 * DTSCS61 00104 * NONE. DTSCS61 00105 * DTSCS61 00106 * DTSCS61 00107 * RECORDS UPDATED: DTSCS61 00108 * DTSCS61 00109 * MASTER: DTSCS61 00110 * DTSCS61 00111 * MHDR (REWRITE) DTSCS61 00112 * MPRF (REWRITE) DTSCS61 00113 * MFAS (WRITE) DTSCS61 00114 * MEVL (WRITE) DTSCS61 00115 * DTSCS61 00116 * DTSCS61 00117 * REFERENCE: DTSCS61 00118 * DTSCS61 00119 * NONE. DTSCS61 00120 * DTSCS61 00121 * DTSCS61 00122 * ACCOUNTING TRANSACTION COLLECTION: DTSCS61 00123 * DTSCS61 00124 * NONE. DTSCS61 00125 * DTSCS61 00126 * DTSCS61 00127 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCS61 00128 * DTSCS61 00129 * IF MAP-TAX-EXTRACT = 'Y' DTSCS61 00130 * WRITE A T021 (TRN-CD = '01') RECORD. DTSCS61 00131 * DTSCS61 00132 * IF MAP-WAGE-EXTRACT = 'Y' DTSCS61 00133 * WRITE A T021 (TRN-CD = '02') RECORD. DTSCS61 00134 * DTSCS61 00135 * DTSCS61 00136 * TEMPORARY STORAGE USAGE: DTSCS61 00137 * DTSCS61 00138 * NONE. DTSCS61 00139 * DTSCS61 00140 * DTSCS61 00141 * MODULES LINKED TO: DTSCS61 00142 * DTSCS61 00143 * DTSCU001 DATE EDIT/CONVERSION. DTSCS61 00144 * DTSCU004 QUARTER EDIT/CONVERSION. DTSCS61 00145 * DTSCU015 DATE FROM SCREEN FORMAT/EDIT. DTSCS61 00146 * DTSCU018 EMP NO FROM SCREEN FORMAT/EDIT. DTSCS61 00147 * DTSCU020 SOCIAL SECURITY NUMBER FROM SCREEN FORMAT/EDIT. DTSCS61 00148 * DTSCU024 YEAR/QUARTER RANGE FROM SCREEN FORMAT/EDIT. DTSCS61 00149 * DTSCU038 R&A CODES EDIT/DESCRIPTION. DTSCS61 00150 * DTSCU039 SIC CODE EDIT/DESCRIPTION. DTSCS61 00151 * DTSCU061 FIELD ZIP/FIELD REP ID. DTSCS61 00152 * DTSCU062 FIELD REP ID EDIT/DESCRIPTION. DTSCS61 00153 * DTSCU063 FIELD ASSIGNMENT TYPE EDIT/DESCRIPTION. DTSCS61 00154 * DTSCU071 NAME EDIT/CONVERSION. DTSCS61 00155 * DTSCU081 CLAIMANT NAME LOOKUP. DTSCS61 00156 * DTSCU082 OPERATOR ID EDIT/LOOKUP. DTSCS61 00157 * DTSCU221 MPRF-UPDATE DATA ELEMENT MAINTENANCE. DTSCS61 00158 * DTSCU351 FIELD ASSIGNMENT MEMORANDUM PRINT. DTSCS61 00159 * DTSCU810 MASTER FILE INPUT/OUTPUT. DTSCS61 00160 * DTSCU825 ON-LINE ACTIVITY FILE OUTPUT. DTSCS61 00161 * DTSCS61 00162 * DTSCS61 00163 DTSCS61 00164 ENVIRONMENT DIVISION. DTSCS61 00165 DTSCS61 00166 DATA DIVISION. DTSCS61 00167 DTSCS61 00168 WORKING-STORAGE SECTION. DTSCS61 001685 77 PAN-VALET PICTURE X(24) VALUE '041DTSCS61 02/07/12'. DTSCS61 00169 DTSCS61 00170 01 WRK-AREA. DTSCS61 00171 05 WRK-ABEND-CD PIC X(04) VALUE 'S61 '. DTSCS61 00172 DTSCS61 00173 05 WRK-SCR-ID. DTSCS61 00174 10 WRK-SCR-ID-N PIC 9(02) VALUE 61. DTSCS61 00175 DTSCS61 00176 05 WRK-F03-SCR-ID PIC X(02) VALUE '60'. DTSCS61 00177 DTSCS61 00178 05 SCR-ACCESS-IND PIC X(01). DTSCS61 00179 88 SCR-ACCESS-INQ VALUE '1'. DTSCS61 00180 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS61 00181 DTSCS61 00182 05 CURSOR-SET-IND PIC X(01). DTSCS61 00183 88 CURSOR-SET-YES VALUE 'Y'. DTSCS61 00184 88 CURSOR-SET-NO VALUE 'N'. DTSCS61 00185 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS61 00186 DTSCS61 00187 05 REQ-IND PIC X(01). DTSCS61 00188 88 REQ-ERROR VALUE 'O'. DTSCS61 00189 88 REQ-JUMP VALUE 'J'. DTSCS61 00190 88 REQ-INQUIRE VALUE 'I'. DTSCS61 00191 88 REQ-CLEAR VALUE 'C'. DTSCS61 00192 88 REQ-EDIT VALUE 'E'. DTSCS61 00193 88 REQ-UPDATE VALUE 'U'. DTSCS61 00194 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS61 00195 DTSCS61 00196 05 RESP-IND PIC X(01). DTSCS61 00197 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS61 00198 88 RESP-SEND-MAP VALUE 'M'. DTSCS61 00199 88 RESP-JUMP VALUE 'J'. DTSCS61 00200 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS61 00201 DTSCS61 00202 05 WRK-MSG-AREA PIC X(64). DTSCS61 00203 DTSCS61 00204 05 WRK-ATB-AN PIC X(01). DTSCS61 00205 05 WRK-ATB-NUM PIC X(01). DTSCS61 00206 DTSCS61 00207 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSCS61 00208 DTSCS61 00209 05 WRK-CTR PIC S9(04) COMP. DTSCS61 00210 DTSCS61 00211 05 WRK-MPRF-IND PIC X(01). DTSCS61 00212 88 WRK-MPRF-YES-88 VALUE 'Y'. DTSCS61 00213 88 WRK-MPRF-NO-88 VALUE 'N'. DTSCS61 00214 DTSCS61 00215 05 WRK-EXTRACT-REQ-IND PIC X(01). DTSCS61 00216 88 WRK-EXTRACT-REQ-YES-88 VALUE 'Y'. DTSCS61 00217 88 WRK-EXTRACT-REQ-NO-88 VALUE 'N'. DTSCS61 00218 DTSCS61 00219 05 WRK-DISPLAY PIC 9(11). DTSCS61 00220 DTSCS61 00221 05 FILLER REDEFINES WRK-DISPLAY. DTSCS61 00222 10 FILLER PIC X(05). DTSCS61 00223 10 WRK-DISPLAY-EMP-NO-1 PIC X(03). DTSCS61 00224 10 WRK-DISPLAY-EMP-NO-2 PIC X(03). DTSCS61 00225 DTSCS61 00226 05 FILLER REDEFINES WRK-DISPLAY. DTSCS61 00227 10 FILLER PIC X(08). DTSCS61 00228 10 WRK-DISPLAY-QTR-YR PIC X(02). DTSCS61 00229 10 WRK-DISPLAY-QTR-Q PIC X(01). DTSCS61 00230 DTSCS61 00231 05 FILLER REDEFINES WRK-DISPLAY. DTSCS61 00232 10 FILLER PIC 9(05). DTSCS61 00233 10 WRK-DISPLAY-YR PIC 9(02). DTSCS61 00234 10 WRK-DISPLAY-MO PIC 9(02). DTSCS61 00235 10 WRK-DISPLAY-DA PIC 9(02). DTSCS61 00236 DTSCS61 00237 05 INQUIRY-CONTROL-AREA. DTSCS61 00238 10 LAST-REC-NUM PIC S9(08) COMP. DTSCS61 00239 DTSCS61 00240 10 WS-REC-NUM PIC S9(08) COMP. DTSCS61 00241 DTSCS61 00242 10 LAST-REC-KEY-AREA PIC X(16). DTSCS61 00243 DTSCS61 00244 10 SCR-REC-KEY-AREA PIC X(16). DTSCS61 00245 DTSCS61 00246 10 WS-REC-FOUND-IND PIC X(01). DTSCS61 00247 DTSCS61 00248 DTSCS61 00249 DTSCS61 00250 * 05 WRK-ASSIGN-TYPE-ERROR-IND PIC X(01). DTSCS61 00251 * 88 WRK-ASSIGN-TYPE-ERROR-YES VALUE 'Y'. DTSCS61 00252 * 88 WRK-ASSIGN-TYPE-ERROR-NO VALUE 'N'. DTSCS61 00253 DTSCS61 00254 05 WRK-START-DATE-ERROR-IND PIC X(01). DTSCS61 00255 88 WRK-START-DATE-ERROR-YES VALUE 'Y'. DTSCS61 00256 88 WRK-START-DATE-ERROR-NO VALUE 'N'. DTSCS61 00257 DTSCS61 00258 05 WRK-FLD-REP-ENTERED-IND PIC X(01). DTSCS61 00259 88 WRK-FLD-REP-NOT-ENTERED VALUE 'Y'. DTSCS61 00260 88 WRK-FLD-REP-ENTERED VALUE 'N'. DTSCS61 00261 DTSCS61 00262 05 WRK-START-DATE PIC S9(09) COMP-3. DTSCS61 00263 DTSCS61 00264 05 WRK-L331-REC-OCC-ID PIC X(20). DTSCS61 00265 05 FILLER REDEFINES WRK-L331-REC-OCC-ID. DTSCS61 00266 10 WRK-L331-ASSIGN-NO PIC 9(09). DTSCS61 00267 10 FILLER PIC X(11). DTSCS61 00268 DTSCS61 00269 EJECT DTSCS61 00270 DTSCS61 00271 ***** DTSCS61 00272 * DTSCS61 00273 ***** DTSCS61 00274 DTSCS61 00275 01 MSG-LITERALS. DTSCS61 00276 DTSCS61 00277 05 MSG-E611-AREA. DTSCS61 00278 10 FILLER PIC X(04) VALUE 'E611'. DTSCS61 00279 10 FILLER PIC X(30) DTSCS61 00280 VALUE 'OPEN ASSIGNMENT EXISTS. TALK '. DTSCS61 00281 10 FILLER PIC X(30) DTSCS61 00282 VALUE 'TO THE FIELD DESK. '. DTSCS61 00283 DTSCS61 00284 05 MSG-E612-AREA. DTSCS61 00285 10 FILLER PIC X(04) VALUE 'E612'. DTSCS61 00286 10 FILLER PIC X(30) DTSCS61 00287 VALUE 'SELF INSURED EMPLOYER OR OPEN '. DTSCS61 00288 10 FILLER PIC X(30) DTSCS61 00289 VALUE 'BANKRUPTCY - AUDIT NOT ALLOWED'. DTSCS61 00290 DTSCS61 00291 05 MSG-E613-AREA. DTSCS61 00292 10 FILLER PIC X(04) VALUE 'E613'. DTSCS61 00293 10 FILLER PIC X(30) DTSCS61 00294 VALUE 'RELATED EMPLOYER IS CHARGING O'. DTSCS61 00295 10 FILLER PIC X(30) DTSCS61 00296 VALUE 'NLY. NOT VALID ENTRY. '. DTSCS61 00297 DTSCS61 00298 05 MSG-E614-AREA. DTSCS61 00299 10 FILLER PIC X(04) VALUE 'E614'. DTSCS61 00300 10 FILLER PIC X(11) VALUE DTSCS61 00301 'ASSIGNMENT '. DTSCS61 00302 10 WRK-MSG-ASSIGN-NO PIC 99B99999. DTSCS61 00303 10 FILLER PIC X(07) VALUE ' ADDED.'. DTSCS61 00304 10 WRK-PRINTER-MSG PIC X(34) VALUE SPACES. DTSCS61 00305 DTSCS61 00306 05 MSG-E615-AREA. DTSCS61 00307 10 FILLER PIC X(04) VALUE 'E615'. DTSCS61 00308 10 FILLER PIC X(30) DTSCS61 00309 VALUE 'START DATE MUST BE <= ASSIGNME'. DTSCS61 00310 10 FILLER PIC X(30) DTSCS61 00311 VALUE 'NT DUE DATE '. DTSCS61 00312 DTSCS61 00313 05 MSG-E616-AREA. DTSCS61 00314 10 FILLER PIC X(04) VALUE 'E616'. DTSCS61 00315 10 FILLER PIC X(30) DTSCS61 00316 VALUE 'EXTRACT REQUESTED - YRQ RANGE '. DTSCS61 00317 10 FILLER PIC X(30) DTSCS61 00318 VALUE 'REQUIRED '. DTSCS61 00319 DTSCS61 00320 05 MSG-E617-AREA. DTSCS61 00321 10 FILLER PIC X(04) VALUE 'E617'. DTSCS61 00322 10 FILLER PIC X(30) DTSCS61 00323 VALUE 'ORIGINATOR IS NOT FIELD DESK '. DTSCS61 00324 10 FILLER PIC X(30) DTSCS61 00325 VALUE '"FD" IS ONLY VALID VALUE '. DTSCS61 00326 DTSCS61 00327 05 MSG-E618-AREA. DTSCS61 00328 10 FILLER PIC X(04) VALUE 'E618'. DTSCS61 00329 10 FILLER PIC X(30) DTSCS61 00330 VALUE 'ORIGINATOR IS NOT FIELD DESK '. DTSCS61 00331 10 FILLER PIC X(30) DTSCS61 00332 VALUE '"AD" IS ONLY VALID VALUE '. DTSCS61 00333 DTSCS61 00334 05 MSG-E61A-AREA. DTSCS61 00335 10 FILLER PIC X(04) VALUE 'E61A'. DTSCS61 00336 10 FILLER PIC X(30) DTSCS61 00337 VALUE 'NOT AN AUDIT ASSIGNMENT ENTRY'. DTSCS61 00338 10 FILLER PIC X(30) DTSCS61 00339 VALUE ' NOT ALLOWED '. DTSCS61 00340 DTSCS61 00341 05 MSG-E61B-AREA. DTSCS61 00342 10 FILLER PIC X(04) VALUE 'E61B'. DTSCS61 00343 10 FILLER PIC X(30) DTSCS61 00344 VALUE 'AUDIT ASSIGNMENT ENTRY IS REQ'. DTSCS61 00345 10 FILLER PIC X(30) DTSCS61 00346 VALUE 'UIRED '. DTSCS61 00347 DTSCS61 00348 05 MSG-E61C-AREA. DTSCS61 00349 10 FILLER PIC X(04) VALUE 'E61C'. DTSCS61 00350 10 FILLER PIC X(30) DTSCS61 00351 VALUE 'EMPLOYER WRITTEN OFF - EXTRACT'. DTSCS61 00352 10 FILLER PIC X(30) DTSCS61 00353 VALUE ' NOT ALLOWED '. DTSCS61 00354 SKIP3 DTSCS61 00355 01 EVL-TEXT. DTSCS61 00356 05 FILLER PIC X(17) VALUE 'FIELD ASSIGNMENT '. DTSCS61 00357 05 EVL-ASSIGN-NO PIC 99B99999. DTSCS61 00358 05 FILLER PIC X(10) VALUE ' INITIATED'. DTSCS61 00359 EJECT DTSCS61 00360 01 L001-COMM-AREA. DTSCS61 00361 ++INCLUDE DTSIL001 DTSCS61 00362 EJECT DTSCS61 00363 01 L004-COMM-AREA. DTSCS61 00364 ++INCLUDE DTSIL004 DTSCS61 00365 EJECT DTSCS61 00366 01 L015-COMM-AREA. DTSCS61 00367 ++INCLUDE DTSIL015 DTSCS61 00368 EJECT DTSCS61 00369 01 L018-COMM-AREA. DTSCS61 00370 ++INCLUDE DTSIL018 DTSCS61 00371 EJECT DTSCS61 00372 01 L020-COMM-AREA. DTSCS61 00373 ++INCLUDE DTSIL020 DTSCS61 00374 EJECT DTSCS61 00375 01 L024-COMM-AREA. DTSCS61 00376 ++INCLUDE DTSIL024 DTSCS61 00377 EJECT DTSCS61 00378 01 L036-COMM-AREA. DTSCS61 00379 ++INCLUDE DTSIL036 DTSCS61 00380 EJECT DTSCS61 00381 01 L038-COMM-AREA. DTSCS61 00382 ++INCLUDE DTSIL038 DTSCS61 00383 EJECT DTSCS61 00384 01 L039-COMM-AREA. DTSCS61 00385 ++INCLUDE DTSIL039 DTSCS61 00386 EJECT DTSCS61 00387 01 L061-COMM-AREA. DTSCS61 00388 ++INCLUDE DTSIL061 DTSCS61 00389 EJECT DTSCS61 00390 01 L062-COMM-AREA. DTSCS61 00391 ++INCLUDE DTSIL062 DTSCS61 00392 EJECT DTSCS61 00393 01 L063-COMM-AREA. DTSCS61 00394 ++INCLUDE DTSIL063 DTSCS61 00395 EJECT DTSCS61 00396 01 L071-COMM-AREA. DTSCS61 00397 ++INCLUDE DTSIL071 DTSCS61 00398 EJECT DTSCS61 00399 01 L081-COMM-AREA. DTSCS61 00400 ++INCLUDE DTSIL081 DTSCS61 00401 EJECT DTSCS61 00402 01 L082-COMM-AREA. DTSCS61 00403 ++INCLUDE DTSIL082 DTSCS61 00404 EJECT DTSCS61 00405 01 L221-COMM-AREA. DTSCS61 00406 ++INCLUDE DTSIL221 DTSCS61 00407 EJECT DTSCS61 00408 01 L331-COMM-AREA. DTSCS61 00409 ++INCLUDE DTSIL331 DTSCS61 00410 EJECT DTSCS61 00411 *01 L351-COMM-AREA. DTSCS61 00412 ***INCLUDE DTSIL351 DTSCS61 00413 EJECT DTSCS61 00414 01 L805-COMM-AREA. DTSCS61 00415 ++INCLUDE DTSIL805 DTSCS61 00416 EJECT DTSCS61 00417 01 L810-COMM-AREA. DTSCS61 00418 05 L810-CONTROL-BLOCK. DTSCS61 00419 ++INCLUDE DTSIL810 DTSCS61 00420 EJECT DTSCS61 00421 05 MSKL-REC. DTSCS61 00422 ++INCLUDE DTSIMSKL DTSCS61 00423 EJECT DTSCS61 00424 01 MPRF-REC. DTSCS61 00425 ++INCLUDE DTSIMPRF DTSCS61 00426 EJECT DTSCS61 00427 01 MHDR-REC. DTSCS61 00428 ++INCLUDE DTSIMHDR DTSCS61 00429 EJECT DTSCS61 00430 01 MFAS-REC. DTSCS61 00431 ++INCLUDE DTSIMFAS DTSCS61 00432 EJECT DTSCS61 00433 01 MEVL-REC. DTSCS61 00434 ++INCLUDE DTSIMEVL DTSCS61 00435 EJECT DTSCS61 00436 01 L825-COMM-AREA. DTSCS61 00437 05 L825-CONTROL-BLOCK. DTSCS61 00438 ++INCLUDE DTSIL825 DTSCS61 00439 DTSCS61 00440 05 RSKL-REC. DTSCS61 00441 ++INCLUDE DTSIRSK1 DTSCS61 00442 EJECT DTSCS61 00443 01 T021-REC. DTSCS61 00444 ++INCLUDE DTSIT021 DTSCS61 00445 EJECT DTSCS61 00446 01 L851-COMM-AREA. DTSCS61 00447 ++INCLUDE DTSIL851 DTSCS61 00448 DTSCS61 00449 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS61 00450 ++INCLUDE DTSIS61 DTSCS61 00451 EJECT DTSCS61 00452 01 CATB-LITERALS. DTSCS61 00453 ++INCLUDE DTSICATB DTSCS61 00454 DTSCS61 00455 01 CFKD-LITERALS. DTSCS61 00456 ++INCLUDE DTSICFKD DTSCS61 00457 DTSCS61 00458 01 CECD-LITERALS. DTSCS61 00459 ++INCLUDE DTSICECD DTSCS61 00460 DTSCS61 00461 01 CPCD-LITERALS. DTSCS61 00462 ++INCLUDE DTSICPCD DTSCS61 00463 DTSCS61 00464 01 MMAX-LITERALS. DTSCS61 00465 ++INCLUDE DTSIMMAX DTSCS61 00466 EJECT DTSCS61 00467 LINKAGE SECTION. DTSCS61 00468 DTSCS61 00469 01 DFHCOMMAREA. DTSCS61 00470 ++INCLUDE DTSILCCM DTSCS61 00471 EJECT DTSCS61 00472 ******************************************************************DTSCS61 00473 * *DTSCS61 00474 ******************************************************************DTSCS61 00475 DTSCS61 00476 PROCEDURE DIVISION. DTSCS61 00477 DTSCS61 00478 MOVE +0 TO WRK-EMP-NO. DTSCS61 00479 DTSCS61 00480 SET WRK-MPRF-NO-88 TO TRUE. DTSCS61 00481 SET WRK-EXTRACT-REQ-NO-88 TO TRUE. DTSCS61 00482 DTSCS61 00483 MOVE LOW-VALUES TO MAP-AREA. DTSCS61 00484 DTSCS61 00485 SET CURSOR-SET-NO TO TRUE. DTSCS61 00486 DTSCS61 00487 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N) DTSCS61 00488 TO SCR-ACCESS-IND. DTSCS61 00489 DTSCS61 00490 MOVE SPACE TO REQ-IND. DTSCS61 00491 DTSCS61 00492 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS61 00493 DTSCS61 00494 *----------------------------------------------------- DTSCS61 00495 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS61 00496 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS61 00497 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS61 00498 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS61 00499 * DTSCS61 00500 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS61 00501 * PROCESSED. DTSCS61 00502 * DTSCS61 00503 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS61 00504 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS61 00505 * WORK STATION OPERATOR. DTSCS61 00506 *----------------------------------------------------- DTSCS61 00507 DTSCS61 00508 MOVE SPACE TO RESP-IND. DTSCS61 00509 DTSCS61 00510 IF REQ-ERROR DTSCS61 00511 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS61 00512 ELSE DTSCS61 00513 IF REQ-JUMP DTSCS61 00514 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS61 00515 ELSE DTSCS61 00516 IF REQ-CLEAR DTSCS61 00517 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS61 00518 ELSE DTSCS61 00519 IF REQ-CURSOR-TO-GOTO DTSCS61 00520 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS61 00521 ELSE DTSCS61 00522 IF REQ-EDIT DTSCS61 00523 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS61 00524 ELSE DTSCS61 00525 IF REQ-UPDATE DTSCS61 00526 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS61 00527 ELSE DTSCS61 00528 GO TO S899-ABEND. DTSCS61 00529 DTSCS61 00530 *----------------------------------------------------- DTSCS61 00531 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS61 00532 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS61 00533 *----------------------------------------------------- DTSCS61 00534 DTSCS61 00535 IF RESP-SEND-MAP DTSCS61 00536 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS61 00537 SET LCCM-END-TASK-88 TO TRUE DTSCS61 00538 ELSE DTSCS61 00539 IF RESP-SEND-MSGONLY DTSCS61 00540 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS61 00541 SET LCCM-END-TASK-88 TO TRUE DTSCS61 00542 ELSE DTSCS61 00543 IF RESP-JUMP DTSCS61 00544 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS61 00545 ELSE DTSCS61 00546 IF RESP-CURSOR-TO-GOTO DTSCS61 00547 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS61 00548 SET LCCM-END-TASK-88 TO TRUE DTSCS61 00549 ELSE DTSCS61 00550 GO TO S899-ABEND. DTSCS61 00551 DTSCS61 00552 MAINLINE-EXIT. DTSCS61 00553 DTSCS61 00554 EXEC CICS DTSCS61 00555 RETURN DTSCS61 00556 END-EXEC. DTSCS61 00557 DTSCS61 00558 GOBACK. DTSCS61 00559 EJECT DTSCS61 00560 /*****************************************************************DTSCS61 00561 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS61 00562 ******************************************************************DTSCS61 00563 P1000-ANALYZE-REQUEST. DTSCS61 00564 DTSCS61 00565 *----------------------------------------------------- DTSCS61 00566 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS61 00567 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS61 00568 * REPLACED WITH ENTER) DTSCS61 00569 *----------------------------------------------------- DTSCS61 00570 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS61 00571 SET LCCM-ENTER-88 TO TRUE DTSCS61 00572 SET REQ-CLEAR TO TRUE DTSCS61 00573 IF LCCM-EMP-NO > ZERO DTSCS61 00574 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS61 00575 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS61 00576 END-IF DTSCS61 00577 GO TO P1000-EXIT. DTSCS61 00578 DTSCS61 00579 *----------------------------------------------------- DTSCS61 00580 * MAP IS RECEIVED DTSCS61 00581 *----------------------------------------------------- DTSCS61 00582 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS61 00583 DTSCS61 00584 *----------------------------------------------------- DTSCS61 00585 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS61 00586 * WORK STATION DTSCS61 00587 *----------------------------------------------------- DTSCS61 00588 IF LCCM-CLEAR-88 DTSCS61 00589 SET REQ-CLEAR TO TRUE DTSCS61 00590 GO TO P1000-EXIT. DTSCS61 00591 DTSCS61 00592 *----------------------------------------------------- DTSCS61 00593 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS61 00594 *----------------------------------------------------- DTSCS61 00595 IF LCCM-SCR-UPDATE-LOCKED DTSCS61 00596 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS61 00597 GO TO P1000-EXIT. DTSCS61 00598 DTSCS61 00599 *----------------------------------------------------- DTSCS61 00600 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS61 00601 *----------------------------------------------------- DTSCS61 00602 IF LCCM-PA2-88 DTSCS61 00603 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS61 00604 GO TO P1000-EXIT. DTSCS61 00605 DTSCS61 00606 *----------------------------------------------------- DTSCS61 00607 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS61 00608 *----------------------------------------------------- DTSCS61 00609 IF LCCM-PA-88 DTSCS61 00610 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS61 00611 SET REQ-ERROR TO TRUE DTSCS61 00612 GO TO P1000-EXIT. DTSCS61 00613 DTSCS61 00614 *----------------------------------------------------- DTSCS61 00615 * IF PF12 IS PRESSED AND UPDATE NOT IN PROGRESS THEN DTSCS61 00616 * CLEAR SCREEN DTSCS61 00617 *----------------------------------------------------- DTSCS61 00618 IF LCCM-F12-88 DTSCS61 00619 MOVE LOW-VALUES TO MAP-AREA DTSCS61 00620 SET REQ-CLEAR TO TRUE DTSCS61 00621 GO TO P1000-EXIT. DTSCS61 00622 DTSCS61 00623 *----------------------------------------------------- DTSCS61 00624 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS61 00625 *----------------------------------------------------- DTSCS61 00626 IF LCCM-F03-88 DTSCS61 00627 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS61 00628 SET REQ-JUMP TO TRUE DTSCS61 00629 GO TO P1000-EXIT. DTSCS61 00630 DTSCS61 00631 *----------------------------------------------------- DTSCS61 00632 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS61 00633 *----------------------------------------------------- DTSCS61 00634 IF LCCM-F04-88 DTSCS61 00635 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS61 00636 SET REQ-JUMP TO TRUE DTSCS61 00637 GO TO P1000-EXIT. DTSCS61 00638 DTSCS61 00639 *--------------------------------------------------------- DTSCS61 00640 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS61 00641 * CORRESPONDENCE SCREEN. DTSCS61 00642 *--------------------------------------------------------- DTSCS61 00643 DTSCS61 00644 IF LCCM-F14-88 DTSCS61 00645 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS61 00646 SET REQ-JUMP TO TRUE DTSCS61 00647 GO TO P1000-EXIT. DTSCS61 00648 DTSCS61 00649 *--------------------------------------------------------- DTSCS61 00650 * IF REGISTRATION INQUIRY SCREEN KEY PRESSED, DTSCS61 00651 * THEN JUMP TO REGISTRATION INQUIRY SCREEN. DTSCS61 00652 *--------------------------------------------------------- DTSCS61 00653 * DTSCS61 00654 * IF LCCM-F17-88 DTSCS61 00655 * MOVE '11' TO LCCM-REQ-SCR-ID DTSCS61 00656 * SET REQ-JUMP TO TRUE DTSCS61 00657 * GO TO P1000-EXIT. DTSCS61 00658 * DTSCS61 00659 *----------------------------------------------------- DTSCS61 00660 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS61 00661 * REQUESTED SCREEN TYPE DTSCS61 00662 *----------------------------------------------------- DTSCS61 00663 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS61 00664 NEXT SENTENCE DTSCS61 00665 ELSE DTSCS61 00666 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS61 00667 SET REQ-JUMP TO TRUE DTSCS61 00668 GO TO P1000-EXIT. DTSCS61 00669 DTSCS61 00670 *----------------------------------------------------- DTSCS61 00671 * IF REQUEST TO UPDATE THE DATA (ADD,MOD,DEL) DTSCS61 00672 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS61 00673 *----------------------------------------------------- DTSCS61 00674 IF LCCM-F09-88 DTSCS61 00675 IF SCR-ACCESS-UPDATE DTSCS61 00676 SET REQ-EDIT TO TRUE DTSCS61 00677 GO TO P1000-EXIT DTSCS61 00678 ELSE DTSCS61 00679 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS61 00680 SET REQ-ERROR TO TRUE DTSCS61 00681 GO TO P1000-EXIT. DTSCS61 00682 DTSCS61 00683 *----------------------------------------------------- DTSCS61 00684 * ANY OTHER KEY IS INVALID DTSCS61 00685 *----------------------------------------------------- DTSCS61 00686 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS61 00687 SET REQ-ERROR TO TRUE. DTSCS61 00688 P1000-EXIT. DTSCS61 00689 EXIT. DTSCS61 00690 DTSCS61 00691 ******************************************************************DTSCS61 00692 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS61 00693 ******************************************************************DTSCS61 00694 DTSCS61 00695 P1100-UPDATE-LOCKED. DTSCS61 00696 *----------------------------------------------------- DTSCS61 00697 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS61 00698 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCS61 00699 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS61 00700 *----------------------------------------------------- DTSCS61 00701 IF LCCM-ENTER-88 OR LCCM-F09-88 OR LCCM-F12-88 DTSCS61 00702 SET REQ-UPDATE TO TRUE DTSCS61 00703 ELSE DTSCS61 00704 SET REQ-ERROR TO TRUE DTSCS61 00705 IF LCCM-SCR-ADD-LOCKED DTSCS61 00706 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS61 00707 ELSE DTSCS61 00708 GO TO S899-ABEND. DTSCS61 00709 P1100-EXIT. DTSCS61 00710 EXIT. DTSCS61 00711 /*****************************************************************DTSCS61 00712 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS61 00713 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS61 00714 ******************************************************************DTSCS61 00715 DTSCS61 00716 P2000-REQUEST-ERROR. DTSCS61 00717 IF LCCM-MSG DTSCS61 00718 SET RESP-SEND-MSGONLY TO TRUE DTSCS61 00719 ELSE DTSCS61 00720 GO TO S899-ABEND. DTSCS61 00721 P2000-EXIT. DTSCS61 00722 EXIT. DTSCS61 00723 /*****************************************************************DTSCS61 00724 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS61 00725 ******************************************************************DTSCS61 00726 DTSCS61 00727 P3000-REQUEST-JUMP. DTSCS61 00728 *----------------------------------------------------- DTSCS61 00729 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS61 00730 * BY USER DTSCS61 00731 *----------------------------------------------------- DTSCS61 00732 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS61 00733 DTSCS61 00734 *----------------------------------------------------- DTSCS61 00735 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS61 00736 *----------------------------------------------------- DTSCS61 00737 IF LCCM-MSG DTSCS61 00738 SET RESP-SEND-MSGONLY TO TRUE DTSCS61 00739 SET CURSOR-SET-GOTO TO TRUE DTSCS61 00740 GO TO P3000-EXIT. DTSCS61 00741 SKIP3 DTSCS61 00742 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS61 00743 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS61 00744 IF L018-VALID DTSCS61 00745 MOVE L018-EMP-NO TO LCCM-EMP-NO. DTSCS61 00746 DTSCS61 00747 *----------------------------------------------------- DTSCS61 00748 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS61 00749 *----------------------------------------------------- DTSCS61 00750 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS61 00751 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS61 00752 SET RESP-JUMP TO TRUE. DTSCS61 00753 P3000-EXIT. DTSCS61 00754 EXIT. DTSCS61 00755 /*****************************************************************DTSCS61 00756 * CLEAR KEY WAS PRESSED *DTSCS61 00757 ******************************************************************DTSCS61 00758 DTSCS61 00759 P4000-REQUEST-CLEAR. DTSCS61 00760 DTSCS61 00761 *----------------------------------------------------- DTSCS61 00762 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS61 00763 * FIELDS FROM EARLIER REQUESTS DTSCS61 00764 *----------------------------------------------------- DTSCS61 00765 IF LCCM-EMP-NO > ZERO DTSCS61 00766 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS61 00767 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS61 00768 PERFORM S1101-EMP-NO THRU S1101-EXIT. DTSCS61 00769 ***** DTSCS61 00770 *****MOVE ZERO TO LCCM-EMP-NO. DTSCS61 00771 ***** DTSCS61 00772 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS61 00773 DTSCS61 00774 SET LCCM-SCR-CLEAR TO TRUE. DTSCS61 00775 DTSCS61 00776 IF SCR-ACCESS-UPDATE DTSCS61 00777 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS61 00778 ELSE DTSCS61 00779 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS61 00780 DTSCS61 00781 SET RESP-SEND-MAP TO TRUE. DTSCS61 00782 P4000-EXIT. DTSCS61 00783 EXIT. DTSCS61 00784 /*****************************************************************DTSCS61 00785 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS61 00786 ******************************************************************DTSCS61 00787 DTSCS61 00788 P5000-CURSOR-TO-GOTO. DTSCS61 00789 SET CURSOR-SET-GOTO TO TRUE. DTSCS61 00790 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS61 00791 P5000-EXIT. DTSCS61 00792 EXIT. DTSCS61 00793 /*****************************************************************DTSCS61 00794 * FUNCTION KEY TO ADD THE RECORD WAS PRESSED. DTSCS61 00795 ******************************************************************DTSCS61 00796 DTSCS61 00797 P7000-REQUEST-EDIT. DTSCS61 00798 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS61 00799 DTSCS61 00800 IF LCCM-F09-88 DTSCS61 00801 PERFORM P7100-EDIT-ADD THRU P7100-EXIT DTSCS61 00802 ELSE DTSCS61 00803 GO TO S899-ABEND. DTSCS61 00804 DTSCS61 00805 *------------------------------------------------------ DTSCS61 00806 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCS61 00807 * IN ORDER TO CONTINUE TO ATTEMPT A MOD THE SCREEN MUST DTSCS61 00808 * REMAIN IN 'INQUIRE' STATUS. DTSCS61 00809 *------------------------------------------------------ DTSCS61 00810 DTSCS61 00811 IF LCCM-MSG DTSCS61 00812 NEXT SENTENCE DTSCS61 00813 ELSE DTSCS61 00814 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCS61 00815 IF LCCM-F09-88 DTSCS61 00816 SET LCCM-SCR-ADD-LOCKED TO TRUE DTSCS61 00817 MOVE PMSG-ALT-ADD-CONFIRM TO LCCM-MSG-ID. DTSCS61 00818 DTSCS61 00819 SET RESP-SEND-MAP TO TRUE. DTSCS61 00820 P7000-EXIT. DTSCS61 00821 EXIT. DTSCS61 00822 /*****************************************************************DTSCS61 00823 * ADD FUNCTION WAS REQUESTED *DTSCS61 00824 ******************************************************************DTSCS61 00825 DTSCS61 00826 P7100-EDIT-ADD. DTSCS61 00827 *----------------------------------------------------- DTSCS61 00828 * ADDITION REQUIRES THAT THE SCREEN WAS CLEARED FIRST DTSCS61 00829 *----------------------------------------------------- DTSCS61 00830 IF NOT LCCM-SCR-CLEAR DTSCS61 00831 MOVE EMSG-ADD-PRECEDED TO LCCM-MSG-ID DTSCS61 00832 GO TO P7100-EXIT. DTSCS61 00833 DTSCS61 00834 *----------------------------------------------------- DTSCS61 00835 * MAP-EMP-NO MAY NOT BE CHANGED DURING THE ADD DTSCS61 00836 *----------------------------------------------------- DTSCS61 00837 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS61 00838 IF LCCM-MSG DTSCS61 00839 GO TO P7100-EXIT. DTSCS61 00840 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS61 00841 DTSCS61 00842 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS61 00843 DTSCS61 00844 P7100-EXIT. DTSCS61 00845 EXIT. DTSCS61 00846 /*****************************************************************DTSCS61 00847 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED *DTSCS61 00848 ******************************************************************DTSCS61 00849 DTSCS61 00850 P8000-REQUEST-UPDATE. DTSCS61 00851 DTSCS61 00852 IF LCCM-SCR-ADD-LOCKED DTSCS61 00853 PERFORM P8100-ADD THRU P8100-EXIT DTSCS61 00854 ELSE DTSCS61 00855 GO TO S899-ABEND. DTSCS61 00856 DTSCS61 00857 SET RESP-SEND-MAP TO TRUE. DTSCS61 00858 P8000-EXIT. DTSCS61 00859 EXIT. DTSCS61 00860 /*****************************************************************DTSCS61 00861 * *DTSCS61 00862 ******************************************************************DTSCS61 00863 DTSCS61 00864 P8100-ADD. DTSCS61 00865 SET LCCM-SCR-CLEAR TO TRUE. DTSCS61 00866 DTSCS61 00867 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS61 00868 DTSCS61 00869 IF LCCM-F12-88 DTSCS61 00870 MOVE PMSG-ADD-CANCELED TO LCCM-MSG-ID DTSCS61 00871 GO TO P8100-EXIT. DTSCS61 00872 DTSCS61 00873 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS61 00874 DTSCS61 00875 MOVE 'A' TO L221-UPDATE-FUNCTION. DTSCS61 00876 PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS61 00877 IF LCCM-MSG DTSCS61 00878 GO TO P8100-EXIT. DTSCS61 00879 DTSCS61 00880 PERFORM P8110-UPD-HDR THRU P8110-EXIT. DTSCS61 00881 DTSCS61 00882 IF LCCM-MSG DTSCS61 00883 PERFORM S221-EMP-UNLOCK THRU S221-EXIT DTSCS61 00884 GO TO P8100-EXIT. DTSCS61 00885 DTSCS61 00886 PERFORM P8900-INITIALIZE-L331 THRU P8900-EXIT. DTSCS61 00887 DTSCS61 00888 PERFORM P8120-CONSTRUCT-MFAS THRU P8120-EXIT. DTSCS61 00889 DTSCS61 00890 PERFORM P8130-MEVL-WRITE THRU P8130-EXIT. DTSCS61 00891 DTSCS61 00892 PERFORM P8140-UPDATE-MPRF THRU P8140-EXIT. DTSCS61 00893 DTSCS61 00894 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS61 00895 DTSCS61 00896 * IF MAP-COPIES > +0 DTSCS61 00897 * PERFORM P8150-FIELD-MEMO THRU P8150-EXIT DTSCS61 00898 * END-IF. DTSCS61 00899 DTSCS61 00900 IF LCCM-ENTER-88 DTSCS61 00901 MOVE LOW-VALUES TO MAP-AREA DTSCS61 00902 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS61 00903 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS61 00904 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS61 00905 PERFORM S1101-EMP-NO THRU S1101-EXIT DTSCS61 00906 ELSE DTSCS61 00907 MOVE LOW-VALUES TO MAP-FLD-REP-ID DTSCS61 00908 MAP-SIC-CD DTSCS61 00909 MAP-OWN-CD. DTSCS61 00910 DTSCS61 00911 MOVE MFAS-ASSIGN-NO TO WRK-MSG-ASSIGN-NO. DTSCS61 00912 MOVE MSG-E614-AREA TO LCCM-MSG-AREA. DTSCS61 00913 **** MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS61 00914 DTSCS61 00915 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS61 00916 P8100-EXIT. DTSCS61 00917 EXIT. DTSCS61 00918 DTSCS61 00919 P8110-UPD-HDR. DTSCS61 00920 MOVE LOW-VALUES TO MHDR-KEY-AREA. DTSCS61 00921 MOVE ZEROS TO MHDR-EMP-NO. DTSCS61 00922 SET MHDR-HDR-88 TO TRUE. DTSCS61 00923 MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA. DTSCS61 00924 PERFORM S810-READ-UPDATE THRU S810-EXIT. DTSCS61 00925 IF L810-NO-REC-88 DTSCS61 00926 GO TO S899-ABEND. DTSCS61 00927 DTSCS61 00928 MOVE MSKL-REC TO MHDR-REC. DTSCS61 00929 ADD +1 TO MHDR-LAST-USED-ASSIGN-NO.DTSCS61 00930 DTSCS61 00931 MOVE MHDR-REC TO MSKL-REC. DTSCS61 00932 PERFORM S810-REWRITE-UPDATE THRU S810-EXIT. DTSCS61 00933 DTSCS61 00934 P8110-EXIT. EXIT. DTSCS61 00935 DTSCS61 00936 DTSCS61 00937 P8120-CONSTRUCT-MFAS. DTSCS61 00938 MOVE LOW-VALUES TO MFAS-REC. DTSCS61 00939 MOVE LCCM-EMP-NO TO MFAS-EMP-NO. DTSCS61 00940 SET MFAS-FAS-88 TO TRUE. DTSCS61 00941 MOVE MHDR-LAST-USED-ASSIGN-NO TO MFAS-ASSIGN-NO DTSCS61 00942 LCCM-ASSIGN-NO. DTSCS61 00943 MOVE +0 TO MFAS-PURGE-DATE. DTSCS61 00944 DTSCS61 00945 MOVE SPACES TO WRK-L331-REC-OCC-ID. DTSCS61 00946 MOVE MFAS-ASSIGN-NO TO WRK-L331-ASSIGN-NO. DTSCS61 00947 MOVE WRK-L331-REC-OCC-ID TO L331-REC-OCC-ID. DTSCS61 00948 DTSCS61 00949 * INFORMATION RETURNED FROM L063 WILL BE NEEDED DTSCS61 00950 MOVE MAP-ASSIGN-TYPE TO L063-TYPE. DTSCS61 00951 PERFORM S063-FIELD-ASSIGNMENT-EDIT THRU S063-EXIT. DTSCS61 00952 DTSCS61 00953 MOVE L063-AUDIT-IND TO MFAS-AUDIT-IND. DTSCS61 00954 DTSCS61 00955 MOVE L063-ACCOUNTING-DESK-IND DTSCS61 00956 TO MFAS-ACCOUNTING-DESK-IND. DTSCS61 00957 DTSCS61 00958 MOVE MAP-ASSIGN-TYPE TO MFAS-ASSIGN-TYPE. DTSCS61 00959 MOVE 'MFAS-ASSIGN-TYPE' TO L331-FIELD-NAME. DTSCS61 00960 MOVE SPACES TO L331-FROM-VALUE. DTSCS61 00961 MOVE MFAS-ASSIGN-TYPE TO L331-TO-VALUE. DTSCS61 00962 PERFORM S331-WRITE-MLOG THRU S331-EXIT. DTSCS61 00963 DTSCS61 00964 SET MFAS-STATUS-ACTIVE-88 TO TRUE. DTSCS61 00965 MOVE 'MFAS-STATUS-CD' TO L331-FIELD-NAME. DTSCS61 00966 MOVE SPACES TO L331-FROM-VALUE. DTSCS61 00967 MOVE MFAS-STATUS-CD TO L331-TO-VALUE. DTSCS61 00968 PERFORM S331-WRITE-MLOG THRU S331-EXIT. DTSCS61 00969 DTSCS61 00970 MOVE MAP-FLD-REP-ID TO MFAS-FLD-REP-ID. DTSCS61 00971 MOVE 'MFAS-FLD-REP-ID' TO L331-FIELD-NAME. DTSCS61 00972 MOVE SPACES TO L331-FROM-VALUE. DTSCS61 00973 MOVE MFAS-FLD-REP-ID TO L331-TO-VALUE. DTSCS61 00974 PERFORM S331-WRITE-MLOG THRU S331-EXIT. DTSCS61 00975 DTSCS61 00976 MOVE MAP-ATTACHMENTS-IND TO MFAS-ATTACHMENTS-IND. DTSCS61 00977 DTSCS61 00978 MOVE MAP-START-DATE-AREA TO L015-S-DATE-AREA. DTSCS61 00979 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS61 00980 MOVE L015-DATE TO MFAS-START-DATE. DTSCS61 00981 DTSCS61 00982 MOVE MAP-DUE-DATE-AREA TO L015-S-DATE-AREA. DTSCS61 00983 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS61 00984 MOVE L015-DATE TO MFAS-DUE-DATE. DTSCS61 00985 MOVE 'MFAS-DUE-DATE' TO L331-FIELD-NAME. DTSCS61 00986 MOVE SPACES TO L331-FROM-VALUE. DTSCS61 00987 MOVE MFAS-DUE-DATE TO L001-FED-8-DATE-9. DTSCS61 00988 SET L001-FROM-FED-8 TO TRUE. DTSCS61 00989 PERFORM S001-DATE THRU S001-EXIT. DTSCS61 00990 MOVE L001-SLASH-DATE TO L331-TO-VALUE. DTSCS61 00991 PERFORM S331-WRITE-MLOG THRU S331-EXIT. DTSCS61 00992 DTSCS61 00993 MOVE +0 TO MFAS-PROCESSED-DATE DTSCS61 00994 MFAS-COMPLETED-DATE DTSCS61 00995 DTSCS61 00996 IF MAP-TAX-EXTRACT-YES DTSCS61 00997 MOVE LCCM-CURR-RUN-DATE TO MFAS-TAX-DOWNLOAD-DATE DTSCS61 00998 ELSE DTSCS61 00999 MOVE +0 TO MFAS-TAX-DOWNLOAD-DATE DTSCS61 01000 END-IF. DTSCS61 01001 DTSCS61 01002 IF MAP-WAGE-EXTRACT-YES DTSCS61 01003 MOVE LCCM-CURR-RUN-DATE TO MFAS-WAGE-DOWNLOAD-DATE DTSCS61 01004 ELSE DTSCS61 01005 MOVE +0 TO MFAS-WAGE-DOWNLOAD-DATE DTSCS61 01006 END-IF. DTSCS61 01007 DTSCS61 01008 MOVE MAP-SOURCE-OP-ID TO MFAS-SOURCE-OP-ID. DTSCS61 01009 MOVE MAP-CLAIMANT-SSN-AREA TO L020-S-SSN-AREA. DTSCS61 01010 PERFORM S020-SSN-FROM-SCREEN THRU S020-EXIT. DTSCS61 01011 IF L020-NO-ENTRY DTSCS61 01012 MOVE +0 TO MFAS-CLAIMANT-SSN DTSCS61 01013 MOVE SPACE TO MFAS-CLAIMANT-NAME DTSCS61 01014 ELSE DTSCS61 01015 MOVE MAP-CLAIMANT-NAME TO MFAS-CLAIMANT-NAME DTSCS61 01016 MOVE L020-SSN TO MFAS-CLAIMANT-SSN DTSCS61 01017 END-IF. DTSCS61 01018 DTSCS61 01019 MOVE MAP-RELATED-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS61 01020 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS61 01021 MOVE L018-EMP-NO TO MFAS-RELATED-EMP-NO. DTSCS61 01022 DTSCS61 01023 IF MAP-NAICS-CD = LOW-VALUES OR SPACES DTSCS61 01024 MOVE SPACES TO MFAS-NAICS-CD DTSCS61 01025 ELSE DTSCS61 01026 MOVE MAP-NAICS-CD TO MFAS-NAICS-CD DTSCS61 01027 END-IF. DTSCS61 01028 DTSCS61 01029 IF MAP-SIC-CD = LOW-VALUES OR SPACES DTSCS61 01030 MOVE SPACES TO MFAS-SIC-CD DTSCS61 01031 ELSE DTSCS61 01032 MOVE MAP-SIC-CD TO MFAS-SIC-CD DTSCS61 01033 END-IF. DTSCS61 01034 DTSCS61 01035 IF MAP-OWN-CD = LOW-VALUES OR SPACES DTSCS61 01036 MOVE SPACES TO MFAS-OWN-CD DTSCS61 01037 ELSE DTSCS61 01038 MOVE MAP-OWN-CD TO MFAS-OWN-CD DTSCS61 01039 END-IF. DTSCS61 01040 DTSCS61 01041 MOVE MAP-EMP-SIZE-IND TO MFAS-EMP-SIZE-IND. DTSCS61 01042 DTSCS61 01043 MOVE MAP-AUDIT-START-YRQ-AREA TO L024-S-START-YRQ-AREA. DTSCS61 01044 MOVE MAP-AUDIT-END-YRQ-AREA TO L024-S-END-YRQ-AREA. DTSCS61 01045 PERFORM S024-EDIT-QTR-SPAN THRU S024-EXIT. DTSCS61 01046 IF L024-START-NO-ENTRY DTSCS61 01047 MOVE +0 TO MFAS-START-YRQ DTSCS61 01048 ELSE DTSCS61 01049 MOVE L024-START-YRQ TO MFAS-START-YRQ DTSCS61 01050 END-IF. DTSCS61 01051 DTSCS61 01052 IF L024-END-NO-ENTRY DTSCS61 01053 MOVE +0 TO MFAS-END-YRQ DTSCS61 01054 ELSE DTSCS61 01055 MOVE L024-END-YRQ TO MFAS-END-YRQ DTSCS61 01056 END-IF. DTSCS61 01057 DTSCS61 01058 PERFORM VARYING WRK-CTR FROM 1 BY 1 DTSCS61 01059 UNTIL WRK-CTR > MMAX-FAS-SEL-MAX DTSCS61 01060 IF MAP-AUDIT-SEL-REASON(WRK-CTR) = LOW-VALUES OR SPACES DTSCS61 01061 MOVE SPACES TO MFAS-AUDIT-SEL-REASON (WRK-CTR) DTSCS61 01062 ELSE DTSCS61 01063 MOVE MAP-AUDIT-SEL-REASON(WRK-CTR) DTSCS61 01064 TO MFAS-AUDIT-SEL-REASON(WRK-CTR) DTSCS61 01065 MOVE WRK-CTR TO MFAS-SEL-CNT DTSCS61 01066 END-IF DTSCS61 01067 END-PERFORM DTSCS61 01068 DTSCS61 01069 MOVE LCCM-CURR-RUN-DATE TO MFAS-ESTB-DATE DTSCS61 01070 MFAS-CHNG-DATE DTSCS61 01071 SET MFAS-NOT-CONVERTED-88 TO TRUE. DTSCS61 01072 MOVE +0 TO MFAS-TEXT-CNT. DTSCS61 01073 DTSCS61 01074 PERFORM P8126-TEXT THRU P8126-EXIT DTSCS61 01075 VARYING WRK-CTR FROM 1 BY 1 DTSCS61 01076 UNTIL WRK-CTR > MMAX-FAS-TEXT-MAX. DTSCS61 01077 DTSCS61 01078 DTSCS61 01079 MOVE MFAS-REC TO MSKL-REC. DTSCS61 01080 PERFORM S810-WRITE THRU S810-EXIT. DTSCS61 01081 DTSCS61 01082 ***** DTSCS61 01083 * DTSCS61 01084 ***** DTSCS61 01085 IF MAP-TAX-EXTRACT-YES DTSCS61 01086 SET T021-DOWNLOAD-TAX TO TRUE DTSCS61 01087 PERFORM P9100-CREATE-T021 THRU P9100-EXIT. DTSCS61 01088 DTSCS61 01089 IF MAP-WAGE-EXTRACT-YES DTSCS61 01090 SET T021-DOWNLOAD-WAGE TO TRUE DTSCS61 01091 PERFORM P9100-CREATE-T021 THRU P9100-EXIT. DTSCS61 01092 DTSCS61 01093 P8120-EXIT. DTSCS61 01094 EXIT. DTSCS61 01095 DTSCS61 01096 P8126-TEXT. DTSCS61 01097 IF MAP-TEXT(WRK-CTR) EQUAL LOW-VALUES OR SPACES DTSCS61 01098 MOVE SPACES TO MFAS-TEXT(WRK-CTR) DTSCS61 01099 ELSE DTSCS61 01100 MOVE MAP-TEXT(WRK-CTR) TO MFAS-TEXT(WRK-CTR) DTSCS61 01101 MOVE WRK-CTR TO MFAS-TEXT-CNT. DTSCS61 01102 P8126-EXIT. EXIT. DTSCS61 01103 DTSCS61 01104 P8130-MEVL-WRITE. DTSCS61 01105 MOVE LOW-VALUES TO MEVL-REC. DTSCS61 01106 DTSCS61 01107 MOVE WRK-EMP-NO TO MEVL-EMP-NO. DTSCS61 01108 SET MEVL-EVL-88 TO TRUE. DTSCS61 01109 MOVE LCCM-TASK-START-DATE TO MEVL-DATE. DTSCS61 01110 MOVE LCCM-TASK-START-TIME TO MEVL-TIME. DTSCS61 01111 DTSCS61 01112 MOVE +0 TO MEVL-PURGE-DATE. DTSCS61 01113 DTSCS61 01114 MOVE MFAS-ASSIGN-NO TO EVL-ASSIGN-NO. DTSCS61 01115 MOVE EVL-TEXT TO MEVL-TEXT. DTSCS61 01116 MOVE LCCM-OP-ID TO MEVL-SOURCE. DTSCS61 01117 SET MEVL-NOT-CONVERTED-88 TO TRUE. DTSCS61 01118 MOVE LCCM-CURR-RUN-DATE TO MEVL-ESTB-DATE DTSCS61 01119 MEVL-CHNG-DATE. DTSCS61 01120 DTSCS61 01121 MOVE MEVL-REC TO MSKL-REC. DTSCS61 01122 PERFORM S810-WRITE THRU S810-EXIT. DTSCS61 01123 P8130-EXIT. DTSCS61 01124 EXIT. DTSCS61 01125 DTSCS61 01126 P8140-UPDATE-MPRF. DTSCS61 01127 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS61 01128 DTSCS61 01129 SET MPRF-MFAS-EXISTS-88 TO TRUE. DTSCS61 01130 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSCS61 01131 DTSCS61 01132 MOVE MPRF-REC TO MSKL-REC. DTSCS61 01133 PERFORM S810-REWRITE THRU S810-EXIT. DTSCS61 01134 DTSCS61 01135 P8140-EXIT. DTSCS61 01136 EXIT. DTSCS61 01137 DTSCS61 01138 DTSCS61 01139 *P8150-FIELD-MEMO. DTSCS61 01140 *****MOVE MFAS-EMP-NO TO L351-EMP-NO. DTSCS61 01141 *****MOVE MFAS-ASSIGN-NO TO L351-ASSIGN-NO. DTSCS61 01142 *****MOVE MAP-PRINTER-ID TO L351-PRINTER-ID. DTSCS61 01143 *****MOVE MAP-COPIES TO L351-COPY-CNT. DTSCS61 01144 *****MOVE LCCM-TASK-START-DISP-DATE TO L351-TASK-START-DISP-DATE. DTSCS61 01145 *****MOVE LCCM-TASK-START-DISP-TIME TO L351-TASK-START-DISP-TIME. DTSCS61 01146 *****MOVE LCCM-TS-NAME-PREFIX TO L351-TS-NAME-PREFIX. DTSCS61 01147 DTSCS61 01148 *****PERFORM S351-PRINT THRU S351-EXIT. DTSCS61 01149 DTSCS61 01150 *****IF L351-PRINT-FAILED DTSCS61 01151 ********MOVE ' (BUT THE PRINT FAILED!)' TO WRK-PRINTER-MSG. DTSCS61 01152 *P8150-EXIT. EXIT. DTSCS61 01153 DTSCS61 01154 P8810-LOCK-EMPLOYER. DTSCS61 01155 MOVE WRK-EMP-NO TO L221-EMP-NO. DTSCS61 01156 MOVE LCCM-SCR-ABSTIME TO L221-SCR-ABSTIME. DTSCS61 01157 MOVE LCCM-TASK-ID TO L221-UPDATE-TASK-ID. DTSCS61 01158 MOVE LCCM-OP-ID TO L221-UPDATE-OP-ID. DTSCS61 01159 MOVE LCCM-CICS-TERM-ID TO L221-UPDATE-TERMID. DTSCS61 01160 MOVE LCCM-TASK-NETNAME TO L221-UPDATE-NETNAME. DTSCS61 01161 MOVE LCCM-TASK-START-DATE TO L221-UPDATE-START-DATE. DTSCS61 01162 MOVE LCCM-TASK-START-TIME TO L221-UPDATE-START-TIME. DTSCS61 01163 MOVE WRK-SCR-ID TO L221-UPDATE-SCR-ID. DTSCS61 01164 DTSCS61 01165 PERFORM S221-EMP-LOCK THRU S221-EXIT. DTSCS61 01166 P8810-EXIT. DTSCS61 01167 EXIT. DTSCS61 01168 EJECT DTSCS61 01169 DTSCS61 01170 P8900-INITIALIZE-L331. DTSCS61 01171 MOVE WRK-EMP-NO TO L331-EMP-NO. DTSCS61 01172 DTSCS61 01173 MOVE LCCM-CURR-RUN-DATE TO L331-CURR-RUN-DATE. DTSCS61 01174 DTSCS61 01175 MOVE LCCM-TASK-START-ABSTIME TO L331-UPDATE-ABSTIME. DTSCS61 01176 DTSCS61 01177 MOVE LCCM-OP-ID TO L331-OP-ID. DTSCS61 01178 DTSCS61 01179 P8900-EXIT. DTSCS61 01180 EXIT. DTSCS61 01181 DTSCS61 01182 * DTSCS61 01183 P9100-CREATE-T021. DTSCS61 01184 MOVE WRK-EMP-NO TO T021-EMP-NO. DTSCS61 01185 MOVE LCCM-OP-ID TO T021-OP-ID. DTSCS61 01186 MOVE WRK-SCR-ID TO T021-SCR-ID. DTSCS61 01187 MOVE LCCM-TASK-START-DATE TO T021-SYS-DATE. DTSCS61 01188 MOVE LCCM-TASK-START-TIME TO T021-SYS-TIME. DTSCS61 01189 MOVE MFAS-ASSIGN-NO TO T021-ASSIGN-NO. DTSCS61 01190 MOVE LENGTH OF T021-REC TO T021-LENGTH. DTSCS61 01191 MOVE T021-REC TO RSKL-REC. DTSCS61 01192 PERFORM S825-WRITE THRU S825-EXIT. DTSCS61 01193 P9100-EXIT. DTSCS61 01194 EXIT. DTSCS61 01195 DTSCS61 01196 /*****************************************************************DTSCS61 01197 * LINKS TO UTILITY MODULES DTSCS61 01198 ******************************************************************DTSCS61 01199 DTSCS61 01200 S001-FROM-FED-8. DTSCS61 01201 SET L001-FROM-FED-8 TO TRUE. DTSCS61 01202 GO TO S001-DATE. DTSCS61 01203 DTSCS61 01204 S001-FROM-ABS-DATE. DTSCS61 01205 SET L001-FROM-ABS-DAY TO TRUE. DTSCS61 01206 GO TO S001-DATE. DTSCS61 01207 DTSCS61 01208 S001-DATE. DTSCS61 01209 EXEC CICS LINK DTSCS61 01210 PROGRAM('DTSCU001') DTSCS61 01211 COMMAREA(L001-COMM-AREA) DTSCS61 01212 END-EXEC. DTSCS61 01213 S001-EXIT. DTSCS61 01214 EXIT. DTSCS61 01215 DTSCS61 01216 S004-FROM-5. DTSCS61 01217 SET L004-FROM-5 TO TRUE. DTSCS61 01218 GO TO S004-YRQ. DTSCS61 01219 DTSCS61 01220 S004-FROM-ABS. DTSCS61 01221 SET L004-FROM-ABS TO TRUE. DTSCS61 01222 GO TO S004-YRQ. DTSCS61 01223 DTSCS61 01224 S004-FROM-DATE. DTSCS61 01225 SET L004-FROM-DATE TO TRUE. DTSCS61 01226 GO TO S004-YRQ. DTSCS61 01227 DTSCS61 01228 S004-YRQ. DTSCS61 01229 EXEC CICS LINK DTSCS61 01230 PROGRAM('DTSCU004') DTSCS61 01231 COMMAREA(L004-COMM-AREA) DTSCS61 01232 END-EXEC. DTSCS61 01233 S004-EXIT. DTSCS61 01234 EXIT. DTSCS61 01235 DTSCS61 01236 S015-DATE-FROM-SCREEN. DTSCS61 01237 EXEC CICS LINK DTSCS61 01238 PROGRAM('DTSCU015') DTSCS61 01239 COMMAREA(L015-COMM-AREA) DTSCS61 01240 END-EXEC. DTSCS61 01241 S015-EXIT. DTSCS61 01242 EXIT. DTSCS61 01243 DTSCS61 01244 S018-EMP-NO-FROM-SCREEN. DTSCS61 01245 EXEC CICS LINK DTSCS61 01246 PROGRAM('DTSCU018') DTSCS61 01247 COMMAREA(L018-COMM-AREA) DTSCS61 01248 END-EXEC. DTSCS61 01249 S018-EXIT. DTSCS61 01250 EXIT. DTSCS61 01251 DTSCS61 01252 S020-SSN-FROM-SCREEN. DTSCS61 01253 EXEC CICS LINK DTSCS61 01254 PROGRAM('DTSCU020') DTSCS61 01255 COMMAREA(L020-COMM-AREA) DTSCS61 01256 END-EXEC. DTSCS61 01257 S020-EXIT. DTSCS61 01258 EXIT. DTSCS61 01259 DTSCS61 01260 S024-EDIT-QTR-SPAN. DTSCS61 01261 SET L024-END-REQUIRED TO TRUE. DTSCS61 01262 EXEC CICS LINK DTSCS61 01263 PROGRAM('DTSCU024') DTSCS61 01264 COMMAREA(L024-COMM-AREA) DTSCS61 01265 END-EXEC. DTSCS61 01266 S024-EXIT. DTSCS61 01267 EXIT. DTSCS61 01268 DTSCS61 01269 S036-EMP-SIZE. DTSCS61 01270 SET L036-MFAS-EMP-SIZE-IND TO TRUE. DTSCS61 01271 GO TO S036-FS-EDIT-DSCR. DTSCS61 01272 DTSCS61 01273 S036-AUDIT-SEL-REASON. DTSCS61 01274 SET L036-MFAS-AUDIT-SEL-REASON TO TRUE. DTSCS61 01275 GO TO S036-FS-EDIT-DSCR. DTSCS61 01276 DTSCS61 01277 S036-FS-EDIT-DSCR. DTSCS61 01278 EXEC CICS LINK DTSCS61 01279 PROGRAM('DTSCU036') DTSCS61 01280 COMMAREA(L036-COMM-AREA) DTSCS61 01281 END-EXEC. DTSCS61 01282 S036-EXIT. DTSCS61 01283 EXIT. DTSCS61 01284 DTSCS61 01285 *S039-SIC-OWN-CODE-EDIT. DTSCS61 01286 *****EXEC CICS LINK DTSCS61 01287 ***** PROGRAM('MACCU039') DTSCS61 01288 ***** COMMAREA(L039-COMM-AREA) DTSCS61 01289 ***** LENGTH(L039-LENGTH) DTSCS61 01290 *****END-EXEC. DTSCS61 01291 ***** DTSCS61 01292 *****IF L039-SIC-FILE-CLOSED DTSCS61 01293 ***** MOVE L039-MSG-AREA TO LCCM-MSG-AREA DTSCS61 01294 ***** SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS61 01295 ***** SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS61 01296 ***** GO TO MAINLINE-EXIT. DTSCS61 01297 ***** DTSCS61 01298 *S039-EXIT. DTSCS61 01299 *****EXIT. DTSCS61 01300 DTSCS61 01301 S061-FIELD-ZIP-REP-ID. DTSCS61 01302 EXEC CICS LINK DTSCS61 01303 PROGRAM('DTSCU061') DTSCS61 01304 COMMAREA(L061-COMM-AREA) DTSCS61 01305 END-EXEC. DTSCS61 01306 DTSCS61 01307 IF L061-FILE-CLOSED DTSCS61 01308 MOVE L061-MSG-AREA TO LCCM-MSG-AREA DTSCS61 01309 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS61 01310 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS61 01311 GO TO MAINLINE-EXIT. DTSCS61 01312 DTSCS61 01313 S061-EXIT. DTSCS61 01314 EXIT. DTSCS61 01315 DTSCS61 01316 S062-FLD-REP-ID-DESC. DTSCS61 01317 EXEC CICS LINK DTSCS61 01318 PROGRAM('DTSCU062') DTSCS61 01319 COMMAREA(L062-COMM-AREA) DTSCS61 01320 END-EXEC. DTSCS61 01321 DTSCS61 01322 IF L062-FILE-CLOSED DTSCS61 01323 MOVE L062-MSG-AREA TO LCCM-MSG-AREA DTSCS61 01324 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS61 01325 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS61 01326 GO TO MAINLINE-EXIT. DTSCS61 01327 DTSCS61 01328 S062-EXIT. DTSCS61 01329 EXIT. DTSCS61 01330 DTSCS61 01331 S063-FIELD-ASSIGNMENT-EDIT. DTSCS61 01332 EXEC CICS LINK DTSCS61 01333 PROGRAM('DTSCU063') DTSCS61 01334 COMMAREA(L063-COMM-AREA) DTSCS61 01335 END-EXEC. DTSCS61 01336 DTSCS61 01337 IF L063-FILE-CLOSED DTSCS61 01338 MOVE L063-MSG-AREA TO LCCM-MSG-AREA DTSCS61 01339 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS61 01340 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS61 01341 GO TO MAINLINE-EXIT. DTSCS61 01342 DTSCS61 01343 S063-EXIT. DTSCS61 01344 EXIT. DTSCS61 01345 DTSCS61 01346 S071-FROM-LAST-NAME-FIRST. DTSCS61 01347 SET L071-FROM-LAST-NAME-FIRST TO TRUE. DTSCS61 01348 GO TO S071-NAME-EDIT. DTSCS61 01349 DTSCS61 01350 S071-NAME-EDIT. DTSCS61 01351 EXEC CICS LINK DTSCS61 01352 PROGRAM('DTSCU071') DTSCS61 01353 COMMAREA(L071-COMM-AREA) DTSCS61 01354 END-EXEC. DTSCS61 01355 S071-EXIT. DTSCS61 01356 EXIT. DTSCS61 01357 DTSCS61 01358 S081-CLAIMANT-NAME. DTSCS61 01359 EXEC CICS LINK DTSCS61 01360 PROGRAM('DTSCU081') DTSCS61 01361 COMMAREA(L081-COMM-AREA) DTSCS61 01362 END-EXEC. DTSCS61 01363 DTSCS61 01364 IF L081-FILE-CLOSED DTSCS61 01365 MOVE L081-MSG-AREA TO LCCM-MSG-AREA DTSCS61 01366 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS61 01367 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS61 01368 GO TO MAINLINE-EXIT. DTSCS61 01369 DTSCS61 01370 S081-EXIT. DTSCS61 01371 EXIT. DTSCS61 01372 DTSCS61 01373 S082-OP-ID-EDIT. DTSCS61 01374 EXEC CICS LINK DTSCS61 01375 PROGRAM('DTSCU082') DTSCS61 01376 COMMAREA(L082-COMM-AREA) DTSCS61 01377 END-EXEC. DTSCS61 01378 DTSCS61 01379 IF L082-FILE-CLOSED DTSCS61 01380 MOVE L082-MSG-AREA TO LCCM-MSG-AREA DTSCS61 01381 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS61 01382 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS61 01383 GO TO MAINLINE-EXIT. DTSCS61 01384 DTSCS61 01385 S082-EXIT. DTSCS61 01386 EXIT. DTSCS61 01387 DTSCS61 01388 S221-EMP-LOCK. DTSCS61 01389 SET L221-START-UPDATE TO TRUE. DTSCS61 01390 GO TO S221-EMP-LOCK-UNLOCK. DTSCS61 01391 DTSCS61 01392 S221-EMP-UNLOCK. DTSCS61 01393 SET L221-END-UPDATE TO TRUE. DTSCS61 01394 GO TO S221-EMP-LOCK-UNLOCK. DTSCS61 01395 DTSCS61 01396 S221-EMP-LOCK-UNLOCK. DTSCS61 01397 EXEC CICS LINK DTSCS61 01398 PROGRAM('DTSCU221') DTSCS61 01399 COMMAREA(L221-COMM-AREA) DTSCS61 01400 END-EXEC. DTSCS61 01401 DTSCS61 01402 IF L221-FILE-CLOSED DTSCS61 01403 MOVE L221-MSG-AREA TO LCCM-MSG-AREA DTSCS61 01404 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS61 01405 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS61 01406 GO TO MAINLINE-EXIT. DTSCS61 01407 DTSCS61 01408 IF L221-NOT-OK DTSCS61 01409 MOVE L221-MSG-AREA TO LCCM-MSG-AREA. DTSCS61 01410 S221-EXIT. DTSCS61 01411 EXIT. DTSCS61 01412 DTSCS61 01413 S331-WRITE-MLOG. DTSCS61 01414 EXEC CICS LINK DTSCS61 01415 PROGRAM('DTSCU331') DTSCS61 01416 COMMAREA(L331-COMM-AREA) DTSCS61 01417 END-EXEC. DTSCS61 01418 DTSCS61 01419 IF L331-FILE-CLOSED DTSCS61 01420 MOVE L331-MSG-AREA TO LCCM-MSG-AREA DTSCS61 01421 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS61 01422 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS61 01423 GO TO MAINLINE-EXIT. DTSCS61 01424 DTSCS61 01425 S331-EXIT. DTSCS61 01426 EXIT. DTSCS61 01427 DTSCS61 01428 *S351-PRINT. DTSCS61 01429 *****EXEC CICS LINK DTSCS61 01430 *********PROGRAM('DTSCU351') DTSCS61 01431 *********COMMAREA(L351-COMM-AREA) DTSCS61 01432 *****END-EXEC. DTSCS61 01433 *S351-EXIT. DTSCS61 01434 *****EXIT. DTSCS61 01435 DTSCS61 01436 S803-REQ-SCR-ID-EDIT. DTSCS61 01437 EXEC CICS LINK DTSCS61 01438 PROGRAM ('DTSCU803') DTSCS61 01439 COMMAREA (DFHCOMMAREA) DTSCS61 01440 END-EXEC. DTSCS61 01441 S803-EXIT. DTSCS61 01442 EXIT. DTSCS61 01443 DTSCS61 01444 S804-INVALID-KEY. DTSCS61 01445 EXEC CICS LINK DTSCS61 01446 PROGRAM ('DTSCU804') DTSCS61 01447 COMMAREA (DFHCOMMAREA) DTSCS61 01448 END-EXEC. DTSCS61 01449 S804-EXIT. DTSCS61 01450 EXIT. DTSCS61 01451 DTSCS61 01452 S805-MSG-AREA. DTSCS61 01453 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS61 01454 DTSCS61 01455 EXEC CICS LINK DTSCS61 01456 PROGRAM ('DTSCU805') DTSCS61 01457 COMMAREA (L805-COMM-AREA) DTSCS61 01458 END-EXEC. DTSCS61 01459 DTSCS61 01460 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS61 01461 S805-EXIT. DTSCS61 01462 EXIT. DTSCS61 01463 EJECT DTSCS61 01464 S810-READ. DTSCS61 01465 SET L810-READ-88 TO TRUE. DTSCS61 01466 GO TO S810-IO. DTSCS61 01467 DTSCS61 01468 S810-START-BROWSE. DTSCS61 01469 SET L810-START-BROWSE-88 TO TRUE. DTSCS61 01470 GO TO S810-IO. DTSCS61 01471 DTSCS61 01472 S810-READ-NEXT. DTSCS61 01473 SET L810-READ-NEXT-88 TO TRUE. DTSCS61 01474 GO TO S810-IO. DTSCS61 01475 DTSCS61 01476 S810-READ-PREV. DTSCS61 01477 SET L810-READ-PREV-88 TO TRUE. DTSCS61 01478 GO TO S810-IO. DTSCS61 01479 DTSCS61 01480 S810-END-BROWSE. DTSCS61 01481 SET L810-END-BROWSE-88 TO TRUE. DTSCS61 01482 GO TO S810-IO. DTSCS61 01483 DTSCS61 01484 S810-COUNT. DTSCS61 01485 SET L810-COUNT-88 TO TRUE. DTSCS61 01486 GO TO S810-IO. DTSCS61 01487 DTSCS61 01488 S810-REWRITE. DTSCS61 01489 SET L810-REWRITE-88 TO TRUE. DTSCS61 01490 GO TO S810-IO. DTSCS61 01491 DTSCS61 01492 S810-WRITE. DTSCS61 01493 SET L810-WRITE-88 TO TRUE. DTSCS61 01494 GO TO S810-IO. DTSCS61 01495 DTSCS61 01496 S810-READ-UPDATE. DTSCS61 01497 SET L810-READ-UPDATE-88 TO TRUE. DTSCS61 01498 GO TO S810-IO. DTSCS61 01499 DTSCS61 01500 S810-REWRITE-UPDATE. DTSCS61 01501 SET L810-REWRITE-UPDATE-88 TO TRUE. DTSCS61 01502 GO TO S810-IO. DTSCS61 01503 DTSCS61 01504 S810-DELETE. DTSCS61 01505 SET L810-DELETE-88 TO TRUE. DTSCS61 01506 GO TO S810-IO. DTSCS61 01507 DTSCS61 01508 S810-IO. DTSCS61 01509 DTSCS61 01510 EXEC CICS LINK DTSCS61 01511 PROGRAM ('DTSCU810') DTSCS61 01512 COMMAREA (L810-COMM-AREA) DTSCS61 01513 END-EXEC. DTSCS61 01514 DTSCS61 01515 IF L810-FILE-CLOSED-88 DTSCS61 01516 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS61 01517 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS61 01518 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS61 01519 GO TO MAINLINE-EXIT. DTSCS61 01520 S810-EXIT. DTSCS61 01521 EXIT. DTSCS61 01522 EJECT DTSCS61 01523 S825-WRITE. DTSCS61 01524 SET L825-WRITE-88 TO TRUE. DTSCS61 01525 GO TO S825-O. DTSCS61 01526 DTSCS61 01527 S825-O. DTSCS61 01528 DTSCS61 01529 DTSCS61 01530 EXEC CICS LINK DTSCS61 01531 PROGRAM ('DTSCU825') DTSCS61 01532 COMMAREA (L825-COMM-AREA) DTSCS61 01533 END-EXEC. DTSCS61 01534 DTSCS61 01535 IF L825-FILE-CLOSED-88 DTSCS61 01536 MOVE L825-MSG-AREA TO LCCM-MSG-AREA DTSCS61 01537 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS61 01538 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS61 01539 GO TO MAINLINE-EXIT. DTSCS61 01540 S825-EXIT. DTSCS61 01541 EXIT. DTSCS61 01542 EJECT DTSCS61 01543 S851-SCREEN-PROCESSING. DTSCS61 01544 EXEC CICS LINK DTSCS61 01545 PROGRAM ('DTSCU851') DTSCS61 01546 COMMAREA (L851-COMM-AREA) DTSCS61 01547 END-EXEC. DTSCS61 01548 S851-EXIT. DTSCS61 01549 EXIT. DTSCS61 01550 DTSCS61 01551 S899-ABEND. DTSCS61 01552 EXEC CICS ABEND DTSCS61 01553 ABCODE(WRK-ABEND-CD) DTSCS61 01554 END-EXEC. DTSCS61 01555 S899-EXIT. DTSCS61 01556 EXIT. DTSCS61 01557 /*****************************************************************DTSCS61 01558 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS61 01559 ******************************************************************DTSCS61 01560 DTSCS61 01561 S1000-SCREEN-EDITS. DTSCS61 01562 PERFORM S1101-EMP-NO THRU S1101-EXIT. DTSCS61 01563 IF LCCM-MSG DTSCS61 01564 GO TO S1000-EXIT. DTSCS61 01565 DTSCS61 01566 PERFORM S1200-ASSIGN-TYPE THRU S1200-EXIT. DTSCS61 01567 IF LCCM-MSG DTSCS61 01568 GO TO S1000-EXIT. DTSCS61 01569 DTSCS61 01570 PERFORM S1300-ADD-OPEN-IND THRU S1300-EXIT. DTSCS61 01571 PERFORM S1400-START-DATE THRU S1400-EXIT. DTSCS61 01572 PERFORM S1500-DUE-DATE THRU S1500-EXIT. DTSCS61 01573 PERFORM S1600-FLD-REP-ID THRU S1600-EXIT. DTSCS61 01574 PERFORM S1700-ATTACHMENTS THRU S1700-EXIT. DTSCS61 01575 PERFORM S1800-SOURCE-OP-ID THRU S1800-EXIT. DTSCS61 01576 PERFORM S1900-EMP-SIZE-IND THRU S1900-EXIT DTSCS61 01577 PERFORM S2000-AUDIT-SEL-REASON THRU S2000-EXIT DTSCS61 01578 VARYING WRK-CTR FROM 1 BY 1 DTSCS61 01579 UNTIL WRK-CTR > MMAX-FAS-SEL-MAX. DTSCS61 01580 SKIP1 DTSCS61 01581 PERFORM S2100-TAX-EXTRACT THRU S2100-EXIT. DTSCS61 01582 PERFORM S2200-WAGE-EXTRACT THRU S2200-EXIT. DTSCS61 01583 PERFORM S2300-QTR-RANGE THRU S2300-EXIT DTSCS61 01584 PERFORM S2400-SIC-NAICS-OWN THRU S2400-EXIT. DTSCS61 01585 PERFORM S2500-RELATED-EMP-NO THRU S2500-EXIT. DTSCS61 01586 PERFORM S2600-CLAIMANT-SSN THRU S2600-EXIT. DTSCS61 01587 PERFORM S2700-CLAIMANT-NAME THRU S2700-EXIT. DTSCS61 01588 SKIP1 DTSCS61 01589 PERFORM S2800-TEXT THRU S2800-EXIT DTSCS61 01590 VARYING WRK-CTR FROM 1 BY 1 DTSCS61 01591 UNTIL WRK-CTR > MMAX-FAS-TEXT-MAX. DTSCS61 01592 SKIP1 DTSCS61 01593 DTSCS61 01594 PERFORM S3000-MISC-EDITS THRU S3000-EXIT. DTSCS61 01595 S1000-EXIT. EXIT. DTSCS61 01596 EJECT DTSCS61 01597 S1100-EDIT-KEY. DTSCS61 01598 PERFORM S1101-EMP-NO THRU S1101-EXIT. DTSCS61 01599 S1100-EXIT. EXIT. DTSCS61 01600 /*****************************************************************DTSCS61 01601 * DTSCS61 01602 ******************************************************************DTSCS61 01603 S1101-EMP-NO. DTSCS61 01604 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS61 01605 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS61 01606 DTSCS61 01607 IF L018-NO-ENTRY DTSCS61 01608 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS61 01609 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS61 01610 GO TO S1101-EXIT. DTSCS61 01611 DTSCS61 01612 IF L018-NOT-VALID DTSCS61 01613 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS61 01614 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS61 01615 GO TO S1101-EXIT. DTSCS61 01616 DTSCS61 01617 MOVE L018-EMP-NO TO WRK-EMP-NO. DTSCS61 01618 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS61 01619 S1101-EXIT. EXIT. DTSCS61 01620 DTSCS61 01621 S1110-READ-MPRF. DTSCS61 01622 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS61 01623 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS61 01624 SET MPRF-PRF-88 TO TRUE. DTSCS61 01625 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS61 01626 PERFORM S810-READ THRU S810-EXIT. DTSCS61 01627 IF L810-NO-REC-88 DTSCS61 01628 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS61 01629 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS61 01630 ELSE DTSCS61 01631 MOVE MSKL-REC TO MPRF-REC DTSCS61 01632 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME DTSCS61 01633 SET WRK-MPRF-YES-88 TO TRUE. DTSCS61 01634 S1110-EXIT. DTSCS61 01635 EXIT. DTSCS61 01636 DTSCS61 01637 S1199-ERROR. DTSCS61 01638 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS61 01639 MAP-EMP-NO-2-A. DTSCS61 01640 IF LCCM-NO-MSG DTSCS61 01641 SET CURSOR-SET-YES TO TRUE DTSCS61 01642 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS61 01643 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS61 01644 S1199-EXIT. EXIT. DTSCS61 01645 /*****************************************************************DTSCS61 01646 * *DTSCS61 01647 ******************************************************************DTSCS61 01648 S1200-ASSIGN-TYPE. DTSCS61 01649 DTSCS61 01650 MOVE SPACES TO MAP-ASSIGN-TYPE-DESC. DTSCS61 01651 DTSCS61 01652 IF MAP-ASSIGN-TYPE EQUAL LOW-VALUES OR SPACES DTSCS61 01653 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS61 01654 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS61 01655 ELSE DTSCS61 01656 MOVE MAP-ASSIGN-TYPE TO L063-TYPE DTSCS61 01657 PERFORM S063-FIELD-ASSIGNMENT-EDIT THRU S063-EXIT DTSCS61 01658 IF L063-NOT-VALID DTSCS61 01659 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS61 01660 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS61 01661 ELSE DTSCS61 01662 MOVE L063-DESCRIPTION TO MAP-ASSIGN-TYPE-DESC DTSCS61 01663 PERFORM S1210-CROSS-EDITS THRU S1210-EXIT. DTSCS61 01664 DTSCS61 01665 S1200-EXIT. EXIT. DTSCS61 01666 DTSCS61 01667 S1201-ERROR. DTSCS61 01668 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-ASSIGN-TYPE-A. DTSCS61 01669 IF LCCM-NO-MSG DTSCS61 01670 SET CURSOR-SET-YES TO TRUE DTSCS61 01671 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS61 01672 MOVE CATB-CURSOR TO MAP-ASSIGN-TYPE-L. DTSCS61 01673 S1201-EXIT. EXIT. DTSCS61 01674 DTSCS61 01675 S1210-CROSS-EDITS. DTSCS61 01676 IF L063-AUDIT-88 DTSCS61 01677 IF (MPRF-CLASS-CHG-ONLY-88) DTSCS61 01678 OR DTSCS61 01679 (MPRF-CLASS-SELF-INS-88) DTSCS61 01680 OR DTSCS61 01681 (MPRF-BANKRP-OPEN-88) DTSCS61 01682 MOVE MSG-E612-AREA TO WRK-MSG-AREA DTSCS61 01683 PERFORM S1201-ERROR THRU S1201-EXIT. DTSCS61 01684 S1210-EXIT. DTSCS61 01685 EXIT. DTSCS61 01686 /*****************************************************************DTSCS61 01687 * *DTSCS61 01688 ******************************************************************DTSCS61 01689 S1300-ADD-OPEN-IND. DTSCS61 01690 IF (MAP-ADD-OPEN-IND = LOW-VALUES OR SPACES) DTSCS61 01691 MOVE 'N' TO MAP-ADD-OPEN-IND DTSCS61 01692 ELSE DTSCS61 01693 IF MAP-ADD-OPEN-IND-VALID DTSCS61 01694 NEXT SENTENCE DTSCS61 01695 ELSE DTSCS61 01696 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS61 01697 PERFORM S1301-ERROR THRU S1301-EXIT. DTSCS61 01698 DTSCS61 01699 S1300-EXIT. EXIT. DTSCS61 01700 DTSCS61 01701 S1301-ERROR. DTSCS61 01702 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ADD-OPEN-IND-A. DTSCS61 01703 IF LCCM-NO-MSG DTSCS61 01704 SET CURSOR-SET-YES TO TRUE DTSCS61 01705 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS61 01706 MOVE CATB-CURSOR TO MAP-ADD-OPEN-IND-L. DTSCS61 01707 S1301-EXIT. EXIT. DTSCS61 01708 /*****************************************************************DTSCS61 01709 * *DTSCS61 01710 ******************************************************************DTSCS61 01711 S1400-START-DATE. DTSCS61 01712 SET WRK-START-DATE-ERROR-NO TO TRUE. DTSCS61 01713 MOVE +0 TO WRK-START-DATE. DTSCS61 01714 DTSCS61 01715 MOVE MAP-START-DATE-AREA TO L015-S-DATE-AREA. DTSCS61 01716 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS61 01717 DTSCS61 01718 IF L015-NO-ENTRY DTSCS61 01719 IF L063-VERIF-AUDIT-88 DTSCS61 01720 PERFORM S1450-NEXT-QTR THRU S1450-EXIT DTSCS61 01721 ELSE DTSCS61 01722 MOVE LCCM-CURR-RUN-DATE TO WRK-DISPLAY DTSCS61 01723 WRK-START-DATE DTSCS61 01724 END-IF DTSCS61 01725 MOVE WRK-DISPLAY-MO TO MAP-START-DATE-MO DTSCS61 01726 MOVE WRK-DISPLAY-DA TO MAP-START-DATE-DA DTSCS61 01727 MOVE WRK-DISPLAY-YR TO MAP-START-DATE-YR DTSCS61 01728 ELSE DTSCS61 01729 IF L015-NOT-VALID DTSCS61 01730 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS61 01731 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS61 01732 ELSE DTSCS61 01733 MOVE L015-DATE TO WRK-START-DATE. DTSCS61 01734 S1400-EXIT. EXIT. DTSCS61 01735 DTSCS61 01736 S1401-ERROR. DTSCS61 01737 SET WRK-START-DATE-ERROR-YES TO TRUE. DTSCS61 01738 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-START-DATE-MO-A DTSCS61 01739 MAP-START-DATE-DA-A DTSCS61 01740 MAP-START-DATE-YR-A. DTSCS61 01741 IF LCCM-NO-MSG DTSCS61 01742 SET CURSOR-SET-YES TO TRUE DTSCS61 01743 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS61 01744 MOVE CATB-CURSOR TO MAP-START-DATE-MO-L. DTSCS61 01745 S1401-EXIT. EXIT. DTSCS61 01746 DTSCS61 01747 S1450-NEXT-QTR. DTSCS61 01748 MOVE LCCM-CURR-RUN-DATE TO L004-DATE. DTSCS61 01749 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSCS61 01750 ADD +1 TO L004-ABS-QTR. DTSCS61 01751 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSCS61 01752 MOVE L004-QTR-START-DATE TO WRK-DISPLAY DTSCS61 01753 WRK-START-DATE. DTSCS61 01754 S1450-EXIT. EXIT. DTSCS61 01755 /*****************************************************************DTSCS61 01756 * *DTSCS61 01757 ******************************************************************DTSCS61 01758 S1500-DUE-DATE. DTSCS61 01759 MOVE MAP-DUE-DATE-AREA TO L015-S-DATE-AREA. DTSCS61 01760 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS61 01761 DTSCS61 01762 IF L015-NO-ENTRY DTSCS61 01763 IF WRK-START-DATE-ERROR-YES DTSCS61 01764 NEXT SENTENCE DTSCS61 01765 ELSE DTSCS61 01766 IF L063-NO-DEFAULT-DUE-88 DTSCS61 01767 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS61 01768 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS61 01769 ELSE DTSCS61 01770 IF L063-DEFAULT-DUE-NXT-Q-END-88 DTSCS61 01771 MOVE LCCM-CURR-RUN-DATE TO L004-DATE DTSCS61 01772 PERFORM S004-FROM-DATE THRU S004-EXIT DTSCS61 01773 ADD +1 TO L004-ABS-QTR DTSCS61 01774 PERFORM S004-FROM-ABS THRU S004-EXIT DTSCS61 01775 MOVE L004-QTR-END-DATE TO WRK-DISPLAY DTSCS61 01776 MOVE WRK-DISPLAY-MO TO MAP-DUE-DATE-MO DTSCS61 01777 MOVE WRK-DISPLAY-DA TO MAP-DUE-DATE-DA DTSCS61 01778 MOVE WRK-DISPLAY-YR TO MAP-DUE-DATE-YR DTSCS61 01779 PERFORM S1510-START-DUE-CROSS-EDIT THRU S1510-EXIT DTSCS61 01780 ELSE DTSCS61 01781 MOVE WRK-START-DATE TO L001-FED-8-DATE-9 DTSCS61 01782 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCS61 01783 ADD L063-DEFAULT-DUE-DAYS TO L001-JUL-ABS-DAY DTSCS61 01784 PERFORM S001-FROM-ABS-DATE THRU S001-EXIT DTSCS61 01785 MOVE L001-FED-8-DATE-9 TO WRK-DISPLAY DTSCS61 01786 MOVE WRK-DISPLAY-MO TO MAP-DUE-DATE-MO DTSCS61 01787 MOVE WRK-DISPLAY-DA TO MAP-DUE-DATE-DA DTSCS61 01788 MOVE WRK-DISPLAY-YR TO MAP-DUE-DATE-YR DTSCS61 01789 PERFORM S1510-START-DUE-CROSS-EDIT THRU S1510-EXIT DTSCS61 01790 ELSE DTSCS61 01791 IF L015-NOT-VALID DTSCS61 01792 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS61 01793 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS61 01794 ELSE DTSCS61 01795 PERFORM S1510-START-DUE-CROSS-EDIT THRU S1510-EXIT. DTSCS61 01796 S1500-EXIT. EXIT. DTSCS61 01797 DTSCS61 01798 S1501-ERROR. DTSCS61 01799 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-DUE-DATE-MO-A DTSCS61 01800 MAP-DUE-DATE-DA-A DTSCS61 01801 MAP-DUE-DATE-YR-A. DTSCS61 01802 IF LCCM-NO-MSG DTSCS61 01803 SET CURSOR-SET-YES TO TRUE DTSCS61 01804 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS61 01805 MOVE CATB-CURSOR TO MAP-DUE-DATE-MO-L. DTSCS61 01806 S1501-EXIT. EXIT. DTSCS61 01807 SKIP3 DTSCS61 01808 S1510-START-DUE-CROSS-EDIT. DTSCS61 01809 IF WRK-START-DATE = +0 DTSCS61 01810 GO TO S1510-EXIT. DTSCS61 01811 DTSCS61 01812 MOVE MAP-DUE-DATE-AREA TO L015-S-DATE-AREA. DTSCS61 01813 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS61 01814 IF L015-VALID DTSCS61 01815 NEXT SENTENCE DTSCS61 01816 ELSE DTSCS61 01817 GO TO S1510-EXIT. DTSCS61 01818 DTSCS61 01819 IF WRK-START-DATE > L015-DATE DTSCS61 01820 MOVE MSG-E615-AREA TO WRK-MSG-AREA DTSCS61 01821 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS61 01822 PERFORM S1501-ERROR THRU S1501-EXIT. DTSCS61 01823 S1510-EXIT. DTSCS61 01824 EXIT. DTSCS61 01825 /*****************************************************************DTSCS61 01826 * *DTSCS61 01827 ******************************************************************DTSCS61 01828 S1600-FLD-REP-ID. DTSCS61 01829 MOVE SPACES TO MAP-FLD-REP-ID-DESC DTSCS61 01830 DTSCS61 01831 IF MAP-FLD-REP-ID EQUAL LOW-VALUES OR SPACES DTSCS61 01832 SET WRK-FLD-REP-NOT-ENTERED TO TRUE DTSCS61 01833 ELSE DTSCS61 01834 SET WRK-FLD-REP-ENTERED TO TRUE DTSCS61 01835 MOVE MAP-FLD-REP-ID TO L062-FLD-REP-ID DTSCS61 01836 PERFORM S062-FLD-REP-ID-DESC THRU S062-EXIT DTSCS61 01837 IF L062-NOT-VALID DTSCS61 01838 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS61 01839 PERFORM S1601-ERROR THRU S1601-EXIT. DTSCS61 01840 S1600-EXIT. EXIT. DTSCS61 01841 DTSCS61 01842 S1601-ERROR. DTSCS61 01843 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-FLD-REP-ID-A. DTSCS61 01844 IF LCCM-NO-MSG DTSCS61 01845 SET CURSOR-SET-YES TO TRUE DTSCS61 01846 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS61 01847 MOVE CATB-CURSOR TO MAP-FLD-REP-ID-L. DTSCS61 01848 S1601-EXIT. EXIT. DTSCS61 01849 /*****************************************************************DTSCS61 01850 * *DTSCS61 01851 ******************************************************************DTSCS61 01852 S1700-ATTACHMENTS. DTSCS61 01853 IF (MAP-ATTACHMENTS-IND = LOW-VALUES OR SPACES) DTSCS61 01854 MOVE L063-DEFAULT-ATTACH-IND TO MAP-ATTACHMENTS-IND DTSCS61 01855 ELSE DTSCS61 01856 IF MAP-ATTACHMENTS-IND-VALID DTSCS61 01857 NEXT SENTENCE DTSCS61 01858 ELSE DTSCS61 01859 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS61 01860 PERFORM S1701-ERROR THRU S1701-EXIT. DTSCS61 01861 S1700-EXIT. EXIT. DTSCS61 01862 DTSCS61 01863 S1701-ERROR. DTSCS61 01864 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ATTACHMENTS-IND-A. DTSCS61 01865 IF LCCM-NO-MSG DTSCS61 01866 SET CURSOR-SET-YES TO TRUE DTSCS61 01867 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS61 01868 MOVE CATB-CURSOR TO MAP-ATTACHMENTS-IND-L. DTSCS61 01869 S1701-EXIT. EXIT. DTSCS61 01870 /*****************************************************************DTSCS61 01871 * *DTSCS61 01872 ******************************************************************DTSCS61 01873 S1800-SOURCE-OP-ID. DTSCS61 01874 MOVE SPACES TO MAP-SOURCE-OP-ID-DESC. DTSCS61 01875 DTSCS61 01876 IF MAP-SOURCE-OP-ID EQUAL LOW-VALUES OR SPACES DTSCS61 01877 MOVE LCCM-RESP-OP-ID TO MAP-SOURCE-OP-ID. DTSCS61 01878 DTSCS61 01879 IF MAP-SOURCE-OP-ID = LCCM-OP-ID DTSCS61 01880 MOVE LCCM-OP-NAME TO L082-NAME DTSCS61 01881 MOVE LCCM-OP-FLD-DESK-IND TO L082-FLD-DESK-IND DTSCS61 01882 MOVE LCCM-OP-ACCOUNTING-DESK-IND DTSCS61 01883 TO L082-ACCOUNTING-DESK-IND DTSCS61 01884 ELSE DTSCS61 01885 MOVE MAP-SOURCE-OP-ID TO L082-OP-ID DTSCS61 01886 PERFORM S082-OP-ID-EDIT THRU S082-EXIT DTSCS61 01887 IF L082-INTERNAL-88 DTSCS61 01888 OR L082-NOT-VALID-OP DTSCS61 01889 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS61 01890 PERFORM S1801-ERROR THRU S1801-EXIT DTSCS61 01891 GO TO S1800-EXIT. DTSCS61 01892 DTSCS61 01893 MOVE MAP-SOURCE-OP-ID TO LCCM-RESP-OP-ID. DTSCS61 01894 DTSCS61 01895 MOVE L082-NAME TO MAP-SOURCE-OP-ID-DESC. DTSCS61 01896 DTSCS61 01897 IF L082-IS-FLD-DESK-88 DTSCS61 01898 PERFORM S1810-FLD-DESK-OPER THRU S1810-EXIT DTSCS61 01899 ELSE DTSCS61 01900 PERFORM S1820-NON-FLD-DESK-OPER THRU S1820-EXIT. DTSCS61 01901 DTSCS61 01902 MOVE MAP-FLD-REP-ID TO L062-FLD-REP-ID. DTSCS61 01903 DTSCS61 01904 PERFORM S062-FLD-REP-ID-DESC THRU S062-EXIT. DTSCS61 01905 DTSCS61 01906 MOVE L062-NAME TO MAP-FLD-REP-ID-DESC. DTSCS61 01907 S1800-EXIT. EXIT. DTSCS61 01908 DTSCS61 01909 S1801-ERROR. DTSCS61 01910 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-SOURCE-OP-ID-A. DTSCS61 01911 IF LCCM-NO-MSG DTSCS61 01912 SET CURSOR-SET-YES TO TRUE DTSCS61 01913 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS61 01914 MOVE CATB-CURSOR TO MAP-SOURCE-OP-ID-L. DTSCS61 01915 S1801-EXIT. EXIT. DTSCS61 01916 DTSCS61 01917 S1810-FLD-DESK-OPER. DTSCS61 01918 IF WRK-FLD-REP-NOT-ENTERED DTSCS61 01919 IF L063-ACCOUNTING-YES-88 DTSCS61 01920 MOVE 'AD' TO MAP-FLD-REP-ID DTSCS61 01921 ELSE DTSCS61 01922 MOVE MPRF-FLD-ZIP TO L061-FLD-ZIP DTSCS61 01923 MOVE MPRF-FLD-ST TO L061-FLD-ST DTSCS61 01924 MOVE MPRF-EMP-NO TO L061-EMP-NO DTSCS61 01925 PERFORM S061-FIELD-ZIP-REP-ID THRU S061-EXIT DTSCS61 01926 MOVE L061-FLD-REP-ID TO MAP-FLD-REP-ID DTSCS61 01927 END-IF DTSCS61 01928 END-IF. DTSCS61 01929 S1810-EXIT. EXIT. DTSCS61 01930 DTSCS61 01931 S1820-NON-FLD-DESK-OPER. DTSCS61 01932 IF WRK-FLD-REP-NOT-ENTERED DTSCS61 01933 IF L063-ACCOUNTING-YES-88 DTSCS61 01934 MOVE 'AD' TO MAP-FLD-REP-ID DTSCS61 01935 GO TO S1820-EXIT DTSCS61 01936 ELSE DTSCS61 01937 MOVE 'FD' TO MAP-FLD-REP-ID DTSCS61 01938 GO TO S1820-EXIT. DTSCS61 01939 DTSCS61 01940 IF L063-ACCOUNTING-YES-88 DTSCS61 01941 IF MAP-FLD-REP-ID NOT = 'AD' DTSCS61 01942 MOVE MSG-E618-AREA TO WRK-MSG-AREA DTSCS61 01943 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS61 01944 ELSE DTSCS61 01945 NEXT SENTENCE DTSCS61 01946 ELSE DTSCS61 01947 IF MAP-FLD-REP-ID NOT = 'FD' DTSCS61 01948 MOVE MSG-E617-AREA TO WRK-MSG-AREA DTSCS61 01949 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS61 01950 ELSE DTSCS61 01951 NEXT SENTENCE. DTSCS61 01952 S1820-EXIT. EXIT. DTSCS61 01953 DTSCS61 01954 /*****************************************************************DTSCS61 01955 * MORE EDITING HERE DTSCS61 01956 ******************************************************************DTSCS61 01957 S1900-EMP-SIZE-IND. DTSCS61 01958 IF MAP-EMP-SIZE-IND = LOW-VALUES DTSCS61 01959 MOVE SPACES TO MAP-EMP-SIZE-IND. DTSCS61 01960 SKIP1 DTSCS61 01961 IF MAP-EMP-SIZE-IND = SPACES DTSCS61 01962 IF L063-NON-AUDIT-88 DTSCS61 01963 NEXT SENTENCE DTSCS61 01964 ELSE DTSCS61 01965 MOVE 'S' TO MAP-EMP-SIZE-IND DTSCS61 01966 ELSE DTSCS61 01967 IF MAP-EMP-SIZE-IND-VALID DTSCS61 01968 IF L063-NON-AUDIT-88 DTSCS61 01969 MOVE MSG-E61A-AREA TO WRK-MSG-AREA DTSCS61 01970 PERFORM S1901-ERROR THRU S1901-EXIT DTSCS61 01971 ELSE DTSCS61 01972 NEXT SENTENCE DTSCS61 01973 ELSE DTSCS61 01974 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS61 01975 PERFORM S1901-ERROR THRU S1901-EXIT. DTSCS61 01976 DTSCS61 01977 S1900-EXIT. EXIT. DTSCS61 01978 DTSCS61 01979 S1901-ERROR. DTSCS61 01980 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-EMP-SIZE-IND-A. DTSCS61 01981 IF LCCM-NO-MSG DTSCS61 01982 SET CURSOR-SET-YES TO TRUE DTSCS61 01983 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS61 01984 MOVE CATB-CURSOR TO MAP-EMP-SIZE-IND-L. DTSCS61 01985 S1901-EXIT. EXIT. DTSCS61 01986 /*****************************************************************DTSCS61 01987 * *DTSCS61 01988 ******************************************************************DTSCS61 01989 S2000-AUDIT-SEL-REASON. DTSCS61 01990 INSPECT MAP-AUDIT-SEL-REASON(WRK-CTR) DTSCS61 01991 CONVERTING LOW-VALUES TO SPACES. DTSCS61 01992 DTSCS61 01993 IF MAP-AUDIT-SEL-REASON(WRK-CTR) = SPACES DTSCS61 01994 IF L063-AUDIT-88 AND WRK-CTR = 1 DTSCS61 01995 SET MAP-AUDIT-SEL-DEFAULT-88 (WRK-CTR) TO TRUE DTSCS61 01996 GO TO S2000-EXIT DTSCS61 01997 ELSE DTSCS61 01998 GO TO S2000-EXIT. DTSCS61 01999 DTSCS61 02000 IF L063-NON-AUDIT-88 DTSCS61 02001 MOVE MSG-E61A-AREA TO WRK-MSG-AREA DTSCS61 02002 PERFORM S2001-ERROR THRU S2001-EXIT DTSCS61 02003 GO TO S2000-EXIT. DTSCS61 02004 DTSCS61 02005 MOVE MAP-AUDIT-SEL-REASON(WRK-CTR) TO L036-CD. DTSCS61 02006 PERFORM S036-AUDIT-SEL-REASON THRU S036-EXIT. DTSCS61 02007 DTSCS61 02008 IF L036-NOT-VALID DTSCS61 02009 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS61 02010 PERFORM S2001-ERROR THRU S2001-EXIT. DTSCS61 02011 S2000-EXIT. EXIT. DTSCS61 02012 DTSCS61 02013 S2001-ERROR. DTSCS61 02014 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS61 02015 TO MAP-AUDIT-SEL-REASON-A(WRK-CTR). DTSCS61 02016 IF LCCM-NO-MSG DTSCS61 02017 SET CURSOR-SET-YES TO TRUE DTSCS61 02018 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS61 02019 MOVE CATB-CURSOR TO MAP-AUDIT-SEL-REASON-L(WRK-CTR). DTSCS61 02020 S2001-EXIT. EXIT. DTSCS61 02021 /*****************************************************************DTSCS61 02022 * *DTSCS61 02023 ******************************************************************DTSCS61 02024 S2100-TAX-EXTRACT. DTSCS61 02025 IF MAP-TAX-EXTRACT EQUAL LOW-VALUES OR SPACES DTSCS61 02026 SET MAP-TAX-EXTRACT-NO TO TRUE DTSCS61 02027 ELSE DTSCS61 02028 IF NOT MAP-TAX-EXTRACT-VALID DTSCS61 02029 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS61 02030 PERFORM S2101-ERROR THRU S2101-EXIT DTSCS61 02031 ELSE DTSCS61 02032 IF MAP-TAX-EXTRACT-YES DTSCS61 02033 SET WRK-EXTRACT-REQ-YES-88 TO TRUE. DTSCS61 02034 DTSCS61 02035 IF MAP-TAX-EXTRACT-YES DTSCS61 02036 IF MPRF-NOT-WRITTEN-OFF-88 DTSCS61 02037 NEXT SENTENCE DTSCS61 02038 ELSE DTSCS61 02039 MOVE MSG-E61C-AREA TO WRK-MSG-AREA DTSCS61 02040 PERFORM S2101-ERROR THRU S2101-EXIT. DTSCS61 02041 S2100-EXIT. EXIT. DTSCS61 02042 DTSCS61 02043 S2101-ERROR. DTSCS61 02044 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-TAX-EXTRACT-A. DTSCS61 02045 IF LCCM-NO-MSG DTSCS61 02046 SET CURSOR-SET-YES TO TRUE DTSCS61 02047 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS61 02048 MOVE CATB-CURSOR TO MAP-TAX-EXTRACT-L. DTSCS61 02049 S2101-EXIT. EXIT. DTSCS61 02050 /*****************************************************************DTSCS61 02051 * *DTSCS61 02052 ******************************************************************DTSCS61 02053 S2200-WAGE-EXTRACT. DTSCS61 02054 IF MAP-WAGE-EXTRACT EQUAL LOW-VALUES OR SPACES DTSCS61 02055 SET MAP-WAGE-EXTRACT-NO TO TRUE DTSCS61 02056 ELSE DTSCS61 02057 IF NOT MAP-WAGE-EXTRACT-VALID DTSCS61 02058 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS61 02059 PERFORM S2201-ERROR THRU S2201-EXIT DTSCS61 02060 ELSE DTSCS61 02061 IF MAP-WAGE-EXTRACT-YES DTSCS61 02062 SET WRK-EXTRACT-REQ-YES-88 TO TRUE. DTSCS61 02063 DTSCS61 02064 IF MAP-WAGE-EXTRACT-YES DTSCS61 02065 IF MPRF-NOT-WRITTEN-OFF-88 DTSCS61 02066 NEXT SENTENCE DTSCS61 02067 ELSE DTSCS61 02068 MOVE MSG-E61C-AREA TO WRK-MSG-AREA DTSCS61 02069 PERFORM S2201-ERROR THRU S2201-EXIT. DTSCS61 02070 S2200-EXIT. EXIT. DTSCS61 02071 DTSCS61 02072 S2201-ERROR. DTSCS61 02073 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-WAGE-EXTRACT-A. DTSCS61 02074 IF LCCM-NO-MSG DTSCS61 02075 SET CURSOR-SET-YES TO TRUE DTSCS61 02076 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS61 02077 MOVE CATB-CURSOR TO MAP-WAGE-EXTRACT-L. DTSCS61 02078 S2201-EXIT. EXIT. DTSCS61 02079 /*****************************************************************DTSCS61 02080 * DTSCS61 02081 ******************************************************************DTSCS61 02082 S2300-QTR-RANGE. DTSCS61 02083 MOVE MAP-AUDIT-START-YRQ-AREA TO L024-S-START-YRQ-AREA. DTSCS61 02084 MOVE MAP-AUDIT-END-YRQ-AREA TO L024-S-END-YRQ-AREA. DTSCS61 02085 PERFORM S024-EDIT-QTR-SPAN THRU S024-EXIT. DTSCS61 02086 IF L024-START-NO-ENTRY DTSCS61 02087 IF L063-AUDIT-88 DTSCS61 02088 MOVE MSG-E61B-AREA TO WRK-MSG-AREA DTSCS61 02089 PERFORM S2301-ERROR THRU S2301-EXIT DTSCS61 02090 ELSE DTSCS61 02091 IF WRK-EXTRACT-REQ-YES-88 DTSCS61 02092 MOVE MSG-E616-AREA TO WRK-MSG-AREA DTSCS61 02093 PERFORM S2301-ERROR THRU S2301-EXIT DTSCS61 02094 END-IF DTSCS61 02095 END-IF DTSCS61 02096 ELSE DTSCS61 02097 IF WRK-EXTRACT-REQ-NO-88 AND L063-NON-AUDIT-88 DTSCS61 02098 MOVE MSG-E61A-AREA TO WRK-MSG-AREA DTSCS61 02099 PERFORM S2301-ERROR THRU S2301-EXIT DTSCS61 02100 ELSE DTSCS61 02101 IF L024-START-NOT-VALID DTSCS61 02102 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS61 02103 PERFORM S2301-ERROR THRU S2301-EXIT DTSCS61 02104 ELSE DTSCS61 02105 NEXT SENTENCE DTSCS61 02106 END-IF DTSCS61 02107 END-IF DTSCS61 02108 END-IF. DTSCS61 02109 DTSCS61 02110 IF L024-END-NO-ENTRY DTSCS61 02111 IF L063-AUDIT-88 DTSCS61 02112 MOVE MSG-E61B-AREA TO WRK-MSG-AREA DTSCS61 02113 PERFORM S2301-ERROR THRU S2301-EXIT DTSCS61 02114 ELSE DTSCS61 02115 IF WRK-EXTRACT-REQ-YES-88 DTSCS61 02116 MOVE MSG-E616-AREA TO WRK-MSG-AREA DTSCS61 02117 PERFORM S2301-ERROR THRU S2301-EXIT DTSCS61 02118 END-IF DTSCS61 02119 END-IF DTSCS61 02120 ELSE DTSCS61 02121 IF WRK-EXTRACT-REQ-NO-88 AND L063-NON-AUDIT-88 DTSCS61 02122 MOVE MSG-E61A-AREA TO WRK-MSG-AREA DTSCS61 02123 PERFORM S2303-ERROR THRU S2303-EXIT DTSCS61 02124 ELSE DTSCS61 02125 IF L024-END-NOT-VALID DTSCS61 02126 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS61 02127 PERFORM S2303-ERROR THRU S2303-EXIT DTSCS61 02128 ELSE DTSCS61 02129 NEXT SENTENCE DTSCS61 02130 END-IF DTSCS61 02131 END-IF DTSCS61 02132 END-IF. DTSCS61 02133 DTSCS61 02134 DTSCS61 02135 IF WRK-EXTRACT-REQ-NO-88 AND L063-NON-AUDIT-88 DTSCS61 02136 GO TO S2300-EXIT. DTSCS61 02137 DTSCS61 02138 IF L024-SPAN-INVALID DTSCS61 02139 OR L024-END-BEFORE-START DTSCS61 02140 OR L024-QTRS-SPANNED > +12 DTSCS61 02141 MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS61 02142 PERFORM S2301-ERROR THRU S2301-EXIT DTSCS61 02143 PERFORM S2303-ERROR THRU S2303-EXIT DTSCS61 02144 END-IF. DTSCS61 02145 S2300-EXIT. EXIT. DTSCS61 02146 DTSCS61 02147 S2301-ERROR. DTSCS61 02148 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-AUDIT-START-YR-A DTSCS61 02149 MAP-AUDIT-START-Q-A DTSCS61 02150 IF LCCM-NO-MSG DTSCS61 02151 SET CURSOR-SET-YES TO TRUE DTSCS61 02152 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS61 02153 MOVE CATB-CURSOR TO MAP-AUDIT-START-YR-L. DTSCS61 02154 S2301-EXIT. EXIT. DTSCS61 02155 DTSCS61 02156 S2303-ERROR. DTSCS61 02157 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-AUDIT-END-YR-A DTSCS61 02158 MAP-AUDIT-END-Q-A DTSCS61 02159 IF LCCM-NO-MSG DTSCS61 02160 SET CURSOR-SET-YES TO TRUE DTSCS61 02161 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS61 02162 MOVE CATB-CURSOR TO MAP-AUDIT-END-YR-L. DTSCS61 02163 S2303-EXIT. EXIT. DTSCS61 02164 /*****************************************************************DTSCS61 02165 * DTSCS61 02166 ******************************************************************DTSCS61 02167 S2400-SIC-NAICS-OWN. DTSCS61 02168 MOVE MPRF-NAICS-CD TO MAP-NAICS-CD. DTSCS61 02169 MOVE MPRF-SIC-CD TO MAP-SIC-CD. DTSCS61 02170 MOVE MPRF-OWN-CD TO MAP-OWN-CD. DTSCS61 02171 DTSCS61 02172 ***** DTSCS61 02173 ***** SIC CODE AND OWN CODE CHANGED TO DISPLAY ONLY DTSCS61 02174 ***** ON 03/01/95 PER LYNNETTE DTSCS61 02175 ***** DTSCS61 02176 *****IF MAP-SIC-CD = LOW-VALUES DTSCS61 02177 ***** MOVE SPACES TO MAP-SIC-CD. DTSCS61 02178 ***** DTSCS61 02179 *****IF MAP-OWN-CD = LOW-VALUES DTSCS61 02180 ***** MOVE SPACES TO MAP-OWN-CD. DTSCS61 02181 ***** DTSCS61 02182 *****IF (MAP-SIC-CD = SPACES) DTSCS61 02183 ***** AND DTSCS61 02184 ***** (MAP-OWN-CD = SPACES) DTSCS61 02185 ***** IF WRK-ASSIGN-TYPE-ERROR-YES DTSCS61 02186 ***** GO TO S2200-EXIT DTSCS61 02187 ***** ELSE DTSCS61 02188 ***** IF L063-AUDIT-88 DTSCS61 02189 ***** MOVE MPRF-SIC-CD TO MAP-SIC-CD DTSCS61 02190 ***** MOVE MPRF-OWN-CD TO MAP-OWN-CD DTSCS61 02191 ***** GO TO S2200-EXIT DTSCS61 02192 ***** ELSE DTSCS61 02193 ***** GO TO S2200-EXIT. DTSCS61 02194 ***** DTSCS61 02195 *****MOVE MAP-SIC-CD TO L039-SIC-CD. DTSCS61 02196 *****MOVE MAP-OWN-CD TO L039-OWN-CD. DTSCS61 02197 ***** DTSCS61 02198 *****PERFORM S039-SIC-OWN-CODE-EDIT THRU S039-EXIT. DTSCS61 02199 ***** DTSCS61 02200 *****IF L039-SIC-NOT-VALID DTSCS61 02201 ***** MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS61 02202 ***** PERFORM S2201-ERROR THRU S2201-EXIT. DTSCS61 02203 ***** DTSCS61 02204 *****IF L039-OWN-NOT-VALID DTSCS61 02205 ***** MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS61 02206 ***** PERFORM S2202-ERROR THRU S2202-EXIT. DTSCS61 02207 S2400-EXIT. EXIT. DTSCS61 02208 DTSCS61 02209 *S2201-ERROR. DTSCS61 02210 *****MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS61 02211 ***** TO MAP-SIC-CD-A. DTSCS61 02212 *****IF LCCM-NO-MSG DTSCS61 02213 ***** SET CURSOR-SET-YES TO TRUE DTSCS61 02214 ***** MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS61 02215 ***** MOVE CATB-CURSOR TO MAP-SIC-CD-L. DTSCS61 02216 *S2201-EXIT. EXIT. DTSCS61 02217 DTSCS61 02218 *S2202-ERROR. DTSCS61 02219 *****MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS61 02220 ***** TO MAP-OWN-CD-A. DTSCS61 02221 *****IF LCCM-NO-MSG DTSCS61 02222 ***** SET CURSOR-SET-YES TO TRUE DTSCS61 02223 ***** MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS61 02224 ***** MOVE CATB-CURSOR TO MAP-OWN-CD-L. DTSCS61 02225 *S2202-EXIT. EXIT. DTSCS61 02226 /*****************************************************************DTSCS61 02227 * *DTSCS61 02228 ******************************************************************DTSCS61 02229 *S2300-COPIES. DTSCS61 02230 * IF MAP-COPIES = LOW-VALUE OR SPACE DTSCS61 02231 * MOVE MAP-CLAIMANT-SSN-AREA TO L020-S-SSN-AREA DTSCS61 02232 * PERFORM S020-SSN-FROM-SCREEN THRU S020-EXIT DTSCS61 02233 * MOVE MAP-RELATED-EMP-NO-AREA TO L018-S-EMP-NO-AREA DTSCS61 02234 * PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT DTSCS61 02235 * IF L018-NO-ENTRY DTSCS61 02236 * AND L020-NO-ENTRY DTSCS61 02237 * MOVE '0' TO MAP-COPIES DTSCS61 02238 * ELSE DTSCS61 02239 * IF L020-NO-ENTRY DTSCS61 02240 * OR L018-NO-ENTRY DTSCS61 02241 * MOVE '0' TO MAP-COPIES DTSCS61 02242 * ELSE DTSCS61 02243 * MOVE '0' TO MAP-COPIES DTSCS61 02244 * ELSE DTSCS61 02245 * IF NOT MAP-COPIES-VALID DTSCS61 02246 * MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS61 02247 * PERFORM S2301-ERROR THRU S2301-EXIT. DTSCS61 02248 *S2300-EXIT. EXIT. DTSCS61 02249 DTSCS61 02250 *S2301-ERROR. DTSCS61 02251 * MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-COPIES-A. DTSCS61 02252 * IF LCCM-NO-MSG DTSCS61 02253 * SET CURSOR-SET-YES TO TRUE DTSCS61 02254 * MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS61 02255 ** MOVE CATB-CURSOR TO MAP-COPIES-L. DTSCS61 02256 *S2301-EXIT. EXIT. DTSCS61 02257 /*****************************************************************DTSCS61 02258 * *DTSCS61 02259 ******************************************************************DTSCS61 02260 *S2400-PRINTER-ID. DTSCS61 02261 * IF MAP-PRINTER-ID EQUAL LOW-VALUES OR SPACES DTSCS61 02262 * IF LCCM-NO-PRINTER DTSCS61 02263 * AND MAP-COPIES NOT = '0' DTSCS61 02264 * MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS61 02265 * PERFORM S2401-ERROR THRU S2401-EXIT DTSCS61 02266 * ELSE DTSCS61 02267 * MOVE LCCM-PRINTER-ID TO MAP-PRINTER-ID DTSCS61 02268 * ELSE DTSCS61 02269 * MOVE MAP-PRINTER-ID TO LCCM-PRINTER-ID. DTSCS61 02270 *S2400-EXIT. EXIT. DTSCS61 02271 DTSCS61 02272 *S2401-ERROR. DTSCS61 02273 * MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-PRINTER-ID-A. DTSCS61 02274 * IF LCCM-NO-MSG DTSCS61 02275 * SET CURSOR-SET-YES TO TRUE DTSCS61 02276 * MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS61 02277 * MOVE CATB-CURSOR TO MAP-PRINTER-ID-L. DTSCS61 02278 *S2401-EXIT. EXIT. DTSCS61 02279 /*****************************************************************DTSCS61 02280 * *DTSCS61 02281 ******************************************************************DTSCS61 02282 S2500-RELATED-EMP-NO. DTSCS61 02283 MOVE MAP-RELATED-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS61 02284 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS61 02285 IF L018-NO-ENTRY DTSCS61 02286 GO TO S2500-EXIT. DTSCS61 02287 DTSCS61 02288 IF L018-NOT-VALID DTSCS61 02289 OR L018-EMP-NO = LCCM-EMP-NO DTSCS61 02290 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS61 02291 PERFORM S2501-ERROR THRU S2501-EXIT DTSCS61 02292 GO TO S2500-EXIT. DTSCS61 02293 DTSCS61 02294 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS61 02295 MOVE L018-EMP-NO TO MPRF-EMP-NO. DTSCS61 02296 SET MPRF-PRF-88 TO TRUE. DTSCS61 02297 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS61 02298 PERFORM S810-READ THRU S810-EXIT. DTSCS61 02299 DTSCS61 02300 IF L810-NO-REC-88 DTSCS61 02301 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS61 02302 PERFORM S2501-ERROR THRU S2501-EXIT DTSCS61 02303 GO TO S2500-EXIT. DTSCS61 02304 DTSCS61 02305 MOVE MSKL-REC TO MPRF-REC. DTSCS61 02306 MOVE MPRF-PRIMARY-NAME TO MAP-RELATED-PRIMARY-NAME. DTSCS61 02307 IF MPRF-CLASS-CHG-ONLY-88 DTSCS61 02308 MOVE MSG-E613-AREA TO WRK-MSG-AREA DTSCS61 02309 PERFORM S2501-ERROR THRU S2501-EXIT. DTSCS61 02310 DTSCS61 02311 *** NEED TO REREAD THE EMPLOYER FOR LATER DTSCS61 02312 DTSCS61 02313 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS61 02314 S2500-EXIT. EXIT. DTSCS61 02315 DTSCS61 02316 S2501-ERROR. DTSCS61 02317 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-RELATED-EMP-NO-1-A DTSCS61 02318 MAP-RELATED-EMP-NO-2-A. DTSCS61 02319 IF LCCM-NO-MSG DTSCS61 02320 SET CURSOR-SET-YES TO TRUE DTSCS61 02321 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS61 02322 MOVE CATB-CURSOR TO MAP-RELATED-EMP-NO-1-L. DTSCS61 02323 S2501-EXIT. EXIT. DTSCS61 02324 /*****************************************************************DTSCS61 02325 * *DTSCS61 02326 ******************************************************************DTSCS61 02327 S2600-CLAIMANT-SSN. DTSCS61 02328 MOVE MAP-CLAIMANT-SSN-AREA TO L020-S-SSN-AREA DTSCS61 02329 PERFORM S020-SSN-FROM-SCREEN THRU S020-EXIT DTSCS61 02330 IF L020-NO-ENTRY DTSCS61 02331 NEXT SENTENCE DTSCS61 02332 ELSE DTSCS61 02333 IF L020-NOT-VALID DTSCS61 02334 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS61 02335 PERFORM S2601-ERROR THRU S2601-EXIT. DTSCS61 02336 DTSCS61 02337 S2600-EXIT. EXIT. DTSCS61 02338 DTSCS61 02339 S2601-ERROR. DTSCS61 02340 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-CLAIMANT-SSN-1-A DTSCS61 02341 MAP-CLAIMANT-SSN-2-A DTSCS61 02342 MAP-CLAIMANT-SSN-3-A. DTSCS61 02343 IF LCCM-NO-MSG DTSCS61 02344 SET CURSOR-SET-YES TO TRUE DTSCS61 02345 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS61 02346 MOVE CATB-CURSOR TO MAP-CLAIMANT-SSN-1-L. DTSCS61 02347 S2601-EXIT. EXIT. DTSCS61 02348 /*****************************************************************DTSCS61 02349 * *DTSCS61 02350 ******************************************************************DTSCS61 02351 S2700-CLAIMANT-NAME. DTSCS61 02352 INSPECT MAP-CLAIMANT-NAME DTSCS61 02353 CONVERTING LOW-VALUES TO SPACES. DTSCS61 02354 DTSCS61 02355 IF MAP-CLAIMANT-NAME = SPACES DTSCS61 02356 IF L020-NO-ENTRY DTSCS61 02357 GO TO S2700-EXIT. DTSCS61 02358 DTSCS61 02359 IF L020-NOT-VALID DTSCS61 02360 GO TO S2700-EXIT. DTSCS61 02361 DTSCS61 02362 IF L020-NO-ENTRY DTSCS61 02363 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS61 02364 PERFORM S2701-ERROR THRU S2701-EXIT DTSCS61 02365 GO TO S2700-EXIT. DTSCS61 02366 DTSCS61 02367 IF MAP-CLAIMANT-NAME = SPACES DTSCS61 02368 MOVE L020-SSN TO L081-CLAIMANT-SSN DTSCS61 02369 PERFORM S081-CLAIMANT-NAME THRU S081-EXIT DTSCS61 02370 IF L081-NAME-FOUND DTSCS61 02371 MOVE L081-CLAIMANT-NAME TO MAP-CLAIMANT-NAME. DTSCS61 02372 DTSCS61 02373 IF MAP-CLAIMANT-NAME = SPACES DTSCS61 02374 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS61 02375 PERFORM S2701-ERROR THRU S2701-EXIT DTSCS61 02376 ELSE DTSCS61 02377 MOVE MAP-CLAIMANT-NAME TO L071-NAM DTSCS61 02378 PERFORM S071-FROM-LAST-NAME-FIRST THRU S071-EXIT DTSCS61 02379 IF L071-NAME-INVALID DTSCS61 02380 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS61 02381 PERFORM S2701-ERROR THRU S2701-EXIT. DTSCS61 02382 DTSCS61 02383 S2700-EXIT. EXIT. DTSCS61 02384 DTSCS61 02385 S2701-ERROR. DTSCS61 02386 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-CLAIMANT-NAME-A. DTSCS61 02387 IF LCCM-NO-MSG DTSCS61 02388 SET CURSOR-SET-YES TO TRUE DTSCS61 02389 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS61 02390 MOVE CATB-CURSOR TO MAP-CLAIMANT-NAME-L. DTSCS61 02391 S2701-EXIT. EXIT. DTSCS61 02392 /*****************************************************************DTSCS61 02393 * *DTSCS61 02394 ******************************************************************DTSCS61 02395 S2800-TEXT. DTSCS61 02396 INSPECT MAP-TEXT (WRK-CTR) DTSCS61 02397 CONVERTING LOW-VALUES TO SPACES. DTSCS61 02398 S2800-EXIT. EXIT. DTSCS61 02399 DTSCS61 02400 *S3001-ERROR. DTSCS61 02401 **** MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-TEXT-A(WRK-CTR). DTSCS61 02402 **** IF LCCM-NO-MSG DTSCS61 02403 **** SET CURSOR-SET-YES TO TRUE DTSCS61 02404 **** MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS61 02405 **** MOVE CATB-CURSOR TO MAP-TEXT-L(WRK-CTR). DTSCS61 02406 *S3001-EXIT. EXIT. DTSCS61 02407 DTSCS61 02408 S3000-MISC-EDITS. DTSCS61 02409 IF MAP-ADD-OPEN-IND-YES DTSCS61 02410 NEXT SENTENCE DTSCS61 02411 ELSE DTSCS61 02412 PERFORM S3010-MFAS-OPEN-EDIT THRU S3010-EXIT. DTSCS61 02413 S3000-EXIT. EXIT. DTSCS61 02414 DTSCS61 02415 S3010-MFAS-OPEN-EDIT. DTSCS61 02416 MOVE LOW-VALUES TO MFAS-KEY-AREA. DTSCS61 02417 MOVE WRK-EMP-NO TO MFAS-EMP-NO. DTSCS61 02418 SET MFAS-FAS-88 TO TRUE. DTSCS61 02419 MOVE MFAS-KEY-AREA TO MSKL-KEY-AREA. DTSCS61 02420 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS61 02421 PERFORM S3011-SCAN-MFAS THRU S3011-EXIT DTSCS61 02422 UNTIL L810-NO-REC-88. DTSCS61 02423 S3010-EXIT. DTSCS61 02424 EXIT. DTSCS61 02425 SKIP3 DTSCS61 02426 S3011-SCAN-MFAS. DTSCS61 02427 MOVE MSKL-REC TO MFAS-REC. DTSCS61 02428 IF MFAS-STATUS-ACTIVE-88 OR MFAS-STATUS-HELD-88 DTSCS61 02429 MOVE MSG-E611-AREA TO WRK-MSG-AREA DTSCS61 02430 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS61 02431 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS61 02432 SET L810-NO-REC-88 TO TRUE DTSCS61 02433 GO TO S3011-EXIT. DTSCS61 02434 SKIP1 DTSCS61 02435 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS61 02436 S3011-EXIT. DTSCS61 02437 EXIT. DTSCS61 02438 /*****************************************************************DTSCS61 02439 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCS61 02440 ******************************************************************DTSCS61 02441 S5100-SET-LOCK-ATTRB. DTSCS61 02442 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS61 02443 WRK-ATB-NUM. DTSCS61 02444 DTSCS61 02445 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS61 02446 DTSCS61 02447 MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-NO-1-A DTSCS61 02448 MAP-EMP-NO-2-A DTSCS61 02449 MAP-GOTO-A. DTSCS61 02450 S5100-EXIT. DTSCS61 02451 EXIT. DTSCS61 02452 DTSCS61 02453 ******************************************************************DTSCS61 02454 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS61 02455 ******************************************************************DTSCS61 02456 S5200-SET-UPDATE-ATTRB. DTSCS61 02457 MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN. DTSCS61 02458 MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM. DTSCS61 02459 DTSCS61 02460 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS61 02461 DTSCS61 02462 S5200-EXIT. DTSCS61 02463 EXIT. DTSCS61 02464 DTSCS61 02465 ******************************************************************DTSCS61 02466 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS61 02467 ******************************************************************DTSCS61 02468 S5300-SET-INQ-ATTRB. DTSCS61 02469 MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN DTSCS61 02470 WRK-ATB-NUM. DTSCS61 02471 DTSCS61 02472 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS61 02473 S5300-EXIT. DTSCS61 02474 EXIT. DTSCS61 02475 DTSCS61 02476 S5900-SET-ATTRB. DTSCS61 02477 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS61 02478 MAP-EMP-NO-2-A. DTSCS61 02479 DTSCS61 02480 MOVE WRK-ATB-AN TO DTSCS61 02481 MAP-SOURCE-OP-ID-A DTSCS61 02482 MAP-TAX-EXTRACT-A DTSCS61 02483 MAP-WAGE-EXTRACT-A DTSCS61 02484 MAP-CLAIMANT-NAME-A DTSCS61 02485 MAP-ADD-OPEN-IND-A DTSCS61 02486 MAP-FLD-REP-ID-A DTSCS61 02487 MAP-ATTACHMENTS-IND-A DTSCS61 02488 MAP-EMP-SIZE-IND-A. DTSCS61 02489 DTSCS61 02490 PERFORM VARYING WRK-CTR FROM 1 BY 1 DTSCS61 02491 UNTIL WRK-CTR > MMAX-FAS-SEL-MAX DTSCS61 02492 MOVE WRK-ATB-AN TO DTSCS61 02493 MAP-AUDIT-SEL-REASON-A(WRK-CTR) DTSCS61 02494 END-PERFORM. DTSCS61 02495 DTSCS61 02496 PERFORM VARYING WRK-CTR FROM 1 BY 1 DTSCS61 02497 UNTIL WRK-CTR > MMAX-FAS-TEXT-MAX DTSCS61 02498 MOVE WRK-ATB-AN TO DTSCS61 02499 MAP-TEXT-A (WRK-CTR) DTSCS61 02500 END-PERFORM. DTSCS61 02501 DTSCS61 02502 MOVE WRK-ATB-NUM TO DTSCS61 02503 MAP-ASSIGN-TYPE-A DTSCS61 02504 MAP-DUE-DATE-MO-A DTSCS61 02505 MAP-DUE-DATE-DA-A DTSCS61 02506 MAP-DUE-DATE-YR-A DTSCS61 02507 MAP-CLAIMANT-SSN-1-A DTSCS61 02508 MAP-CLAIMANT-SSN-2-A DTSCS61 02509 MAP-CLAIMANT-SSN-3-A DTSCS61 02510 MAP-RELATED-EMP-NO-1-A DTSCS61 02511 MAP-RELATED-EMP-NO-2-A DTSCS61 02512 MAP-AUDIT-END-Q-A DTSCS61 02513 MAP-AUDIT-END-YR-A DTSCS61 02514 MAP-AUDIT-START-Q-A DTSCS61 02515 MAP-AUDIT-START-YR-A DTSCS61 02516 MAP-START-DATE-DA-A DTSCS61 02517 MAP-START-DATE-MO-A DTSCS61 02518 MAP-START-DATE-YR-A. DTSCS61 02519 DTSCS61 02520 MOVE CATB-ASKIP-BRT-MDTON TO MAP-SIC-CD-A DTSCS61 02521 MAP-NAICS-CD-A DTSCS61 02522 MAP-OWN-CD-A. DTSCS61 02523 DTSCS61 02524 MOVE CATB-ASKIP-BRT-MDTON TO MAP-PRIMARY-NAME-A. DTSCS61 02525 DTSCS61 02526 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS61 02527 S5900-EXIT. DTSCS61 02528 EXIT. DTSCS61 02529 EJECT DTSCS61 02530 /*****************************************************************DTSCS61 02531 * MAP ROUTINES *DTSCS61 02532 ******************************************************************DTSCS61 02533 S9100-RECEIVE. DTSCS61 02534 SET L851-RECEIVE-88 TO TRUE. DTSCS61 02535 DTSCS61 02536 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS61 02537 DTSCS61 02538 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS61 02539 DTSCS61 02540 MOVE L851-AID TO LCCM-AID. DTSCS61 02541 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS61 02542 S9100-EXIT. DTSCS61 02543 EXIT. DTSCS61 02544 DTSCS61 02545 S9200-SEND-DATAONLY. DTSCS61 02546 MOVE LOW-VALUES TO MAP-AREA. DTSCS61 02547 DTSCS61 02548 IF LCCM-NO-MSG DTSCS61 02549 NEXT SENTENCE DTSCS61 02550 ELSE DTSCS61 02551 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS61 02552 DTSCS61 02553 IF CURSOR-SET-GOTO DTSCS61 02554 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS61 02555 ELSE DTSCS61 02556 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS61 02557 DTSCS61 02558 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS61 02559 DTSCS61 02560 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS61 02561 DTSCS61 02562 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS61 02563 S9200-EXIT. DTSCS61 02564 EXIT. DTSCS61 02565 DTSCS61 02566 S9300-SEND-MAP. DTSCS61 02567 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS61 02568 MOVE SPACES TO MAP-SYS-TIME. DTSCS61 02569 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS61 02570 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS61 02571 DTSCS61 02572 IF SCR-ACCESS-UPDATE DTSCS61 02573 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS61 02574 ELSE DTSCS61 02575 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS61 02576 DTSCS61 02577 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCS61 02578 DTSCS61 02579 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS61 02580 DTSCS61 02581 IF CURSOR-SET-NO DTSCS61 02582 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS61 02583 DTSCS61 02584 SET L851-SEND-88 TO TRUE. DTSCS61 02585 DTSCS61 02586 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS61 02587 DTSCS61 02588 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS61 02589 S9300-EXIT. DTSCS61 02590 EXIT. DTSCS61 02591 DTSCS61 02592 S9310-UPDATE-FKEYS. DTSCS61 02593 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS61 02594 DTSCS61 02595 DTSCS61 02596 IF LCCM-SCR-CLEAR DTSCS61 02597 MOVE CFKD-ADD TO MAP-KEY-ADD DTSCS61 02598 ELSE DTSCS61 02599 IF LCCM-SCR-UPDATE-LOCKED DTSCS61 02600 MOVE LOW-VALUES TO MAP-KEY-ADD. DTSCS61 02601 S9310-EXIT. DTSCS61 02602 EXIT. DTSCS61 02603 DTSCS61 02604 S9320-INQUIRY-FKEYS. DTSCS61 02605 MOVE LOW-VALUES TO MAP-KEY-ADD. DTSCS61 02606 DTSCS61 02607 * PERFORM S9321-JUMP-KEYS THRU S9321-EXIT. DTSCS61 02608 S9320-EXIT. DTSCS61 02609 EXIT. DTSCS61 02610 DTSCS61 02611 *S9321-JUMP-KEYS. DTSCS61 02612 * MOVE CFKD-REG-INQ TO MAP-KEY-REG-INQ. DTSCS61 02613 *S9321-EXIT. DTSCS61 02614 * EXIT. DTSCS61 02615 * DTSCS61 02616 S9330-DSCR-FIELDS. DTSCS61 02617 S9330-EXIT. EXIT. DTSCS61 02618 DTSCS61 02619 S9900-PREPARE-SEND. DTSCS61 02620 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS61 02621 LCCM-SCR-ID. DTSCS61 02622 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS61 02623 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS61 02624 S9900-EXIT. DTSCS61 02625 EXIT. DTSCS61