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

2273 lines
178 KiB
COBOL
Raw Blame History

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