2174 lines
170 KiB
COBOL
2174 lines
170 KiB
COBOL
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
|