00001 IDENTIFICATION DIVISION. 08/13/98 00002 PROGRAM-ID. DTSCS81. DTSCS81 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV005 00004 DATE-WRITTEN. APRIL 1994. DTSCS81 00005 DATE-COMPILED. DTSCS81 00006 SKIP3 DTSCS81 00007 ***** DTSCS81 00008 * DTSCS81 00009 * FUNCTION: CALENDAR YEAR INQUIRY/UPDATE DTSCS81 00010 * SCREEN PROCESSOR. DTSCS81 00011 * DTSCS81 00012 * DTSCS81 00013 * MODIFICATION LOG: DTSCS81 00014 * DTSCS81 00015 * 04/20/94 INITIAL DEVELOPMENT. DTSCS81 00016 * WORK ORDER: PROGRAMMER: RHC DTSCS81 00017 * DTSCS81 00018 * 08/01/97 MODIFY LOGIC TO ALLOW DELETE FUNCTION TO BE DTSCS81 00019 * PERFORMED USING FUNCTION KEY 23 INSTEAD OF 11. DTSCS81 00020 * REFERENCE RFP: TCL 096 PROGRAMMER: FLS DTSCS81 00021 * DTSCS81 00022 * 08/13/1998 REVIEWED AND MODIFIED FOR DC. CL**2 00023 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH CL**2 00024 * CL**2 00025 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2 00026 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2 00027 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX CL**2 00028 * DTSCS81 00029 * DTSCS81 00030 * DESCRIPTION: DTSCS81 00031 * DTSCS81 00032 * CLEAR: DTSCS81 00033 * DTSCS81 00034 * DATA FIELDS DISPLAYED: NONE. DTSCS81 00035 * MESSAGE: NONE (OTHER THAN "DELETE SUCCESSFUL"). DTSCS81 00036 * MOVE LOW-VALUES TO LCCM-SCR-KEY-AREA. DTSCS81 00037 * DTSCS81 00038 * DTSCS81 00039 * INQUIRY: DTSCS81 00040 * DTSCS81 00041 * CONTROL FIELD(S): MAP-YR. DTSCS81 00042 * DTSCS81 00043 * JUMP IN: USE CLEAR LOGIC. DTSCS81 00044 * DTSCS81 00045 * ENTER: DISPLAY FCYR RECORD ASSOCIATED WITH MAP-YR. DTSCS81 00046 * DTSCS81 00047 * PRIOR: STANDARD PAGING LOGIC, EXCEPT BASED ON USER DTSCS81 00048 * MODIFICATION TO MAP-YR (RATHER THAN EMP-NO). DTSCS81 00049 * DTSCS81 00050 * NEXT: STANDARD PAGING LOGIC, EXCEPT BASED ON USER DTSCS81 00051 * MODIFICATION TO MAP-YR (RATHER THAN EMP-NO). DTSCS81 00052 * DTSCS81 00053 * WHILE PAGING, CONSIDER THE BREAK TO BE A BREAK IN REC-TYPE.DTSCS81 00054 * DO NOT "WRAP" PAGING. DTSCS81 00055 * DTSCS81 00056 * A SUCCESSFUL DISPLAY RESULTS IN STORAGE OF THE DTSCS81 00057 * FCYR-KEY-AREA OF THE DISPLAYED FCYR RECORD IN DTSCS81 00058 * LCCM-SCR-KEY-AREA. DTSCS81 00059 * DTSCS81 00060 * DTSCS81 00061 * UPDATE: DTSCS81 00062 * DTSCS81 00063 * ADD DTSCS81 00064 * MOD DTSCS81 00065 * DEL DTSCS81 00066 * DTSCS81 00067 * DTSCS81 00068 * RECORDS READ: DTSCS81 00069 * DTSCS81 00070 * MASTER: DTSCS81 00071 * DTSCS81 00072 * NONE. DTSCS81 00073 * DTSCS81 00074 * DTSCS81 00075 * ALTERNATE INDEX: DTSCS81 00076 * DTSCS81 00077 * NONE. DTSCS81 00078 * DTSCS81 00079 * DTSCS81 00080 * REFERENCE: DTSCS81 00081 * DTSCS81 00082 * FCYR. DTSCS81 00083 * DTSCS81 00084 * DTSCS81 00085 * ACCOUNTING TRANSACTION COLLECTION: DTSCS81 00086 * DTSCS81 00087 * NONE. DTSCS81 00088 * DTSCS81 00089 * DTSCS81 00090 * RECORDS UPDATED: DTSCS81 00091 * DTSCS81 00092 * MASTER: DTSCS81 00093 * DTSCS81 00094 * NONE. DTSCS81 00095 * DTSCS81 00096 * DTSCS81 00097 * REFERENCE: DTSCS81 00098 * DTSCS81 00099 * FCYR (ADD, MOD, DEL). DTSCS81 00100 * DTSCS81 00101 * DTSCS81 00102 * ACCOUNTING TRANSACTION COLLECTION: DTSCS81 00103 * DTSCS81 00104 * NONE. DTSCS81 00105 * DTSCS81 00106 * DTSCS81 00107 * ON-LINE EVENT FILE RECORDS WRITTEN: DTSCS81 00108 * DTSCS81 00109 * NONE. DTSCS81 00110 * DTSCS81 00111 * DTSCS81 00112 * MODULES (OTHER THAN STANDARD SCREEN PROCESSING DTSCS81 00113 * UTILITY MODULES) LINKED TO: DTSCS81 00114 * DTSCS81 00115 * DTSCU001 DATE EDIT/CONVERSION. CL**2 00116 * DTSCU007 CALENDAR YEAR EDIT/CONVERSION. CL**2 00117 * DTSCU011 AMOUNT FROM SCREEN FORMAT/EDIT. CL**2 00118 * DTSCU012 RATE FROM SCREEN FORMAT/EDIT. CL**2 00119 * DTSCU056 RATE DISPLAY. CL**2 00120 * DTSCU831 REFERENCE FILE I/O. CL**2 00121 * DTSCS81 00122 * DTSCS81 00123 * MAINTENANCE NOTES: DTSCS81 00124 * DTSCS81 00125 * A NON-KEY FIELD ADDED TO OR REMOVED FROM THE SCREEN DTSCS81 00126 * REQUIRES ATTENTION IN THE FOLLOWING AREAS: DTSCS81 00127 * ALTER PARAGRAPHS P6900, P8900, S5900, DTSCS81 00128 * ALTER AS APPROPRIATE PARAGRAPHS LISTED IN S1000, DTSCS81 00129 * ALTER THE SEND/RECEIVE AREA DEFINITION (DTSIS81), CL**2 00130 * ALTER THE MAP (DTSM81) AND ASSEMBLE THE MAPSET (DTSMSET). CL**2 00131 * DTSCS81 00132 ***** DTSCS81 00133 SKIP3 DTSCS81 00134 ENVIRONMENT DIVISION. DTSCS81 00135 SKIP3 DTSCS81 00136 DATA DIVISION. DTSCS81 00137 SKIP3 DTSCS81 00138 WORKING-STORAGE SECTION. DTSCS81 001385 77 PAN-VALET PICTURE X(24) VALUE '005DTSCS81 08/13/98'. DTSCS81 00139 SKIP3 DTSCS81 00140 01 WRK-AREA. DTSCS81 00141 05 WRK-ABEND-CD PIC X(04) VALUE 'S81 '. DTSCS81 00142 CL**2 00143 05 WRK-SCR-ID. DTSCS81 00144 10 WRK-SCR-ID-9 PIC 9(02) VALUE 81. DTSCS81 00145 05 WRK-F03-SCR-ID PIC X(02) VALUE '80'. DTSCS81 00146 SKIP3 DTSCS81 00147 05 SCR-ACCESS-IND PIC X(01). DTSCS81 00148 88 SCR-ACCESS-INQ VALUE '1'. DTSCS81 00149 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS81 00150 CL**2 00151 05 CURSOR-SET-IND PIC X(01). DTSCS81 00152 88 CURSOR-SET-YES VALUE 'Y'. DTSCS81 00153 88 CURSOR-SET-NO VALUE 'N'. DTSCS81 00154 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS81 00155 CL**2 00156 05 REQ-IND PIC X(01). DTSCS81 00157 88 REQ-ERROR VALUE 'O'. DTSCS81 00158 88 REQ-JUMP VALUE 'J'. DTSCS81 00159 88 REQ-INQUIRE VALUE 'I'. DTSCS81 00160 88 REQ-CLEAR VALUE 'C'. DTSCS81 00161 88 REQ-EDIT VALUE 'E'. DTSCS81 00162 88 REQ-UPDATE VALUE 'U'. DTSCS81 00163 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS81 00164 CL**2 00165 05 RESP-IND PIC X(01). DTSCS81 00166 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS81 00167 88 RESP-SEND-MAP VALUE 'M'. DTSCS81 00168 88 RESP-JUMP VALUE 'J'. DTSCS81 00169 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS81 00170 CL**2 00171 05 WRK-KEY-AREA. DTSCS81 00172 10 WRK-REC-TYPE PIC S9(04) COMP. DTSCS81 00173 10 WRK-YR PIC S9(05) COMP-3. DTSCS81 00174 10 FILLER PIC X(11). DTSCS81 00175 CL**2 00176 05 WRK-NEW-KEY-IND PIC X(01). DTSCS81 00177 CL**2 00178 05 WRK-MSG-ID PIC X(04). DTSCS81 00179 CL**2 00180 05 WRK-ATB-AN PIC X(01). CL**4 00181 05 WRK-ATB-NUM PIC X(01). DTSCS81 00182 CL**2 00183 05 WRK-DISP-DATE PIC 9(08). DTSCS81 00184 05 FILLER REDEFINES WRK-DISP-DATE. DTSCS81 00185 10 WRK-DISP-CC PIC X(02). DTSCS81 00186 10 WRK-DISP-YY PIC X(02). DTSCS81 00187 10 WRK-DISP-MM PIC X(02). DTSCS81 00188 10 WRK-DISP-DD PIC X(02). DTSCS81 00189 EJECT DTSCS81 00190 01 L001-COMM-AREA. DTSCS81 00191 ++INCLUDE DTSIL001 CL**3 00192 EJECT DTSCS81 00193 01 L007-COMM-AREA. DTSCS81 00194 ++INCLUDE DTSIL007 CL**3 00195 EJECT DTSCS81 00196 01 L011-COMM-AREA. DTSCS81 00197 ++INCLUDE DTSIL011 CL**3 00198 EJECT DTSCS81 00199 01 L012-COMM-AREA. DTSCS81 00200 ++INCLUDE DTSIL012 CL**3 00201 EJECT DTSCS81 00202 01 L056-COMM-AREA. DTSCS81 00203 ++INCLUDE DTSIL056 CL**3 00204 EJECT DTSCS81 00205 * ERROR MSG MODULE DTSCS81 00206 01 L805-COMM-AREA. DTSCS81 00207 ++INCLUDE DTSIL805 CL**3 00208 EJECT DTSCS81 00209 * REFERENCE FILE I-O LINKAGE DTSCS81 00210 01 L831-COMM-AREA. DTSCS81 00211 05 L831-CONTROL-BLOCK. DTSCS81 00212 ++INCLUDE DTSIL831 CL**5 00213 EJECT DTSCS81 00214 * COMMON SKELETAL RECORD DTSCS81 00215 05 FCOMM-REC. DTSCS81 00216 ++INCLUDE DTSIFSKL CL**5 00217 EJECT DTSCS81 00218 * CALENDAR YEAR RECORD LAYOUT DTSCS81 00219 05 FCYR-REC REDEFINES FCOMM-REC. DTSCS81 00220 ++INCLUDE DTSIFCYR CL**5 00221 EJECT DTSCS81 00222 * MAP DEFINITION DTSCS81 00223 01 L851-COMM-AREA. DTSCS81 00224 ++INCLUDE DTSIL851 CL**3 00225 SKIP3 DTSCS81 00226 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS81 00227 ++INCLUDE DTSIS81 CL**3 00228 EJECT DTSCS81 00229 * ATTRIBUTE LITERALS DTSCS81 00230 01 CATB-LITERALS. DTSCS81 00231 ++INCLUDE DTSICATB CL**3 00232 SKIP3 DTSCS81 00233 * FUNCTION KEY DESCRIPTION LITERALS DTSCS81 00234 01 CFKD-LITERALS. DTSCS81 00235 ++INCLUDE DTSICFKD CL**3 00236 SKIP3 DTSCS81 00237 * ERROR CODE MESSAGE LITERALS DTSCS81 00238 01 CECD-LITERALS. DTSCS81 00239 ++INCLUDE DTSICECD CL**3 00240 SKIP3 DTSCS81 00241 * PROMPT CODE MESSAGE LITERALS DTSCS81 00242 01 CPCD-LITERALS. DTSCS81 00243 ++INCLUDE DTSICPCD CL**3 00244 EJECT DTSCS81 00245 LINKAGE SECTION. DTSCS81 00246 SKIP3 DTSCS81 00247 01 DFHCOMMAREA. DTSCS81 00248 ++INCLUDE DTSILCCM CL**3 00249 SKIP3 DTSCS81 00250 15 FILLER REDEFINES LCCM-SCR-HOLD-AREA. DTSCS81 00251 20 LCCM-SCR-KEY-AREA PIC X(16). DTSCS81 00252 EJECT DTSCS81 00253 ******************************************************************DTSCS81 00254 * *DTSCS81 00255 ******************************************************************DTSCS81 00256 CL**2 00257 PROCEDURE DIVISION. DTSCS81 00258 SKIP2 DTSCS81 00259 SET CURSOR-SET-NO TO TRUE. DTSCS81 00260 CL**2 00261 MOVE LOW-VALUES TO MAP-AREA. DTSCS81 00262 CL**2 00263 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-9) DTSCS81 00264 TO SCR-ACCESS-IND. DTSCS81 00265 SKIP3 DTSCS81 00266 MOVE SPACE TO REQ-IND. DTSCS81 00267 CL**2 00268 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS81 00269 CL**2 00270 *----------------------------------------------------- DTSCS81 00271 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS81 00272 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS81 00273 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS81 00274 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS81 00275 * DTSCS81 00276 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS81 00277 * PROCESSED. DTSCS81 00278 * DTSCS81 00279 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS81 00280 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS81 00281 * WORK STATION OPERATOR. DTSCS81 00282 *----------------------------------------------------- DTSCS81 00283 CL**2 00284 MOVE SPACE TO RESP-IND. DTSCS81 00285 CL**2 00286 IF REQ-ERROR DTSCS81 00287 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS81 00288 ELSE DTSCS81 00289 IF REQ-JUMP DTSCS81 00290 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS81 00291 ELSE DTSCS81 00292 IF REQ-CLEAR DTSCS81 00293 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS81 00294 ELSE DTSCS81 00295 IF REQ-CURSOR-TO-GOTO DTSCS81 00296 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS81 00297 ELSE DTSCS81 00298 IF REQ-INQUIRE DTSCS81 00299 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS81 00300 ELSE DTSCS81 00301 IF REQ-EDIT DTSCS81 00302 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS81 00303 ELSE DTSCS81 00304 IF REQ-UPDATE DTSCS81 00305 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS81 00306 ELSE DTSCS81 00307 PERFORM S899-ABEND THRU S899-EXIT. DTSCS81 00308 SKIP3 DTSCS81 00309 *----------------------------------------------------- DTSCS81 00310 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS81 00311 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS81 00312 *----------------------------------------------------- DTSCS81 00313 CL**2 00314 IF RESP-SEND-MAP DTSCS81 00315 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS81 00316 SET LCCM-END-TASK-88 TO TRUE DTSCS81 00317 ELSE DTSCS81 00318 IF RESP-SEND-MSGONLY DTSCS81 00319 OR RESP-CURSOR-TO-GOTO DTSCS81 00320 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS81 00321 SET LCCM-END-TASK-88 TO TRUE DTSCS81 00322 ELSE DTSCS81 00323 IF RESP-JUMP DTSCS81 00324 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS81 00325 ELSE DTSCS81 00326 PERFORM S899-ABEND THRU S899-EXIT. DTSCS81 00327 SKIP3 DTSCS81 00328 MAINLINE-EXIT. DTSCS81 00329 CL**2 00330 EXEC CICS DTSCS81 00331 RETURN DTSCS81 00332 END-EXEC. DTSCS81 00333 SKIP2 DTSCS81 00334 GOBACK. DTSCS81 00335 /*****************************************************************DTSCS81 00336 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS81 00337 ******************************************************************DTSCS81 00338 P1000-ANALYZE-REQUEST. DTSCS81 00339 CL**2 00340 *----------------------------------------------------- DTSCS81 00341 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS81 00342 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS81 00343 * REPLACED WITH ENTER) DTSCS81 00344 *----------------------------------------------------- DTSCS81 00345 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS81 00346 SET LCCM-ENTER-88 TO TRUE DTSCS81 00347 SET REQ-CLEAR TO TRUE DTSCS81 00348 GO TO P1000-EXIT. DTSCS81 00349 SKIP3 DTSCS81 00350 *----------------------------------------------------- DTSCS81 00351 * MAP IS RECEIVED DTSCS81 00352 *----------------------------------------------------- DTSCS81 00353 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS81 00354 SKIP3 DTSCS81 00355 *----------------------------------------------------- DTSCS81 00356 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS81 00357 * WORK STATION DTSCS81 00358 *----------------------------------------------------- DTSCS81 00359 IF LCCM-CLEAR-88 DTSCS81 00360 SET REQ-CLEAR TO TRUE DTSCS81 00361 GO TO P1000-EXIT. DTSCS81 00362 SKIP3 DTSCS81 00363 *----------------------------------------------------- DTSCS81 00364 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS81 00365 *----------------------------------------------------- DTSCS81 00366 IF LCCM-SCR-UPDATE-LOCKED DTSCS81 00367 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS81 00368 GO TO P1000-EXIT. DTSCS81 00369 SKIP3 DTSCS81 00370 *----------------------------------------------------- DTSCS81 00371 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS81 00372 *----------------------------------------------------- DTSCS81 00373 IF LCCM-PA2-88 DTSCS81 00374 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS81 00375 GO TO P1000-EXIT. DTSCS81 00376 SKIP3 DTSCS81 00377 *----------------------------------------------------- DTSCS81 00378 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS81 00379 *----------------------------------------------------- DTSCS81 00380 IF LCCM-PA-88 DTSCS81 00381 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS81 00382 SET REQ-ERROR TO TRUE DTSCS81 00383 GO TO P1000-EXIT. DTSCS81 00384 SKIP3 DTSCS81 00385 *----------------------------------------------------- CL**3 00386 * IF F12 PRESSED WHEN UPDATE NOT IN PROGRESS IS A CL**3 00387 * REQUEST TO CLEAR THE SCREEN. CL**3 00388 *----------------------------------------------------- CL**3 00389 IF LCCM-F12-88 CL**3 00390 MOVE LOW-VALUES TO MAP-AREA CL**3 00391 SET REQ-CLEAR TO TRUE CL**3 00392 GO TO P1000-EXIT. CL**3 00393 SKIP3 CL**3 00394 *----------------------------------------------------- DTSCS81 00395 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS81 00396 *----------------------------------------------------- DTSCS81 00397 IF LCCM-F03-88 DTSCS81 00398 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS81 00399 SET REQ-JUMP TO TRUE DTSCS81 00400 GO TO P1000-EXIT. DTSCS81 00401 SKIP3 DTSCS81 00402 *----------------------------------------------------- DTSCS81 00403 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS81 00404 *----------------------------------------------------- DTSCS81 00405 IF LCCM-F04-88 DTSCS81 00406 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS81 00407 SET REQ-JUMP TO TRUE DTSCS81 00408 GO TO P1000-EXIT. DTSCS81 00409 SKIP3 DTSCS81 00410 *----------------------------------------------------- DTSCS81 00411 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS81 00412 * CORRESPONDENCE SCREEN DTSCS81 00413 *----------------------------------------------------- DTSCS81 00414 IF LCCM-F14-88 DTSCS81 00415 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS81 00416 SET REQ-JUMP TO TRUE DTSCS81 00417 GO TO P1000-EXIT. DTSCS81 00418 SKIP3 DTSCS81 00419 *----------------------------------------------------- DTSCS81 00420 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS81 00421 * REQUESTED SCREEN TYPE DTSCS81 00422 *----------------------------------------------------- DTSCS81 00423 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS81 00424 NEXT SENTENCE DTSCS81 00425 ELSE DTSCS81 00426 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS81 00427 SET REQ-JUMP TO TRUE DTSCS81 00428 GO TO P1000-EXIT. DTSCS81 00429 SKIP3 DTSCS81 00430 *----------------------------------------------------- DTSCS81 00431 * IF REQUEST TO UPDATE THE DATA (ADD, MOD, DEL) DTSCS81 00432 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS81 00433 *----------------------------------------------------- DTSCS81 00434 IF LCCM-F09-88 OR LCCM-F10-88 OR LCCM-F23-88 DTSCS81 00435 IF SCR-ACCESS-UPDATE DTSCS81 00436 SET REQ-EDIT TO TRUE DTSCS81 00437 GO TO P1000-EXIT DTSCS81 00438 ELSE DTSCS81 00439 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS81 00440 SET REQ-ERROR TO TRUE DTSCS81 00441 GO TO P1000-EXIT. DTSCS81 00442 SKIP3 DTSCS81 00443 *----------------------------------------------------- DTSCS81 00444 * IF INQUIRY TYPE KEY PRESSED (ENTER, PAGE DOWN, DTSCS81 00445 * PAGE UP), INDICATE INQUIRY REQUEST DTSCS81 00446 *----------------------------------------------------- DTSCS81 00447 IF LCCM-ENTER-88 OR LCCM-F07-88 OR LCCM-F08-88 DTSCS81 00448 SET REQ-INQUIRE TO TRUE DTSCS81 00449 GO TO P1000-EXIT. DTSCS81 00450 SKIP3 DTSCS81 00451 *----------------------------------------------------- DTSCS81 00452 * ANY OTHER KEY IS INVALID DTSCS81 00453 *----------------------------------------------------- DTSCS81 00454 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS81 00455 SET REQ-ERROR TO TRUE. DTSCS81 00456 P1000-EXIT. DTSCS81 00457 EXIT. DTSCS81 00458 SKIP3 DTSCS81 00459 ******************************************************************DTSCS81 00460 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS81 00461 ******************************************************************DTSCS81 00462 CL**2 00463 P1100-UPDATE-LOCKED. DTSCS81 00464 *----------------------------------------------------- DTSCS81 00465 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS81 00466 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCS81 00467 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS81 00468 *----------------------------------------------------- DTSCS81 00469 IF LCCM-ENTER-88 OR LCCM-F12-88 DTSCS81 00470 SET REQ-UPDATE TO TRUE DTSCS81 00471 ELSE DTSCS81 00472 SET REQ-ERROR TO TRUE DTSCS81 00473 IF LCCM-SCR-ADD-LOCKED DTSCS81 00474 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS81 00475 ELSE DTSCS81 00476 IF LCCM-SCR-MOD-LOCKED DTSCS81 00477 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS81 00478 ELSE DTSCS81 00479 IF LCCM-SCR-DEL-LOCKED DTSCS81 00480 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID DTSCS81 00481 ELSE DTSCS81 00482 PERFORM S899-ABEND THRU S899-EXIT. DTSCS81 00483 P1100-EXIT. DTSCS81 00484 EXIT. DTSCS81 00485 /*****************************************************************DTSCS81 00486 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS81 00487 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS81 00488 ******************************************************************DTSCS81 00489 CL**2 00490 P2000-REQUEST-ERROR. DTSCS81 00491 IF LCCM-MSG DTSCS81 00492 SET RESP-SEND-MSGONLY TO TRUE DTSCS81 00493 ELSE DTSCS81 00494 PERFORM S899-ABEND THRU S899-EXIT. DTSCS81 00495 P2000-EXIT. DTSCS81 00496 EXIT. DTSCS81 00497 /*****************************************************************DTSCS81 00498 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS81 00499 ******************************************************************DTSCS81 00500 CL**2 00501 P3000-REQUEST-JUMP. DTSCS81 00502 *----------------------------------------------------- DTSCS81 00503 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS81 00504 * BY USER DTSCS81 00505 *----------------------------------------------------- DTSCS81 00506 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS81 00507 SKIP3 DTSCS81 00508 *----------------------------------------------------- DTSCS81 00509 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS81 00510 *----------------------------------------------------- DTSCS81 00511 IF LCCM-MSG DTSCS81 00512 SET RESP-SEND-MSGONLY TO TRUE DTSCS81 00513 SET CURSOR-SET-GOTO TO TRUE DTSCS81 00514 GO TO P3000-EXIT. DTSCS81 00515 SKIP3 DTSCS81 00516 *----------------------------------------------------- DTSCS81 00517 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS81 00518 *----------------------------------------------------- DTSCS81 00519 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS81 00520 LCCM-SCR-HOLD-AREA. DTSCS81 00521 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS81 00522 SET RESP-JUMP TO TRUE. DTSCS81 00523 P3000-EXIT. DTSCS81 00524 EXIT. DTSCS81 00525 /*****************************************************************DTSCS81 00526 * CLEAR KEY WAS PRESSED *DTSCS81 00527 ******************************************************************DTSCS81 00528 CL**2 00529 P4000-REQUEST-CLEAR. DTSCS81 00530 IF SCR-ACCESS-UPDATE DTSCS81 00531 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS81 00532 ELSE DTSCS81 00533 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS81 00534 SKIP3 DTSCS81 00535 *----------------------------------------------------- DTSCS81 00536 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS81 00537 * FIELDS FROM EARLIER REQUESTS DTSCS81 00538 *----------------------------------------------------- DTSCS81 00539 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA. DTSCS81 00540 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS81 00541 SET LCCM-SCR-CLEAR TO TRUE. DTSCS81 00542 SET RESP-SEND-MAP TO TRUE. DTSCS81 00543 P4000-EXIT. DTSCS81 00544 EXIT. DTSCS81 00545 /*****************************************************************DTSCS81 00546 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS81 00547 ******************************************************************DTSCS81 00548 CL**2 00549 P5000-CURSOR-TO-GOTO. DTSCS81 00550 SET CURSOR-SET-GOTO TO TRUE. DTSCS81 00551 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS81 00552 P5000-EXIT. DTSCS81 00553 EXIT. DTSCS81 00554 /*****************************************************************DTSCS81 00555 * INQUIRY WAS REQUESTED *DTSCS81 00556 ******************************************************************DTSCS81 00557 CL**2 00558 P6000-REQUEST-INQUIRE. DTSCS81 00559 MOVE MAP-YR TO L007-YR-2-X. DTSCS81 00560 MOVE LOW-VALUES TO MAP-AREA. DTSCS81 00561 MOVE L007-YR-2-X TO MAP-YR. DTSCS81 00562 CL**2 00563 MOVE LOW-VALUES TO FCYR-KEY-AREA. DTSCS81 00564 SET FCYR-CYR-88 TO TRUE. DTSCS81 00565 IF MAP-YR = LOW-VALUE OR SPACE DTSCS81 00566 MOVE +0 TO FCYR-YR DTSCS81 00567 ELSE DTSCS81 00568 PERFORM S007-CHECK-MAP-YR THRU S007-EXIT DTSCS81 00569 IF L007-VALID-YR DTSCS81 00570 MOVE L007-YR-4-9 TO FCYR-YR DTSCS81 00571 ELSE DTSCS81 00572 MOVE +0 TO FCYR-YR DTSCS81 00573 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS81 00574 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS81 00575 IF LCCM-SCR-INQUIRE DTSCS81 00576 AND FCYR-KEY-AREA = LCCM-SCR-KEY-AREA DTSCS81 00577 MOVE 'N' TO WRK-NEW-KEY-IND DTSCS81 00578 ELSE DTSCS81 00579 MOVE 'Y' TO WRK-NEW-KEY-IND. DTSCS81 00580 CL**2 00581 IF SCR-ACCESS-UPDATE DTSCS81 00582 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS81 00583 ELSE DTSCS81 00584 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS81 00585 CL**2 00586 SET LCCM-SCR-CLEAR TO TRUE. DTSCS81 00587 MOVE LOW-VALUES TO LCCM-SCR-KEY-AREA. DTSCS81 00588 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS81 00589 CL**2 00590 IF LCCM-MSG DTSCS81 00591 NEXT SENTENCE DTSCS81 00592 ELSE DTSCS81 00593 IF LCCM-ENTER-88 DTSCS81 00594 PERFORM P6100-NO-PAGE THRU P6100-EXIT DTSCS81 00595 ELSE DTSCS81 00596 IF LCCM-F07-88 DTSCS81 00597 PERFORM P6200-PAGE-BACK THRU P6200-EXIT DTSCS81 00598 ELSE DTSCS81 00599 IF LCCM-F08-88 DTSCS81 00600 PERFORM P6300-PAGE-NEXT THRU P6300-EXIT DTSCS81 00601 ELSE DTSCS81 00602 PERFORM S899-ABEND THRU S899-EXIT. DTSCS81 00603 CL**2 00604 SET RESP-SEND-MAP TO TRUE. DTSCS81 00605 P6000-EXIT. DTSCS81 00606 EXIT. DTSCS81 00607 EJECT DTSCS81 00608 P6100-NO-PAGE. DTSCS81 00609 IF MAP-YR = SPACES OR LOW-VALUES DTSCS81 00610 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-ID DTSCS81 00611 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS81 00612 GO TO P6100-EXIT. DTSCS81 00613 CL**2 00614 PERFORM S831-READ THRU S831-EXIT. DTSCS81 00615 IF L831-NO-REC-88 DTSCS81 00616 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS81 00617 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS81 00618 GO TO P6100-EXIT. DTSCS81 00619 CL**2 00620 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS81 00621 P6100-EXIT. DTSCS81 00622 EXIT. DTSCS81 00623 EJECT DTSCS81 00624 P6200-PAGE-BACK. DTSCS81 00625 MOVE FCYR-KEY-AREA TO WRK-KEY-AREA. DTSCS81 00626 PERFORM S831-START-BROWSE THRU S831-EXIT. DTSCS81 00627 IF L831-NO-REC-88 DTSCS81 00628 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS81 00629 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS81 00630 GO TO P6200-EXIT. DTSCS81 00631 CL**2 00632 IF (WRK-NEW-KEY-IND = 'Y') DTSCS81 00633 AND DTSCS81 00634 (WRK-KEY-AREA = FCYR-KEY-AREA) DTSCS81 00635 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS81 00636 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS81 00637 GO TO P6200-EXIT. DTSCS81 00638 CL**2 00639 PERFORM S831-READ-PREV THRU S831-EXIT. DTSCS81 00640 IF L831-NO-REC-88 DTSCS81 00641 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS81 00642 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS81 00643 GO TO P6200-EXIT. DTSCS81 00644 CL**2 00645 PERFORM S831-READ-PREV THRU S831-EXIT. DTSCS81 00646 IF L831-NO-REC-88 DTSCS81 00647 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS81 00648 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-ID DTSCS81 00649 ELSE DTSCS81 00650 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS81 00651 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS81 00652 P6200-EXIT. DTSCS81 00653 EXIT. DTSCS81 00654 EJECT DTSCS81 00655 P6300-PAGE-NEXT. DTSCS81 00656 MOVE FCYR-KEY-AREA TO WRK-KEY-AREA. DTSCS81 00657 PERFORM S831-START-BROWSE THRU S831-EXIT. DTSCS81 00658 IF L831-NO-REC-88 DTSCS81 00659 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS81 00660 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS81 00661 GO TO P6300-EXIT. DTSCS81 00662 CL**2 00663 IF (WRK-NEW-KEY-IND = 'N') DTSCS81 00664 AND DTSCS81 00665 (WRK-KEY-AREA = FCYR-KEY-AREA) DTSCS81 00666 NEXT SENTENCE DTSCS81 00667 ELSE DTSCS81 00668 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS81 00669 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS81 00670 GO TO P6300-EXIT. DTSCS81 00671 CL**2 00672 PERFORM S831-READ-NEXT THRU S831-EXIT. DTSCS81 00673 IF L831-NO-REC-88 DTSCS81 00674 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS81 00675 MOVE PMSG-LAST-PAGE TO LCCM-MSG-ID DTSCS81 00676 ELSE DTSCS81 00677 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS81 00678 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS81 00679 P6300-EXIT. DTSCS81 00680 EXIT. DTSCS81 00681 /*****************************************************************DTSCS81 00682 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCS81 00683 ******************************************************************DTSCS81 00684 CL**2 00685 P6900-CONSTRUCT-SCREEN. DTSCS81 00686 PERFORM S007-CONVERT-FCYR-YR THROUGH S007-EXIT. DTSCS81 00687 IF L007-VALID-YR DTSCS81 00688 MOVE L007-YR-2-X TO MAP-YR DTSCS81 00689 ELSE DTSCS81 00690 GO TO S899-ABEND. DTSCS81 00691 SKIP3 DTSCS81 00692 MOVE FCYR-TAXABLE-WAGE-BASE TO MAP-TAXABLE-WAGE-BASE-N. DTSCS81 00693 CL**2 00694 MOVE FCYR-FUTA-CREDIT-RATE TO L056-RATE. DTSCS81 00695 SET L056-DISP1-LEFT-88 TO TRUE. DTSCS81 00696 PERFORM S056-RATE-DISPLAY THROUGH S056-EXIT. DTSCS81 00697 MOVE L056-DISP-RATE TO MAP-FUTA-CREDIT-RATE. DTSCS81 00698 SKIP3 DTSCS81 00699 IF FCYR-ESTB-DATE NOT = +0 DTSCS81 00700 MOVE FCYR-ESTB-DATE TO L001-FED-8-DATE-9 DTSCS81 00701 SET L001-FROM-FED-8 TO TRUE DTSCS81 00702 PERFORM S001-DATE THRU S001-EXIT DTSCS81 00703 MOVE L001-SLASH-DATE TO MAP-ESTB-DATE. DTSCS81 00704 CL**2 00705 IF FCYR-CHNG-DATE NOT = +0 DTSCS81 00706 MOVE FCYR-CHNG-DATE TO L001-FED-8-DATE-9 DTSCS81 00707 SET L001-FROM-FED-8 TO TRUE DTSCS81 00708 PERFORM S001-DATE THRU S001-EXIT DTSCS81 00709 MOVE L001-SLASH-DATE TO MAP-CHNG-DATE. DTSCS81 00710 CL**2 00711 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS81 00712 MOVE FCYR-KEY-AREA TO LCCM-SCR-KEY-AREA. DTSCS81 00713 P6900-EXIT. DTSCS81 00714 EXIT. DTSCS81 00715 /*****************************************************************DTSCS81 00716 * FUNCTION KEY WAS PRESSED TO ADD, MOD OR DEL THE RECORD. *DTSCS81 00717 ******************************************************************DTSCS81 00718 CL**2 00719 P7000-REQUEST-EDIT. DTSCS81 00720 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS81 00721 CL**2 00722 IF LCCM-F09-88 DTSCS81 00723 PERFORM P7100-EDIT-ADD THRU P7100-EXIT DTSCS81 00724 ELSE DTSCS81 00725 IF LCCM-F10-88 DTSCS81 00726 PERFORM P7200-EDIT-MOD THRU P7200-EXIT DTSCS81 00727 ELSE DTSCS81 00728 IF LCCM-F23-88 DTSCS81 00729 PERFORM P7300-EDIT-DEL THRU P7300-EXIT DTSCS81 00730 ELSE DTSCS81 00731 PERFORM S899-ABEND THRU S899-EXIT. DTSCS81 00732 SKIP3 DTSCS81 00733 *------------------------------------------------------ DTSCS81 00734 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCS81 00735 * IN ORDER TO CONTINUE TO ATTEMPT AN ADD THE SCREEN MUST REMAIN DTSCS81 00736 * IN A 'CLEAR' STATE. THE SCREEN MUST BE IN 'INQUIRE' STATUS DTSCS81 00737 * IF MOD OR DEL FUNCTIONS ARE BEING REQUESTED. DTSCS81 00738 *------------------------------------------------------ DTSCS81 00739 CL**2 00740 IF LCCM-MSG DTSCS81 00741 NEXT SENTENCE DTSCS81 00742 ELSE DTSCS81 00743 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCS81 00744 IF LCCM-F09-88 DTSCS81 00745 SET LCCM-SCR-ADD-LOCKED TO TRUE DTSCS81 00746 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS81 00747 ELSE DTSCS81 00748 IF LCCM-F10-88 DTSCS81 00749 SET LCCM-SCR-MOD-LOCKED TO TRUE DTSCS81 00750 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS81 00751 ELSE DTSCS81 00752 IF LCCM-F23-88 DTSCS81 00753 SET LCCM-SCR-DEL-LOCKED TO TRUE DTSCS81 00754 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID. DTSCS81 00755 CL**2 00756 SET RESP-SEND-MAP TO TRUE. DTSCS81 00757 P7000-EXIT. DTSCS81 00758 EXIT. DTSCS81 00759 /*****************************************************************DTSCS81 00760 * ADD FUNCTION WAS REQUESTED *DTSCS81 00761 ******************************************************************DTSCS81 00762 CL**2 00763 P7100-EDIT-ADD. DTSCS81 00764 *------------------------------------------------------ DTSCS81 00765 * ADD REQUIRES THAT THE SCREEN WAS IN THE CLEAR STATE DTSCS81 00766 *------------------------------------------------------ DTSCS81 00767 IF NOT LCCM-SCR-CLEAR DTSCS81 00768 MOVE EMSG-ADD-PRECEDED TO LCCM-MSG-ID DTSCS81 00769 GO TO P7100-EXIT. DTSCS81 00770 CL**2 00771 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS81 00772 CL**2 00773 IF LCCM-NO-MSG DTSCS81 00774 PERFORM S8010-READ-FCYR THRU S8010-EXIT DTSCS81 00775 IF L831-OK-88 DTSCS81 00776 MOVE EMSG-RECORD-EXISTS TO WRK-MSG-ID DTSCS81 00777 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS81 00778 P7100-EXIT. DTSCS81 00779 EXIT. DTSCS81 00780 /*****************************************************************DTSCS81 00781 * MODIFICATION FUNCTION WAS REQUESTED *DTSCS81 00782 ******************************************************************DTSCS81 00783 CL**2 00784 P7200-EDIT-MOD. DTSCS81 00785 *----------------------------------------------------- DTSCS81 00786 * MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS81 00787 * INQUIRED DTSCS81 00788 *----------------------------------------------------- DTSCS81 00789 IF NOT LCCM-SCR-INQUIRE DTSCS81 00790 MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-ID DTSCS81 00791 GO TO P7200-EXIT. DTSCS81 00792 SKIP3 DTSCS81 00793 *----------------------------------------------------- DTSCS81 00794 * CONTROL FIELD(S) MAY NOT BE CHANGED DURING THE MOD DTSCS81 00795 *----------------------------------------------------- DTSCS81 00796 MOVE LCCM-SCR-KEY-AREA TO WRK-KEY-AREA. DTSCS81 00797 PERFORM S007-CHECK-MAP-YR THRU S007-EXIT. DTSCS81 00798 IF L007-NOT-VALID-YR DTSCS81 00799 OR L007-YR-4-9 NOT = WRK-YR DTSCS81 00800 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-ID DTSCS81 00801 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS81 00802 GO TO P7200-EXIT. DTSCS81 00803 CL**2 00804 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS81 00805 CL**2 00806 IF LCCM-NO-MSG DTSCS81 00807 PERFORM S8010-READ-FCYR THRU S8010-EXIT DTSCS81 00808 IF L831-NO-REC-88 DTSCS81 00809 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS81 00810 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS81 00811 P7200-EXIT. DTSCS81 00812 EXIT. DTSCS81 00813 /*****************************************************************DTSCS81 00814 * DELETE FUNCTION WAS REQUESTED *DTSCS81 00815 ******************************************************************DTSCS81 00816 CL**2 00817 P7300-EDIT-DEL. DTSCS81 00818 *----------------------------------------------------- DTSCS81 00819 * DELETE REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS81 00820 * INQUIRED DTSCS81 00821 *----------------------------------------------------- DTSCS81 00822 IF NOT LCCM-SCR-INQUIRE DTSCS81 00823 MOVE EMSG-DEL-PRECEDED TO LCCM-MSG-ID DTSCS81 00824 GO TO P7300-EXIT. DTSCS81 00825 SKIP3 DTSCS81 00826 *----------------------------------------------------- DTSCS81 00827 * CONTROL FIELD(S) MAY NOT BE CHANGED DURING A DELETE DTSCS81 00828 *----------------------------------------------------- DTSCS81 00829 MOVE LCCM-SCR-KEY-AREA TO WRK-KEY-AREA. DTSCS81 00830 PERFORM S007-CHECK-MAP-YR THRU S007-EXIT. DTSCS81 00831 IF L007-NOT-VALID-YR DTSCS81 00832 OR L007-YR-4-9 NOT = WRK-YR DTSCS81 00833 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-ID DTSCS81 00834 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS81 00835 CL**2 00836 IF LCCM-NO-MSG DTSCS81 00837 PERFORM S8010-READ-FCYR THRU S8010-EXIT DTSCS81 00838 IF L831-NO-REC-88 DTSCS81 00839 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS81 00840 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS81 00841 P7300-EXIT. DTSCS81 00842 EXIT. DTSCS81 00843 /*****************************************************************DTSCS81 00844 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED *DTSCS81 00845 ******************************************************************DTSCS81 00846 CL**2 00847 P8000-REQUEST-UPDATE. DTSCS81 00848 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS81 00849 CL**2 00850 IF LCCM-SCR-ADD-LOCKED DTSCS81 00851 PERFORM P8100-ADD THRU P8100-EXIT DTSCS81 00852 ELSE DTSCS81 00853 IF LCCM-SCR-MOD-LOCKED DTSCS81 00854 PERFORM P8200-MOD THRU P8200-EXIT DTSCS81 00855 ELSE DTSCS81 00856 IF LCCM-SCR-DEL-LOCKED DTSCS81 00857 PERFORM P8300-DEL THRU P8300-EXIT DTSCS81 00858 ELSE DTSCS81 00859 PERFORM S899-ABEND THRU S899-EXIT. DTSCS81 00860 CL**2 00861 SET RESP-SEND-MAP TO TRUE. DTSCS81 00862 P8000-EXIT. DTSCS81 00863 EXIT. DTSCS81 00864 /*****************************************************************DTSCS81 00865 * *DTSCS81 00866 ******************************************************************DTSCS81 00867 CL**2 00868 P8100-ADD. DTSCS81 00869 SET LCCM-SCR-CLEAR TO TRUE. DTSCS81 00870 CL**2 00871 IF LCCM-F12-88 DTSCS81 00872 MOVE PMSG-ADD-CANCELED TO LCCM-MSG-ID DTSCS81 00873 GO TO P8100-EXIT. DTSCS81 00874 CL**2 00875 PERFORM S8010-READ-FCYR THRU S8010-EXIT. DTSCS81 00876 CL**2 00877 IF L831-OK-88 DTSCS81 00878 MOVE EMSG-RECORD-EXISTS TO WRK-MSG-ID DTSCS81 00879 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS81 00880 GO TO P8100-EXIT. DTSCS81 00881 CL**2 00882 MOVE LOW-VALUES TO FCYR-DATA-AREA. DTSCS81 00883 CL**2 00884 PERFORM P8900-CONSTRUCT-FCYR THRU P8900-EXIT. DTSCS81 00885 CL**2 00886 MOVE LCCM-CURR-RUN-DATE TO FCYR-ESTB-DATE. DTSCS81 00887 CL**3 00888 MOVE LCCM-CURR-RUN-DATE TO FCYR-CHNG-DATE. DTSCS81 00889 CL**2 00890 PERFORM S831-WRITE THRU S831-EXIT. DTSCS81 00891 CL**2 00892 MOVE LOW-VALUES TO MAP-AREA. DTSCS81 00893 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS81 00894 MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS81 00895 P8100-EXIT. DTSCS81 00896 EXIT. DTSCS81 00897 /*****************************************************************DTSCS81 00898 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS81 00899 ******************************************************************DTSCS81 00900 CL**2 00901 P8200-MOD. DTSCS81 00902 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS81 00903 CL**2 00904 IF LCCM-F12-88 DTSCS81 00905 MOVE PMSG-MOD-CANCELED TO LCCM-MSG-ID DTSCS81 00906 GO TO P8200-EXIT. DTSCS81 00907 CL**2 00908 PERFORM S8010-READ-FCYR THRU S8010-EXIT. DTSCS81 00909 IF L831-NO-REC-88 DTSCS81 00910 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS81 00911 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS81 00912 GO TO P8200-EXIT. DTSCS81 00913 CL**2 00914 PERFORM P8900-CONSTRUCT-FCYR THRU P8900-EXIT. DTSCS81 00915 CL**2 00916 MOVE LCCM-CURR-RUN-DATE TO FCYR-CHNG-DATE. DTSCS81 00917 CL**2 00918 PERFORM S831-REWRITE THRU S831-EXIT. DTSCS81 00919 CL**2 00920 MOVE FCYR-CHNG-DATE TO L001-FED-8-DATE-9. DTSCS81 00921 SET L001-FROM-FED-8 TO TRUE. DTSCS81 00922 PERFORM S001-DATE THRU S001-EXIT. DTSCS81 00923 MOVE L001-SLASH-DATE TO MAP-CHNG-DATE. DTSCS81 00924 CL**2 00925 MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS81 00926 P8200-EXIT. DTSCS81 00927 EXIT. DTSCS81 00928 /*****************************************************************DTSCS81 00929 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS81 00930 ******************************************************************DTSCS81 00931 CL**2 00932 P8300-DEL. DTSCS81 00933 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS81 00934 CL**2 00935 IF LCCM-F12-88 DTSCS81 00936 MOVE PMSG-DEL-CANCELED TO LCCM-MSG-ID DTSCS81 00937 GO TO P8300-EXIT. DTSCS81 00938 CL**2 00939 PERFORM S8010-READ-FCYR THRU S8010-EXIT. DTSCS81 00940 IF NOT L831-OK-88 DTSCS81 00941 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS81 00942 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS81 00943 GO TO P8300-EXIT. DTSCS81 00944 CL**2 00945 PERFORM S831-DELETE THRU S831-EXIT. DTSCS81 00946 CL**2 00947 MOVE LOW-VALUES TO LCCM-SCR-KEY-AREA. DTSCS81 00948 SET LCCM-SCR-CLEAR TO TRUE. DTSCS81 00949 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS81 00950 CL**2 00951 MOVE LOW-VALUES TO MAP-AREA. DTSCS81 00952 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS81 00953 PERFORM S007-CONVERT-FCYR-YR THRU S007-EXIT. DTSCS81 00954 IF L007-VALID-YR DTSCS81 00955 MOVE L007-YR-2-X TO MAP-YR DTSCS81 00956 ELSE DTSCS81 00957 GO TO S899-ABEND. DTSCS81 00958 CL**2 00959 MOVE PMSG-DEL-SUCCESSFUL TO LCCM-MSG-ID. DTSCS81 00960 P8300-EXIT. DTSCS81 00961 EXIT. DTSCS81 00962 EJECT DTSCS81 00963 P8900-CONSTRUCT-FCYR. DTSCS81 00964 MOVE MAP-TAXABLE-WAGE-BASE-AREA DTSCS81 00965 TO L011-S-AMT-AREA. CL**3 00966 PERFORM S011-DOLLARS THRU S011-EXIT. DTSCS81 00967 MOVE L011-AMT TO FCYR-TAXABLE-WAGE-BASE. CL**3 00968 CL**2 00969 MOVE MAP-FUTA-CREDIT-RATE-AREA DTSCS81 00970 TO L012-S-RATE-AREA. DTSCS81 00971 PERFORM S012-RATE THRU S012-EXIT. DTSCS81 00972 MOVE L012-RATE TO FCYR-FUTA-CREDIT-RATE. DTSCS81 00973 P8900-EXIT. DTSCS81 00974 EXIT. DTSCS81 00975 /*****************************************************************DTSCS81 00976 * LINKS TO UTILITY MODULES DTSCS81 00977 ******************************************************************DTSCS81 00978 CL**2 00979 S001-DATE. DTSCS81 00980 EXEC CICS LINK DTSCS81 00981 PROGRAM ('DTSCU001') CL**2 00982 COMMAREA (L001-COMM-AREA) DTSCS81 00983 END-EXEC. DTSCS81 00984 S001-EXIT. DTSCS81 00985 EXIT. DTSCS81 00986 SKIP3 DTSCS81 00987 S007-CHECK-MAP-YR. DTSCS81 00988 MOVE MAP-YR TO L007-YR-2-X. DTSCS81 00989 SET L007-FROM-YR-2 TO TRUE. DTSCS81 00990 GO TO S007-YR-CONVERT. DTSCS81 00991 S007-CONVERT-FCYR-YR. DTSCS81 00992 MOVE FCYR-YR TO L007-YR-4-9. DTSCS81 00993 SET L007-FROM-YR-4 TO TRUE. DTSCS81 00994 GO TO S007-YR-CONVERT. DTSCS81 00995 S007-YR-CONVERT. DTSCS81 00996 EXEC CICS LINK DTSCS81 00997 PROGRAM ('DTSCU007') CL**2 00998 COMMAREA (L007-COMM-AREA) DTSCS81 00999 END-EXEC. DTSCS81 01000 S007-EXIT. DTSCS81 01001 EXIT. DTSCS81 01002 SKIP3 DTSCS81 01003 S011-DOLLARS. DTSCS81 01004 MOVE +1.00 TO L011-MIN-AMT. DTSCS81 01005 MOVE +9999999.99 TO L011-MAX-AMT. DTSCS81 01006 CL**2 01007 EXEC CICS LINK DTSCS81 01008 PROGRAM ('DTSCU011') CL**2 01009 COMMAREA (L011-COMM-AREA) DTSCS81 01010 END-EXEC. DTSCS81 01011 S011-EXIT. DTSCS81 01012 EXIT. DTSCS81 01013 SKIP3 DTSCS81 01014 S012-RATE. DTSCS81 01015 EXEC CICS LINK DTSCS81 01016 PROGRAM ('DTSCU012') CL**2 01017 COMMAREA (L012-COMM-AREA) DTSCS81 01018 END-EXEC. DTSCS81 01019 S012-EXIT. DTSCS81 01020 EXIT. DTSCS81 01021 SKIP3 DTSCS81 01022 S056-RATE-DISPLAY. DTSCS81 01023 EXEC CICS LINK DTSCS81 01024 PROGRAM ('DTSCU056') CL**2 01025 COMMAREA (L056-COMM-AREA) DTSCS81 01026 END-EXEC. DTSCS81 01027 S056-EXIT. DTSCS81 01028 EXIT. DTSCS81 01029 EJECT DTSCS81 01030 S803-REQ-SCR-ID-EDIT. DTSCS81 01031 EXEC CICS LINK DTSCS81 01032 PROGRAM ('DTSCU803') CL**2 01033 COMMAREA (DFHCOMMAREA) DTSCS81 01034 END-EXEC. DTSCS81 01035 S803-EXIT. DTSCS81 01036 EXIT. DTSCS81 01037 SKIP3 DTSCS81 01038 S804-INVALID-KEY. DTSCS81 01039 EXEC CICS LINK DTSCS81 01040 PROGRAM ('DTSCU804') CL**2 01041 COMMAREA (DFHCOMMAREA) DTSCS81 01042 END-EXEC. DTSCS81 01043 S804-EXIT. DTSCS81 01044 EXIT. DTSCS81 01045 SKIP3 DTSCS81 01046 S805-MSG-AREA. DTSCS81 01047 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS81 01048 CL**2 01049 EXEC CICS LINK DTSCS81 01050 PROGRAM ('DTSCU805') CL**2 01051 COMMAREA (L805-COMM-AREA) DTSCS81 01052 END-EXEC. DTSCS81 01053 CL**2 01054 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS81 01055 S805-EXIT. DTSCS81 01056 EXIT. DTSCS81 01057 EJECT DTSCS81 01058 S831-READ. DTSCS81 01059 SET L831-READ-88 TO TRUE. DTSCS81 01060 GO TO S831-IO. DTSCS81 01061 CL**2 01062 S831-START-BROWSE. DTSCS81 01063 SET L831-START-BROWSE-88 TO TRUE. DTSCS81 01064 GO TO S831-IO. DTSCS81 01065 CL**2 01066 S831-READ-NEXT. DTSCS81 01067 SET L831-READ-NEXT-88 TO TRUE. DTSCS81 01068 GO TO S831-IO. DTSCS81 01069 CL**2 01070 S831-READ-PREV. DTSCS81 01071 SET L831-READ-PREV-88 TO TRUE. DTSCS81 01072 GO TO S831-IO. DTSCS81 01073 CL**2 01074 S831-END-BROWSE. DTSCS81 01075 SET L831-END-BROWSE-88 TO TRUE. DTSCS81 01076 GO TO S831-IO. DTSCS81 01077 CL**2 01078 S831-REWRITE. DTSCS81 01079 SET L831-REWRITE-88 TO TRUE. DTSCS81 01080 GO TO S831-IO. DTSCS81 01081 CL**2 01082 S831-WRITE. DTSCS81 01083 SET L831-WRITE-88 TO TRUE. DTSCS81 01084 GO TO S831-IO. DTSCS81 01085 CL**2 01086 S831-DELETE. DTSCS81 01087 SET L831-DELETE-88 TO TRUE. DTSCS81 01088 GO TO S831-IO. DTSCS81 01089 CL**2 01090 S831-IO. DTSCS81 01091 CL**2 01092 EXEC CICS LINK DTSCS81 01093 PROGRAM ('DTSCU831') CL**2 01094 COMMAREA (L831-COMM-AREA) DTSCS81 01095 END-EXEC. DTSCS81 01096 CL**2 01097 IF L831-FILE-CLOSED-88 DTSCS81 01098 MOVE L831-MSG-AREA TO LCCM-MSG-AREA DTSCS81 01099 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS81 01100 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS81 01101 GO TO MAINLINE-EXIT. DTSCS81 01102 S831-EXIT. DTSCS81 01103 EXIT. DTSCS81 01104 SKIP3 DTSCS81 01105 S851-SCREEN-PROCESSING. DTSCS81 01106 EXEC CICS LINK DTSCS81 01107 PROGRAM ('DTSCU851') CL**2 01108 COMMAREA (L851-COMM-AREA) DTSCS81 01109 END-EXEC. DTSCS81 01110 S851-EXIT. DTSCS81 01111 EXIT. DTSCS81 01112 SKIP3 DTSCS81 01113 S899-ABEND. DTSCS81 01114 EXEC CICS ABEND DTSCS81 01115 ABCODE(WRK-ABEND-CD) DTSCS81 01116 END-EXEC. DTSCS81 01117 S899-EXIT. DTSCS81 01118 EXIT. DTSCS81 01119 /*****************************************************************DTSCS81 01120 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS81 01121 ******************************************************************DTSCS81 01122 CL**2 01123 S1000-SCREEN-EDITS. DTSCS81 01124 PERFORM S1100-YR THRU S1100-EXIT. DTSCS81 01125 PERFORM S1200-TAX-WAGE-BASE THRU S1200-EXIT. DTSCS81 01126 PERFORM S1300-FUTA-CR-RATE THRU S1300-EXIT. DTSCS81 01127 S1000-EXIT. DTSCS81 01128 EXIT. DTSCS81 01129 EJECT DTSCS81 01130 S1100-YR. DTSCS81 01131 IF MAP-YR = LOW-VALUES OR SPACES DTSCS81 01132 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-ID DTSCS81 01133 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS81 01134 ELSE DTSCS81 01135 PERFORM S007-CHECK-MAP-YR THRU S007-EXIT DTSCS81 01136 IF L007-NOT-VALID-YR DTSCS81 01137 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS81 01138 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS81 01139 S1100-EXIT. DTSCS81 01140 EXIT. DTSCS81 01141 SKIP3 DTSCS81 01142 S1101-ERROR. DTSCS81 01143 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-YR-A. DTSCS81 01144 IF LCCM-NO-MSG DTSCS81 01145 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS81 01146 MOVE CATB-CURSOR TO MAP-YR-L DTSCS81 01147 SET CURSOR-SET-YES TO TRUE. DTSCS81 01148 S1101-EXIT. DTSCS81 01149 EXIT. DTSCS81 01150 EJECT DTSCS81 01151 S1200-TAX-WAGE-BASE. DTSCS81 01152 MOVE MAP-TAXABLE-WAGE-BASE-AREA TO L011-S-AMT-AREA. DTSCS81 01153 PERFORM S011-DOLLARS THRU S011-EXIT. DTSCS81 01154 IF L011-NO-ENTRY DTSCS81 01155 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-ID DTSCS81 01156 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS81 01157 ELSE DTSCS81 01158 IF L011-NOT-NUMERIC DTSCS81 01159 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS81 01160 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS81 01161 ELSE DTSCS81 01162 IF L011-INVALID-NEGATIVE DTSCS81 01163 MOVE EMSG-INVALID-NEGATIVE TO WRK-MSG-ID DTSCS81 01164 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS81 01165 ELSE DTSCS81 01166 IF L011-EXCEEDS-MIN-MAX DTSCS81 01167 MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-ID DTSCS81 01168 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS81 01169 ELSE DTSCS81 01170 MOVE L011-AMT TO MAP-TAXABLE-WAGE-BASE-N. DTSCS81 01171 S1200-EXIT. DTSCS81 01172 EXIT. DTSCS81 01173 SKIP3 DTSCS81 01174 S1201-ERROR. DTSCS81 01175 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-TAXABLE-WAGE-BASE-A. DTSCS81 01176 IF LCCM-NO-MSG DTSCS81 01177 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS81 01178 MOVE CATB-CURSOR TO MAP-TAXABLE-WAGE-BASE-L DTSCS81 01179 SET CURSOR-SET-YES TO TRUE. DTSCS81 01180 S1201-EXIT. DTSCS81 01181 EXIT. DTSCS81 01182 EJECT DTSCS81 01183 S1300-FUTA-CR-RATE. DTSCS81 01184 MOVE MAP-FUTA-CREDIT-RATE-AREA TO L012-S-RATE-AREA. DTSCS81 01185 PERFORM S012-RATE THRU S012-EXIT. DTSCS81 01186 IF L012-NOT-VALID DTSCS81 01187 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS81 01188 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS81 01189 ELSE DTSCS81 01190 IF L012-NO-ENTRY DTSCS81 01191 OR L012-RATE = +0 DTSCS81 01192 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-ID DTSCS81 01193 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS81 01194 ELSE DTSCS81 01195 MOVE L012-RATE TO L056-RATE DTSCS81 01196 SET L056-DISP1-LEFT-88 TO TRUE DTSCS81 01197 PERFORM S056-RATE-DISPLAY THRU S056-EXIT DTSCS81 01198 MOVE L056-DISP-RATE TO MAP-FUTA-CREDIT-RATE. DTSCS81 01199 S1300-EXIT. DTSCS81 01200 EXIT. DTSCS81 01201 SKIP3 DTSCS81 01202 S1301-ERROR. DTSCS81 01203 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-FUTA-CREDIT-RATE-A. DTSCS81 01204 IF LCCM-NO-MSG DTSCS81 01205 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS81 01206 MOVE CATB-CURSOR TO MAP-FUTA-CREDIT-RATE-L DTSCS81 01207 SET CURSOR-SET-YES TO TRUE. DTSCS81 01208 S1301-EXIT. DTSCS81 01209 EXIT. DTSCS81 01210 /*****************************************************************DTSCS81 01211 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCS81 01212 ******************************************************************DTSCS81 01213 S5100-SET-LOCK-ATTRB. DTSCS81 01214 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS81 01215 WRK-ATB-NUM. DTSCS81 01216 CL**2 01217 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS81 01218 CL**2 01219 MOVE CATB-ASKIP-BRT-MDTON TO MAP-YR-A DTSCS81 01220 MAP-GOTO-A. CL**3 01221 S5100-EXIT. DTSCS81 01222 EXIT. DTSCS81 01223 SKIP3 DTSCS81 01224 ******************************************************************DTSCS81 01225 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS81 01226 ******************************************************************DTSCS81 01227 S5200-SET-UPDATE-ATTRB. DTSCS81 01228 MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN. DTSCS81 01229 MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM. DTSCS81 01230 CL**2 01231 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS81 01232 S5200-EXIT. DTSCS81 01233 EXIT. DTSCS81 01234 SKIP3 DTSCS81 01235 ******************************************************************DTSCS81 01236 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS81 01237 ******************************************************************DTSCS81 01238 S5300-SET-INQ-ATTRB. DTSCS81 01239 MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN DTSCS81 01240 WRK-ATB-NUM. CL**3 01241 CL**2 01242 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS81 01243 S5300-EXIT. DTSCS81 01244 EXIT. DTSCS81 01245 SKIP3 DTSCS81 01246 ******************************************************************DTSCS81 01247 * DO IT *DTSCS81 01248 ******************************************************************DTSCS81 01249 S5900-SET-ATTRB. DTSCS81 01250 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-YR-A. DTSCS81 01251 CL**2 01252 MOVE WRK-ATB-NUM TO MAP-TAXABLE-WAGE-BASE-A DTSCS81 01253 MAP-FUTA-CREDIT-RATE-A. DTSCS81 01254 CL**2 01255 MOVE CATB-ASKIP-BRT-MDTON TO MAP-ESTB-DATE-A DTSCS81 01256 MAP-CHNG-DATE-A. CL**3 01257 CL**2 01258 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS81 01259 S5900-EXIT. DTSCS81 01260 EXIT. DTSCS81 01261 /*****************************************************************DTSCS81 01262 * READ PREPARATION ROUTINES *DTSCS81 01263 ******************************************************************DTSCS81 01264 S8010-READ-FCYR. DTSCS81 01265 PERFORM S007-CHECK-MAP-YR THRU S007-EXIT. DTSCS81 01266 IF L007-VALID-YR DTSCS81 01267 MOVE LOW-VALUES TO FCYR-KEY-AREA DTSCS81 01268 SET FCYR-CYR-88 TO TRUE DTSCS81 01269 MOVE L007-YR-4-9 TO FCYR-YR DTSCS81 01270 PERFORM S831-READ THRU S831-EXIT DTSCS81 01271 ELSE DTSCS81 01272 GO TO S899-ABEND. DTSCS81 01273 S8010-EXIT. DTSCS81 01274 EXIT. DTSCS81 01275 /*****************************************************************DTSCS81 01276 * MAP ROUTINES *DTSCS81 01277 ******************************************************************DTSCS81 01278 S9100-RECEIVE. DTSCS81 01279 SET L851-RECEIVE-88 TO TRUE. DTSCS81 01280 CL**2 01281 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS81 01282 CL**2 01283 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS81 01284 CL**2 01285 MOVE L851-AID TO LCCM-AID. DTSCS81 01286 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS81 01287 S9100-EXIT. DTSCS81 01288 EXIT. DTSCS81 01289 SKIP3 DTSCS81 01290 S9200-SEND-DATAONLY. DTSCS81 01291 MOVE LOW-VALUES TO MAP-AREA. DTSCS81 01292 CL**2 01293 IF LCCM-NO-MSG DTSCS81 01294 NEXT SENTENCE DTSCS81 01295 ELSE DTSCS81 01296 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS81 01297 CL**2 01298 IF CURSOR-SET-GOTO DTSCS81 01299 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS81 01300 ELSE DTSCS81 01301 MOVE CATB-CURSOR TO MAP-YR-L. DTSCS81 01302 CL**2 01303 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS81 01304 CL**2 01305 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS81 01306 CL**2 01307 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS81 01308 S9200-EXIT. DTSCS81 01309 EXIT. DTSCS81 01310 SKIP3 DTSCS81 01311 S9300-SEND-MAP. DTSCS81 01312 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS81 01313 CL**3 01314 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS81 01315 CL**3 01316 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS81 01317 CL**2 01318 IF SCR-ACCESS-UPDATE DTSCS81 01319 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS81 01320 ELSE DTSCS81 01321 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS81 01322 CL**2 01323 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS81 01324 CL**2 01325 IF CURSOR-SET-NO DTSCS81 01326 MOVE CATB-CURSOR TO MAP-YR-L. DTSCS81 01327 CL**2 01328 SET L851-SEND-88 TO TRUE. DTSCS81 01329 CL**2 01330 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS81 01331 CL**2 01332 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS81 01333 S9300-EXIT. DTSCS81 01334 EXIT. DTSCS81 01335 SKIP3 DTSCS81 01336 S9310-UPDATE-FKEYS. DTSCS81 01337 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS81 01338 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS81 01339 MOVE CFKD-ADD TO MAP-KEY-ADD. DTSCS81 01340 MOVE CFKD-MOD TO MAP-KEY-MOD. DTSCS81 01341 MOVE CFKD-DEL TO MAP-KEY-DEL. CL**3 01342 CL**2 01343 IF LCCM-SCR-CLEAR DTSCS81 01344 MOVE LOW-VALUES TO MAP-KEY-MOD DTSCS81 01345 MAP-KEY-DEL DTSCS81 01346 ELSE DTSCS81 01347 IF LCCM-SCR-UPDATE-LOCKED DTSCS81 01348 MOVE LOW-VALUES TO MAP-KEY-BACK DTSCS81 01349 MAP-KEY-FWRD DTSCS81 01350 MAP-KEY-ADD DTSCS81 01351 MAP-KEY-MOD DTSCS81 01352 MAP-KEY-DEL DTSCS81 01353 ELSE DTSCS81 01354 MOVE LOW-VALUES TO MAP-KEY-ADD. DTSCS81 01355 S9310-EXIT. DTSCS81 01356 EXIT. DTSCS81 01357 SKIP3 DTSCS81 01358 S9320-INQUIRY-FKEYS. DTSCS81 01359 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS81 01360 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS81 01361 MOVE LOW-VALUES TO MAP-KEY-ADD DTSCS81 01362 MAP-KEY-MOD DTSCS81 01363 MAP-KEY-DEL. DTSCS81 01364 S9320-EXIT. DTSCS81 01365 EXIT. DTSCS81 01366 SKIP3 DTSCS81 01367 S9900-PREPARE-SEND. DTSCS81 01368 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS81 01369 LCCM-SCR-ID. DTSCS81 01370 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS81 01371 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS81 01372 S9900-EXIT. DTSCS81 01373 EXIT. DTSCS81