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