00001 IDENTIFICATION DIVISION. 02/07/12 00002 PROGRAM-ID. DTSCS64. DTSCS64 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV008 00004 DATE-WRITTEN. MAY 1994. DTSCS64 00005 DATE-COMPILED. DTSCS64 00006 SKIP3 DTSCS64 00007 ***** DTSCS64 00008 * DTSCS64 00009 * FUNCTION: QUARTERLY AUDIT RESULTS INQUIRY/UPDATE DTSCS64 00010 * SCREEN PROCESSOR. DTSCS64 00011 * DTSCS64 00012 * DTSCS64 00013 * MODIFICATION LOG: DTSCS64 00014 * DTSCS64 00015 * 11/16/98 INITIAL DEVLOPMENT. COPIED FROM MACCS65 DTSCS64 00016 * REFERENCE RFP: PROGRAMMER: ZL1 DTSCS64 00017 * DTSCS64 00018 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS64 00019 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS64 00020 * WORK ORDER: PROGRAMMER: XXX DTSCS64 00021 * DTSCS64 00022 * DTSCS64 00023 * DESCRIPTION: DTSCS64 00024 * DTSCS64 00025 * CLEAR: DTSCS64 00026 * DTSCS64 00027 * FIELD DISPLAYED: MAP-ASSIGN-NO (FROM LCCM-ASSIGN-NO). DTSCS64 00028 * DTSCS64 00029 * DTSCS64 00030 * JUMP: DTSCS64 00031 * DTSCS64 00032 * F17 REGISTRATION INQUIRY (11). DTSCS64 00033 * F21 FIELD ASSIGNMENT INQUIRY/UPDATE (62). DTSCS64 00034 * F22 AUDIT RESULTS INQUIRY/UPDATE (63). DTSCS64 00035 * DTSCS64 00036 * DTSCS64 00037 * INQUIRY: DTSCS64 00038 * DTSCS64 00039 * CONTROL FIELD(S): MAP-ASSIGN-NO. DTSCS64 00040 * DTSCS64 00041 * JUMP IN: IF LCCM-ASSIGN-NO = LCCM-SCR64-HOLD-AREA DTSCS64 00042 * ASSIGN-NO DTSCS64 00043 * DISPLAY RECORD INDICATED BY DTSCS64 00044 * LCCM-SCR64-HOLD-AREA DTSCS64 00045 * ELSE DTSCS64 00046 * DISPLAY LAST PAGE OF DATA ASSOCIATED DTSCS64 00047 * WITH LCCM-ASSIGN-NO. DTSCS64 00048 * DTSCS64 00049 * ENTER, F05, F06, F07, F08: STANDARD PAGING. DTSCS64 00050 * DTSCS64 00051 * DISPLAY SEQUENCE: ASCENDING ON DTSCS64 00052 * MAUY-CALENDAR-YEAR. DTSCS64 00053 * DTSCS64 00054 * PAGE INITIALLY DISPLAYED: LAST. DTSCS64 00055 * DTSCS64 00056 * JUMP OUT: NO SPECIAL PROCESSING. DTSCS64 00057 * DTSCS64 00058 * NOTE. IF MFAS-NON-AUDIT-88, THEN RATHER THEN DISPLAYING DTSCS64 00059 * THE MAUY RECORD, DISPLAY AN ERROR MESSAGE. DTSCS64 00060 * DTSCS64 00061 * DTSCS64 00062 * LCCM DATA ELEMENT MAINTENANCE: DTSCS64 00063 * DTSCS64 00064 * STANDARD LCCM-ASSIGN-NO MAINTENANCE. DTSCS64 00065 * DTSCS64 00066 * MAINTAIN LCCM-EMP-NO IN SYNC WITH LCCM-ASSIGN-NO. DTSCS64 00067 * DTSCS64 00068 * STORE PAGING CONTROL INFORMATION IN LCCM-SCR-HOLD-AREA. DTSCS64 00069 * DTSCS64 00070 * DTSCS64 00071 * UPDATE: DTSCS64 00072 * DTSCS64 00073 * ADD DTSCS64 00074 * MOD DTSCS64 00075 * DEL DTSCS64 00076 * DTSCS64 00077 * DTSCS64 00078 * RECORDS READ: DTSCS64 00079 * DTSCS64 00080 * MASTER: DTSCS64 00081 * DTSCS64 00082 * MPRF DTSCS64 00083 * MFAS DTSCS64 00084 * MAUR DTSCS64 00085 * MAUY DTSCS64 00086 * DTSCS64 00087 * DTSCS64 00088 * ALTERNATE INDEX: DTSCS64 00089 * DTSCS64 00090 * IFAN. DTSCS64 00091 * DTSCS64 00092 * DTSCS64 00093 * REFERENCE: DTSCS64 00094 * DTSCS64 00095 * NONE. DTSCS64 00096 * DTSCS64 00097 * DTSCS64 00098 * ACCOUNTING TRANSACTION COLLECTION: DTSCS64 00099 * DTSCS64 00100 * NONE. DTSCS64 00101 * DTSCS64 00102 * DTSCS64 00103 * RECORDS UPDATED: DTSCS64 00104 * DTSCS64 00105 * MASTER: DTSCS64 00106 * DTSCS64 00107 * MAUY (ADD, REWRITE, DELETE) DTSCS64 00108 * DTSCS64 00109 * DTSCS64 00110 * REFERENCE: DTSCS64 00111 * DTSCS64 00112 * NONE. DTSCS64 00113 * DTSCS64 00114 * DTSCS64 00115 * ACCOUNTING TRANSACTION COLLECTION: DTSCS64 00116 * DTSCS64 00117 * NONE. DTSCS64 00118 * DTSCS64 00119 * DTSCS64 00120 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCS64 00121 * DTSCS64 00122 * NONE. DTSCS64 00123 * DTSCS64 00124 * DTSCS64 00125 * TEMPORARY STORAGE USAGE: DTSCS64 00126 * DTSCS64 00127 * NONE DTSCS64 00128 * DTSCS64 00129 * DTSCS64 00130 * MODULES LINKED TO: DTSCS64 00131 * DTSCS64 00132 * DTSCS64 00133 * DTSCU001 DATE EDIT/CONVERSION. DTSCS64 00134 * DTSCU007 CALENDAR YEAR EDIT/CONVERSION. DTSCS64 00135 * DTSCU011 MONEY AMOUNT FROM SCREEN FORMAT/EDIT. DTSCS64 00136 * DTSCU022 FIELD ASSIGNMENT NUMBER FROM SCREEN FORMAT/EDIT. DTSCS64 00137 * DTSCU221 MPRF-UPDATE DATA ELEMENT MAINTENANCE. DTSCS64 00138 * DTSCU810 MASTER FILE INPUT/OUTPUT. DTSCS64 00139 * DTSCU821 ALTERNATE INDEX FILE INPUT/OUTPUT. DTSCS64 00140 * DTSCS64 00141 * DTSCS64 00142 ***** DTSCS64 00143 DTSCS64 00144 ENVIRONMENT DIVISION. DTSCS64 00145 DTSCS64 00146 DATA DIVISION. DTSCS64 00147 DTSCS64 00148 WORKING-STORAGE SECTION. DTSCS64 001485 77 PAN-VALET PICTURE X(24) VALUE '008DTSCS64 02/07/12'. DTSCS64 00149 DTSCS64 00150 01 WRK-AREA. DTSCS64 00151 05 WRK-ABEND-CD PIC X(04) VALUE 'S64 '. DTSCS64 00152 DTSCS64 00153 05 WRK-SCR-ID. DTSCS64 00154 10 WRK-SCR-ID-N PIC 9(02) VALUE 64. DTSCS64 00155 DTSCS64 00156 05 WRK-F03-SCR-ID PIC X(02) VALUE '60'. DTSCS64 00157 DTSCS64 00158 05 SCR-ACCESS-IND PIC X(01). DTSCS64 00159 88 SCR-ACCESS-INQ VALUE '1'. DTSCS64 00160 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS64 00161 DTSCS64 00162 05 CURSOR-SET-IND PIC X(01). DTSCS64 00163 88 CURSOR-SET-YES VALUE 'Y'. DTSCS64 00164 88 CURSOR-SET-NO VALUE 'N'. DTSCS64 00165 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS64 00166 DTSCS64 00167 05 REQ-IND PIC X(01). DTSCS64 00168 88 REQ-ERROR VALUE 'O'. DTSCS64 00169 88 REQ-JUMP VALUE 'J'. DTSCS64 00170 88 REQ-INQUIRE VALUE 'I'. DTSCS64 00171 88 REQ-CLEAR VALUE 'C'. DTSCS64 00172 88 REQ-EDIT VALUE 'E'. DTSCS64 00173 88 REQ-UPDATE VALUE 'U'. DTSCS64 00174 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS64 00175 DTSCS64 00176 05 RESP-IND PIC X(01). DTSCS64 00177 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS64 00178 88 RESP-SEND-MAP VALUE 'M'. DTSCS64 00179 88 RESP-JUMP VALUE 'J'. DTSCS64 00180 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS64 00181 DTSCS64 00182 05 WRK-MSG-AREA PIC X(64). DTSCS64 00183 DTSCS64 00184 05 WRK-ATB-AN PIC X(01). DTSCS64 00185 05 WRK-ATB-NUM PIC X(01). DTSCS64 00186 DTSCS64 00187 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSCS64 00188 05 WRK-ASSIGN-NO PIC S9(09) COMP-3. DTSCS64 00189 DTSCS64 00190 05 WRK-MPRF-IND PIC X(01). DTSCS64 00191 88 WRK-MPRF-YES-88 VALUE 'Y'. DTSCS64 00192 88 WRK-MPRF-NO-88 VALUE 'N'. DTSCS64 00193 DTSCS64 00194 05 WRK-YRQ-1 PIC 9(05). DTSCS64 00195 05 FILLER REDEFINES WRK-YRQ-1. DTSCS64 00196 15 WRK-QTR-1-YR PIC 9(04). DTSCS64 00197 15 WRK-QTR-1-Q PIC 9(01). DTSCS64 00198 DTSCS64 00199 05 WRK-YRQ-2 PIC 9(05). DTSCS64 00200 05 FILLER REDEFINES WRK-YRQ-2. DTSCS64 00201 15 WRK-QTR-2-YR PIC 9(04). DTSCS64 00202 15 WRK-QTR-2-Q PIC 9(01). DTSCS64 00203 DTSCS64 00204 05 WRK-CALENDAR-YEAR PIC 9(04). DTSCS64 00205 DTSCS64 00206 05 WRK-DISPLAY PIC 9(11). DTSCS64 00207 DTSCS64 00208 05 FILLER REDEFINES WRK-DISPLAY. DTSCS64 00209 10 FILLER PIC X(04). DTSCS64 00210 10 WRK-DISPLAY-ASSIGN-NO-1 PIC X(02). DTSCS64 00211 10 WRK-DISPLAY-ASSIGN-NO-2 PIC X(05). DTSCS64 00212 DTSCS64 00213 05 FILLER REDEFINES WRK-DISPLAY. DTSCS64 00214 10 FILLER PIC X(05). DTSCS64 00215 10 WRK-DISPLAY-EMP-NO-1 PIC X(03). DTSCS64 00216 10 WRK-DISPLAY-EMP-NO-2 PIC X(03). DTSCS64 00217 DTSCS64 00218 05 FILLER REDEFINES WRK-DISPLAY. DTSCS64 00219 10 FILLER PIC 9(05). DTSCS64 00220 10 WRK-DISPLAY-YR PIC 9(02). DTSCS64 00221 10 WRK-DISPLAY-MO PIC 9(02). DTSCS64 00222 10 WRK-DISPLAY-DA PIC 9(02). DTSCS64 00223 10 WRK-DISPLAY-CAL-YR REDEFINES WRK-DISPLAY-DA DTSCS64 00224 PIC 9(02). DTSCS64 00225 DTSCS64 00226 05 INQUIRY-CONTROL-AREA. DTSCS64 00227 10 LAST-REC-NUM PIC S9(08) COMP. DTSCS64 00228 10 WS-REC-NUM PIC S9(08) COMP. DTSCS64 00229 DTSCS64 00230 10 LAST-REC-KEY-AREA PIC X(16). DTSCS64 00231 10 SCR-REC-KEY-AREA PIC X(16). DTSCS64 00232 DTSCS64 00233 10 WS-REC-FOUND-IND PIC X(01). DTSCS64 00234 10 WRK-OCC PIC S9(04) COMP. DTSCS64 00235 EJECT DTSCS64 00236 * SCREEN SPECIFIC ERROR MESSAGES DTSCS64 00237 DTSCS64 00238 01 MSG-LITERALS. DTSCS64 00239 DTSCS64 00240 05 MSG-E641-AREA. DTSCS64 00241 10 FILLER PIC X(04) VALUE 'E641'. DTSCS64 00242 10 FILLER PIC X(30) DTSCS64 00243 VALUE 'QUARTER OUTSIDE OF PERIOD AUDI'. DTSCS64 00244 10 FILLER PIC X(30) DTSCS64 00245 VALUE 'TED '. DTSCS64 00246 DTSCS64 00247 05 MSG-E642-AREA. DTSCS64 00248 10 FILLER PIC X(04) VALUE 'E642'. DTSCS64 00249 10 FILLER PIC X(30) DTSCS64 00250 VALUE 'PROCESSED DATE DOES NOT EXIST.'. DTSCS64 00251 10 FILLER PIC X(30) DTSCS64 00252 VALUE ' '. DTSCS64 00253 DTSCS64 00254 05 MSG-E643-AREA. DTSCS64 00255 10 FILLER PIC X(04) VALUE 'E643'. DTSCS64 00256 10 FILLER PIC X(30) DTSCS64 00257 VALUE 'NON AUDIT ASSIGNMENT '. DTSCS64 00258 10 FILLER PIC X(30) DTSCS64 00259 VALUE ' '. DTSCS64 00260 DTSCS64 00261 05 MSG-E644-AREA. DTSCS64 00262 10 FILLER PIC X(04) VALUE 'E644'. DTSCS64 00263 10 FILLER PIC X(30) DTSCS64 00264 VALUE 'MAXIMUM OF 6 YEARS EXIST FOR T'. DTSCS64 00265 10 FILLER PIC X(30) DTSCS64 00266 VALUE 'HIS ASSIGNMENT. ADD NOT VALID.'. DTSCS64 00267 DTSCS64 00268 05 MSG-E645-AREA. DTSCS64 00269 10 FILLER PIC X(04) VALUE 'E645'. DTSCS64 00270 10 MSG-EMP-NO-IN-ERR PIC 999B999. DTSCS64 00271 10 MSG-E645-MSG PIC X(50) VALUE DTSCS64 00272 ' ALTERNATE INDEX FILE ERROR - CONTACT DP'. DTSCS64 00273 EJECT DTSCS64 00274 01 L001-COMM-AREA. DTSCS64 00275 ++INCLUDE DTSIL001 DTSCS64 00276 EJECT DTSCS64 00277 01 L007-COMM-AREA. DTSCS64 00278 ++INCLUDE DTSIL007 DTSCS64 00279 EJECT DTSCS64 00280 01 L011-COMM-AREA. DTSCS64 00281 ++INCLUDE DTSIL011 DTSCS64 00282 EJECT DTSCS64 00283 01 L022-COMM-AREA. DTSCS64 00284 ++INCLUDE DTSIL022 DTSCS64 00285 EJECT DTSCS64 00286 01 L221-COMM-AREA. DTSCS64 00287 ++INCLUDE DTSIL221 DTSCS64 00288 EJECT DTSCS64 00289 01 L805-COMM-AREA. DTSCS64 00290 ++INCLUDE DTSIL805 DTSCS64 00291 EJECT DTSCS64 00292 01 L810-COMM-AREA. DTSCS64 00293 05 L810-CONTROL-BLOCK. DTSCS64 00294 ++INCLUDE DTSIL810 DTSCS64 00295 EJECT DTSCS64 00296 05 MSKL-REC. DTSCS64 00297 ++INCLUDE DTSIMSKL DTSCS64 00298 EJECT DTSCS64 00299 * DTSCS64 00300 01 MPRF-REC. DTSCS64 00301 ++INCLUDE DTSIMPRF DTSCS64 00302 EJECT DTSCS64 00303 01 MFAS-REC. DTSCS64 00304 ++INCLUDE DTSIMFAS DTSCS64 00305 EJECT DTSCS64 00306 01 MAUR-REC. DTSCS64 00307 ++INCLUDE DTSIMAUR DTSCS64 00308 EJECT DTSCS64 00309 01 MAUY-REC. DTSCS64 00310 ++INCLUDE DTSIMAUY DTSCS64 00311 EJECT DTSCS64 00312 01 L851-COMM-AREA. DTSCS64 00313 ++INCLUDE DTSIL851 DTSCS64 00314 DTSCS64 00315 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS64 00316 ++INCLUDE DTSIS64 DTSCS64 00317 EJECT DTSCS64 00318 01 L821-COMM-AREA. DTSCS64 00319 05 L821-CONTROL-BLOCK. DTSCS64 00320 ++INCLUDE DTSIL821 DTSCS64 00321 DTSCS64 00322 05 ISKL-REC. DTSCS64 00323 ++INCLUDE DTSIISKL DTSCS64 00324 05 FILLER REDEFINES ISKL-REC. DTSCS64 00325 ++INCLUDE DTSIIFAN DTSCS64 00326 EJECT DTSCS64 00327 01 CATB-LITERALS. DTSCS64 00328 ++INCLUDE DTSICATB DTSCS64 00329 DTSCS64 00330 01 CFKD-LITERALS. DTSCS64 00331 ++INCLUDE DTSICFKD DTSCS64 00332 DTSCS64 00333 01 CECD-LITERALS. DTSCS64 00334 ++INCLUDE DTSICECD DTSCS64 00335 DTSCS64 00336 01 CPCD-LITERALS. DTSCS64 00337 ++INCLUDE DTSICPCD DTSCS64 00338 DTSCS64 00339 01 MMAX-LITERALS. DTSCS64 00340 ++INCLUDE DTSIMMAX DTSCS64 00341 EJECT DTSCS64 00342 LINKAGE SECTION. DTSCS64 00343 DTSCS64 00344 01 DFHCOMMAREA. DTSCS64 00345 ++INCLUDE DTSILCCM DTSCS64 00346 EJECT DTSCS64 00347 ******************************************************************DTSCS64 00348 * *DTSCS64 00349 ******************************************************************DTSCS64 00350 DTSCS64 00351 PROCEDURE DIVISION. DTSCS64 00352 DTSCS64 00353 MOVE +0 TO WRK-EMP-NO. DTSCS64 00354 SET WRK-MPRF-NO-88 TO TRUE. DTSCS64 00355 DTSCS64 00356 MOVE +0 TO WRK-ASSIGN-NO. DTSCS64 00357 DTSCS64 00358 MOVE LOW-VALUES TO MAP-AREA. DTSCS64 00359 DTSCS64 00360 SET CURSOR-SET-NO TO TRUE. DTSCS64 00361 DTSCS64 00362 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N) DTSCS64 00363 TO SCR-ACCESS-IND. DTSCS64 00364 DTSCS64 00365 MOVE SPACE TO REQ-IND. DTSCS64 00366 DTSCS64 00367 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS64 00368 DTSCS64 00369 *----------------------------------------------------- DTSCS64 00370 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS64 00371 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS64 00372 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS64 00373 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS64 00374 * DTSCS64 00375 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS64 00376 * PROCESSED. DTSCS64 00377 * DTSCS64 00378 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS64 00379 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS64 00380 * WORK STATION OPERATOR. DTSCS64 00381 *----------------------------------------------------- DTSCS64 00382 DTSCS64 00383 MOVE SPACE TO RESP-IND. DTSCS64 00384 DTSCS64 00385 IF REQ-ERROR DTSCS64 00386 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS64 00387 ELSE DTSCS64 00388 IF REQ-JUMP DTSCS64 00389 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS64 00390 ELSE DTSCS64 00391 IF REQ-CLEAR DTSCS64 00392 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS64 00393 ELSE DTSCS64 00394 IF REQ-CURSOR-TO-GOTO DTSCS64 00395 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS64 00396 ELSE DTSCS64 00397 IF REQ-INQUIRE DTSCS64 00398 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS64 00399 ELSE DTSCS64 00400 IF REQ-EDIT DTSCS64 00401 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS64 00402 ELSE DTSCS64 00403 IF REQ-UPDATE DTSCS64 00404 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS64 00405 ELSE DTSCS64 00406 GO TO S899-ABEND. DTSCS64 00407 DTSCS64 00408 *----------------------------------------------------- DTSCS64 00409 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS64 00410 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS64 00411 *----------------------------------------------------- DTSCS64 00412 DTSCS64 00413 IF RESP-SEND-MAP DTSCS64 00414 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS64 00415 SET LCCM-END-TASK-88 TO TRUE DTSCS64 00416 ELSE DTSCS64 00417 IF RESP-SEND-MSGONLY DTSCS64 00418 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS64 00419 SET LCCM-END-TASK-88 TO TRUE DTSCS64 00420 ELSE DTSCS64 00421 IF RESP-JUMP DTSCS64 00422 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS64 00423 ELSE DTSCS64 00424 IF RESP-CURSOR-TO-GOTO DTSCS64 00425 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS64 00426 SET LCCM-END-TASK-88 TO TRUE DTSCS64 00427 ELSE DTSCS64 00428 GO TO S899-ABEND. DTSCS64 00429 DTSCS64 00430 MAINLINE-EXIT. DTSCS64 00431 DTSCS64 00432 EXEC CICS DTSCS64 00433 RETURN DTSCS64 00434 END-EXEC. DTSCS64 00435 DTSCS64 00436 GOBACK. DTSCS64 00437 EJECT DTSCS64 00438 /*****************************************************************DTSCS64 00439 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS64 00440 ******************************************************************DTSCS64 00441 P1000-ANALYZE-REQUEST. DTSCS64 00442 DTSCS64 00443 *----------------------------------------------------- DTSCS64 00444 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS64 00445 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS64 00446 * REPLACED WITH ENTER) DTSCS64 00447 *----------------------------------------------------- DTSCS64 00448 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS64 00449 SET LCCM-ENTER-88 TO TRUE DTSCS64 00450 IF LCCM-ASSIGN-NO > ZERO DTSCS64 00451 SET REQ-INQUIRE TO TRUE DTSCS64 00452 MOVE LCCM-ASSIGN-NO TO WRK-DISPLAY DTSCS64 00453 MOVE WRK-DISPLAY-ASSIGN-NO-1 TO MAP-ASSIGN-NO-1 DTSCS64 00454 MOVE WRK-DISPLAY-ASSIGN-NO-2 TO MAP-ASSIGN-NO-2 DTSCS64 00455 ELSE DTSCS64 00456 SET REQ-INQUIRE TO TRUE DTSCS64 00457 END-IF DTSCS64 00458 GO TO P1000-EXIT. DTSCS64 00459 DTSCS64 00460 *----------------------------------------------------- DTSCS64 00461 * MAP IS RECEIVED DTSCS64 00462 *----------------------------------------------------- DTSCS64 00463 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS64 00464 DTSCS64 00465 *----------------------------------------------------- DTSCS64 00466 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS64 00467 * WORK STATION DTSCS64 00468 *----------------------------------------------------- DTSCS64 00469 IF LCCM-CLEAR-88 DTSCS64 00470 SET REQ-CLEAR TO TRUE DTSCS64 00471 GO TO P1000-EXIT. DTSCS64 00472 DTSCS64 00473 *----------------------------------------------------- DTSCS64 00474 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS64 00475 *----------------------------------------------------- DTSCS64 00476 IF LCCM-SCR-UPDATE-LOCKED DTSCS64 00477 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS64 00478 GO TO P1000-EXIT. DTSCS64 00479 DTSCS64 00480 *----------------------------------------------------- DTSCS64 00481 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS64 00482 *----------------------------------------------------- DTSCS64 00483 IF LCCM-PA2-88 DTSCS64 00484 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS64 00485 GO TO P1000-EXIT. DTSCS64 00486 DTSCS64 00487 *----------------------------------------------------- DTSCS64 00488 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS64 00489 *----------------------------------------------------- DTSCS64 00490 IF LCCM-PA-88 DTSCS64 00491 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS64 00492 SET REQ-ERROR TO TRUE DTSCS64 00493 GO TO P1000-EXIT. DTSCS64 00494 DTSCS64 00495 *----------------------------------------------------- DTSCS64 00496 * IF F12 IS PRESSED AND UPDATE NOT IN PROGRESS THEN DTSCS64 00497 * CLEAR SCREEN DTSCS64 00498 *----------------------------------------------------- DTSCS64 00499 IF LCCM-F12-88 DTSCS64 00500 MOVE LOW-VALUES TO MAP-AREA DTSCS64 00501 SET REQ-CLEAR TO TRUE DTSCS64 00502 GO TO P1000-EXIT. DTSCS64 00503 DTSCS64 00504 *----------------------------------------------------- DTSCS64 00505 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS64 00506 *----------------------------------------------------- DTSCS64 00507 IF LCCM-F03-88 DTSCS64 00508 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS64 00509 SET REQ-JUMP TO TRUE DTSCS64 00510 GO TO P1000-EXIT. DTSCS64 00511 DTSCS64 00512 *----------------------------------------------------- DTSCS64 00513 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS64 00514 *----------------------------------------------------- DTSCS64 00515 IF LCCM-F04-88 DTSCS64 00516 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS64 00517 SET REQ-JUMP TO TRUE DTSCS64 00518 GO TO P1000-EXIT. DTSCS64 00519 DTSCS64 00520 *--------------------------------------------------------- DTSCS64 00521 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS64 00522 * CORRESPONDENCE SCREEN. DTSCS64 00523 *--------------------------------------------------------- DTSCS64 00524 DTSCS64 00525 IF LCCM-F14-88 DTSCS64 00526 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS64 00527 SET REQ-JUMP TO TRUE DTSCS64 00528 GO TO P1000-EXIT. DTSCS64 00529 DTSCS64 00530 *----------------------------------------------------- DTSCS64 00531 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS64 00532 * REQUESTED SCREEN TYPE DTSCS64 00533 *----------------------------------------------------- DTSCS64 00534 * IF LCCM-F17-88 DTSCS64 00535 * MOVE '11' TO LCCM-REQ-SCR-ID DTSCS64 00536 * SET REQ-JUMP TO TRUE DTSCS64 00537 * GO TO P1000-EXIT. DTSCS64 00538 * DTSCS64 00539 * IF LCCM-F21-88 DTSCS64 00540 * MOVE '62' TO LCCM-REQ-SCR-ID DTSCS64 00541 * SET REQ-JUMP TO TRUE DTSCS64 00542 * GO TO P1000-EXIT. DTSCS64 00543 * DTSCS64 00544 * IF LCCM-F22-88 DTSCS64 00545 * MOVE '63' TO LCCM-REQ-SCR-ID DTSCS64 00546 * SET REQ-JUMP TO TRUE DTSCS64 00547 * GO TO P1000-EXIT. DTSCS64 00548 * DTSCS64 00549 *----------------------------------------------------- DTSCS64 00550 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS64 00551 * REQUESTED SCREEN TYPE DTSCS64 00552 *----------------------------------------------------- DTSCS64 00553 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS64 00554 NEXT SENTENCE DTSCS64 00555 ELSE DTSCS64 00556 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS64 00557 SET REQ-JUMP TO TRUE DTSCS64 00558 GO TO P1000-EXIT. DTSCS64 00559 DTSCS64 00560 *----------------------------------------------------- DTSCS64 00561 * IF REQUEST TO UPDATE THE DATA (ADD,MOD,DEL) DTSCS64 00562 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS64 00563 *----------------------------------------------------- DTSCS64 00564 IF LCCM-F09-88 DTSCS64 00565 OR LCCM-F10-88 DTSCS64 00566 OR LCCM-F23-88 DTSCS64 00567 IF SCR-ACCESS-UPDATE DTSCS64 00568 SET REQ-EDIT TO TRUE DTSCS64 00569 GO TO P1000-EXIT DTSCS64 00570 ELSE DTSCS64 00571 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS64 00572 SET REQ-ERROR TO TRUE DTSCS64 00573 GO TO P1000-EXIT. DTSCS64 00574 DTSCS64 00575 *----------------------------------------------------- DTSCS64 00576 * IF INQUIRY TYPE KEY PRESSED (ENTER, F5, F6, F7, DTSCS64 00577 * OR F8), INDICATE INQUIRY REQUEST DTSCS64 00578 *----------------------------------------------------- DTSCS64 00579 IF LCCM-INQUIRY-88 DTSCS64 00580 SET REQ-INQUIRE TO TRUE DTSCS64 00581 GO TO P1000-EXIT. DTSCS64 00582 DTSCS64 00583 *----------------------------------------------------- DTSCS64 00584 * ANY OTHER KEY IS INVALID DTSCS64 00585 *----------------------------------------------------- DTSCS64 00586 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS64 00587 SET REQ-ERROR TO TRUE. DTSCS64 00588 P1000-EXIT. DTSCS64 00589 EXIT. DTSCS64 00590 DTSCS64 00591 ******************************************************************DTSCS64 00592 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS64 00593 ******************************************************************DTSCS64 00594 DTSCS64 00595 P1100-UPDATE-LOCKED. DTSCS64 00596 *----------------------------------------------------- DTSCS64 00597 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS64 00598 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCS64 00599 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS64 00600 *----------------------------------------------------- DTSCS64 00601 IF LCCM-ENTER-88 OR LCCM-F12-88 DTSCS64 00602 SET REQ-UPDATE TO TRUE DTSCS64 00603 ELSE DTSCS64 00604 SET REQ-ERROR TO TRUE DTSCS64 00605 IF LCCM-SCR-ADD-LOCKED DTSCS64 00606 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS64 00607 ELSE DTSCS64 00608 IF LCCM-SCR-MOD-LOCKED DTSCS64 00609 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS64 00610 ELSE DTSCS64 00611 IF LCCM-SCR-DEL-LOCKED DTSCS64 00612 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID DTSCS64 00613 ELSE DTSCS64 00614 GO TO S899-ABEND. DTSCS64 00615 P1100-EXIT. DTSCS64 00616 EXIT. DTSCS64 00617 /*****************************************************************DTSCS64 00618 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS64 00619 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS64 00620 ******************************************************************DTSCS64 00621 DTSCS64 00622 P2000-REQUEST-ERROR. DTSCS64 00623 IF LCCM-MSG DTSCS64 00624 SET RESP-SEND-MSGONLY TO TRUE DTSCS64 00625 ELSE DTSCS64 00626 GO TO S899-ABEND. DTSCS64 00627 P2000-EXIT. DTSCS64 00628 EXIT. DTSCS64 00629 /*****************************************************************DTSCS64 00630 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS64 00631 ******************************************************************DTSCS64 00632 DTSCS64 00633 P3000-REQUEST-JUMP. DTSCS64 00634 *----------------------------------------------------- DTSCS64 00635 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS64 00636 * BY USER DTSCS64 00637 *----------------------------------------------------- DTSCS64 00638 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS64 00639 DTSCS64 00640 *----------------------------------------------------- DTSCS64 00641 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS64 00642 *----------------------------------------------------- DTSCS64 00643 IF LCCM-MSG DTSCS64 00644 SET RESP-SEND-MSGONLY TO TRUE DTSCS64 00645 SET CURSOR-SET-GOTO TO TRUE DTSCS64 00646 GO TO P3000-EXIT. DTSCS64 00647 SKIP3 DTSCS64 00648 MOVE MAP-ASSIGN-NO-AREA TO L022-S-ASSIGN-NO-AREA. DTSCS64 00649 PERFORM S022-ASSIGN-NO-FROM-SCREEN THRU S022-EXIT. DTSCS64 00650 IF L022-VALID DTSCS64 00651 MOVE L022-ASSIGN-NO TO LCCM-ASSIGN-NO. DTSCS64 00652 DTSCS64 00653 *----------------------------------------------------- DTSCS64 00654 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS64 00655 *----------------------------------------------------- DTSCS64 00656 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS64 00657 LCCM-SCR-HOLD-AREA. DTSCS64 00658 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS64 00659 SET RESP-JUMP TO TRUE. DTSCS64 00660 P3000-EXIT. DTSCS64 00661 EXIT. DTSCS64 00662 /*****************************************************************DTSCS64 00663 * CLEAR KEY WAS PRESSED *DTSCS64 00664 ******************************************************************DTSCS64 00665 DTSCS64 00666 P4000-REQUEST-CLEAR. DTSCS64 00667 DTSCS64 00668 *----------------------------------------------------- DTSCS64 00669 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS64 00670 * FIELDS FROM EARLIER REQUESTS DTSCS64 00671 *----------------------------------------------------- DTSCS64 00672 IF LCCM-ASSIGN-NO > ZERO DTSCS64 00673 MOVE LCCM-ASSIGN-NO TO WRK-DISPLAY DTSCS64 00674 MOVE WRK-DISPLAY-ASSIGN-NO-1 TO MAP-ASSIGN-NO-1 DTSCS64 00675 MOVE WRK-DISPLAY-ASSIGN-NO-2 TO MAP-ASSIGN-NO-2. DTSCS64 00676 DTSCS64 00677 MOVE ZERO TO LCCM-ASSIGN-NO DTSCS64 00678 DTSCS64 00679 MOVE LOW-VALUES TO LCCM-SCR64-HOLD-AREA. DTSCS64 00680 DTSCS64 00681 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS64 00682 DTSCS64 00683 SET LCCM-SCR-CLEAR TO TRUE. DTSCS64 00684 DTSCS64 00685 IF SCR-ACCESS-UPDATE DTSCS64 00686 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS64 00687 ELSE DTSCS64 00688 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS64 00689 DTSCS64 00690 SET RESP-SEND-MAP TO TRUE. DTSCS64 00691 P4000-EXIT. DTSCS64 00692 EXIT. DTSCS64 00693 /*****************************************************************DTSCS64 00694 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS64 00695 ******************************************************************DTSCS64 00696 DTSCS64 00697 P5000-CURSOR-TO-GOTO. DTSCS64 00698 SET CURSOR-SET-GOTO TO TRUE. DTSCS64 00699 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS64 00700 P5000-EXIT. DTSCS64 00701 EXIT. DTSCS64 00702 /*****************************************************************DTSCS64 00703 * INQUIRY WAS REQUESTED *DTSCS64 00704 ******************************************************************DTSCS64 00705 DTSCS64 00706 P6000-REQUEST-INQUIRE. DTSCS64 00707 MOVE MAP-ASSIGN-NO-AREA TO L022-S-ASSIGN-NO-AREA. DTSCS64 00708 MOVE LOW-VALUES TO MAP-AREA. DTSCS64 00709 MOVE L022-S-ASSIGN-NO-AREA TO MAP-ASSIGN-NO-AREA. DTSCS64 00710 DTSCS64 00711 SET LCCM-SCR-CLEAR TO TRUE. DTSCS64 00712 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS64 00713 DTSCS64 00714 SET RESP-SEND-MAP TO TRUE. DTSCS64 00715 DTSCS64 00716 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS64 00717 DTSCS64 00718 MOVE LCCM-SCR64-HOLD-AREA TO SCR-REC-KEY-AREA. DTSCS64 00719 MOVE LOW-VALUES TO LCCM-SCR64-HOLD-AREA. DTSCS64 00720 DTSCS64 00721 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS64 00722 IF LCCM-MSG DTSCS64 00723 GO TO P6000-EXIT. DTSCS64 00724 DTSCS64 00725 PERFORM S1120-READ-IFAN THRU S1120-EXIT. DTSCS64 00726 IF LCCM-MSG DTSCS64 00727 GO TO P6000-EXIT. DTSCS64 00728 DTSCS64 00729 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS64 00730 DTSCS64 00731 PERFORM S1130-READ-MPRF THRU S1130-EXIT. DTSCS64 00732 DTSCS64 00733 MOVE WRK-ASSIGN-NO TO LCCM-ASSIGN-NO. DTSCS64 00734 DTSCS64 00735 PERFORM S1110-READ-MFAS THRU S1110-EXIT. DTSCS64 00736 DTSCS64 00737 IF LCCM-MSG DTSCS64 00738 GO TO P6000-EXIT. DTSCS64 00739 DTSCS64 00740 IF SCR-ACCESS-UPDATE DTSCS64 00741 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS64 00742 DTSCS64 00743 MOVE LOW-VALUES TO MAUY-KEY-AREA. DTSCS64 00744 MOVE WRK-EMP-NO TO MAUY-EMP-NO. DTSCS64 00745 SET MAUY-AUY-88 TO TRUE. DTSCS64 00746 MOVE WRK-ASSIGN-NO TO MAUY-ASSIGN-NO. DTSCS64 00747 MOVE MAUY-KEY-AREA TO MSKL-KEY-AREA. DTSCS64 00748 PERFORM S810-COUNT THRU S810-EXIT. DTSCS64 00749 DTSCS64 00750 MOVE L810-RECORD-CNT TO LAST-REC-NUM. DTSCS64 00751 IF L810-NO-REC-88 DTSCS64 00752 MOVE LOW-VALUE TO LAST-REC-KEY-AREA DTSCS64 00753 ELSE DTSCS64 00754 MOVE MSKL-KEY-AREA TO LAST-REC-KEY-AREA. DTSCS64 00755 DTSCS64 00756 IF LAST-REC-NUM = +0 DTSCS64 00757 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS64 00758 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS64 00759 GO TO P6000-EXIT. DTSCS64 00760 DTSCS64 00761 PERFORM P6100-LOCATE-REC THRU P6100-EXIT. DTSCS64 00762 IF LCCM-MSG DTSCS64 00763 GO TO P6000-EXIT. DTSCS64 00764 DTSCS64 00765 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS64 00766 DTSCS64 00767 MOVE MAUY-KEY-AREA TO LCCM-SCR64-HOLD-AREA. DTSCS64 00768 DTSCS64 00769 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS64 00770 DTSCS64 00771 IF SCR-ACCESS-UPDATE DTSCS64 00772 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS64 00773 P6000-EXIT. DTSCS64 00774 EXIT. DTSCS64 00775 EJECT DTSCS64 00776 P6100-LOCATE-REC. DTSCS64 00777 *------------------------------------------------------------ DTSCS64 00778 * IF, AT THE LAST USE OF THIS SCREEN, A RECORD FOR DTSCS64 00779 * EMPLOYER NUMBER LCCM-EMP-NO WAS DISPLAYED ON THE DTSCS64 00780 * SCREEN, THEN BASE THE PAGING LOGIC ON THE LAST RECORD DTSCS64 00781 * DISPLAYED ON THIS SCREEN; OTHERWISE, DISPLAY THE DTSCS64 00782 * RECORD WITH THE GREATEST CALENDAR-YEAR (THE MOST DTSCS64 00783 * RECENT CALENDAR YEAR ASSOCIATED WITH ASSIGN-NO). DTSCS64 00784 *------------------------------------------------------------ DTSCS64 00785 DTSCS64 00786 IF SCR-REC-KEY-AREA = LOW-VALUES DTSCS64 00787 PERFORM P6140-LAST-REC THRU P6140-EXIT DTSCS64 00788 GO TO P6100-EXIT. DTSCS64 00789 DTSCS64 00790 MOVE SCR-REC-KEY-AREA TO MAUY-KEY-AREA. DTSCS64 00791 DTSCS64 00792 IF WRK-ASSIGN-NO = MAUY-ASSIGN-NO DTSCS64 00793 NEXT SENTENCE DTSCS64 00794 ELSE DTSCS64 00795 PERFORM P6140-LAST-REC THRU P6140-EXIT DTSCS64 00796 GO TO P6100-EXIT. DTSCS64 00797 DTSCS64 00798 IF LCCM-F05-88 DTSCS64 00799 PERFORM P6110-FIRST-REC THRU P6110-EXIT DTSCS64 00800 GO TO P6100-EXIT. DTSCS64 00801 DTSCS64 00802 IF LCCM-F06-88 DTSCS64 00803 PERFORM P6140-LAST-REC THRU P6140-EXIT DTSCS64 00804 GO TO P6100-EXIT. DTSCS64 00805 DTSCS64 00806 MOVE LOW-VALUES TO MAUY-KEY-AREA. DTSCS64 00807 MOVE WRK-EMP-NO TO MAUY-EMP-NO. DTSCS64 00808 MOVE WRK-ASSIGN-NO TO MAUY-ASSIGN-NO. DTSCS64 00809 SET MAUY-AUY-88 TO TRUE. DTSCS64 00810 MOVE MAUY-KEY-AREA TO MSKL-KEY-AREA. DTSCS64 00811 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS64 00812 IF L810-NO-REC-88 DTSCS64 00813 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS64 00814 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS64 00815 GO TO P6100-EXIT. DTSCS64 00816 DTSCS64 00817 MOVE +0 TO WS-REC-NUM. DTSCS64 00818 MOVE 'N' TO WS-REC-FOUND-IND. DTSCS64 00819 PERFORM P6190-BROWSE-MAUY THRU P6190-EXIT DTSCS64 00820 UNTIL (L810-NO-REC-88) DTSCS64 00821 OR DTSCS64 00822 (WS-REC-FOUND-IND = 'Y'). DTSCS64 00823 DTSCS64 00824 IF L810-NO-REC-88 DTSCS64 00825 PERFORM P6140-LAST-REC THRU P6140-EXIT DTSCS64 00826 GO TO P6100-EXIT. DTSCS64 00827 DTSCS64 00828 IF LCCM-ENTER-88 DTSCS64 00829 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS64 00830 GO TO P6100-EXIT. DTSCS64 00831 DTSCS64 00832 IF LCCM-F07-88 DTSCS64 00833 PERFORM P6120-PREV-REC THRU P6120-EXIT DTSCS64 00834 GO TO P6100-EXIT. DTSCS64 00835 DTSCS64 00836 IF LCCM-F08-88 DTSCS64 00837 PERFORM P6130-NEXT-REC THRU P6130-EXIT DTSCS64 00838 GO TO P6100-EXIT. DTSCS64 00839 DTSCS64 00840 GO TO S899-ABEND. DTSCS64 00841 P6100-EXIT. DTSCS64 00842 EXIT. DTSCS64 00843 DTSCS64 00844 P6110-FIRST-REC. DTSCS64 00845 MOVE LOW-VALUES TO MAUY-KEY-AREA. DTSCS64 00846 MOVE WRK-EMP-NO TO MAUY-EMP-NO. DTSCS64 00847 MOVE WRK-ASSIGN-NO TO MAUY-ASSIGN-NO. DTSCS64 00848 SET MAUY-AUY-88 TO TRUE. DTSCS64 00849 MOVE MAUY-KEY-AREA TO MSKL-KEY-AREA. DTSCS64 00850 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS64 00851 IF L810-NO-REC-88 DTSCS64 00852 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS64 00853 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS64 00854 GO TO P6110-EXIT. DTSCS64 00855 DTSCS64 00856 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS64 00857 DTSCS64 00858 MOVE MSKL-REC TO MAUY-REC. DTSCS64 00859 DTSCS64 00860 IF MAUY-ASSIGN-NO = WRK-ASSIGN-NO DTSCS64 00861 NEXT SENTENCE DTSCS64 00862 ELSE DTSCS64 00863 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS64 00864 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS64 00865 GO TO P6110-EXIT. DTSCS64 00866 DTSCS64 00867 MOVE +1 TO WS-REC-NUM. DTSCS64 00868 P6110-EXIT. DTSCS64 00869 EXIT. DTSCS64 00870 DTSCS64 00871 P6120-PREV-REC. DTSCS64 00872 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCS64 00873 IF L810-NO-REC-88 DTSCS64 00874 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS64 00875 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS64 00876 GO TO P6120-EXIT. DTSCS64 00877 DTSCS64 00878 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCS64 00879 IF L810-NO-REC-88 DTSCS64 00880 GO TO P6120-EXIT. DTSCS64 00881 DTSCS64 00882 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS64 00883 DTSCS64 00884 SUBTRACT 1 FROM WS-REC-NUM. DTSCS64 00885 DTSCS64 00886 MOVE MSKL-REC TO MAUY-REC. DTSCS64 00887 DTSCS64 00888 IF MAUY-ASSIGN-NO = WRK-ASSIGN-NO DTSCS64 00889 NEXT SENTENCE DTSCS64 00890 ELSE DTSCS64 00891 PERFORM P6110-FIRST-REC THRU P6110-EXIT. DTSCS64 00892 P6120-EXIT. DTSCS64 00893 EXIT. DTSCS64 00894 DTSCS64 00895 P6130-NEXT-REC. DTSCS64 00896 IF MAUY-KEY-AREA > SCR-REC-KEY-AREA DTSCS64 00897 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS64 00898 GO TO P6130-EXIT. DTSCS64 00899 DTSCS64 00900 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS64 00901 DTSCS64 00902 IF L810-NO-REC-88 DTSCS64 00903 GO TO P6130-EXIT. DTSCS64 00904 DTSCS64 00905 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS64 00906 DTSCS64 00907 ADD +1 TO WS-REC-NUM. DTSCS64 00908 DTSCS64 00909 MOVE MSKL-REC TO MAUY-REC. DTSCS64 00910 DTSCS64 00911 IF MAUY-ASSIGN-NO = WRK-ASSIGN-NO DTSCS64 00912 NEXT SENTENCE DTSCS64 00913 ELSE DTSCS64 00914 PERFORM P6140-LAST-REC THRU P6140-EXIT. DTSCS64 00915 P6130-EXIT. DTSCS64 00916 EXIT. DTSCS64 00917 DTSCS64 00918 P6140-LAST-REC. DTSCS64 00919 MOVE LAST-REC-KEY-AREA TO MSKL-KEY-AREA. DTSCS64 00920 PERFORM S810-READ THRU S810-EXIT. DTSCS64 00921 IF L810-NO-REC-88 DTSCS64 00922 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS64 00923 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS64 00924 GO TO P6140-EXIT. DTSCS64 00925 DTSCS64 00926 MOVE MSKL-REC TO MAUY-REC. DTSCS64 00927 DTSCS64 00928 MOVE LAST-REC-NUM TO WS-REC-NUM. DTSCS64 00929 P6140-EXIT. DTSCS64 00930 EXIT. DTSCS64 00931 DTSCS64 00932 P6190-BROWSE-MAUY. DTSCS64 00933 MOVE MSKL-REC TO MAUY-REC. DTSCS64 00934 DTSCS64 00935 IF MAUY-ASSIGN-NO = WRK-ASSIGN-NO DTSCS64 00936 NEXT SENTENCE DTSCS64 00937 ELSE DTSCS64 00938 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS64 00939 SET L810-NO-REC-88 TO TRUE DTSCS64 00940 GO TO P6190-EXIT. DTSCS64 00941 DTSCS64 00942 ADD +1 TO WS-REC-NUM. DTSCS64 00943 IF MAUY-KEY-AREA NOT < SCR-REC-KEY-AREA DTSCS64 00944 MOVE 'Y' TO WS-REC-FOUND-IND DTSCS64 00945 ELSE DTSCS64 00946 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS64 00947 P6190-EXIT. DTSCS64 00948 EXIT. DTSCS64 00949 /*****************************************************************DTSCS64 00950 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCS64 00951 ******************************************************************DTSCS64 00952 DTSCS64 00953 P6900-CONSTRUCT-SCREEN. DTSCS64 00954 PERFORM P6910-FROM-MAUY THRU P6910-EXIT. DTSCS64 00955 DTSCS64 00956 PERFORM P6990-PAGE-NUMBER THRU P6990-EXIT. DTSCS64 00957 P6900-EXIT. DTSCS64 00958 EXIT. DTSCS64 00959 DTSCS64 00960 P6910-FROM-MAUY. DTSCS64 00961 PERFORM VARYING WRK-OCC FROM 1 BY 1 DTSCS64 00962 UNTIL WRK-OCC > 4 DTSCS64 00963 IF MAUY-QTR-AUDITED-88(WRK-OCC) DTSCS64 00964 MOVE MAUY-QTR-GROSS-PAYROLL (WRK-OCC) DTSCS64 00965 TO MAP-GROSS-PAYROLL-N (WRK-OCC) DTSCS64 00966 MOVE MAUY-QTR-UNDER-TOT-WAGE (WRK-OCC) DTSCS64 00967 TO MAP-UNDER-TOT-WAGE-N (WRK-OCC) DTSCS64 00968 MOVE MAUY-QTR-UNDER-TAX-WAGE (WRK-OCC) DTSCS64 00969 TO MAP-UNDER-TAX-WAGE-N (WRK-OCC) DTSCS64 00970 MOVE MAUY-QTR-UNDER-CONTRIB (WRK-OCC) DTSCS64 00971 TO MAP-UNDER-CONTRIB-N (WRK-OCC) DTSCS64 00972 MOVE MAUY-QTR-OVER-TOT-WAGE (WRK-OCC) DTSCS64 00973 TO MAP-OVER-TOT-WAGE-N (WRK-OCC) DTSCS64 00974 MOVE MAUY-QTR-OVER-TAX-WAGE (WRK-OCC) DTSCS64 00975 TO MAP-OVER-TAX-WAGE-N (WRK-OCC) DTSCS64 00976 MOVE MAUY-QTR-OVER-CONTRIB (WRK-OCC) DTSCS64 00977 TO MAP-OVER-CONTRIB-N (WRK-OCC) DTSCS64 00978 END-IF DTSCS64 00979 END-PERFORM. DTSCS64 00980 MOVE MAUY-CALENDAR-YEAR TO WRK-DISPLAY. DTSCS64 00981 MOVE WRK-DISPLAY-CAL-YR TO MAP-CALENDAR-YEAR. DTSCS64 00982 P6910-EXIT. DTSCS64 00983 EXIT. DTSCS64 00984 DTSCS64 00985 P6990-PAGE-NUMBER. DTSCS64 00986 MOVE WS-REC-NUM TO MAP-CURR-PAGE. DTSCS64 00987 MOVE LAST-REC-NUM TO MAP-LAST-PAGE. DTSCS64 00988 DTSCS64 00989 IF WS-REC-NUM = +1 DTSCS64 00990 IF LAST-REC-NUM = +1 DTSCS64 00991 MOVE PMSG-ONLY-PAGE TO LCCM-MSG-AREA DTSCS64 00992 ELSE DTSCS64 00993 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-AREA DTSCS64 00994 ELSE DTSCS64 00995 IF WS-REC-NUM = LAST-REC-NUM DTSCS64 00996 MOVE PMSG-LAST-PAGE TO LCCM-MSG-AREA. DTSCS64 00997 P6990-EXIT. DTSCS64 00998 EXIT. DTSCS64 00999 /*****************************************************************DTSCS64 01000 * FUNCTION KEY TO ADD, MOD OR DEL THE RECORD WAS PRESSED. *DTSCS64 01001 ******************************************************************DTSCS64 01002 DTSCS64 01003 P7000-REQUEST-EDIT. DTSCS64 01004 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS64 01005 DTSCS64 01006 IF LCCM-F09-88 DTSCS64 01007 PERFORM P7100-EDIT-ADD THRU P7100-EXIT DTSCS64 01008 ELSE DTSCS64 01009 IF LCCM-F10-88 DTSCS64 01010 PERFORM P7200-EDIT-MOD THRU P7200-EXIT DTSCS64 01011 ELSE DTSCS64 01012 IF LCCM-F23-88 DTSCS64 01013 PERFORM P7300-EDIT-DEL THRU P7300-EXIT DTSCS64 01014 ELSE DTSCS64 01015 GO TO S899-ABEND. DTSCS64 01016 DTSCS64 01017 *------------------------------------------------------ DTSCS64 01018 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCS64 01019 * IN ORDER TO CONTINUE TO ATTEMPT A MOD THE SCREEN MUST DTSCS64 01020 * REMAIN IN 'INQUIRE' STATUS. DTSCS64 01021 *------------------------------------------------------ DTSCS64 01022 DTSCS64 01023 IF LCCM-MSG DTSCS64 01024 NEXT SENTENCE DTSCS64 01025 ELSE DTSCS64 01026 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCS64 01027 IF LCCM-F09-88 DTSCS64 01028 SET LCCM-SCR-ADD-LOCKED TO TRUE DTSCS64 01029 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS64 01030 ELSE DTSCS64 01031 IF LCCM-F10-88 DTSCS64 01032 SET LCCM-SCR-MOD-LOCKED TO TRUE DTSCS64 01033 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS64 01034 ELSE DTSCS64 01035 IF LCCM-F23-88 DTSCS64 01036 SET LCCM-SCR-DEL-LOCKED TO TRUE DTSCS64 01037 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID. DTSCS64 01038 DTSCS64 01039 SET RESP-SEND-MAP TO TRUE. DTSCS64 01040 P7000-EXIT. DTSCS64 01041 EXIT. DTSCS64 01042 /*****************************************************************DTSCS64 01043 * ADD FUNCTION WAS REQUESTED *DTSCS64 01044 ******************************************************************DTSCS64 01045 DTSCS64 01046 P7100-EDIT-ADD. DTSCS64 01047 *----------------------------------------------------- DTSCS64 01048 * ADDITION REQUIRES THAT THE SCREEN WAS CLEARED FIRST DTSCS64 01049 *----------------------------------------------------- DTSCS64 01050 IF NOT LCCM-SCR-CLEAR DTSCS64 01051 MOVE EMSG-ADD-PRECEDED TO LCCM-MSG-ID DTSCS64 01052 GO TO P7100-EXIT. DTSCS64 01053 DTSCS64 01054 *----------------------------------------------------- DTSCS64 01055 * DTSCS64 01056 *----------------------------------------------------- DTSCS64 01057 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS64 01058 IF LCCM-MSG DTSCS64 01059 GO TO P7100-EXIT. DTSCS64 01060 DTSCS64 01061 PERFORM S1120-READ-IFAN THRU S1120-EXIT. DTSCS64 01062 IF LCCM-MSG DTSCS64 01063 GO TO P7100-EXIT. DTSCS64 01064 DTSCS64 01065 MOVE WRK-ASSIGN-NO TO LCCM-ASSIGN-NO. DTSCS64 01066 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS64 01067 DTSCS64 01068 PERFORM S1130-READ-MPRF THRU S1130-EXIT. DTSCS64 01069 DTSCS64 01070 PERFORM S1110-READ-MFAS THRU S1110-EXIT. DTSCS64 01071 IF LCCM-MSG DTSCS64 01072 GO TO P7100-EXIT. DTSCS64 01073 DTSCS64 01074 PERFORM S1140-READ-MAUR THRU S1140-EXIT. DTSCS64 01075 IF LCCM-MSG DTSCS64 01076 GO TO P7100-EXIT. DTSCS64 01077 DTSCS64 01078 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS64 01079 DTSCS64 01080 P7100-EXIT. DTSCS64 01081 EXIT. DTSCS64 01082 /*****************************************************************DTSCS64 01083 * MODIFICATION FUNCTION WAS REQUESTED *DTSCS64 01084 ******************************************************************DTSCS64 01085 DTSCS64 01086 P7200-EDIT-MOD. DTSCS64 01087 *----------------------------------------------------- DTSCS64 01088 * MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS64 01089 * INQUIRED DTSCS64 01090 *----------------------------------------------------- DTSCS64 01091 IF NOT LCCM-SCR-INQUIRE DTSCS64 01092 MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-ID DTSCS64 01093 GO TO P7200-EXIT. DTSCS64 01094 DTSCS64 01095 *----------------------------------------------------- DTSCS64 01096 * MAP-ASSIGN-NO MAY NOT BE CHANGED DURING THE MOD DTSCS64 01097 *----------------------------------------------------- DTSCS64 01098 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS64 01099 IF LCCM-MSG DTSCS64 01100 GO TO P7200-EXIT. DTSCS64 01101 DTSCS64 01102 PERFORM S1120-READ-IFAN THRU S1120-EXIT. DTSCS64 01103 IF LCCM-MSG DTSCS64 01104 GO TO P7200-EXIT. DTSCS64 01105 DTSCS64 01106 PERFORM S1130-READ-MPRF THRU S1130-EXIT. DTSCS64 01107 DTSCS64 01108 PERFORM S1110-READ-MFAS THRU S1110-EXIT. DTSCS64 01109 DTSCS64 01110 IF LCCM-ASSIGN-NO NOT = WRK-ASSIGN-NO DTSCS64 01111 MOVE EMSG-NO-ASSIGN-NO-CHANGE TO WRK-MSG-AREA DTSCS64 01112 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS64 01113 GO TO P7200-EXIT. DTSCS64 01114 DTSCS64 01115 MOVE MAP-CALENDAR-YEAR TO L007-YR-2-X. DTSCS64 01116 PERFORM S007-CAL-YEAR-EDIT THRU S007-EXIT. DTSCS64 01117 MOVE LCCM-SCR64-HOLD-AREA TO MAUY-KEY-AREA. DTSCS64 01118 IF (L007-VALID-YR) DTSCS64 01119 AND DTSCS64 01120 (L007-YR-4-9 = MAUY-CALENDAR-YEAR) DTSCS64 01121 NEXT SENTENCE DTSCS64 01122 ELSE DTSCS64 01123 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS64 01124 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS64 01125 GO TO P7200-EXIT. DTSCS64 01126 DTSCS64 01127 PERFORM S1140-READ-MAUR THRU S1140-EXIT. DTSCS64 01128 IF LCCM-MSG DTSCS64 01129 GO TO P7200-EXIT. DTSCS64 01130 DTSCS64 01131 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS64 01132 DTSCS64 01133 P7200-EXIT. DTSCS64 01134 EXIT. DTSCS64 01135 /*****************************************************************DTSCS64 01136 * DELETE FUNCTION WAS REQUESTED *DTSCS64 01137 ******************************************************************DTSCS64 01138 DTSCS64 01139 P7300-EDIT-DEL. DTSCS64 01140 *----------------------------------------------------- DTSCS64 01141 * DELETION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS64 01142 * INQUIRED DTSCS64 01143 *----------------------------------------------------- DTSCS64 01144 IF NOT LCCM-SCR-INQUIRE DTSCS64 01145 MOVE EMSG-DEL-PRECEDED TO LCCM-MSG-ID DTSCS64 01146 GO TO P7300-EXIT. DTSCS64 01147 DTSCS64 01148 *----------------------------------------------------- DTSCS64 01149 * MAP-ASSIGN-NO MAY NOT BE CHANGED DURING THE DEL DTSCS64 01150 *----------------------------------------------------- DTSCS64 01151 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS64 01152 IF LCCM-MSG DTSCS64 01153 GO TO P7300-EXIT. DTSCS64 01154 DTSCS64 01155 PERFORM S1120-READ-IFAN THRU S1120-EXIT. DTSCS64 01156 IF LCCM-MSG DTSCS64 01157 GO TO P7300-EXIT. DTSCS64 01158 DTSCS64 01159 PERFORM S1130-READ-MPRF THRU S1130-EXIT. DTSCS64 01160 DTSCS64 01161 PERFORM S1110-READ-MFAS THRU S1110-EXIT. DTSCS64 01162 DTSCS64 01163 IF LCCM-ASSIGN-NO NOT = WRK-ASSIGN-NO DTSCS64 01164 MOVE EMSG-NO-ASSIGN-NO-CHANGE TO WRK-MSG-AREA DTSCS64 01165 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS64 01166 GO TO P7300-EXIT. DTSCS64 01167 DTSCS64 01168 MOVE MAP-CALENDAR-YEAR TO L007-YR-2-X. DTSCS64 01169 PERFORM S007-CAL-YEAR-EDIT THRU S007-EXIT. DTSCS64 01170 MOVE LCCM-SCR64-HOLD-AREA TO MAUY-KEY-AREA. DTSCS64 01171 IF (L007-VALID-YR) DTSCS64 01172 AND DTSCS64 01173 (L007-YR-4-9 = MAUY-CALENDAR-YEAR) DTSCS64 01174 NEXT SENTENCE DTSCS64 01175 ELSE DTSCS64 01176 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS64 01177 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS64 01178 GO TO P7300-EXIT. DTSCS64 01179 DTSCS64 01180 P7300-EXIT. DTSCS64 01181 EXIT. DTSCS64 01182 /*****************************************************************DTSCS64 01183 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED *DTSCS64 01184 ******************************************************************DTSCS64 01185 DTSCS64 01186 P8000-REQUEST-UPDATE. DTSCS64 01187 DTSCS64 01188 DTSCS64 01189 IF LCCM-SCR-ADD-LOCKED DTSCS64 01190 PERFORM P8100-ADD THRU P8100-EXIT DTSCS64 01191 ELSE DTSCS64 01192 IF LCCM-SCR-MOD-LOCKED DTSCS64 01193 PERFORM P8200-MOD THRU P8200-EXIT DTSCS64 01194 ELSE DTSCS64 01195 IF LCCM-SCR-DEL-LOCKED DTSCS64 01196 PERFORM P8300-DEL THRU P8300-EXIT DTSCS64 01197 ELSE DTSCS64 01198 GO TO S899-ABEND. DTSCS64 01199 DTSCS64 01200 SET RESP-SEND-MAP TO TRUE. DTSCS64 01201 P8000-EXIT. DTSCS64 01202 EXIT. DTSCS64 01203 /*****************************************************************DTSCS64 01204 * *DTSCS64 01205 ******************************************************************DTSCS64 01206 DTSCS64 01207 P8100-ADD. DTSCS64 01208 SET LCCM-SCR-CLEAR TO TRUE. DTSCS64 01209 DTSCS64 01210 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS64 01211 DTSCS64 01212 IF LCCM-F12-88 DTSCS64 01213 MOVE PMSG-ADD-CANCELED TO LCCM-MSG-ID DTSCS64 01214 GO TO P8100-EXIT. DTSCS64 01215 DTSCS64 01216 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS64 01217 PERFORM S1120-READ-IFAN THRU S1120-EXIT. DTSCS64 01218 DTSCS64 01219 MOVE 'A' TO L221-UPDATE-FUNCTION. DTSCS64 01220 PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS64 01221 IF LCCM-MSG DTSCS64 01222 GO TO P8100-EXIT. DTSCS64 01223 DTSCS64 01224 DTSCS64 01225 PERFORM S1110-READ-MFAS THRU S1110-EXIT. DTSCS64 01226 PERFORM P8110-CONSTRUCT-MAUY THRU P8110-EXIT. DTSCS64 01227 DTSCS64 01228 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS64 01229 DTSCS64 01230 DTSCS64 01231 MOVE MAUY-KEY-AREA TO LCCM-SCR64-HOLD-AREA. DTSCS64 01232 SET LCCM-ENTER-88 TO TRUE. DTSCS64 01233 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT. DTSCS64 01234 DTSCS64 01235 MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS64 01236 DTSCS64 01237 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS64 01238 P8100-EXIT. DTSCS64 01239 EXIT. DTSCS64 01240 DTSCS64 01241 P8110-CONSTRUCT-MAUY. DTSCS64 01242 MOVE LOW-VALUES TO MAUY-REC. DTSCS64 01243 DTSCS64 01244 MOVE WRK-EMP-NO TO MAUY-EMP-NO. DTSCS64 01245 MOVE WRK-ASSIGN-NO TO MAUY-ASSIGN-NO. DTSCS64 01246 SET MAUY-AUY-88 TO TRUE. DTSCS64 01247 DTSCS64 01248 MOVE +0 TO MAUY-PURGE-DATE. DTSCS64 01249 SET MAUY-NOT-CONVERTED-88 TO TRUE. DTSCS64 01250 MOVE LCCM-CURR-RUN-DATE TO MAUY-ESTB-DATE. DTSCS64 01251 MOVE LCCM-CURR-RUN-DATE TO MAUY-CHNG-DATE. DTSCS64 01252 DTSCS64 01253 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS64 01254 DTSCS64 01255 MOVE MAUY-REC TO MSKL-REC. DTSCS64 01256 PERFORM S810-WRITE THRU S810-EXIT. DTSCS64 01257 DTSCS64 01258 P8110-EXIT. DTSCS64 01259 EXIT. DTSCS64 01260 /*****************************************************************DTSCS64 01261 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS64 01262 ******************************************************************DTSCS64 01263 DTSCS64 01264 P8200-MOD. DTSCS64 01265 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS64 01266 DTSCS64 01267 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS64 01268 DTSCS64 01269 IF LCCM-F12-88 DTSCS64 01270 MOVE PMSG-MOD-CANCELED TO LCCM-MSG-ID DTSCS64 01271 GO TO P8200-EXIT. DTSCS64 01272 DTSCS64 01273 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS64 01274 PERFORM S1120-READ-IFAN THRU S1120-EXIT. DTSCS64 01275 DTSCS64 01276 MOVE 'M' TO L221-UPDATE-FUNCTION. DTSCS64 01277 PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS64 01278 IF LCCM-MSG DTSCS64 01279 GO TO P8200-EXIT. DTSCS64 01280 DTSCS64 01281 PERFORM S1110-READ-MFAS THRU S1110-EXIT. DTSCS64 01282 PERFORM P8210-CONSTRUCT-MAUY THRU P8210-EXIT. DTSCS64 01283 DTSCS64 01284 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS64 01285 DTSCS64 01286 MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS64 01287 DTSCS64 01288 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS64 01289 P8200-EXIT. DTSCS64 01290 EXIT. DTSCS64 01291 EJECT DTSCS64 01292 P8210-CONSTRUCT-MAUY. DTSCS64 01293 MOVE LCCM-SCR64-HOLD-AREA TO MSKL-KEY-AREA. DTSCS64 01294 PERFORM S810-READ THRU S810-EXIT. DTSCS64 01295 IF L810-NO-REC-88 DTSCS64 01296 GO TO S899-ABEND. DTSCS64 01297 DTSCS64 01298 MOVE MSKL-REC TO MAUY-REC. DTSCS64 01299 DTSCS64 01300 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS64 01301 DTSCS64 01302 MOVE LCCM-CURR-RUN-DATE TO MAUY-CHNG-DATE. DTSCS64 01303 DTSCS64 01304 MOVE MAUY-REC TO MSKL-REC. DTSCS64 01305 PERFORM S810-REWRITE THRU S810-EXIT. DTSCS64 01306 P8210-EXIT. DTSCS64 01307 EXIT. DTSCS64 01308 /*****************************************************************DTSCS64 01309 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS64 01310 ******************************************************************DTSCS64 01311 DTSCS64 01312 P8300-DEL. DTSCS64 01313 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS64 01314 DTSCS64 01315 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS64 01316 DTSCS64 01317 IF LCCM-F12-88 DTSCS64 01318 MOVE PMSG-DEL-CANCELED TO LCCM-MSG-ID DTSCS64 01319 GO TO P8300-EXIT. DTSCS64 01320 DTSCS64 01321 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS64 01322 PERFORM S1120-READ-IFAN THRU S1120-EXIT. DTSCS64 01323 DTSCS64 01324 MOVE 'D' TO L221-UPDATE-FUNCTION. DTSCS64 01325 PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS64 01326 IF LCCM-MSG DTSCS64 01327 GO TO P8300-EXIT. DTSCS64 01328 DTSCS64 01329 MOVE LCCM-SCR64-HOLD-AREA TO MSKL-KEY-AREA. DTSCS64 01330 PERFORM S810-READ THRU S810-EXIT. DTSCS64 01331 IF L810-NO-REC-88 DTSCS64 01332 GO TO S899-ABEND. DTSCS64 01333 DTSCS64 01334 PERFORM S810-DELETE THRU S810-EXIT. DTSCS64 01335 DTSCS64 01336 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS64 01337 DTSCS64 01338 MOVE LOW-VALUES TO MAP-AREA. DTSCS64 01339 DTSCS64 01340 MOVE WRK-ASSIGN-NO TO WRK-DISPLAY. DTSCS64 01341 MOVE WRK-DISPLAY-ASSIGN-NO-1 TO MAP-ASSIGN-NO-1. DTSCS64 01342 MOVE WRK-DISPLAY-ASSIGN-NO-2 TO MAP-ASSIGN-NO-2. DTSCS64 01343 DTSCS64 01344 MOVE WRK-EMP-NO TO WRK-DISPLAY. DTSCS64 01345 MOVE WRK-DISPLAY-EMP-NO-1 TO MAP-EMP-NO-1. DTSCS64 01346 MOVE WRK-DISPLAY-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS64 01347 DTSCS64 01348 MOVE LCCM-SCR64-HOLD-AREA TO MAUY-KEY-AREA. DTSCS64 01349 MOVE MAUY-CALENDAR-YEAR TO WRK-DISPLAY. DTSCS64 01350 MOVE WRK-DISPLAY-CAL-YR TO MAP-CALENDAR-YEAR. DTSCS64 01351 DTSCS64 01352 SET LCCM-SCR-CLEAR TO TRUE. DTSCS64 01353 DTSCS64 01354 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS64 01355 DTSCS64 01356 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS64 01357 DTSCS64 01358 MOVE PMSG-DEL-SUCCESSFUL TO LCCM-MSG-ID. DTSCS64 01359 P8300-EXIT. DTSCS64 01360 EXIT. DTSCS64 01361 EJECT DTSCS64 01362 DTSCS64 01363 P8810-LOCK-EMPLOYER. DTSCS64 01364 MOVE WRK-EMP-NO TO L221-EMP-NO. DTSCS64 01365 MOVE LCCM-SCR-ABSTIME TO L221-SCR-ABSTIME. DTSCS64 01366 MOVE LCCM-TASK-ID TO L221-UPDATE-TASK-ID. DTSCS64 01367 MOVE LCCM-OP-ID TO L221-UPDATE-OP-ID. DTSCS64 01368 MOVE LCCM-CICS-TERM-ID TO L221-UPDATE-TERMID. DTSCS64 01369 MOVE LCCM-TASK-NETNAME TO L221-UPDATE-NETNAME. DTSCS64 01370 MOVE LCCM-TASK-START-DATE TO L221-UPDATE-START-DATE. DTSCS64 01371 MOVE LCCM-TASK-START-TIME TO L221-UPDATE-START-TIME. DTSCS64 01372 MOVE WRK-SCR-ID TO L221-UPDATE-SCR-ID. DTSCS64 01373 DTSCS64 01374 PERFORM S221-EMP-LOCK THRU S221-EXIT. DTSCS64 01375 P8810-EXIT. DTSCS64 01376 EXIT. DTSCS64 01377 EJECT DTSCS64 01378 DTSCS64 01379 /*****************************************************************DTSCS64 01380 * LINKS TO UTILITY MODULES DTSCS64 01381 ******************************************************************DTSCS64 01382 DTSCS64 01383 S001-FROM-FED-8. DTSCS64 01384 SET L001-FROM-FED-8 TO TRUE. DTSCS64 01385 GO TO S001-DATE. DTSCS64 01386 DTSCS64 01387 S001-FROM-ABS-DATE. DTSCS64 01388 SET L001-FROM-ABS-DAY TO TRUE. DTSCS64 01389 GO TO S001-DATE. DTSCS64 01390 DTSCS64 01391 S001-DATE. DTSCS64 01392 EXEC CICS LINK DTSCS64 01393 PROGRAM('DTSCU001') DTSCS64 01394 COMMAREA(L001-COMM-AREA) DTSCS64 01395 END-EXEC. DTSCS64 01396 S001-EXIT. DTSCS64 01397 EXIT. DTSCS64 01398 DTSCS64 01399 DTSCS64 01400 S007-CAL-YEAR-EDIT. DTSCS64 01401 SET L007-FROM-YR-2 TO TRUE. DTSCS64 01402 EXEC CICS LINK DTSCS64 01403 PROGRAM('DTSCU007') DTSCS64 01404 COMMAREA(L007-COMM-AREA) DTSCS64 01405 END-EXEC. DTSCS64 01406 S007-EXIT. DTSCS64 01407 EXIT. DTSCS64 01408 DTSCS64 01409 S011-MONEY-FROM-SCREEN. DTSCS64 01410 MOVE +99999999.99 TO L011-MAX-AMT. DTSCS64 01411 MOVE +0 TO L011-MIN-AMT. DTSCS64 01412 EXEC CICS LINK DTSCS64 01413 PROGRAM('DTSCU011') DTSCS64 01414 COMMAREA(L011-COMM-AREA) DTSCS64 01415 END-EXEC. DTSCS64 01416 S011-EXIT. DTSCS64 01417 EXIT. DTSCS64 01418 DTSCS64 01419 S022-ASSIGN-NO-FROM-SCREEN. DTSCS64 01420 EXEC CICS LINK DTSCS64 01421 PROGRAM('DTSCU022') DTSCS64 01422 COMMAREA(L022-COMM-AREA) DTSCS64 01423 END-EXEC. DTSCS64 01424 S022-EXIT. DTSCS64 01425 EXIT. DTSCS64 01426 DTSCS64 01427 S221-EMP-LOCK. DTSCS64 01428 SET L221-START-UPDATE TO TRUE. DTSCS64 01429 GO TO S221-EMP-LOCK-UNLOCK. DTSCS64 01430 DTSCS64 01431 S221-EMP-UNLOCK. DTSCS64 01432 SET L221-END-UPDATE TO TRUE. DTSCS64 01433 GO TO S221-EMP-LOCK-UNLOCK. DTSCS64 01434 DTSCS64 01435 S221-EMP-LOCK-UNLOCK. DTSCS64 01436 EXEC CICS LINK DTSCS64 01437 PROGRAM('DTSCU221') DTSCS64 01438 COMMAREA(L221-COMM-AREA) DTSCS64 01439 END-EXEC. DTSCS64 01440 DTSCS64 01441 IF L221-FILE-CLOSED DTSCS64 01442 MOVE L221-MSG-AREA TO LCCM-MSG-AREA DTSCS64 01443 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS64 01444 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS64 01445 GO TO MAINLINE-EXIT. DTSCS64 01446 DTSCS64 01447 IF L221-NOT-OK DTSCS64 01448 MOVE L221-MSG-AREA TO LCCM-MSG-AREA. DTSCS64 01449 S221-EXIT. DTSCS64 01450 EXIT. DTSCS64 01451 DTSCS64 01452 S803-REQ-SCR-ID-EDIT. DTSCS64 01453 EXEC CICS LINK DTSCS64 01454 PROGRAM ('DTSCU803') DTSCS64 01455 COMMAREA (DFHCOMMAREA) DTSCS64 01456 END-EXEC. DTSCS64 01457 S803-EXIT. DTSCS64 01458 EXIT. DTSCS64 01459 DTSCS64 01460 S804-INVALID-KEY. DTSCS64 01461 EXEC CICS LINK DTSCS64 01462 PROGRAM ('DTSCU804') DTSCS64 01463 COMMAREA (DFHCOMMAREA) DTSCS64 01464 END-EXEC. DTSCS64 01465 S804-EXIT. DTSCS64 01466 EXIT. DTSCS64 01467 DTSCS64 01468 S805-MSG-AREA. DTSCS64 01469 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS64 01470 DTSCS64 01471 EXEC CICS LINK DTSCS64 01472 PROGRAM ('DTSCU805') DTSCS64 01473 COMMAREA (L805-COMM-AREA) DTSCS64 01474 END-EXEC. DTSCS64 01475 DTSCS64 01476 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS64 01477 S805-EXIT. DTSCS64 01478 EXIT. DTSCS64 01479 EJECT DTSCS64 01480 S810-READ. DTSCS64 01481 SET L810-READ-88 TO TRUE. DTSCS64 01482 GO TO S810-IO. DTSCS64 01483 DTSCS64 01484 S810-START-BROWSE. DTSCS64 01485 SET L810-START-BROWSE-88 TO TRUE. DTSCS64 01486 GO TO S810-IO. DTSCS64 01487 DTSCS64 01488 S810-READ-NEXT. DTSCS64 01489 SET L810-READ-NEXT-88 TO TRUE. DTSCS64 01490 GO TO S810-IO. DTSCS64 01491 DTSCS64 01492 S810-READ-PREV. DTSCS64 01493 SET L810-READ-PREV-88 TO TRUE. DTSCS64 01494 GO TO S810-IO. DTSCS64 01495 DTSCS64 01496 S810-END-BROWSE. DTSCS64 01497 SET L810-END-BROWSE-88 TO TRUE. DTSCS64 01498 GO TO S810-IO. DTSCS64 01499 DTSCS64 01500 S810-COUNT. DTSCS64 01501 SET L810-COUNT-88 TO TRUE. DTSCS64 01502 GO TO S810-IO. DTSCS64 01503 DTSCS64 01504 S810-REWRITE. DTSCS64 01505 SET L810-REWRITE-88 TO TRUE. DTSCS64 01506 GO TO S810-IO. DTSCS64 01507 DTSCS64 01508 S810-WRITE. DTSCS64 01509 SET L810-WRITE-88 TO TRUE. DTSCS64 01510 GO TO S810-IO. DTSCS64 01511 DTSCS64 01512 S810-DELETE. DTSCS64 01513 SET L810-DELETE-88 TO TRUE. DTSCS64 01514 GO TO S810-IO. DTSCS64 01515 DTSCS64 01516 S810-IO. DTSCS64 01517 DTSCS64 01518 EXEC CICS LINK DTSCS64 01519 PROGRAM ('DTSCU810') DTSCS64 01520 COMMAREA (L810-COMM-AREA) DTSCS64 01521 END-EXEC. DTSCS64 01522 DTSCS64 01523 IF L810-FILE-CLOSED-88 DTSCS64 01524 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS64 01525 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS64 01526 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS64 01527 GO TO MAINLINE-EXIT. DTSCS64 01528 S810-EXIT. DTSCS64 01529 EXIT. DTSCS64 01530 EJECT DTSCS64 01531 S821-START-BROWSE. DTSCS64 01532 SET L821-START-BROWSE-88 TO TRUE. DTSCS64 01533 GO TO S821-MASTER-IO. DTSCS64 01534 S821-END-BROWSE. DTSCS64 01535 SET L821-END-BROWSE-88 TO TRUE. DTSCS64 01536 GO TO S821-MASTER-IO. DTSCS64 01537 S821-READ-PREV. DTSCS64 01538 SET L821-READ-PREV-88 TO TRUE. DTSCS64 01539 GO TO S821-MASTER-IO. DTSCS64 01540 S821-READ-NEXT. DTSCS64 01541 SET L821-READ-NEXT-88 TO TRUE. DTSCS64 01542 GO TO S821-MASTER-IO. DTSCS64 01543 S821-MASTER-IO. DTSCS64 01544 EXEC CICS LINK DTSCS64 01545 PROGRAM ('DTSCU821') DTSCS64 01546 COMMAREA (L821-COMM-AREA) DTSCS64 01547 END-EXEC. DTSCS64 01548 IF L821-FILE-CLOSED-88 DTSCS64 01549 MOVE L821-MSG-AREA TO LCCM-MSG-AREA DTSCS64 01550 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS64 01551 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS64 01552 GO TO MAINLINE-EXIT DTSCS64 01553 END-IF. DTSCS64 01554 S821-EXIT. EXIT. DTSCS64 01555 EJECT DTSCS64 01556 S851-SCREEN-PROCESSING. DTSCS64 01557 EXEC CICS LINK DTSCS64 01558 PROGRAM ('DTSCU851') DTSCS64 01559 COMMAREA (L851-COMM-AREA) DTSCS64 01560 END-EXEC. DTSCS64 01561 S851-EXIT. DTSCS64 01562 EXIT. DTSCS64 01563 DTSCS64 01564 S899-ABEND. DTSCS64 01565 EXEC CICS ABEND DTSCS64 01566 ABCODE(WRK-ABEND-CD) DTSCS64 01567 END-EXEC. DTSCS64 01568 S899-EXIT. DTSCS64 01569 EXIT. DTSCS64 01570 /*****************************************************************DTSCS64 01571 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS64 01572 ******************************************************************DTSCS64 01573 DTSCS64 01574 S1000-SCREEN-EDITS. DTSCS64 01575 DTSCS64 01576 PERFORM S1200-CALENDAR-YEAR THRU S1200-EXIT. DTSCS64 01577 DTSCS64 01578 PERFORM S1300-GROSS-PAYROLL THRU S1300-EXIT DTSCS64 01579 VARYING WRK-OCC FROM 1 BY 1 DTSCS64 01580 UNTIL WRK-OCC > MMAX-AUY-QTR-MAX. DTSCS64 01581 DTSCS64 01582 PERFORM S1400-UNDER-TOT-WAGE THRU S1400-EXIT DTSCS64 01583 VARYING WRK-OCC FROM 1 BY 1 DTSCS64 01584 UNTIL WRK-OCC > MMAX-AUY-QTR-MAX. DTSCS64 01585 DTSCS64 01586 PERFORM S1500-UNDER-TAX-WAGE THRU S1500-EXIT DTSCS64 01587 VARYING WRK-OCC FROM 1 BY 1 DTSCS64 01588 UNTIL WRK-OCC > MMAX-AUY-QTR-MAX. DTSCS64 01589 DTSCS64 01590 PERFORM S1600-UNDER-CONTRIB THRU S1600-EXIT DTSCS64 01591 VARYING WRK-OCC FROM 1 BY 1 DTSCS64 01592 UNTIL WRK-OCC > MMAX-AUY-QTR-MAX. DTSCS64 01593 DTSCS64 01594 PERFORM S1700-OVER-TOT-WAGE THRU S1700-EXIT DTSCS64 01595 VARYING WRK-OCC FROM 1 BY 1 DTSCS64 01596 UNTIL WRK-OCC > MMAX-AUY-QTR-MAX. DTSCS64 01597 DTSCS64 01598 PERFORM S1800-OVER-TAX-WAGE THRU S1800-EXIT DTSCS64 01599 VARYING WRK-OCC FROM 1 BY 1 DTSCS64 01600 UNTIL WRK-OCC > MMAX-AUY-QTR-MAX. DTSCS64 01601 DTSCS64 01602 PERFORM S1900-OVER-CONTRIB THRU S1900-EXIT DTSCS64 01603 VARYING WRK-OCC FROM 1 BY 1 DTSCS64 01604 UNTIL WRK-OCC > MMAX-AUY-QTR-MAX. DTSCS64 01605 DTSCS64 01606 IF LCCM-MSG DTSCS64 01607 GO TO S1000-EXIT. DTSCS64 01608 DTSCS64 01609 PERFORM S2000-MISC-EDITS THRU S2000-EXIT. DTSCS64 01610 S1000-EXIT. EXIT. DTSCS64 01611 EJECT DTSCS64 01612 /*****************************************************************DTSCS64 01613 * DTSCS64 01614 ******************************************************************DTSCS64 01615 S1100-EDIT-KEY. DTSCS64 01616 PERFORM S1101-ASSIGN-NO THRU S1101-EXIT. DTSCS64 01617 S1100-EXIT. EXIT. DTSCS64 01618 /*****************************************************************DTSCS64 01619 * DTSCS64 01620 ******************************************************************DTSCS64 01621 S1101-ASSIGN-NO. DTSCS64 01622 MOVE MAP-ASSIGN-NO-AREA TO L022-S-ASSIGN-NO-AREA. DTSCS64 01623 PERFORM S022-ASSIGN-NO-FROM-SCREEN THRU S022-EXIT. DTSCS64 01624 DTSCS64 01625 IF L022-NO-ENTRY DTSCS64 01626 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS64 01627 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS64 01628 GO TO S1101-EXIT. DTSCS64 01629 DTSCS64 01630 IF L022-NOT-VALID DTSCS64 01631 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS64 01632 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS64 01633 GO TO S1101-EXIT. DTSCS64 01634 DTSCS64 01635 MOVE L022-ASSIGN-NO TO WRK-ASSIGN-NO. DTSCS64 01636 S1101-EXIT. EXIT. DTSCS64 01637 DTSCS64 01638 /*****************************************************************DTSCS64 01639 * DTSCS64 01640 ******************************************************************DTSCS64 01641 S1110-READ-MFAS. DTSCS64 01642 MOVE LOW-VALUES TO MFAS-KEY-AREA. DTSCS64 01643 MOVE WRK-ASSIGN-NO TO MFAS-ASSIGN-NO. DTSCS64 01644 MOVE WRK-EMP-NO TO MFAS-EMP-NO. DTSCS64 01645 SET MFAS-FAS-88 TO TRUE. DTSCS64 01646 DTSCS64 01647 MOVE MFAS-KEY-AREA TO MSKL-KEY-AREA. DTSCS64 01648 DTSCS64 01649 PERFORM S810-READ THRU S810-EXIT. DTSCS64 01650 DTSCS64 01651 IF L810-NO-REC-88 DTSCS64 01652 MOVE WRK-EMP-NO TO MSG-EMP-NO-IN-ERR DTSCS64 01653 MOVE MSG-E645-AREA TO LCCM-MSG-AREA DTSCS64 01654 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS64 01655 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS64 01656 GO TO MAINLINE-EXIT DTSCS64 01657 ELSE DTSCS64 01658 MOVE MSKL-REC TO MFAS-REC DTSCS64 01659 END-IF. DTSCS64 01660 DTSCS64 01661 IF MFAS-NON-AUDIT-88 DTSCS64 01662 MOVE MSG-E643-AREA TO WRK-MSG-AREA DTSCS64 01663 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS64 01664 GO TO S1110-EXIT. DTSCS64 01665 DTSCS64 01666 IF MFAS-STATUS-PROCESSED-88 DTSCS64 01667 CONTINUE DTSCS64 01668 ELSE DTSCS64 01669 MOVE MSG-E642-AREA TO WRK-MSG-AREA DTSCS64 01670 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS64 01671 GO TO S1110-EXIT DTSCS64 01672 END-IF. DTSCS64 01673 DTSCS64 01674 S1110-EXIT. DTSCS64 01675 EXIT. DTSCS64 01676 /*****************************************************************DTSCS64 01677 * DTSCS64 01678 ******************************************************************DTSCS64 01679 S1120-READ-IFAN. DTSCS64 01680 MOVE LOW-VALUES TO IFAN-KEY-AREA. DTSCS64 01681 SET IFAN-FAN-88 TO TRUE. DTSCS64 01682 MOVE WRK-ASSIGN-NO TO IFAN-ASSIGN-NO. DTSCS64 01683 DTSCS64 01684 PERFORM S821-START-BROWSE THRU S821-EXIT. DTSCS64 01685 DTSCS64 01686 IF L821-OK-88 DTSCS64 01687 IF IFAN-ASSIGN-NO NOT = WRK-ASSIGN-NO DTSCS64 01688 MOVE EMSG-NO-ASSIGNMENT TO WRK-MSG-AREA DTSCS64 01689 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS64 01690 ELSE DTSCS64 01691 MOVE IFAN-EMP-NO TO WRK-EMP-NO DTSCS64 01692 END-IF DTSCS64 01693 PERFORM S821-END-BROWSE THRU S821-EXIT DTSCS64 01694 ELSE DTSCS64 01695 MOVE EMSG-NO-ASSIGNMENT TO WRK-MSG-AREA DTSCS64 01696 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS64 01697 END-IF. DTSCS64 01698 DTSCS64 01699 S1120-EXIT. DTSCS64 01700 EXIT. DTSCS64 01701 DTSCS64 01702 /*****************************************************************DTSCS64 01703 * DTSCS64 01704 ******************************************************************DTSCS64 01705 S1130-READ-MPRF. DTSCS64 01706 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS64 01707 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS64 01708 SET MPRF-PRF-88 TO TRUE. DTSCS64 01709 DTSCS64 01710 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS64 01711 DTSCS64 01712 PERFORM S810-READ THRU S810-EXIT. DTSCS64 01713 DTSCS64 01714 IF L810-NO-REC-88 DTSCS64 01715 MOVE WRK-EMP-NO TO MSG-EMP-NO-IN-ERR DTSCS64 01716 MOVE MSG-E645-AREA TO LCCM-MSG-AREA DTSCS64 01717 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS64 01718 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS64 01719 GO TO MAINLINE-EXIT DTSCS64 01720 ELSE DTSCS64 01721 MOVE MSKL-REC TO MPRF-REC DTSCS64 01722 SET WRK-MPRF-YES-88 TO TRUE DTSCS64 01723 END-IF. DTSCS64 01724 DTSCS64 01725 S1130-EXIT. DTSCS64 01726 EXIT. DTSCS64 01727 DTSCS64 01728 S1140-READ-MAUR. DTSCS64 01729 MOVE LOW-VALUES TO MAUR-KEY-AREA. DTSCS64 01730 MOVE WRK-EMP-NO TO MAUR-EMP-NO. DTSCS64 01731 SET MAUR-AUR-88 TO TRUE. DTSCS64 01732 MOVE WRK-ASSIGN-NO TO MAUR-ASSIGN-NO. DTSCS64 01733 MOVE MAUR-KEY-AREA TO MSKL-KEY-AREA. DTSCS64 01734 DTSCS64 01735 PERFORM S810-READ THRU S810-EXIT. DTSCS64 01736 DTSCS64 01737 IF L810-NO-REC-88 DTSCS64 01738 MOVE MSG-E642-AREA TO WRK-MSG-AREA DTSCS64 01739 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS64 01740 ELSE DTSCS64 01741 MOVE MSKL-REC TO MAUR-REC. DTSCS64 01742 S1140-EXIT. DTSCS64 01743 EXIT. DTSCS64 01744 DTSCS64 01745 S1199-ERROR. DTSCS64 01746 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-ASSIGN-NO-1-A DTSCS64 01747 MAP-ASSIGN-NO-2-A. DTSCS64 01748 IF LCCM-NO-MSG DTSCS64 01749 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS64 01750 MOVE CATB-CURSOR TO MAP-ASSIGN-NO-1-L DTSCS64 01751 SET CURSOR-SET-YES TO TRUE. DTSCS64 01752 S1199-EXIT. EXIT. DTSCS64 01753 DTSCS64 01754 /*****************************************************************DTSCS64 01755 * DTSCS64 01756 ******************************************************************DTSCS64 01757 S1200-CALENDAR-YEAR. DTSCS64 01758 MOVE 0 TO WRK-CALENDAR-YEAR. DTSCS64 01759 IF MAP-CALENDAR-YEAR = LOW-VALUES OR SPACES DTSCS64 01760 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS64 01761 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS64 01762 GO TO S1200-EXIT DTSCS64 01763 ELSE DTSCS64 01764 MOVE MAP-CALENDAR-YEAR TO L007-YR-2-X DTSCS64 01765 PERFORM S007-CAL-YEAR-EDIT THRU S007-EXIT DTSCS64 01766 IF L007-NOT-VALID-YR DTSCS64 01767 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS64 01768 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS64 01769 GO TO S1200-EXIT DTSCS64 01770 ELSE DTSCS64 01771 MOVE L007-YR-4-9 TO MAUY-CALENDAR-YEAR DTSCS64 01772 WRK-CALENDAR-YEAR DTSCS64 01773 END-IF. DTSCS64 01774 DTSCS64 01775 IF LCCM-F09-88 OR LCCM-F10-88 DTSCS64 01776 NEXT SENTENCE DTSCS64 01777 ELSE DTSCS64 01778 GO TO S1200-EXIT. DTSCS64 01779 DTSCS64 01780 ***** EVEN IF MAP-CALENDAR-YEAR WAS INVALID THIS SHOULD DTSCS64 01781 ****** STILL WORK MAUY-CALENDAR-YEAR SHOULD HAVE 0000 IN IT DTSCS64 01782 ****** AND MAUR BETTER HAVE BEEN READ. DTSCS64 01783 DTSCS64 01784 MOVE WRK-CALENDAR-YEAR TO WRK-QTR-1-YR. DTSCS64 01785 MOVE 1 TO WRK-QTR-1-Q. DTSCS64 01786 MOVE WRK-CALENDAR-YEAR TO WRK-QTR-2-YR. DTSCS64 01787 MOVE 4 TO WRK-QTR-2-Q. DTSCS64 01788 IF (WRK-YRQ-2 < MAUR-FIRST-YRQ) DTSCS64 01789 OR (WRK-YRQ-1 > MAUR-LAST-YRQ) DTSCS64 01790 MOVE MSG-E641-AREA TO WRK-MSG-AREA DTSCS64 01791 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS64 01792 END-IF. DTSCS64 01793 DTSCS64 01794 S1200-EXIT. DTSCS64 01795 EXIT. DTSCS64 01796 DTSCS64 01797 S1201-ERROR. DTSCS64 01798 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-CALENDAR-YEAR-A. DTSCS64 01799 IF LCCM-NO-MSG DTSCS64 01800 SET CURSOR-SET-YES TO TRUE DTSCS64 01801 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS64 01802 MOVE CATB-CURSOR TO MAP-CALENDAR-YEAR-L. DTSCS64 01803 S1201-EXIT. DTSCS64 01804 EXIT. DTSCS64 01805 /*****************************************************************DTSCS64 01806 * DTSCS64 01807 ******************************************************************DTSCS64 01808 DTSCS64 01809 S1300-GROSS-PAYROLL. DTSCS64 01810 SET MAUY-QTR-NOT-AUDITED-88 (WRK-OCC) TO TRUE. DTSCS64 01811 DTSCS64 01812 MOVE +0 TO MAUY-QTR-GROSS-PAYROLL (WRK-OCC). DTSCS64 01813 DTSCS64 01814 MOVE MAP-GROSS-PAYROLL-AREA (WRK-OCC) TO L011-S-AMT-AREA. DTSCS64 01815 PERFORM S011-MONEY-FROM-SCREEN THRU S011-EXIT. DTSCS64 01816 DTSCS64 01817 IF L011-NO-ENTRY DTSCS64 01818 GO TO S1300-EXIT. DTSCS64 01819 DTSCS64 01820 SET MAUY-QTR-AUDITED-88(WRK-OCC) TO TRUE. DTSCS64 01821 IF L011-NOT-VALID DTSCS64 01822 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS64 01823 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS64 01824 ELSE DTSCS64 01825 MOVE L011-AMT TO MAP-GROSS-PAYROLL-N (WRK-OCC) DTSCS64 01826 MAUY-QTR-GROSS-PAYROLL (WRK-OCC) DTSCS64 01827 END-IF. DTSCS64 01828 DTSCS64 01829 IF LCCM-F09-88 OR LCCM-F10-88 DTSCS64 01830 NEXT SENTENCE DTSCS64 01831 ELSE DTSCS64 01832 GO TO S1300-EXIT. DTSCS64 01833 DTSCS64 01834 ***** EVEN IF MAP-CALENDAR-YEAR WAS INVALID THIS SHOULD DTSCS64 01835 ****** STILL WORK MAUY-CALENDAR-YEAR SHOULD HAVE 0000 IN IT DTSCS64 01836 ****** AND MAUR BETTER HAVE BEEN READ. DTSCS64 01837 DTSCS64 01838 MOVE WRK-CALENDAR-YEAR TO WRK-QTR-1-YR. DTSCS64 01839 MOVE WRK-OCC TO WRK-QTR-1-Q. DTSCS64 01840 IF WRK-YRQ-1 < MAUR-FIRST-YRQ DTSCS64 01841 OR WRK-YRQ-1 > MAUR-LAST-YRQ DTSCS64 01842 MOVE MSG-E641-AREA TO WRK-MSG-AREA DTSCS64 01843 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS64 01844 END-IF. DTSCS64 01845 DTSCS64 01846 S1300-EXIT. DTSCS64 01847 EXIT. DTSCS64 01848 DTSCS64 01849 S1301-ERROR. DTSCS64 01850 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS64 01851 TO MAP-GROSS-PAYROLL-A(WRK-OCC). DTSCS64 01852 DTSCS64 01853 IF LCCM-NO-MSG DTSCS64 01854 SET CURSOR-SET-YES TO TRUE DTSCS64 01855 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS64 01856 MOVE CATB-CURSOR TO MAP-GROSS-PAYROLL-L(WRK-OCC). DTSCS64 01857 S1301-EXIT. DTSCS64 01858 EXIT. DTSCS64 01859 /*****************************************************************DTSCS64 01860 * DTSCS64 01861 ******************************************************************DTSCS64 01862 DTSCS64 01863 S1400-UNDER-TOT-WAGE. DTSCS64 01864 MOVE +0 TO MAUY-QTR-UNDER-TOT-WAGE(WRK-OCC). DTSCS64 01865 DTSCS64 01866 MOVE MAP-UNDER-TOT-WAGE-AREA (WRK-OCC) TO L011-S-AMT-AREA. DTSCS64 01867 PERFORM S011-MONEY-FROM-SCREEN THRU S011-EXIT. DTSCS64 01868 DTSCS64 01869 IF L011-NO-ENTRY DTSCS64 01870 NEXT SENTENCE DTSCS64 01871 ELSE DTSCS64 01872 IF L011-NOT-VALID DTSCS64 01873 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS64 01874 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS64 01875 ELSE DTSCS64 01876 IF MAUY-QTR-NOT-AUDITED-88(WRK-OCC) DTSCS64 01877 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS64 01878 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS64 01879 ELSE DTSCS64 01880 MOVE L011-AMT TO MAP-UNDER-TOT-WAGE-N (WRK-OCC) DTSCS64 01881 MAUY-QTR-UNDER-TOT-WAGE(WRK-OCC) DTSCS64 01882 END-IF. DTSCS64 01883 S1400-EXIT. DTSCS64 01884 EXIT. DTSCS64 01885 DTSCS64 01886 S1401-ERROR. DTSCS64 01887 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS64 01888 TO MAP-UNDER-TOT-WAGE-A(WRK-OCC). DTSCS64 01889 DTSCS64 01890 IF LCCM-NO-MSG DTSCS64 01891 SET CURSOR-SET-YES TO TRUE DTSCS64 01892 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS64 01893 MOVE CATB-CURSOR TO MAP-UNDER-TOT-WAGE-L(WRK-OCC).DTSCS64 01894 S1401-EXIT. DTSCS64 01895 EXIT. DTSCS64 01896 /*****************************************************************DTSCS64 01897 * DTSCS64 01898 ******************************************************************DTSCS64 01899 DTSCS64 01900 S1500-UNDER-TAX-WAGE. DTSCS64 01901 MOVE +0 TO MAUY-QTR-UNDER-TAX-WAGE(WRK-OCC). DTSCS64 01902 DTSCS64 01903 MOVE MAP-UNDER-TAX-WAGE-AREA (WRK-OCC) TO L011-S-AMT-AREA. DTSCS64 01904 PERFORM S011-MONEY-FROM-SCREEN THRU S011-EXIT. DTSCS64 01905 DTSCS64 01906 IF L011-NO-ENTRY DTSCS64 01907 NEXT SENTENCE DTSCS64 01908 ELSE DTSCS64 01909 IF L011-NOT-VALID DTSCS64 01910 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS64 01911 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS64 01912 ELSE DTSCS64 01913 IF MAUY-QTR-NOT-AUDITED-88(WRK-OCC) DTSCS64 01914 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS64 01915 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS64 01916 ELSE DTSCS64 01917 MOVE L011-AMT TO MAP-UNDER-TAX-WAGE-N (WRK-OCC) DTSCS64 01918 MAUY-QTR-UNDER-TAX-WAGE(WRK-OCC) DTSCS64 01919 END-IF. DTSCS64 01920 S1500-EXIT. DTSCS64 01921 EXIT. DTSCS64 01922 DTSCS64 01923 S1501-ERROR. DTSCS64 01924 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS64 01925 TO MAP-UNDER-TAX-WAGE-A(WRK-OCC). DTSCS64 01926 DTSCS64 01927 IF LCCM-NO-MSG DTSCS64 01928 SET CURSOR-SET-YES TO TRUE DTSCS64 01929 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS64 01930 MOVE CATB-CURSOR TO MAP-UNDER-TAX-WAGE-L(WRK-OCC).DTSCS64 01931 S1501-EXIT. DTSCS64 01932 EXIT. DTSCS64 01933 /*****************************************************************DTSCS64 01934 * DTSCS64 01935 ******************************************************************DTSCS64 01936 DTSCS64 01937 S1600-UNDER-CONTRIB. DTSCS64 01938 MOVE +0 TO MAUY-QTR-UNDER-CONTRIB(WRK-OCC). DTSCS64 01939 DTSCS64 01940 MOVE MAP-UNDER-CONTRIB-AREA (WRK-OCC) TO L011-S-AMT-AREA. DTSCS64 01941 PERFORM S011-MONEY-FROM-SCREEN THRU S011-EXIT. DTSCS64 01942 DTSCS64 01943 IF L011-NO-ENTRY DTSCS64 01944 NEXT SENTENCE DTSCS64 01945 ELSE DTSCS64 01946 IF L011-NOT-VALID DTSCS64 01947 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS64 01948 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS64 01949 ELSE DTSCS64 01950 IF MAUY-QTR-NOT-AUDITED-88 (WRK-OCC) DTSCS64 01951 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS64 01952 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS64 01953 ELSE DTSCS64 01954 MOVE L011-AMT TO MAP-UNDER-CONTRIB-N (WRK-OCC) DTSCS64 01955 MAUY-QTR-UNDER-CONTRIB (WRK-OCC) DTSCS64 01956 END-IF. DTSCS64 01957 S1600-EXIT. DTSCS64 01958 EXIT. DTSCS64 01959 DTSCS64 01960 S1601-ERROR. DTSCS64 01961 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS64 01962 TO MAP-UNDER-CONTRIB-A(WRK-OCC). DTSCS64 01963 DTSCS64 01964 IF LCCM-NO-MSG DTSCS64 01965 SET CURSOR-SET-YES TO TRUE DTSCS64 01966 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS64 01967 MOVE CATB-CURSOR TO MAP-UNDER-CONTRIB-L(WRK-OCC). DTSCS64 01968 S1601-EXIT. DTSCS64 01969 EXIT. DTSCS64 01970 /*****************************************************************DTSCS64 01971 * DTSCS64 01972 ******************************************************************DTSCS64 01973 DTSCS64 01974 S1700-OVER-TOT-WAGE. DTSCS64 01975 MOVE +0 TO MAUY-QTR-OVER-TOT-WAGE(WRK-OCC). DTSCS64 01976 DTSCS64 01977 MOVE MAP-OVER-TOT-WAGE-AREA (WRK-OCC) TO L011-S-AMT-AREA. DTSCS64 01978 PERFORM S011-MONEY-FROM-SCREEN THRU S011-EXIT. DTSCS64 01979 DTSCS64 01980 IF L011-NO-ENTRY DTSCS64 01981 NEXT SENTENCE DTSCS64 01982 ELSE DTSCS64 01983 IF L011-NOT-VALID DTSCS64 01984 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS64 01985 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS64 01986 ELSE DTSCS64 01987 IF MAUY-QTR-NOT-AUDITED-88(WRK-OCC) DTSCS64 01988 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS64 01989 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS64 01990 ELSE DTSCS64 01991 MOVE L011-AMT TO MAP-OVER-TOT-WAGE-N (WRK-OCC) DTSCS64 01992 MAUY-QTR-OVER-TOT-WAGE(WRK-OCC) DTSCS64 01993 END-IF. DTSCS64 01994 S1700-EXIT. DTSCS64 01995 EXIT. DTSCS64 01996 DTSCS64 01997 S1701-ERROR. DTSCS64 01998 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS64 01999 TO MAP-OVER-TOT-WAGE-A(WRK-OCC). DTSCS64 02000 DTSCS64 02001 IF LCCM-NO-MSG DTSCS64 02002 SET CURSOR-SET-YES TO TRUE DTSCS64 02003 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS64 02004 MOVE CATB-CURSOR TO MAP-OVER-TOT-WAGE-L(WRK-OCC). DTSCS64 02005 S1701-EXIT. DTSCS64 02006 EXIT. DTSCS64 02007 /*****************************************************************DTSCS64 02008 * DTSCS64 02009 ******************************************************************DTSCS64 02010 DTSCS64 02011 S1800-OVER-TAX-WAGE. DTSCS64 02012 MOVE +0 TO MAUY-QTR-OVER-TAX-WAGE(WRK-OCC). DTSCS64 02013 DTSCS64 02014 MOVE MAP-OVER-TAX-WAGE-AREA (WRK-OCC) TO L011-S-AMT-AREA. DTSCS64 02015 PERFORM S011-MONEY-FROM-SCREEN THRU S011-EXIT. DTSCS64 02016 DTSCS64 02017 IF L011-NO-ENTRY DTSCS64 02018 NEXT SENTENCE DTSCS64 02019 ELSE DTSCS64 02020 IF L011-NOT-VALID DTSCS64 02021 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS64 02022 PERFORM S1801-ERROR THRU S1801-EXIT DTSCS64 02023 ELSE DTSCS64 02024 IF MAUY-QTR-NOT-AUDITED-88(WRK-OCC) DTSCS64 02025 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS64 02026 PERFORM S1801-ERROR THRU S1801-EXIT DTSCS64 02027 ELSE DTSCS64 02028 MOVE L011-AMT TO MAP-OVER-TAX-WAGE-N (WRK-OCC) DTSCS64 02029 MAUY-QTR-OVER-TAX-WAGE(WRK-OCC) DTSCS64 02030 END-IF. DTSCS64 02031 S1800-EXIT. DTSCS64 02032 EXIT. DTSCS64 02033 DTSCS64 02034 S1801-ERROR. DTSCS64 02035 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS64 02036 TO MAP-OVER-TAX-WAGE-A(WRK-OCC). DTSCS64 02037 DTSCS64 02038 IF LCCM-NO-MSG DTSCS64 02039 SET CURSOR-SET-YES TO TRUE DTSCS64 02040 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS64 02041 MOVE CATB-CURSOR TO MAP-OVER-TAX-WAGE-L(WRK-OCC). DTSCS64 02042 S1801-EXIT. DTSCS64 02043 EXIT. DTSCS64 02044 /*****************************************************************DTSCS64 02045 * DTSCS64 02046 ******************************************************************DTSCS64 02047 DTSCS64 02048 S1900-OVER-CONTRIB. DTSCS64 02049 MOVE +0 TO MAUY-QTR-OVER-CONTRIB(WRK-OCC). DTSCS64 02050 DTSCS64 02051 MOVE MAP-OVER-CONTRIB-AREA (WRK-OCC) TO L011-S-AMT-AREA. DTSCS64 02052 PERFORM S011-MONEY-FROM-SCREEN THRU S011-EXIT. DTSCS64 02053 DTSCS64 02054 IF L011-NO-ENTRY DTSCS64 02055 NEXT SENTENCE DTSCS64 02056 ELSE DTSCS64 02057 IF L011-NOT-VALID DTSCS64 02058 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS64 02059 PERFORM S1901-ERROR THRU S1901-EXIT DTSCS64 02060 ELSE DTSCS64 02061 IF MAUY-QTR-NOT-AUDITED-88(WRK-OCC) DTSCS64 02062 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS64 02063 PERFORM S1901-ERROR THRU S1901-EXIT DTSCS64 02064 ELSE DTSCS64 02065 MOVE L011-AMT TO MAP-OVER-CONTRIB-N (WRK-OCC) DTSCS64 02066 MAUY-QTR-OVER-CONTRIB(WRK-OCC) DTSCS64 02067 END-IF. DTSCS64 02068 S1900-EXIT. DTSCS64 02069 EXIT. DTSCS64 02070 DTSCS64 02071 S1901-ERROR. DTSCS64 02072 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS64 02073 TO MAP-OVER-CONTRIB-A(WRK-OCC). DTSCS64 02074 DTSCS64 02075 IF LCCM-NO-MSG DTSCS64 02076 SET CURSOR-SET-YES TO TRUE DTSCS64 02077 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS64 02078 MOVE CATB-CURSOR TO MAP-OVER-CONTRIB-L(WRK-OCC). DTSCS64 02079 S1901-EXIT. DTSCS64 02080 EXIT. DTSCS64 02081 /*****************************************************************DTSCS64 02082 * DTSCS64 02083 ******************************************************************DTSCS64 02084 S2000-MISC-EDITS. DTSCS64 02085 IF LCCM-F09-88 DTSCS64 02086 PERFORM S2010-COUNT-YEARS THRU S2010-EXIT DTSCS64 02087 PERFORM S2020-CHECK-DUPE THRU S2020-EXIT DTSCS64 02088 END-IF. DTSCS64 02089 S2000-EXIT. DTSCS64 02090 EXIT. DTSCS64 02091 DTSCS64 02092 DTSCS64 02093 S2010-COUNT-YEARS. DTSCS64 02094 MOVE LOW-VALUES TO MAUY-KEY-AREA. DTSCS64 02095 MOVE WRK-EMP-NO TO MAUY-EMP-NO. DTSCS64 02096 SET MAUY-AUY-88 TO TRUE. DTSCS64 02097 MOVE WRK-ASSIGN-NO TO MAUY-ASSIGN-NO. DTSCS64 02098 MOVE MAUY-KEY-AREA TO MSKL-KEY-AREA. DTSCS64 02099 PERFORM S810-COUNT THRU S810-EXIT. DTSCS64 02100 DTSCS64 02101 MOVE L810-RECORD-CNT TO LAST-REC-NUM. DTSCS64 02102 IF L810-NO-REC-88 DTSCS64 02103 MOVE LOW-VALUE TO LAST-REC-KEY-AREA DTSCS64 02104 ELSE DTSCS64 02105 MOVE MSKL-KEY-AREA TO LAST-REC-KEY-AREA. DTSCS64 02106 DTSCS64 02107 IF L810-RECORD-CNT > 5 DTSCS64 02108 MOVE MSG-E644-AREA TO WRK-MSG-AREA DTSCS64 02109 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS64 02110 END-IF. DTSCS64 02111 S2010-EXIT. DTSCS64 02112 EXIT. DTSCS64 02113 DTSCS64 02114 S2020-CHECK-DUPE. DTSCS64 02115 MOVE WRK-EMP-NO TO MAUY-EMP-NO. DTSCS64 02116 SET MAUY-AUY-88 TO TRUE. DTSCS64 02117 MOVE WRK-ASSIGN-NO TO MAUY-ASSIGN-NO. DTSCS64 02118 MOVE WRK-CALENDAR-YEAR TO MAUY-CALENDAR-YEAR. DTSCS64 02119 MOVE LOW-VALUES TO MAUY-KEY-FILLER. DTSCS64 02120 MOVE MAUY-KEY-AREA TO MSKL-KEY-AREA. DTSCS64 02121 PERFORM S810-READ THRU S810-EXIT. DTSCS64 02122 IF L810-OK-88 DTSCS64 02123 MOVE EMSG-RECORD-EXISTS TO WRK-MSG-AREA DTSCS64 02124 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS64 02125 END-IF. DTSCS64 02126 S2020-EXIT. DTSCS64 02127 EXIT. DTSCS64 02128 /*****************************************************************DTSCS64 02129 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCS64 02130 ******************************************************************DTSCS64 02131 S5100-SET-LOCK-ATTRB. DTSCS64 02132 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS64 02133 WRK-ATB-NUM. DTSCS64 02134 DTSCS64 02135 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS64 02136 DTSCS64 02137 MOVE CATB-ASKIP-BRT-MDTON TO MAP-ASSIGN-NO-1-A DTSCS64 02138 MAP-ASSIGN-NO-2-A DTSCS64 02139 MAP-GOTO-A. DTSCS64 02140 S5100-EXIT. DTSCS64 02141 EXIT. DTSCS64 02142 DTSCS64 02143 ******************************************************************DTSCS64 02144 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS64 02145 ******************************************************************DTSCS64 02146 S5200-SET-UPDATE-ATTRB. DTSCS64 02147 MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN. DTSCS64 02148 MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM. DTSCS64 02149 DTSCS64 02150 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS64 02151 DTSCS64 02152 DTSCS64 02153 ***** DTSCS64 02154 * CALLENDAR-YEAR ATTRIBUTE BYTE TRICKS. DTSCS64 02155 * DTSCS64 02156 ***** DTSCS64 02157 DTSCS64 02158 IF LCCM-SCR-INQUIRE DTSCS64 02159 MOVE CATB-ASKIP-BRT-MDTON TO MAP-CALENDAR-YEAR-A. DTSCS64 02160 S5200-EXIT. DTSCS64 02161 EXIT. DTSCS64 02162 DTSCS64 02163 ******************************************************************DTSCS64 02164 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS64 02165 ******************************************************************DTSCS64 02166 S5300-SET-INQ-ATTRB. DTSCS64 02167 MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN DTSCS64 02168 WRK-ATB-NUM. DTSCS64 02169 DTSCS64 02170 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS64 02171 S5300-EXIT. DTSCS64 02172 EXIT. DTSCS64 02173 DTSCS64 02174 S5900-SET-ATTRB. DTSCS64 02175 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-ASSIGN-NO-1-A DTSCS64 02176 MAP-ASSIGN-NO-2-A. DTSCS64 02177 DTSCS64 02178 MOVE WRK-ATB-NUM TO MAP-CALENDAR-YEAR-A. DTSCS64 02179 DTSCS64 02180 PERFORM VARYING WRK-OCC DTSCS64 02181 FROM 1 BY 1 DTSCS64 02182 UNTIL WRK-OCC > MMAX-AUY-QTR-MAX DTSCS64 02183 MOVE WRK-ATB-NUM TO DTSCS64 02184 MAP-GROSS-PAYROLL-A (WRK-OCC) DTSCS64 02185 MAP-UNDER-TOT-WAGE-A (WRK-OCC) DTSCS64 02186 MAP-UNDER-TAX-WAGE-A (WRK-OCC) DTSCS64 02187 MAP-UNDER-CONTRIB-A (WRK-OCC) DTSCS64 02188 MAP-OVER-TOT-WAGE-A (WRK-OCC) DTSCS64 02189 MAP-OVER-TAX-WAGE-A (WRK-OCC) DTSCS64 02190 MAP-OVER-CONTRIB-A (WRK-OCC) DTSCS64 02191 END-PERFORM. DTSCS64 02192 DTSCS64 02193 MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-NO-1-A DTSCS64 02194 MAP-EMP-NO-2-A DTSCS64 02195 MAP-PRIMARY-NAME-A DTSCS64 02196 MAP-CURR-PAGE-A DTSCS64 02197 MAP-LAST-PAGE-A. DTSCS64 02198 DTSCS64 02199 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS64 02200 S5900-EXIT. DTSCS64 02201 EXIT. DTSCS64 02202 EJECT DTSCS64 02203 /*****************************************************************DTSCS64 02204 * MAP ROUTINES *DTSCS64 02205 ******************************************************************DTSCS64 02206 S9100-RECEIVE. DTSCS64 02207 SET L851-RECEIVE-88 TO TRUE. DTSCS64 02208 DTSCS64 02209 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS64 02210 DTSCS64 02211 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS64 02212 DTSCS64 02213 MOVE L851-AID TO LCCM-AID. DTSCS64 02214 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS64 02215 S9100-EXIT. DTSCS64 02216 EXIT. DTSCS64 02217 DTSCS64 02218 S9200-SEND-DATAONLY. DTSCS64 02219 MOVE LOW-VALUES TO MAP-AREA. DTSCS64 02220 DTSCS64 02221 IF LCCM-NO-MSG DTSCS64 02222 NEXT SENTENCE DTSCS64 02223 ELSE DTSCS64 02224 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS64 02225 DTSCS64 02226 IF CURSOR-SET-GOTO DTSCS64 02227 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS64 02228 ELSE DTSCS64 02229 MOVE CATB-CURSOR TO MAP-ASSIGN-NO-1-L. DTSCS64 02230 DTSCS64 02231 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS64 02232 DTSCS64 02233 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS64 02234 DTSCS64 02235 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS64 02236 S9200-EXIT. DTSCS64 02237 EXIT. DTSCS64 02238 DTSCS64 02239 S9300-SEND-MAP. DTSCS64 02240 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS64 02241 MOVE SPACES TO MAP-SYS-TIME. DTSCS64 02242 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS64 02243 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS64 02244 DTSCS64 02245 IF SCR-ACCESS-UPDATE DTSCS64 02246 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS64 02247 ELSE DTSCS64 02248 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS64 02249 DTSCS64 02250 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCS64 02251 DTSCS64 02252 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS64 02253 DTSCS64 02254 IF CURSOR-SET-NO DTSCS64 02255 MOVE CATB-CURSOR TO MAP-ASSIGN-NO-1-L. DTSCS64 02256 DTSCS64 02257 SET L851-SEND-88 TO TRUE. DTSCS64 02258 DTSCS64 02259 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS64 02260 DTSCS64 02261 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS64 02262 S9300-EXIT. DTSCS64 02263 EXIT. DTSCS64 02264 DTSCS64 02265 S9310-UPDATE-FKEYS. DTSCS64 02266 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS64 02267 DTSCS64 02268 DTSCS64 02269 IF LCCM-SCR-CLEAR DTSCS64 02270 MOVE CFKD-ADD TO MAP-KEY-ADD DTSCS64 02271 ELSE DTSCS64 02272 IF LCCM-SCR-INQUIRE DTSCS64 02273 MOVE CFKD-MOD TO MAP-KEY-MOD DTSCS64 02274 MOVE CFKD-DEL TO MAP-KEY-DEL DTSCS64 02275 ELSE DTSCS64 02276 IF LCCM-SCR-UPDATE-LOCKED DTSCS64 02277 MOVE LOW-VALUES TO MAP-KEY-FIRST DTSCS64 02278 MAP-KEY-LAST DTSCS64 02279 MAP-KEY-BACK DTSCS64 02280 MAP-KEY-FWRD. DTSCS64 02281 S9310-EXIT. DTSCS64 02282 EXIT. DTSCS64 02283 DTSCS64 02284 S9320-INQUIRY-FKEYS. DTSCS64 02285 MOVE CFKD-FIRST TO MAP-KEY-FIRST. DTSCS64 02286 MOVE CFKD-LAST TO MAP-KEY-LAST. DTSCS64 02287 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS64 02288 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS64 02289 DTSCS64 02290 MOVE LOW-VALUES TO MAP-KEY-ADD DTSCS64 02291 MAP-KEY-MOD DTSCS64 02292 MAP-KEY-DEL. DTSCS64 02293 DTSCS64 02294 * PERFORM S9321-JUMP-KEYS THRU S9321-EXIT. DTSCS64 02295 S9320-EXIT. DTSCS64 02296 EXIT. DTSCS64 02297 DTSCS64 02298 *S9321-JUMP-KEYS. DTSCS64 02299 * MOVE CFKD-REG-INQ TO MAP-KEY-REG-INQ. DTSCS64 02300 * MOVE CFKD-ASSIGN TO MAP-KEY-ASSIGN. DTSCS64 02301 * MOVE CFKD-AUDIT-RSLT-22 TO MAP-KEY-AUDIT-RSLT. DTSCS64 02302 *S9321-EXIT. DTSCS64 02303 * EXIT. DTSCS64 02304 * DTSCS64 02305 S9330-DSCR-FIELDS. DTSCS64 02306 IF WRK-MPRF-YES-88 DTSCS64 02307 MOVE WRK-EMP-NO TO WRK-DISPLAY DTSCS64 02308 MOVE WRK-DISPLAY-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS64 02309 MOVE WRK-DISPLAY-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS64 02310 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME. DTSCS64 02311 DTSCS64 02312 S9330-EXIT. EXIT. DTSCS64 02313 DTSCS64 02314 S9900-PREPARE-SEND. DTSCS64 02315 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS64 02316 LCCM-SCR-ID. DTSCS64 02317 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS64 02318 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS64 02319 S9900-EXIT. DTSCS64 02320 EXIT. DTSCS64