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