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