Files
DUTAS/CICS/DTSCS83.cob
2025-07-21 11:20:11 -04:00

2248 lines
176 KiB
COBOL

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