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