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