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

2228 lines
174 KiB
COBOL
Raw Blame History

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
Reference in New Issue View Git Blame Copy Permalink