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