00001 IDENTIFICATION DIVISION. 04/12/13 00002 PROGRAM-ID. DTSCS73. DTSCS73 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV018 00004 DATE-WRITTEN. MAY 1994. DTSCS73 00005 DATE-COMPILED. DTSCS73 00006 SKIP3 DTSCS73 00007 ***** DTSCS73 00008 * DTSCS73 00009 * FUNCTION: EVENT LOG INQUIRY/UPDATE DTSCS73 00010 * SCREEN PROCESSOR. DTSCS73 00011 * DTSCS73 00012 * DTSCS73 00013 * MODIFICATION LOG: DTSCS73 00014 * DTSCS73 00015 * 09/28/1998 INITIAL DEVELOPMENT. COPIED FROM MACCS73 DTSCS73 00016 * REFERENCE RFP: PROGRAMMER: ZL1.DTSCS73 00017 * DTSCS73 00018 * 10/11/2006 MODIFIED TO RECORD 15 EVENTS TAX STAFF CAN ENTER DTSCS73 00019 * REFERENCE RFP: PROGRAMMER: ZL1.DTSCS73 00020 * DTSCS73 00021 * 03/05/2007 ADDED P8900 TO UPDATED MEVL-TEXT BASED ON DTSCS73 00022 * BUSINESS AREA AND ACTIVITY CODE. DTSCS73 00023 * REFERENCE RFP: PROGRAMMER: GD DTSCS73 00024 * DTSCS73 00025 * 11/27/2009 ADDED CODE TO UPDATED MEVL-TEXT BASED ON DTSCS73 00026 * SUPERVISOR APPROVAL. DTSCS73 00027 * REFERENCE RFP: PROGRAMMER: ZL1 DTSCS73 00028 * DTSCS73 00029 * 12/15/2009 REMOVED EDIT IN S1700 THAT REQUIRED ENTRY OF DTSCS73 00030 * AN EVENT. THE EDIT WAS ACCIDENTALLY RE-INSERTED DTSCS73 00031 * DURING A PREVIOUS UPDATE. DTSCS73 00032 * REFERENCE RFP: PROGRAMMER: GD DTSCS73 00033 * DTSCS73 00034 * 12/16/2009 MODIFIED S1700. IF AN EVENT REQUIRING SUPERVISOR DTSCS73 00035 * APPROVAL IS SELECTED, SET MAP-APPRV TO 'X'. DTSCS73 00036 * REFERENCE RFP: PROGRAMMER: GD DTSCS73 00037 * DTSCS73 00038 * XX/XX/XXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS73 00039 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS73 00040 * WORK ORDER: PROGRAMMER: XXX DTSCS73 00041 * DTSCS73 00042 * DTSCS73 00043 * DESCRIPTION: DTSCS73 00044 * DTSCS73 00045 * CLEAR: DTSCS73 00046 * DTSCS73 00047 * FIELD DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO). DTSCS73 00048 * DTSCS73 00049 * DTSCS73 00050 * JUMP: DTSCS73 00051 * DTSCS73 00052 * F17 REGISTRATION INQUIRY (11). DTSCS73 00053 * F19 QUARTER INQUIRY (31). DTSCS73 00054 * F20 COLLECTIONS INQUIRY (41). DTSCS73 00055 * F21 EVENT LOG INQUIRY (72). DTSCS73 00056 * DTSCS73 00057 * DTSCS73 00058 * INQUIRY: DTSCS73 00059 * DTSCS73 00060 * CONTROL FIELD(S): MAP-EMP-NO. DTSCS73 00061 * DTSCS73 00062 * JUMP IN: IF LCCM-EMP-NO = LCCM-SCR73-HOLD-AREA EMP-NO DTSCS73 00063 * DISPLAY RECORD INDICATED BY DTSCS73 00064 * LCCM-SCR73-HOLD-AREA DTSCS73 00065 * ELSE DTSCS73 00066 * DISPLAY LAST PAGE OF DATA ASSOCIATED DTSCS73 00067 * WITH LCCM-EMP-NO. DTSCS73 00068 * DTSCS73 00069 * ENTER, F05, F06, F07, F08: STANDARD PAGING. DTSCS73 00070 * DTSCS73 00071 * DISPLAY SEQUENCE: ASCENDING ON DTSCS73 00072 * MEVL-DATE + MEVL-TIME. DTSCS73 00073 * DTSCS73 00074 * PAGE INITIALLY DISPLAYED: LAST. DTSCS73 00075 * DTSCS73 00076 * DTSCS73 00077 * JUMP OUT: STANDARD LCCM-EMP-NO MAINTENANCE. DTSCS73 00078 * DTSCS73 00079 * STORE INFORMATION REPRESENTING PAGE DTSCS73 00080 * CURRENTLY DISPLAYED IN LCCM-SCR73-HOLD-AREA. DTSCS73 00081 * DTSCS73 00082 * DTSCS73 00083 * STORE PAGING CONTROL INFORMATION IN LCCM-SCR-HOLD-AREA. DTSCS73 00084 * DTSCS73 00085 * DTSCS73 00086 * UPDATE: DTSCS73 00087 * DTSCS73 00088 * ADD DTSCS73 00089 * MOD DTSCS73 00090 * DEL DTSCS73 00091 * DTSCS73 00092 * DTSCS73 00093 * RECORDS READ: DTSCS73 00094 * DTSCS73 00095 * MASTER: DTSCS73 00096 * DTSCS73 00097 * MPRF DTSCS73 00098 * MEVL DTSCS73 00099 * DTSCS73 00100 * DTSCS73 00101 * ALTERNATE INDEX: DTSCS73 00102 * DTSCS73 00103 * NONE. DTSCS73 00104 * DTSCS73 00105 * DTSCS73 00106 * REFERENCE: DTSCS73 00107 * DTSCS73 00108 * NONE. DTSCS73 00109 * DTSCS73 00110 * DTSCS73 00111 * ACCOUNTING TRANSACTION COLLECTION: DTSCS73 00112 * DTSCS73 00113 * NONE. DTSCS73 00114 * DTSCS73 00115 * DTSCS73 00116 * RECORDS UPDATED: DTSCS73 00117 * DTSCS73 00118 * MASTER: DTSCS73 00119 * DTSCS73 00120 * MEVL (ADD, REWRITE, DELETE) DTSCS73 00121 * DTSCS73 00122 * DTSCS73 00123 * REFERENCE: DTSCS73 00124 * DTSCS73 00125 * NONE. DTSCS73 00126 * DTSCS73 00127 * DTSCS73 00128 * ACCOUNTING TRANSACTION COLLECTION: DTSCS73 00129 * DTSCS73 00130 * NONE. DTSCS73 00131 * DTSCS73 00132 * DTSCS73 00133 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCS73 00134 * DTSCS73 00135 * NONE. DTSCS73 00136 * DTSCS73 00137 * DTSCS73 00138 * TEMPORARY STORAGE USAGE: DTSCS73 00139 * DTSCS73 00140 * NONE DTSCS73 00141 * DTSCS73 00142 * DTSCS73 00143 * MODULES LINKED TO: DTSCS73 00144 * DTSCS73 00145 * DTSCU001 DATE EDIT/CONVERSION. DTSCS73 00146 * DTSCU015 DATE FROM SCREEN FORMAT/EDIT. DTSCS73 00147 * DTSCU025 TIME FROM SCREEN FORMAT/EDIT. DTSCS73 00148 * DTSCU018 EMPLOYER NUMBER FROM SCREEN FORMAT/EDIT. DTSCS73 00149 * DTSCU082 OPERATOR ID EDIT/LOOKUP. DTSCS73 00150 * DTSCU221 MPRF-UPDATE DATA ELEMENT MAINTENANCE. DTSCS73 00151 * DTSCU810 MASTER FILE INPUT/OUTPUT. DTSCS73 00152 * DTSCS73 00153 * DTSCS73 00154 * VERMONT REFERENCE: DTSCS73 00155 * DTSCS73 00156 * NONE. DTSCS73 00157 * DTSCS73 00158 * DTSCS73 00159 * NOTES TO JEFF: DTSCS73 00160 * DTSCS73 00161 * . WITH THE EXCEPTION OF ALLOWING "EVENT DATE" AND "EVENT DTSCS73 00162 * TIME" (WHICH ARE MEVL KEY FIELDS) TO BE CHANGED DURING DTSCS73 00163 * A MODIFY, THIS SCREEN SHOULD BE VERY SIMPLE. DTSCS73 00164 * DTSCS73 00165 * DTSCS73 00166 ***** DTSCS73 00167 DTSCS73 00168 ENVIRONMENT DIVISION. DTSCS73 00169 DTSCS73 00170 DATA DIVISION. DTSCS73 00171 DTSCS73 00172 WORKING-STORAGE SECTION. DTSCS73 001725 77 PAN-VALET PICTURE X(24) VALUE '018DTSCS73 04/12/13'. DTSCS73 00173 77 PAN-VALET PICTURE X(24) VALUE '005DTSCS73 10/12/12'. DTSCS73 00174 77 PAN-VALET PICTURE X(24) VALUE '005DTSCS73 12/16/09'. DTSCS73 00175 DTSCS73 00176 01 WRK-AREA. DTSCS73 00177 05 WRK-ABEND-CD PIC X(04) VALUE 'S73 '. DTSCS73 00178 DTSCS73 00179 05 WRK-SCR-ID. DTSCS73 00180 10 WRK-SCR-ID-N PIC 9(02) VALUE 73. DTSCS73 00181 DTSCS73 00182 05 WRK-F03-SCR-ID PIC X(02) VALUE '70'. DTSCS73 00183 DTSCS73 00184 05 SCR-ACCESS-IND PIC X(01). DTSCS73 00185 88 SCR-ACCESS-INQ VALUE '1'. DTSCS73 00186 88 SCR-ACCESS-UPDATE VALUE '2' '3'. DTSCS73 00187 88 SCR-ACCESS-SUPERVISOR VALUE '3'. DTSCS73 00188 DTSCS73 00189 05 CURSOR-SET-IND PIC X(01). DTSCS73 00190 88 CURSOR-SET-YES VALUE 'Y'. DTSCS73 00191 88 CURSOR-SET-NO VALUE 'N'. DTSCS73 00192 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS73 00193 DTSCS73 00194 05 REQ-IND PIC X(01). DTSCS73 00195 88 REQ-ERROR VALUE 'O'. DTSCS73 00196 88 REQ-JUMP VALUE 'J'. DTSCS73 00197 88 REQ-INQUIRE VALUE 'I'. DTSCS73 00198 88 REQ-CLEAR VALUE 'C'. DTSCS73 00199 88 REQ-EDIT VALUE 'E'. DTSCS73 00200 88 REQ-UPDATE VALUE 'U'. DTSCS73 00201 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS73 00202 DTSCS73 00203 05 RESP-IND PIC X(01). DTSCS73 00204 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS73 00205 88 RESP-SEND-MAP VALUE 'M'. DTSCS73 00206 88 RESP-JUMP VALUE 'J'. DTSCS73 00207 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS73 00208 DTSCS73 00209 DTSCS73 00210 05 WRK-MSG-AREA PIC X(64). DTSCS73 00211 DTSCS73 00212 05 WRK-ATB-AN PIC X(01). DTSCS73 00213 05 WRK-ATB-NUM PIC X(01). DTSCS73 00214 DTSCS73 00215 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSCS73 00216 DTSCS73 00217 05 WRK-MPRF-IND PIC X(01). DTSCS73 00218 88 WRK-MPRF-YES-88 VALUE 'Y'. DTSCS73 00219 88 WRK-MPRF-NO-88 VALUE 'N'. DTSCS73 00220 DTSCS73 00221 05 WRK-EVENT-SECTION-IND PIC 9(01) VALUE ZEROS. DTSCS73 00222 05 WRK-EVENT-WORK-IND PIC 9(02) VALUE ZEROS. DTSCS73 00223 DTSCS73 00224 05 WRK-BUSINESS-AREA PIC X(12) VALUE SPACES. DTSCS73 00225 05 WRK-ACTIVITY PIC X(36) VALUE SPACES. DTSCS73 00226 DTSCS73 00227 05 WRK-DISPLAY PIC 9(11). DTSCS73 00228 05 FILLER REDEFINES WRK-DISPLAY. DTSCS73 00229 10 FILLER PIC X(05). DTSCS73 00230 10 WRK-DISPLAY-EMP-NO-1 PIC X(03). DTSCS73 00231 10 WRK-DISPLAY-EMP-NO-2 PIC X(03). DTSCS73 00232 DTSCS73 00233 05 FILLER REDEFINES WRK-DISPLAY. DTSCS73 00234 10 FILLER PIC X(05). DTSCS73 00235 10 WRK-DISPLAY-YR PIC X(02). DTSCS73 00236 10 WRK-DISPLAY-MO PIC X(02). DTSCS73 00237 10 WRK-DISPLAY-DA PIC X(02). DTSCS73 00238 DTSCS73 00239 05 FILLER REDEFINES WRK-DISPLAY. DTSCS73 00240 10 FILLER PIC X(05). DTSCS73 00241 10 WRK-DISPLAY-HR PIC X(02). DTSCS73 00242 10 WRK-DISPLAY-MN PIC X(02). DTSCS73 00243 10 WRK-DISPLAY-SC PIC X(02). DTSCS73 00244 DTSCS73 00245 DTSCS73 00246 05 INQUIRY-CONTROL-AREA. DTSCS73 00247 10 LAST-REC-NUM PIC S9(08) COMP. DTSCS73 00248 10 WS-REC-NUM PIC S9(08) COMP. DTSCS73 00249 DTSCS73 00250 10 LAST-REC-KEY-AREA PIC X(16). DTSCS73 00251 10 SCR-REC-KEY-AREA PIC X(16). DTSCS73 00252 DTSCS73 00253 10 WS-REC-FOUND-IND PIC X(01). DTSCS73 00254 EJECT DTSCS73 00255 DTSCS73 00256 01 MSG-LITERALS. DTSCS73 00257 DTSCS73 00258 05 MSG-E731-AREA. DTSCS73 00259 10 FILLER PIC X(04) VALUE 'E731'. DTSCS73 00260 10 FILLER PIC X(30) DTSCS73 00261 VALUE 'RECORD EXISTS. DATE/TIME MATCH'. DTSCS73 00262 10 FILLER PIC X(30) DTSCS73 00263 VALUE ' AN EXISTING EVENT LOG. '. DTSCS73 00264 DTSCS73 00265 05 MSG-E732-AREA. DTSCS73 00266 10 FILLER PIC X(04) VALUE 'E732'. DTSCS73 00267 10 FILLER PIC X(30) DTSCS73 00268 VALUE 'DATE/TIME MAY NOT BE CHANGED D'. DTSCS73 00269 10 FILLER PIC X(30) DTSCS73 00270 VALUE 'URING A DELETE. '. DTSCS73 00271 DTSCS73 00272 05 MSG-E733-AREA. DTSCS73 00273 10 FILLER PIC X(04) VALUE 'E733'. DTSCS73 00274 10 FILLER PIC X(30) DTSCS73 00275 VALUE 'EVENT DATE MUST BE <= TAX SYST'. DTSCS73 00276 10 FILLER PIC X(30) DTSCS73 00277 VALUE 'EM PROCESSING DATE '. DTSCS73 00278 DTSCS73 00279 05 MSG-E734-AREA. DTSCS73 00280 10 FILLER PIC X(04) VALUE 'E734'. DTSCS73 00281 10 FILLER PIC X(30) DTSCS73 00282 VALUE 'EVENT CANNOT BELONG TO MORE TH'. DTSCS73 00283 10 FILLER PIC X(30) DTSCS73 00284 VALUE 'AN ONE SECTION. '. DTSCS73 00285 DTSCS73 00286 05 MSG-E735-AREA. DTSCS73 00287 10 FILLER PIC X(04) VALUE 'E735'. DTSCS73 00288 10 FILLER PIC X(30) DTSCS73 00289 VALUE 'CANNOT RECORD MORE THAN ONE EV'. DTSCS73 00290 10 FILLER PIC X(30) DTSCS73 00291 VALUE 'ENT AT A TIME. '. DTSCS73 00292 DTSCS73 00293 05 MSG-E736-AREA. DTSCS73 00294 10 FILLER PIC X(04) VALUE 'E736'. DTSCS73 00295 10 FILLER PIC X(30) DTSCS73 00296 VALUE 'CANNOT MODIFY (CHANGE/DEL) ANO'. DTSCS73 00297 10 FILLER PIC X(30) DTSCS73 00298 VALUE 'THER USER EVENT LOG. '. DTSCS73 00299 DTSCS73 00300 EJECT DTSCS73 00301 01 L001-COMM-AREA. DTSCS73 00302 ++INCLUDE DTSIL001 DTSCS73 00303 EJECT DTSCS73 00304 01 L015-COMM-AREA. DTSCS73 00305 ++INCLUDE DTSIL015 DTSCS73 00306 EJECT DTSCS73 00307 01 L018-COMM-AREA. DTSCS73 00308 ++INCLUDE DTSIL018 DTSCS73 00309 EJECT DTSCS73 00310 01 L025-COMM-AREA. DTSCS73 00311 ++INCLUDE DTSIL025 DTSCS73 00312 EJECT DTSCS73 00313 01 L082-COMM-AREA. DTSCS73 00314 ++INCLUDE DTSIL082 DTSCS73 00315 EJECT DTSCS73 00316 01 L221-COMM-AREA. DTSCS73 00317 ++INCLUDE DTSIL221 DTSCS73 00318 EJECT DTSCS73 00319 01 L805-COMM-AREA. DTSCS73 00320 ++INCLUDE DTSIL805 DTSCS73 00321 EJECT DTSCS73 00322 01 L810-COMM-AREA. DTSCS73 00323 05 L810-CONTROL-BLOCK. DTSCS73 00324 ++INCLUDE DTSIL810 DTSCS73 00325 EJECT DTSCS73 00326 05 MSKL-REC. DTSCS73 00327 ++INCLUDE DTSIMSKL DTSCS73 00328 EJECT DTSCS73 00329 01 MPRF-REC. DTSCS73 00330 ++INCLUDE DTSIMPRF DTSCS73 00331 EJECT DTSCS73 00332 01 MEVL-REC. DTSCS73 00333 ++INCLUDE DTSIMEVL DTSCS73 00334 EJECT DTSCS73 00335 01 L851-COMM-AREA. DTSCS73 00336 ++INCLUDE DTSIL851 DTSCS73 00337 DTSCS73 00338 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS73 00339 ++INCLUDE DTSIS73 DTSCS73 00340 EJECT DTSCS73 00341 01 CATB-LITERALS. DTSCS73 00342 ++INCLUDE DTSICATB DTSCS73 00343 DTSCS73 00344 01 CFKD-LITERALS. DTSCS73 00345 ++INCLUDE DTSICFKD DTSCS73 00346 DTSCS73 00347 01 CECD-LITERALS. DTSCS73 00348 ++INCLUDE DTSICECD DTSCS73 00349 DTSCS73 00350 01 CPCD-LITERALS. DTSCS73 00351 ++INCLUDE DTSICPCD DTSCS73 00352 EJECT DTSCS73 00353 LINKAGE SECTION. DTSCS73 00354 DTSCS73 00355 01 DFHCOMMAREA. DTSCS73 00356 ++INCLUDE DTSILCCM DTSCS73 00357 EJECT DTSCS73 00358 ******************************************************************DTSCS73 00359 * *DTSCS73 00360 ******************************************************************DTSCS73 00361 DTSCS73 00362 PROCEDURE DIVISION. DTSCS73 00363 DTSCS73 00364 MOVE +0 TO WRK-EMP-NO. DTSCS73 00365 SET WRK-MPRF-NO-88 TO TRUE. DTSCS73 00366 DTSCS73 00367 MOVE LOW-VALUES TO MAP-AREA. DTSCS73 00368 DTSCS73 00369 SET CURSOR-SET-NO TO TRUE. DTSCS73 00370 DTSCS73 00371 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N) DTSCS73 00372 TO SCR-ACCESS-IND. DTSCS73 00373 DTSCS73 00374 MOVE SPACE TO REQ-IND. DTSCS73 00375 DTSCS73 00376 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS73 00377 DTSCS73 00378 *----------------------------------------------------- DTSCS73 00379 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS73 00380 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS73 00381 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS73 00382 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS73 00383 * DTSCS73 00384 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS73 00385 * PROCESSED. DTSCS73 00386 * DTSCS73 00387 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS73 00388 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS73 00389 * WORK STATION OPERATOR. DTSCS73 00390 *----------------------------------------------------- DTSCS73 00391 DTSCS73 00392 MOVE SPACE TO RESP-IND. DTSCS73 00393 DTSCS73 00394 IF REQ-ERROR DTSCS73 00395 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS73 00396 ELSE DTSCS73 00397 IF REQ-JUMP DTSCS73 00398 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS73 00399 ELSE DTSCS73 00400 IF REQ-CLEAR DTSCS73 00401 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS73 00402 ELSE DTSCS73 00403 IF REQ-CURSOR-TO-GOTO DTSCS73 00404 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS73 00405 ELSE DTSCS73 00406 IF REQ-INQUIRE DTSCS73 00407 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS73 00408 ELSE DTSCS73 00409 IF REQ-EDIT DTSCS73 00410 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS73 00411 ELSE DTSCS73 00412 IF REQ-UPDATE DTSCS73 00413 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS73 00414 ELSE DTSCS73 00415 GO TO S899-ABEND. DTSCS73 00416 DTSCS73 00417 *----------------------------------------------------- DTSCS73 00418 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS73 00419 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS73 00420 *----------------------------------------------------- DTSCS73 00421 DTSCS73 00422 IF RESP-SEND-MAP DTSCS73 00423 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS73 00424 SET LCCM-END-TASK-88 TO TRUE DTSCS73 00425 ELSE DTSCS73 00426 IF RESP-SEND-MSGONLY DTSCS73 00427 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS73 00428 SET LCCM-END-TASK-88 TO TRUE DTSCS73 00429 ELSE DTSCS73 00430 IF RESP-JUMP DTSCS73 00431 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS73 00432 ELSE DTSCS73 00433 IF RESP-CURSOR-TO-GOTO DTSCS73 00434 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS73 00435 SET LCCM-END-TASK-88 TO TRUE DTSCS73 00436 ELSE DTSCS73 00437 GO TO S899-ABEND. DTSCS73 00438 DTSCS73 00439 MAINLINE-EXIT. DTSCS73 00440 DTSCS73 00441 EXEC CICS DTSCS73 00442 RETURN DTSCS73 00443 END-EXEC. DTSCS73 00444 DTSCS73 00445 GOBACK. DTSCS73 00446 EJECT DTSCS73 00447 /*****************************************************************DTSCS73 00448 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS73 00449 ******************************************************************DTSCS73 00450 P1000-ANALYZE-REQUEST. DTSCS73 00451 DTSCS73 00452 *----------------------------------------------------- DTSCS73 00453 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS73 00454 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS73 00455 * REPLACED WITH ENTER) DTSCS73 00456 *----------------------------------------------------- DTSCS73 00457 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS73 00458 SET LCCM-ENTER-88 TO TRUE DTSCS73 00459 IF LCCM-EMP-NO > ZERO DTSCS73 00460 SET REQ-INQUIRE TO TRUE DTSCS73 00461 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS73 00462 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS73 00463 ELSE DTSCS73 00464 SET REQ-INQUIRE TO TRUE DTSCS73 00465 END-IF DTSCS73 00466 GO TO P1000-EXIT. DTSCS73 00467 DTSCS73 00468 *----------------------------------------------------- DTSCS73 00469 * MAP IS RECEIVED DTSCS73 00470 *----------------------------------------------------- DTSCS73 00471 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS73 00472 DTSCS73 00473 *----------------------------------------------------- DTSCS73 00474 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS73 00475 * WORK STATION DTSCS73 00476 *----------------------------------------------------- DTSCS73 00477 IF LCCM-CLEAR-88 DTSCS73 00478 SET REQ-CLEAR TO TRUE DTSCS73 00479 GO TO P1000-EXIT. DTSCS73 00480 DTSCS73 00481 *----------------------------------------------------- DTSCS73 00482 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS73 00483 *----------------------------------------------------- DTSCS73 00484 IF LCCM-SCR-UPDATE-LOCKED DTSCS73 00485 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS73 00486 GO TO P1000-EXIT. DTSCS73 00487 DTSCS73 00488 *----------------------------------------------------- DTSCS73 00489 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS73 00490 *----------------------------------------------------- DTSCS73 00491 IF LCCM-PA2-88 DTSCS73 00492 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS73 00493 GO TO P1000-EXIT. DTSCS73 00494 DTSCS73 00495 *----------------------------------------------------- DTSCS73 00496 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS73 00497 *----------------------------------------------------- DTSCS73 00498 IF LCCM-PA-88 DTSCS73 00499 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS73 00500 SET REQ-ERROR TO TRUE DTSCS73 00501 GO TO P1000-EXIT. DTSCS73 00502 DTSCS73 00503 *----------------------------------------------------- DTSCS73 00504 * IF PF12 IS PRESSED AND UPDATE NOT IN PROGRESS DTSCS73 00505 * CLEAR SCREEN DTSCS73 00506 *----------------------------------------------------- DTSCS73 00507 IF LCCM-F12-88 DTSCS73 00508 MOVE LOW-VALUES TO MAP-AREA DTSCS73 00509 SET REQ-CLEAR TO TRUE DTSCS73 00510 GO TO P1000-EXIT. DTSCS73 00511 DTSCS73 00512 *----------------------------------------------------- DTSCS73 00513 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS73 00514 *----------------------------------------------------- DTSCS73 00515 IF LCCM-F03-88 DTSCS73 00516 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS73 00517 SET REQ-JUMP TO TRUE DTSCS73 00518 GO TO P1000-EXIT. DTSCS73 00519 DTSCS73 00520 *----------------------------------------------------- DTSCS73 00521 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS73 00522 *----------------------------------------------------- DTSCS73 00523 IF LCCM-F04-88 DTSCS73 00524 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS73 00525 SET REQ-JUMP TO TRUE DTSCS73 00526 GO TO P1000-EXIT. DTSCS73 00527 DTSCS73 00528 *--------------------------------------------------------- DTSCS73 00529 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS73 00530 * CORRESPONDENCE SCREEN. DTSCS73 00531 *--------------------------------------------------------- DTSCS73 00532 DTSCS73 00533 IF LCCM-F14-88 DTSCS73 00534 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS73 00535 SET REQ-JUMP TO TRUE DTSCS73 00536 GO TO P1000-EXIT. DTSCS73 00537 DTSCS73 00538 *----------------------------------------------------- DTSCS73 00539 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS73 00540 * REQUESTED SCREEN TYPE DTSCS73 00541 *----------------------------------------------------- DTSCS73 00542 * JUMP: DTSCS73 00543 * DTSCS73 00544 * F17 REGISTRATION INQUIRY (11). DTSCS73 00545 * F19 QUARTER INQUIRY (31). DTSCS73 00546 * F20 COLLECTIONS INQUIRY (41). DTSCS73 00547 * F21 EVENT LOG INQUIRY (72). DTSCS73 00548 * DTSCS73 00549 * IF LCCM-F17-88 DTSCS73 00550 * MOVE '11' TO LCCM-REQ-SCR-ID DTSCS73 00551 * SET REQ-JUMP TO TRUE DTSCS73 00552 * GO TO P1000-EXIT. DTSCS73 00553 * DTSCS73 00554 * IF LCCM-F19-88 DTSCS73 00555 * MOVE '31' TO LCCM-REQ-SCR-ID DTSCS73 00556 * SET REQ-JUMP TO TRUE DTSCS73 00557 * GO TO P1000-EXIT. DTSCS73 00558 * DTSCS73 00559 * IF LCCM-F20-88 DTSCS73 00560 * MOVE '41' TO LCCM-REQ-SCR-ID DTSCS73 00561 * SET REQ-JUMP TO TRUE DTSCS73 00562 * GO TO P1000-EXIT. DTSCS73 00563 * DTSCS73 00564 * IF LCCM-F21-88 DTSCS73 00565 * MOVE '72' TO LCCM-REQ-SCR-ID DTSCS73 00566 * SET REQ-JUMP TO TRUE DTSCS73 00567 * GO TO P1000-EXIT. DTSCS73 00568 DTSCS73 00569 *----------------------------------------------------- DTSCS73 00570 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS73 00571 * REQUESTED SCREEN TYPE DTSCS73 00572 *----------------------------------------------------- DTSCS73 00573 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS73 00574 NEXT SENTENCE DTSCS73 00575 ELSE DTSCS73 00576 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS73 00577 SET REQ-JUMP TO TRUE DTSCS73 00578 GO TO P1000-EXIT. DTSCS73 00579 DTSCS73 00580 *----------------------------------------------------- DTSCS73 00581 * IF REQUEST TO UPDATE THE DATA (ADD,MOD,DEL) DTSCS73 00582 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS73 00583 *----------------------------------------------------- DTSCS73 00584 IF LCCM-F09-88 DTSCS73 00585 OR LCCM-F10-88 DTSCS73 00586 OR LCCM-F23-88 DTSCS73 00587 IF SCR-ACCESS-UPDATE DTSCS73 00588 SET REQ-EDIT TO TRUE DTSCS73 00589 GO TO P1000-EXIT DTSCS73 00590 ELSE DTSCS73 00591 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS73 00592 SET REQ-ERROR TO TRUE DTSCS73 00593 GO TO P1000-EXIT. DTSCS73 00594 DTSCS73 00595 *----------------------------------------------------- DTSCS73 00596 * IF INQUIRY TYPE KEY PRESSED (ENTER, F5, F6, F7, DTSCS73 00597 * OR F8), INDICATE INQUIRY REQUEST DTSCS73 00598 *----------------------------------------------------- DTSCS73 00599 IF LCCM-INQUIRY-88 DTSCS73 00600 SET REQ-INQUIRE TO TRUE DTSCS73 00601 GO TO P1000-EXIT. DTSCS73 00602 DTSCS73 00603 *----------------------------------------------------- DTSCS73 00604 * ANY OTHER KEY IS INVALID DTSCS73 00605 *----------------------------------------------------- DTSCS73 00606 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS73 00607 SET REQ-ERROR TO TRUE. DTSCS73 00608 P1000-EXIT. DTSCS73 00609 EXIT. DTSCS73 00610 DTSCS73 00611 ******************************************************************DTSCS73 00612 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS73 00613 ******************************************************************DTSCS73 00614 DTSCS73 00615 P1100-UPDATE-LOCKED. DTSCS73 00616 *----------------------------------------------------- DTSCS73 00617 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS73 00618 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCS73 00619 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS73 00620 *----------------------------------------------------- DTSCS73 00621 IF LCCM-ENTER-88 OR LCCM-F12-88 DTSCS73 00622 SET REQ-UPDATE TO TRUE DTSCS73 00623 ELSE DTSCS73 00624 SET REQ-ERROR TO TRUE DTSCS73 00625 IF LCCM-SCR-ADD-LOCKED DTSCS73 00626 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS73 00627 ELSE DTSCS73 00628 IF LCCM-SCR-MOD-LOCKED DTSCS73 00629 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS73 00630 ELSE DTSCS73 00631 IF LCCM-SCR-DEL-LOCKED DTSCS73 00632 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID DTSCS73 00633 ELSE DTSCS73 00634 GO TO S899-ABEND. DTSCS73 00635 P1100-EXIT. DTSCS73 00636 EXIT. DTSCS73 00637 /*****************************************************************DTSCS73 00638 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS73 00639 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS73 00640 ******************************************************************DTSCS73 00641 DTSCS73 00642 P2000-REQUEST-ERROR. DTSCS73 00643 IF LCCM-MSG DTSCS73 00644 SET RESP-SEND-MSGONLY TO TRUE DTSCS73 00645 ELSE DTSCS73 00646 GO TO S899-ABEND. DTSCS73 00647 P2000-EXIT. DTSCS73 00648 EXIT. DTSCS73 00649 /*****************************************************************DTSCS73 00650 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS73 00651 ******************************************************************DTSCS73 00652 DTSCS73 00653 P3000-REQUEST-JUMP. DTSCS73 00654 *----------------------------------------------------- DTSCS73 00655 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS73 00656 * BY USER DTSCS73 00657 *----------------------------------------------------- DTSCS73 00658 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS73 00659 DTSCS73 00660 *----------------------------------------------------- DTSCS73 00661 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS73 00662 *----------------------------------------------------- DTSCS73 00663 IF LCCM-MSG DTSCS73 00664 SET RESP-SEND-MSGONLY TO TRUE DTSCS73 00665 SET CURSOR-SET-GOTO TO TRUE DTSCS73 00666 GO TO P3000-EXIT. DTSCS73 00667 SKIP3 DTSCS73 00668 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS73 00669 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS73 00670 IF L018-VALID DTSCS73 00671 MOVE L018-EMP-NO TO LCCM-EMP-NO. DTSCS73 00672 DTSCS73 00673 *----------------------------------------------------- DTSCS73 00674 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS73 00675 *----------------------------------------------------- DTSCS73 00676 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS73 00677 LCCM-SCR-HOLD-AREA. DTSCS73 00678 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS73 00679 SET RESP-JUMP TO TRUE. DTSCS73 00680 P3000-EXIT. DTSCS73 00681 EXIT. DTSCS73 00682 /*****************************************************************DTSCS73 00683 * CLEAR KEY WAS PRESSED *DTSCS73 00684 ******************************************************************DTSCS73 00685 DTSCS73 00686 P4000-REQUEST-CLEAR. DTSCS73 00687 DTSCS73 00688 *----------------------------------------------------- DTSCS73 00689 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS73 00690 * FIELDS FROM EARLIER REQUESTS DTSCS73 00691 *----------------------------------------------------- DTSCS73 00692 IF LCCM-EMP-NO > ZERO DTSCS73 00693 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS73 00694 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS73 00695 DTSCS73 00696 MOVE ZERO TO LCCM-EMP-NO. DTSCS73 00697 DTSCS73 00698 MOVE LOW-VALUES TO LCCM-SCR73-HOLD-AREA. DTSCS73 00699 DTSCS73 00700 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS73 00701 DTSCS73 00702 SET LCCM-SCR-CLEAR TO TRUE. DTSCS73 00703 DTSCS73 00704 IF SCR-ACCESS-UPDATE DTSCS73 00705 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS73 00706 ELSE DTSCS73 00707 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS73 00708 DTSCS73 00709 SET RESP-SEND-MAP TO TRUE. DTSCS73 00710 P4000-EXIT. DTSCS73 00711 EXIT. DTSCS73 00712 /*****************************************************************DTSCS73 00713 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS73 00714 ******************************************************************DTSCS73 00715 DTSCS73 00716 P5000-CURSOR-TO-GOTO. DTSCS73 00717 SET CURSOR-SET-GOTO TO TRUE. DTSCS73 00718 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS73 00719 P5000-EXIT. DTSCS73 00720 EXIT. DTSCS73 00721 /*****************************************************************DTSCS73 00722 * INQUIRY WAS REQUESTED *DTSCS73 00723 ******************************************************************DTSCS73 00724 DTSCS73 00725 P6000-REQUEST-INQUIRE. DTSCS73 00726 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS73 00727 MOVE LOW-VALUES TO MAP-AREA. DTSCS73 00728 MOVE L018-S-EMP-NO-AREA TO MAP-EMP-NO-AREA. DTSCS73 00729 DTSCS73 00730 SET LCCM-SCR-CLEAR TO TRUE. DTSCS73 00731 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS73 00732 DTSCS73 00733 SET RESP-SEND-MAP TO TRUE. DTSCS73 00734 DTSCS73 00735 IF SCR-ACCESS-UPDATE DTSCS73 00736 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS73 00737 ELSE DTSCS73 00738 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS73 00739 DTSCS73 00740 MOVE LCCM-SCR73-HOLD-AREA TO SCR-REC-KEY-AREA. DTSCS73 00741 MOVE LOW-VALUES TO LCCM-SCR73-HOLD-AREA. DTSCS73 00742 DTSCS73 00743 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS73 00744 IF LCCM-MSG DTSCS73 00745 GO TO P6000-EXIT. DTSCS73 00746 DTSCS73 00747 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS73 00748 DTSCS73 00749 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS73 00750 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS73 00751 SET MSKL-EVL-88 TO TRUE. DTSCS73 00752 PERFORM S810-COUNT THRU S810-EXIT. DTSCS73 00753 DTSCS73 00754 IF L810-RECORD-CNT = +0 DTSCS73 00755 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS73 00756 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS73 00757 GO TO P6000-EXIT. DTSCS73 00758 DTSCS73 00759 MOVE L810-RECORD-CNT TO LAST-REC-NUM. DTSCS73 00760 MOVE MSKL-KEY-AREA TO LAST-REC-KEY-AREA. DTSCS73 00761 DTSCS73 00762 PERFORM P6100-LOCATE-REC THRU P6100-EXIT. DTSCS73 00763 IF LCCM-MSG DTSCS73 00764 GO TO P6000-EXIT. DTSCS73 00765 DTSCS73 00766 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS73 00767 DTSCS73 00768 MOVE MEVL-KEY-AREA TO LCCM-SCR73-HOLD-AREA. DTSCS73 00769 DTSCS73 00770 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS73 00771 DTSCS73 00772 IF SCR-ACCESS-UPDATE DTSCS73 00773 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS73 00774 P6000-EXIT. DTSCS73 00775 EXIT. DTSCS73 00776 EJECT DTSCS73 00777 DTSCS73 00778 P6100-LOCATE-REC. DTSCS73 00779 *------------------------------------------------------------ DTSCS73 00780 * IF, AT THE LAST USE OF THIS SCREEN, A RECORD FOR DTSCS73 00781 * EMPLOYER NUMBER LCCM-EMP-NO WAS DISPLAYED ON THE DTSCS73 00782 * SCREEN, THEN BASE THE PAGING LOGIC ON THE LAST RECORD DTSCS73 00783 * DISPLAYED ON THIS SCREEN; OTHERWISE, DISPLAY THE DTSCS73 00784 * RECORD WITH THE GREATEST MEVL-DATE DTSCS73 00785 *------------------------------------------------------------ DTSCS73 00786 DTSCS73 00787 IF SCR-REC-KEY-AREA = LOW-VALUES DTSCS73 00788 PERFORM P6140-LAST-REC THRU P6140-EXIT DTSCS73 00789 GO TO P6100-EXIT. DTSCS73 00790 DTSCS73 00791 MOVE SCR-REC-KEY-AREA TO MEVL-KEY-AREA. DTSCS73 00792 DTSCS73 00793 IF WRK-EMP-NO = MEVL-EMP-NO DTSCS73 00794 NEXT SENTENCE DTSCS73 00795 ELSE DTSCS73 00796 PERFORM P6140-LAST-REC THRU P6140-EXIT DTSCS73 00797 GO TO P6100-EXIT. DTSCS73 00798 DTSCS73 00799 IF LCCM-F05-88 DTSCS73 00800 PERFORM P6110-FIRST-REC THRU P6110-EXIT DTSCS73 00801 GO TO P6100-EXIT. DTSCS73 00802 DTSCS73 00803 IF LCCM-F06-88 DTSCS73 00804 PERFORM P6140-LAST-REC THRU P6140-EXIT DTSCS73 00805 GO TO P6100-EXIT. DTSCS73 00806 DTSCS73 00807 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS73 00808 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS73 00809 SET MSKL-EVL-88 TO TRUE. DTSCS73 00810 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS73 00811 IF L810-NO-REC-88 DTSCS73 00812 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS73 00813 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS73 00814 GO TO P6100-EXIT. DTSCS73 00815 DTSCS73 00816 MOVE +0 TO WS-REC-NUM. DTSCS73 00817 MOVE 'N' TO WS-REC-FOUND-IND. DTSCS73 00818 PERFORM P6190-BROWSE-MEVL THRU P6190-EXIT DTSCS73 00819 UNTIL (L810-NO-REC-88) DTSCS73 00820 OR DTSCS73 00821 (WS-REC-FOUND-IND = 'Y'). DTSCS73 00822 DTSCS73 00823 IF L810-NO-REC-88 DTSCS73 00824 PERFORM P6140-LAST-REC THRU P6140-EXIT DTSCS73 00825 GO TO P6100-EXIT. DTSCS73 00826 DTSCS73 00827 IF LCCM-ENTER-88 DTSCS73 00828 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS73 00829 GO TO P6100-EXIT. DTSCS73 00830 DTSCS73 00831 IF LCCM-F07-88 DTSCS73 00832 PERFORM P6120-PREV-REC THRU P6120-EXIT DTSCS73 00833 GO TO P6100-EXIT. DTSCS73 00834 DTSCS73 00835 IF LCCM-F08-88 DTSCS73 00836 PERFORM P6130-NEXT-REC THRU P6130-EXIT DTSCS73 00837 GO TO P6100-EXIT. DTSCS73 00838 DTSCS73 00839 GO TO S899-ABEND. DTSCS73 00840 P6100-EXIT. DTSCS73 00841 EXIT. DTSCS73 00842 DTSCS73 00843 P6110-FIRST-REC. DTSCS73 00844 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS73 00845 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS73 00846 SET MSKL-EVL-88 TO TRUE. DTSCS73 00847 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS73 00848 IF L810-NO-REC-88 DTSCS73 00849 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS73 00850 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS73 00851 GO TO P6110-EXIT. DTSCS73 00852 DTSCS73 00853 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS73 00854 DTSCS73 00855 MOVE MSKL-REC TO MEVL-REC. DTSCS73 00856 DTSCS73 00857 MOVE +1 TO WS-REC-NUM. DTSCS73 00858 P6110-EXIT. DTSCS73 00859 EXIT. DTSCS73 00860 DTSCS73 00861 P6120-PREV-REC. DTSCS73 00862 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCS73 00863 IF L810-NO-REC-88 DTSCS73 00864 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS73 00865 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS73 00866 GO TO P6120-EXIT. DTSCS73 00867 DTSCS73 00868 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCS73 00869 IF L810-NO-REC-88 DTSCS73 00870 GO TO P6120-EXIT. DTSCS73 00871 DTSCS73 00872 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS73 00873 DTSCS73 00874 SUBTRACT 1 FROM WS-REC-NUM. DTSCS73 00875 DTSCS73 00876 MOVE MSKL-REC TO MEVL-REC. DTSCS73 00877 P6120-EXIT. DTSCS73 00878 EXIT. DTSCS73 00879 DTSCS73 00880 P6130-NEXT-REC. DTSCS73 00881 IF MEVL-KEY-AREA > SCR-REC-KEY-AREA DTSCS73 00882 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS73 00883 GO TO P6130-EXIT. DTSCS73 00884 DTSCS73 00885 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS73 00886 DTSCS73 00887 IF L810-NO-REC-88 DTSCS73 00888 GO TO P6130-EXIT. DTSCS73 00889 DTSCS73 00890 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS73 00891 DTSCS73 00892 ADD +1 TO WS-REC-NUM. DTSCS73 00893 DTSCS73 00894 MOVE MSKL-REC TO MEVL-REC. DTSCS73 00895 P6130-EXIT. DTSCS73 00896 EXIT. DTSCS73 00897 DTSCS73 00898 P6140-LAST-REC. DTSCS73 00899 MOVE LAST-REC-KEY-AREA TO MSKL-KEY-AREA. DTSCS73 00900 PERFORM S810-READ THRU S810-EXIT. DTSCS73 00901 IF L810-NO-REC-88 DTSCS73 00902 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS73 00903 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS73 00904 GO TO P6140-EXIT. DTSCS73 00905 DTSCS73 00906 MOVE MSKL-REC TO MEVL-REC. DTSCS73 00907 DTSCS73 00908 MOVE LAST-REC-NUM TO WS-REC-NUM. DTSCS73 00909 P6140-EXIT. DTSCS73 00910 EXIT. DTSCS73 00911 DTSCS73 00912 P6190-BROWSE-MEVL. DTSCS73 00913 MOVE MSKL-REC TO MEVL-REC. DTSCS73 00914 ADD +1 TO WS-REC-NUM. DTSCS73 00915 IF MEVL-KEY-AREA NOT < SCR-REC-KEY-AREA DTSCS73 00916 MOVE 'Y' TO WS-REC-FOUND-IND DTSCS73 00917 ELSE DTSCS73 00918 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS73 00919 P6190-EXIT. DTSCS73 00920 EXIT. DTSCS73 00921 /*****************************************************************DTSCS73 00922 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCS73 00923 ******************************************************************DTSCS73 00924 DTSCS73 00925 P6900-CONSTRUCT-SCREEN. DTSCS73 00926 PERFORM P6910-FROM-MEVL THRU P6910-EXIT. DTSCS73 00927 DTSCS73 00928 PERFORM P6990-PAGE-NUMBER THRU P6990-EXIT. DTSCS73 00929 P6900-EXIT. DTSCS73 00930 EXIT. DTSCS73 00931 DTSCS73 00932 P6910-FROM-MEVL. DTSCS73 00933 MOVE MEVL-DATE TO WRK-DISPLAY. DTSCS73 00934 MOVE WRK-DISPLAY-YR TO MAP-DATE-YR. DTSCS73 00935 MOVE WRK-DISPLAY-MO TO MAP-DATE-MO. DTSCS73 00936 MOVE WRK-DISPLAY-DA TO MAP-DATE-DA. DTSCS73 00937 DTSCS73 00938 MOVE MEVL-TIME TO WRK-DISPLAY. DTSCS73 00939 MOVE WRK-DISPLAY-HR TO MAP-TIME-HR. DTSCS73 00940 MOVE WRK-DISPLAY-MN TO MAP-TIME-MN. DTSCS73 00941 MOVE WRK-DISPLAY-SC TO MAP-TIME-SC. DTSCS73 00942 DTSCS73 00943 IF MEVL-BA-STATUS-88 DTSCS73 00944 MOVE 'X' TO MAP-STAT DTSCS73 00945 ELSE DTSCS73 00946 MOVE '_' TO MAP-STAT. DTSCS73 00947 DTSCS73 00948 IF MEVL-BA-ACCOUNTING-88 DTSCS73 00949 MOVE 'X' TO MAP-REPT DTSCS73 00950 ELSE DTSCS73 00951 MOVE '_' TO MAP-REPT. DTSCS73 00952 DTSCS73 00953 IF MEVL-BA-COLLECTIONS-88 DTSCS73 00954 MOVE 'X' TO MAP-COLL DTSCS73 00955 ELSE DTSCS73 00956 MOVE '_' TO MAP-COLL. DTSCS73 00957 DTSCS73 00958 IF MEVL-BA-RATING-88 DTSCS73 00959 MOVE 'X' TO MAP-RATING DTSCS73 00960 ELSE DTSCS73 00961 MOVE '_' TO MAP-RATING. DTSCS73 00962 DTSCS73 00963 IF MEVL-BA-AUDIT-88 DTSCS73 00964 MOVE 'X' TO MAP-AUDIT DTSCS73 00965 ELSE DTSCS73 00966 MOVE '_' TO MAP-AUDIT. DTSCS73 00967 DTSCS73 00968 IF MEVL-BA-STATUS-APPRV-88 DTSCS73 00969 MOVE 'X' TO MAP-APPRV DTSCS73 00970 ELSE DTSCS73 00971 MOVE '_' TO MAP-APPRV. DTSCS73 00972 DTSCS73 00973 DTSCS73 00974 IF MEVL-ACT-CALL-EMP-88 DTSCS73 00975 MOVE 'X' TO MAP-CALL-EMP DTSCS73 00976 ELSE DTSCS73 00977 MOVE '_' TO MAP-CALL-EMP. DTSCS73 00978 IF MEVL-ACT-PROC-CALL-LTR-88 DTSCS73 00979 MOVE 'X' TO MAP-PROC-CLN DTSCS73 00980 ELSE DTSCS73 00981 MOVE '_' TO MAP-PROC-CLN. DTSCS73 00982 IF MEVL-ACT-CALL-AGNT-88 DTSCS73 00983 MOVE 'X' TO MAP-CALL-AGNT DTSCS73 00984 ELSE DTSCS73 00985 MOVE '_' TO MAP-CALL-AGNT. DTSCS73 00986 IF MEVL-ACT-SEND-FR500-88 DTSCS73 00987 MOVE 'X' TO MAP-SEND-500 DTSCS73 00988 ELSE DTSCS73 00989 MOVE '_' TO MAP-SEND-500. DTSCS73 00990 IF MEVL-ACT-LETR-EMP-AGNT-88 OR MEVL-ACT-LETR-AGNT-88 DTSCS73 00991 MOVE 'X' TO MAP-LETR-EMP-AGNT DTSCS73 00992 ELSE DTSCS73 00993 MOVE '_' TO MAP-LETR-EMP-AGNT. DTSCS73 00994 IF MEVL-ACT-SEND-UC30-88 DTSCS73 00995 MOVE 'X' TO MAP-SEND-30H DTSCS73 00996 ELSE DTSCS73 00997 MOVE '_' TO MAP-SEND-30H. DTSCS73 00998 IF MEVL-ACT-SEND-UC226-88 DTSCS73 00999 MOVE 'X' TO MAP-SEND-226 DTSCS73 01000 ELSE DTSCS73 01001 MOVE '_' TO MAP-SEND-226. DTSCS73 01002 IF MEVL-ACT-FLD-VISIT-88 DTSCS73 01003 MOVE 'X' TO MAP-FLD-VISIT DTSCS73 01004 ELSE DTSCS73 01005 MOVE '_' TO MAP-FLD-VISIT. DTSCS73 01006 IF MEVL-ACT-RSLV-BLK-CLM-88 DTSCS73 01007 MOVE 'X' TO MAP-RSLV-BC DTSCS73 01008 ELSE DTSCS73 01009 MOVE '_' TO MAP-RSLV-BC. DTSCS73 01010 DTSCS73 01011 IF MEVL-ACT-SRCH-DUTAS-88 DTSCS73 01012 MOVE 'X' TO MAP-SRCH-TAX DTSCS73 01013 ELSE DTSCS73 01014 MOVE '_' TO MAP-SRCH-TAX. DTSCS73 01015 IF MEVL-ACT-PRE-AUDIT-88 DTSCS73 01016 MOVE 'X' TO MAP-PRE-AWU DTSCS73 01017 ELSE DTSCS73 01018 MOVE '_' TO MAP-PRE-AWU. DTSCS73 01019 IF MEVL-ACT-SRCH-EXTRNL-88 DTSCS73 01020 MOVE 'X' TO MAP-SRCH-EXT DTSCS73 01021 ELSE DTSCS73 01022 MOVE '_' TO MAP-SRCH-EXT. DTSCS73 01023 IF MEVL-ACT-EMP-VISIT-88 DTSCS73 01024 MOVE 'X' TO MAP-EMP-VISIT DTSCS73 01025 ELSE DTSCS73 01026 MOVE '_' TO MAP-EMP-VISIT. DTSCS73 01027 IF MEVL-ACT-SRCH-TAX-FILE-88 DTSCS73 01028 MOVE 'X' TO MAP-SRCH-FILE DTSCS73 01029 ELSE DTSCS73 01030 MOVE '_' TO MAP-SRCH-FILE. DTSCS73 01031 DTSCS73 01032 IF MEVL-ACT-APPRV-SUCC-88 DTSCS73 01033 MOVE 'X' TO MAP-PRED-SUCC DTSCS73 01034 ELSE DTSCS73 01035 MOVE '_' TO MAP-PRED-SUCC. DTSCS73 01036 DTSCS73 01037 IF MEVL-ACT-APPRV-INACT-88 DTSCS73 01038 MOVE 'X' TO MAP-CHNG-SOL DTSCS73 01039 ELSE DTSCS73 01040 MOVE '_' TO MAP-CHNG-SOL. DTSCS73 01041 DTSCS73 01042 IF MEVL-ACT-APPRV-RATE-88 DTSCS73 01043 MOVE 'X' TO MAP-CHNG-RATE DTSCS73 01044 ELSE DTSCS73 01045 MOVE '_' TO MAP-CHNG-RATE. DTSCS73 01046 DTSCS73 01047 IF MEVL-ACT-APPRV-WO-88 DTSCS73 01048 MOVE 'X' TO MAP-WRITE-OFF DTSCS73 01049 ELSE DTSCS73 01050 MOVE '_' TO MAP-WRITE-OFF. DTSCS73 01051 DTSCS73 01052 MOVE MEVL-ESTB-DATE TO L001-FED-8-DATE-9. DTSCS73 01053 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSCS73 01054 MOVE L001-SLASH-DATE TO MAP-ESTB-DATE. DTSCS73 01055 DTSCS73 01056 MOVE MEVL-CHNG-DATE TO L001-FED-8-DATE-9. DTSCS73 01057 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSCS73 01058 MOVE L001-SLASH-DATE TO MAP-CHNG-DATE. DTSCS73 01059 DTSCS73 01060 MOVE MEVL-SOURCE TO MAP-SOURCE. DTSCS73 01061 DTSCS73 01062 MOVE MEVL-TEXT TO MAP-TEXT. DTSCS73 01063 DTSCS73 01064 P6910-EXIT. DTSCS73 01065 EXIT. DTSCS73 01066 DTSCS73 01067 P6990-PAGE-NUMBER. DTSCS73 01068 MOVE WS-REC-NUM TO MAP-CURR-PAGE. DTSCS73 01069 MOVE LAST-REC-NUM TO MAP-LAST-PAGE. DTSCS73 01070 DTSCS73 01071 IF WS-REC-NUM = +1 DTSCS73 01072 IF LAST-REC-NUM = +1 DTSCS73 01073 MOVE PMSG-ONLY-PAGE TO LCCM-MSG-AREA DTSCS73 01074 ELSE DTSCS73 01075 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-AREA DTSCS73 01076 ELSE DTSCS73 01077 IF WS-REC-NUM = LAST-REC-NUM DTSCS73 01078 MOVE PMSG-LAST-PAGE TO LCCM-MSG-AREA. DTSCS73 01079 P6990-EXIT. DTSCS73 01080 EXIT. DTSCS73 01081 /*****************************************************************DTSCS73 01082 * FUNCTION KEY TO ADD, MOD OR DEL THE RECORD WAS PRESSED. *DTSCS73 01083 ******************************************************************DTSCS73 01084 DTSCS73 01085 P7000-REQUEST-EDIT. DTSCS73 01086 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS73 01087 DTSCS73 01088 IF LCCM-F09-88 DTSCS73 01089 PERFORM P7100-EDIT-ADD THRU P7100-EXIT DTSCS73 01090 ELSE DTSCS73 01091 IF LCCM-F10-88 DTSCS73 01092 PERFORM P7200-EDIT-MOD THRU P7200-EXIT DTSCS73 01093 ELSE DTSCS73 01094 IF LCCM-F23-88 DTSCS73 01095 PERFORM P7300-EDIT-DEL THRU P7300-EXIT DTSCS73 01096 ELSE DTSCS73 01097 GO TO S899-ABEND. DTSCS73 01098 DTSCS73 01099 *------------------------------------------------------ DTSCS73 01100 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCS73 01101 * IN ORDER TO CONTINUE TO ATTEMPT A MOD THE SCREEN MUST DTSCS73 01102 * REMAIN IN 'INQUIRE' STATUS. DTSCS73 01103 *------------------------------------------------------ DTSCS73 01104 DTSCS73 01105 IF LCCM-MSG DTSCS73 01106 NEXT SENTENCE DTSCS73 01107 ELSE DTSCS73 01108 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCS73 01109 IF LCCM-F09-88 DTSCS73 01110 SET LCCM-SCR-ADD-LOCKED TO TRUE DTSCS73 01111 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS73 01112 ELSE DTSCS73 01113 IF LCCM-F10-88 DTSCS73 01114 SET LCCM-SCR-MOD-LOCKED TO TRUE DTSCS73 01115 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS73 01116 ELSE DTSCS73 01117 IF LCCM-F23-88 DTSCS73 01118 SET LCCM-SCR-DEL-LOCKED TO TRUE DTSCS73 01119 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID. DTSCS73 01120 DTSCS73 01121 SET RESP-SEND-MAP TO TRUE. DTSCS73 01122 P7000-EXIT. DTSCS73 01123 EXIT. DTSCS73 01124 /*****************************************************************DTSCS73 01125 * ADD FUNCTION WAS REQUESTED *DTSCS73 01126 ******************************************************************DTSCS73 01127 DTSCS73 01128 P7100-EDIT-ADD. DTSCS73 01129 *----------------------------------------------------- DTSCS73 01130 * ADDITION REQUIRES THAT THE SCREEN WAS CLEARED FIRST DTSCS73 01131 *----------------------------------------------------- DTSCS73 01132 IF NOT LCCM-SCR-CLEAR DTSCS73 01133 MOVE EMSG-ADD-PRECEDED TO LCCM-MSG-ID DTSCS73 01134 GO TO P7100-EXIT. DTSCS73 01135 DTSCS73 01136 *----------------------------------------------------- DTSCS73 01137 * MAP-EMP-NO MAY NOT BE CHANGED DURING THE ADD DTSCS73 01138 *----------------------------------------------------- DTSCS73 01139 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS73 01140 IF LCCM-MSG DTSCS73 01141 GO TO P7100-EXIT. DTSCS73 01142 DTSCS73 01143 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS73 01144 P7100-EXIT. DTSCS73 01145 EXIT. DTSCS73 01146 /*****************************************************************DTSCS73 01147 * MODIFICATION FUNCTION WAS REQUESTED *DTSCS73 01148 ******************************************************************DTSCS73 01149 DTSCS73 01150 P7200-EDIT-MOD. DTSCS73 01151 *----------------------------------------------------- DTSCS73 01152 * MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS73 01153 * INQUIRED DTSCS73 01154 *----------------------------------------------------- DTSCS73 01155 IF NOT LCCM-SCR-INQUIRE DTSCS73 01156 MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-ID DTSCS73 01157 GO TO P7200-EXIT. DTSCS73 01158 DTSCS73 01159 *----------------------------------------------------- DTSCS73 01160 * MAP-EMP-NO MAY NOT BE CHANGED DURING THE MOD DTSCS73 01161 *----------------------------------------------------- DTSCS73 01162 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS73 01163 IF LCCM-MSG DTSCS73 01164 GO TO P7200-EXIT. DTSCS73 01165 DTSCS73 01166 IF LCCM-EMP-NO NOT = WRK-EMP-NO DTSCS73 01167 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS73 01168 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS73 01169 GO TO P7200-EXIT. DTSCS73 01170 DTSCS73 01171 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS73 01172 DTSCS73 01173 P7200-EXIT. DTSCS73 01174 EXIT. DTSCS73 01175 /*****************************************************************DTSCS73 01176 * DELETE FUNCTION WAS REQUESTED *DTSCS73 01177 ******************************************************************DTSCS73 01178 DTSCS73 01179 P7300-EDIT-DEL. DTSCS73 01180 *----------------------------------------------------- DTSCS73 01181 * DELETION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS73 01182 * INQUIRED DTSCS73 01183 *----------------------------------------------------- DTSCS73 01184 IF NOT LCCM-SCR-INQUIRE DTSCS73 01185 MOVE EMSG-DEL-PRECEDED TO LCCM-MSG-ID DTSCS73 01186 GO TO P7300-EXIT. DTSCS73 01187 DTSCS73 01188 *----------------------------------------------------- DTSCS73 01189 * MAP-EMP-NO MAY NOT BE CHANGED DURING THE DEL DTSCS73 01190 *----------------------------------------------------- DTSCS73 01191 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS73 01192 IF LCCM-MSG DTSCS73 01193 GO TO P7300-EXIT. DTSCS73 01194 DTSCS73 01195 IF LCCM-EMP-NO NOT = WRK-EMP-NO DTSCS73 01196 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS73 01197 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS73 01198 GO TO P7300-EXIT. DTSCS73 01199 DTSCS73 01200 IF LCCM-OP-ID NOT EQUAL MAP-SOURCE DTSCS73 01201 MOVE MSG-E736-AREA TO WRK-MSG-AREA DTSCS73 01202 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS73 01203 GO TO P7300-EXIT. DTSCS73 01204 *----------------------------------------------------- DTSCS73 01205 * DATE AND TIME MAY NOT BE CHANGED DURING THE DEL DTSCS73 01206 *----------------------------------------------------- DTSCS73 01207 MOVE LCCM-SCR73-HOLD-AREA TO MEVL-KEY-AREA. DTSCS73 01208 DTSCS73 01209 MOVE MAP-DATE-AREA TO L015-S-DATE-AREA. DTSCS73 01210 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS73 01211 MOVE MAP-TIME-AREA TO L025-S-TIME-AREA. DTSCS73 01212 PERFORM S025-TIME-FROM-SCREEN THRU S025-EXIT. DTSCS73 01213 DTSCS73 01214 IF L015-DATE = MEVL-DATE DTSCS73 01215 AND L025-TIME = MEVL-TIME DTSCS73 01216 CONTINUE DTSCS73 01217 ELSE DTSCS73 01218 MOVE MSG-E732-AREA TO WRK-MSG-AREA DTSCS73 01219 GO TO P7300-EXIT DTSCS73 01220 END-IF. DTSCS73 01221 P7300-EXIT. DTSCS73 01222 EXIT. DTSCS73 01223 /*****************************************************************DTSCS73 01224 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED *DTSCS73 01225 ******************************************************************DTSCS73 01226 DTSCS73 01227 P8000-REQUEST-UPDATE. DTSCS73 01228 DTSCS73 01229 IF LCCM-SCR-ADD-LOCKED DTSCS73 01230 PERFORM P8100-ADD THRU P8100-EXIT DTSCS73 01231 ELSE DTSCS73 01232 IF LCCM-SCR-MOD-LOCKED DTSCS73 01233 PERFORM P8200-MOD THRU P8200-EXIT DTSCS73 01234 ELSE DTSCS73 01235 IF LCCM-SCR-DEL-LOCKED DTSCS73 01236 PERFORM P8300-DEL THRU P8300-EXIT DTSCS73 01237 ELSE DTSCS73 01238 GO TO S899-ABEND. DTSCS73 01239 DTSCS73 01240 SET RESP-SEND-MAP TO TRUE. DTSCS73 01241 P8000-EXIT. DTSCS73 01242 EXIT. DTSCS73 01243 /*****************************************************************DTSCS73 01244 * *DTSCS73 01245 ******************************************************************DTSCS73 01246 DTSCS73 01247 P8100-ADD. DTSCS73 01248 SET LCCM-SCR-CLEAR TO TRUE. DTSCS73 01249 DTSCS73 01250 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS73 01251 DTSCS73 01252 IF LCCM-F12-88 DTSCS73 01253 MOVE PMSG-ADD-CANCELED TO LCCM-MSG-ID DTSCS73 01254 GO TO P8100-EXIT. DTSCS73 01255 DTSCS73 01256 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS73 01257 DTSCS73 01258 MOVE 'A' TO L221-UPDATE-FUNCTION. DTSCS73 01259 PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS73 01260 IF LCCM-MSG DTSCS73 01261 GO TO P8100-EXIT. DTSCS73 01262 DTSCS73 01263 PERFORM P8110-CONSTRUCT-MEVL THRU P8110-EXIT. DTSCS73 01264 DTSCS73 01265 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS73 01266 DTSCS73 01267 DTSCS73 01268 MOVE MEVL-KEY-AREA TO LCCM-SCR73-HOLD-AREA. DTSCS73 01269 SET LCCM-ENTER-88 TO TRUE. DTSCS73 01270 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT. DTSCS73 01271 DTSCS73 01272 MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS73 01273 DTSCS73 01274 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS73 01275 P8100-EXIT. DTSCS73 01276 EXIT. DTSCS73 01277 DTSCS73 01278 P8110-CONSTRUCT-MEVL. DTSCS73 01279 MOVE LOW-VALUES TO MEVL-REC. DTSCS73 01280 MOVE WRK-EMP-NO TO MEVL-EMP-NO. DTSCS73 01281 SET MEVL-EVL-88 TO TRUE. DTSCS73 01282 DTSCS73 01283 SET MEVL-NOT-CONVERTED-88 TO TRUE. DTSCS73 01284 DTSCS73 01285 MOVE LCCM-CURR-RUN-DATE TO MEVL-ESTB-DATE. DTSCS73 01286 MOVE LCCM-CURR-RUN-DATE TO MEVL-CHNG-DATE. DTSCS73 01287 DTSCS73 01288 MOVE MAP-DATE-AREA TO L015-S-DATE-AREA. DTSCS73 01289 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS73 01290 MOVE L015-DATE TO MEVL-DATE. DTSCS73 01291 DTSCS73 01292 MOVE MAP-TIME-AREA TO L025-S-TIME-AREA. DTSCS73 01293 PERFORM S025-TIME-FROM-SCREEN THRU S025-EXIT. DTSCS73 01294 MOVE L025-TIME TO MEVL-TIME. DTSCS73 01295 DTSCS73 01296 *** MOVE OF TEXT IS NOW IN P8900 DTSCS73 01297 *** MOVE MAP-TEXT TO MEVL-TEXT. DTSCS73 01298 DTSCS73 01299 MOVE MAP-SOURCE TO MEVL-SOURCE. DTSCS73 01300 DTSCS73 01301 PERFORM P8900-EVENT-LOG-VALUES THRU P8900-EXIT. DTSCS73 01302 DTSCS73 01303 MOVE MEVL-REC TO MSKL-REC. DTSCS73 01304 PERFORM S810-WRITE THRU S810-EXIT. DTSCS73 01305 DTSCS73 01306 P8110-EXIT. DTSCS73 01307 EXIT. DTSCS73 01308 DTSCS73 01309 /*****************************************************************DTSCS73 01310 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS73 01311 ******************************************************************DTSCS73 01312 DTSCS73 01313 P8200-MOD. DTSCS73 01314 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS73 01315 DTSCS73 01316 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS73 01317 DTSCS73 01318 IF LCCM-F12-88 DTSCS73 01319 MOVE PMSG-MOD-CANCELED TO LCCM-MSG-ID DTSCS73 01320 GO TO P8200-EXIT. DTSCS73 01321 DTSCS73 01322 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS73 01323 DTSCS73 01324 MOVE 'M' TO L221-UPDATE-FUNCTION. DTSCS73 01325 PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS73 01326 IF LCCM-MSG DTSCS73 01327 GO TO P8200-EXIT. DTSCS73 01328 DTSCS73 01329 PERFORM P8210-CONSTRUCT-MEVL THRU P8210-EXIT. DTSCS73 01330 DTSCS73 01331 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS73 01332 DTSCS73 01333 MOVE MEVL-KEY-AREA TO LCCM-SCR73-HOLD-AREA. DTSCS73 01334 SET LCCM-ENTER-88 TO TRUE. DTSCS73 01335 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT. DTSCS73 01336 DTSCS73 01337 MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS73 01338 DTSCS73 01339 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS73 01340 P8200-EXIT. DTSCS73 01341 EXIT. DTSCS73 01342 EJECT DTSCS73 01343 P8210-CONSTRUCT-MEVL. DTSCS73 01344 MOVE LCCM-SCR73-HOLD-AREA TO MSKL-KEY-AREA. DTSCS73 01345 DTSCS73 01346 PERFORM S810-READ THRU S810-EXIT. DTSCS73 01347 IF L810-NO-REC-88 DTSCS73 01348 GO TO S899-ABEND. DTSCS73 01349 DTSCS73 01350 MOVE MSKL-REC TO MEVL-REC. DTSCS73 01351 DTSCS73 01352 MOVE LCCM-CURR-RUN-DATE TO MEVL-CHNG-DATE. DTSCS73 01353 MOVE MAP-TEXT TO MEVL-TEXT. DTSCS73 01354 MOVE MAP-SOURCE TO MEVL-SOURCE. DTSCS73 01355 DTSCS73 01356 MOVE LCCM-CURR-RUN-DATE TO MEVL-CHNG-DATE. DTSCS73 01357 DTSCS73 01358 PERFORM P8900-EVENT-LOG-VALUES THRU P8900-EXIT. DTSCS73 01359 DTSCS73 01360 MOVE MAP-DATE-AREA TO L015-S-DATE-AREA. DTSCS73 01361 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS73 01362 MOVE MAP-TIME-AREA TO L025-S-TIME-AREA. DTSCS73 01363 PERFORM S025-TIME-FROM-SCREEN THRU S025-EXIT. DTSCS73 01364 DTSCS73 01365 IF L015-DATE = MEVL-DATE DTSCS73 01366 AND L025-TIME = MEVL-TIME DTSCS73 01367 MOVE MEVL-REC TO MSKL-REC DTSCS73 01368 PERFORM S810-REWRITE THRU S810-EXIT DTSCS73 01369 ELSE DTSCS73 01370 PERFORM S810-DELETE THRU S810-EXIT DTSCS73 01371 MOVE L015-DATE TO MEVL-DATE DTSCS73 01372 MOVE L025-TIME TO MEVL-TIME DTSCS73 01373 MOVE MEVL-REC TO MSKL-REC DTSCS73 01374 PERFORM S810-WRITE THRU S810-EXIT DTSCS73 01375 END-IF. DTSCS73 01376 DTSCS73 01377 P8210-EXIT. DTSCS73 01378 EXIT. DTSCS73 01379 /*****************************************************************DTSCS73 01380 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS73 01381 ******************************************************************DTSCS73 01382 DTSCS73 01383 P8300-DEL. DTSCS73 01384 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS73 01385 DTSCS73 01386 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS73 01387 DTSCS73 01388 IF LCCM-F12-88 DTSCS73 01389 MOVE PMSG-DEL-CANCELED TO LCCM-MSG-ID DTSCS73 01390 GO TO P8300-EXIT. DTSCS73 01391 DTSCS73 01392 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS73 01393 DTSCS73 01394 MOVE 'D' TO L221-UPDATE-FUNCTION. DTSCS73 01395 PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS73 01396 IF LCCM-MSG DTSCS73 01397 GO TO P8300-EXIT. DTSCS73 01398 DTSCS73 01399 DTSCS73 01400 MOVE LCCM-SCR73-HOLD-AREA TO MSKL-KEY-AREA. DTSCS73 01401 PERFORM S810-READ THRU S810-EXIT. DTSCS73 01402 IF L810-NO-REC-88 DTSCS73 01403 GO TO S899-ABEND. DTSCS73 01404 DTSCS73 01405 MOVE MSKL-REC TO MEVL-REC. DTSCS73 01406 DTSCS73 01407 PERFORM S810-DELETE THRU S810-EXIT. DTSCS73 01408 DTSCS73 01409 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS73 01410 DTSCS73 01411 MOVE LOW-VALUES TO MAP-AREA. DTSCS73 01412 DTSCS73 01413 MOVE WRK-EMP-NO TO WRK-DISPLAY. DTSCS73 01414 MOVE WRK-DISPLAY-EMP-NO-1 TO MAP-EMP-NO-1. DTSCS73 01415 MOVE WRK-DISPLAY-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS73 01416 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS73 01417 DTSCS73 01418 MOVE MEVL-DATE TO WRK-DISPLAY. DTSCS73 01419 MOVE WRK-DISPLAY-MO TO MAP-DATE-MO. DTSCS73 01420 MOVE WRK-DISPLAY-DA TO MAP-DATE-DA. DTSCS73 01421 MOVE WRK-DISPLAY-YR TO MAP-DATE-YR. DTSCS73 01422 DTSCS73 01423 MOVE MEVL-TIME TO WRK-DISPLAY. DTSCS73 01424 MOVE WRK-DISPLAY-HR TO MAP-TIME-HR. DTSCS73 01425 MOVE WRK-DISPLAY-MN TO MAP-TIME-MN. DTSCS73 01426 MOVE WRK-DISPLAY-SC TO MAP-TIME-SC. DTSCS73 01427 DTSCS73 01428 SET LCCM-SCR-CLEAR TO TRUE. DTSCS73 01429 DTSCS73 01430 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS73 01431 DTSCS73 01432 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS73 01433 DTSCS73 01434 MOVE PMSG-DEL-SUCCESSFUL TO LCCM-MSG-ID. DTSCS73 01435 P8300-EXIT. DTSCS73 01436 EXIT. DTSCS73 01437 EJECT DTSCS73 01438 DTSCS73 01439 DTSCS73 01440 P8810-LOCK-EMPLOYER. DTSCS73 01441 MOVE WRK-EMP-NO TO L221-EMP-NO. DTSCS73 01442 MOVE LCCM-SCR-ABSTIME TO L221-SCR-ABSTIME. DTSCS73 01443 MOVE LCCM-TASK-ID TO L221-UPDATE-TASK-ID. DTSCS73 01444 MOVE LCCM-OP-ID TO L221-UPDATE-OP-ID. DTSCS73 01445 MOVE LCCM-CICS-TERM-ID TO L221-UPDATE-TERMID. DTSCS73 01446 MOVE LCCM-TASK-NETNAME TO L221-UPDATE-NETNAME. DTSCS73 01447 MOVE LCCM-TASK-START-DATE TO L221-UPDATE-START-DATE. DTSCS73 01448 MOVE LCCM-TASK-START-TIME TO L221-UPDATE-START-TIME. DTSCS73 01449 MOVE WRK-SCR-ID TO L221-UPDATE-SCR-ID. DTSCS73 01450 DTSCS73 01451 PERFORM S221-EMP-LOCK THRU S221-EXIT. DTSCS73 01452 P8810-EXIT. DTSCS73 01453 EXIT. DTSCS73 01454 EJECT DTSCS73 01455 DTSCS73 01456 P8900-EVENT-LOG-VALUES. DTSCS73 01457 EVALUATE TRUE DTSCS73 01458 WHEN MAP-STAT NOT = '_' AND SPACES DTSCS73 01459 SET MEVL-BA-STATUS-88 TO TRUE DTSCS73 01460 DTSCS73 01461 WHEN MAP-REPT NOT = '_' AND SPACES DTSCS73 01462 SET MEVL-BA-ACCOUNTING-88 TO TRUE DTSCS73 01463 DTSCS73 01464 WHEN MAP-COLL NOT = '_' AND SPACES DTSCS73 01465 SET MEVL-BA-COLLECTIONS-88 TO TRUE DTSCS73 01466 DTSCS73 01467 WHEN MAP-RATING NOT = '_' AND SPACES DTSCS73 01468 SET MEVL-BA-RATING-88 TO TRUE DTSCS73 01469 DTSCS73 01470 WHEN MAP-AUDIT NOT = '_' AND SPACES DTSCS73 01471 SET MEVL-BA-AUDIT-88 TO TRUE DTSCS73 01472 DTSCS73 01473 WHEN MAP-APPRV NOT = '_' AND SPACES DTSCS73 01474 SET MEVL-BA-STATUS-APPRV-88 TO TRUE DTSCS73 01475 END-EVALUATE. DTSCS73 01476 DTSCS73 01477 EVALUATE TRUE DTSCS73 01478 WHEN MAP-CALL-EMP > SPACES DTSCS73 01479 SET MEVL-ACT-CALL-EMP-88 TO TRUE DTSCS73 01480 DTSCS73 01481 WHEN MAP-PROC-CLN > SPACES DTSCS73 01482 SET MEVL-ACT-PROC-CALL-LTR-88 TO TRUE DTSCS73 01483 DTSCS73 01484 WHEN MAP-CALL-AGNT > SPACES DTSCS73 01485 SET MEVL-ACT-CALL-AGNT-88 TO TRUE DTSCS73 01486 DTSCS73 01487 WHEN MAP-SEND-500 > SPACES DTSCS73 01488 SET MEVL-ACT-SEND-FR500-88 TO TRUE DTSCS73 01489 DTSCS73 01490 WHEN MAP-LETR-EMP-AGNT > SPACES DTSCS73 01491 SET MEVL-ACT-LETR-EMP-AGNT-88 TO TRUE DTSCS73 01492 DTSCS73 01493 WHEN MAP-SEND-30H > SPACES DTSCS73 01494 SET MEVL-ACT-SEND-UC30-88 TO TRUE DTSCS73 01495 DTSCS73 01496 WHEN MAP-SEND-226 > SPACES DTSCS73 01497 SET MEVL-ACT-SEND-UC226-88 TO TRUE DTSCS73 01498 DTSCS73 01499 WHEN MAP-FLD-VISIT > SPACES DTSCS73 01500 SET MEVL-ACT-FLD-VISIT-88 TO TRUE DTSCS73 01501 DTSCS73 01502 WHEN MAP-RSLV-BC > SPACES DTSCS73 01503 SET MEVL-ACT-RSLV-BLK-CLM-88 TO TRUE DTSCS73 01504 DTSCS73 01505 WHEN MAP-SRCH-TAX > SPACES DTSCS73 01506 SET MEVL-ACT-SRCH-DUTAS-88 TO TRUE DTSCS73 01507 DTSCS73 01508 WHEN MAP-PRE-AWU > SPACES DTSCS73 01509 SET MEVL-ACT-PRE-AUDIT-88 TO TRUE DTSCS73 01510 DTSCS73 01511 WHEN MAP-SRCH-EXT > SPACES DTSCS73 01512 SET MEVL-ACT-SRCH-EXTRNL-88 TO TRUE DTSCS73 01513 DTSCS73 01514 WHEN MAP-EMP-VISIT > SPACES DTSCS73 01515 SET MEVL-ACT-EMP-VISIT-88 TO TRUE DTSCS73 01516 DTSCS73 01517 WHEN MAP-SRCH-FILE > SPACES DTSCS73 01518 SET MEVL-ACT-SRCH-TAX-FILE-88 TO TRUE DTSCS73 01519 DTSCS73 01520 WHEN MAP-PRED-SUCC > SPACES DTSCS73 01521 SET MEVL-ACT-APPRV-SUCC-88 TO TRUE DTSCS73 01522 DTSCS73 01523 WHEN MAP-CHNG-SOL > SPACES DTSCS73 01524 SET MEVL-ACT-APPRV-INACT-88 TO TRUE DTSCS73 01525 DTSCS73 01526 WHEN MAP-CHNG-RATE > SPACES DTSCS73 01527 SET MEVL-ACT-APPRV-RATE-88 TO TRUE DTSCS73 01528 DTSCS73 01529 WHEN MAP-WRITE-OFF > SPACES DTSCS73 01530 SET MEVL-ACT-APPRV-WO-88 TO TRUE DTSCS73 01531 END-EVALUATE. DTSCS73 01532 DTSCS73 01533 IF MEVL-ACTIVITY-CODE > SPACES DTSCS73 01534 PERFORM P8910-ACTIVITY-DESC THRU P8910-EXIT DTSCS73 01535 ELSE DTSCS73 01536 MOVE MAP-TEXT TO MEVL-TEXT DTSCS73 01537 END-IF. DTSCS73 01538 DTSCS73 01539 P8900-EXIT. DTSCS73 01540 EXIT. DTSCS73 01541 DTSCS73 01542 P8910-ACTIVITY-DESC. DTSCS73 01543 EVALUATE TRUE DTSCS73 01544 WHEN MEVL-BUSINESS-AREA = '01' DTSCS73 01545 MOVE 'STATUS' TO WRK-BUSINESS-AREA DTSCS73 01546 DTSCS73 01547 WHEN MEVL-BUSINESS-AREA = '02' DTSCS73 01548 MOVE 'ACCOUNTING' TO WRK-BUSINESS-AREA DTSCS73 01549 DTSCS73 01550 WHEN MEVL-BUSINESS-AREA = '03' DTSCS73 01551 MOVE 'COLLECTIONS' TO WRK-BUSINESS-AREA DTSCS73 01552 DTSCS73 01553 WHEN MEVL-BUSINESS-AREA = '04' DTSCS73 01554 MOVE 'AUDIT' TO WRK-BUSINESS-AREA DTSCS73 01555 DTSCS73 01556 WHEN MEVL-BUSINESS-AREA = '05' DTSCS73 01557 MOVE 'RATING' TO WRK-BUSINESS-AREA DTSCS73 01558 DTSCS73 01559 WHEN MEVL-BUSINESS-AREA = '06' DTSCS73 01560 MOVE 'APPROVAL' TO WRK-BUSINESS-AREA DTSCS73 01561 DTSCS73 01562 END-EVALUATE. DTSCS73 01563 DTSCS73 01564 EVALUATE TRUE DTSCS73 01565 WHEN MEVL-ACTIVITY-CODE = '100' DTSCS73 01566 MOVE 'CALLED EMPLOYER' TO WRK-ACTIVITY DTSCS73 01567 DTSCS73 01568 WHEN MEVL-ACTIVITY-CODE = '101' DTSCS73 01569 MOVE 'LETTER TO EMPLOYER/AGENT' TO WRK-ACTIVITY DTSCS73 01570 DTSCS73 01571 WHEN MEVL-ACTIVITY-CODE = '102' DTSCS73 01572 MOVE 'CALLED FISCAL AGENT' TO WRK-ACTIVITY DTSCS73 01573 DTSCS73 01574 WHEN MEVL-ACTIVITY-CODE = '103' DTSCS73 01575 MOVE 'LETTER TO FISCAL AGENT' TO WRK-ACTIVITY DTSCS73 01576 DTSCS73 01577 WHEN MEVL-ACTIVITY-CODE = '104' DTSCS73 01578 MOVE 'FIELD VISIT' TO WRK-ACTIVITY DTSCS73 01579 DTSCS73 01580 WHEN MEVL-ACTIVITY-CODE = '105' DTSCS73 01581 MOVE 'SEARCHED DUTAS' TO WRK-ACTIVITY DTSCS73 01582 DTSCS73 01583 WHEN MEVL-ACTIVITY-CODE = '106' DTSCS73 01584 MOVE 'SEARCHED EXTERNAL SOURCES' TO WRK-ACTIVITY DTSCS73 01585 DTSCS73 01586 WHEN MEVL-ACTIVITY-CODE = '107' DTSCS73 01587 MOVE 'SEARCHED TAX FILES' TO WRK-ACTIVITY DTSCS73 01588 DTSCS73 01589 WHEN MEVL-ACTIVITY-CODE = '108' DTSCS73 01590 MOVE 'PROCESSED CALL OR LETTER' TO WRK-ACTIVITY DTSCS73 01591 DTSCS73 01592 WHEN MEVL-ACTIVITY-CODE = '109' DTSCS73 01593 MOVE 'SENT FR-500' TO WRK-ACTIVITY DTSCS73 01594 DTSCS73 01595 WHEN MEVL-ACTIVITY-CODE = '110' DTSCS73 01596 MOVE 'SENT UC-30' TO WRK-ACTIVITY DTSCS73 01597 DTSCS73 01598 WHEN MEVL-ACTIVITY-CODE = '111' DTSCS73 01599 MOVE 'SENT UC-226' TO WRK-ACTIVITY DTSCS73 01600 DTSCS73 01601 WHEN MEVL-ACTIVITY-CODE = '112' DTSCS73 01602 MOVE 'RESOLVED BLOCKED CLAIM' TO WRK-ACTIVITY DTSCS73 01603 DTSCS73 01604 WHEN MEVL-ACTIVITY-CODE = '113' DTSCS73 01605 MOVE 'PRE-AUDIT WRITEUP' TO WRK-ACTIVITY DTSCS73 01606 DTSCS73 01607 WHEN MEVL-ACTIVITY-CODE = '114' DTSCS73 01608 MOVE 'VISIT FROM EMPLOYER' TO WRK-ACTIVITY DTSCS73 01609 DTSCS73 01610 WHEN MEVL-ACTIVITY-CODE = '117' DTSCS73 01611 MOVE 'PREDECESSOR/SUCCESSOR' TO WRK-ACTIVITY DTSCS73 01612 DTSCS73 01613 WHEN MEVL-ACTIVITY-CODE = '118' DTSCS73 01614 MOVE 'INACTIVATE/CHNG SOL' TO WRK-ACTIVITY DTSCS73 01615 DTSCS73 01616 WHEN MEVL-ACTIVITY-CODE = '119' DTSCS73 01617 MOVE 'RATE CHANGE ' TO WRK-ACTIVITY DTSCS73 01618 DTSCS73 01619 WHEN MEVL-ACTIVITY-CODE = '120' DTSCS73 01620 MOVE 'WRITE OFF ' TO WRK-ACTIVITY DTSCS73 01621 DTSCS73 01622 END-EVALUATE. DTSCS73 01623 DTSCS73 01624 STRING DTSCS73 01625 WRK-ACTIVITY, DTSCS73 01626 ': ', DTSCS73 01627 WRK-BUSINESS-AREA DTSCS73 01628 DELIMITED BY SIZE DTSCS73 01629 INTO DTSCS73 01630 MEVL-TEXT DTSCS73 01631 END-STRING. DTSCS73 01632 DTSCS73 01633 MOVE MEVL-TEXT TO MAP-TEXT. DTSCS73 01634 DTSCS73 01635 P8910-EXIT. DTSCS73 01636 EXIT. DTSCS73 01637 DTSCS73 01638 /*****************************************************************DTSCS73 01639 * LINKS TO UTILITY MODULES DTSCS73 01640 ******************************************************************DTSCS73 01641 DTSCS73 01642 S001-FROM-FED-8. DTSCS73 01643 SET L001-FROM-FED-8 TO TRUE. DTSCS73 01644 GO TO S001-DATE. DTSCS73 01645 DTSCS73 01646 S001-FROM-ABS-DATE. DTSCS73 01647 SET L001-FROM-ABS-DAY TO TRUE. DTSCS73 01648 GO TO S001-DATE. DTSCS73 01649 DTSCS73 01650 S001-DATE. DTSCS73 01651 EXEC CICS LINK DTSCS73 01652 PROGRAM('DTSCU001') DTSCS73 01653 COMMAREA(L001-COMM-AREA) DTSCS73 01654 END-EXEC. DTSCS73 01655 S001-EXIT. DTSCS73 01656 EXIT. DTSCS73 01657 DTSCS73 01658 S015-DATE-FROM-SCREEN. DTSCS73 01659 EXEC CICS LINK DTSCS73 01660 PROGRAM('DTSCU015') DTSCS73 01661 COMMAREA(L015-COMM-AREA) DTSCS73 01662 END-EXEC. DTSCS73 01663 S015-EXIT. DTSCS73 01664 EXIT. DTSCS73 01665 DTSCS73 01666 S018-EMP-NO-FROM-SCREEN. DTSCS73 01667 EXEC CICS LINK DTSCS73 01668 PROGRAM('DTSCU018') DTSCS73 01669 COMMAREA(L018-COMM-AREA) DTSCS73 01670 END-EXEC. DTSCS73 01671 S018-EXIT. DTSCS73 01672 EXIT. DTSCS73 01673 DTSCS73 01674 S025-TIME-FROM-SCREEN. DTSCS73 01675 EXEC CICS LINK DTSCS73 01676 PROGRAM('DTSCU025') DTSCS73 01677 COMMAREA(L025-COMM-AREA) DTSCS73 01678 END-EXEC. DTSCS73 01679 S025-EXIT. DTSCS73 01680 EXIT. DTSCS73 01681 DTSCS73 01682 S082-OP-ID-LOOKUP. DTSCS73 01683 EXEC CICS LINK DTSCS73 01684 PROGRAM('DTSCU082') DTSCS73 01685 COMMAREA(L082-COMM-AREA) DTSCS73 01686 END-EXEC. DTSCS73 01687 DTSCS73 01688 IF L082-FILE-CLOSED DTSCS73 01689 MOVE L082-MSG-AREA TO LCCM-MSG-AREA DTSCS73 01690 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS73 01691 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS73 01692 GO TO MAINLINE-EXIT. DTSCS73 01693 DTSCS73 01694 S082-EXIT. DTSCS73 01695 EXIT. DTSCS73 01696 DTSCS73 01697 S221-EMP-LOCK. DTSCS73 01698 SET L221-START-UPDATE TO TRUE. DTSCS73 01699 GO TO S221-EMP-LOCK-UNLOCK. DTSCS73 01700 DTSCS73 01701 S221-EMP-UNLOCK. DTSCS73 01702 SET L221-END-UPDATE TO TRUE. DTSCS73 01703 GO TO S221-EMP-LOCK-UNLOCK. DTSCS73 01704 DTSCS73 01705 S221-EMP-LOCK-UNLOCK. DTSCS73 01706 EXEC CICS LINK DTSCS73 01707 PROGRAM('DTSCU221') DTSCS73 01708 COMMAREA(L221-COMM-AREA) DTSCS73 01709 END-EXEC. DTSCS73 01710 DTSCS73 01711 IF L221-FILE-CLOSED DTSCS73 01712 MOVE L221-MSG-AREA TO LCCM-MSG-AREA DTSCS73 01713 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS73 01714 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS73 01715 GO TO MAINLINE-EXIT. DTSCS73 01716 DTSCS73 01717 IF L221-NOT-OK DTSCS73 01718 MOVE L221-MSG-AREA TO LCCM-MSG-AREA. DTSCS73 01719 S221-EXIT. DTSCS73 01720 EXIT. DTSCS73 01721 DTSCS73 01722 DTSCS73 01723 S803-REQ-SCR-ID-EDIT. DTSCS73 01724 EXEC CICS LINK DTSCS73 01725 PROGRAM ('DTSCU803') DTSCS73 01726 COMMAREA (DFHCOMMAREA) DTSCS73 01727 END-EXEC. DTSCS73 01728 S803-EXIT. DTSCS73 01729 EXIT. DTSCS73 01730 DTSCS73 01731 S804-INVALID-KEY. DTSCS73 01732 EXEC CICS LINK DTSCS73 01733 PROGRAM ('DTSCU804') DTSCS73 01734 COMMAREA (DFHCOMMAREA) DTSCS73 01735 END-EXEC. DTSCS73 01736 S804-EXIT. DTSCS73 01737 EXIT. DTSCS73 01738 DTSCS73 01739 S805-MSG-AREA. DTSCS73 01740 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS73 01741 DTSCS73 01742 EXEC CICS LINK DTSCS73 01743 PROGRAM ('DTSCU805') DTSCS73 01744 COMMAREA (L805-COMM-AREA) DTSCS73 01745 END-EXEC. DTSCS73 01746 DTSCS73 01747 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS73 01748 S805-EXIT. DTSCS73 01749 EXIT. DTSCS73 01750 EJECT DTSCS73 01751 S810-READ. DTSCS73 01752 SET L810-READ-88 TO TRUE. DTSCS73 01753 GO TO S810-IO. DTSCS73 01754 DTSCS73 01755 S810-START-BROWSE. DTSCS73 01756 SET L810-START-BROWSE-88 TO TRUE. DTSCS73 01757 GO TO S810-IO. DTSCS73 01758 DTSCS73 01759 S810-READ-NEXT. DTSCS73 01760 SET L810-READ-NEXT-88 TO TRUE. DTSCS73 01761 GO TO S810-IO. DTSCS73 01762 DTSCS73 01763 S810-READ-PREV. DTSCS73 01764 SET L810-READ-PREV-88 TO TRUE. DTSCS73 01765 GO TO S810-IO. DTSCS73 01766 DTSCS73 01767 S810-END-BROWSE. DTSCS73 01768 SET L810-END-BROWSE-88 TO TRUE. DTSCS73 01769 GO TO S810-IO. DTSCS73 01770 DTSCS73 01771 S810-COUNT. DTSCS73 01772 SET L810-COUNT-88 TO TRUE. DTSCS73 01773 GO TO S810-IO. DTSCS73 01774 DTSCS73 01775 S810-REWRITE. DTSCS73 01776 SET L810-REWRITE-88 TO TRUE. DTSCS73 01777 GO TO S810-IO. DTSCS73 01778 DTSCS73 01779 S810-WRITE. DTSCS73 01780 SET L810-WRITE-88 TO TRUE. DTSCS73 01781 GO TO S810-IO. DTSCS73 01782 DTSCS73 01783 S810-DELETE. DTSCS73 01784 SET L810-DELETE-88 TO TRUE. DTSCS73 01785 GO TO S810-IO. DTSCS73 01786 DTSCS73 01787 S810-IO. DTSCS73 01788 DTSCS73 01789 EXEC CICS LINK DTSCS73 01790 PROGRAM ('DTSCU810') DTSCS73 01791 COMMAREA (L810-COMM-AREA) DTSCS73 01792 END-EXEC. DTSCS73 01793 DTSCS73 01794 IF L810-FILE-CLOSED-88 DTSCS73 01795 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS73 01796 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS73 01797 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS73 01798 GO TO MAINLINE-EXIT. DTSCS73 01799 S810-EXIT. DTSCS73 01800 EXIT. DTSCS73 01801 EJECT DTSCS73 01802 S851-SCREEN-PROCESSING. DTSCS73 01803 EXEC CICS LINK DTSCS73 01804 PROGRAM ('DTSCU851') DTSCS73 01805 COMMAREA (L851-COMM-AREA) DTSCS73 01806 END-EXEC. DTSCS73 01807 S851-EXIT. DTSCS73 01808 EXIT. DTSCS73 01809 DTSCS73 01810 S899-ABEND. DTSCS73 01811 EXEC CICS ABEND DTSCS73 01812 ABCODE(WRK-ABEND-CD) DTSCS73 01813 END-EXEC. DTSCS73 01814 S899-EXIT. DTSCS73 01815 EXIT. DTSCS73 01816 /*****************************************************************DTSCS73 01817 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS73 01818 ******************************************************************DTSCS73 01819 DTSCS73 01820 S1000-SCREEN-EDITS. DTSCS73 01821 DTSCS73 01822 DTSCS73 01823 PERFORM S1200-EVENT-DATE THRU S1200-EXIT. DTSCS73 01824 PERFORM S1300-EVENT-TIME THRU S1300-EXIT. DTSCS73 01825 PERFORM S1400-TEXT THRU S1400-EXIT. DTSCS73 01826 PERFORM S1500-INITIATING-OP THRU S1500-EXIT. DTSCS73 01827 PERFORM S1600-EVENT-SECTION THRU S1600-EXIT. DTSCS73 01828 PERFORM S1700-EVENT-WORK-LOG THRU S1700-EXIT. DTSCS73 01829 DTSCS73 01830 IF LCCM-MSG DTSCS73 01831 GO TO S1000-EXIT. DTSCS73 01832 DTSCS73 01833 PERFORM S2000-MISC-EDITS THRU S2000-EXIT. DTSCS73 01834 PERFORM S2100-CROSS-EDITS THRU S2100-EXIT. DTSCS73 01835 S1000-EXIT. EXIT. DTSCS73 01836 EJECT DTSCS73 01837 DTSCS73 01838 S1100-EDIT-KEY. DTSCS73 01839 PERFORM S1101-EMP-NO THRU S1101-EXIT. DTSCS73 01840 S1100-EXIT. EXIT. DTSCS73 01841 /*****************************************************************DTSCS73 01842 * DTSCS73 01843 ******************************************************************DTSCS73 01844 S1101-EMP-NO. DTSCS73 01845 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS73 01846 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS73 01847 DTSCS73 01848 IF L018-NO-ENTRY DTSCS73 01849 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS73 01850 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS73 01851 GO TO S1101-EXIT. DTSCS73 01852 DTSCS73 01853 IF L018-NOT-VALID DTSCS73 01854 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS73 01855 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS73 01856 GO TO S1101-EXIT. DTSCS73 01857 DTSCS73 01858 MOVE L018-EMP-NO TO WRK-EMP-NO. DTSCS73 01859 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS73 01860 S1101-EXIT. EXIT. DTSCS73 01861 DTSCS73 01862 S1110-READ-MPRF. DTSCS73 01863 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS73 01864 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS73 01865 SET MPRF-PRF-88 TO TRUE. DTSCS73 01866 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS73 01867 PERFORM S810-READ THRU S810-EXIT. DTSCS73 01868 IF L810-NO-REC-88 DTSCS73 01869 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS73 01870 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS73 01871 ELSE DTSCS73 01872 MOVE MSKL-REC TO MPRF-REC DTSCS73 01873 SET WRK-MPRF-YES-88 TO TRUE. DTSCS73 01874 S1110-EXIT. DTSCS73 01875 EXIT. DTSCS73 01876 DTSCS73 01877 S1199-ERROR. DTSCS73 01878 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS73 01879 MAP-EMP-NO-2-A. DTSCS73 01880 IF LCCM-NO-MSG DTSCS73 01881 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS73 01882 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L DTSCS73 01883 SET CURSOR-SET-YES TO TRUE. DTSCS73 01884 S1199-EXIT. EXIT. DTSCS73 01885 DTSCS73 01886 /*****************************************************************DTSCS73 01887 * *DTSCS73 01888 ******************************************************************DTSCS73 01889 S1200-EVENT-DATE. DTSCS73 01890 MOVE LCCM-TASK-START-DATE TO WRK-DISPLAY DTSCS73 01891 L015-DATE DTSCS73 01892 MOVE WRK-DISPLAY-YR TO MAP-DATE-YR DTSCS73 01893 MOVE WRK-DISPLAY-MO TO MAP-DATE-MO DTSCS73 01894 MOVE WRK-DISPLAY-DA TO MAP-DATE-DA. DTSCS73 01895 S1200-EXIT. DTSCS73 01896 EXIT. DTSCS73 01897 S1201-ERROR. DTSCS73 01898 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS73 01899 TO MAP-DATE-MO-A DTSCS73 01900 MAP-DATE-DA-A DTSCS73 01901 MAP-DATE-YR-A. DTSCS73 01902 IF LCCM-NO-MSG DTSCS73 01903 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS73 01904 MOVE CATB-CURSOR TO MAP-DATE-MO-L DTSCS73 01905 SET CURSOR-SET-YES TO TRUE. DTSCS73 01906 DTSCS73 01907 S1201-EXIT. EXIT. DTSCS73 01908 /*****************************************************************DTSCS73 01909 * *DTSCS73 01910 ******************************************************************DTSCS73 01911 S1300-EVENT-TIME. DTSCS73 01912 MOVE LCCM-TASK-START-TIME TO WRK-DISPLAY DTSCS73 01913 L025-TIME DTSCS73 01914 MOVE WRK-DISPLAY-HR TO MAP-TIME-HR DTSCS73 01915 MOVE WRK-DISPLAY-MN TO MAP-TIME-MN DTSCS73 01916 MOVE WRK-DISPLAY-SC TO MAP-TIME-SC. DTSCS73 01917 S1300-EXIT. DTSCS73 01918 EXIT. DTSCS73 01919 DTSCS73 01920 S1301-ERROR. DTSCS73 01921 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS73 01922 TO MAP-TIME-HR-A DTSCS73 01923 MAP-TIME-MN-A DTSCS73 01924 MAP-TIME-SC-A. DTSCS73 01925 IF LCCM-NO-MSG DTSCS73 01926 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS73 01927 MOVE CATB-CURSOR TO MAP-TIME-HR-L DTSCS73 01928 SET CURSOR-SET-YES TO TRUE. DTSCS73 01929 DTSCS73 01930 S1301-EXIT. EXIT. DTSCS73 01931 /*****************************************************************DTSCS73 01932 * *DTSCS73 01933 ******************************************************************DTSCS73 01934 S1400-TEXT. DTSCS73 01935 INSPECT MAP-TEXT DTSCS73 01936 CONVERTING LOW-VALUES TO SPACES. DTSCS73 01937 DTSCS73 01938 **************************************** DTSCS73 01939 * THE FOLLOWING EDIT MOVED TO S2100-CROSS-EDITS DTSCS73 01940 **************************************** DTSCS73 01941 * IF MAP-TEXT = SPACES DTSCS73 01942 * MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS73 01943 * PERFORM S1401-ERROR THRU S1401-EXIT. DTSCS73 01944 S1400-EXIT. EXIT. DTSCS73 01945 DTSCS73 01946 S1401-ERROR. DTSCS73 01947 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS73 01948 TO MAP-TEXT-A. DTSCS73 01949 IF LCCM-NO-MSG DTSCS73 01950 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS73 01951 MOVE CATB-CURSOR TO MAP-TEXT-L DTSCS73 01952 SET CURSOR-SET-YES TO TRUE. DTSCS73 01953 S1401-EXIT. EXIT. DTSCS73 01954 /*****************************************************************DTSCS73 01955 * *DTSCS73 01956 ******************************************************************DTSCS73 01957 S1500-INITIATING-OP. DTSCS73 01958 MOVE SPACES TO MAP-SOURCE-DESC DTSCS73 01959 IF MAP-SOURCE EQUAL LOW-VALUES OR SPACES DTSCS73 01960 MOVE LCCM-OP-ID TO MAP-SOURCE DTSCS73 01961 MOVE LCCM-OP-NAME TO MAP-SOURCE-DESC DTSCS73 01962 ELSE DTSCS73 01963 IF LCCM-OP-ID NOT EQUAL MAP-SOURCE DTSCS73 01964 MOVE MSG-E736-AREA TO WRK-MSG-AREA DTSCS73 01965 PERFORM S1501-ERROR THRU S1501-EXIT. DTSCS73 01966 S1500-EXIT. EXIT. DTSCS73 01967 DTSCS73 01968 S1501-ERROR. DTSCS73 01969 * MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS73 01970 * TO MAP-SOURCE-A. DTSCS73 01971 IF LCCM-NO-MSG DTSCS73 01972 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS73 01973 MOVE CATB-CURSOR TO MAP-SOURCE-L DTSCS73 01974 SET CURSOR-SET-YES TO TRUE. DTSCS73 01975 S1501-EXIT. EXIT. DTSCS73 01976 ******************************************************************DTSCS73 01977 S1600-EVENT-SECTION. DTSCS73 01978 INSPECT MAP-STAT DTSCS73 01979 CONVERTING '_' TO SPACES. DTSCS73 01980 DTSCS73 01981 INSPECT MAP-COLL DTSCS73 01982 CONVERTING '_' TO SPACES. DTSCS73 01983 DTSCS73 01984 INSPECT MAP-REPT DTSCS73 01985 CONVERTING '_' TO SPACES. DTSCS73 01986 DTSCS73 01987 INSPECT MAP-RATING DTSCS73 01988 CONVERTING '_' TO SPACES. DTSCS73 01989 DTSCS73 01990 INSPECT MAP-AUDIT DTSCS73 01991 CONVERTING '_' TO SPACES. DTSCS73 01992 DTSCS73 01993 INSPECT MAP-APPRV DTSCS73 01994 CONVERTING '_' TO SPACES. DTSCS73 01995 DTSCS73 01996 MOVE ZEROS TO WRK-EVENT-SECTION-IND. DTSCS73 01997 DTSCS73 01998 IF MAP-STAT > SPACES DTSCS73 01999 ADD 1 TO WRK-EVENT-SECTION-IND DTSCS73 02000 ELSE DTSCS73 02001 MOVE '_' TO MAP-STAT. DTSCS73 02002 IF MAP-REPT > SPACES DTSCS73 02003 ADD 1 TO WRK-EVENT-SECTION-IND DTSCS73 02004 ELSE DTSCS73 02005 MOVE '_' TO MAP-REPT. DTSCS73 02006 DTSCS73 02007 IF MAP-COLL > SPACES DTSCS73 02008 ADD 1 TO WRK-EVENT-SECTION-IND DTSCS73 02009 ELSE DTSCS73 02010 MOVE '_' TO MAP-COLL. DTSCS73 02011 DTSCS73 02012 IF MAP-RATING > SPACES DTSCS73 02013 ADD 1 TO WRK-EVENT-SECTION-IND DTSCS73 02014 ELSE DTSCS73 02015 MOVE '_' TO MAP-RATING. DTSCS73 02016 DTSCS73 02017 IF MAP-AUDIT > SPACES DTSCS73 02018 ADD 1 TO WRK-EVENT-SECTION-IND DTSCS73 02019 ELSE DTSCS73 02020 MOVE '_' TO MAP-AUDIT. DTSCS73 02021 DTSCS73 02022 IF MAP-APPRV > SPACES DTSCS73 02023 ADD 1 TO WRK-EVENT-SECTION-IND DTSCS73 02024 ELSE DTSCS73 02025 MOVE '_' TO MAP-APPRV. DTSCS73 02026 DTSCS73 02027 IF WRK-EVENT-SECTION-IND > 1 DTSCS73 02028 MOVE MSG-E734-AREA TO WRK-MSG-AREA DTSCS73 02029 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS73 02030 GO TO S1600-EXIT. DTSCS73 02031 DTSCS73 02032 IF WRK-EVENT-SECTION-IND = ZEROS DTSCS73 02033 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS73 02034 PERFORM S1601-ERROR THRU S1601-EXIT. DTSCS73 02035 DTSCS73 02036 S1600-EXIT. EXIT. DTSCS73 02037 DTSCS73 02038 S1601-ERROR. DTSCS73 02039 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS73 02040 TO MAP-STAT-A DTSCS73 02041 MAP-REPT-A DTSCS73 02042 MAP-COLL-A DTSCS73 02043 MAP-RATING-A DTSCS73 02044 MAP-APPRV-A DTSCS73 02045 MAP-AUDIT-A. DTSCS73 02046 IF LCCM-NO-MSG DTSCS73 02047 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS73 02048 MOVE CATB-CURSOR TO MAP-STAT-L DTSCS73 02049 SET CURSOR-SET-YES TO TRUE. DTSCS73 02050 S1601-EXIT. EXIT. DTSCS73 02051 ******************************************************************DTSCS73 02052 S1700-EVENT-WORK-LOG. DTSCS73 02053 DTSCS73 02054 MOVE ZEROS TO WRK-EVENT-WORK-IND. DTSCS73 02055 DTSCS73 02056 INSPECT MAP-CALL-EMP DTSCS73 02057 CONVERTING '_' TO SPACES. DTSCS73 02058 INSPECT MAP-PROC-CLN DTSCS73 02059 CONVERTING '_' TO SPACES. DTSCS73 02060 INSPECT MAP-CALL-AGNT DTSCS73 02061 CONVERTING '_' TO SPACES. DTSCS73 02062 INSPECT MAP-SEND-500 DTSCS73 02063 CONVERTING '_' TO SPACES. DTSCS73 02064 INSPECT MAP-LETR-EMP-AGNT DTSCS73 02065 CONVERTING '_' TO SPACES. DTSCS73 02066 INSPECT MAP-SEND-30H DTSCS73 02067 CONVERTING '_' TO SPACES. DTSCS73 02068 INSPECT MAP-SEND-226 DTSCS73 02069 CONVERTING '_' TO SPACES. DTSCS73 02070 INSPECT MAP-FLD-VISIT DTSCS73 02071 CONVERTING '_' TO SPACES. DTSCS73 02072 INSPECT MAP-RSLV-BC DTSCS73 02073 CONVERTING '_' TO SPACES. DTSCS73 02074 INSPECT MAP-SRCH-TAX DTSCS73 02075 CONVERTING '_' TO SPACES. DTSCS73 02076 INSPECT MAP-PRE-AWU DTSCS73 02077 CONVERTING '_' TO SPACES. DTSCS73 02078 INSPECT MAP-SRCH-EXT DTSCS73 02079 CONVERTING '_' TO SPACES. DTSCS73 02080 INSPECT MAP-EMP-VISIT DTSCS73 02081 CONVERTING '_' TO SPACES. DTSCS73 02082 INSPECT MAP-SRCH-FILE DTSCS73 02083 CONVERTING '_' TO SPACES. DTSCS73 02084 INSPECT MAP-PRED-SUCC DTSCS73 02085 CONVERTING '_' TO SPACES. DTSCS73 02086 INSPECT MAP-CHNG-SOL DTSCS73 02087 CONVERTING '_' TO SPACES. DTSCS73 02088 INSPECT MAP-CHNG-RATE DTSCS73 02089 CONVERTING '_' TO SPACES. DTSCS73 02090 INSPECT MAP-WRITE-OFF DTSCS73 02091 CONVERTING '_' TO SPACES. DTSCS73 02092 DTSCS73 02093 IF MAP-CALL-EMP > SPACES DTSCS73 02094 ADD 1 TO WRK-EVENT-WORK-IND. DTSCS73 02095 DTSCS73 02096 IF MAP-PROC-CLN > SPACES DTSCS73 02097 ADD 1 TO WRK-EVENT-WORK-IND. DTSCS73 02098 DTSCS73 02099 IF MAP-CALL-AGNT > SPACES DTSCS73 02100 ADD 1 TO WRK-EVENT-WORK-IND. DTSCS73 02101 DTSCS73 02102 IF MAP-SEND-500 > SPACES DTSCS73 02103 ADD 1 TO WRK-EVENT-WORK-IND. DTSCS73 02104 DTSCS73 02105 IF MAP-LETR-EMP-AGNT > SPACES DTSCS73 02106 ADD 1 TO WRK-EVENT-WORK-IND. DTSCS73 02107 DTSCS73 02108 IF MAP-SEND-30H > SPACES DTSCS73 02109 ADD 1 TO WRK-EVENT-WORK-IND. DTSCS73 02110 DTSCS73 02111 IF MAP-SEND-226 > SPACES DTSCS73 02112 ADD 1 TO WRK-EVENT-WORK-IND. DTSCS73 02113 DTSCS73 02114 IF MAP-FLD-VISIT > SPACES DTSCS73 02115 ADD 1 TO WRK-EVENT-WORK-IND. DTSCS73 02116 DTSCS73 02117 IF MAP-RSLV-BC > SPACES DTSCS73 02118 ADD 1 TO WRK-EVENT-WORK-IND. DTSCS73 02119 DTSCS73 02120 IF MAP-SRCH-TAX > SPACES DTSCS73 02121 ADD 1 TO WRK-EVENT-WORK-IND. DTSCS73 02122 DTSCS73 02123 IF MAP-PRE-AWU > SPACES DTSCS73 02124 ADD 1 TO WRK-EVENT-WORK-IND. DTSCS73 02125 DTSCS73 02126 IF MAP-SRCH-EXT > SPACES DTSCS73 02127 ADD 1 TO WRK-EVENT-WORK-IND. DTSCS73 02128 DTSCS73 02129 IF MAP-EMP-VISIT > SPACES DTSCS73 02130 ADD 1 TO WRK-EVENT-WORK-IND. DTSCS73 02131 DTSCS73 02132 IF MAP-SRCH-FILE > SPACES DTSCS73 02133 ADD 1 TO WRK-EVENT-WORK-IND. DTSCS73 02134 DTSCS73 02135 IF MAP-PRED-SUCC > SPACES DTSCS73 02136 ADD 1 TO WRK-EVENT-WORK-IND. DTSCS73 02137 DTSCS73 02138 IF MAP-CHNG-SOL > SPACES DTSCS73 02139 ADD 1 TO WRK-EVENT-WORK-IND. DTSCS73 02140 DTSCS73 02141 IF MAP-CHNG-RATE > SPACES DTSCS73 02142 ADD 1 TO WRK-EVENT-WORK-IND. DTSCS73 02143 DTSCS73 02144 IF MAP-WRITE-OFF > SPACES DTSCS73 02145 ADD 1 TO WRK-EVENT-WORK-IND. DTSCS73 02146 DTSCS73 02147 IF WRK-EVENT-WORK-IND > 1 DTSCS73 02148 MOVE MSG-E735-AREA TO WRK-MSG-AREA DTSCS73 02149 PERFORM S1701-ERROR THRU S1701-EXIT. DTSCS73 02150 DTSCS73 02151 ** DEFAULT MAP-APPRV TO 'X' IF MAP-PRED-SUCC OR DTSCS73 02152 ** MAP-CHNG-SOL OR MAP-CHNG-RATE ARE SELECTED. DTSCS73 02153 IF MAP-PRED-SUCC > SPACES DTSCS73 02154 OR MAP-CHNG-SOL > SPACES DTSCS73 02155 OR MAP-CHNG-RATE > SPACES DTSCS73 02156 OR MAP-WRITE-OFF > SPACES DTSCS73 02157 MOVE 'X' TO MAP-APPRV DTSCS73 02158 MOVE '_' TO MAP-STAT DTSCS73 02159 MOVE '_' TO MAP-COLL DTSCS73 02160 MOVE '_' TO MAP-REPT DTSCS73 02161 MOVE '_' TO MAP-RATING DTSCS73 02162 MOVE '_' TO MAP-AUDIT DTSCS73 02163 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-APPRV-A DTSCS73 02164 END-IF. DTSCS73 02165 DTSCS73 02166 *** S2100 CHECKS WHETHER ANYTHING HAS BEEN ENTERED IN DTSCS73 02167 *** THE TEXT LINE. IT MAY BE BLANK ONLY IF AN EVENT DTSCS73 02168 *** HAS BEEN SELECTED. DTSCS73 02169 *** IF WRK-EVENT-WORK-IND = ZEROS DTSCS73 02170 * MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS73 02171 *** PERFORM S1701-ERROR THRU S1701-EXIT. DTSCS73 02172 DTSCS73 02173 S1700-EXIT. EXIT. DTSCS73 02174 DTSCS73 02175 S1701-ERROR. DTSCS73 02176 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS73 02177 TO MAP-CALL-EMP-A DTSCS73 02178 MAP-PROC-CLN-A DTSCS73 02179 MAP-CALL-AGNT-A DTSCS73 02180 MAP-SEND-500-A DTSCS73 02181 MAP-LETR-EMP-AGNT-A DTSCS73 02182 MAP-SEND-30H-A DTSCS73 02183 MAP-WRITE-OFF-A DTSCS73 02184 MAP-SEND-226-A DTSCS73 02185 MAP-FLD-VISIT-A DTSCS73 02186 MAP-RSLV-BC-A DTSCS73 02187 MAP-SRCH-TAX-A DTSCS73 02188 MAP-PRE-AWU-A DTSCS73 02189 MAP-SRCH-EXT-A DTSCS73 02190 MAP-EMP-VISIT-A DTSCS73 02191 MAP-SRCH-FILE-A DTSCS73 02192 MAP-CHNG-RATE-A DTSCS73 02193 MAP-CHNG-SOL-A DTSCS73 02194 MAP-APPRV-A DTSCS73 02195 MAP-PRED-SUCC-A. DTSCS73 02196 DTSCS73 02197 IF NOT SCR-ACCESS-SUPERVISOR DTSCS73 02198 MOVE CATB-ASKIP-BRT-MDTON TO DTSCS73 02199 MAP-CHNG-RATE-A DTSCS73 02200 MAP-WRITE-OFF-A DTSCS73 02201 MAP-CHNG-SOL-A DTSCS73 02202 MAP-APPRV-A DTSCS73 02203 MAP-PRED-SUCC-A. DTSCS73 02204 DTSCS73 02205 IF LCCM-NO-MSG DTSCS73 02206 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS73 02207 MOVE CATB-CURSOR TO MAP-CALL-EMP-L DTSCS73 02208 SET CURSOR-SET-YES TO TRUE. DTSCS73 02209 S1701-EXIT. EXIT. DTSCS73 02210 /*****************************************************************DTSCS73 02211 DTSCS73 02212 /*****************************************************************DTSCS73 02213 * CHECK FOR DUPLICATES *DTSCS73 02214 ******************************************************************DTSCS73 02215 S2000-MISC-EDITS. DTSCS73 02216 IF LCCM-F09-88 DTSCS73 02217 MOVE LOW-VALUES TO MEVL-KEY-AREA DTSCS73 02218 MOVE WRK-EMP-NO TO MEVL-EMP-NO DTSCS73 02219 SET MEVL-EVL-88 TO TRUE DTSCS73 02220 MOVE L015-DATE TO MEVL-DATE DTSCS73 02221 MOVE L025-TIME TO MEVL-TIME DTSCS73 02222 ELSE DTSCS73 02223 MOVE LCCM-SCR73-HOLD-AREA TO MEVL-KEY-AREA DTSCS73 02224 IF MEVL-DATE = L015-DATE DTSCS73 02225 AND MEVL-TIME = L025-TIME DTSCS73 02226 GO TO S2000-EXIT DTSCS73 02227 ELSE DTSCS73 02228 MOVE L015-DATE TO MEVL-DATE DTSCS73 02229 MOVE L025-TIME TO MEVL-TIME DTSCS73 02230 END-IF DTSCS73 02231 END-IF. DTSCS73 02232 DTSCS73 02233 MOVE MEVL-KEY-AREA TO MSKL-KEY-AREA. DTSCS73 02234 PERFORM S810-READ THRU S810-EXIT. DTSCS73 02235 IF L810-OK-88 DTSCS73 02236 IF LCCM-F09-88 DTSCS73 02237 MOVE EMSG-RECORD-EXISTS TO WRK-MSG-AREA DTSCS73 02238 ELSE DTSCS73 02239 MOVE MSG-E731-AREA TO WRK-MSG-AREA DTSCS73 02240 END-IF DTSCS73 02241 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS73 02242 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS73 02243 END-IF. DTSCS73 02244 S2000-EXIT. EXIT. DTSCS73 02245 DTSCS73 02246 S2100-CROSS-EDITS. DTSCS73 02247 IF MAP-TEXT = SPACES DTSCS73 02248 IF WRK-EVENT-SECTION-IND > 0 DTSCS73 02249 AND WRK-EVENT-WORK-IND > 0 DTSCS73 02250 NEXT SENTENCE DTSCS73 02251 ELSE DTSCS73 02252 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS73 02253 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS73 02254 END-IF DTSCS73 02255 END-IF. DTSCS73 02256 DTSCS73 02257 S2100-EXIT. EXIT. DTSCS73 02258 DTSCS73 02259 /*****************************************************************DTSCS73 02260 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCS73 02261 ******************************************************************DTSCS73 02262 S5100-SET-LOCK-ATTRB. DTSCS73 02263 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS73 02264 WRK-ATB-NUM. DTSCS73 02265 DTSCS73 02266 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS73 02267 DTSCS73 02268 MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-NO-1-A DTSCS73 02269 MAP-EMP-NO-2-A DTSCS73 02270 MAP-GOTO-A. DTSCS73 02271 S5100-EXIT. DTSCS73 02272 EXIT. DTSCS73 02273 DTSCS73 02274 ******************************************************************DTSCS73 02275 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS73 02276 ******************************************************************DTSCS73 02277 S5200-SET-UPDATE-ATTRB. DTSCS73 02278 MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN. DTSCS73 02279 MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM. DTSCS73 02280 DTSCS73 02281 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS73 02282 S5200-EXIT. DTSCS73 02283 EXIT. DTSCS73 02284 DTSCS73 02285 ******************************************************************DTSCS73 02286 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS73 02287 ******************************************************************DTSCS73 02288 S5300-SET-INQ-ATTRB. DTSCS73 02289 MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN DTSCS73 02290 WRK-ATB-NUM. DTSCS73 02291 DTSCS73 02292 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS73 02293 S5300-EXIT. DTSCS73 02294 EXIT. DTSCS73 02295 DTSCS73 02296 S5900-SET-ATTRB. DTSCS73 02297 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS73 02298 MAP-EMP-NO-2-A. DTSCS73 02299 DTSCS73 02300 MOVE WRK-ATB-AN TO DTSCS73 02301 MAP-SOURCE-A DTSCS73 02302 MAP-TEXT-A DTSCS73 02303 MAP-STAT-A DTSCS73 02304 MAP-COLL-A DTSCS73 02305 MAP-REPT-A DTSCS73 02306 MAP-RATING-A DTSCS73 02307 MAP-AUDIT-A DTSCS73 02308 MAP-CALL-EMP-A DTSCS73 02309 MAP-PROC-CLN-A DTSCS73 02310 MAP-CALL-AGNT-A DTSCS73 02311 MAP-SEND-500-A DTSCS73 02312 MAP-LETR-EMP-AGNT-A DTSCS73 02313 MAP-SEND-30H-A DTSCS73 02314 MAP-WRITE-OFF-A DTSCS73 02315 MAP-SEND-226-A DTSCS73 02316 MAP-FLD-VISIT-A DTSCS73 02317 MAP-RSLV-BC-A DTSCS73 02318 MAP-SRCH-TAX-A DTSCS73 02319 MAP-PRE-AWU-A DTSCS73 02320 MAP-SRCH-EXT-A DTSCS73 02321 MAP-EMP-VISIT-A DTSCS73 02322 MAP-SRCH-FILE-A DTSCS73 02323 MAP-PRED-SUCC-A DTSCS73 02324 MAP-CHNG-SOL-A DTSCS73 02325 MAP-APPRV-A DTSCS73 02326 MAP-CHNG-RATE-A. DTSCS73 02327 DTSCS73 02328 IF NOT SCR-ACCESS-SUPERVISOR DTSCS73 02329 MOVE CATB-ASKIP-BRT-MDTON TO DTSCS73 02330 MAP-WRITE-OFF-A DTSCS73 02331 MAP-PRED-SUCC-A DTSCS73 02332 MAP-CHNG-SOL-A DTSCS73 02333 MAP-APPRV-A DTSCS73 02334 MAP-CHNG-RATE-A. DTSCS73 02335 DTSCS73 02336 MOVE CATB-ASKIP-BRT-MDTON TO DTSCS73 02337 MAP-SOURCE-A DTSCS73 02338 MAP-DATE-MO-A DTSCS73 02339 MAP-DATE-DA-A DTSCS73 02340 MAP-DATE-YR-A DTSCS73 02341 MAP-TIME-HR-A DTSCS73 02342 MAP-TIME-MN-A DTSCS73 02343 MAP-TIME-SC-A DTSCS73 02344 MAP-PRIMARY-NAME-A DTSCS73 02345 MAP-CURR-PAGE-A DTSCS73 02346 MAP-LAST-PAGE-A DTSCS73 02347 MAP-CHNG-DATE-A DTSCS73 02348 MAP-ESTB-DATE-A. DTSCS73 02349 DTSCS73 02350 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS73 02351 S5900-EXIT. DTSCS73 02352 EXIT. DTSCS73 02353 EJECT DTSCS73 02354 /*****************************************************************DTSCS73 02355 * MAP ROUTINES *DTSCS73 02356 ******************************************************************DTSCS73 02357 S9100-RECEIVE. DTSCS73 02358 SET L851-RECEIVE-88 TO TRUE. DTSCS73 02359 DTSCS73 02360 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS73 02361 DTSCS73 02362 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS73 02363 DTSCS73 02364 MOVE L851-AID TO LCCM-AID. DTSCS73 02365 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS73 02366 S9100-EXIT. DTSCS73 02367 EXIT. DTSCS73 02368 DTSCS73 02369 S9200-SEND-DATAONLY. DTSCS73 02370 MOVE LOW-VALUES TO MAP-AREA. DTSCS73 02371 DTSCS73 02372 IF LCCM-NO-MSG DTSCS73 02373 NEXT SENTENCE DTSCS73 02374 ELSE DTSCS73 02375 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS73 02376 DTSCS73 02377 IF CURSOR-SET-GOTO DTSCS73 02378 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS73 02379 ELSE DTSCS73 02380 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS73 02381 DTSCS73 02382 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS73 02383 DTSCS73 02384 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS73 02385 DTSCS73 02386 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS73 02387 S9200-EXIT. DTSCS73 02388 EXIT. DTSCS73 02389 DTSCS73 02390 S9300-SEND-MAP. DTSCS73 02391 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS73 02392 MOVE SPACES TO MAP-SYS-TIME. DTSCS73 02393 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS73 02394 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS73 02395 DTSCS73 02396 IF SCR-ACCESS-UPDATE DTSCS73 02397 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS73 02398 ELSE DTSCS73 02399 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS73 02400 DTSCS73 02401 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCS73 02402 DTSCS73 02403 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS73 02404 DTSCS73 02405 IF CURSOR-SET-NO DTSCS73 02406 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS73 02407 DTSCS73 02408 SET L851-SEND-88 TO TRUE. DTSCS73 02409 DTSCS73 02410 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS73 02411 DTSCS73 02412 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS73 02413 S9300-EXIT. DTSCS73 02414 EXIT. DTSCS73 02415 DTSCS73 02416 S9310-UPDATE-FKEYS. DTSCS73 02417 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS73 02418 DTSCS73 02419 DTSCS73 02420 IF LCCM-SCR-CLEAR DTSCS73 02421 MOVE CFKD-ADD TO MAP-KEY-ADD DTSCS73 02422 ELSE DTSCS73 02423 IF LCCM-SCR-INQUIRE DTSCS73 02424 MOVE CFKD-MOD TO MAP-KEY-MOD DTSCS73 02425 MOVE CFKD-DEL TO MAP-KEY-DEL DTSCS73 02426 ELSE DTSCS73 02427 IF LCCM-SCR-UPDATE-LOCKED DTSCS73 02428 MOVE LOW-VALUES TO MAP-KEY-FIRST DTSCS73 02429 MAP-KEY-LAST DTSCS73 02430 MAP-KEY-BACK DTSCS73 02431 MAP-KEY-FWRD. DTSCS73 02432 S9310-EXIT. DTSCS73 02433 EXIT. DTSCS73 02434 DTSCS73 02435 S9320-INQUIRY-FKEYS. DTSCS73 02436 MOVE CFKD-FIRST TO MAP-KEY-FIRST. DTSCS73 02437 MOVE CFKD-LAST TO MAP-KEY-LAST. DTSCS73 02438 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS73 02439 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS73 02440 DTSCS73 02441 MOVE LOW-VALUES TO MAP-KEY-ADD DTSCS73 02442 MAP-KEY-MOD DTSCS73 02443 MAP-KEY-DEL. DTSCS73 02444 DTSCS73 02445 *****PERFORM S9321-JUMP-KEYS THRU S9321-EXIT. DTSCS73 02446 S9320-EXIT. DTSCS73 02447 EXIT. DTSCS73 02448 DTSCS73 02449 *S9321-JUMP-KEYS. DTSCS73 02450 *****MOVE CFKD-REG-INQ TO MAP-KEY-REG-INQ. DTSCS73 02451 *****MOVE CFKD-QTR-INQ TO MAP-KEY-QTR-INQ. DTSCS73 02452 *****MOVE CFKD-COLL-INQ TO MAP-KEY-COLL-INQ. DTSCS73 02453 *****MOVE CFKD-EVL-INQ TO MAP-KEY-EVL-INQ. DTSCS73 02454 *S9321-EXIT. DTSCS73 02455 *****EXIT. DTSCS73 02456 ***** DTSCS73 02457 S9330-DSCR-FIELDS. DTSCS73 02458 IF WRK-MPRF-YES-88 DTSCS73 02459 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME DTSCS73 02460 END-IF. DTSCS73 02461 DTSCS73 02462 IF MAP-SOURCE = LOW-VALUES OR SPACES DTSCS73 02463 MOVE LOW-VALUES TO MAP-SOURCE-DESC DTSCS73 02464 ELSE DTSCS73 02465 IF MAP-SOURCE = LCCM-OP-ID DTSCS73 02466 MOVE LCCM-OP-NAME TO MAP-SOURCE-DESC DTSCS73 02467 ELSE DTSCS73 02468 MOVE MAP-SOURCE TO L082-OP-ID DTSCS73 02469 PERFORM S082-OP-ID-LOOKUP THRU S082-EXIT DTSCS73 02470 MOVE L082-NAME TO MAP-SOURCE-DESC. DTSCS73 02471 DTSCS73 02472 DTSCS73 02473 S9330-EXIT. EXIT. DTSCS73 02474 DTSCS73 02475 S9900-PREPARE-SEND. DTSCS73 02476 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS73 02477 LCCM-SCR-ID. DTSCS73 02478 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS73 02479 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS73 02480 S9900-EXIT. DTSCS73 02481 EXIT. DTSCS73