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