giteaadmin/DUTAS
4
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
ca3572c5dfa2d2f7aa129881cbdfdb422c1fc30f
DUTAS/CICS/DTSCS67.cob
Neeraj Kumar ca3572c5df DUTAS re-platformed to Raincode - Initial Source Code
2025-07-21 11:20:11 -04:00

1957 lines
153 KiB
COBOL
Raw Blame History

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