00001 IDENTIFICATION DIVISION. 01/23/01 00002 PROGRAM-ID. DTSCS12. DTSCS12 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV061 00004 DATE-WRITTEN. OCTOBER 1998. DTSCS12 00005 DATE-COMPILED. DTSCS12 00006 SKIP3 DTSCS12 00007 ***** DTSCS12 00008 * DTSCS12 00009 * FUNCTION: REGISTRATION SEARCHES DTSCS12 00010 * SCREEN PROCESSOR. DTSCS12 00011 * DTSCS12 00012 * DTSCS12 00013 * MODIFICATION LOG: DTSCS12 00014 * DTSCS12 00015 * 10/20/1998 INITIAL DEVELOPMENT. MODIFIED FROM MACCS12. DTSCS12 00016 * WORK ORDER: PROGRAMMER: GD DTSCS12 00017 * DTSCS12 00018 * XX/XX/XXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS12 00019 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS12 00020 * WORK ORDER: PROGRAMMER: XXX DTSCS12 00021 * DTSCS12 00022 * DTSCS12 00023 * DESCRIPTION: DTSCS12 00024 * DTSCS12 00025 * DTSCS12 00026 * CLEAR: DTSCS12 00027 * DTSCS12 00028 * FIELD DISPLAYED :NONE. UPROTECT MAP-EMP-NAME, DTSCS12 00029 * MAP-OPO-NAME, MAP-OPO-SSN, AND MAP-FEIN, MAP-BTN. DTSCS12 00030 * DTSCS12 00031 * JUMP: DTSCS12 00032 * DTSCS12 00033 * DTSCS12 00034 * INQUIRY: DTSCS12 00035 * DTSCS12 00036 * CONTROL FIELD(S): MAP-EMP-NAME, MAP-OPO-NAME, DTSCS12 00037 * MAP-OPO-SSN, MAP-FEIN AND MAP-BTN DTSCS12 00038 * (MUTUALLY EXCLUSIVE). DTSCS12 00039 * DTSCS12 00040 * JUMP IN: IF LCCM-EMP-NO = LCCM-SCR12-HOLD-AREA EMP-NO DTSCS12 00041 * START A SEARCH AT THE AIX INDEX RECORD WHOSE DTSCS12 00042 * KEY IS IN LCCM-SCR12-HOLD-AREA DTSCS12 00043 * ELSE DTSCS12 00044 * CLEAR. DTSCS12 00045 * DTSCS12 00046 * ENTER: REDISPLAY SAME STUFF. DTSCS12 00047 * DTSCS12 00048 * F07, F08: DO NOT BOTHER TO 'WRAP' PAGING. SEE SCREEN DTSCS12 00049 * DESCRIPTION FOR 'BREAK' POINTS. DTSCS12 00050 * DTSCS12 00051 * JUMP OUT: IF A LINE NO IS BEING SELECTED: DTSCS12 00052 * UPDATE LCCM-EMP-NO DTSCS12 00053 * STORE AIX RECORD REPRESENTING LINE NO DTSCS12 00054 * SELECTED IN LCCM-SCR12-HOLD-AREA DTSCS12 00055 * IF (EMPLOYER NAME SEARCH IS IN PROGRESS) DTSCS12 00056 * AND DTSCS12 00057 * (BENEFIT ALTERNATE NAME SELECTED) DTSCS12 00058 * AND DTSCS12 00059 * (JUMP TO SCREEN '79' REQUESTED) DTSCS12 00060 * CONSTRUCT LCCM-SCR79-HOLD-AREA DTSCS12 00061 * ELSE DTSCS12 00062 * IF (EMPLOYER NAME SEARCH IS IN PROGRESS) DTSCS12 00063 * AND DTSCS12 00064 * (TAX ALTERNATE NAME SELECTED) DTSCS12 00065 * AND DTSCS12 00066 * (JUMP TO SCREEN '16' REQUESTED) DTSCS12 00067 * CONSTRUCT LCCM-SCR16-HOLD-AREA DTSCS12 00068 * ELSE DTSCS12 00069 * IF (OPO-NAME SEARCH IS IN PROGRESS) DTSCS12 00070 * AND DTSCS12 00071 * (JUMP TO SCREEN '15' REQUESTED) DTSCS12 00072 * CONSTRUCT LCCM-SCR15-HOLD-AREA DTSCS12 00073 * ELSE DTSCS12 00074 * IF (OPO-SSN SEARCH IS IN PROGRESS) DTSCS12 00075 * AND DTSCS12 00076 * (JUMP TO SCREEN '15' REQUESTED) DTSCS12 00077 * CONSTRUCT LCCM-SCR15-HOLD-AREA. DTSCS12 00078 * DTSCS12 00079 * PROTECT THE FOUR 'CONTROL' FIELDS DURING A SEARCH - DTSCS12 00080 * LEAVING THE USER SPECIFIED SEARCH CRITERIA DISPLAYED. DTSCS12 00081 * THE USER MUST PRESS THE CLEAR KEY BEFORE RESTARTING DTSCS12 00082 * A SEARCH. DTSCS12 00083 * DTSCS12 00084 * DURING A DISPLAY OF THE RESULTS OF THE SEARCH, USE DTSCS12 00085 * LCCM-SCR-HOLD-AREA TO HOLD THE FROM 1 TO 12 AIX DTSCS12 00086 * RECORDS FROM WHICH THE 1 TO 12 LINES OF THE DISPLAY DTSCS12 00087 * WERE CONSTRUCTED. WHEN THE USER SELECTS A 'LINE NO', DTSCS12 00088 * THE INFORMATION STORED IN LCCM-SCR-HOLD-AREA IS USED DTSCS12 00089 * TO DETERMINE WHICH EMPLOYER WAS SELECTED. DTSCS12 00090 * DTSCS12 00091 * DURING A DISPLAY OF THE RESULTS OF THE SEARCH, USE DTSCS12 00092 * THE INFORMATION STORED IN LCCM-SCR-HOLD-AREA TO DTSCS12 00093 * CONTROL PAGING. DTSCS12 00094 * DTSCS12 00095 * DTSCS12 00096 * UPDATE: DTSCS12 00097 * DTSCS12 00098 * NONE. DTSCS12 00099 * DTSCS12 00100 * DTSCS12 00101 * RECORDS READ: DTSCS12 00102 * DTSCS12 00103 * MASTER: DTSCS12 00104 * DTSCS12 00105 * MPRF DTSCS12 00106 * MTAD DTSCS12 00107 * MOPO DTSCS12 00108 * MBAA DTSCS12 00109 * MTAA DTSCS12 00110 * DTSCS12 00111 * DTSCS12 00112 * ALTERNATE INDEX: DTSCS12 00113 * DTSCS12 00114 * IBTB DTSCS12 00115 * IOPN DTSCS12 00116 * IOPS DTSCS12 00117 * IEIN DTSCS12 00118 * IBTN DTSCS12 00119 * DTSCS12 00120 * DTSCS12 00121 * REFERENCE: DTSCS12 00122 * DTSCS12 00123 * NONE. DTSCS12 00124 * DTSCS12 00125 * DTSCS12 00126 * ACCOUNTING TRANSACTION COLLECTION: DTSCS12 00127 * DTSCS12 00128 * NONE. DTSCS12 00129 * DTSCS12 00130 * DTSCS12 00131 * RECORDS UPDATED: DTSCS12 00132 * DTSCS12 00133 * MASTER: DTSCS12 00134 * DTSCS12 00135 * NONE. DTSCS12 00136 * DTSCS12 00137 * DTSCS12 00138 * REFERENCE: DTSCS12 00139 * DTSCS12 00140 * NONE. DTSCS12 00141 * DTSCS12 00142 * DTSCS12 00143 * ACCOUNTING TRANSACTION COLLECTION: DTSCS12 00144 * DTSCS12 00145 * NONE. DTSCS12 00146 * DTSCS12 00147 * DTSCS12 00148 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCS12 00149 * DTSCS12 00150 * NONE. DTSCS12 00151 * DTSCS12 00152 * DTSCS12 00153 * TEMPORARY STORAGE USAGE: DTSCS12 00154 * DTSCS12 00155 * NONE. DTSCS12 00156 * DTSCS12 00157 * DTSCS12 00158 * MODULES LINKED TO: DTSCS12 00159 * DTSCS12 00160 * DTSCU001 DATE EDIT/CONVERSION. DTSCS12 00161 * DTSCU013 COUNT (INTEGER) FROM SCREEN FORMAT/EDIT. DTSCS12 00162 * DTSCU017 FEIN FROM SCREEN FORMAT/EDIT. DTSCS12 00163 * DTSCU020 SOCIAL SECURITY NUMBER FROM SCREEN FORMAT/EDIT. DTSCS12 00164 * DTSCU810 MASTER FILE INPUT/OUTPUT. DTSCS12 00165 * DTSCU821 ALTERNATE INDEX FILE INPUT/OUTPUT. DTSCS12 00166 * DTSCS12 00167 ***** DTSCS12 00168 DTSCS12 00169 ENVIRONMENT DIVISION. DTSCS12 00170 DTSCS12 00171 DATA DIVISION. DTSCS12 00172 DTSCS12 00173 WORKING-STORAGE SECTION. DTSCS12 001735 77 PAN-VALET PICTURE X(24) VALUE '061DTSCS12 01/23/01'. DTSCS12 00174 DTSCS12 00175 ************************************************************ DTSCS12 00176 * THE TABLE BELOW CONTAINS DATA FROM THE LCCM-SCR-HOLD-AREA DTSCS12 00177 ************************************************************ DTSCS12 00178 01 WRK-SCR-HOLD-AREA. DTSCS12 00179 05 WRK-SCR-HOLD-PROG-NAME PIC X(07). DTSCS12 00180 05 WRK-SCR-HOLD-KEY-CTR PIC S9(04) COMP. DTSCS12 00181 05 WRK-SCR-HOLD-KEY-AREA PIC X(768). DTSCS12 00182 05 FILLER REDEFINES WRK-SCR-HOLD-KEY-AREA. DTSCS12 00183 10 WRK-SCR-HOLD-KEY OCCURS 12 TIMES. DTSCS12 00184 15 WRK-SCR-HOLD-REC-TYPE PIC S9(04) COMP. DTSCS12 00185 15 FILLER PIC X(62). DTSCS12 00186 DTSCS12 00187 ************************************************************ DTSCS12 00188 * THE PROGRAM STORES AIX KEYS AND FORMARTED MAP LINES IN THE DTSCS12 00189 * TABLE BELOW DURING PAGE BACK OPERATIONS. BUILDING A TABLE DTSCS12 00190 * BY READING BACKWARDS ORDERS THE LINES IN REVERSE ORDER DTSCS12 00191 * (HIGHEST KEY TO LOWEST). TO BUILD THE SCREEN HOLD AREA DTSCS12 00192 * AND THE MAP, THE PROGRAM READS THE TABLE ENTRIES IN DTSCS12 00193 * REVERSE ORDER. DTSCS12 00194 ************************************************************ DTSCS12 00195 01 WRK-PAGE-BACK-AREA. DTSCS12 00196 05 WRK-PAGE-BACK-CTR PIC S9(04) COMP. DTSCS12 00197 05 WRK-PAGE-BACK-DATA-AREA PIC X(1716). DTSCS12 00198 05 FILLER REDEFINES WRK-PAGE-BACK-DATA-AREA. DTSCS12 00199 10 WRK-PAGE-BACK-ENTRY OCCURS 12 TIMES. DTSCS12 00200 15 WRK-PAGE-BACK-KEY PIC X(64). DTSCS12 00201 15 WRK-PAGE-BACK-LINE PIC X(79). DTSCS12 00202 15 FILLER REDEFINES WRK-PAGE-BACK-LINE. DTSCS12 00203 20 WRK-PAGE-BACK-LINE-NO PIC X(02). DTSCS12 00204 20 FILLER PIC X(77). DTSCS12 00205 DTSCS12 00206 01 WRK-AREA. DTSCS12 00207 05 WRK-ABEND-CD PIC X(04) VALUE 'S12 '. DTSCS12 00208 DTSCS12 00209 05 WRK-MOD-NAME PIC X(07) VALUE 'DTSCS12'. DTSCS12 00210 DTSCS12 00211 05 WRK-FATAL-ERROR-IND PIC X(01). DTSCS12 00212 88 WRK-FATAL-ERROR-YES VALUE 'Y'. DTSCS12 00213 88 WRK-FATAL-ERROR-NO VALUE 'N'. DTSCS12 00214 DTSCS12 00215 05 WRK-SCR-ID. DTSCS12 00216 10 WRK-SCR-ID-N PIC 9(02) VALUE 12. DTSCS12 00217 DTSCS12 00218 05 WRK-F03-SCR-ID PIC X(02) VALUE '10'. DTSCS12 00219 05 SCR-ACCESS-IND PIC X(01). DTSCS12 00220 88 SCR-ACCESS-INQ VALUE '1'. DTSCS12 00221 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS12 00222 DTSCS12 00223 05 CURSOR-SET-IND PIC X(01). DTSCS12 00224 88 CURSOR-SET-YES VALUE 'Y'. DTSCS12 00225 88 CURSOR-SET-NO VALUE 'N'. DTSCS12 00226 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS12 00227 DTSCS12 00228 05 REQ-IND PIC X(01). DTSCS12 00229 88 REQ-ERROR VALUE 'O'. DTSCS12 00230 88 REQ-JUMP VALUE 'J'. DTSCS12 00231 88 REQ-INQUIRE VALUE 'I'. DTSCS12 00232 88 REQ-CLEAR VALUE 'C'. DTSCS12 00233 88 REQ-EDIT VALUE 'E'. DTSCS12 00234 88 REQ-UPDATE VALUE 'U'. DTSCS12 00235 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS12 00236 DTSCS12 00237 05 RESP-IND PIC X(01). DTSCS12 00238 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS12 00239 88 RESP-SEND-MAP VALUE 'M'. DTSCS12 00240 88 RESP-JUMP VALUE 'J'. DTSCS12 00241 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS12 00242 DTSCS12 00243 05 WRK-MSG-AREA PIC X(64). DTSCS12 00244 DTSCS12 00245 05 WRK-ATB-AN PIC X(01). DTSCS12 00246 05 WRK-ATB-NUM PIC X(01). DTSCS12 00247 DTSCS12 00248 ************************************************************** DTSCS12 00249 * DATA ELEMENT BELOW USED TO DETERMINE IF REQUESTED SCREEN DTSCS12 00250 * IS VALID FOR THE AIX KEY OF THE LINE SELECTED. DTSCS12 00251 ************************************************************** DTSCS12 00252 05 WRK-VALID-SCREEN PIC X(02). DTSCS12 00253 88 VALID-BTB-PRIMARY-NAME-SCR VALUE '11'. DTSCS12 00254 88 VALID-BTB-ENTITY-NAME-SCR VALUE '11'. DTSCS12 00255 88 VALID-BTB-TAX-ALT-NAME-SCR VALUE '11' '16'. DTSCS12 00256 88 VALID-BTB-BEN-ALT-NAME-SCR VALUE '11' '79'. DTSCS12 00257 88 VALID-OPS-SCR VALUE '15' '11'. DTSCS12 00258 88 VALID-OPN-SCR VALUE '15' '11'. DTSCS12 00259 88 VALID-EIN-SCR VALUE '11'. DTSCS12 00260 88 VALID-BTN-SCR VALUE '11'. DTSCS12 00261 DTSCS12 00262 DTSCS12 00263 ************************************************************** DTSCS12 00264 * MAXIMUM NUMBER OF LINES THAT MAY BE DISPLAYED ON ONE PAGE. DTSCS12 00265 ************************************************************** DTSCS12 00266 05 MAX-LINES PIC S9(04) COMP VALUE +12. DTSCS12 00267 DTSCS12 00268 ************************************************************** DTSCS12 00269 * THE DATA ELEMENT BELOW INDICATES WHETHER AN AIX KEY FROM DTSCS12 00270 * A PREVIOUS TASK HAS BEEN FOUND. DTSCS12 00271 * WRK-AIX-TBL-KEY-FND INDICATES THAT THE LCCM-SCR-HOLD AREA DTSCS12 00272 * CONTAINS THE AIX KEYS USED TO BUILD THE PREVIOUS DISPLAY. DTSCS12 00273 * THIS IMPLIES THAT THE USER IS IN THE MIDDLE OF A SEARCH DTSCS12 00274 * AND IS PAGING THROUGH THE SCREENS. DTSCS12 00275 * WRK-JUMP-IN-KEY-FND INDICATES THAT THE LCCM-SCR12-HOLD-AREA DTSCS12 00276 * CONTAINS A KEY THAT MATCHES LCCM-EMP-NO. THIS MEANS THE USER DTSCS12 00277 * HAS SELECTED A LINE FROM SCREEN 12, JUMPED TO ANOTHER SCREEN DTSCS12 00278 * FOR A DETAILED VIEW OF THE RECORD, THEN RETURNED TO SCR 12. DTSCS12 00279 *************************************************************** DTSCS12 00280 05 WRK-KEY-FOUND-IND PIC X(01). DTSCS12 00281 88 WRK-AIX-TBL-KEY-FND VALUE '1'. DTSCS12 00282 88 WRK-JUMP-IN-KEY-FND VALUE '2'. DTSCS12 00283 88 WRK-KEY-FOUND-YES VALUE '1' '2'. DTSCS12 00284 88 WRK-KEY-FOUND-NO VALUE '0'. DTSCS12 00285 DTSCS12 00286 05 WRK-NUM-SRCH-FLDS-ENTERED PIC S9(04) COMP. DTSCS12 00287 DTSCS12 00288 05 WRK-CTR PIC S9(04) COMP. DTSCS12 00289 DTSCS12 00290 05 WRK-SUB PIC S9(04) COMP. DTSCS12 00291 05 WRK-SUB-DISP PIC Z9. DTSCS12 00292 DTSCS12 00293 05 WRK-SUB2 PIC S9(04) COMP. DTSCS12 00294 DTSCS12 00295 05 WRK-SCREEN-DATA-LINE. DTSCS12 00296 10 WRK-LINE-NO PIC X(02). DTSCS12 00297 10 FILLER PIC X(02). DTSCS12 00298 10 WRK-NAME PIC X(42). DTSCS12 00299 10 FILLER PIC X(02). DTSCS12 00300 10 WRK-CITY PIC X(12). DTSCS12 00301 10 FILLER PIC X(02). DTSCS12 00302 10 WRK-ST PIC X(02). DTSCS12 00303 10 FILLER PIC X(02). DTSCS12 00304 10 WRK-EMP-NO-1 PIC X(03). DTSCS12 00305 10 FILLER PIC X(01). DTSCS12 00306 10 WRK-EMP-NO-2 PIC X(03). DTSCS12 00307 10 FILLER PIC X(02). DTSCS12 00308 10 WRK-EMP-STATUS PIC X(01). DTSCS12 00309 10 FILLER PIC X(02). DTSCS12 00310 10 WRK-TYPE PIC X(01). DTSCS12 00311 DTSCS12 00312 ************************************************************ DTSCS12 00313 * THE FOLLOWING FIELDS CONTAIN THE STARTING AND ENDING AIX DTSCS12 00314 * KEYS FOR THE CURRENT SCREEN DISPLAY. DTSCS12 00315 * THE STARTING KEY IS BUILT INITIALLY FROM THE S1000 EDITS DTSCS12 00316 * AND REPLACED BY THE ACTUAL AIX KEY DURING INQUIRY DTSCS12 00317 * PROCESSING IN P6000. DTSCS12 00318 * THE INQUIRY PROCESS MOVES THIS KEY TO LCCM-SCR12-HOLD-AREA. DTSCS12 00319 * DTSCS12 00320 * THE ENDING KEY IS THE LAST ENTRY IN THE AIX TABLE STORED DTSCS12 00321 * IN LCCM-SCR-HOLD-AREA. IT IS USED TO SET THE STARTING DTSCS12 00322 * POINT WHEN PAGING FORWARD. DTSCS12 00323 ************************************************************ DTSCS12 00324 05 WRK-STARTING-SEARCH-KEY PIC X(64). DTSCS12 00325 05 WRK-ENDING-SEARCH-KEY PIC X(64). DTSCS12 00326 DTSCS12 00327 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSCS12 00328 05 WRK-EMP-NO-DISP PIC 9(07). DTSCS12 00329 05 FILLER REDEFINES WRK-EMP-NO-DISP. DTSCS12 00330 10 FILLER PIC X. DTSCS12 00331 10 WRK-EMP-NO-DISP-1 PIC 9(03). DTSCS12 00332 10 WRK-EMP-NO-DISP-2 PIC 9(03). DTSCS12 00333 DTSCS12 00334 05 WRK-FEIN PIC 9(09) COMP-3. DTSCS12 00335 05 WRK-FEIN-DISP PIC 9(09). DTSCS12 00336 05 FILLER REDEFINES WRK-FEIN-DISP. DTSCS12 00337 10 WRK-FEIN-DISP-1 PIC 9(02). DTSCS12 00338 10 WRK-FEIN-DISP-2 PIC 9(07). DTSCS12 00339 DTSCS12 00340 05 WRK-SSN PIC S9(09) COMP-3. DTSCS12 00341 05 WRK-SSN-DISP PIC 9(09). DTSCS12 00342 05 FILLER REDEFINES WRK-SSN-DISP. DTSCS12 00343 10 WRK-SSN-DISP-1 PIC 9(03). DTSCS12 00344 10 WRK-SSN-DISP-2 PIC 9(02). DTSCS12 00345 10 WRK-SSN-DISP-3 PIC 9(04). DTSCS12 00346 DTSCS12 00347 05 WRK-BTN PIC S9(09) COMP-3. DTSCS12 00348 05 WRK-BTN-DISP PIC 9(09). DTSCS12 00349 DTSCS12 00350 05 WRK-ID-NO PIC S9(03) COMP-3. DTSCS12 00351 DTSCS12 00352 DTSCS12 00353 05 HOLD-ISKL-KEY-AREA PIC X(64). DTSCS12 00354 DTSCS12 00355 01 MSG-LITERALS. DTSCS12 00356 05 MSG-E121-AREA. DTSCS12 00357 10 FILLER PIC X(04) VALUE 'E121'. DTSCS12 00358 10 FILLER PIC X(30) DTSCS12 00359 VALUE 'ENTER 1 SEARCH FIELD. '. DTSCS12 00360 10 FILLER PIC X(30) DTSCS12 00361 VALUE ' '. DTSCS12 00362 DTSCS12 00363 05 MSG-E122-AREA. DTSCS12 00364 10 FILLER PIC X(04) VALUE 'E122'. DTSCS12 00365 10 FILLER PIC X(30) DTSCS12 00366 VALUE 'ENTRY OF ONLY 1 SEARCH FIELD A'. DTSCS12 00367 10 FILLER PIC X(30) DTSCS12 00368 VALUE 'LLOWED '. DTSCS12 00369 DTSCS12 00370 05 MSG-E123-AREA. DTSCS12 00371 10 FILLER PIC X(04) VALUE 'E123'. DTSCS12 00372 10 MSG-EMP-NO-IN-ERR PIC 999B999. DTSCS12 00373 10 FILLER PIC X(50) VALUE DTSCS12 00374 ' ALTERNATE INDEX FILE ERROR - CONTACT DP'. DTSCS12 00375 DTSCS12 00376 05 MSG-E124-AREA. DTSCS12 00377 10 FILLER PIC X(04) VALUE 'E124'. DTSCS12 00378 10 FILLER PIC X(30) DTSCS12 00379 VALUE 'SCREEN 11 IS ONLY VALID SELECT'. DTSCS12 00380 10 FILLER PIC X(30) DTSCS12 00381 VALUE 'ION FOR THIS LINE '. DTSCS12 00382 DTSCS12 00383 05 MSG-E125-AREA. DTSCS12 00384 10 FILLER PIC X(04) VALUE 'E125'. DTSCS12 00385 10 FILLER PIC X(30) DTSCS12 00386 VALUE 'SCREENS 11 AND 79 ARE THE ONLY'. DTSCS12 00387 10 FILLER PIC X(30) DTSCS12 00388 VALUE 'VALID SELECTIONS FOR THIS LINE'. DTSCS12 00389 DTSCS12 00390 05 MSG-E126-AREA. DTSCS12 00391 10 FILLER PIC X(04) VALUE 'E126'. DTSCS12 00392 10 FILLER PIC X(30) DTSCS12 00393 VALUE 'SCREENS 11 AND 16 ARE THE ONLY'. DTSCS12 00394 10 FILLER PIC X(30) DTSCS12 00395 VALUE 'VALID SELECTIONS FOR THIS LINE'. DTSCS12 00396 DTSCS12 00397 05 MSG-E127-AREA. DTSCS12 00398 10 FILLER PIC X(04) VALUE 'E127'. DTSCS12 00399 10 FILLER PIC X(30) DTSCS12 00400 VALUE 'SCREENS 11 AND 15 ARE THE ONLY'. DTSCS12 00401 10 FILLER PIC X(30) DTSCS12 00402 VALUE 'VALID SELECTIONS FOR THIS LINE'. DTSCS12 00403 DTSCS12 00404 EJECT DTSCS12 00405 01 L001-COMM-AREA. DTSCS12 00406 ++INCLUDE DTSIL001 DTSCS12 00407 EJECT DTSCS12 00408 01 L013-COMM-AREA. DTSCS12 00409 ++INCLUDE DTSIL013 DTSCS12 00410 EJECT DTSCS12 00411 01 L017-COMM-AREA. DTSCS12 00412 ++INCLUDE DTSIL017 DTSCS12 00413 EJECT DTSCS12 00414 01 L020-COMM-AREA. DTSCS12 00415 ++INCLUDE DTSIL020 DTSCS12 00416 EJECT DTSCS12 00417 01 L027-COMM-AREA. DTSCS12 00418 ++INCLUDE DTSIL027 DTSCS12 00419 EJECT DTSCS12 00420 01 L805-COMM-AREA. DTSCS12 00421 ++INCLUDE DTSIL805 DTSCS12 00422 EJECT DTSCS12 00423 01 L810-COMM-AREA. DTSCS12 00424 05 L810-CONTROL-BLOCK. DTSCS12 00425 ++INCLUDE DTSIL810 DTSCS12 00426 EJECT DTSCS12 00427 05 MSKL-REC. DTSCS12 00428 ++INCLUDE DTSIMSKL DTSCS12 00429 EJECT DTSCS12 00430 01 MPRF-REC. DTSCS12 00431 ++INCLUDE DTSIMPRF DTSCS12 00432 EJECT DTSCS12 00433 01 MTAD-REC. DTSCS12 00434 ++INCLUDE DTSIMTAD DTSCS12 00435 EJECT DTSCS12 00436 01 MTAA-REC. DTSCS12 00437 ++INCLUDE DTSIMTAA DTSCS12 00438 EJECT DTSCS12 00439 01 MOPO-REC. DTSCS12 00440 ++INCLUDE DTSIMOPO DTSCS12 00441 EJECT DTSCS12 00442 01 MBAA-REC. DTSCS12 00443 ++INCLUDE DTSIMBAA DTSCS12 00444 EJECT DTSCS12 00445 01 L821-COMM-AREA. DTSCS12 00446 05 L821-CONTROL-BLOCK. DTSCS12 00447 ++INCLUDE DTSIL821 DTSCS12 00448 DTSCS12 00449 05 ISKL-REC. DTSCS12 00450 ++INCLUDE DTSIISKL DTSCS12 00451 05 FILLER REDEFINES ISKL-REC. DTSCS12 00452 ++INCLUDE DTSIIBTB DTSCS12 00453 05 FILLER REDEFINES ISKL-REC. DTSCS12 00454 ++INCLUDE DTSIIOPN DTSCS12 00455 05 FILLER REDEFINES ISKL-REC. DTSCS12 00456 ++INCLUDE DTSIIOPS DTSCS12 00457 05 FILLER REDEFINES ISKL-REC. DTSCS12 00458 ++INCLUDE DTSIIEIN DTSCS12 00459 05 FILLER REDEFINES ISKL-REC. DTSCS12 00460 ++INCLUDE DTSIIBTN DTSCS12 00461 EJECT DTSCS12 00462 DTSCS12 00463 01 L851-COMM-AREA. DTSCS12 00464 ++INCLUDE DTSIL851 DTSCS12 00465 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS12 00466 ++INCLUDE DTSIS12 DTSCS12 00467 EJECT DTSCS12 00468 01 CATB-LITERALS. DTSCS12 00469 ++INCLUDE DTSICATB DTSCS12 00470 DTSCS12 00471 01 CFKD-LITERALS. DTSCS12 00472 ++INCLUDE DTSICFKD DTSCS12 00473 DTSCS12 00474 01 CECD-LITERALS. DTSCS12 00475 ++INCLUDE DTSICECD DTSCS12 00476 DTSCS12 00477 01 CPCD-LITERALS. DTSCS12 00478 ++INCLUDE DTSICPCD DTSCS12 00479 EJECT DTSCS12 00480 LINKAGE SECTION. DTSCS12 00481 DTSCS12 00482 01 DFHCOMMAREA. DTSCS12 00483 ++INCLUDE DTSILCCM DTSCS12 00484 DTSCS12 00485 15 FILLER REDEFINES LCCM-SCR-HOLD-AREA. DTSCS12 00486 20 LCCM-SCR-HOLD-PROG-NAME PIC X(07). DTSCS12 00487 20 LCCM-SCR-HOLD-KEY-CTR PIC S9(04) COMP. DTSCS12 00488 20 LCCM-SCR-HOLD-KEY-AREA PIC X(768). DTSCS12 00489 20 FILLER REDEFINES LCCM-SCR-HOLD-KEY-AREA. DTSCS12 00490 25 LCCM-SCR-HOLD-KEY OCCURS 12 TIMES DTSCS12 00491 PIC X(64). DTSCS12 00492 EJECT DTSCS12 00493 ******************************************************************DTSCS12 00494 * *DTSCS12 00495 ******************************************************************DTSCS12 00496 DTSCS12 00497 PROCEDURE DIVISION. DTSCS12 00498 DTSCS12 00499 SET WRK-FATAL-ERROR-NO TO TRUE. DTSCS12 00500 SET WRK-KEY-FOUND-NO TO TRUE. DTSCS12 00501 DTSCS12 00502 MOVE +0 TO WRK-EMP-NO. DTSCS12 00503 DTSCS12 00504 MOVE +0 TO WRK-CTR DTSCS12 00505 WRK-SUB DTSCS12 00506 WRK-SUB2. DTSCS12 00507 DTSCS12 00508 MOVE LOW-VALUES TO WRK-STARTING-SEARCH-KEY DTSCS12 00509 WRK-ENDING-SEARCH-KEY. DTSCS12 00510 DTSCS12 00511 MOVE LOW-VALUES TO MAP-AREA. DTSCS12 00512 DTSCS12 00513 SET CURSOR-SET-NO TO TRUE. DTSCS12 00514 DTSCS12 00515 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N) DTSCS12 00516 TO SCR-ACCESS-IND. DTSCS12 00517 DTSCS12 00518 MOVE SPACE TO REQ-IND. DTSCS12 00519 DTSCS12 00520 MOVE SPACES TO LCCM-REQ-SCR-ID. DTSCS12 00521 DTSCS12 00522 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS12 00523 DTSCS12 00524 *----------------------------------------------------- DTSCS12 00525 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS12 00526 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS12 00527 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS12 00528 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS12 00529 * DTSCS12 00530 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS12 00531 * PROCESSED. DTSCS12 00532 * DTSCS12 00533 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS12 00534 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS12 00535 * WORK STATION OPERATOR. DTSCS12 00536 *----------------------------------------------------- DTSCS12 00537 DTSCS12 00538 MOVE SPACE TO RESP-IND. DTSCS12 00539 DTSCS12 00540 IF REQ-ERROR DTSCS12 00541 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS12 00542 ELSE DTSCS12 00543 IF REQ-JUMP DTSCS12 00544 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS12 00545 ELSE DTSCS12 00546 IF REQ-CLEAR DTSCS12 00547 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS12 00548 ELSE DTSCS12 00549 IF REQ-CURSOR-TO-GOTO DTSCS12 00550 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS12 00551 ELSE DTSCS12 00552 IF REQ-INQUIRE DTSCS12 00553 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS12 00554 ELSE DTSCS12 00555 GO TO S899-ABEND. DTSCS12 00556 DTSCS12 00557 IF WRK-FATAL-ERROR-YES DTSCS12 00558 GO TO MAINLINE-EXIT. DTSCS12 00559 *----------------------------------------------------- DTSCS12 00560 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS12 00561 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS12 00562 *----------------------------------------------------- DTSCS12 00563 DTSCS12 00564 IF RESP-SEND-MAP DTSCS12 00565 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS12 00566 SET LCCM-END-TASK-88 TO TRUE DTSCS12 00567 ELSE DTSCS12 00568 IF RESP-SEND-MSGONLY DTSCS12 00569 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS12 00570 SET LCCM-END-TASK-88 TO TRUE DTSCS12 00571 ELSE DTSCS12 00572 IF RESP-JUMP DTSCS12 00573 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS12 00574 ELSE DTSCS12 00575 IF RESP-CURSOR-TO-GOTO DTSCS12 00576 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS12 00577 SET LCCM-END-TASK-88 TO TRUE DTSCS12 00578 ELSE DTSCS12 00579 GO TO S899-ABEND. DTSCS12 00580 DTSCS12 00581 MAINLINE-EXIT. DTSCS12 00582 DTSCS12 00583 EXEC CICS DTSCS12 00584 RETURN DTSCS12 00585 END-EXEC. DTSCS12 00586 DTSCS12 00587 GOBACK. DTSCS12 00588 EJECT DTSCS12 00589 /*****************************************************************DTSCS12 00590 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS12 00591 ******************************************************************DTSCS12 00592 P1000-ANALYZE-REQUEST. DTSCS12 00593 *----------------------------------------------------- DTSCS12 00594 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS12 00595 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS12 00596 * REPLACED WITH ENTER) DTSCS12 00597 * SET LCCM-SCR-HOLD-AREA TO LOW-VALUES. THIS AREA DTSCS12 00598 * CONTAINS THE AIX KEYS FOR THE CURRENT DISPLAY. DTSCS12 00599 * THE LCCM-SCR12-HOLD-AREA CONTAINS EITHER THE DTSCS12 00600 * AIX KEY ASSOCIATED WITH LINE 1 OF THE CURRENT DISPLAY DTSCS12 00601 * OR THE KEY OF THE LINE THE USER SELECTED. DTSCS12 00602 * THE SYSTEM RETAINS THIS KEY WHEN THE USER JUMPS DTSCS12 00603 * TO ANOTHER SCREEN, AND USES IT TO RECREATE THE DTSCS12 00604 * THE DISPLAY IF THE USER RETURNS TO SCREEN 12. DTSCS12 00605 *----------------------------------------------------- DTSCS12 00606 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS12 00607 SET LCCM-ENTER-88 TO TRUE DTSCS12 00608 MOVE LOW-VALUE TO LCCM-SCR-HOLD-AREA DTSCS12 00609 IF LCCM-SCR12-HOLD-AREA = LOW-VALUES OR SPACES DTSCS12 00610 SET REQ-CLEAR TO TRUE DTSCS12 00611 GO TO P1000-EXIT DTSCS12 00612 ELSE DTSCS12 00613 PERFORM P1200-CHECK-HOLD-AREA THRU P1200-EXIT DTSCS12 00614 IF WRK-KEY-FOUND-YES DTSCS12 00615 SET REQ-INQUIRE TO TRUE DTSCS12 00616 GO TO P1000-EXIT DTSCS12 00617 ELSE DTSCS12 00618 SET REQ-CLEAR TO TRUE DTSCS12 00619 GO TO P1000-EXIT. DTSCS12 00620 DTSCS12 00621 *----------------------------------------------------- DTSCS12 00622 * MAP IS RECEIVED DTSCS12 00623 *----------------------------------------------------- DTSCS12 00624 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS12 00625 DTSCS12 00626 *----------------------------------------------------- DTSCS12 00627 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS12 00628 * WORK STATION DTSCS12 00629 *----------------------------------------------------- DTSCS12 00630 IF LCCM-CLEAR-88 DTSCS12 00631 SET REQ-CLEAR TO TRUE DTSCS12 00632 GO TO P1000-EXIT. DTSCS12 00633 DTSCS12 00634 *----------------------------------------------------- DTSCS12 00635 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS12 00636 *----------------------------------------------------- DTSCS12 00637 IF LCCM-PA2-88 DTSCS12 00638 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS12 00639 GO TO P1000-EXIT. DTSCS12 00640 DTSCS12 00641 *----------------------------------------------------- DTSCS12 00642 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS12 00643 *----------------------------------------------------- DTSCS12 00644 IF LCCM-PA-88 DTSCS12 00645 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS12 00646 SET REQ-ERROR TO TRUE DTSCS12 00647 GO TO P1000-EXIT. DTSCS12 00648 DTSCS12 00649 *----------------------------------------------------- DTSCS12 00650 * F12 PRESSED WHEN UPDATE NOT IN PROGRESS IS A DTSCS12 00651 * REQUEST TO CLEAR THE SCREEN DTSCS12 00652 *----------------------------------------------------- DTSCS12 00653 IF LCCM-F12-88 DTSCS12 00654 MOVE LOW-VALUES TO MAP-AREA DTSCS12 00655 SET REQ-CLEAR TO TRUE DTSCS12 00656 GO TO P1000-EXIT. DTSCS12 00657 DTSCS12 00658 *----------------------------------------------------- DTSCS12 00659 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS12 00660 *----------------------------------------------------- DTSCS12 00661 IF LCCM-F03-88 DTSCS12 00662 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS12 00663 SET REQ-JUMP TO TRUE DTSCS12 00664 GO TO P1000-EXIT. DTSCS12 00665 DTSCS12 00666 *----------------------------------------------------- DTSCS12 00667 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS12 00668 *----------------------------------------------------- DTSCS12 00669 IF LCCM-F04-88 DTSCS12 00670 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS12 00671 SET REQ-JUMP TO TRUE DTSCS12 00672 GO TO P1000-EXIT. DTSCS12 00673 DTSCS12 00674 *----------------------------------------------------- DTSCS12 00675 * IF CORRESPONDENCE KEY PRESSED, JUMP TO DTSCS12 00676 * CORRESPONDENCE INQUIRY/UPDATE SCREEN. DTSCS12 00677 *----------------------------------------------------- DTSCS12 00678 IF LCCM-F14-88 DTSCS12 00679 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS12 00680 SET REQ-JUMP TO TRUE DTSCS12 00681 GO TO P1000-EXIT. DTSCS12 00682 DTSCS12 00683 *----------------------------------------------------- DTSCS12 00684 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS12 00685 * REQUESTED SCREEN TYPE DTSCS12 00686 *----------------------------------------------------- DTSCS12 00687 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS12 00688 NEXT SENTENCE DTSCS12 00689 ELSE DTSCS12 00690 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS12 00691 SET REQ-JUMP TO TRUE DTSCS12 00692 GO TO P1000-EXIT. DTSCS12 00693 DTSCS12 00694 *----------------------------------------------------- DTSCS12 00695 * SET REQ-JUMP TO TRUE IF USER HAS ENTERED DTSCS12 00696 * MAP-LINE-NUMBER OR MAP-SCREEN-ID. DTSCS12 00697 *----------------------------------------------------- DTSCS12 00698 IF (MAP-SCREEN-ID = LOW-VALUES OR SPACES) DTSCS12 00699 AND (MAP-LINE-NUMBER = LOW-VALUES OR SPACES) DTSCS12 00700 NEXT SENTENCE DTSCS12 00701 ELSE DTSCS12 00702 SET REQ-JUMP TO TRUE DTSCS12 00703 GO TO P1000-EXIT. DTSCS12 00704 DTSCS12 00705 *----------------------------------------------------- DTSCS12 00706 * IF INQUIRY TYPE KEY PRESSED (ENTER, F5, F6, F7, DTSCS12 00707 * OR F8), INDICATE INQUIRY REQUEST DTSCS12 00708 *----------------------------------------------------- DTSCS12 00709 IF LCCM-F07-88 DTSCS12 00710 OR LCCM-F08-88 DTSCS12 00711 OR LCCM-ENTER-88 DTSCS12 00712 SET REQ-INQUIRE TO TRUE DTSCS12 00713 GO TO P1000-EXIT. DTSCS12 00714 DTSCS12 00715 *----------------------------------------------------- DTSCS12 00716 * ANY OTHER KEY IS INVALID DTSCS12 00717 *----------------------------------------------------- DTSCS12 00718 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS12 00719 SET REQ-ERROR TO TRUE. DTSCS12 00720 P1000-EXIT. DTSCS12 00721 EXIT. DTSCS12 00722 DTSCS12 00723 ******************************************************************DTSCS12 00724 * JUMP IN: IF LCCM-EMP-NO = LCCM-SCR12-HOLD-AREA EMP-NO DTSCS12 00725 * START A SEARCH AT THE AIX INDEX RECORD WHOSE DTSCS12 00726 * KEY IS IN LCCM-SCR12-HOLD-AREA DTSCS12 00727 * ELSE DTSCS12 00728 * CLEAR. DTSCS12 00729 * DTSCS12 00730 ******************************************************************DTSCS12 00731 DTSCS12 00732 P1200-CHECK-HOLD-AREA. DTSCS12 00733 DTSCS12 00734 MOVE LCCM-SCR12-HOLD-AREA TO ISKL-KEY-AREA. DTSCS12 00735 IF ISKL-BTB-88 DTSCS12 00736 IF IBTB-EMP-NO = LCCM-EMP-NO DTSCS12 00737 SET WRK-JUMP-IN-KEY-FND TO TRUE DTSCS12 00738 ELSE DTSCS12 00739 SET WRK-KEY-FOUND-NO TO TRUE DTSCS12 00740 ELSE DTSCS12 00741 IF ISKL-OPN-88 DTSCS12 00742 IF IOPN-EMP-NO = LCCM-EMP-NO DTSCS12 00743 SET WRK-JUMP-IN-KEY-FND TO TRUE DTSCS12 00744 ELSE DTSCS12 00745 SET WRK-KEY-FOUND-NO TO TRUE DTSCS12 00746 ELSE DTSCS12 00747 IF ISKL-OPS-88 DTSCS12 00748 IF IOPS-EMP-NO = LCCM-EMP-NO DTSCS12 00749 SET WRK-JUMP-IN-KEY-FND TO TRUE DTSCS12 00750 ELSE DTSCS12 00751 SET WRK-KEY-FOUND-NO TO TRUE DTSCS12 00752 ELSE DTSCS12 00753 IF ISKL-EIN-88 DTSCS12 00754 IF IEIN-EMP-NO = LCCM-EMP-NO DTSCS12 00755 SET WRK-JUMP-IN-KEY-FND TO TRUE DTSCS12 00756 ELSE DTSCS12 00757 SET WRK-KEY-FOUND-NO TO TRUE DTSCS12 00758 ELSE DTSCS12 00759 IF ISKL-BTN-88 DTSCS12 00760 IF IBTN-EMP-NO = LCCM-EMP-NO DTSCS12 00761 SET WRK-JUMP-IN-KEY-FND TO TRUE DTSCS12 00762 ELSE DTSCS12 00763 SET WRK-KEY-FOUND-NO TO TRUE DTSCS12 00764 ELSE DTSCS12 00765 SET WRK-KEY-FOUND-NO TO TRUE. DTSCS12 00766 DTSCS12 00767 IF WRK-KEY-FOUND-YES DTSCS12 00768 MOVE LCCM-SCR12-HOLD-AREA TO DTSCS12 00769 WRK-STARTING-SEARCH-KEY. DTSCS12 00770 P1200-EXIT. DTSCS12 00771 EXIT. DTSCS12 00772 /*****************************************************************DTSCS12 00773 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS12 00774 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS12 00775 ******************************************************************DTSCS12 00776 DTSCS12 00777 P2000-REQUEST-ERROR. DTSCS12 00778 IF LCCM-MSG DTSCS12 00779 SET RESP-SEND-MSGONLY TO TRUE DTSCS12 00780 ELSE DTSCS12 00781 GO TO S899-ABEND. DTSCS12 00782 P2000-EXIT. DTSCS12 00783 EXIT. DTSCS12 00784 /*****************************************************************DTSCS12 00785 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS12 00786 ******************************************************************DTSCS12 00787 DTSCS12 00788 P3000-REQUEST-JUMP. DTSCS12 00789 *----------------------------------------------------- DTSCS12 00790 * IF THERE IS A VALUE IN LCCM-REQ-SCR-ID (THE FIELD DTSCS12 00791 * IS INITIALIZED TO SPACES ON ENTRY TO THE PROGRAM) DTSCS12 00792 * THE USER HAS PRESSED F3 OR F4 OR HAS ENTERED A DTSCS12 00793 * VALUE IN MAP-GOTO. DTSCS12 00794 *----------------------------------------------------- DTSCS12 00795 IF LCCM-REQ-SCR-ID NOT = SPACES DTSCS12 00796 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT DTSCS12 00797 IF LCCM-MSG DTSCS12 00798 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT DTSCS12 00799 SET RESP-SEND-MSGONLY TO TRUE DTSCS12 00800 SET CURSOR-SET-GOTO TO TRUE DTSCS12 00801 GO TO P3000-EXIT DTSCS12 00802 ELSE DTSCS12 00803 GO TO P3000-CLEANUP. DTSCS12 00804 DTSCS12 00805 *----------------------------------------------------- DTSCS12 00806 * IF LCCM-REQ-SCR-ID = SPACES, THE USER HAS ENTERED DTSCS12 00807 * A VALUE IN THE SELECT LINE NO FIELD. DTSCS12 00808 * EDIT LCCM-SCR-HOLD-AREA FOR VALIDITY: THE AIX KEYS DTSCS12 00809 * IN THIS AREA CORRESPOND TO THE LINES DISPLAYED AND DTSCS12 00810 * ENABLE THE SYSTEM TO FIND THE DETAILED DATA FOR DTSCS12 00811 * THE LINE SELECTED. DTSCS12 00812 *----------------------------------------------------- DTSCS12 00813 PERFORM P9000-CHECK-LCCM-SCR-HOLD THRU P9000-EXIT. DTSCS12 00814 IF WRK-KEY-FOUND-NO DTSCS12 00815 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS12 00816 PERFORM P3900-MAP-LINE-ERROR THRU P3900-EXIT DTSCS12 00817 SET RESP-SEND-MAP TO TRUE DTSCS12 00818 GO TO P3000-EXIT. DTSCS12 00819 DTSCS12 00820 PERFORM P3100-SELECTION-LINE-EDIT THRU P3100-EXIT. DTSCS12 00821 IF LCCM-MSG DTSCS12 00822 SET RESP-SEND-MAP TO TRUE DTSCS12 00823 GO TO P3000-EXIT. DTSCS12 00824 DTSCS12 00825 PERFORM P3200-SELECT-SCREEN THRU P3200-EXIT. DTSCS12 00826 IF LCCM-MSG DTSCS12 00827 SET RESP-SEND-MAP TO TRUE DTSCS12 00828 GO TO P3000-EXIT. DTSCS12 00829 DTSCS12 00830 PERFORM P3300-BUILD-KEY-FOR-JUMP THRU P3300-EXIT. DTSCS12 00831 MOVE ISKL-KEY-AREA TO LCCM-SCR12-HOLD-AREA. DTSCS12 00832 DTSCS12 00833 DTSCS12 00834 P3000-CLEANUP. DTSCS12 00835 *----------------------------------------------------- DTSCS12 00836 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS12 00837 *----------------------------------------------------- DTSCS12 00838 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS12 00839 LCCM-SCR-HOLD-AREA. DTSCS12 00840 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS12 00841 SET RESP-JUMP TO TRUE. DTSCS12 00842 P3000-EXIT. DTSCS12 00843 EXIT. DTSCS12 00844 DTSCS12 00845 ******************************************************************DTSCS12 00846 * LINE NUMBER IS REQUIRED. NUMBER ENTERED CANNOT BE GREATER DTSCS12 00847 * WRK-SCR-HOLD-KEY-CTR (NUMBER OF ENTRIES IN TABLE CORRESPONDS DTSCS12 00848 * TO NUMBER OF LINES ON SCREEN). THIS PARAGRAPH RETURNS L013-CNT. DTSCS12 00849 ******************************************************************DTSCS12 00850 P3100-SELECTION-LINE-EDIT. DTSCS12 00851 MOVE +1 TO L013-MIN-CNT. DTSCS12 00852 MOVE WRK-SCR-HOLD-KEY-CTR TO L013-MAX-CNT. DTSCS12 00853 MOVE MAP-LINE-NUMBER-AREA TO L013-S-CNT-AREA. DTSCS12 00854 PERFORM S013-COUNT-FROM-SCREEN THRU S013-EXIT. DTSCS12 00855 IF L013-NO-ENTRY DTSCS12 00856 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS12 00857 PERFORM P3900-MAP-LINE-ERROR THRU P3900-EXIT DTSCS12 00858 ELSE DTSCS12 00859 IF L013-NOT-VALID DTSCS12 00860 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS12 00861 PERFORM P3900-MAP-LINE-ERROR THRU P3900-EXIT. DTSCS12 00862 P3100-EXIT. DTSCS12 00863 EXIT. DTSCS12 00864 DTSCS12 00865 P3200-SELECT-SCREEN. DTSCS12 00866 MOVE ZERO TO WRK-EMP-NO DTSCS12 00867 WRK-ID-NO. DTSCS12 00868 DTSCS12 00869 MOVE WRK-SCR-HOLD-KEY (L013-CNT) TO ISKL-KEY-AREA. DTSCS12 00870 DTSCS12 00871 IF MAP-SCREEN-ID = LOW-VALUES OR SPACES OR WRK-SCR-ID DTSCS12 00872 PERFORM P3210-DEFAULT-SCR-ID THRU P3210-EXIT DTSCS12 00873 ELSE DTSCS12 00874 MOVE MAP-SCREEN-ID TO LCCM-REQ-SCR-ID DTSCS12 00875 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT DTSCS12 00876 IF LCCM-MSG DTSCS12 00877 PERFORM P3210-DEFAULT-SCR-ID THRU P3210-EXIT. DTSCS12 00878 DTSCS12 00879 PERFORM P3220-EDIT-SCR-ID THRU P3220-EXIT. DTSCS12 00880 P3200-EXIT. DTSCS12 00881 EXIT. DTSCS12 00882 DTSCS12 00883 P3210-DEFAULT-SCR-ID. DTSCS12 00884 IF ISKL-BTB-88 DTSCS12 00885 IF IBTB-NAME-BEN-ALT-88 DTSCS12 00886 MOVE '79' TO LCCM-REQ-SCR-ID DTSCS12 00887 ELSE DTSCS12 00888 MOVE '11' TO LCCM-REQ-SCR-ID DTSCS12 00889 END-IF DTSCS12 00890 ELSE DTSCS12 00891 MOVE '11' TO LCCM-REQ-SCR-ID. DTSCS12 00892 P3210-EXIT. DTSCS12 00893 EXIT. DTSCS12 00894 DTSCS12 00895 P3220-EDIT-SCR-ID. DTSCS12 00896 MOVE LCCM-REQ-SCR-ID TO WRK-VALID-SCREEN. DTSCS12 00897 DTSCS12 00898 IF ISKL-BTB-88 DTSCS12 00899 PERFORM P3221-EDIT-BTB THRU P3221-EXIT DTSCS12 00900 ELSE DTSCS12 00901 IF ISKL-OPN-88 DTSCS12 00902 *& IF VALID-OPN-SCR DTSCS12 00903 MOVE IOPN-EMP-NO TO WRK-EMP-NO DTSCS12 00904 MOVE IOPN-ID-NO TO WRK-ID-NO DTSCS12 00905 *& ELSE DTSCS12 00906 *& MOVE MSG-E127-AREA TO WRK-MSG-AREA DTSCS12 00907 *& PERFORM P3910-SELECT-SCREEN-ERROR THRU P3910-EXIT DTSCS12 00908 *& END-IF DTSCS12 00909 ELSE DTSCS12 00910 IF ISKL-OPS-88 DTSCS12 00911 *& IF VALID-OPS-SCR DTSCS12 00912 MOVE IOPS-EMP-NO TO WRK-EMP-NO DTSCS12 00913 MOVE IOPS-ID-NO TO WRK-ID-NO DTSCS12 00914 *& ELSE DTSCS12 00915 *& MOVE MSG-E127-AREA TO WRK-MSG-AREA DTSCS12 00916 *& PERFORM P3910-SELECT-SCREEN-ERROR THRU P3910-EXIT DTSCS12 00917 *& END-IF DTSCS12 00918 ELSE DTSCS12 00919 IF ISKL-EIN-88 DTSCS12 00920 *& IF VALID-EIN-SCR DTSCS12 00921 MOVE IEIN-EMP-NO TO WRK-EMP-NO DTSCS12 00922 MOVE ZERO TO WRK-ID-NO DTSCS12 00923 *& ELSE DTSCS12 00924 *& MOVE MSG-E124-AREA TO WRK-MSG-AREA DTSCS12 00925 *& PERFORM P3910-SELECT-SCREEN-ERROR THRU P3910-EXIT DTSCS12 00926 *& END-IF DTSCS12 00927 ELSE DTSCS12 00928 IF ISKL-BTN-88 DTSCS12 00929 *& IF VALID-BTN-SCR DTSCS12 00930 MOVE IBTN-EMP-NO TO WRK-EMP-NO DTSCS12 00931 MOVE ZERO TO WRK-ID-NO DTSCS12 00932 *& ELSE DTSCS12 00933 *& MOVE MSG-E124-AREA TO WRK-MSG-AREA DTSCS12 00934 *& PERFORM P3910-SELECT-SCREEN-ERROR THRU P3910-EXIT DTSCS12 00935 *& END-IF DTSCS12 00936 ELSE DTSCS12 00937 MOVE MSG-E124-AREA TO WRK-MSG-AREA DTSCS12 00938 PERFORM P3910-SELECT-SCREEN-ERROR THRU P3910-EXIT. DTSCS12 00939 DTSCS12 00940 P3220-EXIT. DTSCS12 00941 EXIT. DTSCS12 00942 DTSCS12 00943 P3221-EDIT-BTB. DTSCS12 00944 IF IBTB-NAME-PRIMARY-88 DTSCS12 00945 *& IF VALID-BTB-PRIMARY-NAME-SCR DTSCS12 00946 MOVE IBTB-EMP-NO TO WRK-EMP-NO DTSCS12 00947 MOVE IBTB-ID-NO TO WRK-ID-NO DTSCS12 00948 *& ELSE DTSCS12 00949 *& MOVE MSG-E124-AREA TO WRK-MSG-AREA DTSCS12 00950 *& PERFORM P3910-SELECT-SCREEN-ERROR THRU P3910-EXIT DTSCS12 00951 ELSE DTSCS12 00952 IF IBTB-NAME-ENTITY-88 DTSCS12 00953 *& IF VALID-BTB-ENTITY-NAME-SCR DTSCS12 00954 MOVE IBTB-EMP-NO TO WRK-EMP-NO DTSCS12 00955 MOVE IBTB-ID-NO TO WRK-ID-NO DTSCS12 00956 *& ELSE DTSCS12 00957 *& MOVE MSG-E124-AREA TO WRK-MSG-AREA DTSCS12 00958 *& PERFORM P3910-SELECT-SCREEN-ERROR THRU P3910-EXIT DTSCS12 00959 ELSE DTSCS12 00960 IF IBTB-NAME-TAX-ALT-88 DTSCS12 00961 *& IF VALID-BTB-TAX-ALT-NAME-SCR DTSCS12 00962 MOVE IBTB-EMP-NO TO WRK-EMP-NO DTSCS12 00963 MOVE IBTB-ID-NO TO WRK-ID-NO DTSCS12 00964 *& ELSE DTSCS12 00965 *& MOVE MSG-E126-AREA TO WRK-MSG-AREA DTSCS12 00966 *& PERFORM P3910-SELECT-SCREEN-ERROR THRU P3910-EXIT DTSCS12 00967 ELSE DTSCS12 00968 IF IBTB-NAME-BEN-ALT-88 DTSCS12 00969 *& IF VALID-BTB-BEN-ALT-NAME-SCR DTSCS12 00970 MOVE IBTB-EMP-NO TO WRK-EMP-NO DTSCS12 00971 MOVE IBTB-ID-NO TO WRK-ID-NO DTSCS12 00972 *& ELSE DTSCS12 00973 *& MOVE MSG-E125-AREA TO WRK-MSG-AREA DTSCS12 00974 *& PERFORM P3910-SELECT-SCREEN-ERROR THRU P3910-EXIT DTSCS12 00975 ELSE DTSCS12 00976 *& IF VALID-BTB-PRIMARY-NAME-SCR DTSCS12 00977 MOVE IBTB-EMP-NO TO WRK-EMP-NO DTSCS12 00978 MOVE IBTB-ID-NO TO WRK-ID-NO. DTSCS12 00979 *& ELSE DTSCS12 00980 *& MOVE MSG-E124-AREA TO WRK-MSG-AREA DTSCS12 00981 *& PERFORM P3910-SELECT-SCREEN-ERROR THRU P3910-EXIT. DTSCS12 00982 P3221-EXIT. DTSCS12 00983 EXIT. DTSCS12 00984 DTSCS12 00985 P3300-BUILD-KEY-FOR-JUMP. DTSCS12 00986 IF WRK-EMP-NO NOT = ZERO DTSCS12 00987 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS12 00988 DTSCS12 00989 IF LCCM-REQ-SCR-ID = '15' DTSCS12 00990 PERFORM P3310-JUMP-TO-SCR-15 THRU P3310-EXIT DTSCS12 00991 ELSE DTSCS12 00992 IF LCCM-REQ-SCR-ID = '16' DTSCS12 00993 PERFORM P3320-JUMP-TO-SCR-16 THRU P3320-EXIT DTSCS12 00994 ELSE DTSCS12 00995 IF LCCM-REQ-SCR-ID = '79' DTSCS12 00996 PERFORM P3330-JUMP-TO-SCR-79 THRU P3330-EXIT. DTSCS12 00997 P3300-EXIT. DTSCS12 00998 EXIT. DTSCS12 00999 DTSCS12 01000 P3310-JUMP-TO-SCR-15. DTSCS12 01001 MOVE LOW-VALUES TO LCCM-SCR15-HOLD-AREA. DTSCS12 01002 DTSCS12 01003 MOVE LOW-VALUES TO MOPO-KEY-AREA. DTSCS12 01004 DTSCS12 01005 SET MOPO-OPO-88 TO TRUE. DTSCS12 01006 DTSCS12 01007 MOVE WRK-EMP-NO TO MOPO-EMP-NO. DTSCS12 01008 MOVE WRK-ID-NO TO MOPO-ID-NO. DTSCS12 01009 DTSCS12 01010 MOVE MOPO-KEY-AREA TO LCCM-SCR15-HOLD-AREA. DTSCS12 01011 DTSCS12 01012 P3310-EXIT. DTSCS12 01013 EXIT. DTSCS12 01014 DTSCS12 01015 P3320-JUMP-TO-SCR-16. DTSCS12 01016 MOVE LOW-VALUES TO LCCM-SCR16-HOLD-AREA. DTSCS12 01017 DTSCS12 01018 MOVE LOW-VALUES TO MTAA-KEY-AREA. DTSCS12 01019 DTSCS12 01020 SET MTAA-TAA-88 TO TRUE. DTSCS12 01021 DTSCS12 01022 MOVE WRK-EMP-NO TO MTAA-EMP-NO. DTSCS12 01023 MOVE WRK-ID-NO TO MTAA-ID-NO. DTSCS12 01024 DTSCS12 01025 MOVE MTAA-KEY-AREA TO LCCM-SCR16-HOLD-AREA. DTSCS12 01026 DTSCS12 01027 P3320-EXIT. DTSCS12 01028 EXIT. DTSCS12 01029 DTSCS12 01030 P3330-JUMP-TO-SCR-79. DTSCS12 01031 MOVE LOW-VALUES TO LCCM-SCR79-HOLD-AREA. DTSCS12 01032 DTSCS12 01033 MOVE LOW-VALUES TO MBAA-KEY-AREA. DTSCS12 01034 DTSCS12 01035 SET MBAA-BAA-88 TO TRUE. DTSCS12 01036 DTSCS12 01037 MOVE WRK-EMP-NO TO MBAA-EMP-NO. DTSCS12 01038 MOVE WRK-ID-NO TO MBAA-ID-NO. DTSCS12 01039 DTSCS12 01040 MOVE MBAA-KEY-AREA TO LCCM-SCR79-HOLD-AREA. DTSCS12 01041 P3330-EXIT. DTSCS12 01042 EXIT. DTSCS12 01043 DTSCS12 01044 /**************************************************************** DTSCS12 01045 * SCREEN SELECT AND LINE NUMBER ERROR ROUTINES DTSCS12 01046 ***************************************************************** DTSCS12 01047 P3900-MAP-LINE-ERROR. DTSCS12 01048 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS12 01049 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-LINE-NUMBER-A DTSCS12 01050 MAP-SCREEN-ID-A. DTSCS12 01051 SET CURSOR-SET-YES TO TRUE. DTSCS12 01052 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA. DTSCS12 01053 MOVE CATB-CURSOR TO MAP-LINE-NUMBER-L. DTSCS12 01054 P3900-EXIT. EXIT. DTSCS12 01055 DTSCS12 01056 P3910-SELECT-SCREEN-ERROR. DTSCS12 01057 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS12 01058 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-SCREEN-ID-A DTSCS12 01059 MAP-LINE-NUMBER-A. DTSCS12 01060 SET CURSOR-SET-YES TO TRUE. DTSCS12 01061 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA. DTSCS12 01062 MOVE CATB-CURSOR TO MAP-SCREEN-ID-L. DTSCS12 01063 P3910-EXIT. EXIT. DTSCS12 01064 /*****************************************************************DTSCS12 01065 * CLEAR KEY WAS PRESSED *DTSCS12 01066 ******************************************************************DTSCS12 01067 DTSCS12 01068 P4000-REQUEST-CLEAR. DTSCS12 01069 PERFORM S5200-SET-CLEAR-ATTRB THRU S5200-EXIT. DTSCS12 01070 DTSCS12 01071 *& IF WRK-TS-FOUND-YES DTSCS12 01072 *& MOVE LCCM-SCR12-HOLD-AREA TO ISKL-KEY-AREA DTSCS12 01073 *& IF ISKL-BTB-88 DTSCS12 01074 *& MOVE CATB-CURSOR TO MAP-EMP-NAME-L DTSCS12 01075 *& ELSE DTSCS12 01076 *& IF ISKL-OPN-88 DTSCS12 01077 *& MOVE CATB-CURSOR TO MAP-OPO-NAME-L DTSCS12 01078 *& ELSE DTSCS12 01079 *& IF ISKL-OPS-88 DTSCS12 01080 *& MOVE CATB-CURSOR TO MAP-SSN-1-L DTSCS12 01081 *& ELSE DTSCS12 01082 *& IF ISKL-EIN-88 DTSCS12 01083 *& MOVE CATB-CURSOR TO MAP-FEIN-1-L DTSCS12 01084 *& ELSE DTSCS12 01085 *& IF ISKL-BTN-88 DTSCS12 01086 *& MOVE CATB-CURSOR TO MAP-BTN-L DTSCS12 01087 *& ELSE DTSCS12 01088 *& MOVE CATB-CURSOR TO MAP-EMP-NAME-L. DTSCS12 01089 DTSCS12 01090 *& SET CURSOR-SET-YES TO TRUE. DTSCS12 01091 *& MOVE 'N' TO WRK-TS-FOUND-IND. DTSCS12 01092 *----------------------------------------------------- DTSCS12 01093 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS12 01094 * FIELDS FROM EARLIER REQUESTS DTSCS12 01095 *----------------------------------------------------- DTSCS12 01096 MOVE ZERO TO LCCM-EMP-NO. DTSCS12 01097 DTSCS12 01098 MOVE LOW-VALUES TO LCCM-SCR12-HOLD-AREA DTSCS12 01099 LCCM-SCR-HOLD-AREA. DTSCS12 01100 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS12 01101 DTSCS12 01102 SET LCCM-SCR-CLEAR TO TRUE. DTSCS12 01103 DTSCS12 01104 SET RESP-SEND-MAP TO TRUE. DTSCS12 01105 P4000-EXIT. DTSCS12 01106 EXIT. DTSCS12 01107 /*****************************************************************DTSCS12 01108 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS12 01109 ******************************************************************DTSCS12 01110 DTSCS12 01111 P5000-CURSOR-TO-GOTO. DTSCS12 01112 SET CURSOR-SET-GOTO TO TRUE. DTSCS12 01113 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS12 01114 P5000-EXIT. DTSCS12 01115 EXIT. DTSCS12 01116 /*****************************************************************DTSCS12 01117 * INQUIRY WAS REQUESTED *DTSCS12 01118 ******************************************************************DTSCS12 01119 DTSCS12 01120 P6000-REQUEST-INQUIRE. DTSCS12 01121 MOVE LOW-VALUES TO MAP-TABLE. DTSCS12 01122 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS12 01123 SET RESP-SEND-MAP TO TRUE. DTSCS12 01124 DTSCS12 01125 ************************************************************* DTSCS12 01126 * IF P1200 HAS NOT FOUND A STARTING KEY IN LCCM-SCR12-HOLD, DTSCS12 01127 * CHECK WHETHER THE AIX TABLE FROM A PREVIOUS TASK EXISTS DTSCS12 01128 * IN LCCM-SCR-HOLD-AREA. IF A VALID AIX TABLE EXISTS, SET DTSCS12 01129 * WRK-AIX-TBL-KEY-FND TO TRUE. DTSCS12 01130 ************************************************************ DTSCS12 01131 IF WRK-KEY-FOUND-NO DTSCS12 01132 PERFORM P9000-CHECK-LCCM-SCR-HOLD THRU P9000-EXIT. DTSCS12 01133 DTSCS12 01134 MOVE LOW-VALUE TO LCCM-SCR-HOLD-AREA DTSCS12 01135 WRK-SCR-HOLD-AREA DTSCS12 01136 WRK-PAGE-BACK-AREA DTSCS12 01137 LCCM-SCR12-HOLD-AREA. DTSCS12 01138 MOVE +0 TO WRK-SCR-HOLD-KEY-CTR. DTSCS12 01139 MOVE WRK-MOD-NAME TO WRK-SCR-HOLD-PROG-NAME. DTSCS12 01140 DTSCS12 01141 IF LCCM-SCR-CLEAR DTSCS12 01142 OR WRK-KEY-FOUND-NO DTSCS12 01143 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT DTSCS12 01144 IF LCCM-MSG DTSCS12 01145 PERFORM S5200-SET-CLEAR-ATTRB THRU S5200-EXIT DTSCS12 01146 GO TO P6000-EXIT. DTSCS12 01147 DTSCS12 01148 IF LCCM-F08-88 DTSCS12 01149 IF WRK-AIX-TBL-KEY-FND DTSCS12 01150 MOVE WRK-ENDING-SEARCH-KEY TO ISKL-KEY-AREA DTSCS12 01151 ELSE DTSCS12 01152 MOVE WRK-STARTING-SEARCH-KEY TO ISKL-KEY-AREA DTSCS12 01153 ELSE DTSCS12 01154 MOVE WRK-STARTING-SEARCH-KEY TO ISKL-KEY-AREA. DTSCS12 01155 DTSCS12 01156 ******************************************************* DTSCS12 01157 * SET WRK-FEIN, WRK-SSN, WRK-BTN. THESE FIELDS ARE DTSCS12 01158 * USED DURING THE READ TO DETERMINE WHEN TO RETURN DTSCS12 01159 * L821-NO-REC-88. DTSCS12 01160 ******************************************************* DTSCS12 01161 DTSCS12 01162 IF ISKL-OPS-88 DTSCS12 01163 MOVE IOPS-SSN TO WRK-SSN DTSCS12 01164 ELSE DTSCS12 01165 IF ISKL-EIN-88 DTSCS12 01166 MOVE IEIN-FEIN TO WRK-FEIN DTSCS12 01167 ELSE DTSCS12 01168 IF ISKL-BTN-88 DTSCS12 01169 MOVE IBTN-DC-BUSINESS-TAX-ACCT-NO TO WRK-BTN. DTSCS12 01170 DTSCS12 01171 PERFORM S821-START-BROWSE THRU S821-EXIT. DTSCS12 01172 IF L821-NO-REC-88 DTSCS12 01173 PERFORM P6001-SRCH-CRITERIA-ERR THRU P6001-EXIT DTSCS12 01174 GO TO P6000-EXIT. DTSCS12 01175 DTSCS12 01176 IF LCCM-ENTER-88 DTSCS12 01177 PERFORM P6100-NO-PAGE THRU P6100-EXIT DTSCS12 01178 ELSE DTSCS12 01179 IF LCCM-F07-88 DTSCS12 01180 PERFORM P6200-PAGE-BACK THRU P6200-EXIT DTSCS12 01181 ELSE DTSCS12 01182 IF LCCM-F08-88 DTSCS12 01183 PERFORM P6300-PAGE-NEXT THRU P6300-EXIT DTSCS12 01184 ELSE DTSCS12 01185 GO TO S899-ABEND. DTSCS12 01186 DTSCS12 01187 IF WRK-FATAL-ERROR-YES DTSCS12 01188 GO TO P6000-EXIT. DTSCS12 01189 DTSCS12 01190 IF WRK-SCR-HOLD-KEY-CTR > 0 DTSCS12 01191 MOVE WRK-SCR-HOLD-AREA TO LCCM-SCR-HOLD-AREA DTSCS12 01192 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT DTSCS12 01193 MOVE WRK-SCR-HOLD-KEY (1) TO LCCM-SCR12-HOLD-AREA DTSCS12 01194 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-SCREEN-ID-A DTSCS12 01195 MOVE CATB-UNPROT-BRT-NUM-MDTON DTSCS12 01196 TO MAP-LINE-NUMBER-A DTSCS12 01197 MOVE CATB-CURSOR TO MAP-LINE-NUMBER-L DTSCS12 01198 SET CURSOR-SET-YES TO TRUE DTSCS12 01199 ELSE DTSCS12 01200 PERFORM P6001-SRCH-CRITERIA-ERR THRU P6001-EXIT DTSCS12 01201 GO TO P6000-EXIT. DTSCS12 01202 DTSCS12 01203 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS12 01204 P6000-EXIT. DTSCS12 01205 EXIT. DTSCS12 01206 DTSCS12 01207 P6001-SRCH-CRITERIA-ERR. DTSCS12 01208 MOVE EMSG-SEARCH-CRITERIA TO LCCM-MSG-ID DTSCS12 01209 PERFORM S5200-SET-CLEAR-ATTRB THRU S5200-EXIT. DTSCS12 01210 DTSCS12 01211 IF ISKL-BTB-88 DTSCS12 01212 MOVE CATB-CURSOR TO MAP-EMP-NAME-L DTSCS12 01213 ELSE DTSCS12 01214 IF ISKL-OPN-88 DTSCS12 01215 MOVE CATB-CURSOR TO MAP-OPO-NAME-L DTSCS12 01216 ELSE DTSCS12 01217 IF ISKL-OPS-88 DTSCS12 01218 MOVE CATB-CURSOR TO MAP-SSN-1-L DTSCS12 01219 ELSE DTSCS12 01220 IF ISKL-EIN-88 DTSCS12 01221 MOVE CATB-CURSOR TO MAP-FEIN-1-L DTSCS12 01222 ELSE DTSCS12 01223 IF ISKL-BTN-88 DTSCS12 01224 MOVE CATB-CURSOR TO MAP-BTN-L DTSCS12 01225 ELSE DTSCS12 01226 MOVE CATB-CURSOR TO MAP-EMP-NAME-L. DTSCS12 01227 IF LCCM-MSG DTSCS12 01228 SET CURSOR-SET-YES TO TRUE. DTSCS12 01229 P6001-EXIT. DTSCS12 01230 EXIT. DTSCS12 01231 DTSCS12 01232 /*****************************************************************DTSCS12 01233 * ENTER KEY WAS PRESSED. THE STARTING KEY HAS BEEN SET IN *DTSCS12 01234 * P6000, AND THE FIRST RECORD RETURNED FROM A START BROWSE. *DTSCS12 01235 ******************************************************************DTSCS12 01236 P6100-NO-PAGE. DTSCS12 01237 DTSCS12 01238 PERFORM P6500-SET-SEARCH-FIELDS THRU P6500-EXIT. DTSCS12 01239 PERFORM P6700-SCAN-AIX-FWD THRU P6700-EXIT DTSCS12 01240 VARYING WRK-SUB FROM 1 BY 1 DTSCS12 01241 UNTIL WRK-SUB > MAX-LINES DTSCS12 01242 OR L821-NO-REC-88 DTSCS12 01243 OR WRK-FATAL-ERROR-YES. DTSCS12 01244 DTSCS12 01245 P6100-EXIT. DTSCS12 01246 EXIT. DTSCS12 01247 DTSCS12 01248 /*****************************************************************DTSCS12 01249 * *DTSCS12 01250 ******************************************************************DTSCS12 01251 P6200-PAGE-BACK. DTSCS12 01252 PERFORM S821-READ-PREV THRU S821-EXIT. DTSCS12 01253 IF L821-NO-REC-88 DTSCS12 01254 * MOVE WRK-STARTING-SEARCH-KEY TO ISKL-KEY-AREA DTSCS12 01255 * PERFORM S821-START-BROWSE THRU S821-EXIT DTSCS12 01256 * IF L821-NO-REC-88 DTSCS12 01257 MOVE EMSG-NO-RECORD TO LCCM-MSG-ID DTSCS12 01258 GO TO P6200-EXIT. DTSCS12 01259 * ELSE DTSCS12 01260 * MOVE PMSG-FIRST-PAGE TO LCCM-MSG-ID. DTSCS12 01261 DTSCS12 01262 PERFORM S821-READ-PREV THRU S821-EXIT. DTSCS12 01263 IF L821-NO-REC-88 DTSCS12 01264 MOVE WRK-STARTING-SEARCH-KEY TO ISKL-KEY-AREA DTSCS12 01265 PERFORM S821-START-BROWSE THRU S821-EXIT DTSCS12 01266 IF L821-NO-REC-88 DTSCS12 01267 MOVE EMSG-NO-RECORD TO LCCM-MSG-ID DTSCS12 01268 GO TO P6200-EXIT DTSCS12 01269 ELSE DTSCS12 01270 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-ID DTSCS12 01271 PERFORM P6700-SCAN-AIX-FWD THRU P6700-EXIT DTSCS12 01272 VARYING WRK-SUB FROM 1 BY 1 DTSCS12 01273 UNTIL WRK-SUB > MAX-LINES DTSCS12 01274 OR L821-NO-REC-88 DTSCS12 01275 OR WRK-FATAL-ERROR-YES DTSCS12 01276 GO TO P6200-EXIT. DTSCS12 01277 DTSCS12 01278 DTSCS12 01279 PERFORM P6800-SCAN-AIX-BACK THRU P6800-EXIT DTSCS12 01280 VARYING WRK-SUB FROM 1 BY 1 DTSCS12 01281 UNTIL WRK-SUB > MAX-LINES DTSCS12 01282 OR L821-NO-REC-88 DTSCS12 01283 OR WRK-FATAL-ERROR-YES. DTSCS12 01284 DTSCS12 01285 IF L821-NO-REC-88 DTSCS12 01286 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-ID. DTSCS12 01287 DTSCS12 01288 MOVE WRK-PAGE-BACK-CTR TO WRK-SCR-HOLD-KEY-CTR. DTSCS12 01289 MOVE ZERO TO WRK-SUB2. DTSCS12 01290 PERFORM P6210-BUILD-MAP THRU P6210-EXIT DTSCS12 01291 VARYING WRK-SUB FROM WRK-PAGE-BACK-CTR BY -1 DTSCS12 01292 UNTIL WRK-SUB < +1. DTSCS12 01293 P6200-EXIT. DTSCS12 01294 EXIT. DTSCS12 01295 DTSCS12 01296 P6210-BUILD-MAP. DTSCS12 01297 ADD +1 TO WRK-SUB2. DTSCS12 01298 MOVE WRK-PAGE-BACK-KEY (WRK-SUB) DTSCS12 01299 TO WRK-SCR-HOLD-KEY (WRK-SUB2). DTSCS12 01300 MOVE WRK-SUB2 TO WRK-SUB-DISP DTSCS12 01301 MOVE WRK-SUB-DISP TO WRK-PAGE-BACK-LINE-NO (WRK-SUB). DTSCS12 01302 MOVE WRK-PAGE-BACK-LINE (WRK-SUB) DTSCS12 01303 TO MAP-LINE-DATA (WRK-SUB2). DTSCS12 01304 P6210-EXIT. DTSCS12 01305 EXIT. DTSCS12 01306 DTSCS12 01307 /*****************************************************************DTSCS12 01308 * *DTSCS12 01309 ******************************************************************DTSCS12 01310 P6300-PAGE-NEXT. DTSCS12 01311 PERFORM S821-READ-NEXT THRU S821-EXIT. DTSCS12 01312 IF L821-NO-REC-88 DTSCS12 01313 MOVE WRK-STARTING-SEARCH-KEY TO ISKL-KEY-AREA DTSCS12 01314 PERFORM S821-START-BROWSE THRU S821-EXIT DTSCS12 01315 IF L821-NO-REC-88 DTSCS12 01316 MOVE EMSG-NO-RECORD TO LCCM-MSG-ID DTSCS12 01317 GO TO P6300-EXIT DTSCS12 01318 ELSE DTSCS12 01319 MOVE PMSG-LAST-PAGE TO LCCM-MSG-ID. DTSCS12 01320 DTSCS12 01321 PERFORM P6700-SCAN-AIX-FWD THRU P6700-EXIT DTSCS12 01322 VARYING WRK-SUB FROM 1 BY 1 DTSCS12 01323 UNTIL WRK-SUB > MAX-LINES DTSCS12 01324 OR L821-NO-REC-88 DTSCS12 01325 OR WRK-FATAL-ERROR-YES. DTSCS12 01326 DTSCS12 01327 IF L821-NO-REC-88 DTSCS12 01328 MOVE PMSG-LAST-PAGE TO LCCM-MSG-ID. DTSCS12 01329 P6300-EXIT. DTSCS12 01330 EXIT. DTSCS12 01331 DTSCS12 01332 P6500-SET-SEARCH-FIELDS. DTSCS12 01333 IF ISKL-BTB-88 DTSCS12 01334 MOVE IBTB-NAME TO MAP-EMP-NAME DTSCS12 01335 ELSE DTSCS12 01336 IF ISKL-EIN-88 DTSCS12 01337 MOVE IEIN-FEIN TO WRK-FEIN-DISP DTSCS12 01338 MOVE WRK-FEIN-DISP-1 TO MAP-FEIN-1 DTSCS12 01339 MOVE WRK-FEIN-DISP-2 TO MAP-FEIN-2 DTSCS12 01340 ELSE DTSCS12 01341 IF ISKL-OPN-88 DTSCS12 01342 MOVE IOPN-NAME TO MAP-OPO-NAME DTSCS12 01343 ELSE DTSCS12 01344 IF ISKL-OPS-88 DTSCS12 01345 MOVE IOPS-SSN TO WRK-SSN-DISP DTSCS12 01346 MOVE WRK-SSN-DISP-1 TO MAP-SSN-1 DTSCS12 01347 MOVE WRK-SSN-DISP-2 TO MAP-SSN-2 DTSCS12 01348 MOVE WRK-SSN-DISP-3 TO MAP-SSN-3 DTSCS12 01349 ELSE DTSCS12 01350 IF ISKL-BTN-88 DTSCS12 01351 MOVE IBTN-DC-BUSINESS-TAX-ACCT-NO TO WRK-BTN-DISP DTSCS12 01352 MOVE WRK-BTN-DISP TO MAP-BTN. DTSCS12 01353 P6500-EXIT. DTSCS12 01354 EXIT. DTSCS12 01355 DTSCS12 01356 P6700-SCAN-AIX-FWD. DTSCS12 01357 PERFORM P6900-FORMAT-LINE THRU P6900-EXIT. DTSCS12 01358 IF WRK-FATAL-ERROR-YES DTSCS12 01359 GO TO P6700-EXIT DTSCS12 01360 ELSE DTSCS12 01361 MOVE ISKL-KEY-AREA TO WRK-SCR-HOLD-KEY (WRK-SUB) DTSCS12 01362 MOVE WRK-SUB TO WRK-SUB-DISP DTSCS12 01363 MOVE WRK-SUB-DISP TO WRK-LINE-NO DTSCS12 01364 MOVE SPACES TO MAP-LINE-DATA (WRK-SUB) DTSCS12 01365 MOVE WRK-SCREEN-DATA-LINE TO MAP-LINE-DATA (WRK-SUB) DTSCS12 01366 MOVE WRK-SUB TO WRK-SCR-HOLD-KEY-CTR. DTSCS12 01367 DTSCS12 01368 PERFORM S821-READ-NEXT THRU S821-EXIT. DTSCS12 01369 P6700-EXIT. DTSCS12 01370 EXIT. DTSCS12 01371 P6800-SCAN-AIX-BACK. DTSCS12 01372 PERFORM P6900-FORMAT-LINE THRU P6900-EXIT. DTSCS12 01373 IF WRK-FATAL-ERROR-YES DTSCS12 01374 GO TO P6800-EXIT DTSCS12 01375 ELSE DTSCS12 01376 MOVE ISKL-KEY-AREA TO WRK-PAGE-BACK-KEY (WRK-SUB) DTSCS12 01377 MOVE SPACES TO WRK-PAGE-BACK-LINE (WRK-SUB) DTSCS12 01378 MOVE WRK-SCREEN-DATA-LINE DTSCS12 01379 TO WRK-PAGE-BACK-LINE (WRK-SUB) DTSCS12 01380 MOVE WRK-SUB TO WRK-PAGE-BACK-CTR. DTSCS12 01381 DTSCS12 01382 PERFORM S821-READ-PREV THRU S821-EXIT. DTSCS12 01383 P6800-EXIT. DTSCS12 01384 EXIT. DTSCS12 01385 /*****************************************************************DTSCS12 01386 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCS12 01387 ******************************************************************DTSCS12 01388 P6900-FORMAT-LINE. DTSCS12 01389 DTSCS12 01390 MOVE SPACES TO WRK-SCREEN-DATA-LINE. DTSCS12 01391 DTSCS12 01392 IF ISKL-BTB-88 DTSCS12 01393 MOVE IBTB-EMP-NO TO WRK-EMP-NO DTSCS12 01394 ELSE DTSCS12 01395 IF ISKL-OPN-88 DTSCS12 01396 MOVE IOPN-EMP-NO TO WRK-EMP-NO DTSCS12 01397 ELSE DTSCS12 01398 IF ISKL-OPS-88 DTSCS12 01399 MOVE IOPS-EMP-NO TO WRK-EMP-NO DTSCS12 01400 ELSE DTSCS12 01401 IF ISKL-EIN-88 DTSCS12 01402 MOVE IEIN-EMP-NO TO WRK-EMP-NO DTSCS12 01403 ELSE DTSCS12 01404 IF ISKL-BTN-88 DTSCS12 01405 MOVE IBTN-EMP-NO TO WRK-EMP-NO DTSCS12 01406 ELSE DTSCS12 01407 MOVE +0 TO WRK-EMP-NO. DTSCS12 01408 DTSCS12 01409 PERFORM P6970-READ-PRF THRU P6970-EXIT. DTSCS12 01410 IF WRK-FATAL-ERROR-YES DTSCS12 01411 GO TO P6900-EXIT. DTSCS12 01412 DTSCS12 01413 PERFORM P6980-READ-TAD THRU P6980-EXIT. DTSCS12 01414 IF WRK-FATAL-ERROR-YES DTSCS12 01415 GO TO P6900-EXIT. DTSCS12 01416 DTSCS12 01417 IF ISKL-BTB-88 DTSCS12 01418 PERFORM P6910-FORMAT-FROM-BTB THRU P6910-EXIT DTSCS12 01419 ELSE DTSCS12 01420 IF ISKL-OPN-88 DTSCS12 01421 OR ISKL-OPS-88 DTSCS12 01422 PERFORM P6920-FORMAT-FROM-OPO THRU P6920-EXIT DTSCS12 01423 ELSE DTSCS12 01424 PERFORM P6930-FORMAT-FROM-PRF-TAD THRU P6930-EXIT. DTSCS12 01425 DTSCS12 01426 IF WRK-FATAL-ERROR-YES DTSCS12 01427 GO TO P6900-EXIT. DTSCS12 01428 DTSCS12 01429 MOVE WRK-EMP-NO TO WRK-EMP-NO-DISP. DTSCS12 01430 MOVE WRK-EMP-NO-DISP-1 TO WRK-EMP-NO-1. DTSCS12 01431 MOVE WRK-EMP-NO-DISP-2 TO WRK-EMP-NO-2. DTSCS12 01432 DTSCS12 01433 MOVE MPRF-EMP-STATUS TO WRK-EMP-STATUS. DTSCS12 01434 DTSCS12 01435 DTSCS12 01436 DTSCS12 01437 P6900-EXIT. EXIT. DTSCS12 01438 DTSCS12 01439 P6910-FORMAT-FROM-BTB. DTSCS12 01440 MOVE IBTB-NAME TO WRK-NAME. DTSCS12 01441 DTSCS12 01442 IF IBTB-NAME-BEN-ALT-88 DTSCS12 01443 MOVE 'B' TO WRK-TYPE DTSCS12 01444 PERFORM P6911-READ-BAA THRU P6911-EXIT DTSCS12 01445 IF WRK-FATAL-ERROR-YES DTSCS12 01446 GO TO P6910-EXIT DTSCS12 01447 ELSE DTSCS12 01448 MOVE MBAA-CITY TO WRK-CITY DTSCS12 01449 MOVE MBAA-ST TO WRK-ST DTSCS12 01450 GO TO P6910-EXIT DTSCS12 01451 END-IF DTSCS12 01452 ELSE DTSCS12 01453 MOVE MTAD-CITY TO WRK-CITY DTSCS12 01454 MOVE MTAD-ST TO WRK-ST DTSCS12 01455 IF IBTB-NAME-PRIMARY-88 DTSCS12 01456 MOVE 'P' TO WRK-TYPE DTSCS12 01457 ELSE DTSCS12 01458 IF IBTB-NAME-ENTITY-88 DTSCS12 01459 MOVE 'E' TO WRK-TYPE DTSCS12 01460 ELSE DTSCS12 01461 IF IBTB-NAME-TAX-ALT-88 DTSCS12 01462 MOVE 'A' TO WRK-TYPE DTSCS12 01463 ELSE DTSCS12 01464 GO TO S899-ABEND. DTSCS12 01465 P6910-EXIT. DTSCS12 01466 EXIT. DTSCS12 01467 DTSCS12 01468 P6911-READ-BAA. DTSCS12 01469 MOVE LOW-VALUES TO MBAA-KEY-AREA. DTSCS12 01470 MOVE IBTB-EMP-NO TO MBAA-EMP-NO. DTSCS12 01471 MOVE IBTB-ID-NO TO MBAA-ID-NO. DTSCS12 01472 SET MBAA-BAA-88 TO TRUE. DTSCS12 01473 MOVE MBAA-KEY-AREA TO MSKL-KEY-AREA. DTSCS12 01474 PERFORM S810-READ THRU S810-EXIT. DTSCS12 01475 IF L810-NO-REC-88 DTSCS12 01476 MOVE IBTB-EMP-NO TO MSG-EMP-NO-IN-ERR DTSCS12 01477 MOVE MSG-E123-AREA TO LCCM-MSG-AREA DTSCS12 01478 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS12 01479 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS12 01480 SET WRK-FATAL-ERROR-YES TO TRUE DTSCS12 01481 GO TO P6911-EXIT. DTSCS12 01482 DTSCS12 01483 MOVE MSKL-REC TO MBAA-REC. DTSCS12 01484 P6911-EXIT. DTSCS12 01485 EXIT. DTSCS12 01486 DTSCS12 01487 P6920-FORMAT-FROM-OPO. DTSCS12 01488 MOVE MTAD-CITY TO WRK-CITY. DTSCS12 01489 MOVE MTAD-ST TO WRK-ST. DTSCS12 01490 DTSCS12 01491 IF ISKL-OPN-88 DTSCS12 01492 STRING DTSCS12 01493 IOPN-NAME DELIMITED BY ' ' DTSCS12 01494 '; ' DELIMITED BY SIZE DTSCS12 01495 MPRF-PRIMARY-NAME DELIMITED BY SIZE DTSCS12 01496 INTO DTSCS12 01497 WRK-NAME DTSCS12 01498 ELSE DTSCS12 01499 IF ISKL-OPS-88 DTSCS12 01500 PERFORM P6921-READ-OPO THRU P6921-EXIT DTSCS12 01501 IF WRK-FATAL-ERROR-YES DTSCS12 01502 GO TO P6920-EXIT DTSCS12 01503 END-IF DTSCS12 01504 STRING DTSCS12 01505 MOPO-NAME DELIMITED BY ' ' DTSCS12 01506 '; ' DELIMITED BY SIZE DTSCS12 01507 MPRF-PRIMARY-NAME DELIMITED BY SIZE DTSCS12 01508 INTO DTSCS12 01509 WRK-NAME. DTSCS12 01510 P6920-EXIT. DTSCS12 01511 EXIT. DTSCS12 01512 DTSCS12 01513 P6921-READ-OPO. DTSCS12 01514 MOVE LOW-VALUES TO MOPO-KEY-AREA. DTSCS12 01515 MOVE IOPS-EMP-NO TO MOPO-EMP-NO. DTSCS12 01516 MOVE IOPS-ID-NO TO MOPO-ID-NO. DTSCS12 01517 SET MOPO-OPO-88 TO TRUE. DTSCS12 01518 MOVE MOPO-KEY-AREA TO MSKL-KEY-AREA. DTSCS12 01519 PERFORM S810-READ THRU S810-EXIT. DTSCS12 01520 IF L810-NO-REC-88 DTSCS12 01521 MOVE IOPS-EMP-NO TO MSG-EMP-NO-IN-ERR DTSCS12 01522 MOVE MSG-E123-AREA TO LCCM-MSG-AREA DTSCS12 01523 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS12 01524 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS12 01525 SET WRK-FATAL-ERROR-YES TO TRUE DTSCS12 01526 GO TO P6921-EXIT. DTSCS12 01527 DTSCS12 01528 MOVE MSKL-REC TO MOPO-REC. DTSCS12 01529 P6921-EXIT. DTSCS12 01530 EXIT. DTSCS12 01531 DTSCS12 01532 P6930-FORMAT-FROM-PRF-TAD. DTSCS12 01533 MOVE MPRF-PRIMARY-NAME TO WRK-NAME. DTSCS12 01534 MOVE MTAD-CITY TO WRK-CITY. DTSCS12 01535 MOVE MTAD-ST TO WRK-ST. DTSCS12 01536 P6930-EXIT. DTSCS12 01537 EXIT. DTSCS12 01538 DTSCS12 01539 DTSCS12 01540 P6970-READ-PRF. DTSCS12 01541 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS12 01542 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS12 01543 SET MPRF-PRF-88 TO TRUE. DTSCS12 01544 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS12 01545 PERFORM S810-READ THRU S810-EXIT. DTSCS12 01546 IF L810-NO-REC-88 DTSCS12 01547 MOVE WRK-EMP-NO TO MSG-EMP-NO-IN-ERR DTSCS12 01548 MOVE MSG-E123-AREA TO LCCM-MSG-AREA DTSCS12 01549 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS12 01550 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS12 01551 SET WRK-FATAL-ERROR-YES TO TRUE DTSCS12 01552 GO TO P6970-EXIT. DTSCS12 01553 DTSCS12 01554 MOVE MSKL-REC TO MPRF-REC. DTSCS12 01555 P6970-EXIT. DTSCS12 01556 EXIT. DTSCS12 01557 DTSCS12 01558 P6980-READ-TAD. DTSCS12 01559 MOVE LOW-VALUES TO MTAD-KEY-AREA. DTSCS12 01560 MOVE WRK-EMP-NO TO MTAD-EMP-NO. DTSCS12 01561 SET MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE. DTSCS12 01562 SET MTAD-TAD-88 TO TRUE. DTSCS12 01563 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSCS12 01564 PERFORM S810-READ THRU S810-EXIT. DTSCS12 01565 IF L810-NO-REC-88 DTSCS12 01566 MOVE WRK-EMP-NO TO MSG-EMP-NO-IN-ERR DTSCS12 01567 MOVE MSG-E123-AREA TO LCCM-MSG-AREA DTSCS12 01568 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS12 01569 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS12 01570 SET WRK-FATAL-ERROR-YES TO TRUE DTSCS12 01571 GO TO P6980-EXIT. DTSCS12 01572 DTSCS12 01573 MOVE MSKL-REC TO MTAD-REC. DTSCS12 01574 P6980-EXIT. DTSCS12 01575 EXIT. DTSCS12 01576 DTSCS12 01577 /*****************************************************************DTSCS12 01578 * CHECK DATA IN LCCM-SCR-HOLD-AREA. THE TABLE CONTAINS AIX KEYS DTSCS12 01579 * REPRESENTING EACH LINE DISPLAYED. THIS PARAGRAPH IS CALLED DTSCS12 01580 * FROM P3000, P4000, P6000. DTSCS12 01581 ******************************************************************DTSCS12 01582 P9000-CHECK-LCCM-SCR-HOLD. DTSCS12 01583 MOVE LCCM-SCR-HOLD-AREA TO WRK-SCR-HOLD-AREA DTSCS12 01584 IF WRK-SCR-HOLD-PROG-NAME = WRK-MOD-NAME DTSCS12 01585 NEXT SENTENCE DTSCS12 01586 ELSE DTSCS12 01587 GO TO P9000-EXIT. DTSCS12 01588 DTSCS12 01589 MOVE WRK-SCR-HOLD-KEY (1) TO ISKL-KEY-AREA. DTSCS12 01590 IF ISKL-BTB-88 DTSCS12 01591 OR ISKL-OPN-88 DTSCS12 01592 OR ISKL-OPS-88 DTSCS12 01593 OR ISKL-EIN-88 DTSCS12 01594 OR ISKL-BTN-88 DTSCS12 01595 SET WRK-AIX-TBL-KEY-FND TO TRUE DTSCS12 01596 MOVE ISKL-KEY-AREA TO WRK-STARTING-SEARCH-KEY DTSCS12 01597 ELSE DTSCS12 01598 GO TO P9000-EXIT. DTSCS12 01599 DTSCS12 01600 MOVE WRK-SCR-HOLD-KEY (WRK-SCR-HOLD-KEY-CTR) DTSCS12 01601 TO ISKL-KEY-AREA. DTSCS12 01602 IF ISKL-BTB-88 DTSCS12 01603 OR ISKL-OPN-88 DTSCS12 01604 OR ISKL-OPS-88 DTSCS12 01605 OR ISKL-EIN-88 DTSCS12 01606 OR ISKL-BTN-88 DTSCS12 01607 MOVE ISKL-KEY-AREA TO WRK-ENDING-SEARCH-KEY DTSCS12 01608 ELSE DTSCS12 01609 MOVE WRK-STARTING-SEARCH-KEY DTSCS12 01610 TO WRK-ENDING-SEARCH-KEY. DTSCS12 01611 P9000-EXIT. DTSCS12 01612 EXIT. DTSCS12 01613 DTSCS12 01614 /*****************************************************************DTSCS12 01615 * LINKS TO UTILITY MODULES DTSCS12 01616 ******************************************************************DTSCS12 01617 DTSCS12 01618 S001-FROM-FED-8. DTSCS12 01619 SET L001-FROM-FED-8 TO TRUE. DTSCS12 01620 GO TO S001-DATE. DTSCS12 01621 DTSCS12 01622 S001-FROM-ABS-DATE. DTSCS12 01623 SET L001-FROM-ABS-DAY TO TRUE. DTSCS12 01624 GO TO S001-DATE. DTSCS12 01625 DTSCS12 01626 S001-DATE. DTSCS12 01627 EXEC CICS LINK DTSCS12 01628 PROGRAM('DTSCU001') DTSCS12 01629 COMMAREA(L001-COMM-AREA) DTSCS12 01630 END-EXEC. DTSCS12 01631 S001-EXIT. DTSCS12 01632 EXIT. DTSCS12 01633 DTSCS12 01634 S013-COUNT-FROM-SCREEN. DTSCS12 01635 EXEC CICS LINK DTSCS12 01636 PROGRAM('DTSCU013') DTSCS12 01637 COMMAREA(L013-COMM-AREA) DTSCS12 01638 END-EXEC. DTSCS12 01639 S013-EXIT. DTSCS12 01640 EXIT. DTSCS12 01641 DTSCS12 01642 S017-FEIN-FROM-SCREEN. DTSCS12 01643 EXEC CICS LINK DTSCS12 01644 PROGRAM('DTSCU017') DTSCS12 01645 COMMAREA(L017-COMM-AREA) DTSCS12 01646 END-EXEC. DTSCS12 01647 S017-EXIT. DTSCS12 01648 EXIT. DTSCS12 01649 DTSCS12 01650 S020-SSN-FROM-SCREEN. DTSCS12 01651 EXEC CICS LINK DTSCS12 01652 PROGRAM('DTSCU020') DTSCS12 01653 COMMAREA(L020-COMM-AREA) DTSCS12 01654 END-EXEC. DTSCS12 01655 S020-EXIT. DTSCS12 01656 EXIT. DTSCS12 01657 DTSCS12 01658 S027-BTN-FROM-SCREEN. DTSCS12 01659 EXEC CICS LINK DTSCS12 01660 PROGRAM('DTSCU027') DTSCS12 01661 COMMAREA(L027-COMM-AREA) DTSCS12 01662 END-EXEC. DTSCS12 01663 S027-EXIT. DTSCS12 01664 EXIT. DTSCS12 01665 DTSCS12 01666 S803-REQ-SCR-ID-EDIT. DTSCS12 01667 EXEC CICS LINK DTSCS12 01668 PROGRAM ('DTSCU803') DTSCS12 01669 COMMAREA (DFHCOMMAREA) DTSCS12 01670 END-EXEC. DTSCS12 01671 S803-EXIT. DTSCS12 01672 EXIT. DTSCS12 01673 DTSCS12 01674 S804-INVALID-KEY. DTSCS12 01675 EXEC CICS LINK DTSCS12 01676 PROGRAM ('DTSCU804') DTSCS12 01677 COMMAREA (DFHCOMMAREA) DTSCS12 01678 END-EXEC. DTSCS12 01679 S804-EXIT. DTSCS12 01680 EXIT. DTSCS12 01681 DTSCS12 01682 S805-MSG-AREA. DTSCS12 01683 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS12 01684 DTSCS12 01685 EXEC CICS LINK DTSCS12 01686 PROGRAM ('DTSCU805') DTSCS12 01687 COMMAREA (L805-COMM-AREA) DTSCS12 01688 END-EXEC. DTSCS12 01689 DTSCS12 01690 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS12 01691 S805-EXIT. DTSCS12 01692 EXIT. DTSCS12 01693 EJECT DTSCS12 01694 S810-READ. DTSCS12 01695 SET L810-READ-88 TO TRUE. DTSCS12 01696 GO TO S810-IO. DTSCS12 01697 DTSCS12 01698 S810-START-BROWSE. DTSCS12 01699 SET L810-START-BROWSE-88 TO TRUE. DTSCS12 01700 GO TO S810-IO. DTSCS12 01701 DTSCS12 01702 S810-READ-NEXT. DTSCS12 01703 SET L810-READ-NEXT-88 TO TRUE. DTSCS12 01704 GO TO S810-IO. DTSCS12 01705 DTSCS12 01706 S810-READ-PREV. DTSCS12 01707 SET L810-READ-PREV-88 TO TRUE. DTSCS12 01708 GO TO S810-IO. DTSCS12 01709 DTSCS12 01710 S810-END-BROWSE. DTSCS12 01711 SET L810-END-BROWSE-88 TO TRUE. DTSCS12 01712 GO TO S810-IO. DTSCS12 01713 DTSCS12 01714 S810-COUNT. DTSCS12 01715 SET L810-COUNT-88 TO TRUE. DTSCS12 01716 GO TO S810-IO. DTSCS12 01717 DTSCS12 01718 S810-REWRITE. DTSCS12 01719 SET L810-REWRITE-88 TO TRUE. DTSCS12 01720 GO TO S810-IO. DTSCS12 01721 DTSCS12 01722 S810-WRITE. DTSCS12 01723 SET L810-WRITE-88 TO TRUE. DTSCS12 01724 GO TO S810-IO. DTSCS12 01725 DTSCS12 01726 S810-DELETE. DTSCS12 01727 SET L810-DELETE-88 TO TRUE. DTSCS12 01728 GO TO S810-IO. DTSCS12 01729 DTSCS12 01730 S810-IO. DTSCS12 01731 DTSCS12 01732 EXEC CICS LINK DTSCS12 01733 PROGRAM ('DTSCU810') DTSCS12 01734 COMMAREA (L810-COMM-AREA) DTSCS12 01735 END-EXEC. DTSCS12 01736 DTSCS12 01737 IF L810-FILE-CLOSED-88 DTSCS12 01738 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS12 01739 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS12 01740 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS12 01741 GO TO MAINLINE-EXIT. DTSCS12 01742 S810-EXIT. DTSCS12 01743 EXIT. DTSCS12 01744 EJECT DTSCS12 01745 S821-START-BROWSE. DTSCS12 01746 SET L821-START-BROWSE-88 TO TRUE. DTSCS12 01747 GO TO S821-MASTER-IO. DTSCS12 01748 DTSCS12 01749 S821-END-BROWSE. DTSCS12 01750 SET L821-END-BROWSE-88 TO TRUE. DTSCS12 01751 GO TO S821-MASTER-IO. DTSCS12 01752 DTSCS12 01753 S821-READ-PREV. DTSCS12 01754 SET L821-READ-PREV-88 TO TRUE. DTSCS12 01755 GO TO S821-MASTER-IO. DTSCS12 01756 DTSCS12 01757 S821-READ-NEXT. DTSCS12 01758 SET L821-READ-NEXT-88 TO TRUE. DTSCS12 01759 GO TO S821-MASTER-IO. DTSCS12 01760 DTSCS12 01761 S821-MASTER-IO. DTSCS12 01762 MOVE ISKL-KEY-AREA TO HOLD-ISKL-KEY-AREA. DTSCS12 01763 DTSCS12 01764 EXEC CICS LINK DTSCS12 01765 PROGRAM ('DTSCU821') DTSCS12 01766 COMMAREA (L821-COMM-AREA) DTSCS12 01767 END-EXEC. DTSCS12 01768 DTSCS12 01769 IF L821-FILE-CLOSED-88 DTSCS12 01770 MOVE L821-MSG-AREA TO LCCM-MSG-AREA DTSCS12 01771 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS12 01772 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS12 01773 GO TO MAINLINE-EXIT DTSCS12 01774 ELSE DTSCS12 01775 IF L821-OK-88 DTSCS12 01776 PERFORM S821A-SIMULATE-NO-REC THRU S821A-EXIT. DTSCS12 01777 S821-EXIT. EXIT. DTSCS12 01778 DTSCS12 01779 S821A-SIMULATE-NO-REC. DTSCS12 01780 IF L821-END-BROWSE-88 DTSCS12 01781 GO TO S821A-EXIT. DTSCS12 01782 DTSCS12 01783 IF (ISKL-EIN-88) DTSCS12 01784 AND IEIN-FEIN NOT = WRK-FEIN DTSCS12 01785 SET L821-END-BROWSE-88 TO TRUE DTSCS12 01786 EXEC CICS LINK DTSCS12 01787 PROGRAM ('DTSCU821') DTSCS12 01788 COMMAREA (L821-COMM-AREA) DTSCS12 01789 END-EXEC DTSCS12 01790 MOVE HOLD-ISKL-KEY-AREA TO ISKL-KEY-AREA DTSCS12 01791 SET L821-NO-REC-88 TO TRUE DTSCS12 01792 ELSE DTSCS12 01793 IF (ISKL-OPS-88) DTSCS12 01794 AND IOPS-SSN NOT = WRK-SSN DTSCS12 01795 SET L821-END-BROWSE-88 TO TRUE DTSCS12 01796 EXEC CICS LINK DTSCS12 01797 PROGRAM ('DTSCU821') DTSCS12 01798 COMMAREA (L821-COMM-AREA) DTSCS12 01799 END-EXEC DTSCS12 01800 MOVE HOLD-ISKL-KEY-AREA TO ISKL-KEY-AREA DTSCS12 01801 SET L821-NO-REC-88 TO TRUE DTSCS12 01802 ELSE DTSCS12 01803 IF (ISKL-BTN-88) DTSCS12 01804 AND IBTN-DC-BUSINESS-TAX-ACCT-NO NOT = WRK-BTN DTSCS12 01805 SET L821-END-BROWSE-88 TO TRUE DTSCS12 01806 EXEC CICS LINK DTSCS12 01807 PROGRAM ('DTSCU821') DTSCS12 01808 COMMAREA (L821-COMM-AREA) DTSCS12 01809 END-EXEC DTSCS12 01810 MOVE HOLD-ISKL-KEY-AREA TO ISKL-KEY-AREA DTSCS12 01811 SET L821-NO-REC-88 TO TRUE. DTSCS12 01812 S821A-EXIT. EXIT. DTSCS12 01813 DTSCS12 01814 S851-SCREEN-PROCESSING. DTSCS12 01815 EXEC CICS LINK DTSCS12 01816 PROGRAM ('DTSCU851') DTSCS12 01817 COMMAREA (L851-COMM-AREA) DTSCS12 01818 END-EXEC. DTSCS12 01819 S851-EXIT. DTSCS12 01820 EXIT. DTSCS12 01821 DTSCS12 01822 S899-ABEND. DTSCS12 01823 EXEC CICS ABEND DTSCS12 01824 ABCODE(WRK-ABEND-CD) DTSCS12 01825 END-EXEC. DTSCS12 01826 S899-EXIT. DTSCS12 01827 EXIT. DTSCS12 01828 /*****************************************************************DTSCS12 01829 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS12 01830 ******************************************************************DTSCS12 01831 DTSCS12 01832 S1000-SCREEN-EDITS. DTSCS12 01833 MOVE +0 TO WRK-NUM-SRCH-FLDS-ENTERED. DTSCS12 01834 PERFORM S1100-EDIT-NAME THRU S1100-EXIT. DTSCS12 01835 PERFORM S1200-EDIT-OPO THRU S1200-EXIT. DTSCS12 01836 PERFORM S1300-EDIT-SSN THRU S1300-EXIT. DTSCS12 01837 PERFORM S1400-EDIT-FEIN THRU S1400-EXIT. DTSCS12 01838 PERFORM S1500-EDIT-BTN THRU S1500-EXIT. DTSCS12 01839 IF WRK-NUM-SRCH-FLDS-ENTERED = 0 DTSCS12 01840 MOVE MSG-E121-AREA TO WRK-MSG-AREA DTSCS12 01841 PERFORM S1001-ERROR THRU S1001-EXIT DTSCS12 01842 ELSE DTSCS12 01843 IF WRK-NUM-SRCH-FLDS-ENTERED > 1 DTSCS12 01844 MOVE MSG-E122-AREA TO WRK-MSG-AREA DTSCS12 01845 PERFORM S1001-ERROR THRU S1001-EXIT. DTSCS12 01846 DTSCS12 01847 S1000-EXIT. EXIT. DTSCS12 01848 EJECT DTSCS12 01849 /**************************************************************** DTSCS12 01850 * ERROR IN SELECTION CRITERIA DTSCS12 01851 ***************************************************************** DTSCS12 01852 S1001-ERROR. DTSCS12 01853 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-EMP-NAME-A DTSCS12 01854 MAP-OPO-NAME-A. DTSCS12 01855 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-SSN-1-A DTSCS12 01856 MAP-SSN-2-A DTSCS12 01857 MAP-SSN-3-A DTSCS12 01858 MAP-FEIN-1-A DTSCS12 01859 MAP-FEIN-2-A DTSCS12 01860 MAP-BTN-A. DTSCS12 01861 SET CURSOR-SET-YES TO TRUE. DTSCS12 01862 IF LCCM-NO-MSG DTSCS12 01863 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS12 01864 MOVE CATB-CURSOR TO MAP-EMP-NAME-L. DTSCS12 01865 S1001-EXIT. EXIT. DTSCS12 01866 /**************************************************************** DTSCS12 01867 * EDIT EMPLOYER NAME FOR ENTRY DTSCS12 01868 ***************************************************************** DTSCS12 01869 S1100-EDIT-NAME. DTSCS12 01870 IF MAP-EMP-NAME = LOW-VALUES OR SPACES DTSCS12 01871 NEXT SENTENCE DTSCS12 01872 ELSE DTSCS12 01873 ADD 1 TO WRK-NUM-SRCH-FLDS-ENTERED DTSCS12 01874 MOVE LOW-VALUES TO IBTB-KEY-AREA DTSCS12 01875 SET IBTB-BTB-88 TO TRUE DTSCS12 01876 MOVE MAP-EMP-NAME TO IBTB-NAME DTSCS12 01877 MOVE ZEROS TO IBTB-EMP-NO DTSCS12 01878 IBTB-ID-NO DTSCS12 01879 MOVE IBTB-KEY-AREA TO WRK-STARTING-SEARCH-KEY. DTSCS12 01880 S1100-EXIT. EXIT. DTSCS12 01881 DTSCS12 01882 /**************************************************************** DTSCS12 01883 * EDIT OPO NAME FOR ENTRY DTSCS12 01884 ***************************************************************** DTSCS12 01885 S1200-EDIT-OPO. DTSCS12 01886 IF MAP-OPO-NAME = LOW-VALUES OR SPACES DTSCS12 01887 NEXT SENTENCE DTSCS12 01888 ELSE DTSCS12 01889 ADD 1 TO WRK-NUM-SRCH-FLDS-ENTERED DTSCS12 01890 MOVE LOW-VALUES TO IOPN-KEY-AREA DTSCS12 01891 SET IOPN-OPN-88 TO TRUE DTSCS12 01892 MOVE MAP-OPO-NAME TO IOPN-NAME DTSCS12 01893 MOVE ZEROS TO IOPN-EMP-NO DTSCS12 01894 IOPN-ID-NO DTSCS12 01895 MOVE IOPN-KEY-AREA TO WRK-STARTING-SEARCH-KEY. DTSCS12 01896 S1200-EXIT. EXIT. DTSCS12 01897 DTSCS12 01898 /**************************************************************** DTSCS12 01899 * EDIT SSN FOR ENTRY DTSCS12 01900 ***************************************************************** DTSCS12 01901 S1300-EDIT-SSN. DTSCS12 01902 MOVE MAP-SSN-AREA TO L020-S-SSN-AREA DTSCS12 01903 PERFORM S020-SSN-FROM-SCREEN THRU S020-EXIT DTSCS12 01904 IF L020-NO-ENTRY DTSCS12 01905 NEXT SENTENCE DTSCS12 01906 ELSE DTSCS12 01907 ADD 1 TO WRK-NUM-SRCH-FLDS-ENTERED DTSCS12 01908 IF L020-NOT-VALID DTSCS12 01909 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS12 01910 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS12 01911 ELSE DTSCS12 01912 MOVE LOW-VALUES TO IOPS-KEY-AREA DTSCS12 01913 SET IOPS-OPS-88 TO TRUE DTSCS12 01914 MOVE L020-SSN TO IOPS-SSN DTSCS12 01915 MOVE ZEROS TO IOPS-EMP-NO DTSCS12 01916 IOPS-ID-NO DTSCS12 01917 MOVE IOPS-KEY-AREA TO WRK-STARTING-SEARCH-KEY. DTSCS12 01918 S1300-EXIT. EXIT. DTSCS12 01919 DTSCS12 01920 S1301-ERROR. DTSCS12 01921 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-SSN-1-A DTSCS12 01922 MAP-SSN-2-A DTSCS12 01923 MAP-SSN-3-A. DTSCS12 01924 SET CURSOR-SET-YES TO TRUE. DTSCS12 01925 IF LCCM-NO-MSG DTSCS12 01926 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS12 01927 MOVE CATB-CURSOR TO MAP-SSN-1-L. DTSCS12 01928 S1301-EXIT. EXIT. DTSCS12 01929 DTSCS12 01930 /**************************************************************** DTSCS12 01931 * EDIT FEIN FOR ENTRY DTSCS12 01932 ***************************************************************** DTSCS12 01933 S1400-EDIT-FEIN. DTSCS12 01934 MOVE MAP-FEIN-AREA TO L017-S-FEIN-AREA DTSCS12 01935 PERFORM S017-FEIN-FROM-SCREEN THRU S017-EXIT DTSCS12 01936 IF L017-NO-ENTRY DTSCS12 01937 NEXT SENTENCE DTSCS12 01938 ELSE DTSCS12 01939 ADD 1 TO WRK-NUM-SRCH-FLDS-ENTERED DTSCS12 01940 IF L017-NOT-VALID DTSCS12 01941 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS12 01942 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS12 01943 ELSE DTSCS12 01944 MOVE LOW-VALUES TO IEIN-KEY-AREA DTSCS12 01945 SET IEIN-EIN-88 TO TRUE DTSCS12 01946 MOVE L017-FEIN TO IEIN-FEIN DTSCS12 01947 MOVE ZEROS TO IEIN-EMP-NO DTSCS12 01948 MOVE IEIN-KEY-AREA TO WRK-STARTING-SEARCH-KEY. DTSCS12 01949 S1400-EXIT. EXIT. DTSCS12 01950 DTSCS12 01951 S1401-ERROR. DTSCS12 01952 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-FEIN-1-A DTSCS12 01953 MAP-FEIN-2-A DTSCS12 01954 SET CURSOR-SET-YES TO TRUE. DTSCS12 01955 IF LCCM-NO-MSG DTSCS12 01956 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS12 01957 MOVE CATB-CURSOR TO MAP-FEIN-1-L. DTSCS12 01958 S1401-EXIT. EXIT. DTSCS12 01959 DTSCS12 01960 /**************************************************************** DTSCS12 01961 * EDIT BUSINESS TAX NUMBER DTSCS12 01962 ***************************************************************** DTSCS12 01963 S1500-EDIT-BTN. DTSCS12 01964 MOVE MAP-BTN-AREA TO L027-S-BTN-AREA DTSCS12 01965 PERFORM S027-BTN-FROM-SCREEN THRU S027-EXIT DTSCS12 01966 IF L027-NO-ENTRY DTSCS12 01967 NEXT SENTENCE DTSCS12 01968 ELSE DTSCS12 01969 ADD 1 TO WRK-NUM-SRCH-FLDS-ENTERED DTSCS12 01970 IF L027-NOT-VALID DTSCS12 01971 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS12 01972 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS12 01973 ELSE DTSCS12 01974 MOVE LOW-VALUES TO IBTN-KEY-AREA DTSCS12 01975 SET IBTN-BTN-88 TO TRUE DTSCS12 01976 MOVE L027-BTN TO IBTN-DC-BUSINESS-TAX-ACCT-NO DTSCS12 01977 MOVE ZEROS TO IBTN-EMP-NO DTSCS12 01978 MOVE IBTN-KEY-AREA TO WRK-STARTING-SEARCH-KEY. DTSCS12 01979 S1500-EXIT. EXIT. DTSCS12 01980 DTSCS12 01981 S1501-ERROR. DTSCS12 01982 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-BTN-A. DTSCS12 01983 SET CURSOR-SET-YES TO TRUE. DTSCS12 01984 IF LCCM-NO-MSG DTSCS12 01985 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS12 01986 MOVE CATB-CURSOR TO MAP-BTN-L. DTSCS12 01987 S1501-EXIT. EXIT. DTSCS12 01988 DTSCS12 01989 ******************************************************************DTSCS12 01990 * SET ATTIBUTE BYTES FOR SCREEN CLEAR REQUEST. THIS UNLOCKS THE *DTSCS12 01991 * SEARCH CRITERIA FIELDS WHICH ARE PROTECTED WHEN REQ-INQUIRE DTSCS12 01992 * IS TRUE. DTSCS12 01993 ******************************************************************DTSCS12 01994 S5200-SET-CLEAR-ATTRB. DTSCS12 01995 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-EMP-NAME-A DTSCS12 01996 MAP-OPO-NAME-A. DTSCS12 01997 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-SSN-1-A DTSCS12 01998 MAP-SSN-2-A DTSCS12 01999 MAP-SSN-3-A DTSCS12 02000 MAP-FEIN-1-A DTSCS12 02001 MAP-FEIN-2-A DTSCS12 02002 MAP-BTN-A. DTSCS12 02003 DTSCS12 02004 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS12 02005 DTSCS12 02006 S5200-EXIT. DTSCS12 02007 EXIT. DTSCS12 02008 DTSCS12 02009 ******************************************************************DTSCS12 02010 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS12 02011 * WHILE AN INQUIRY IS IN PROGRESS, THE SEARCH CRITERIA FIELDS DTSCS12 02012 * ARE PROTECTED. THE USER MUST CLEAR THE SCREEN TO CHANGE THE DTSCS12 02013 * SEARCH CRITERIA. DTSCS12 02014 ******************************************************************DTSCS12 02015 S5300-SET-INQ-ATTRB. DTSCS12 02016 DTSCS12 02017 MOVE CATB-ASKIP-NORM-MDTON TO MAP-EMP-NAME-A DTSCS12 02018 MAP-OPO-NAME-A DTSCS12 02019 MAP-SSN-1-A DTSCS12 02020 MAP-SSN-2-A DTSCS12 02021 MAP-SSN-3-A DTSCS12 02022 MAP-FEIN-1-A DTSCS12 02023 MAP-FEIN-2-A DTSCS12 02024 MAP-BTN-A. DTSCS12 02025 DTSCS12 02026 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS12 02027 S5300-EXIT. DTSCS12 02028 EXIT. DTSCS12 02029 DTSCS12 02030 S5900-SET-ATTRB. DTSCS12 02031 PERFORM S5910-TABLE THRU S5910-EXIT DTSCS12 02032 VARYING WRK-CTR FROM 1 BY 1 DTSCS12 02033 UNTIL WRK-CTR > MAX-LINES. DTSCS12 02034 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS12 02035 S5900-EXIT. EXIT. DTSCS12 02036 DTSCS12 02037 S5910-TABLE. DTSCS12 02038 MOVE CATB-ASKIP-BRT-MDTON TO MAP-LINE-A(WRK-CTR). DTSCS12 02039 S5910-EXIT. EXIT. DTSCS12 02040 /*************************************************************** DTSCS12 02041 * THESE ATTRIBUTES ARE BUILT PRIOR TO THE SEND BASED ON THE DTSCS12 02042 * SEARCH RESULTS AND SCREEN STATUS DTSCS12 02043 **************************************************************** DTSCS12 02044 *S5920-ATTRIBUTES. DTSCS12 02045 * IF WRK-TS-FOUND-YES DTSCS12 02046 *****AND MAP-SCREEN-ID-A = LOW-VALUES DTSCS12 02047 * MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-SCREEN-ID-A DTSCS12 02048 * ELSE DTSCS12 02049 * IF WRK-TS-FOUND-NO DTSCS12 02050 * MOVE CATB-ASKIP-NORM-MDTON TO MAP-SCREEN-ID-A. DTSCS12 02051 * DTSCS12 02052 * IF WRK-TS-FOUND-YES DTSCS12 02053 *****AND MAP-LINE-NUMBER-A = LOW-VALUES DTSCS12 02054 * MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-LINE-NUMBER-A DTSCS12 02055 * ELSE DTSCS12 02056 * IF WRK-TS-FOUND-NO DTSCS12 02057 * MOVE CATB-ASKIP-NORM-MDTON TO MAP-LINE-NUMBER-A. DTSCS12 02058 * DTSCS12 02059 * IF WRK-TS-FOUND-NO AND MAP-LEGAL-NAME-A = LOW-VALUES DTSCS12 02060 * MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-LEGAL-NAME-A DTSCS12 02061 * ELSE DTSCS12 02062 * IF WRK-TS-FOUND-YES DTSCS12 02063 * MOVE CATB-ASKIP-NORM-MDTON TO MAP-LEGAL-NAME-A. DTSCS12 02064 * DTSCS12 02065 * IF WRK-TS-FOUND-NO AND MAP-OPO-NAME-A = LOW-VALUES DTSCS12 02066 * MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-OPO-NAME-A DTSCS12 02067 * ELSE DTSCS12 02068 * IF WRK-TS-FOUND-YES DTSCS12 02069 * MOVE CATB-ASKIP-NORM-MDTON TO MAP-OPO-NAME-A. DTSCS12 02070 * DTSCS12 02071 * IF WRK-TS-FOUND-NO AND MAP-SSN-1-A = LOW-VALUES DTSCS12 02072 * MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-SSN-1-A DTSCS12 02073 * MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-SSN-2-A DTSCS12 02074 * MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-SSN-3-A DTSCS12 02075 * ELSE DTSCS12 02076 * IF WRK-TS-FOUND-YES DTSCS12 02077 * MOVE CATB-ASKIP-NORM-MDTON TO MAP-SSN-1-A DTSCS12 02078 * MOVE CATB-ASKIP-NORM-MDTON TO MAP-SSN-2-A DTSCS12 02079 * MOVE CATB-ASKIP-NORM-MDTON TO MAP-SSN-3-A. DTSCS12 02080 * DTSCS12 02081 * IF WRK-TS-FOUND-NO AND MAP-FEIN-1-A = LOW-VALUES DTSCS12 02082 * MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-FEIN-1-A DTSCS12 02083 * MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-FEIN-2-A DTSCS12 02084 * ELSE DTSCS12 02085 * IF WRK-TS-FOUND-YES DTSCS12 02086 * MOVE CATB-ASKIP-NORM-MDTON TO MAP-FEIN-1-A DTSCS12 02087 * MOVE CATB-ASKIP-NORM-MDTON TO MAP-FEIN-2-A. DTSCS12 02088 * DTSCS12 02089 *S5920-EXIT. EXIT. DTSCS12 02090 * EJECT DTSCS12 02091 /*****************************************************************DTSCS12 02092 * MAP ROUTINES *DTSCS12 02093 ******************************************************************DTSCS12 02094 S9100-RECEIVE. DTSCS12 02095 SET L851-RECEIVE-88 TO TRUE. DTSCS12 02096 DTSCS12 02097 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS12 02098 DTSCS12 02099 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS12 02100 DTSCS12 02101 MOVE L851-AID TO LCCM-AID. DTSCS12 02102 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS12 02103 S9100-EXIT. DTSCS12 02104 EXIT. DTSCS12 02105 DTSCS12 02106 S9200-SEND-DATAONLY. DTSCS12 02107 MOVE LOW-VALUES TO MAP-AREA. DTSCS12 02108 DTSCS12 02109 IF LCCM-NO-MSG DTSCS12 02110 NEXT SENTENCE DTSCS12 02111 ELSE DTSCS12 02112 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS12 02113 DTSCS12 02114 IF CURSOR-SET-GOTO DTSCS12 02115 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS12 02116 ELSE DTSCS12 02117 IF CURSOR-SET-NO DTSCS12 02118 MOVE CATB-CURSOR TO MAP-EMP-NAME-L. DTSCS12 02119 DTSCS12 02120 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS12 02121 DTSCS12 02122 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS12 02123 DTSCS12 02124 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS12 02125 S9200-EXIT. DTSCS12 02126 EXIT. DTSCS12 02127 DTSCS12 02128 S9300-SEND-MAP. DTSCS12 02129 * PERFORM S5920-ATTRIBUTES THRU S5920-EXIT. DTSCS12 02130 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS12 02131 MOVE SPACES TO MAP-SYS-TIME. DTSCS12 02132 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS12 02133 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS12 02134 DTSCS12 02135 IF SCR-ACCESS-UPDATE DTSCS12 02136 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS12 02137 ELSE DTSCS12 02138 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS12 02139 DTSCS12 02140 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS12 02141 DTSCS12 02142 IF CURSOR-SET-NO DTSCS12 02143 MOVE CATB-CURSOR TO MAP-EMP-NAME-L. DTSCS12 02144 DTSCS12 02145 SET L851-SEND-88 TO TRUE. DTSCS12 02146 DTSCS12 02147 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS12 02148 DTSCS12 02149 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS12 02150 S9300-EXIT. DTSCS12 02151 EXIT. DTSCS12 02152 DTSCS12 02153 S9310-UPDATE-FKEYS. DTSCS12 02154 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS12 02155 DTSCS12 02156 S9310-EXIT. DTSCS12 02157 EXIT. DTSCS12 02158 DTSCS12 02159 S9320-INQUIRY-FKEYS. DTSCS12 02160 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS12 02161 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS12 02162 MOVE CFKD-NEW-SEARCH TO MAP-KEY-NEW-SEARCH. DTSCS12 02163 S9320-EXIT. DTSCS12 02164 EXIT. DTSCS12 02165 DTSCS12 02166 S9900-PREPARE-SEND. DTSCS12 02167 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS12 02168 LCCM-SCR-ID. DTSCS12 02169 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS12 02170 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS12 02171 S9900-EXIT. DTSCS12 02172 EXIT. DTSCS12