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