giteaadmin/DUTAS
4
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
Dutas-Dev-Update
DUTAS/CICS/DTSCS73.cob
Neeraj Kumar ca3572c5df DUTAS re-platformed to Raincode - Initial Source Code
2025-07-21 11:20:11 -04:00

2483 lines
194 KiB
COBOL
Raw Permalink Blame History

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