00001 IDENTIFICATION DIVISION. 05/29/09 00002 PROGRAM-ID. DTSCS11. DTSCS11 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV027 00004 DATE-WRITTEN. JULY 1994. DTSCS11 00005 DATE-COMPILED. DTSCS11 00006 SKIP3 DTSCS11 00007 ***** DTSCS11 00008 * DTSCS11 00009 * FUNCTION: REGISTRATION INQUIRY DTSCS11 00010 * SCREEN PROCESSOR. DTSCS11 00011 * DTSCS11 00012 * DTSCS11 00013 * MODIFICATION LOG: DTSCS11 00014 * DTSCS11 00015 * 07/01/94 INITIAL DEVELOPMENT. DTSCS11 00016 * WORK ORDER: PROGRAMMER: RHC DTSCS11 00017 * DTSCS11 00018 * 01/12/95 CHANGE DPC FROM A NUMBER TO 'Y' FOR YES. DTSCS11 00019 * WORK ORDER: CR032 PROGRAMMER: RHC DTSCS11 00020 * DTSCS11 00021 * 05/21/95 DON'T DEFAULT TO THE WITHDRAWN QUARTER IF THERE DTSCS11 00022 * IS A QUARTER THAT ISN'T WITHDRAWN. DTSCS11 00023 * WORK ORDER: CR093 PROGRAMMER: RHC DTSCS11 00024 * DTSCS11 00025 * 10/03/95 IF NOT MPRF-WH-OFLT-NO-CONNECT-88, THEN DISPLAY DTSCS11 00026 * MPRF-WH-OFLT-SEIN ON THE SCREEN. DTSCS11 00027 * WORK ORDER: JR PROGRAMMER: EHH DTSCS11 00028 * DTSCS11 00029 * 05/13/1999 ADDED MAP-PKUP-DUE RELATED PROCESSING. DTSCS11 00030 * REFERENCE: PICKUP DIR PROGRAMMER: EHH DTSCS11 00031 * DTSCS11 00032 * 10/28/2004 MODIFIED TO INCLUDE LAST AUDIT YEAR DTSCS11 00033 * REFERENCE: DC MAINT PROGRAMMER: ZL1 DTSCS11 00034 * DTSCS11 00035 * 05/29/2009 CORRECTED PROBLEM WITH LAST AUDIT YEAR. DTSCS11 00036 * P6909 WAS ONLY EXECUTED IF THERE WAS AN OPEN DTSCS11 00037 * FIELD ASSIGNMENT, SO IT DID NOT SEE DTSCS11 00038 * PROCESSED AUDITS. DTSCS11 00039 * REFERENCE: DC MAINT PROGRAMMER: GD DTSCS11 00040 * DTSCS11 00041 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS11 00042 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS11 00043 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSCS11 00044 * DTSCS11 00045 * DTSCS11 00046 * DESCRIPTION: DTSCS11 00047 * DTSCS11 00048 * DTSCS11 00049 * CLEAR: DTSCS11 00050 * DTSCS11 00051 * FIELD(S) DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO). DTSCS11 00052 * DTSCS11 00053 * DTSCS11 00054 * JUMP: DTSCS11 00055 * DTSCS11 00056 * DTSCS11 00057 * INQUIRY: DTSCS11 00058 * DTSCS11 00059 * CONTROL FIELD(S): MAP-EMP-NO. DTSCS11 00060 * DTSCS11 00061 * JUMP IN: DISPLAY DATA ASSOCIATED WITH LCCM-EMP-NO. DTSCS11 00062 * DTSCS11 00063 * ENTER: DISPLAY DATA ASSOCIATED WITH MAP-EMP-NO. DTSCS11 00064 * DTSCS11 00065 * F19: DISPLAY DATA ASSOCIATED WITH MAP-PRED-EMP-NO. DTSCS11 00066 * DTSCS11 00067 * F20: DISPLAY DATA ASSOCIATED WITH MAP-SUC-EMP-NO. DTSCS11 00068 * DTSCS11 00069 * STANDARD LCCM-EMP-NO MAINTENANCE. DTSCS11 00070 * DTSCS11 00071 * DTSCS11 00072 * UPDATE: DTSCS11 00073 * DTSCS11 00074 * N/A. DTSCS11 00075 * DTSCS11 00076 * DTSCS11 00077 * RECORDS READ: DTSCS11 00078 * DTSCS11 00079 * MASTER: DTSCS11 00080 * DTSCS11 00081 * MPRF DTSCS11 00082 * MTAD DTSCS11 00083 * MSOL DTSCS11 00084 * MREL DTSCS11 00085 * MAPL DTSCS11 00086 * MLIN DTSCS11 00087 * MDPC DTSCS11 00088 * MFAS DTSCS11 00089 * MNTE DTSCS11 00090 * MTAA DTSCS11 00091 * MOPO DTSCS11 00092 * MRTE. DTSCS11 00093 * DTSCS11 00094 * ALTERNATE INDEX: DTSCS11 00095 * DTSCS11 00096 * IPES. DTSCS11 00097 * DTSCS11 00098 * REFERENCE: DTSCS11 00099 * DTSCS11 00100 * N/A. DTSCS11 00101 * DTSCS11 00102 * ACCOUNTING TRANSACTION COLLECTION: DTSCS11 00103 * DTSCS11 00104 * N/A. DTSCS11 00105 * DTSCS11 00106 * DTSCS11 00107 * RECORDS UPDATED: DTSCS11 00108 * DTSCS11 00109 * MASTER: DTSCS11 00110 * DTSCS11 00111 * N/A. DTSCS11 00112 * DTSCS11 00113 * REFERENCE: DTSCS11 00114 * DTSCS11 00115 * N/A. DTSCS11 00116 * DTSCS11 00117 * ACCOUNTING TRANSACTION COLLECTION: DTSCS11 00118 * DTSCS11 00119 * N/A. DTSCS11 00120 * DTSCS11 00121 * DTSCS11 00122 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCS11 00123 * DTSCS11 00124 * N/A. DTSCS11 00125 * DTSCS11 00126 * DTSCS11 00127 * TEMPORARY STORAGE USAGE: DTSCS11 00128 * DTSCS11 00129 * N/A. DTSCS11 00130 * DTSCS11 00131 * DTSCS11 00132 * MODULES LINKED TO: DTSCS11 00133 * DTSCS11 00134 * DTSCU001 DATE EDIT/CONVERSION. DTSCS11 00135 * DTSCU004 QUARTER EDIT/CONVERSION. DTSCS11 00136 * DTSCU018 EMP NO FROM SCREEN FORMAT/EDIT. DTSCS11 00137 * DTSCU031 EMPLOYER REGISTRATION CODES EDIT/DESCRIPTION. DTSCS11 00138 * DTSCU038 R&A CODES EDIT/DESCRIPTION. DTSCS11 00139 * DTSCU039 R&A SIC CODE EDIT/DESCRIPTION. DTSCS11 00140 * DTSCU056 RATE DISPLAY. DTSCS11 00141 * DTSCU061 FIELD ZIP / FIELD REP ID. DTSCS11 00142 * DTSCU062 FIELD ID EDIT/DESCRIPTION. DTSCS11 00143 * DTSCU810 MASTER FILE I/O DRIVER. DTSCS11 00144 * DTSCU821 AIX FILE I/O DRIVER. DTSCS11 00145 * DTSCS11 00146 * DTSCS11 00147 * MAINTENANCE NOTES: DTSCS11 00148 * DTSCS11 00149 * A NON-KEY FIELD ADDED TO OR REMOVED FROM THE SCREEN DTSCS11 00150 * REQUIRES ATTENTION IN THE FOLLOWING AREAS: DTSCS11 00151 * ALTER PARAGRAPH S5000, DTSCS11 00152 * ALTER AS APPROPRIATE PARAGRAPHS LISTED IN P6900, DTSCS11 00153 * ALTER THE SEND/RECEIVE AREA DEFINITION (DTSIS11), DTSCS11 00154 * ALTER THE MAP (DTSM11) AND ASSEMBLE THE MAPSET (DTSMSET).DTSCS11 00155 * DTSCS11 00156 * DTSCS11 00157 * VERMONT REFERENCE: DTSCS11 00158 * DTSCS11 00159 * TXC330C. DTSCS11 00160 * DTSCS11 00161 ***** DTSCS11 00162 ENVIRONMENT DIVISION. DTSCS11 00163 DATA DIVISION. DTSCS11 00164 EJECT DTSCS11 00165 WORKING-STORAGE SECTION. DTSCS11 001655 77 PAN-VALET PICTURE X(24) VALUE '027DTSCS11 05/29/09'. DTSCS11 00166 DTSCS11 00167 01 WRK-AREA. DTSCS11 00168 05 WRK-ABEND-CD PIC X(04) VALUE 'S11 '. DTSCS11 00169 DTSCS11 00170 05 WRK-SCR-ID. DTSCS11 00171 10 WRK-SCR-ID-N PIC 9(02) VALUE 11. DTSCS11 00172 05 WRK-F03-SCR-ID PIC X(02) VALUE '10'. DTSCS11 00173 DTSCS11 00174 05 WRK-SUBSCRIPTS. DTSCS11 00175 10 HOLD-COUNT PIC S9(04) COMP. DTSCS11 00176 DTSCS11 00177 05 HOLD-KEY-AREA PIC X(16). DTSCS11 00178 DTSCS11 00179 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSCS11 00180 DTSCS11 00181 05 WRK-MSG-AREA PIC X(62). DTSCS11 00182 SKIP3 DTSCS11 00183 05 WRK-LEFT-IN PIC 9(03). DTSCS11 00184 05 THREE-DIGITS REDEFINES WRK-LEFT-IN. DTSCS11 00185 10 FILLER PIC X(01). DTSCS11 00186 88 NOT-TAKE-THREE VALUE '0'. DTSCS11 00187 10 TWO-DIGITS. DTSCS11 00188 15 FILLER PIC X(01). DTSCS11 00189 88 NOT-TAKE-TWO VALUE '0'. DTSCS11 00190 15 ONE-DIGIT PIC X(01). DTSCS11 00191 88 NOT-TAKE-ONE VALUE '0'. DTSCS11 00192 05 WRK-LEFT-OUT PIC X(03). DTSCS11 00193 DTSCS11 00194 05 WRK-LAST-AUDIT-YRQ PIC 9(05). DTSCS11 00195 05 FILLER REDEFINES WRK-LAST-AUDIT-YRQ. DTSCS11 00196 10 WRK-LAST-AUDIT-CCYY PIC 9(04). DTSCS11 00197 10 WRK-LAST-AUDIT-Q PIC 9(01). DTSCS11 00198 SKIP3 DTSCS11 00199 05 WRK-DISPLAY PIC 9(11). DTSCS11 00200 05 FILLER REDEFINES WRK-DISPLAY. DTSCS11 00201 10 FILLER PIC X(05). DTSCS11 00202 10 WRK-DISPLAY-EMP-NO-1 PIC X(03). DTSCS11 00203 10 WRK-DISPLAY-EMP-NO-2 PIC X(03). DTSCS11 00204 05 FILLER REDEFINES WRK-DISPLAY. DTSCS11 00205 10 FILLER PIC X(02). DTSCS11 00206 10 WRK-DISPLAY-FEIN-1 PIC X(02). DTSCS11 00207 10 WRK-DISPLAY-FEIN-2 PIC X(07). DTSCS11 00208 EJECT DTSCS11 00209 01 SCREEN-CONTROL. DTSCS11 00210 05 CURSOR-SET-IND PIC X(01). DTSCS11 00211 88 CURSOR-SET-NO VALUE 'N'. DTSCS11 00212 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS11 00213 DTSCS11 00214 05 REQ-IND PIC X(01). DTSCS11 00215 88 REQ-ERROR VALUE 'O'. DTSCS11 00216 88 REQ-JUMP VALUE 'J'. DTSCS11 00217 88 REQ-CLEAR VALUE 'C'. DTSCS11 00218 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS11 00219 88 REQ-INQUIRE VALUE 'I'. DTSCS11 00220 DTSCS11 00221 05 RESP-IND PIC X(01). DTSCS11 00222 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS11 00223 88 RESP-SEND-MAP VALUE 'M'. DTSCS11 00224 88 RESP-JUMP VALUE 'J'. DTSCS11 00225 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS11 00226 EJECT DTSCS11 00227 01 L001-COMM-AREA. DTSCS11 00228 ++INCLUDE DTSIL001 DTSCS11 00229 EJECT DTSCS11 00230 01 L004-COMM-AREA. DTSCS11 00231 ++INCLUDE DTSIL004 DTSCS11 00232 EJECT DTSCS11 00233 01 L018-COMM-AREA. DTSCS11 00234 ++INCLUDE DTSIL018 DTSCS11 00235 EJECT DTSCS11 00236 01 L031-COMM-AREA. DTSCS11 00237 ++INCLUDE DTSIL031 DTSCS11 00238 EJECT DTSCS11 00239 01 L056-COMM-AREA. DTSCS11 00240 ++INCLUDE DTSIL056 DTSCS11 00241 EJECT DTSCS11 00242 01 L061-COMM-AREA. DTSCS11 00243 ++INCLUDE DTSIL061 DTSCS11 00244 EJECT DTSCS11 00245 01 L062-COMM-AREA. DTSCS11 00246 ++INCLUDE DTSIL062 DTSCS11 00247 EJECT DTSCS11 00248 01 L410-COMM-AREA. DTSCS11 00249 ++INCLUDE DTSIL410 DTSCS11 00250 EJECT DTSCS11 00251 01 L805-COMM-AREA. DTSCS11 00252 ++INCLUDE DTSIL805 DTSCS11 00253 EJECT DTSCS11 00254 01 L810-COMM-AREA. DTSCS11 00255 05 L810-CONTROL-BLOCK. DTSCS11 00256 ++INCLUDE DTSIL810 DTSCS11 00257 EJECT DTSCS11 00258 05 MSKL-REC. DTSCS11 00259 ++INCLUDE DTSIMSKL DTSCS11 00260 EJECT DTSCS11 00261 01 MPRF-REC. DTSCS11 00262 ++INCLUDE DTSIMPRF DTSCS11 00263 EJECT DTSCS11 00264 01 MTAD-REC. DTSCS11 00265 ++INCLUDE DTSIMTAD DTSCS11 00266 EJECT DTSCS11 00267 01 MSOL-REC. DTSCS11 00268 ++INCLUDE DTSIMSOL DTSCS11 00269 EJECT DTSCS11 00270 01 MREL-REC. DTSCS11 00271 ++INCLUDE DTSIMREL DTSCS11 00272 EJECT DTSCS11 00273 01 MAPL-REC. DTSCS11 00274 ++INCLUDE DTSIMAPL DTSCS11 00275 EJECT DTSCS11 00276 01 MLIN-REC. DTSCS11 00277 ++INCLUDE DTSIMLIN DTSCS11 00278 EJECT DTSCS11 00279 01 MDPC-REC. DTSCS11 00280 ++INCLUDE DTSIMDPC DTSCS11 00281 EJECT DTSCS11 00282 01 MFAS-REC. DTSCS11 00283 ++INCLUDE DTSIMFAS DTSCS11 00284 EJECT DTSCS11 00285 01 MNTE-REC. DTSCS11 00286 ++INCLUDE DTSIMNTE DTSCS11 00287 EJECT DTSCS11 00288 01 MTAA-REC. DTSCS11 00289 ++INCLUDE DTSIMTAA DTSCS11 00290 EJECT DTSCS11 00291 01 MOPO-REC. DTSCS11 00292 ++INCLUDE DTSIMOPO DTSCS11 00293 EJECT DTSCS11 00294 01 MRTE-REC. DTSCS11 00295 ++INCLUDE DTSIMRTE DTSCS11 00296 EJECT DTSCS11 00297 EJECT DTSCS11 00298 01 MQTR-REC. DTSCS11 00299 ++INCLUDE DTSIMQTR DTSCS11 00300 EJECT DTSCS11 00301 01 L821-COMM-AREA. DTSCS11 00302 05 L821-CONTROL-BLOCK. DTSCS11 00303 ++INCLUDE DTSIL821 DTSCS11 00304 SKIP3 DTSCS11 00305 05 ISKL-REC. DTSCS11 00306 ++INCLUDE DTSIISKL DTSCS11 00307 SKIP3 DTSCS11 00308 01 IPES-REC. DTSCS11 00309 ++INCLUDE DTSIIPES DTSCS11 00310 EJECT DTSCS11 00311 01 L851-COMM-AREA. DTSCS11 00312 ++INCLUDE DTSIL851 DTSCS11 00313 SKIP3 DTSCS11 00314 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS11 00315 ++INCLUDE DTSIS11 DTSCS11 00316 EJECT DTSCS11 00317 01 CATB-LITERALS. DTSCS11 00318 ++INCLUDE DTSICATB DTSCS11 00319 SKIP3 DTSCS11 00320 01 CFKD-LITERALS. DTSCS11 00321 ++INCLUDE DTSICFKD DTSCS11 00322 EJECT DTSCS11 00323 01 CECD-LITERALS. DTSCS11 00324 ++INCLUDE DTSICECD DTSCS11 00325 EJECT DTSCS11 00326 LINKAGE SECTION. DTSCS11 00327 SKIP3 DTSCS11 00328 01 DFHCOMMAREA. DTSCS11 00329 ++INCLUDE DTSILCCM DTSCS11 00330 EJECT DTSCS11 00331 ******************************************************************DTSCS11 00332 * *DTSCS11 00333 ******************************************************************DTSCS11 00334 DTSCS11 00335 PROCEDURE DIVISION. DTSCS11 00336 DTSCS11 00337 MOVE +0 TO WRK-EMP-NO. DTSCS11 00338 DTSCS11 00339 MOVE LOW-VALUES TO MAP-AREA. DTSCS11 00340 SET CURSOR-SET-NO TO TRUE. DTSCS11 00341 DTSCS11 00342 MOVE SPACE TO REQ-IND. DTSCS11 00343 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS11 00344 DTSCS11 00345 *----------------------------------------------------- DTSCS11 00346 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS11 00347 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS11 00348 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS11 00349 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS11 00350 * DTSCS11 00351 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS11 00352 * PROCESSED. DTSCS11 00353 * DTSCS11 00354 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS11 00355 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS11 00356 * WORK STATION OPERATOR. DTSCS11 00357 *----------------------------------------------------- DTSCS11 00358 DTSCS11 00359 MOVE SPACE TO RESP-IND. DTSCS11 00360 DTSCS11 00361 IF REQ-ERROR DTSCS11 00362 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS11 00363 ELSE DTSCS11 00364 IF REQ-JUMP DTSCS11 00365 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS11 00366 ELSE DTSCS11 00367 IF REQ-CLEAR DTSCS11 00368 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS11 00369 ELSE DTSCS11 00370 IF REQ-CURSOR-TO-GOTO DTSCS11 00371 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS11 00372 ELSE DTSCS11 00373 IF REQ-INQUIRE DTSCS11 00374 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS11 00375 ELSE DTSCS11 00376 GO TO S899-ABEND. DTSCS11 00377 SKIP3 DTSCS11 00378 *----------------------------------------------------- DTSCS11 00379 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS11 00380 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS11 00381 *----------------------------------------------------- DTSCS11 00382 DTSCS11 00383 IF RESP-SEND-MAP DTSCS11 00384 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS11 00385 SET LCCM-END-TASK-88 TO TRUE DTSCS11 00386 ELSE DTSCS11 00387 IF RESP-SEND-MSGONLY DTSCS11 00388 OR RESP-CURSOR-TO-GOTO DTSCS11 00389 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS11 00390 SET LCCM-END-TASK-88 TO TRUE DTSCS11 00391 ELSE DTSCS11 00392 IF RESP-JUMP DTSCS11 00393 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS11 00394 ELSE DTSCS11 00395 GO TO S899-ABEND. DTSCS11 00396 SKIP3 DTSCS11 00397 MAINLINE-EXIT. DTSCS11 00398 DTSCS11 00399 EXEC CICS DTSCS11 00400 RETURN DTSCS11 00401 END-EXEC. DTSCS11 00402 DTSCS11 00403 * GOBACK. DTSCS11 00404 /*****************************************************************DTSCS11 00405 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS11 00406 ******************************************************************DTSCS11 00407 P1000-ANALYZE-REQUEST. DTSCS11 00408 DTSCS11 00409 *----------------------------------------------------- DTSCS11 00410 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS11 00411 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS11 00412 * REPLACED WITH ENTER) DTSCS11 00413 *----------------------------------------------------- DTSCS11 00414 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS11 00415 SET LCCM-ENTER-88 TO TRUE DTSCS11 00416 IF LCCM-EMP-NO > ZERO DTSCS11 00417 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS11 00418 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS11 00419 END-IF DTSCS11 00420 SET REQ-INQUIRE TO TRUE DTSCS11 00421 GO TO P1000-EXIT. DTSCS11 00422 SKIP3 DTSCS11 00423 *----------------------------------------------------- DTSCS11 00424 * MAP IS RECEIVED DTSCS11 00425 *----------------------------------------------------- DTSCS11 00426 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS11 00427 SKIP3 DTSCS11 00428 *----------------------------------------------------- DTSCS11 00429 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS11 00430 * WORK STATION DTSCS11 00431 *----------------------------------------------------- DTSCS11 00432 IF LCCM-CLEAR-88 DTSCS11 00433 SET REQ-CLEAR TO TRUE DTSCS11 00434 GO TO P1000-EXIT. DTSCS11 00435 SKIP3 DTSCS11 00436 *----------------------------------------------------- DTSCS11 00437 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS11 00438 *----------------------------------------------------- DTSCS11 00439 IF LCCM-PA2-88 DTSCS11 00440 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS11 00441 GO TO P1000-EXIT. DTSCS11 00442 SKIP3 DTSCS11 00443 *----------------------------------------------------- DTSCS11 00444 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS11 00445 *----------------------------------------------------- DTSCS11 00446 IF LCCM-PA-88 DTSCS11 00447 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS11 00448 SET REQ-ERROR TO TRUE DTSCS11 00449 GO TO P1000-EXIT. DTSCS11 00450 SKIP3 DTSCS11 00451 *----------------------------------------------------- DTSCS11 00452 * F12 PRESSED WHEN UPDATE NOT IN PROGRESS IS A DTSCS11 00453 * REQUEST TO CLEAR THE SCREEN. DTSCS11 00454 *----------------------------------------------------- DTSCS11 00455 IF LCCM-F12-88 DTSCS11 00456 MOVE LOW-VALUES TO MAP-AREA DTSCS11 00457 SET REQ-CLEAR TO TRUE DTSCS11 00458 GO TO P1000-EXIT. DTSCS11 00459 SKIP3 DTSCS11 00460 *----------------------------------------------------- DTSCS11 00461 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS11 00462 *----------------------------------------------------- DTSCS11 00463 IF LCCM-F03-88 DTSCS11 00464 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS11 00465 SET REQ-JUMP TO TRUE DTSCS11 00466 GO TO P1000-EXIT. DTSCS11 00467 SKIP3 DTSCS11 00468 *----------------------------------------------------- DTSCS11 00469 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS11 00470 *----------------------------------------------------- DTSCS11 00471 IF LCCM-F04-88 DTSCS11 00472 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS11 00473 SET REQ-JUMP TO TRUE DTSCS11 00474 GO TO P1000-EXIT. DTSCS11 00475 SKIP3 DTSCS11 00476 *----------------------------------------------------- DTSCS11 00477 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS11 00478 * CORRESPONDENCE SCREEN DTSCS11 00479 *----------------------------------------------------- DTSCS11 00480 IF LCCM-F14-88 DTSCS11 00481 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS11 00482 SET REQ-JUMP TO TRUE DTSCS11 00483 GO TO P1000-EXIT. DTSCS11 00484 SKIP3 DTSCS11 00485 *----------------------------------------------------- DTSCS11 00486 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS11 00487 * REQUESTED SCREEN TYPE DTSCS11 00488 *----------------------------------------------------- DTSCS11 00489 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS11 00490 NEXT SENTENCE DTSCS11 00491 ELSE DTSCS11 00492 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS11 00493 SET REQ-JUMP TO TRUE DTSCS11 00494 GO TO P1000-EXIT. DTSCS11 00495 SKIP3 DTSCS11 00496 *----------------------------------------------------- DTSCS11 00497 * IF INQUIRY TYPE KEY PRESSED (ENTER, F19, OR F20) DTSCS11 00498 * INDICATE INQUIRY REQUEST DTSCS11 00499 *----------------------------------------------------- DTSCS11 00500 IF LCCM-ENTER-88 OR LCCM-F19-88 OR LCCM-F20-88 DTSCS11 00501 SET REQ-INQUIRE TO TRUE DTSCS11 00502 GO TO P1000-EXIT. DTSCS11 00503 SKIP3 DTSCS11 00504 *----------------------------------------------------- DTSCS11 00505 * ANY OTHER KEY IS INVALID DTSCS11 00506 *----------------------------------------------------- DTSCS11 00507 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS11 00508 SET REQ-ERROR TO TRUE. DTSCS11 00509 P1000-EXIT. EXIT. DTSCS11 00510 /*****************************************************************DTSCS11 00511 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS11 00512 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS11 00513 ******************************************************************DTSCS11 00514 DTSCS11 00515 P2000-REQUEST-ERROR. DTSCS11 00516 IF LCCM-MSG DTSCS11 00517 SET RESP-SEND-MSGONLY TO TRUE DTSCS11 00518 ELSE DTSCS11 00519 GO TO S899-ABEND. DTSCS11 00520 P2000-EXIT. EXIT. DTSCS11 00521 /*****************************************************************DTSCS11 00522 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS11 00523 ******************************************************************DTSCS11 00524 DTSCS11 00525 P3000-REQUEST-JUMP. DTSCS11 00526 *----------------------------------------------------- DTSCS11 00527 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS11 00528 * BY USER DTSCS11 00529 *----------------------------------------------------- DTSCS11 00530 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS11 00531 SKIP3 DTSCS11 00532 *----------------------------------------------------- DTSCS11 00533 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS11 00534 *----------------------------------------------------- DTSCS11 00535 IF LCCM-MSG DTSCS11 00536 SET CURSOR-SET-GOTO TO TRUE DTSCS11 00537 SET RESP-SEND-MSGONLY TO TRUE DTSCS11 00538 GO TO P3000-EXIT. DTSCS11 00539 SKIP3 DTSCS11 00540 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS11 00541 PERFORM S018-SCREEN-EMPNO THRU S018-EXIT. DTSCS11 00542 IF L018-VALID DTSCS11 00543 MOVE L018-EMP-NO TO LCCM-EMP-NO. DTSCS11 00544 SKIP3 DTSCS11 00545 *----------------------------------------------------- DTSCS11 00546 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS11 00547 *----------------------------------------------------- DTSCS11 00548 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS11 00549 LCCM-SCR-HOLD-AREA. DTSCS11 00550 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS11 00551 SET RESP-JUMP TO TRUE. DTSCS11 00552 P3000-EXIT. EXIT. DTSCS11 00553 /*****************************************************************DTSCS11 00554 * CLEAR KEY WAS PRESSED *DTSCS11 00555 ******************************************************************DTSCS11 00556 DTSCS11 00557 P4000-REQUEST-CLEAR. DTSCS11 00558 SET LCCM-SCR-CLEAR TO TRUE. DTSCS11 00559 DTSCS11 00560 PERFORM S5000-SET-INQ-ATTRB THRU S5000-EXIT. DTSCS11 00561 SKIP3 DTSCS11 00562 *----------------------------------------------------- DTSCS11 00563 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS11 00564 * FIELDS FROM EARLIER REQUESTS DTSCS11 00565 *----------------------------------------------------- DTSCS11 00566 IF LCCM-EMP-NO > ZERO DTSCS11 00567 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS11 00568 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS11 00569 MOVE ZERO TO LCCM-EMP-NO. DTSCS11 00570 DTSCS11 00571 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS11 00572 SET RESP-SEND-MAP TO TRUE. DTSCS11 00573 P4000-EXIT. EXIT. DTSCS11 00574 /*****************************************************************DTSCS11 00575 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS11 00576 ******************************************************************DTSCS11 00577 DTSCS11 00578 P5000-CURSOR-TO-GOTO. DTSCS11 00579 SET CURSOR-SET-GOTO TO TRUE. DTSCS11 00580 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS11 00581 P5000-EXIT. EXIT. DTSCS11 00582 /*****************************************************************DTSCS11 00583 * INQUIRY WAS REQUESTED *DTSCS11 00584 * F19 IS A REQUEST TO DISPLAY THE PREDECESSOR DTSCS11 00585 * F20 IS A REQUEST TO DISPLAY THE SUCCESSOR DTSCS11 00586 ******************************************************************DTSCS11 00587 DTSCS11 00588 P6000-REQUEST-INQUIRE. DTSCS11 00589 IF LCCM-F19-88 DTSCS11 00590 SET LCCM-ENTER-88 TO TRUE DTSCS11 00591 MOVE MAP-PRED-EMP-NO-AREA TO L018-S-EMP-NO-AREA DTSCS11 00592 PERFORM S018-SCREEN-EMPNO THRU S018-EXIT DTSCS11 00593 IF L018-VALID DTSCS11 00594 MOVE MAP-PRED-EMP-NO-AREA TO MAP-EMP-NO-AREA DTSCS11 00595 END-IF DTSCS11 00596 ELSE DTSCS11 00597 IF LCCM-F20-88 DTSCS11 00598 SET LCCM-ENTER-88 TO TRUE DTSCS11 00599 MOVE MAP-SUC-EMP-NO-AREA TO L018-S-EMP-NO-AREA DTSCS11 00600 PERFORM S018-SCREEN-EMPNO THRU S018-EXIT DTSCS11 00601 IF L018-VALID DTSCS11 00602 MOVE MAP-SUC-EMP-NO-AREA TO MAP-EMP-NO-AREA. DTSCS11 00603 DTSCS11 00604 SET RESP-SEND-MAP TO TRUE. DTSCS11 00605 DTSCS11 00606 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS11 00607 MOVE LOW-VALUES TO MAP-AREA. DTSCS11 00608 MOVE L018-S-EMP-NO-AREA TO MAP-EMP-NO-AREA. DTSCS11 00609 DTSCS11 00610 PERFORM S5000-SET-INQ-ATTRB THRU S5000-EXIT. DTSCS11 00611 DTSCS11 00612 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS11 00613 DTSCS11 00614 SET LCCM-SCR-CLEAR TO TRUE. DTSCS11 00615 DTSCS11 00616 PERFORM S1100-EMP-NO THRU S1100-EXIT. DTSCS11 00617 IF LCCM-MSG DTSCS11 00618 GO TO P6000-EXIT. DTSCS11 00619 DTSCS11 00620 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS11 00621 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS11 00622 SET MSKL-PRF-88 TO TRUE. DTSCS11 00623 PERFORM S810-READ THRU S810-EXIT. DTSCS11 00624 IF L810-OK-88 DTSCS11 00625 MOVE MSKL-REC TO MPRF-REC DTSCS11 00626 ELSE DTSCS11 00627 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS11 00628 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS11 00629 GO TO P6000-EXIT. DTSCS11 00630 DTSCS11 00631 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS11 00632 DTSCS11 00633 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS11 00634 DTSCS11 00635 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS11 00636 P6000-EXIT. EXIT. DTSCS11 00637 /*****************************************************************DTSCS11 00638 * THE MPRF RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCS11 00639 ******************************************************************DTSCS11 00640 DTSCS11 00641 P6900-CONSTRUCT-SCREEN. DTSCS11 00642 PERFORM P6901-FROM-MPRF THRU P6901-EXIT. DTSCS11 00643 PERFORM P6902-FROM-MTAD THRU P6902-EXIT. DTSCS11 00644 PERFORM P6903-FROM-MSOL THRU P6903-EXIT. DTSCS11 00645 PERFORM P6904-FROM-MREL THRU P6904-EXIT. DTSCS11 00646 PERFORM P6905-FROM-IPES THRU P6905-EXIT. DTSCS11 00647 DTSCS11 00648 IF MPRF-MAPL-EXISTS-88 DTSCS11 00649 PERFORM P6906-FROM-MAPL THRU P6906-EXIT. DTSCS11 00650 DTSCS11 00651 IF MPRF-MLIN-EXISTS-88 DTSCS11 00652 PERFORM P6907-FROM-MLIN THRU P6907-EXIT. DTSCS11 00653 DTSCS11 00654 IF MPRF-MDPC-EXISTS-88 DTSCS11 00655 PERFORM P6908-FROM-MDPC THRU P6908-EXIT. DTSCS11 00656 DTSCS11 00657 *** IF MPRF-MFAS-EXISTS-88 DTSCS11 00658 PERFORM P6909-FROM-MFAS THRU P6909-EXIT. DTSCS11 00659 DTSCS11 00660 PERFORM P6910-FROM-MNTE THRU P6910-EXIT. DTSCS11 00661 PERFORM P6911-FROM-MTAA THRU P6911-EXIT. DTSCS11 00662 PERFORM P6912-FROM-MOPO THRU P6912-EXIT. DTSCS11 00663 PERFORM P6913-FROM-MRTE THRU P6913-EXIT. DTSCS11 00664 PERFORM P6914-FROM-MQTR THRU P6914-EXIT. DTSCS11 00665 P6900-EXIT. EXIT. DTSCS11 00666 SKIP3 DTSCS11 00667 P6901-FROM-MPRF. DTSCS11 00668 MOVE MPRF-EMP-CLASS TO L031-CD. DTSCS11 00669 SET L031-MPRF-EMP-CLASS TO TRUE. DTSCS11 00670 PERFORM S031-DESC-REG THRU S031-EXIT. DTSCS11 00671 MOVE L031-SHORT-DSCR TO MAP-CLASS. DTSCS11 00672 DTSCS11 00673 MOVE MPRF-EMP-STATUS TO L031-CD. DTSCS11 00674 SET L031-MPRF-EMP-STATUS TO TRUE. DTSCS11 00675 PERFORM S031-DESC-REG THRU S031-EXIT. DTSCS11 00676 MOVE L031-SHORT-DSCR TO MAP-STATUS. DTSCS11 00677 DTSCS11 00678 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME. DTSCS11 00679 IF MPRF-ENTITY-NAME NOT = SPACES DTSCS11 00680 MOVE MPRF-ENTITY-NAME TO MAP-ENTITY-NAME. DTSCS11 00681 DTSCS11 00682 MOVE MPRF-FLD-ZIP TO L061-FLD-ZIP. DTSCS11 00683 MOVE MPRF-FLD-ST TO L061-FLD-ST. DTSCS11 00684 MOVE WRK-EMP-NO TO L061-EMP-NO. DTSCS11 00685 PERFORM S061-FLD-ZIP THRU S061-EXIT. DTSCS11 00686 MOVE L061-FLD-REP-ID TO MAP-FLD-REP DTSCS11 00687 L062-FLD-REP-ID. DTSCS11 00688 PERFORM S062-DESC-FLD THRU S062-EXIT. DTSCS11 00689 MOVE L062-NAME TO MAP-FLD-REP-NAME. DTSCS11 00690 DTSCS11 00691 DTSCS11 00692 MOVE MPRF-ORG-TYPE TO MAP-ORG-TYPE DTSCS11 00693 L031-CD. DTSCS11 00694 SET L031-MPRF-ORG-TYPE TO TRUE. DTSCS11 00695 PERFORM S031-DESC-REG THRU S031-EXIT. DTSCS11 00696 MOVE L031-SHORT-DSCR TO MAP-ORG-TYPE-DESC. DTSCS11 00697 DTSCS11 00698 IF MPRF-FEIN NOT = +0 DTSCS11 00699 MOVE MPRF-FEIN TO WRK-DISPLAY DTSCS11 00700 MOVE WRK-DISPLAY-FEIN-1 TO MAP-FEIN-1 DTSCS11 00701 MOVE WRK-DISPLAY-FEIN-2 TO MAP-FEIN-2. DTSCS11 00702 DTSCS11 00703 IF MPRF-DC-BUSINESS-TAX-ACCT-NO NOT = +0 DTSCS11 00704 MOVE MPRF-DC-BUSINESS-TAX-ACCT-NO DTSCS11 00705 TO MAP-BTN. DTSCS11 00706 DTSCS11 00707 IF MPRF-WRITE-OFF-DATE NOT = +0 DTSCS11 00708 MOVE 'Y' TO MAP-WRITE-OFF. DTSCS11 00709 DTSCS11 00710 IF MPRF-PURSUED-RPT-CNT > +0 DTSCS11 00711 OR MPRF-TOT-BALANCE-AMT > +0 DTSCS11 00712 MOVE 'Y' TO MAP-COL. DTSCS11 00713 DTSCS11 00714 IF MPRF-TOT-CREDIT-AMT NOT = +0 DTSCS11 00715 MOVE 'Y' TO MAP-CREDIT. DTSCS11 00716 DTSCS11 00717 IF MPRF-BANKRP-OPEN-88 DTSCS11 00718 MOVE 'Y' TO MAP-OPEN-BNK. DTSCS11 00719 DTSCS11 00720 MOVE MPRF-PURGE-IND TO MAP-PURGE. DTSCS11 00721 DTSCS11 00722 DTSCS11 00723 IF MPRF-ORG-HSEHLD-DMSTIC-88 DTSCS11 00724 PERFORM S410-FILING-SCHEDULE THRU S410-EXIT DTSCS11 00725 IF L410-ANN-SCHED-88 DTSCS11 00726 MOVE 'ANNUAL FILER ' TO MAP-FILER DTSCS11 00727 ELSE DTSCS11 00728 IF L410-QTRLY-SCHED-88 DTSCS11 00729 MOVE 'QUARTERLY FILER' TO MAP-FILER DTSCS11 00730 ELSE DTSCS11 00731 IF L410-PENDING-SCHED-88 DTSCS11 00732 MOVE 'PENDING ' TO MAP-FILER DTSCS11 00733 ELSE DTSCS11 00734 MOVE SPACES TO MAP-FILER DTSCS11 00735 END-IF DTSCS11 00736 END-IF. DTSCS11 00737 DTSCS11 00738 P6901-EXIT. EXIT. DTSCS11 00739 SKIP3 DTSCS11 00740 P6902-FROM-MTAD. DTSCS11 00741 MOVE LOW-VALUE TO MTAD-KEY-AREA. DTSCS11 00742 MOVE WRK-EMP-NO TO MTAD-EMP-NO. DTSCS11 00743 SET MTAD-TAD-88 TO TRUE. DTSCS11 00744 SET MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE. DTSCS11 00745 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSCS11 00746 PERFORM S810-READ THRU S810-EXIT. DTSCS11 00747 IF L810-OK-88 DTSCS11 00748 MOVE MSKL-REC TO MTAD-REC DTSCS11 00749 MOVE MTAD-ATTN-LINE TO MAP-1-ATTN-LINE DTSCS11 00750 MOVE MTAD-DELIV-LINE-1 TO MAP-1-DELIV-LINE-1 DTSCS11 00751 MOVE MTAD-DELIV-LINE-2 TO MAP-1-DELIV-LINE-2 DTSCS11 00752 MOVE MTAD-CITY TO MAP-1-CITY DTSCS11 00753 MOVE MTAD-ST TO MAP-1-ST DTSCS11 00754 MOVE MTAD-ZIP TO MAP-1-ZIP. DTSCS11 00755 DTSCS11 00756 MOVE LOW-VALUE TO MTAD-KEY-AREA. DTSCS11 00757 MOVE WRK-EMP-NO TO MTAD-EMP-NO. DTSCS11 00758 SET MTAD-TAD-88 TO TRUE. DTSCS11 00759 SET MTAD-ID-TAX-RECORDS-ADDR-88 TO TRUE. DTSCS11 00760 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSCS11 00761 PERFORM S810-READ THRU S810-EXIT. DTSCS11 00762 IF L810-OK-88 DTSCS11 00763 MOVE MSKL-REC TO MTAD-REC DTSCS11 00764 MOVE MTAD-ATTN-LINE TO MAP-2-ATTN-LINE DTSCS11 00765 MOVE MTAD-DELIV-LINE-1 TO MAP-2-DELIV-LINE-1 DTSCS11 00766 MOVE MTAD-DELIV-LINE-2 TO MAP-2-DELIV-LINE-2 DTSCS11 00767 MOVE MTAD-CITY TO MAP-2-CITY DTSCS11 00768 MOVE MTAD-ST TO MAP-2-ST DTSCS11 00769 MOVE MTAD-ZIP TO MAP-2-ZIP. DTSCS11 00770 DTSCS11 00771 P6902-EXIT. EXIT. DTSCS11 00772 SKIP3 DTSCS11 00773 P6903-FROM-MSOL. DTSCS11 00774 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSCS11 00775 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS11 00776 SET MSKL-SOL-88 TO TRUE. DTSCS11 00777 PERFORM S8000-RETURN-DISP-COUNT THRU S8000-EXIT. DTSCS11 00778 MOVE WRK-LEFT-OUT TO MAP-SPANS. DTSCS11 00779 DTSCS11 00780 IF L810-RECORD-CNT = +0 DTSCS11 00781 GO TO P6903-EXIT. DTSCS11 00782 DTSCS11 00783 PERFORM S810-READ THRU S810-EXIT. DTSCS11 00784 MOVE MSKL-REC TO MSOL-REC. DTSCS11 00785 IF MSOL-INACT-WITHDRAWN-88 DTSCS11 00786 AND WRK-LEFT-IN > 1 DTSCS11 00787 PERFORM P6903A-LOCATE-MSOL THRU P6903A-EXIT. DTSCS11 00788 SKIP3 DTSCS11 00789 MOVE MSOL-LIAB-DATE TO L001-FED-8-DATE-9. DTSCS11 00790 SET L001-FROM-FED-8 TO TRUE. DTSCS11 00791 PERFORM S001-EDIT-DATE THRU S001-EXIT. DTSCS11 00792 MOVE L001-SLASH-DATE TO MAP-LIAB. DTSCS11 00793 DTSCS11 00794 IF MSOL-FIRST-LIAB-YRQ NOT = +0 DTSCS11 00795 MOVE MSOL-FIRST-LIAB-YRQ TO L004-QTR-5-9 DTSCS11 00796 SET L004-FROM-5 TO TRUE DTSCS11 00797 PERFORM S004-EDIT-QTR THRU S004-EXIT DTSCS11 00798 MOVE L004-SLASH-QTR TO MAP-LIAB-QTR. DTSCS11 00799 DTSCS11 00800 MOVE MSOL-LIAB-ESTB-DATE TO L001-FED-8-DATE-9. DTSCS11 00801 SET L001-FROM-FED-8 TO TRUE. DTSCS11 00802 PERFORM S001-EDIT-DATE THRU S001-EXIT. DTSCS11 00803 MOVE L001-SLASH-DATE TO MAP-LIAB-ESTB. DTSCS11 00804 DTSCS11 00805 MOVE MSOL-ESTB-DATE TO L001-FED-8-DATE-9. DTSCS11 00806 SET L001-FROM-FED-8 TO TRUE. DTSCS11 00807 PERFORM S001-EDIT-DATE THRU S001-EXIT. DTSCS11 00808 MOVE L001-SLASH-DATE TO MAP-LIAB-ENTRY. DTSCS11 00809 DTSCS11 00810 MOVE MSOL-LIAB-CD TO MAP-LIAB-CD DTSCS11 00811 L031-CD. DTSCS11 00812 SET L031-MSOL-LIAB-CD TO TRUE. DTSCS11 00813 PERFORM S031-DESC-REG THRU S031-EXIT. DTSCS11 00814 MOVE L031-SHORT-DSCR TO MAP-LIAB-DESC. DTSCS11 00815 DTSCS11 00816 IF MSOL-INACT-ACTIVE-88 DTSCS11 00817 NEXT SENTENCE DTSCS11 00818 ELSE DTSCS11 00819 MOVE MSOL-INACT-DATE TO L001-FED-8-DATE-9 DTSCS11 00820 SET L001-FROM-FED-8 TO TRUE DTSCS11 00821 PERFORM S001-EDIT-DATE THRU S001-EXIT DTSCS11 00822 MOVE L001-SLASH-DATE TO MAP-INAC DTSCS11 00823 DTSCS11 00824 IF MSOL-LAST-LIAB-YRQ NOT = +0 DTSCS11 00825 MOVE MSOL-LAST-LIAB-YRQ TO L004-QTR-5-9 DTSCS11 00826 SET L004-FROM-5 TO TRUE DTSCS11 00827 PERFORM S004-EDIT-QTR THRU S004-EXIT DTSCS11 00828 MOVE L004-SLASH-QTR TO MAP-INAC-QTR. DTSCS11 00829 DTSCS11 00830 IF MSOL-INACT-ACTIVE-88 DTSCS11 00831 NEXT SENTENCE DTSCS11 00832 ELSE DTSCS11 00833 IF MSOL-INACT-ENTER-DATE NOT = +0 DTSCS11 00834 MOVE MSOL-INACT-ENTER-DATE TO L001-FED-8-DATE-9 DTSCS11 00835 SET L001-FROM-FED-8 TO TRUE DTSCS11 00836 PERFORM S001-EDIT-DATE THRU S001-EXIT DTSCS11 00837 MOVE L001-SLASH-DATE TO MAP-INAC-ENTRY. DTSCS11 00838 DTSCS11 00839 MOVE MSOL-INACT-CD TO MAP-INAC-CD DTSCS11 00840 L031-CD. DTSCS11 00841 SET L031-MSOL-INACT-CD TO TRUE. DTSCS11 00842 PERFORM S031-DESC-REG THRU S031-EXIT. DTSCS11 00843 MOVE L031-SHORT-DSCR TO MAP-INAC-DESC. DTSCS11 00844 P6903-EXIT. EXIT. DTSCS11 00845 SKIP3 DTSCS11 00846 P6903A-LOCATE-MSOL. DTSCS11 00847 MOVE MSKL-KEY-AREA TO HOLD-KEY-AREA. DTSCS11 00848 DTSCS11 00849 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS11 00850 MOVE MSKL-REC TO MSOL-REC. DTSCS11 00851 DTSCS11 00852 PERFORM UNTIL L810-NO-REC-88 DTSCS11 00853 OR NOT MSOL-INACT-WITHDRAWN-88 DTSCS11 00854 PERFORM S810-READ-PREV THRU S810-EXIT DTSCS11 00855 MOVE MSKL-REC TO MSOL-REC DTSCS11 00856 END-PERFORM. DTSCS11 00857 DTSCS11 00858 IF L810-OK-88 DTSCS11 00859 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS11 00860 ELSE DTSCS11 00861 MOVE HOLD-KEY-AREA TO MSKL-KEY-AREA DTSCS11 00862 PERFORM S810-READ THRU S810-EXIT DTSCS11 00863 MOVE MSKL-REC TO MSOL-REC. DTSCS11 00864 P6903A-EXIT. EXIT. DTSCS11 00865 SKIP3 DTSCS11 00866 P6904-FROM-MREL. DTSCS11 00867 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSCS11 00868 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS11 00869 SET MSKL-REL-88 TO TRUE. DTSCS11 00870 PERFORM S8000-RETURN-DISP-COUNT THRU S8000-EXIT. DTSCS11 00871 MOVE WRK-LEFT-OUT TO MAP-PRED. DTSCS11 00872 DTSCS11 00873 IF L810-RECORD-CNT NOT = +0 DTSCS11 00874 MOVE MSKL-KEY-AREA TO MREL-KEY-AREA DTSCS11 00875 MOVE MREL-PRED-EMP-NO TO WRK-DISPLAY DTSCS11 00876 MOVE WRK-DISPLAY-EMP-NO-1 TO MAP-PRED-EMP-NO-1 DTSCS11 00877 MOVE WRK-DISPLAY-EMP-NO-2 TO MAP-PRED-EMP-NO-2. DTSCS11 00878 P6904-EXIT. EXIT. DTSCS11 00879 SKIP3 DTSCS11 00880 P6905-FROM-IPES. DTSCS11 00881 MOVE LOW-VALUE TO IPES-KEY-AREA. DTSCS11 00882 SET IPES-PES-88 TO TRUE. DTSCS11 00883 MOVE WRK-EMP-NO TO IPES-PRED-EMP-NO. DTSCS11 00884 MOVE IPES-REC TO ISKL-REC. DTSCS11 00885 DTSCS11 00886 MOVE 0 TO WRK-LEFT-IN. DTSCS11 00887 PERFORM S821-START-BROWSE THRU S821-EXIT. DTSCS11 00888 DTSCS11 00889 PERFORM UNTIL L821-NO-REC-88 DTSCS11 00890 MOVE ISKL-REC TO IPES-REC DTSCS11 00891 IF IPES-PRED-EMP-NO = WRK-EMP-NO DTSCS11 00892 ADD 1 TO WRK-LEFT-IN DTSCS11 00893 MOVE IPES-SUC-EMP-NO TO WRK-DISPLAY DTSCS11 00894 PERFORM S821-READ-NEXT THRU S821-EXIT DTSCS11 00895 ELSE DTSCS11 00896 PERFORM S821-END-BROWSE THRU S821-EXIT DTSCS11 00897 SET L821-NO-REC-88 TO TRUE DTSCS11 00898 END-IF DTSCS11 00899 END-PERFORM. DTSCS11 00900 DTSCS11 00901 IF WRK-LEFT-IN NOT = 0 DTSCS11 00902 PERFORM S8100-LEFT-JUSTIFY THRU S8100-EXIT DTSCS11 00903 MOVE WRK-LEFT-OUT TO MAP-SUC DTSCS11 00904 MOVE WRK-DISPLAY-EMP-NO-1 TO MAP-SUC-EMP-NO-1 DTSCS11 00905 MOVE WRK-DISPLAY-EMP-NO-2 TO MAP-SUC-EMP-NO-2. DTSCS11 00906 P6905-EXIT. EXIT. DTSCS11 00907 SKIP3 DTSCS11 00908 P6906-FROM-MAPL. DTSCS11 00909 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSCS11 00910 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS11 00911 SET MSKL-APL-88 TO TRUE. DTSCS11 00912 DTSCS11 00913 MOVE 0 TO WRK-LEFT-IN. DTSCS11 00914 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS11 00915 DTSCS11 00916 PERFORM UNTIL L810-NO-REC-88 DTSCS11 00917 MOVE MSKL-REC TO MAPL-REC DTSCS11 00918 IF MAPL-STATUS-OPEN-88 DTSCS11 00919 ADD 1 TO WRK-LEFT-IN DTSCS11 00920 END-IF DTSCS11 00921 PERFORM S810-READ-NEXT THRU S810-EXIT DTSCS11 00922 END-PERFORM. DTSCS11 00923 DTSCS11 00924 PERFORM S8100-LEFT-JUSTIFY THRU S8100-EXIT. DTSCS11 00925 MOVE WRK-LEFT-OUT TO MAP-OPEN-APL. DTSCS11 00926 P6906-EXIT. EXIT. DTSCS11 00927 SKIP3 DTSCS11 00928 P6907-FROM-MLIN. DTSCS11 00929 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSCS11 00930 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS11 00931 SET MSKL-LIN-88 TO TRUE. DTSCS11 00932 DTSCS11 00933 MOVE 0 TO WRK-LEFT-IN. DTSCS11 00934 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS11 00935 DTSCS11 00936 PERFORM UNTIL L810-NO-REC-88 DTSCS11 00937 MOVE MSKL-REC TO MLIN-REC DTSCS11 00938 IF MLIN-STATUS-ACTIVE-88 DTSCS11 00939 ADD 1 TO WRK-LEFT-IN DTSCS11 00940 END-IF DTSCS11 00941 PERFORM S810-READ-NEXT THRU S810-EXIT DTSCS11 00942 END-PERFORM. DTSCS11 00943 DTSCS11 00944 PERFORM S8100-LEFT-JUSTIFY THRU S8100-EXIT. DTSCS11 00945 MOVE WRK-LEFT-OUT TO MAP-OPEN-LIEN. DTSCS11 00946 P6907-EXIT. EXIT. DTSCS11 00947 SKIP3 DTSCS11 00948 P6908-FROM-MDPC. DTSCS11 00949 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSCS11 00950 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS11 00951 SET MSKL-DPC-88 TO TRUE. DTSCS11 00952 DTSCS11 00953 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS11 00954 DTSCS11 00955 PERFORM UNTIL L810-NO-REC-88 DTSCS11 00956 MOVE MSKL-REC TO MDPC-REC DTSCS11 00957 IF MDPC-STATUS-ACTIVE-88 DTSCS11 00958 MOVE 'Y' TO MAP-OPEN-DPC DTSCS11 00959 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS11 00960 SET L810-NO-REC-88 TO TRUE DTSCS11 00961 ELSE DTSCS11 00962 PERFORM S810-READ-NEXT THRU S810-EXIT DTSCS11 00963 END-IF DTSCS11 00964 END-PERFORM. DTSCS11 00965 P6908-EXIT. EXIT. DTSCS11 00966 SKIP3 DTSCS11 00967 P6909-FROM-MFAS. DTSCS11 00968 DTSCS11 00969 MOVE ZEROS TO WRK-LAST-AUDIT-YRQ. DTSCS11 00970 DTSCS11 00971 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSCS11 00972 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS11 00973 SET MSKL-FAS-88 TO TRUE. DTSCS11 00974 DTSCS11 00975 MOVE 0 TO WRK-LEFT-IN. DTSCS11 00976 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS11 00977 DTSCS11 00978 PERFORM UNTIL L810-NO-REC-88 DTSCS11 00979 MOVE MSKL-REC TO MFAS-REC DTSCS11 00980 IF MFAS-STATUS-ACTIVE-88 DTSCS11 00981 OR MFAS-STATUS-HELD-88 DTSCS11 00982 ADD 1 TO WRK-LEFT-IN DTSCS11 00983 ELSE DTSCS11 00984 IF MFAS-STATUS-PROCESSED-88 DTSCS11 00985 IF MFAS-START-YRQ > WRK-LAST-AUDIT-YRQ DTSCS11 00986 MOVE MFAS-START-YRQ TO WRK-LAST-AUDIT-YRQ DTSCS11 00987 END-IF DTSCS11 00988 END-IF DTSCS11 00989 END-IF DTSCS11 00990 PERFORM S810-READ-NEXT THRU S810-EXIT DTSCS11 00991 END-PERFORM. DTSCS11 00992 DTSCS11 00993 PERFORM S8100-LEFT-JUSTIFY THRU S8100-EXIT. DTSCS11 00994 MOVE WRK-LEFT-OUT TO MAP-OPEN-FLD. DTSCS11 00995 IF WRK-LAST-AUDIT-CCYY > ZERO DTSCS11 00996 MOVE WRK-LAST-AUDIT-CCYY TO MAP-LAST-AUDIT DTSCS11 00997 END-IF. DTSCS11 00998 P6909-EXIT. EXIT. DTSCS11 00999 SKIP3 DTSCS11 01000 P6910-FROM-MNTE. DTSCS11 01001 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSCS11 01002 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS11 01003 SET MSKL-NTE-88 TO TRUE. DTSCS11 01004 PERFORM S8000-RETURN-DISP-COUNT THRU S8000-EXIT. DTSCS11 01005 MOVE WRK-LEFT-OUT TO MAP-NOTES. DTSCS11 01006 P6910-EXIT. EXIT. DTSCS11 01007 SKIP3 DTSCS11 01008 P6911-FROM-MTAA. DTSCS11 01009 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSCS11 01010 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS11 01011 SET MSKL-TAA-88 TO TRUE. DTSCS11 01012 PERFORM S8000-RETURN-DISP-COUNT THRU S8000-EXIT. DTSCS11 01013 MOVE WRK-LEFT-OUT TO MAP-ALT-ADDR. DTSCS11 01014 P6911-EXIT. EXIT. DTSCS11 01015 SKIP3 DTSCS11 01016 P6912-FROM-MOPO. DTSCS11 01017 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSCS11 01018 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS11 01019 SET MSKL-OPO-88 TO TRUE. DTSCS11 01020 PERFORM S8000-RETURN-DISP-COUNT THRU S8000-EXIT. DTSCS11 01021 MOVE WRK-LEFT-OUT TO MAP-OPO. DTSCS11 01022 P6912-EXIT. EXIT. DTSCS11 01023 SKIP3 DTSCS11 01024 P6913-FROM-MRTE. DTSCS11 01025 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSCS11 01026 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS11 01027 SET MSKL-RTE-88 TO TRUE. DTSCS11 01028 PERFORM S8000-RETURN-DISP-COUNT THRU S8000-EXIT. DTSCS11 01029 IF L810-RECORD-CNT = +0 DTSCS11 01030 GO TO P6913-EXIT. DTSCS11 01031 DTSCS11 01032 MOVE L810-RECORD-CNT TO HOLD-COUNT. DTSCS11 01033 SKIP3 DTSCS11 01034 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS11 01035 IF L810-NO-REC-88 DTSCS11 01036 GO TO P6913-EXIT. DTSCS11 01037 DTSCS11 01038 MOVE MSKL-REC TO MRTE-REC. DTSCS11 01039 DTSCS11 01040 MOVE MRTE-EFF-YRQ TO L004-QTR-5-9. DTSCS11 01041 SET L004-FROM-5 TO TRUE. DTSCS11 01042 PERFORM S004-EDIT-QTR THRU S004-EXIT. DTSCS11 01043 MOVE L004-SLASH-QTR TO MAP-1-EFF. DTSCS11 01044 DTSCS11 01045 MOVE MRTE-UI-RATE TO L056-RATE. DTSCS11 01046 SET L056-DISP1-LEFT-88 TO TRUE. DTSCS11 01047 PERFORM S056-DISP-RATE THRU S056-EXIT. DTSCS11 01048 MOVE L056-DISP-RATE TO MAP-1-UIRTE. DTSCS11 01049 DTSCS11 01050 IF HOLD-COUNT = +1 DTSCS11 01051 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS11 01052 GO TO P6913-EXIT. DTSCS11 01053 SKIP3 DTSCS11 01054 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCS11 01055 IF L810-NO-REC-88 DTSCS11 01056 GO TO P6913-EXIT. DTSCS11 01057 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCS11 01058 IF L810-NO-REC-88 DTSCS11 01059 GO TO P6913-EXIT. DTSCS11 01060 MOVE MSKL-REC TO MRTE-REC. DTSCS11 01061 DTSCS11 01062 MOVE MRTE-EFF-YRQ TO L004-QTR-5-9. DTSCS11 01063 SET L004-FROM-5 TO TRUE. DTSCS11 01064 PERFORM S004-EDIT-QTR THRU S004-EXIT. DTSCS11 01065 MOVE L004-SLASH-QTR TO MAP-2-EFF. DTSCS11 01066 DTSCS11 01067 MOVE MRTE-UI-RATE TO L056-RATE. DTSCS11 01068 SET L056-DISP1-LEFT-88 TO TRUE. DTSCS11 01069 PERFORM S056-DISP-RATE THRU S056-EXIT. DTSCS11 01070 MOVE L056-DISP-RATE TO MAP-2-UIRTE. DTSCS11 01071 DTSCS11 01072 IF HOLD-COUNT = +2 DTSCS11 01073 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS11 01074 GO TO P6913-EXIT. DTSCS11 01075 SKIP3 DTSCS11 01076 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCS11 01077 IF L810-NO-REC-88 DTSCS11 01078 GO TO P6913-EXIT. DTSCS11 01079 MOVE MSKL-REC TO MRTE-REC. DTSCS11 01080 DTSCS11 01081 MOVE MRTE-EFF-YRQ TO L004-QTR-5-9. DTSCS11 01082 SET L004-FROM-5 TO TRUE. DTSCS11 01083 PERFORM S004-EDIT-QTR THRU S004-EXIT. DTSCS11 01084 MOVE L004-SLASH-QTR TO MAP-3-EFF. DTSCS11 01085 DTSCS11 01086 MOVE MRTE-UI-RATE TO L056-RATE. DTSCS11 01087 SET L056-DISP1-LEFT-88 TO TRUE. DTSCS11 01088 PERFORM S056-DISP-RATE THRU S056-EXIT. DTSCS11 01089 MOVE L056-DISP-RATE TO MAP-3-UIRTE. DTSCS11 01090 DTSCS11 01091 IF HOLD-COUNT = +3 DTSCS11 01092 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS11 01093 GO TO P6913-EXIT. DTSCS11 01094 SKIP3 DTSCS11 01095 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCS11 01096 IF L810-NO-REC-88 DTSCS11 01097 GO TO P6913-EXIT. DTSCS11 01098 MOVE MSKL-REC TO MRTE-REC. DTSCS11 01099 DTSCS11 01100 MOVE MRTE-EFF-YRQ TO L004-QTR-5-9. DTSCS11 01101 SET L004-FROM-5 TO TRUE. DTSCS11 01102 PERFORM S004-EDIT-QTR THRU S004-EXIT. DTSCS11 01103 MOVE L004-SLASH-QTR TO MAP-4-EFF. DTSCS11 01104 DTSCS11 01105 MOVE MRTE-UI-RATE TO L056-RATE. DTSCS11 01106 SET L056-DISP1-LEFT-88 TO TRUE. DTSCS11 01107 PERFORM S056-DISP-RATE THRU S056-EXIT. DTSCS11 01108 MOVE L056-DISP-RATE TO MAP-4-UIRTE. DTSCS11 01109 DTSCS11 01110 IF HOLD-COUNT = +4 DTSCS11 01111 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS11 01112 GO TO P6913-EXIT. DTSCS11 01113 SKIP3 DTSCS11 01114 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCS11 01115 IF L810-NO-REC-88 DTSCS11 01116 GO TO P6913-EXIT. DTSCS11 01117 MOVE MSKL-REC TO MRTE-REC. DTSCS11 01118 DTSCS11 01119 MOVE MRTE-EFF-YRQ TO L004-QTR-5-9. DTSCS11 01120 SET L004-FROM-5 TO TRUE. DTSCS11 01121 PERFORM S004-EDIT-QTR THRU S004-EXIT. DTSCS11 01122 MOVE L004-SLASH-QTR TO MAP-5-EFF. DTSCS11 01123 DTSCS11 01124 MOVE MRTE-UI-RATE TO L056-RATE. DTSCS11 01125 SET L056-DISP1-LEFT-88 TO TRUE. DTSCS11 01126 PERFORM S056-DISP-RATE THRU S056-EXIT. DTSCS11 01127 MOVE L056-DISP-RATE TO MAP-5-UIRTE. DTSCS11 01128 DTSCS11 01129 DTSCS11 01130 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS11 01131 P6913-EXIT. EXIT. DTSCS11 01132 SKIP3 DTSCS11 01133 P6914-FROM-MQTR. DTSCS11 01134 MOVE ' ' TO MAP-PKUP-DUE. DTSCS11 01135 DTSCS11 01136 DTSCS11 01137 IF MPRF-TOT-BALANCE-AMT = +0 DTSCS11 01138 GO TO P6914-EXIT. DTSCS11 01139 DTSCS11 01140 DTSCS11 01141 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSCS11 01142 DTSCS11 01143 MOVE WRK-EMP-NO TO MQTR-EMP-NO. DTSCS11 01144 DTSCS11 01145 SET MQTR-QTR-88 TO TRUE. DTSCS11 01146 DTSCS11 01147 MOVE LCCM-PICKUP-YRQ TO MQTR-YRQ. DTSCS11 01148 DTSCS11 01149 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSCS11 01150 DTSCS11 01151 PERFORM S810-READ THRU S810-EXIT. DTSCS11 01152 DTSCS11 01153 IF L810-NO-REC-88 DTSCS11 01154 GO TO P6914-EXIT. DTSCS11 01155 DTSCS11 01156 DTSCS11 01157 MOVE MSKL-REC TO MQTR-REC. DTSCS11 01158 DTSCS11 01159 DTSCS11 01160 PERFORM DTSCS11 01161 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSCS11 01162 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSCS11 01163 IF MQTR-BALANCE-AMT (MQTR-ACCT-IDX) > +0.00 DTSCS11 01164 MOVE 'Y' TO MAP-PKUP-DUE DTSCS11 01165 END-IF DTSCS11 01166 END-PERFORM. DTSCS11 01167 P6914-EXIT. DTSCS11 01168 EXIT. DTSCS11 01169 /*****************************************************************DTSCS11 01170 * LINKS TO UTILITY MODULES DTSCS11 01171 ******************************************************************DTSCS11 01172 DTSCS11 01173 S001-EDIT-DATE. DTSCS11 01174 EXEC CICS LINK DTSCS11 01175 PROGRAM ('DTSCU001') DTSCS11 01176 COMMAREA (L001-COMM-AREA) DTSCS11 01177 END-EXEC. DTSCS11 01178 S001-EXIT. EXIT. DTSCS11 01179 SKIP3 DTSCS11 01180 S004-EDIT-QTR. DTSCS11 01181 EXEC CICS LINK DTSCS11 01182 PROGRAM ('DTSCU004') DTSCS11 01183 COMMAREA (L004-COMM-AREA) DTSCS11 01184 END-EXEC. DTSCS11 01185 S004-EXIT. EXIT. DTSCS11 01186 SKIP3 DTSCS11 01187 S018-SCREEN-EMPNO. DTSCS11 01188 EXEC CICS LINK DTSCS11 01189 PROGRAM ('DTSCU018') DTSCS11 01190 COMMAREA (L018-COMM-AREA) DTSCS11 01191 END-EXEC. DTSCS11 01192 S018-EXIT. EXIT. DTSCS11 01193 SKIP3 DTSCS11 01194 S031-DESC-REG. DTSCS11 01195 EXEC CICS LINK DTSCS11 01196 PROGRAM ('DTSCU031') DTSCS11 01197 COMMAREA (L031-COMM-AREA) DTSCS11 01198 END-EXEC. DTSCS11 01199 S031-EXIT. EXIT. DTSCS11 01200 SKIP3 DTSCS11 01201 S056-DISP-RATE. DTSCS11 01202 EXEC CICS LINK DTSCS11 01203 PROGRAM ('DTSCU056') DTSCS11 01204 COMMAREA (L056-COMM-AREA) DTSCS11 01205 END-EXEC. DTSCS11 01206 S056-EXIT. EXIT. DTSCS11 01207 SKIP3 DTSCS11 01208 S061-FLD-ZIP. DTSCS11 01209 EXEC CICS LINK DTSCS11 01210 PROGRAM ('DTSCU061') DTSCS11 01211 COMMAREA (L061-COMM-AREA) DTSCS11 01212 END-EXEC. DTSCS11 01213 S061-EXIT. EXIT. DTSCS11 01214 SKIP3 DTSCS11 01215 S062-DESC-FLD. DTSCS11 01216 EXEC CICS LINK DTSCS11 01217 PROGRAM ('DTSCU062') DTSCS11 01218 COMMAREA (L062-COMM-AREA) DTSCS11 01219 END-EXEC. DTSCS11 01220 S062-EXIT. EXIT. DTSCS11 01221 SKIP3 DTSCS11 01222 S410-FILING-SCHEDULE. DTSCS11 01223 DTSCS11 01224 SET L410-MODE-MOST-RECENT-88 TO TRUE. DTSCS11 01225 MOVE MPRF-EMP-NO TO L410-EMP-NO. DTSCS11 01226 DTSCS11 01227 EXEC CICS LINK DTSCS11 01228 PROGRAM ('DTSCU410') DTSCS11 01229 COMMAREA (L410-COMM-AREA) DTSCS11 01230 END-EXEC. DTSCS11 01231 DTSCS11 01232 S410-EXIT. EXIT. DTSCS11 01233 SKIP3 DTSCS11 01234 S803-REQ-SCR-ID-EDIT. DTSCS11 01235 EXEC CICS LINK DTSCS11 01236 PROGRAM ('DTSCU803') DTSCS11 01237 COMMAREA (DFHCOMMAREA) DTSCS11 01238 END-EXEC. DTSCS11 01239 S803-EXIT. EXIT. DTSCS11 01240 SKIP3 DTSCS11 01241 S804-INVALID-KEY. DTSCS11 01242 EXEC CICS LINK DTSCS11 01243 PROGRAM ('DTSCU804') DTSCS11 01244 COMMAREA (DFHCOMMAREA) DTSCS11 01245 END-EXEC. DTSCS11 01246 S804-EXIT. EXIT. DTSCS11 01247 SKIP3 DTSCS11 01248 S805-MSG-AREA. DTSCS11 01249 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS11 01250 DTSCS11 01251 EXEC CICS LINK DTSCS11 01252 PROGRAM ('DTSCU805') DTSCS11 01253 COMMAREA (L805-COMM-AREA) DTSCS11 01254 END-EXEC. DTSCS11 01255 DTSCS11 01256 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS11 01257 S805-EXIT. EXIT. DTSCS11 01258 EJECT DTSCS11 01259 S810-READ. DTSCS11 01260 SET L810-READ-88 TO TRUE. DTSCS11 01261 GO TO S810-IO. DTSCS11 01262 DTSCS11 01263 S810-START-BROWSE. DTSCS11 01264 SET L810-START-BROWSE-88 TO TRUE. DTSCS11 01265 GO TO S810-IO. DTSCS11 01266 DTSCS11 01267 S810-READ-NEXT. DTSCS11 01268 SET L810-READ-NEXT-88 TO TRUE. DTSCS11 01269 GO TO S810-IO. DTSCS11 01270 DTSCS11 01271 S810-READ-PREV. DTSCS11 01272 SET L810-READ-PREV-88 TO TRUE. DTSCS11 01273 GO TO S810-IO. DTSCS11 01274 DTSCS11 01275 S810-END-BROWSE. DTSCS11 01276 SET L810-END-BROWSE-88 TO TRUE. DTSCS11 01277 GO TO S810-IO. DTSCS11 01278 DTSCS11 01279 S810-COUNT. DTSCS11 01280 SET L810-COUNT-88 TO TRUE. DTSCS11 01281 GO TO S810-IO. DTSCS11 01282 DTSCS11 01283 S810-IO. DTSCS11 01284 DTSCS11 01285 EXEC CICS LINK DTSCS11 01286 PROGRAM ('DTSCU810') DTSCS11 01287 COMMAREA (L810-COMM-AREA) DTSCS11 01288 END-EXEC. DTSCS11 01289 DTSCS11 01290 IF L810-FILE-CLOSED-88 DTSCS11 01291 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS11 01292 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS11 01293 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS11 01294 GO TO MAINLINE-EXIT. DTSCS11 01295 S810-EXIT. EXIT. DTSCS11 01296 EJECT DTSCS11 01297 S821-START-BROWSE. DTSCS11 01298 SET L821-START-BROWSE-88 TO TRUE. DTSCS11 01299 GO TO S821-I. DTSCS11 01300 DTSCS11 01301 S821-READ-NEXT. DTSCS11 01302 SET L821-READ-NEXT-88 TO TRUE. DTSCS11 01303 GO TO S821-I. DTSCS11 01304 DTSCS11 01305 S821-END-BROWSE. DTSCS11 01306 SET L821-END-BROWSE-88 TO TRUE. DTSCS11 01307 GO TO S821-I. DTSCS11 01308 DTSCS11 01309 S821-I. DTSCS11 01310 DTSCS11 01311 EXEC CICS LINK DTSCS11 01312 PROGRAM ('DTSCU821') DTSCS11 01313 COMMAREA (L821-COMM-AREA) DTSCS11 01314 END-EXEC. DTSCS11 01315 DTSCS11 01316 IF L821-FILE-CLOSED-88 DTSCS11 01317 MOVE L821-MSG-AREA TO LCCM-MSG-AREA DTSCS11 01318 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS11 01319 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS11 01320 GO TO MAINLINE-EXIT. DTSCS11 01321 S821-EXIT. EXIT. DTSCS11 01322 EJECT DTSCS11 01323 S851-SCREEN-PROCESSING. DTSCS11 01324 EXEC CICS LINK DTSCS11 01325 PROGRAM ('DTSCU851') DTSCS11 01326 COMMAREA (L851-COMM-AREA) DTSCS11 01327 END-EXEC. DTSCS11 01328 S851-EXIT. EXIT. DTSCS11 01329 SKIP3 DTSCS11 01330 S899-ABEND. DTSCS11 01331 EXEC CICS ABEND DTSCS11 01332 ABCODE(WRK-ABEND-CD) DTSCS11 01333 END-EXEC. DTSCS11 01334 *S899-EXIT. EXIT. DTSCS11 01335 /*****************************************************************DTSCS11 01336 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS11 01337 ******************************************************************DTSCS11 01338 DTSCS11 01339 S1100-EMP-NO. DTSCS11 01340 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS11 01341 PERFORM S018-SCREEN-EMPNO THRU S018-EXIT. DTSCS11 01342 DTSCS11 01343 IF L018-NO-ENTRY DTSCS11 01344 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS11 01345 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS11 01346 ELSE DTSCS11 01347 IF L018-NOT-VALID DTSCS11 01348 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS11 01349 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS11 01350 ELSE DTSCS11 01351 MOVE L018-EMP-NO TO WRK-EMP-NO. DTSCS11 01352 S1100-EXIT. EXIT. DTSCS11 01353 SKIP3 DTSCS11 01354 S1101-ERROR. DTSCS11 01355 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS11 01356 MAP-EMP-NO-2-A. DTSCS11 01357 IF LCCM-NO-MSG DTSCS11 01358 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS11 01359 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS11 01360 S1101-EXIT. EXIT. DTSCS11 01361 /*****************************************************************DTSCS11 01362 * DTSCS11 01363 ******************************************************************DTSCS11 01364 S5000-SET-INQ-ATTRB. DTSCS11 01365 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS11 01366 MAP-EMP-NO-2-A. DTSCS11 01367 DTSCS11 01368 MOVE CATB-ASKIP-BRT-MDTON TO MAP-ENTITY-NAME-A DTSCS11 01369 MAP-CLASS-A DTSCS11 01370 MAP-STATUS-A DTSCS11 01371 MAP-1-ATTN-LINE-A DTSCS11 01372 MAP-LIAB-A DTSCS11 01373 MAP-LIAB-QTR-A DTSCS11 01374 MAP-1-DELIV-LINE-1-A DTSCS11 01375 MAP-LIAB-ESTB-A DTSCS11 01376 MAP-1-DELIV-LINE-2-A DTSCS11 01377 MAP-LIAB-ENTRY-A DTSCS11 01378 MAP-1-CITY-A DTSCS11 01379 MAP-1-ST-A DTSCS11 01380 MAP-1-ZIP-A DTSCS11 01381 MAP-LIAB-CD-A DTSCS11 01382 MAP-LAST-AUDIT-A DTSCS11 01383 MAP-2-ATTN-LINE-A DTSCS11 01384 MAP-INAC-A DTSCS11 01385 MAP-INAC-QTR-A DTSCS11 01386 MAP-2-DELIV-LINE-1-A DTSCS11 01387 MAP-INAC-ENTRY-A DTSCS11 01388 MAP-2-DELIV-LINE-2-A DTSCS11 01389 MAP-INAC-CD-A DTSCS11 01390 MAP-2-CITY-A DTSCS11 01391 MAP-2-ST-A DTSCS11 01392 MAP-2-ZIP-A DTSCS11 01393 MAP-ORG-TYPE-A DTSCS11 01394 MAP-SPANS-A DTSCS11 01395 MAP-COL-A DTSCS11 01396 MAP-OPEN-APL-A DTSCS11 01397 MAP-FLD-REP-A DTSCS11 01398 MAP-CREDIT-A DTSCS11 01399 MAP-OPEN-LIEN-A DTSCS11 01400 MAP-1-EFF-A DTSCS11 01401 MAP-1-UIRTE-A DTSCS11 01402 MAP-PRED-EMP-NO-1-A DTSCS11 01403 MAP-PRED-EMP-NO-2-A DTSCS11 01404 MAP-PRED-A DTSCS11 01405 MAP-WRITE-OFF-A DTSCS11 01406 MAP-OPEN-FLD-A DTSCS11 01407 MAP-2-EFF-A DTSCS11 01408 MAP-2-UIRTE-A DTSCS11 01409 MAP-SUC-EMP-NO-1-A DTSCS11 01410 MAP-SUC-EMP-NO-2-A DTSCS11 01411 MAP-SUC-A DTSCS11 01412 MAP-OPEN-BNK-A DTSCS11 01413 MAP-NOTES-A DTSCS11 01414 MAP-3-EFF-A DTSCS11 01415 MAP-3-UIRTE-A DTSCS11 01416 MAP-FEIN-1-A DTSCS11 01417 MAP-FEIN-2-A DTSCS11 01418 MAP-OPEN-DPC-A DTSCS11 01419 MAP-ALT-ADDR-A DTSCS11 01420 MAP-4-EFF-A DTSCS11 01421 MAP-4-UIRTE-A DTSCS11 01422 MAP-BTN-A DTSCS11 01423 MAP-PKUP-DUE-A DTSCS11 01424 MAP-OPO-A DTSCS11 01425 MAP-5-EFF-A DTSCS11 01426 MAP-5-UIRTE-A DTSCS11 01427 MAP-PURGE-A. DTSCS11 01428 DTSCS11 01429 MOVE CATB-ASKIP-NORM-MDTOFF TO MAP-FILER-A. DTSCS11 01430 MOVE CATB-ASKIP-BRT-MDTON TO MAP-PRIMARY-NAME-A. DTSCS11 01431 DTSCS11 01432 MOVE CATB-ASKIP-NORM-MDTON TO MAP-LIAB-DESC-A DTSCS11 01433 MAP-ORG-TYPE-DESC-A DTSCS11 01434 MAP-INAC-DESC-A DTSCS11 01435 MAP-FLD-REP-NAME-A. DTSCS11 01436 DTSCS11 01437 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS11 01438 S5000-EXIT. EXIT. DTSCS11 01439 /*****************************************************************DTSCS11 01440 * *DTSCS11 01441 ******************************************************************DTSCS11 01442 S8000-RETURN-DISP-COUNT. DTSCS11 01443 PERFORM S810-COUNT THRU S810-EXIT. DTSCS11 01444 MOVE L810-RECORD-CNT TO WRK-LEFT-IN. DTSCS11 01445 PERFORM S8100-LEFT-JUSTIFY THRU S8100-EXIT. DTSCS11 01446 S8000-EXIT. EXIT. DTSCS11 01447 SKIP3 DTSCS11 01448 S8100-LEFT-JUSTIFY. DTSCS11 01449 IF NOT-TAKE-THREE DTSCS11 01450 IF NOT-TAKE-TWO DTSCS11 01451 IF NOT-TAKE-ONE DTSCS11 01452 MOVE LOW-VALUE TO WRK-LEFT-OUT DTSCS11 01453 ELSE DTSCS11 01454 MOVE ONE-DIGIT TO WRK-LEFT-OUT DTSCS11 01455 ELSE DTSCS11 01456 MOVE TWO-DIGITS TO WRK-LEFT-OUT DTSCS11 01457 ELSE DTSCS11 01458 MOVE THREE-DIGITS TO WRK-LEFT-OUT. DTSCS11 01459 S8100-EXIT. EXIT. DTSCS11 01460 /*****************************************************************DTSCS11 01461 * MAP ROUTINES *DTSCS11 01462 ******************************************************************DTSCS11 01463 S9100-RECEIVE. DTSCS11 01464 DTSCS11 01465 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS11 01466 DTSCS11 01467 SET L851-RECEIVE-88 TO TRUE. DTSCS11 01468 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS11 01469 DTSCS11 01470 MOVE L851-AID TO LCCM-AID. DTSCS11 01471 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS11 01472 S9100-EXIT. EXIT. DTSCS11 01473 SKIP3 DTSCS11 01474 ******************************************************************DTSCS11 01475 * *DTSCS11 01476 ******************************************************************DTSCS11 01477 S9200-SEND-DATAONLY. DTSCS11 01478 MOVE LOW-VALUES TO MAP-AREA. DTSCS11 01479 DTSCS11 01480 IF LCCM-MSG DTSCS11 01481 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS11 01482 DTSCS11 01483 IF CURSOR-SET-GOTO DTSCS11 01484 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS11 01485 ELSE DTSCS11 01486 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS11 01487 DTSCS11 01488 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS11 01489 DTSCS11 01490 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS11 01491 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS11 01492 S9200-EXIT. EXIT. DTSCS11 01493 SKIP3 DTSCS11 01494 ******************************************************************DTSCS11 01495 * *DTSCS11 01496 ******************************************************************DTSCS11 01497 S9300-SEND-MAP. DTSCS11 01498 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS11 01499 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS11 01500 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS11 01501 DTSCS11 01502 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS11 01503 DTSCS11 01504 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS11 01505 DTSCS11 01506 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS11 01507 DTSCS11 01508 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS11 01509 DTSCS11 01510 SET L851-SEND-88 TO TRUE. DTSCS11 01511 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS11 01512 S9300-EXIT. EXIT. DTSCS11 01513 SKIP3 DTSCS11 01514 S9320-INQUIRY-FKEYS. DTSCS11 01515 MOVE 'F19=PRED' TO MAP-KEY-PRED. DTSCS11 01516 MOVE 'F20=SUC' TO MAP-KEY-SUC. DTSCS11 01517 S9320-EXIT. EXIT. DTSCS11 01518 SKIP3 DTSCS11 01519 S9900-PREPARE-SEND. DTSCS11 01520 MOVE WRK-SCR-ID TO LCCM-SCR-ID DTSCS11 01521 L851-SCR-ID. DTSCS11 01522 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS11 01523 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS11 01524 S9900-EXIT. EXIT. DTSCS11