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