giteaadmin/DUTAS
4
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
ef98c08de5fbfa133def68d439cb1d035e2bc620
DUTAS/CICS/DTSCS82.cob

1899 lines
148 KiB
COBOL
Raw Blame History

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
Reference in New Issue View Git Blame Copy Permalink