1132 lines
88 KiB
COBOL
1132 lines
88 KiB
COBOL
00001 IDENTIFICATION DIVISION. 10/07/98
|
|
00002 PROGRAM-ID. DTSCS99. DTSCS99
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV004
|
|
00004 DATE-WRITTEN. SEPTEMBER 1998. CL**2
|
|
00005 DATE-COMPILED. DTSCS99
|
|
00006 DTSCS99
|
|
00007 ***** DTSCS99
|
|
00008 * DTSCS99
|
|
00009 * FUNCTION: EMPLOYER ON-LINE UPDATE LOCK INQUIRY/UPDATE DTSCS99
|
|
00010 * SCREEN PROCESSOR. DTSCS99
|
|
00011 * DTSCS99
|
|
00012 * DTSCS99
|
|
00013 * MODIFICATION LOG: DTSCS99
|
|
00014 * DTSCS99
|
|
00015 * 09/28/1998 INITIAL DEVELOPMENT. CL**2
|
|
00016 * WORK ORDER: PROGRAMMER: GD CL**2
|
|
00017 * DTSCS99
|
|
00018 * XX/XX/XXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2
|
|
00019 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2
|
|
00020 * WORK ORDER: PROGRAMMER: XXX CL**2
|
|
00021 * DTSCS99
|
|
00022 * DTSCS99
|
|
00023 * DESCRIPTION: DTSCS99
|
|
00024 * DTSCS99
|
|
00025 * CLEAR: DTSCS99
|
|
00026 * DTSCS99
|
|
00027 * DATA FIELDS DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO). DTSCS99
|
|
00028 * DTSCS99
|
|
00029 * DTSCS99
|
|
00030 * INQUIRY: DTSCS99
|
|
00031 * DTSCS99
|
|
00032 * CONTROL FIELDS(S): MAP-EMP-NO. DTSCS99
|
|
00033 * DTSCS99
|
|
00034 * JUMP IN: DISPLAY DATA ASSOCIATED WITH LCCM-EMP-NO. DTSCS99
|
|
00035 * DTSCS99
|
|
00036 * ENTER: DISPLAY DATA ASSOCIATED WITH MAP-EMP-NO. DTSCS99
|
|
00037 * DTSCS99
|
|
00038 * STANDARD LCCM-EMP-NO MAINTENANCE LOGIC. DTSCS99
|
|
00039 * DTSCS99
|
|
00040 * DTSCS99
|
|
00041 * UPDATE: DTSCS99
|
|
00042 * DTSCS99
|
|
00043 * MOD DTSCS99
|
|
00044 * DTSCS99
|
|
00045 * DTSCS99
|
|
00046 * RECORDS READ: DTSCS99
|
|
00047 * DTSCS99
|
|
00048 * MASTER: DTSCS99
|
|
00049 * DTSCS99
|
|
00050 * MPRF. DTSCS99
|
|
00051 * DTSCS99
|
|
00052 * DTSCS99
|
|
00053 * ALTERNATE INDEX: DTSCS99
|
|
00054 * DTSCS99
|
|
00055 * NONE. DTSCS99
|
|
00056 * DTSCS99
|
|
00057 * DTSCS99
|
|
00058 * REFERENCE: DTSCS99
|
|
00059 * DTSCS99
|
|
00060 * NONE. DTSCS99
|
|
00061 * DTSCS99
|
|
00062 * DTSCS99
|
|
00063 * ACCOUNTING TRANSACTION COLLECTION: DTSCS99
|
|
00064 * DTSCS99
|
|
00065 * NONE. DTSCS99
|
|
00066 * DTSCS99
|
|
00067 * DTSCS99
|
|
00068 * RECORDS UPDATED: DTSCS99
|
|
00069 * DTSCS99
|
|
00070 * MASTER: DTSCS99
|
|
00071 * DTSCS99
|
|
00072 * MPRF (MOD). DTSCS99
|
|
00073 * OBVIOUSLY, THIS MODULE BYPASSES THE EMPLOYER ON-LINE DTSCS99
|
|
00074 * UPDATE LOCKING PROCEDURES (THIS IS THE MODULE THAT DTSCS99
|
|
00075 * ALLOWS THE SYSTEM USERS TO MAINTAIN THE EMPLOYER DTSCS99
|
|
00076 * ON-LINE UPDATE LOCK). DTSCS99
|
|
00077 * DTSCS99
|
|
00078 * THE ONLY MPRF FIELDS MODIFIED ARE MPRF-UPDATE-START- DTSCS99
|
|
00079 * ABSTIME AND MPRF-UPDATE-END-ABSTIME. DTSCS99
|
|
00080 * DTSCS99
|
|
00081 * IF MPRF IS MODIFIED, THEN WRITE A DTSIR905 RECORD CL**2
|
|
00082 * REFLECTING THE EVENT. DTSCS99
|
|
00083 * DTSCS99
|
|
00084 * DTSCS99
|
|
00085 * REFERENCE: DTSCS99
|
|
00086 * DTSCS99
|
|
00087 * NONE. DTSCS99
|
|
00088 * DTSCS99
|
|
00089 * DTSCS99
|
|
00090 * ACCOUNTING TRANSACTION COLLECTION: DTSCS99
|
|
00091 * DTSCS99
|
|
00092 * NONE. DTSCS99
|
|
00093 * DTSCS99
|
|
00094 * DTSCS99
|
|
00095 * ON-LINE EVENT FILE RECORDS WRITTEN: DTSCS99
|
|
00096 * DTSCS99
|
|
00097 * DTSIR905 ON-LINE RECOVERY/RESTART (905R1) REPORT RECORD. CL**2
|
|
00098 * DTSCS99
|
|
00099 * DTSCS99
|
|
00100 * MODULES LINKED TO: DTSCS99
|
|
00101 * DTSCS99
|
|
00102 * DTSCU001 DATE EDIT/CONVERSION. CL**2
|
|
00103 * DTSCU018 EMP-NO FROM SCREEN FORMAT/EDIT. CL**2
|
|
00104 * DTSCU810 MASTER I/O. CL**2
|
|
00105 * DTSCU825 ON-LINE EVENT FILE O. CL**2
|
|
00106 * DTSCS99
|
|
00107 * DTSCS99
|
|
00108 ***** DTSCS99
|
|
00109 SKIP3 DTSCS99
|
|
00110 ENVIRONMENT DIVISION. DTSCS99
|
|
00111 SKIP3 DTSCS99
|
|
00112 DATA DIVISION. DTSCS99
|
|
00113 SKIP3 DTSCS99
|
|
00114 WORKING-STORAGE SECTION. DTSCS99
|
|
001145 77 PAN-VALET PICTURE X(24) VALUE '004DTSCS99 10/07/98'. DTSCS99
|
|
00115 SKIP3 DTSCS99
|
|
00116 01 WRK-AREA. DTSCS99
|
|
00117 05 WRK-ABEND-CD PIC X(04) VALUE 'S99 '. DTSCS99
|
|
00118 SKIP1 DTSCS99
|
|
00119 05 WRK-SCR-ID. DTSCS99
|
|
00120 10 WRK-SCR-ID-9 PIC 9(02) VALUE 99. DTSCS99
|
|
00121 SKIP1 DTSCS99
|
|
00122 05 WRK-F03-SCR-ID PIC X(02) VALUE '90'. DTSCS99
|
|
00123 SKIP3 DTSCS99
|
|
00124 05 SCR-ACCESS-IND PIC X(01). DTSCS99
|
|
00125 88 SCR-ACCESS-INQ VALUE '1'. DTSCS99
|
|
00126 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS99
|
|
00127 SKIP1 DTSCS99
|
|
00128 05 CURSOR-SET-IND PIC X(01). DTSCS99
|
|
00129 88 CURSOR-SET-YES VALUE 'Y'. DTSCS99
|
|
00130 88 CURSOR-SET-NO VALUE 'N'. DTSCS99
|
|
00131 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS99
|
|
00132 SKIP1 DTSCS99
|
|
00133 05 REQ-IND PIC X(01). DTSCS99
|
|
00134 88 REQ-ERROR VALUE 'O'. DTSCS99
|
|
00135 88 REQ-JUMP VALUE 'J'. DTSCS99
|
|
00136 88 REQ-INQUIRE VALUE 'I'. DTSCS99
|
|
00137 88 REQ-CLEAR VALUE 'C'. DTSCS99
|
|
00138 88 REQ-EDIT VALUE 'E'. DTSCS99
|
|
00139 88 REQ-UPDATE VALUE 'U'. DTSCS99
|
|
00140 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS99
|
|
00141 SKIP1 DTSCS99
|
|
00142 05 RESP-IND PIC X(01). DTSCS99
|
|
00143 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS99
|
|
00144 88 RESP-SEND-MAP VALUE 'M'. DTSCS99
|
|
00145 88 RESP-JUMP VALUE 'J'. DTSCS99
|
|
00146 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS99
|
|
00147 SKIP1 DTSCS99
|
|
00148 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSCS99
|
|
00149 SKIP1 DTSCS99
|
|
00150 05 WRK-MPRF-IND PIC X(01). DTSCS99
|
|
00151 88 WRK-MPRF-YES-88 VALUE 'Y'. DTSCS99
|
|
00152 88 WRK-MPRF-NO-88 VALUE 'N'. DTSCS99
|
|
00153 SKIP1 DTSCS99
|
|
00154 05 WRK-NEW-KEY-IND PIC X(01). DTSCS99
|
|
00155 SKIP1 DTSCS99
|
|
00156 05 WRK-MSG-AREA PIC X(64). DTSCS99
|
|
00157 SKIP1 DTSCS99
|
|
00158 05 WRK-ATB-AN PIC X(01). DTSCS99
|
|
00159 05 WRK-ATB-NUM PIC X(01). DTSCS99
|
|
00160 SKIP3 DTSCS99
|
|
00161 05 WRK-DISPLAY PIC 9(09). DTSCS99
|
|
00162 SKIP1 DTSCS99
|
|
00163 05 FILLER REDEFINES WRK-DISPLAY. DTSCS99
|
|
00164 10 FILLER PIC X(03). DTSCS99
|
|
00165 10 WRK-DISPLAY-YR PIC X(02). DTSCS99
|
|
00166 10 WRK-DISPLAY-MO PIC X(02). DTSCS99
|
|
00167 10 WRK-DISPLAY-DA PIC X(02). DTSCS99
|
|
00168 SKIP1 DTSCS99
|
|
00169 05 FILLER REDEFINES WRK-DISPLAY. DTSCS99
|
|
00170 10 FILLER PIC X(03). DTSCS99
|
|
00171 10 WRK-DISPLAY-HR PIC X(02). DTSCS99
|
|
00172 10 WRK-DISPLAY-MIN PIC X(02). DTSCS99
|
|
00173 10 WRK-DISPLAY-SEC PIC X(02). DTSCS99
|
|
00174 EJECT DTSCS99
|
|
00175 01 L018-COMM-AREA. DTSCS99
|
|
00176 ++INCLUDE DTSIL018 CL**2
|
|
00177 EJECT DTSCS99
|
|
00178 01 L805-COMM-AREA. DTSCS99
|
|
00179 ++INCLUDE DTSIL805 CL**2
|
|
00180 EJECT DTSCS99
|
|
00181 01 L810-COMM-AREA. DTSCS99
|
|
00182 05 L810-CONTROL-BLOCK. DTSCS99
|
|
00183 ++INCLUDE DTSIL810 CL**2
|
|
00184 EJECT DTSCS99
|
|
00185 05 MSKL-REC. DTSCS99
|
|
00186 ++INCLUDE DTSIMSKL CL**2
|
|
00187 EJECT DTSCS99
|
|
00188 01 MPRF-REC. DTSCS99
|
|
00189 ++INCLUDE DTSIMPRF CL**2
|
|
00190 EJECT DTSCS99
|
|
00191 01 L825-COMM-AREA. DTSCS99
|
|
00192 05 L825-CONTROL-BLOCK. DTSCS99
|
|
00193 ++INCLUDE DTSIL825 CL**2
|
|
00194 EJECT DTSCS99
|
|
00195 05 RSKL-REC. DTSCS99
|
|
00196 ++INCLUDE DTSIRSK1 CL**2
|
|
00197 EJECT DTSCS99
|
|
00198 01 R905-REC. DTSCS99
|
|
00199 ++INCLUDE DTSIR905 CL**2
|
|
00200 EJECT DTSCS99
|
|
00201 * MAP DEFINITION DTSCS99
|
|
00202 01 L851-COMM-AREA. DTSCS99
|
|
00203 ++INCLUDE DTSIL851 CL**2
|
|
00204 SKIP3 DTSCS99
|
|
00205 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS99
|
|
00206 ++INCLUDE DTSIS99 CL**2
|
|
00207 EJECT DTSCS99
|
|
00208 01 CATB-LITERALS. DTSCS99
|
|
00209 ++INCLUDE DTSICATB CL**2
|
|
00210 SKIP3 DTSCS99
|
|
00211 01 CFKD-LITERALS. DTSCS99
|
|
00212 ++INCLUDE DTSICFKD CL**2
|
|
00213 SKIP3 DTSCS99
|
|
00214 01 CECD-LITERALS. DTSCS99
|
|
00215 ++INCLUDE DTSICECD CL**2
|
|
00216 SKIP3 DTSCS99
|
|
00217 01 CPCD-LITERALS. DTSCS99
|
|
00218 ++INCLUDE DTSICPCD CL**2
|
|
00219 EJECT DTSCS99
|
|
00220 LINKAGE SECTION. DTSCS99
|
|
00221 SKIP3 DTSCS99
|
|
00222 01 DFHCOMMAREA. DTSCS99
|
|
00223 ++INCLUDE DTSILCCM CL**2
|
|
00224 EJECT DTSCS99
|
|
00225 ******************************************************************DTSCS99
|
|
00226 * *DTSCS99
|
|
00227 ******************************************************************DTSCS99
|
|
00228 SKIP1 DTSCS99
|
|
00229 PROCEDURE DIVISION. DTSCS99
|
|
00230 SKIP2 DTSCS99
|
|
00231 MOVE +0 TO WRK-EMP-NO. DTSCS99
|
|
00232 SKIP1 DTSCS99
|
|
00233 SET WRK-MPRF-NO-88 TO TRUE. DTSCS99
|
|
00234 SKIP1 DTSCS99
|
|
00235 MOVE LOW-VALUES TO MAP-AREA. DTSCS99
|
|
00236 SKIP1 DTSCS99
|
|
00237 SET CURSOR-SET-NO TO TRUE. DTSCS99
|
|
00238 SKIP1 DTSCS99
|
|
00239 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-9) DTSCS99
|
|
00240 TO SCR-ACCESS-IND. DTSCS99
|
|
00241 SKIP3 DTSCS99
|
|
00242 MOVE SPACE TO REQ-IND. DTSCS99
|
|
00243 SKIP1 DTSCS99
|
|
00244 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS99
|
|
00245 SKIP1 DTSCS99
|
|
00246 *----------------------------------------------------- DTSCS99
|
|
00247 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS99
|
|
00248 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS99
|
|
00249 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS99
|
|
00250 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS99
|
|
00251 * DTSCS99
|
|
00252 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS99
|
|
00253 * PROCESSED. DTSCS99
|
|
00254 * DTSCS99
|
|
00255 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS99
|
|
00256 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS99
|
|
00257 * WORK STATION OPERATOR. DTSCS99
|
|
00258 *----------------------------------------------------- DTSCS99
|
|
00259 SKIP1 DTSCS99
|
|
00260 MOVE SPACE TO RESP-IND. DTSCS99
|
|
00261 SKIP1 DTSCS99
|
|
00262 IF REQ-ERROR DTSCS99
|
|
00263 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS99
|
|
00264 ELSE DTSCS99
|
|
00265 IF REQ-JUMP DTSCS99
|
|
00266 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS99
|
|
00267 ELSE DTSCS99
|
|
00268 IF REQ-CLEAR DTSCS99
|
|
00269 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS99
|
|
00270 ELSE DTSCS99
|
|
00271 IF REQ-CURSOR-TO-GOTO DTSCS99
|
|
00272 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS99
|
|
00273 ELSE DTSCS99
|
|
00274 IF REQ-INQUIRE DTSCS99
|
|
00275 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS99
|
|
00276 ELSE DTSCS99
|
|
00277 IF REQ-EDIT DTSCS99
|
|
00278 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS99
|
|
00279 ELSE DTSCS99
|
|
00280 IF REQ-UPDATE DTSCS99
|
|
00281 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS99
|
|
00282 ELSE DTSCS99
|
|
00283 GO TO S899-ABEND. DTSCS99
|
|
00284 SKIP3 DTSCS99
|
|
00285 *----------------------------------------------------- DTSCS99
|
|
00286 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS99
|
|
00287 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS99
|
|
00288 *----------------------------------------------------- DTSCS99
|
|
00289 SKIP1 DTSCS99
|
|
00290 IF RESP-SEND-MAP DTSCS99
|
|
00291 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS99
|
|
00292 SET LCCM-END-TASK-88 TO TRUE DTSCS99
|
|
00293 ELSE DTSCS99
|
|
00294 IF RESP-SEND-MSGONLY DTSCS99
|
|
00295 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS99
|
|
00296 SET LCCM-END-TASK-88 TO TRUE DTSCS99
|
|
00297 ELSE DTSCS99
|
|
00298 IF RESP-JUMP DTSCS99
|
|
00299 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS99
|
|
00300 ELSE DTSCS99
|
|
00301 IF RESP-CURSOR-TO-GOTO DTSCS99
|
|
00302 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS99
|
|
00303 SET LCCM-END-TASK-88 TO TRUE DTSCS99
|
|
00304 ELSE DTSCS99
|
|
00305 GO TO S899-ABEND. DTSCS99
|
|
00306 SKIP3 DTSCS99
|
|
00307 MAINLINE-EXIT. DTSCS99
|
|
00308 SKIP1 DTSCS99
|
|
00309 EXEC CICS DTSCS99
|
|
00310 RETURN DTSCS99
|
|
00311 END-EXEC. DTSCS99
|
|
00312 SKIP2 DTSCS99
|
|
00313 GOBACK. DTSCS99
|
|
00314 /*****************************************************************DTSCS99
|
|
00315 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS99
|
|
00316 ******************************************************************DTSCS99
|
|
00317 P1000-ANALYZE-REQUEST. DTSCS99
|
|
00318 SKIP1 DTSCS99
|
|
00319 *----------------------------------------------------- DTSCS99
|
|
00320 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS99
|
|
00321 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS99
|
|
00322 * REPLACED WITH ENTER) DTSCS99
|
|
00323 *----------------------------------------------------- DTSCS99
|
|
00324 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS99
|
|
00325 SET LCCM-ENTER-88 TO TRUE DTSCS99
|
|
00326 SET REQ-INQUIRE TO TRUE DTSCS99
|
|
00327 IF LCCM-EMP-NO > ZERO DTSCS99
|
|
00328 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS99
|
|
00329 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS99
|
|
00330 END-IF DTSCS99
|
|
00331 GO TO P1000-EXIT. DTSCS99
|
|
00332 SKIP3 DTSCS99
|
|
00333 *----------------------------------------------------- DTSCS99
|
|
00334 * MAP IS RECEIVED DTSCS99
|
|
00335 *----------------------------------------------------- DTSCS99
|
|
00336 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS99
|
|
00337 SKIP3 DTSCS99
|
|
00338 *----------------------------------------------------- DTSCS99
|
|
00339 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS99
|
|
00340 * WORK STATION DTSCS99
|
|
00341 *----------------------------------------------------- DTSCS99
|
|
00342 IF LCCM-CLEAR-88 DTSCS99
|
|
00343 SET REQ-CLEAR TO TRUE DTSCS99
|
|
00344 GO TO P1000-EXIT. DTSCS99
|
|
00345 SKIP3 DTSCS99
|
|
00346 *----------------------------------------------------- DTSCS99
|
|
00347 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS99
|
|
00348 *----------------------------------------------------- DTSCS99
|
|
00349 IF LCCM-SCR-UPDATE-LOCKED DTSCS99
|
|
00350 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS99
|
|
00351 GO TO P1000-EXIT. DTSCS99
|
|
00352 SKIP3 DTSCS99
|
|
00353 *----------------------------------------------------- DTSCS99
|
|
00354 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS99
|
|
00355 *----------------------------------------------------- DTSCS99
|
|
00356 IF LCCM-PA2-88 DTSCS99
|
|
00357 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS99
|
|
00358 GO TO P1000-EXIT. DTSCS99
|
|
00359 SKIP3 DTSCS99
|
|
00360 *----------------------------------------------------- DTSCS99
|
|
00361 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS99
|
|
00362 *----------------------------------------------------- DTSCS99
|
|
00363 IF LCCM-PA-88 DTSCS99
|
|
00364 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS99
|
|
00365 SET REQ-ERROR TO TRUE DTSCS99
|
|
00366 GO TO P1000-EXIT. DTSCS99
|
|
00367 SKIP3 DTSCS99
|
|
00368 *----------------------------------------------------- CL**2
|
|
00369 * F12 PRESSED WHEN UPDATE NOT IN PROGRESS IS A CL**2
|
|
00370 * REQUEST TO CLEAR THE SCREEN CL**2
|
|
00371 *----------------------------------------------------- CL**2
|
|
00372 IF LCCM-F12-88 CL**2
|
|
00373 MOVE LOW-VALUE TO MAP-AREA CL**2
|
|
00374 SET REQ-CLEAR TO TRUE CL**2
|
|
00375 GO TO P1000-EXIT. CL**2
|
|
00376 SKIP3 CL**2
|
|
00377 *----------------------------------------------------- DTSCS99
|
|
00378 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS99
|
|
00379 *----------------------------------------------------- DTSCS99
|
|
00380 IF LCCM-F03-88 DTSCS99
|
|
00381 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS99
|
|
00382 SET REQ-JUMP TO TRUE DTSCS99
|
|
00383 GO TO P1000-EXIT. DTSCS99
|
|
00384 SKIP3 DTSCS99
|
|
00385 *----------------------------------------------------- DTSCS99
|
|
00386 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS99
|
|
00387 *----------------------------------------------------- DTSCS99
|
|
00388 IF LCCM-F04-88 DTSCS99
|
|
00389 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS99
|
|
00390 SET REQ-JUMP TO TRUE DTSCS99
|
|
00391 GO TO P1000-EXIT. DTSCS99
|
|
00392 SKIP3 DTSCS99
|
|
00393 *----------------------------------------------------- DTSCS99
|
|
00394 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS99
|
|
00395 * CORRESPONDENCE SCREEN DTSCS99
|
|
00396 *----------------------------------------------------- DTSCS99
|
|
00397 IF LCCM-F14-88 DTSCS99
|
|
00398 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS99
|
|
00399 SET REQ-JUMP TO TRUE DTSCS99
|
|
00400 GO TO P1000-EXIT. DTSCS99
|
|
00401 SKIP3 DTSCS99
|
|
00402 *----------------------------------------------------- DTSCS99
|
|
00403 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS99
|
|
00404 * REQUESTED SCREEN TYPE DTSCS99
|
|
00405 *----------------------------------------------------- DTSCS99
|
|
00406 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS99
|
|
00407 NEXT SENTENCE DTSCS99
|
|
00408 ELSE DTSCS99
|
|
00409 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS99
|
|
00410 SET REQ-JUMP TO TRUE DTSCS99
|
|
00411 GO TO P1000-EXIT. DTSCS99
|
|
00412 SKIP3 DTSCS99
|
|
00413 *----------------------------------------------------- DTSCS99
|
|
00414 * IF REQUEST TO UPDATE THE DATA (MOD) DTSCS99
|
|
00415 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS99
|
|
00416 *----------------------------------------------------- DTSCS99
|
|
00417 IF LCCM-F10-88 DTSCS99
|
|
00418 IF SCR-ACCESS-UPDATE DTSCS99
|
|
00419 SET REQ-EDIT TO TRUE DTSCS99
|
|
00420 GO TO P1000-EXIT DTSCS99
|
|
00421 ELSE DTSCS99
|
|
00422 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS99
|
|
00423 SET REQ-ERROR TO TRUE DTSCS99
|
|
00424 GO TO P1000-EXIT. DTSCS99
|
|
00425 SKIP3 DTSCS99
|
|
00426 *----------------------------------------------------- DTSCS99
|
|
00427 * IF INQUIRY TYPE KEY PRESSED (ENTER, PAGE DOWN, DTSCS99
|
|
00428 * PAGE UP), INDICATE INQUIRY REQUEST DTSCS99
|
|
00429 *----------------------------------------------------- DTSCS99
|
|
00430 IF LCCM-ENTER-88 DTSCS99
|
|
00431 SET REQ-INQUIRE TO TRUE DTSCS99
|
|
00432 GO TO P1000-EXIT. DTSCS99
|
|
00433 SKIP3 DTSCS99
|
|
00434 *----------------------------------------------------- DTSCS99
|
|
00435 * ANY OTHER KEY IS INVALID DTSCS99
|
|
00436 *----------------------------------------------------- DTSCS99
|
|
00437 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS99
|
|
00438 SET REQ-ERROR TO TRUE. DTSCS99
|
|
00439 P1000-EXIT. DTSCS99
|
|
00440 EXIT. DTSCS99
|
|
00441 SKIP3 DTSCS99
|
|
00442 ******************************************************************DTSCS99
|
|
00443 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS99
|
|
00444 ******************************************************************DTSCS99
|
|
00445 SKIP1 DTSCS99
|
|
00446 P1100-UPDATE-LOCKED. DTSCS99
|
|
00447 *----------------------------------------------------- DTSCS99
|
|
00448 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS99
|
|
00449 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCS99
|
|
00450 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS99
|
|
00451 *----------------------------------------------------- DTSCS99
|
|
00452 IF LCCM-ENTER-88 OR LCCM-F12-88 DTSCS99
|
|
00453 SET REQ-UPDATE TO TRUE DTSCS99
|
|
00454 ELSE DTSCS99
|
|
00455 SET REQ-ERROR TO TRUE DTSCS99
|
|
00456 IF LCCM-SCR-MOD-LOCKED DTSCS99
|
|
00457 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS99
|
|
00458 ELSE DTSCS99
|
|
00459 GO TO S899-ABEND. DTSCS99
|
|
00460 P1100-EXIT. DTSCS99
|
|
00461 EXIT. DTSCS99
|
|
00462 /*****************************************************************DTSCS99
|
|
00463 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS99
|
|
00464 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS99
|
|
00465 ******************************************************************DTSCS99
|
|
00466 SKIP1 DTSCS99
|
|
00467 P2000-REQUEST-ERROR. DTSCS99
|
|
00468 IF LCCM-MSG DTSCS99
|
|
00469 SET RESP-SEND-MSGONLY TO TRUE DTSCS99
|
|
00470 ELSE DTSCS99
|
|
00471 GO TO S899-ABEND. DTSCS99
|
|
00472 P2000-EXIT. DTSCS99
|
|
00473 EXIT. DTSCS99
|
|
00474 /*****************************************************************DTSCS99
|
|
00475 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS99
|
|
00476 ******************************************************************DTSCS99
|
|
00477 SKIP1 DTSCS99
|
|
00478 P3000-REQUEST-JUMP. DTSCS99
|
|
00479 *----------------------------------------------------- DTSCS99
|
|
00480 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS99
|
|
00481 * BY USER DTSCS99
|
|
00482 *----------------------------------------------------- DTSCS99
|
|
00483 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS99
|
|
00484 SKIP3 DTSCS99
|
|
00485 *----------------------------------------------------- DTSCS99
|
|
00486 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS99
|
|
00487 *----------------------------------------------------- DTSCS99
|
|
00488 IF LCCM-MSG DTSCS99
|
|
00489 SET RESP-SEND-MSGONLY TO TRUE DTSCS99
|
|
00490 SET CURSOR-SET-GOTO TO TRUE DTSCS99
|
|
00491 GO TO P3000-EXIT. DTSCS99
|
|
00492 SKIP3 DTSCS99
|
|
00493 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS99
|
|
00494 PERFORM S018-EMP-NO THRU S018-EXIT. DTSCS99
|
|
00495 IF L018-VALID DTSCS99
|
|
00496 MOVE L018-EMP-NO TO LCCM-EMP-NO. DTSCS99
|
|
00497 SKIP3 DTSCS99
|
|
00498 *----------------------------------------------------- DTSCS99
|
|
00499 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS99
|
|
00500 *----------------------------------------------------- DTSCS99
|
|
00501 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS99
|
|
00502 LCCM-SCR-HOLD-AREA. DTSCS99
|
|
00503 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS99
|
|
00504 SET RESP-JUMP TO TRUE. DTSCS99
|
|
00505 P3000-EXIT. DTSCS99
|
|
00506 EXIT. DTSCS99
|
|
00507 /*****************************************************************DTSCS99
|
|
00508 * CLEAR KEY WAS PRESSED *DTSCS99
|
|
00509 ******************************************************************DTSCS99
|
|
00510 SKIP1 DTSCS99
|
|
00511 P4000-REQUEST-CLEAR. DTSCS99
|
|
00512 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS99
|
|
00513 SKIP3 DTSCS99
|
|
00514 *----------------------------------------------------- DTSCS99
|
|
00515 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS99
|
|
00516 * FIELDS FROM EARLIER REQUESTS DTSCS99
|
|
00517 *----------------------------------------------------- DTSCS99
|
|
00518 IF LCCM-EMP-NO > ZERO DTSCS99
|
|
00519 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS99
|
|
00520 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS99
|
|
00521 MOVE ZERO TO LCCM-EMP-NO. DTSCS99
|
|
00522 SKIP1 DTSCS99
|
|
00523 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA. DTSCS99
|
|
00524 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS99
|
|
00525 SET LCCM-SCR-CLEAR TO TRUE. DTSCS99
|
|
00526 SET RESP-SEND-MAP TO TRUE. DTSCS99
|
|
00527 P4000-EXIT. DTSCS99
|
|
00528 EXIT. DTSCS99
|
|
00529 /*****************************************************************DTSCS99
|
|
00530 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS99
|
|
00531 ******************************************************************DTSCS99
|
|
00532 SKIP1 DTSCS99
|
|
00533 P5000-CURSOR-TO-GOTO. DTSCS99
|
|
00534 SET CURSOR-SET-GOTO TO TRUE. DTSCS99
|
|
00535 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS99
|
|
00536 P5000-EXIT. DTSCS99
|
|
00537 EXIT. DTSCS99
|
|
00538 /*****************************************************************DTSCS99
|
|
00539 * INQUIRY WAS REQUESTED *DTSCS99
|
|
00540 ******************************************************************DTSCS99
|
|
00541 SKIP1 DTSCS99
|
|
00542 P6000-REQUEST-INQUIRE. DTSCS99
|
|
00543 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS99
|
|
00544 MOVE LOW-VALUES TO MAP-AREA. DTSCS99
|
|
00545 MOVE L018-S-EMP-NO-AREA TO MAP-EMP-NO-AREA. DTSCS99
|
|
00546 SKIP1 DTSCS99
|
|
00547 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS99
|
|
00548 SKIP1 DTSCS99
|
|
00549 SET LCCM-SCR-CLEAR TO TRUE. DTSCS99
|
|
00550 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS99
|
|
00551 SKIP1 DTSCS99
|
|
00552 PERFORM S1001-EDIT-KEY THRU S1001-EXIT. DTSCS99
|
|
00553 SKIP1 DTSCS99
|
|
00554 IF LCCM-MSG DTSCS99
|
|
00555 NEXT SENTENCE DTSCS99
|
|
00556 ELSE DTSCS99
|
|
00557 IF LCCM-ENTER-88 DTSCS99
|
|
00558 PERFORM P6100-NO-PAGE THRU P6100-EXIT DTSCS99
|
|
00559 ELSE DTSCS99
|
|
00560 GO TO S899-ABEND. DTSCS99
|
|
00561 SKIP1 DTSCS99
|
|
00562 SET RESP-SEND-MAP TO TRUE. DTSCS99
|
|
00563 P6000-EXIT. DTSCS99
|
|
00564 EXIT. DTSCS99
|
|
00565 EJECT DTSCS99
|
|
00566 P6100-NO-PAGE. DTSCS99
|
|
00567 PERFORM S1190-READ-MPRF THRU S1190-EXIT. DTSCS99
|
|
00568 SKIP1 DTSCS99
|
|
00569 IF LCCM-MSG DTSCS99
|
|
00570 GO TO P6100-EXIT. DTSCS99
|
|
00571 SKIP1 DTSCS99
|
|
00572 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS99
|
|
00573 P6100-EXIT. DTSCS99
|
|
00574 EXIT. DTSCS99
|
|
00575 /*****************************************************************DTSCS99
|
|
00576 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCS99
|
|
00577 ******************************************************************DTSCS99
|
|
00578 SKIP1 DTSCS99
|
|
00579 P6900-CONSTRUCT-SCREEN. DTSCS99
|
|
00580 IF SCR-ACCESS-UPDATE DTSCS99
|
|
00581 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS99
|
|
00582 SKIP3 DTSCS99
|
|
00583 IF MPRF-UPDATE-ACTIVE-88 DTSCS99
|
|
00584 MOVE 'Y' TO MAP-UPDATE-IND DTSCS99
|
|
00585 ELSE DTSCS99
|
|
00586 MOVE 'N' TO MAP-UPDATE-IND. DTSCS99
|
|
00587 SKIP1 DTSCS99
|
|
00588 MOVE MPRF-UPDATE-TASK-ID TO MAP-UPDATE-TASK-ID. DTSCS99
|
|
00589 MOVE MPRF-UPDATE-OP-ID TO MAP-UPDATE-OP-ID. DTSCS99
|
|
00590 MOVE MPRF-UPDATE-TERMID TO MAP-UPDATE-TERMID. DTSCS99
|
|
00591 MOVE MPRF-UPDATE-NETNAME TO MAP-UPDATE-NETNAME. CL**2
|
|
00592 MOVE MPRF-UPDATE-SCR-ID TO MAP-UPDATE-SCR-ID. DTSCS99
|
|
00593 MOVE MPRF-UPDATE-FUNCTION TO MAP-UPDATE-FUNCTION. DTSCS99
|
|
00594 SKIP1 DTSCS99
|
|
00595 MOVE MPRF-UPDATE-START-DATE TO WRK-DISPLAY. DTSCS99
|
|
00596 MOVE ' / / ' TO MAP-UPDATE-START-DATE. DTSCS99
|
|
00597 MOVE WRK-DISPLAY-MO TO MAP-UPDATE-START-DATE (1:2). DTSCS99
|
|
00598 MOVE WRK-DISPLAY-DA TO MAP-UPDATE-START-DATE (4:2). DTSCS99
|
|
00599 MOVE WRK-DISPLAY-YR TO MAP-UPDATE-START-DATE (7:2). DTSCS99
|
|
00600 SKIP1 DTSCS99
|
|
00601 MOVE MPRF-UPDATE-START-TIME TO WRK-DISPLAY. DTSCS99
|
|
00602 MOVE ' : : ' TO MAP-UPDATE-START-TIME. DTSCS99
|
|
00603 MOVE WRK-DISPLAY-HR TO MAP-UPDATE-START-TIME (1:2). DTSCS99
|
|
00604 MOVE WRK-DISPLAY-MIN TO MAP-UPDATE-START-TIME (4:2). DTSCS99
|
|
00605 MOVE WRK-DISPLAY-SEC TO MAP-UPDATE-START-TIME (7:2). DTSCS99
|
|
00606 SKIP3 DTSCS99
|
|
00607 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS99
|
|
00608 SKIP1 DTSCS99
|
|
00609 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS99
|
|
00610 P6900-EXIT. DTSCS99
|
|
00611 EXIT. DTSCS99
|
|
00612 /*****************************************************************DTSCS99
|
|
00613 * FUNCTION KEY TO ADD, MOD OR DEL THE RECORD WAS PRESSED. *DTSCS99
|
|
00614 ******************************************************************DTSCS99
|
|
00615 SKIP1 DTSCS99
|
|
00616 P7000-REQUEST-EDIT. DTSCS99
|
|
00617 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS99
|
|
00618 SKIP1 DTSCS99
|
|
00619 IF LCCM-F10-88 DTSCS99
|
|
00620 PERFORM P7200-EDIT-MOD THRU P7200-EXIT DTSCS99
|
|
00621 ELSE DTSCS99
|
|
00622 GO TO S899-ABEND. DTSCS99
|
|
00623 SKIP3 DTSCS99
|
|
00624 *------------------------------------------------------ DTSCS99
|
|
00625 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCS99
|
|
00626 * IN ORDER TO CONTINUE TO ATTEMPT AN ADD THE SCREEN MUST REMAIN DTSCS99
|
|
00627 * IN A 'CLEAR' STATE. THE SCREEN MUST BE IN 'INQUIRE' STATUS DTSCS99
|
|
00628 * IF MOD OR DEL FUNCTIONS ARE BEING REQUESTED. DTSCS99
|
|
00629 *------------------------------------------------------ DTSCS99
|
|
00630 SKIP1 DTSCS99
|
|
00631 IF LCCM-MSG DTSCS99
|
|
00632 NEXT SENTENCE DTSCS99
|
|
00633 ELSE DTSCS99
|
|
00634 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCS99
|
|
00635 IF LCCM-F10-88 DTSCS99
|
|
00636 SET LCCM-SCR-MOD-LOCKED TO TRUE DTSCS99
|
|
00637 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID. DTSCS99
|
|
00638 SKIP1 DTSCS99
|
|
00639 SET RESP-SEND-MAP TO TRUE. DTSCS99
|
|
00640 P7000-EXIT. DTSCS99
|
|
00641 EXIT. DTSCS99
|
|
00642 /*****************************************************************DTSCS99
|
|
00643 * MODIFICATION FUNCTION WAS REQUESTED *DTSCS99
|
|
00644 ******************************************************************DTSCS99
|
|
00645 SKIP1 DTSCS99
|
|
00646 P7200-EDIT-MOD. DTSCS99
|
|
00647 *----------------------------------------------------- DTSCS99
|
|
00648 * MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS99
|
|
00649 * INQUIRED DTSCS99
|
|
00650 *----------------------------------------------------- DTSCS99
|
|
00651 IF NOT LCCM-SCR-INQUIRE DTSCS99
|
|
00652 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT DTSCS99
|
|
00653 MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-ID DTSCS99
|
|
00654 GO TO P7200-EXIT. DTSCS99
|
|
00655 SKIP3 DTSCS99
|
|
00656 *----------------------------------------------------- DTSCS99
|
|
00657 * MAP-OP-ID MAY NOT BE CHANGED DURING THE MOD DTSCS99
|
|
00658 *----------------------------------------------------- DTSCS99
|
|
00659 PERFORM S1001-EDIT-KEY THRU S1001-EXIT. DTSCS99
|
|
00660 IF LCCM-MSG DTSCS99
|
|
00661 GO TO P7200-EXIT. DTSCS99
|
|
00662 SKIP1 DTSCS99
|
|
00663 IF LCCM-EMP-NO NOT = WRK-EMP-NO DTSCS99
|
|
00664 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS99
|
|
00665 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS99
|
|
00666 GO TO P7200-EXIT. DTSCS99
|
|
00667 SKIP1 DTSCS99
|
|
00668 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS99
|
|
00669 P7200-EXIT. DTSCS99
|
|
00670 EXIT. DTSCS99
|
|
00671 /*****************************************************************DTSCS99
|
|
00672 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED *DTSCS99
|
|
00673 ******************************************************************DTSCS99
|
|
00674 SKIP1 DTSCS99
|
|
00675 P8000-REQUEST-UPDATE. DTSCS99
|
|
00676 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS99
|
|
00677 SKIP1 DTSCS99
|
|
00678 IF LCCM-SCR-MOD-LOCKED DTSCS99
|
|
00679 PERFORM P8200-MOD THRU P8200-EXIT DTSCS99
|
|
00680 ELSE DTSCS99
|
|
00681 GO TO S899-ABEND. DTSCS99
|
|
00682 SKIP1 DTSCS99
|
|
00683 SET RESP-SEND-MAP TO TRUE. DTSCS99
|
|
00684 P8000-EXIT. DTSCS99
|
|
00685 EXIT. DTSCS99
|
|
00686 /*****************************************************************DTSCS99
|
|
00687 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS99
|
|
00688 ******************************************************************DTSCS99
|
|
00689 SKIP1 DTSCS99
|
|
00690 P8200-MOD. DTSCS99
|
|
00691 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS99
|
|
00692 SKIP1 DTSCS99
|
|
00693 IF LCCM-F12-88 DTSCS99
|
|
00694 MOVE PMSG-MOD-CANCELED TO LCCM-MSG-ID DTSCS99
|
|
00695 GO TO P8200-EXIT. DTSCS99
|
|
00696 SKIP1 DTSCS99
|
|
00697 PERFORM S1001-EDIT-KEY THRU S1001-EXIT. DTSCS99
|
|
00698 SKIP1 DTSCS99
|
|
00699 PERFORM S1190-READ-MPRF THRU S1190-EXIT. DTSCS99
|
|
00700 IF LCCM-MSG DTSCS99
|
|
00701 GO TO P8200-EXIT. DTSCS99
|
|
00702 SKIP1 DTSCS99
|
|
00703 PERFORM P8900-UPDATE THRU P8900-EXIT. DTSCS99
|
|
00704 SKIP1 DTSCS99
|
|
00705 MOVE MPRF-REC TO MSKL-REC. DTSCS99
|
|
00706 PERFORM S810-REWRITE THRU S810-EXIT. DTSCS99
|
|
00707 SKIP1 DTSCS99
|
|
00708 *-------------------------------------------------------- DTSCS99
|
|
00709 * REFRESH THE SCREEN. DTSCS99
|
|
00710 *-------------------------------------------------------- DTSCS99
|
|
00711 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS99
|
|
00712 SKIP3 DTSCS99
|
|
00713 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS99
|
|
00714 SKIP1 DTSCS99
|
|
00715 MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS99
|
|
00716 P8200-EXIT. DTSCS99
|
|
00717 EXIT. DTSCS99
|
|
00718 EJECT DTSCS99
|
|
00719 P8900-UPDATE. DTSCS99
|
|
00720 IF MPRF-UPDATE-ACTIVE-88 DTSCS99
|
|
00721 IF MAP-UPDATE-IND = 'Y' DTSCS99
|
|
00722 GO TO P8900-EXIT DTSCS99
|
|
00723 ELSE DTSCS99
|
|
00724 NEXT SENTENCE DTSCS99
|
|
00725 ELSE DTSCS99
|
|
00726 IF MAP-UPDATE-IND = 'N' DTSCS99
|
|
00727 GO TO P8900-EXIT DTSCS99
|
|
00728 ELSE DTSCS99
|
|
00729 NEXT SENTENCE. DTSCS99
|
|
00730 SKIP1 DTSCS99
|
|
00731 IF MAP-UPDATE-IND = 'Y' DTSCS99
|
|
00732 SET MPRF-UPDATE-ACTIVE-88 TO TRUE DTSCS99
|
|
00733 ELSE DTSCS99
|
|
00734 MOVE LCCM-TASK-START-ABSTIME TO MPRF-UPDATE-END-ABSTIME. DTSCS99
|
|
00735 SKIP1 DTSCS99
|
|
00736 MOVE LCCM-TASK-ID TO MPRF-UPDATE-TASK-ID. DTSCS99
|
|
00737 MOVE LCCM-OP-ID TO MPRF-UPDATE-OP-ID. DTSCS99
|
|
00738 MOVE LCCM-CICS-TERM-ID TO MPRF-UPDATE-TERMID. DTSCS99
|
|
00739 MOVE LCCM-TASK-NETNAME TO MPRF-UPDATE-NETNAME. CL**2
|
|
00740 MOVE LCCM-TASK-START-DATE TO MPRF-UPDATE-START-DATE. DTSCS99
|
|
00741 MOVE LCCM-TASK-START-TIME TO MPRF-UPDATE-START-TIME. DTSCS99
|
|
00742 MOVE WRK-SCR-ID TO MPRF-UPDATE-SCR-ID. DTSCS99
|
|
00743 SET MPRF-UPDATE-MODIFY-88 TO TRUE. DTSCS99
|
|
00744 SKIP1 DTSCS99
|
|
00745 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSCS99
|
|
00746 SKIP3 DTSCS99
|
|
00747 PERFORM P8910-CREATE-R905 THRU P8910-EXIT. DTSCS99
|
|
00748 P8900-EXIT. DTSCS99
|
|
00749 EXIT. DTSCS99
|
|
00750 SKIP3 DTSCS99
|
|
00751 P8910-CREATE-R905. DTSCS99
|
|
00752 MOVE WRK-EMP-NO TO R905-EMP-NO. DTSCS99
|
|
00753 MOVE LCCM-TASK-START-DATE TO R905-SYS-DATE. DTSCS99
|
|
00754 MOVE LCCM-TASK-START-TIME TO R905-SYS-TIME. DTSCS99
|
|
00755 MOVE LCCM-OP-ID TO R905-OP-ID. DTSCS99
|
|
00756 MOVE MAP-UPDATE-IND TO R905-UPDATE-IND. DTSCS99
|
|
00757 MOVE MPRF-UPDATE-TASK-ID TO R905-UPDATE-TASK-ID. DTSCS99
|
|
00758 MOVE MPRF-UPDATE-OP-ID TO R905-UPDATE-OP-ID. CL**4
|
|
00759 MOVE MPRF-UPDATE-TERMID TO R905-UPDATE-TERMID. DTSCS99
|
|
00760 MOVE MPRF-UPDATE-NETNAME TO R905-UPDATE-NETNAME. CL**2
|
|
00761 MOVE MPRF-UPDATE-START-DATE TO R905-UPDATE-START-DATE. DTSCS99
|
|
00762 MOVE MPRF-UPDATE-START-TIME TO R905-UPDATE-START-TIME. DTSCS99
|
|
00763 MOVE MPRF-UPDATE-SCR-ID TO R905-UPDATE-SCR-ID. DTSCS99
|
|
00764 MOVE MPRF-UPDATE-FUNCTION TO R905-UPDATE-FUNCTION. DTSCS99
|
|
00765 CL**4
|
|
00766 MOVE LOW-VALUES TO R905-PADDING-FOR-SYNCSORT. CL**4
|
|
00767 CL**4
|
|
00768 MOVE LENGTH OF R905-REC TO R905-LENGTH. CL**4
|
|
00769 CL**4
|
|
00770 MOVE R905-REC TO RSKL-REC. DTSCS99
|
|
00771 CL**4
|
|
00772 PERFORM S825-WRITE THRU S825-EXIT. CL**4
|
|
00773 P8910-EXIT. DTSCS99
|
|
00774 EXIT. DTSCS99
|
|
00775 /*****************************************************************DTSCS99
|
|
00776 * LINKS TO UTILITY MODULES DTSCS99
|
|
00777 ******************************************************************DTSCS99
|
|
00778 SKIP1 DTSCS99
|
|
00779 S018-EMP-NO. DTSCS99
|
|
00780 EXEC CICS LINK DTSCS99
|
|
00781 PROGRAM('DTSCU018') CL**2
|
|
00782 COMMAREA(L018-COMM-AREA) DTSCS99
|
|
00783 END-EXEC. DTSCS99
|
|
00784 S018-EXIT. DTSCS99
|
|
00785 EXIT. DTSCS99
|
|
00786 SKIP3 DTSCS99
|
|
00787 S803-REQ-SCR-ID-EDIT. DTSCS99
|
|
00788 EXEC CICS LINK DTSCS99
|
|
00789 PROGRAM ('DTSCU803') CL**2
|
|
00790 COMMAREA (DFHCOMMAREA) DTSCS99
|
|
00791 END-EXEC. DTSCS99
|
|
00792 S803-EXIT. DTSCS99
|
|
00793 EXIT. DTSCS99
|
|
00794 SKIP3 DTSCS99
|
|
00795 S804-INVALID-KEY. DTSCS99
|
|
00796 EXEC CICS LINK DTSCS99
|
|
00797 PROGRAM ('DTSCU804') CL**2
|
|
00798 COMMAREA (DFHCOMMAREA) DTSCS99
|
|
00799 END-EXEC. DTSCS99
|
|
00800 S804-EXIT. DTSCS99
|
|
00801 EXIT. DTSCS99
|
|
00802 SKIP3 DTSCS99
|
|
00803 S805-MSG-AREA. DTSCS99
|
|
00804 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS99
|
|
00805 SKIP1 DTSCS99
|
|
00806 EXEC CICS LINK DTSCS99
|
|
00807 PROGRAM ('DTSCU805') CL**2
|
|
00808 COMMAREA (L805-COMM-AREA) DTSCS99
|
|
00809 END-EXEC. DTSCS99
|
|
00810 SKIP1 DTSCS99
|
|
00811 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS99
|
|
00812 S805-EXIT. DTSCS99
|
|
00813 EXIT. DTSCS99
|
|
00814 EJECT DTSCS99
|
|
00815 S810-READ. DTSCS99
|
|
00816 SET L810-READ-88 TO TRUE. DTSCS99
|
|
00817 GO TO S810-IO. DTSCS99
|
|
00818 SKIP1 DTSCS99
|
|
00819 S810-START-BROWSE. DTSCS99
|
|
00820 SET L810-START-BROWSE-88 TO TRUE. DTSCS99
|
|
00821 GO TO S810-IO. DTSCS99
|
|
00822 SKIP1 DTSCS99
|
|
00823 S810-READ-NEXT. DTSCS99
|
|
00824 SET L810-READ-NEXT-88 TO TRUE. DTSCS99
|
|
00825 GO TO S810-IO. DTSCS99
|
|
00826 SKIP1 DTSCS99
|
|
00827 S810-READ-PREV. DTSCS99
|
|
00828 SET L810-READ-PREV-88 TO TRUE. DTSCS99
|
|
00829 GO TO S810-IO. DTSCS99
|
|
00830 SKIP1 DTSCS99
|
|
00831 S810-END-BROWSE. DTSCS99
|
|
00832 SET L810-END-BROWSE-88 TO TRUE. DTSCS99
|
|
00833 GO TO S810-IO. DTSCS99
|
|
00834 SKIP1 DTSCS99
|
|
00835 S810-REWRITE. DTSCS99
|
|
00836 SET L810-REWRITE-88 TO TRUE. DTSCS99
|
|
00837 GO TO S810-IO. DTSCS99
|
|
00838 SKIP1 DTSCS99
|
|
00839 S810-WRITE. DTSCS99
|
|
00840 SET L810-WRITE-88 TO TRUE. DTSCS99
|
|
00841 GO TO S810-IO. DTSCS99
|
|
00842 SKIP1 DTSCS99
|
|
00843 S810-DELETE. DTSCS99
|
|
00844 SET L810-DELETE-88 TO TRUE. DTSCS99
|
|
00845 GO TO S810-IO. DTSCS99
|
|
00846 SKIP1 DTSCS99
|
|
00847 S810-IO. DTSCS99
|
|
00848 SKIP1 DTSCS99
|
|
00849 EXEC CICS LINK DTSCS99
|
|
00850 PROGRAM ('DTSCU810') CL**2
|
|
00851 COMMAREA (L810-COMM-AREA) DTSCS99
|
|
00852 END-EXEC. DTSCS99
|
|
00853 SKIP1 DTSCS99
|
|
00854 IF L810-FILE-CLOSED-88 DTSCS99
|
|
00855 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS99
|
|
00856 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS99
|
|
00857 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS99
|
|
00858 GO TO MAINLINE-EXIT. DTSCS99
|
|
00859 S810-EXIT. DTSCS99
|
|
00860 EXIT. DTSCS99
|
|
00861 EJECT DTSCS99
|
|
00862 S825-WRITE. DTSCS99
|
|
00863 SET L825-WRITE-88 TO TRUE. DTSCS99
|
|
00864 GO TO S825-O. DTSCS99
|
|
00865 SKIP1 DTSCS99
|
|
00866 S825-O. DTSCS99
|
|
00867 SKIP1 DTSCS99
|
|
00868 EXEC CICS LINK DTSCS99
|
|
00869 PROGRAM ('DTSCU825') CL**2
|
|
00870 COMMAREA (L825-COMM-AREA) DTSCS99
|
|
00871 END-EXEC. DTSCS99
|
|
00872 SKIP1 DTSCS99
|
|
00873 IF L825-FILE-CLOSED-88 DTSCS99
|
|
00874 MOVE L825-MSG-AREA TO LCCM-MSG-AREA DTSCS99
|
|
00875 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS99
|
|
00876 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS99
|
|
00877 GO TO MAINLINE-EXIT. DTSCS99
|
|
00878 S825-EXIT. DTSCS99
|
|
00879 EXIT. DTSCS99
|
|
00880 EJECT DTSCS99
|
|
00881 S851-SCREEN-PROCESSING. DTSCS99
|
|
00882 EXEC CICS LINK DTSCS99
|
|
00883 PROGRAM ('DTSCU851') CL**2
|
|
00884 COMMAREA (L851-COMM-AREA) DTSCS99
|
|
00885 END-EXEC. DTSCS99
|
|
00886 S851-EXIT. DTSCS99
|
|
00887 EXIT. DTSCS99
|
|
00888 SKIP3 DTSCS99
|
|
00889 S899-ABEND. DTSCS99
|
|
00890 EXEC CICS ABEND DTSCS99
|
|
00891 ABCODE(WRK-ABEND-CD) DTSCS99
|
|
00892 END-EXEC. DTSCS99
|
|
00893 S899-EXIT. DTSCS99
|
|
00894 EXIT. DTSCS99
|
|
00895 /*****************************************************************DTSCS99
|
|
00896 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS99
|
|
00897 ******************************************************************DTSCS99
|
|
00898 SKIP1 DTSCS99
|
|
00899 S1000-SCREEN-EDITS. DTSCS99
|
|
00900 PERFORM S1100-EMP-NO THRU S1100-EXIT. DTSCS99
|
|
00901 SKIP1 DTSCS99
|
|
00902 IF LCCM-MSG DTSCS99
|
|
00903 GO TO S1000-EXIT. DTSCS99
|
|
00904 SKIP1 DTSCS99
|
|
00905 PERFORM S1190-READ-MPRF THRU S1190-EXIT. DTSCS99
|
|
00906 SKIP1 DTSCS99
|
|
00907 IF LCCM-MSG DTSCS99
|
|
00908 GO TO S1000-EXIT. DTSCS99
|
|
00909 SKIP1 DTSCS99
|
|
00910 PERFORM S1200-UPDATE-IND THRU S1200-EXIT. DTSCS99
|
|
00911 S1000-EXIT. DTSCS99
|
|
00912 EXIT. DTSCS99
|
|
00913 SKIP3 DTSCS99
|
|
00914 S1001-EDIT-KEY. DTSCS99
|
|
00915 PERFORM S1100-EMP-NO THRU S1100-EXIT. DTSCS99
|
|
00916 S1001-EXIT. DTSCS99
|
|
00917 EXIT. DTSCS99
|
|
00918 EJECT DTSCS99
|
|
00919 S1100-EMP-NO. DTSCS99
|
|
00920 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS99
|
|
00921 PERFORM S018-EMP-NO THRU S018-EXIT. DTSCS99
|
|
00922 IF L018-NO-ENTRY DTSCS99
|
|
00923 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS99
|
|
00924 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS99
|
|
00925 ELSE DTSCS99
|
|
00926 IF L018-NOT-VALID DTSCS99
|
|
00927 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS99
|
|
00928 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS99
|
|
00929 ELSE DTSCS99
|
|
00930 MOVE L018-EMP-NO TO WRK-EMP-NO. DTSCS99
|
|
00931 S1100-EXIT. DTSCS99
|
|
00932 EXIT. DTSCS99
|
|
00933 SKIP3 DTSCS99
|
|
00934 S1190-READ-MPRF. DTSCS99
|
|
00935 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS99
|
|
00936 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS99
|
|
00937 SET MPRF-PRF-88 TO TRUE. DTSCS99
|
|
00938 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS99
|
|
00939 PERFORM S810-READ THRU S810-EXIT. DTSCS99
|
|
00940 IF L810-NO-REC-88 DTSCS99
|
|
00941 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS99
|
|
00942 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS99
|
|
00943 ELSE DTSCS99
|
|
00944 SET WRK-MPRF-YES-88 TO TRUE DTSCS99
|
|
00945 MOVE MSKL-REC TO MPRF-REC. DTSCS99
|
|
00946 S1190-EXIT. DTSCS99
|
|
00947 EXIT. DTSCS99
|
|
00948 SKIP3 DTSCS99
|
|
00949 S1199-ERROR. DTSCS99
|
|
00950 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS99
|
|
00951 MAP-EMP-NO-2-A. DTSCS99
|
|
00952 IF LCCM-NO-MSG DTSCS99
|
|
00953 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS99
|
|
00954 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L DTSCS99
|
|
00955 SET CURSOR-SET-YES TO TRUE. DTSCS99
|
|
00956 S1199-EXIT. DTSCS99
|
|
00957 EXIT. DTSCS99
|
|
00958 EJECT DTSCS99
|
|
00959 S1200-UPDATE-IND. DTSCS99
|
|
00960 IF MAP-UPDATE-IND = SPACES OR LOW-VALUES DTSCS99
|
|
00961 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS99
|
|
00962 PERFORM S1299-ERROR THRU S1299-EXIT DTSCS99
|
|
00963 ELSE DTSCS99
|
|
00964 IF MAP-UPDATE-IND = 'N' OR 'Y' DTSCS99
|
|
00965 NEXT SENTENCE DTSCS99
|
|
00966 ELSE DTSCS99
|
|
00967 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS99
|
|
00968 PERFORM S1299-ERROR THRU S1299-EXIT. DTSCS99
|
|
00969 S1200-EXIT. DTSCS99
|
|
00970 EXIT. DTSCS99
|
|
00971 SKIP3 DTSCS99
|
|
00972 S1299-ERROR. DTSCS99
|
|
00973 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-UPDATE-IND-A. DTSCS99
|
|
00974 IF LCCM-NO-MSG DTSCS99
|
|
00975 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS99
|
|
00976 MOVE CATB-CURSOR TO MAP-UPDATE-IND-L DTSCS99
|
|
00977 SET CURSOR-SET-YES TO TRUE. DTSCS99
|
|
00978 S1299-EXIT. DTSCS99
|
|
00979 EXIT. DTSCS99
|
|
00980 /*****************************************************************DTSCS99
|
|
00981 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCS99
|
|
00982 ******************************************************************DTSCS99
|
|
00983 S5100-SET-LOCK-ATTRB. DTSCS99
|
|
00984 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS99
|
|
00985 WRK-ATB-NUM. DTSCS99
|
|
00986 SKIP1 DTSCS99
|
|
00987 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS99
|
|
00988 SKIP1 DTSCS99
|
|
00989 MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-NO-1-A DTSCS99
|
|
00990 MAP-EMP-NO-2-A DTSCS99
|
|
00991 MAP-GOTO-A. DTSCS99
|
|
00992 S5100-EXIT. DTSCS99
|
|
00993 EXIT. DTSCS99
|
|
00994 SKIP3 DTSCS99
|
|
00995 ******************************************************************DTSCS99
|
|
00996 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS99
|
|
00997 ******************************************************************DTSCS99
|
|
00998 S5200-SET-UPDATE-ATTRB. DTSCS99
|
|
00999 MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN. DTSCS99
|
|
01000 MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM. DTSCS99
|
|
01001 SKIP1 DTSCS99
|
|
01002 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS99
|
|
01003 S5200-EXIT. DTSCS99
|
|
01004 EXIT. DTSCS99
|
|
01005 SKIP3 DTSCS99
|
|
01006 ******************************************************************DTSCS99
|
|
01007 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS99
|
|
01008 ******************************************************************DTSCS99
|
|
01009 S5300-SET-INQ-ATTRB. DTSCS99
|
|
01010 MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN DTSCS99
|
|
01011 WRK-ATB-NUM. DTSCS99
|
|
01012 SKIP1 DTSCS99
|
|
01013 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS99
|
|
01014 S5300-EXIT. DTSCS99
|
|
01015 EXIT. DTSCS99
|
|
01016 SKIP3 DTSCS99
|
|
01017 S5900-SET-ATTRB. DTSCS99
|
|
01018 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS99
|
|
01019 MAP-EMP-NO-2-A. DTSCS99
|
|
01020 SKIP1 DTSCS99
|
|
01021 SKIP1 DTSCS99
|
|
01022 MOVE WRK-ATB-AN TO MAP-UPDATE-IND-A. DTSCS99
|
|
01023 SKIP1 DTSCS99
|
|
01024 MOVE CATB-ASKIP-BRT-MDTON DTSCS99
|
|
01025 TO MAP-PRIMARY-NAME-A CL**2
|
|
01026 MAP-UPDATE-TASK-ID-A DTSCS99
|
|
01027 MAP-UPDATE-OP-ID-A DTSCS99
|
|
01028 MAP-UPDATE-TERMID-A DTSCS99
|
|
01029 MAP-UPDATE-NETNAME-A CL**2
|
|
01030 MAP-UPDATE-SCR-ID-A DTSCS99
|
|
01031 MAP-UPDATE-FUNCTION-A DTSCS99
|
|
01032 MAP-UPDATE-START-DATE-A DTSCS99
|
|
01033 MAP-UPDATE-START-TIME-A. DTSCS99
|
|
01034 SKIP1 DTSCS99
|
|
01035 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS99
|
|
01036 S5900-EXIT. DTSCS99
|
|
01037 EXIT. DTSCS99
|
|
01038 /*****************************************************************DTSCS99
|
|
01039 * MAP ROUTINES *DTSCS99
|
|
01040 ******************************************************************DTSCS99
|
|
01041 S9100-RECEIVE. DTSCS99
|
|
01042 SET L851-RECEIVE-88 TO TRUE. DTSCS99
|
|
01043 SKIP1 DTSCS99
|
|
01044 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS99
|
|
01045 SKIP1 DTSCS99
|
|
01046 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS99
|
|
01047 SKIP1 DTSCS99
|
|
01048 MOVE L851-AID TO LCCM-AID. DTSCS99
|
|
01049 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS99
|
|
01050 S9100-EXIT. DTSCS99
|
|
01051 EXIT. DTSCS99
|
|
01052 SKIP3 DTSCS99
|
|
01053 S9200-SEND-DATAONLY. DTSCS99
|
|
01054 MOVE LOW-VALUES TO MAP-AREA. DTSCS99
|
|
01055 SKIP1 DTSCS99
|
|
01056 IF LCCM-NO-MSG DTSCS99
|
|
01057 NEXT SENTENCE DTSCS99
|
|
01058 ELSE DTSCS99
|
|
01059 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS99
|
|
01060 SKIP1 DTSCS99
|
|
01061 IF CURSOR-SET-GOTO DTSCS99
|
|
01062 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS99
|
|
01063 ELSE DTSCS99
|
|
01064 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS99
|
|
01065 SKIP1 DTSCS99
|
|
01066 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS99
|
|
01067 SKIP1 DTSCS99
|
|
01068 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS99
|
|
01069 SKIP1 DTSCS99
|
|
01070 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS99
|
|
01071 S9200-EXIT. DTSCS99
|
|
01072 EXIT. DTSCS99
|
|
01073 SKIP3 DTSCS99
|
|
01074 S9300-SEND-MAP. DTSCS99
|
|
01075 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS99
|
|
01076 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS99
|
|
01077 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS99
|
|
01078 SKIP1 DTSCS99
|
|
01079 IF SCR-ACCESS-UPDATE DTSCS99
|
|
01080 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS99
|
|
01081 ELSE DTSCS99
|
|
01082 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS99
|
|
01083 SKIP1 DTSCS99
|
|
01084 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCS99
|
|
01085 SKIP1 DTSCS99
|
|
01086 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS99
|
|
01087 SKIP1 DTSCS99
|
|
01088 IF CURSOR-SET-NO DTSCS99
|
|
01089 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS99
|
|
01090 SKIP1 DTSCS99
|
|
01091 SET L851-SEND-88 TO TRUE. DTSCS99
|
|
01092 SKIP1 DTSCS99
|
|
01093 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS99
|
|
01094 SKIP1 DTSCS99
|
|
01095 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS99
|
|
01096 S9300-EXIT. DTSCS99
|
|
01097 EXIT. DTSCS99
|
|
01098 SKIP3 DTSCS99
|
|
01099 S9310-UPDATE-FKEYS. DTSCS99
|
|
01100 MOVE CFKD-MOD TO MAP-KEY-MOD. DTSCS99
|
|
01101 SKIP1 DTSCS99
|
|
01102 IF LCCM-SCR-CLEAR DTSCS99
|
|
01103 MOVE LOW-VALUES TO MAP-KEY-MOD DTSCS99
|
|
01104 ELSE DTSCS99
|
|
01105 IF LCCM-SCR-UPDATE-LOCKED DTSCS99
|
|
01106 MOVE LOW-VALUES TO MAP-KEY-MOD DTSCS99
|
|
01107 ELSE DTSCS99
|
|
01108 NEXT SENTENCE. DTSCS99
|
|
01109 S9310-EXIT. DTSCS99
|
|
01110 EXIT. DTSCS99
|
|
01111 SKIP3 DTSCS99
|
|
01112 S9320-INQUIRY-FKEYS. DTSCS99
|
|
01113 MOVE LOW-VALUES TO MAP-KEY-MOD. DTSCS99
|
|
01114 S9320-EXIT. DTSCS99
|
|
01115 EXIT. DTSCS99
|
|
01116 SKIP3 DTSCS99
|
|
01117 S9330-DSCR-FIELDS. DTSCS99
|
|
01118 MOVE LOW-VALUES TO MAP-PRIMARY-NAME. CL**3
|
|
01119 IF WRK-MPRF-YES-88 DTSCS99
|
|
01120 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME. CL**2
|
|
01121 S9330-EXIT. DTSCS99
|
|
01122 EXIT. DTSCS99
|
|
01123 SKIP3 DTSCS99
|
|
01124 S9900-PREPARE-SEND. DTSCS99
|
|
01125 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS99
|
|
01126 LCCM-SCR-ID. DTSCS99
|
|
01127 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS99
|
|
01128 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS99
|
|
01129 S9900-EXIT. DTSCS99
|
|
01130 EXIT. DTSCS99
|