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