00001 IDENTIFICATION DIVISION. 08/29/25 00002 PROGRAM-ID. DTSCS85. DTSCS85 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV003 00004 DATE-WRITTEN. SEPTEMBER 1998. DTSCS85 00005 DATE-COMPILED. DTSCS85 00006 SKIP3 DTSCS85 00007 ***** DTSCS85 00008 * FUNCTION: FIELD REPRESENTATIVE TERRITORY INQUIRY/UPDATE DTSCS85 00009 * SCREEN PROCESSOR. DTSCS85 00010 * DTSCS85 00011 * DTSCS85 00012 * ****** NOTE ******* NOTE ******* NOTE ******* NOTE ****** DTSCS85 00013 * DTSCS85 00014 * 09/1998: ALL REFERENCES TO FINALIST COMMENTED OUT UNTIL DTSCS85 00015 * FINALIST BECOMES AVAILABLE -- GD DTSCS85 00016 * DTSCS85 00017 * THIS COMPILE NEEDS DTSCS85 00018 * DTSCS85 00019 * //LINK.SYSLIB DD DTSCS85 00020 * // DD DTSCS85 00021 * // DD DTSCS85 00022 * // DD DTSCS85 00023 * // DD DTSCS85 00024 * // DD DTSCS85 00025 * // DD DSN=CICS.FIN720.LOADLIB.ONLINE,DISP=SHR DTSCS85 00026 * DTSCS85 00027 * AND DTSCS85 00028 * DTSCS85 00029 * // PARM.LINK='LIST,XREF,LET,AMODE(31),RMODE(ANY)', DTSCS85 00030 * DTSCS85 00031 * DTSCS85 00032 * DTSCS85 00033 * VERIFY THAT .V720. IS THE CURRENT FINALIST LIBRARY DTSCS85 00034 * DTSCS85 00035 * ****** NOTE ******* NOTE ******* NOTE ******* NOTE ****** DTSCS85 00036 * DTSCS85 00037 * DTSCS85 00038 * MODIFICATION LOG: DTSCS85 00039 * DTSCS85 00040 * 09/25/1998 INITIAL DEVELOPMENT. MODIFIED FROM MACCS85. DTSCS85 00041 * WORK ORDER: PROGRAMMER: GD DTSCS85 00042 * DTSCS85 00043 * 09/22/2000 RECOMPILED FOR NEW VERSION(R720) OF FINALIST. DTSCS85 00044 * WORK ORDER: PROGRAMMER: ZL1 DTSCS85 00045 * DTSCS85 00046 * 01/27/2005 ADDED CANADA (CD) AS A VALID US TERRITORY DTSCS85 00047 * WORK ORDER: DC MAINT PROGRAMMER: ZL1 DTSCS85 00048 * DTSCS85 00049 * CL**2 00050 * 08/27/2025 REMOVED REFERENCES TO FINALIST TERRITORY CL**2 00051 * WORK ORDER: DC MAINT PROGRAMMER: ZL1 CL**2 00052 * CL**2 00053 * XX/XX/XXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS85 00054 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS85 00055 * WORK ORDER: PROGRAMMER: XXX DTSCS85 00056 * DTSCS85 00057 * DTSCS85 00058 * DESCRIPTION: DTSCS85 00059 * DTSCS85 00060 * CLEAR: DTSCS85 00061 * DTSCS85 00062 * DATA FIELDS DISPLAYED: NONE. DTSCS85 00063 * MESSAGE: NONE (OTHER THAN "DELETE SUCCESSFUL"). DTSCS85 00064 * MOVE LOW-VALUES TO LCCM-SCR-KEY-AREA. DTSCS85 00065 * DTSCS85 00066 * DTSCS85 00067 * INQUIRY: DTSCS85 00068 * DTSCS85 00069 * CONTROL FIELD(S): FLD-TERRITORY DTSCS85 00070 * DTSCS85 00071 * JUMP IN: USE CLEAR LOGIC. DTSCS85 00072 * DTSCS85 00073 * ENTER: DISPLAY FFAZ RECORD ASSOCIATED WITH THE CONTROL DTSCS85 00074 * FIELDS. DTSCS85 00075 * DTSCS85 00076 * PRIOR: STANDARD PAGING LOGIC, EXCEPT BASED ON USER DTSCS85 00077 * MODIFICATION TO CONTROL FIELDS (RATHER THAN DTSCS85 00078 * EMP-NO). DTSCS85 00079 * DTSCS85 00080 * NEXT: STANDARD PAGING LOGIC, EXCEPT BASED ON USER DTSCS85 00081 * MODIFICATION TO CONTROL FIELDS (RATHER THAN DTSCS85 00082 * EMP-NO). DTSCS85 00083 * DTSCS85 00084 * WHILE PAGING, CONSIDER THE BREAK TO BE A BREAK IN REC-TYPE.DTSCS85 00085 * DO NOT "WRAP" PAGING. DTSCS85 00086 * DTSCS85 00087 * A SUCCESSFUL DISPLAY RESULTS IN STORAGE OF THE DTSCS85 00088 * FFAZ-KEY-AREA OF THE DISPLAYED FFAZ RECORD IN DTSCS85 00089 * LCCM-SCR-KEY-AREA. DTSCS85 00090 * DTSCS85 00091 * DTSCS85 00092 * UPDATE: DTSCS85 00093 * DTSCS85 00094 * ADD DTSCS85 00095 * MOD DTSCS85 00096 * DEL DTSCS85 00097 * DTSCS85 00098 * DTSCS85 00099 * RECORDS READ: DTSCS85 00100 * DTSCS85 00101 * MASTER: DTSCS85 00102 * DTSCS85 00103 * NONE. DTSCS85 00104 * DTSCS85 00105 * DTSCS85 00106 * ALTERNATE INDEX: DTSCS85 00107 * DTSCS85 00108 * NONE. DTSCS85 00109 * DTSCS85 00110 * DTSCS85 00111 * REFERENCE: DTSCS85 00112 * DTSCS85 00113 * FFAZ. DTSCS85 00114 * DTSCS85 00115 * DTSCS85 00116 * ACCOUNTING TRANSACTION COLLECTION: DTSCS85 00117 * DTSCS85 00118 * NONE. DTSCS85 00119 * DTSCS85 00120 * DTSCS85 00121 * RECORDS UPDATED: DTSCS85 00122 * DTSCS85 00123 * MASTER: DTSCS85 00124 * DTSCS85 00125 * NONE. DTSCS85 00126 * DTSCS85 00127 * DTSCS85 00128 * REFERENCE: DTSCS85 00129 * DTSCS85 00130 * FFAZ (ADD, MOD, DEL). DTSCS85 00131 * DTSCS85 00132 * DTSCS85 00133 * ACCOUNTING TRANSACTION COLLECTION: DTSCS85 00134 * DTSCS85 00135 * NONE. DTSCS85 00136 * DTSCS85 00137 * DTSCS85 00138 * ON-LINE EVENT FILE RECORDS WRITTEN: DTSCS85 00139 * DTSCS85 00140 * NONE. DTSCS85 00141 * DTSCS85 00142 * DTSCS85 00143 * MODULES (OTHER THAN STANDARD SCREEN PROCESSING DTSCS85 00144 * UTILITY MODULES) LINKED TO: DTSCS85 00145 * DTSCS85 00146 * DTSCU001 DATE EDIT/CONVERSION. DTSCS85 00147 * DTSCU062 FIELD REP ID EDIT/DESCRIPTION. DTSCS85 00148 * DTSCU831 REFERENCE FILE I/O. DTSCS85 00149 * DTSCS85 00150 * DTSCS85 00151 * MAINTENANCE NOTES: DTSCS85 00152 * DTSCS85 00153 * A NON-KEY FIELD ADDED TO OR REMOVED FROM THE SCREEN DTSCS85 00154 * REQUIRES ATTENTION IN THE FOLLOWING AREAS: DTSCS85 00155 * ALTER PARAGRAPHS P6900, P8900, S5900, DTSCS85 00156 * ALTER AS APPROPRIATE PARAGRAPHS LISTED IN S1002, DTSCS85 00157 * ALTER THE SEND/RECEIVE AREA DEFINITION (DTSIS85), DTSCS85 00158 * ALTER THE MAP (DTSM85) AND ASSEMBLE THE MAPSET (DTSMSET).DTSCS85 00159 * DTSCS85 00160 ***** DTSCS85 00161 SKIP3 DTSCS85 00162 ENVIRONMENT DIVISION. DTSCS85 00163 SKIP3 DTSCS85 00164 DATA DIVISION. DTSCS85 00165 SKIP3 DTSCS85 00166 WORKING-STORAGE SECTION. DTSCS85 001665 77 PAN-VALET PICTURE X(24) VALUE '003DTSCS85 08/29/25'. DTSCS85 00167 77 PAN-VALET PICTURE X(24) VALUE '020DTSCS85 01/28/05'. DTSCS85 00168 SKIP3 DTSCS85 00169 01 WRK-AREA. DTSCS85 00170 05 WRK-ABEND-CD PIC X(04) VALUE 'S85 '. DTSCS85 00171 SKIP1 DTSCS85 00172 05 WRK-SCR-ID. DTSCS85 00173 10 WRK-SCR-ID-9 PIC 9(02) VALUE 85. DTSCS85 00174 05 WRK-F03-SCR-ID PIC X(02) VALUE '80'. DTSCS85 00175 SKIP1 DTSCS85 00176 05 WRK-KEY-AREA. DTSCS85 00177 10 WRK-REC-TYPE PIC S9(04) COMP. DTSCS85 00178 10 WRK-FLD-TERRITORY PIC X(05). DTSCS85 00179 10 FILLER PIC X(09). DTSCS85 00180 SKIP1 DTSCS85 00181 05 WRK-MSG-AREA PIC X(64). DTSCS85 00182 SKIP1 DTSCS85 00183 05 WRK-HOLD-TERRITORY PIC X(05). DTSCS85 00184 SKIP1 DTSCS85 00185 SKIP1 DTSCS85 00186 01 MSG-LITERALS. DTSCS85 00187 05 MSG-E851-AREA. DTSCS85 00188 10 FILLER PIC X(04) VALUE 'E851'. DTSCS85 00189 10 FILLER PIC X(60) DTSCS85 00190 VALUE 'EITHER ONE OR TEN ENTRIES REQUIRED'. DTSCS85 00191 EJECT DTSCS85 00192 01 SCREEN-CONTROL. DTSCS85 00193 05 SCR-ACCESS-IND PIC X(01). DTSCS85 00194 88 SCR-ACCESS-INQ VALUE '1'. DTSCS85 00195 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS85 00196 SKIP1 DTSCS85 00197 05 CURSOR-SET-IND PIC X(01). DTSCS85 00198 88 CURSOR-SET-YES VALUE 'Y'. DTSCS85 00199 88 CURSOR-SET-NO VALUE 'N'. DTSCS85 00200 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS85 00201 SKIP1 DTSCS85 00202 05 REQ-IND PIC X(01). DTSCS85 00203 88 REQ-ERROR VALUE 'O'. DTSCS85 00204 88 REQ-JUMP VALUE 'J'. DTSCS85 00205 88 REQ-INQUIRE VALUE 'I'. DTSCS85 00206 88 REQ-CLEAR VALUE 'C'. DTSCS85 00207 88 REQ-EDIT VALUE 'E'. DTSCS85 00208 88 REQ-UPDATE VALUE 'U'. DTSCS85 00209 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS85 00210 SKIP1 DTSCS85 00211 05 RESP-IND PIC X(01). DTSCS85 00212 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS85 00213 88 RESP-SEND-MAP VALUE 'M'. DTSCS85 00214 88 RESP-JUMP VALUE 'J'. DTSCS85 00215 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS85 00216 SKIP1 DTSCS85 00217 05 SCR-NEW-KEY-IND PIC X(01). DTSCS85 00218 SKIP1 DTSCS85 00219 05 SCR-ATB-AN PIC X(01). DTSCS85 00220 05 SCR-ATB-NUM PIC X(01). DTSCS85 00221 EJECT DTSCS85 00222 *01 LPAM-DUMMY-COMMAREA PIC X(01). CL**2 00223 DTSCS85 00224 *01 LPAM-FUNCTIONS. CL**2 00225 * 05 LPAM-INIT-FUNCTION PIC X(08) VALUE 'INIT '. CL**2 00226 * 05 LPAM-OPEN-FUNCTION PIC X(08) VALUE 'OPEN '. CL**2 00227 * 05 LPAM-GETZIP-FUNCTION PIC X(08) VALUE 'GETZIP '. CL**2 00228 * 05 LPAM-CLOSE-FUNCTION PIC X(08) VALUE 'CLOSE '. CL**2 00229 * 05 LPAM-TERM-FUNCTION PIC X(08) VALUE 'TERM '. CL**2 00230 DTSCS85 00231 *01 LPAM-ANCHOR-AREA PIC X(04). CL**2 00232 DTSCS85 00233 *01 LPAM-RETURN-CODE PIC X(02). CL**2 00234 DTSCS85 00235 *01 LPAM-ERROR-AREA. CL**2 00236 * 05 LPAM-ERROR-MODULE PIC X(08). CL**2 00237 * 05 FILLER PIC X(01). CL**2 00238 * 05 LPAM-ERROR-FUNCTION PIC X(08). CL**2 00239 * 05 FILLER PIC X(01). CL**2 00240 * 05 ERROR-RETURN-CODES. CL**2 00241 * 10 ERROR-RETURN-CODE OCCURS 17 TIMES CL**2 00242 * INDEXED BY ERROR-RETURN-IDX CL**2 00243 * PIC X(01). CL**2 00244 * 05 FILLER PIC X(01). CL**2 00245 * 05 ERROR-MESSAGE PIC X(44). CL**2 00246 DTSCS85 00247 *01 LPAM-STREET-FILE-RCB PIC X(08). CL**2 00248 DTSCS85 00249 *01 LPAM-NAMES. CL**2 00250 * 05 LPAM-MODULE-NAME PIC X(08) VALUE 'LPAMC '. CL**2 00251 * 05 LPAM-PROFILE-NAME PIC X(08) VALUE ' '. CL**2 00252 * 05 LPAM-PRODUCT-NAME PIC X(08) VALUE 'BACCMETH'. CL**2 00253 * 05 LPAM-STREET-FILE-NAME PIC X(08) VALUE 'CBDATA '. CL**2 00254 * 05 LPAM-CITY-FILE-NAME PIC X(08) VALUE 'CBCTYST '. CL**2 00255 DTSCS85 00256 *++INCLUDE LPAM007C CL**2 00257 SKIP3 DTSCS85 00258 *++INCLUDE LPAM008C CL**2 00259 EJECT DTSCS85 00260 01 L001-COMM-AREA. DTSCS85 00261 ++INCLUDE DTSIL001 DTSCS85 00262 EJECT DTSCS85 00263 01 L062-COMM-AREA. DTSCS85 00264 ++INCLUDE DTSIL062 DTSCS85 00265 EJECT DTSCS85 00266 * ERROR MSG MODULE DTSCS85 00267 01 L805-COMM-AREA. DTSCS85 00268 ++INCLUDE DTSIL805 DTSCS85 00269 EJECT DTSCS85 00270 * STATE POSTAL CODES DTSCS85 00271 01 STATE-POSTAL-CODES. DTSCS85 00272 ++INCLUDE DTSIC072 DTSCS85 00273 EJECT DTSCS85 00274 * REFERENCE FILE I-O LINKAGE DTSCS85 00275 01 L831-COMM-AREA. DTSCS85 00276 05 L831-CONTROL-BLOCK. DTSCS85 00277 ++INCLUDE DTSIL831 DTSCS85 00278 EJECT DTSCS85 00279 * COMMON SKELETAL RECORD DTSCS85 00280 05 FCOMM-REC. DTSCS85 00281 ++INCLUDE DTSIFSKL DTSCS85 00282 SKIP3 DTSCS85 00283 * FIELD REP TERRITORY RECORD LAYOUT DTSCS85 00284 05 FFAZ-REC REDEFINES FCOMM-REC. DTSCS85 00285 ++INCLUDE DTSIFFAZ DTSCS85 00286 EJECT DTSCS85 00287 * MAP DEFINITION DTSCS85 00288 01 L851-COMM-AREA. DTSCS85 00289 ++INCLUDE DTSIL851 DTSCS85 00290 SKIP3 DTSCS85 00291 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS85 00292 ++INCLUDE DTSIS85 DTSCS85 00293 EJECT DTSCS85 00294 * ATTRIBUTE LITERALS DTSCS85 00295 01 CATB-LITERALS. DTSCS85 00296 ++INCLUDE DTSICATB DTSCS85 00297 SKIP3 DTSCS85 00298 * FUNCTION KEY DESCRIPTION LITERALS DTSCS85 00299 01 CFKD-LITERALS. DTSCS85 00300 ++INCLUDE DTSICFKD DTSCS85 00301 EJECT DTSCS85 00302 * ERROR CODE MESSAGE LITERALS DTSCS85 00303 01 CECD-LITERALS. DTSCS85 00304 ++INCLUDE DTSICECD DTSCS85 00305 SKIP3 DTSCS85 00306 * PROMPT CODE MESSAGE LITERALS DTSCS85 00307 01 CPCD-LITERALS. DTSCS85 00308 ++INCLUDE DTSICPCD DTSCS85 00309 EJECT DTSCS85 00310 LINKAGE SECTION. DTSCS85 00311 SKIP3 DTSCS85 00312 01 DFHCOMMAREA. DTSCS85 00313 ++INCLUDE DTSILCCM DTSCS85 00314 SKIP3 DTSCS85 00315 15 FILLER REDEFINES LCCM-SCR-HOLD-AREA. DTSCS85 00316 20 LCCM-SCR-KEY-AREA PIC X(16). DTSCS85 00317 EJECT DTSCS85 00318 ******************************************************************DTSCS85 00319 * *DTSCS85 00320 ******************************************************************DTSCS85 00321 SKIP1 DTSCS85 00322 PROCEDURE DIVISION. DTSCS85 00323 SKIP2 DTSCS85 00324 SET CURSOR-SET-NO TO TRUE. DTSCS85 00325 SKIP1 DTSCS85 00326 MOVE LOW-VALUES TO MAP-AREA. DTSCS85 00327 SKIP1 DTSCS85 00328 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-9) DTSCS85 00329 TO SCR-ACCESS-IND. DTSCS85 00330 SKIP3 DTSCS85 00331 MOVE SPACE TO REQ-IND. DTSCS85 00332 SKIP1 DTSCS85 00333 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS85 00334 SKIP1 DTSCS85 00335 *----------------------------------------------------- DTSCS85 00336 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS85 00337 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS85 00338 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS85 00339 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS85 00340 * DTSCS85 00341 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS85 00342 * PROCESSED. DTSCS85 00343 * DTSCS85 00344 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS85 00345 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS85 00346 * WORK STATION OPERATOR. DTSCS85 00347 *----------------------------------------------------- DTSCS85 00348 SKIP1 DTSCS85 00349 MOVE SPACE TO RESP-IND. DTSCS85 00350 SKIP1 DTSCS85 00351 IF REQ-ERROR DTSCS85 00352 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS85 00353 ELSE DTSCS85 00354 IF REQ-JUMP DTSCS85 00355 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS85 00356 ELSE DTSCS85 00357 IF REQ-CLEAR DTSCS85 00358 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS85 00359 ELSE DTSCS85 00360 IF REQ-CURSOR-TO-GOTO DTSCS85 00361 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS85 00362 ELSE DTSCS85 00363 IF REQ-INQUIRE DTSCS85 00364 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS85 00365 ELSE DTSCS85 00366 IF REQ-EDIT DTSCS85 00367 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS85 00368 ELSE DTSCS85 00369 IF REQ-UPDATE DTSCS85 00370 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS85 00371 ELSE DTSCS85 00372 GO TO S899-ABEND. DTSCS85 00373 SKIP3 DTSCS85 00374 *----------------------------------------------------- DTSCS85 00375 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS85 00376 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS85 00377 *----------------------------------------------------- DTSCS85 00378 SKIP1 DTSCS85 00379 IF RESP-SEND-MAP DTSCS85 00380 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS85 00381 SET LCCM-END-TASK-88 TO TRUE DTSCS85 00382 ELSE DTSCS85 00383 IF RESP-SEND-MSGONLY DTSCS85 00384 OR RESP-CURSOR-TO-GOTO DTSCS85 00385 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS85 00386 SET LCCM-END-TASK-88 TO TRUE DTSCS85 00387 ELSE DTSCS85 00388 IF RESP-JUMP DTSCS85 00389 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS85 00390 ELSE DTSCS85 00391 GO TO S899-ABEND. DTSCS85 00392 SKIP3 DTSCS85 00393 MAINLINE-EXIT. DTSCS85 00394 SKIP1 DTSCS85 00395 EXEC CICS DTSCS85 00396 RETURN DTSCS85 00397 END-EXEC. DTSCS85 00398 SKIP2 DTSCS85 00399 * GOBACK. DTSCS85 00400 /*****************************************************************DTSCS85 00401 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS85 00402 ******************************************************************DTSCS85 00403 P1000-ANALYZE-REQUEST. DTSCS85 00404 SKIP1 DTSCS85 00405 *----------------------------------------------------- DTSCS85 00406 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS85 00407 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS85 00408 * REPLACED WITH ENTER) DTSCS85 00409 *----------------------------------------------------- DTSCS85 00410 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS85 00411 SET LCCM-ENTER-88 TO TRUE DTSCS85 00412 SET REQ-CLEAR TO TRUE DTSCS85 00413 GO TO P1000-EXIT. DTSCS85 00414 SKIP3 DTSCS85 00415 *----------------------------------------------------- DTSCS85 00416 * MAP IS RECEIVED DTSCS85 00417 *----------------------------------------------------- DTSCS85 00418 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS85 00419 SKIP3 DTSCS85 00420 *----------------------------------------------------- DTSCS85 00421 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS85 00422 * WORK STATION DTSCS85 00423 *----------------------------------------------------- DTSCS85 00424 IF LCCM-CLEAR-88 DTSCS85 00425 SET REQ-CLEAR TO TRUE DTSCS85 00426 GO TO P1000-EXIT. DTSCS85 00427 SKIP3 DTSCS85 00428 *----------------------------------------------------- DTSCS85 00429 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS85 00430 *----------------------------------------------------- DTSCS85 00431 IF LCCM-SCR-UPDATE-LOCKED DTSCS85 00432 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS85 00433 GO TO P1000-EXIT. DTSCS85 00434 SKIP3 DTSCS85 00435 *----------------------------------------------------- DTSCS85 00436 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS85 00437 *----------------------------------------------------- DTSCS85 00438 IF LCCM-PA2-88 DTSCS85 00439 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS85 00440 GO TO P1000-EXIT. DTSCS85 00441 SKIP3 DTSCS85 00442 *----------------------------------------------------- DTSCS85 00443 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS85 00444 *----------------------------------------------------- DTSCS85 00445 IF LCCM-PA-88 DTSCS85 00446 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS85 00447 SET REQ-ERROR TO TRUE DTSCS85 00448 GO TO P1000-EXIT. DTSCS85 00449 SKIP3 DTSCS85 00450 *----------------------------------------------------- DTSCS85 00451 * F12 PRESSED WHEN UPDATE NOT IN PROGRESS IS A DTSCS85 00452 * REQUEST TO CLEAR THE SCREEN. DTSCS85 00453 *----------------------------------------------------- DTSCS85 00454 IF LCCM-F12-88 DTSCS85 00455 MOVE LOW-VALUES TO MAP-AREA DTSCS85 00456 SET REQ-CLEAR TO TRUE DTSCS85 00457 GO TO P1000-EXIT. DTSCS85 00458 SKIP3 DTSCS85 00459 *----------------------------------------------------- DTSCS85 00460 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS85 00461 *----------------------------------------------------- DTSCS85 00462 IF LCCM-F03-88 DTSCS85 00463 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS85 00464 SET REQ-JUMP TO TRUE DTSCS85 00465 GO TO P1000-EXIT. DTSCS85 00466 SKIP3 DTSCS85 00467 *----------------------------------------------------- DTSCS85 00468 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS85 00469 *----------------------------------------------------- DTSCS85 00470 IF LCCM-F04-88 DTSCS85 00471 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS85 00472 SET REQ-JUMP TO TRUE DTSCS85 00473 GO TO P1000-EXIT. DTSCS85 00474 SKIP3 DTSCS85 00475 *----------------------------------------------------- DTSCS85 00476 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS85 00477 * CORRESPONDENCE SCREEN DTSCS85 00478 *----------------------------------------------------- DTSCS85 00479 IF LCCM-F14-88 DTSCS85 00480 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS85 00481 SET REQ-JUMP TO TRUE DTSCS85 00482 GO TO P1000-EXIT. DTSCS85 00483 SKIP3 DTSCS85 00484 *----------------------------------------------------- DTSCS85 00485 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS85 00486 * REQUESTED SCREEN TYPE DTSCS85 00487 *----------------------------------------------------- DTSCS85 00488 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS85 00489 NEXT SENTENCE DTSCS85 00490 ELSE DTSCS85 00491 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS85 00492 SET REQ-JUMP TO TRUE DTSCS85 00493 GO TO P1000-EXIT. DTSCS85 00494 SKIP3 DTSCS85 00495 *----------------------------------------------------- DTSCS85 00496 * IF REQUEST TO UPDATE THE DATA (ADD, MOD, DEL) DTSCS85 00497 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS85 00498 *----------------------------------------------------- DTSCS85 00499 IF LCCM-F09-88 OR LCCM-F10-88 OR LCCM-F23-88 DTSCS85 00500 IF SCR-ACCESS-UPDATE DTSCS85 00501 SET REQ-EDIT TO TRUE DTSCS85 00502 GO TO P1000-EXIT DTSCS85 00503 ELSE DTSCS85 00504 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS85 00505 SET REQ-ERROR TO TRUE DTSCS85 00506 GO TO P1000-EXIT. DTSCS85 00507 SKIP3 DTSCS85 00508 *----------------------------------------------------- DTSCS85 00509 * IF INQUIRY TYPE KEY PRESSED (ENTER, PAGE DOWN, DTSCS85 00510 * PAGE UP), INDICATE INQUIRY REQUEST DTSCS85 00511 *----------------------------------------------------- DTSCS85 00512 IF LCCM-ENTER-88 OR LCCM-F07-88 OR LCCM-F08-88 DTSCS85 00513 SET REQ-INQUIRE TO TRUE DTSCS85 00514 GO TO P1000-EXIT. DTSCS85 00515 SKIP3 DTSCS85 00516 *----------------------------------------------------- DTSCS85 00517 * ANY OTHER KEY IS INVALID DTSCS85 00518 *----------------------------------------------------- DTSCS85 00519 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS85 00520 SET REQ-ERROR TO TRUE. DTSCS85 00521 P1000-EXIT. DTSCS85 00522 EXIT. DTSCS85 00523 SKIP3 DTSCS85 00524 ******************************************************************DTSCS85 00525 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS85 00526 ******************************************************************DTSCS85 00527 SKIP1 DTSCS85 00528 P1100-UPDATE-LOCKED. DTSCS85 00529 *----------------------------------------------------- DTSCS85 00530 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS85 00531 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCS85 00532 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS85 00533 *----------------------------------------------------- DTSCS85 00534 IF LCCM-ENTER-88 OR LCCM-F12-88 DTSCS85 00535 SET REQ-UPDATE TO TRUE DTSCS85 00536 ELSE DTSCS85 00537 SET REQ-ERROR TO TRUE DTSCS85 00538 IF LCCM-SCR-ADD-LOCKED DTSCS85 00539 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS85 00540 ELSE DTSCS85 00541 IF LCCM-SCR-MOD-LOCKED DTSCS85 00542 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS85 00543 ELSE DTSCS85 00544 IF LCCM-SCR-DEL-LOCKED DTSCS85 00545 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID DTSCS85 00546 ELSE DTSCS85 00547 GO TO S899-ABEND. DTSCS85 00548 P1100-EXIT. DTSCS85 00549 EXIT. DTSCS85 00550 /*****************************************************************DTSCS85 00551 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS85 00552 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS85 00553 ******************************************************************DTSCS85 00554 SKIP1 DTSCS85 00555 P2000-REQUEST-ERROR. DTSCS85 00556 IF LCCM-MSG DTSCS85 00557 SET RESP-SEND-MSGONLY TO TRUE DTSCS85 00558 ELSE DTSCS85 00559 GO TO S899-ABEND. DTSCS85 00560 P2000-EXIT. DTSCS85 00561 EXIT. DTSCS85 00562 /*****************************************************************DTSCS85 00563 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS85 00564 ******************************************************************DTSCS85 00565 SKIP1 DTSCS85 00566 P3000-REQUEST-JUMP. DTSCS85 00567 *----------------------------------------------------- DTSCS85 00568 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS85 00569 * BY USER DTSCS85 00570 *----------------------------------------------------- DTSCS85 00571 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS85 00572 SKIP3 DTSCS85 00573 *----------------------------------------------------- DTSCS85 00574 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS85 00575 *----------------------------------------------------- DTSCS85 00576 IF LCCM-MSG DTSCS85 00577 SET RESP-SEND-MSGONLY TO TRUE DTSCS85 00578 SET CURSOR-SET-GOTO TO TRUE DTSCS85 00579 GO TO P3000-EXIT. DTSCS85 00580 SKIP3 DTSCS85 00581 *----------------------------------------------------- DTSCS85 00582 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS85 00583 *----------------------------------------------------- DTSCS85 00584 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS85 00585 LCCM-SCR-HOLD-AREA. DTSCS85 00586 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS85 00587 SET RESP-JUMP TO TRUE. DTSCS85 00588 P3000-EXIT. DTSCS85 00589 EXIT. DTSCS85 00590 /*****************************************************************DTSCS85 00591 * CLEAR KEY WAS PRESSED *DTSCS85 00592 ******************************************************************DTSCS85 00593 SKIP1 DTSCS85 00594 P4000-REQUEST-CLEAR. DTSCS85 00595 IF SCR-ACCESS-UPDATE DTSCS85 00596 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS85 00597 ELSE DTSCS85 00598 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS85 00599 SKIP3 DTSCS85 00600 *----------------------------------------------------- DTSCS85 00601 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS85 00602 * FIELDS FROM EARLIER REQUESTS DTSCS85 00603 *----------------------------------------------------- DTSCS85 00604 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA. DTSCS85 00605 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS85 00606 SET LCCM-SCR-CLEAR TO TRUE. DTSCS85 00607 SET RESP-SEND-MAP TO TRUE. DTSCS85 00608 P4000-EXIT. DTSCS85 00609 EXIT. DTSCS85 00610 /*****************************************************************DTSCS85 00611 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS85 00612 ******************************************************************DTSCS85 00613 SKIP1 DTSCS85 00614 P5000-CURSOR-TO-GOTO. DTSCS85 00615 SET CURSOR-SET-GOTO TO TRUE. DTSCS85 00616 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS85 00617 P5000-EXIT. DTSCS85 00618 EXIT. DTSCS85 00619 /*****************************************************************DTSCS85 00620 * INQUIRY WAS REQUESTED *DTSCS85 00621 ******************************************************************DTSCS85 00622 SKIP1 DTSCS85 00623 P6000-REQUEST-INQUIRE. DTSCS85 00624 MOVE LOW-VALUES TO FFAZ-KEY-AREA. DTSCS85 00625 SET FFAZ-FAZ-88 TO TRUE. DTSCS85 00626 SKIP1 DTSCS85 00627 MOVE MAP-TERRITORY TO WRK-HOLD-TERRITORY. DTSCS85 00628 MOVE LOW-VALUES TO MAP-AREA. DTSCS85 00629 MOVE WRK-HOLD-TERRITORY TO MAP-TERRITORY. DTSCS85 00630 SKIP1 DTSCS85 00631 INSPECT MAP-TERRITORY CONVERTING LOW-VALUE TO SPACE. DTSCS85 00632 MOVE MAP-TERRITORY TO FFAZ-FLD-TERRITORY. DTSCS85 00633 SKIP1 DTSCS85 00634 IF LCCM-SCR-INQUIRE DTSCS85 00635 AND FFAZ-KEY-AREA = LCCM-SCR-KEY-AREA DTSCS85 00636 MOVE 'N' TO SCR-NEW-KEY-IND DTSCS85 00637 ELSE DTSCS85 00638 MOVE 'Y' TO SCR-NEW-KEY-IND. DTSCS85 00639 SKIP1 DTSCS85 00640 IF SCR-ACCESS-UPDATE DTSCS85 00641 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS85 00642 ELSE DTSCS85 00643 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS85 00644 SKIP1 DTSCS85 00645 SET LCCM-SCR-CLEAR TO TRUE. DTSCS85 00646 MOVE LOW-VALUES TO LCCM-SCR-KEY-AREA. DTSCS85 00647 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS85 00648 SKIP1 DTSCS85 00649 IF LCCM-MSG DTSCS85 00650 NEXT SENTENCE DTSCS85 00651 ELSE DTSCS85 00652 IF LCCM-ENTER-88 DTSCS85 00653 PERFORM P6100-NO-PAGE THRU P6100-EXIT DTSCS85 00654 ELSE DTSCS85 00655 IF LCCM-F07-88 DTSCS85 00656 PERFORM P6200-PAGE-BACK THRU P6200-EXIT DTSCS85 00657 ELSE DTSCS85 00658 IF LCCM-F08-88 DTSCS85 00659 PERFORM P6300-PAGE-NEXT THRU P6300-EXIT DTSCS85 00660 ELSE DTSCS85 00661 GO TO S899-ABEND. DTSCS85 00662 SKIP1 DTSCS85 00663 SET RESP-SEND-MAP TO TRUE. DTSCS85 00664 P6000-EXIT. DTSCS85 00665 EXIT. DTSCS85 00666 EJECT DTSCS85 00667 P6100-NO-PAGE. DTSCS85 00668 IF MAP-TERRITORY = SPACE DTSCS85 00669 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS85 00670 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS85 00671 GO TO P6100-EXIT. DTSCS85 00672 SKIP1 DTSCS85 00673 PERFORM S831-READ THRU S831-EXIT. DTSCS85 00674 IF L831-NO-REC-88 DTSCS85 00675 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS85 00676 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS85 00677 GO TO P6100-EXIT. DTSCS85 00678 SKIP1 DTSCS85 00679 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS85 00680 P6100-EXIT. DTSCS85 00681 EXIT. DTSCS85 00682 EJECT DTSCS85 00683 P6200-PAGE-BACK. DTSCS85 00684 MOVE FFAZ-KEY-AREA TO WRK-KEY-AREA. DTSCS85 00685 PERFORM S831-START-BROWSE THRU S831-EXIT. DTSCS85 00686 IF L831-NO-REC-88 DTSCS85 00687 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS85 00688 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS85 00689 GO TO P6200-EXIT. DTSCS85 00690 SKIP1 DTSCS85 00691 IF (SCR-NEW-KEY-IND = 'Y') DTSCS85 00692 AND DTSCS85 00693 (WRK-KEY-AREA = FFAZ-KEY-AREA) DTSCS85 00694 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS85 00695 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS85 00696 GO TO P6200-EXIT. DTSCS85 00697 SKIP1 DTSCS85 00698 PERFORM S831-READ-PREV THRU S831-EXIT. DTSCS85 00699 IF L831-NO-REC-88 DTSCS85 00700 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS85 00701 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS85 00702 GO TO P6200-EXIT. DTSCS85 00703 SKIP1 DTSCS85 00704 PERFORM S831-READ-PREV THRU S831-EXIT. DTSCS85 00705 IF L831-NO-REC-88 DTSCS85 00706 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS85 00707 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-ID DTSCS85 00708 ELSE DTSCS85 00709 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS85 00710 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS85 00711 P6200-EXIT. DTSCS85 00712 EXIT. DTSCS85 00713 EJECT DTSCS85 00714 P6300-PAGE-NEXT. DTSCS85 00715 MOVE FFAZ-KEY-AREA TO WRK-KEY-AREA. DTSCS85 00716 PERFORM S831-START-BROWSE THRU S831-EXIT. DTSCS85 00717 IF L831-NO-REC-88 DTSCS85 00718 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS85 00719 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS85 00720 GO TO P6300-EXIT. DTSCS85 00721 SKIP1 DTSCS85 00722 IF (SCR-NEW-KEY-IND = 'N') DTSCS85 00723 AND DTSCS85 00724 (WRK-KEY-AREA = FFAZ-KEY-AREA) DTSCS85 00725 NEXT SENTENCE DTSCS85 00726 ELSE DTSCS85 00727 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS85 00728 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS85 00729 GO TO P6300-EXIT. DTSCS85 00730 SKIP1 DTSCS85 00731 PERFORM S831-READ-NEXT THRU S831-EXIT. DTSCS85 00732 IF L831-NO-REC-88 DTSCS85 00733 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS85 00734 MOVE PMSG-LAST-PAGE TO LCCM-MSG-ID DTSCS85 00735 ELSE DTSCS85 00736 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS85 00737 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS85 00738 P6300-EXIT. DTSCS85 00739 EXIT. DTSCS85 00740 /*****************************************************************DTSCS85 00741 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCS85 00742 ******************************************************************DTSCS85 00743 SKIP1 DTSCS85 00744 P6900-CONSTRUCT-SCREEN. DTSCS85 00745 MOVE FFAZ-FLD-TERRITORY TO MAP-TERRITORY. DTSCS85 00746 SKIP1 DTSCS85 00747 IF FFAZ-SINGLE-REP DTSCS85 00748 MOVE FFAZ-FLD-REP-ID (1) TO MAP-REP-ID (1) DTSCS85 00749 MOVE LOW-VALUE TO MAP-REP-ID (2) DTSCS85 00750 MAP-REP-ID (3) DTSCS85 00751 MAP-REP-ID (4) DTSCS85 00752 MAP-REP-ID (5) DTSCS85 00753 MAP-REP-ID (6) DTSCS85 00754 MAP-REP-ID (7) DTSCS85 00755 MAP-REP-ID (8) DTSCS85 00756 MAP-REP-ID (9) DTSCS85 00757 MAP-REP-ID (10) DTSCS85 00758 ELSE DTSCS85 00759 MOVE FFAZ-FLD-REP-ID (1) TO MAP-REP-ID (1) DTSCS85 00760 MOVE FFAZ-FLD-REP-ID (2) TO MAP-REP-ID (2) DTSCS85 00761 MOVE FFAZ-FLD-REP-ID (3) TO MAP-REP-ID (3) DTSCS85 00762 MOVE FFAZ-FLD-REP-ID (4) TO MAP-REP-ID (4) DTSCS85 00763 MOVE FFAZ-FLD-REP-ID (5) TO MAP-REP-ID (5) DTSCS85 00764 MOVE FFAZ-FLD-REP-ID (6) TO MAP-REP-ID (6) DTSCS85 00765 MOVE FFAZ-FLD-REP-ID (7) TO MAP-REP-ID (7) DTSCS85 00766 MOVE FFAZ-FLD-REP-ID (8) TO MAP-REP-ID (8) DTSCS85 00767 MOVE FFAZ-FLD-REP-ID (9) TO MAP-REP-ID (9) DTSCS85 00768 MOVE FFAZ-FLD-REP-ID (10) TO MAP-REP-ID (10). DTSCS85 00769 SKIP1 DTSCS85 00770 IF FFAZ-ESTB-DATE NOT = +0 DTSCS85 00771 MOVE FFAZ-ESTB-DATE TO L001-FED-8-DATE-9 DTSCS85 00772 SET L001-FROM-FED-8 TO TRUE DTSCS85 00773 PERFORM S001-DATE THRU S001-EXIT DTSCS85 00774 MOVE L001-SLASH-DATE TO MAP-ESTB-DATE. DTSCS85 00775 SKIP1 DTSCS85 00776 IF FFAZ-CHNG-DATE NOT = +0 DTSCS85 00777 MOVE FFAZ-CHNG-DATE TO L001-FED-8-DATE-9 DTSCS85 00778 SET L001-FROM-FED-8 TO TRUE DTSCS85 00779 PERFORM S001-DATE THRU S001-EXIT DTSCS85 00780 MOVE L001-SLASH-DATE TO MAP-CHNG-DATE. DTSCS85 00781 SKIP1 DTSCS85 00782 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS85 00783 MOVE FFAZ-KEY-AREA TO LCCM-SCR-KEY-AREA. DTSCS85 00784 P6900-EXIT. DTSCS85 00785 EXIT. DTSCS85 00786 /*****************************************************************DTSCS85 00787 * FUNCTION KEY WAS PRESSED TO ADD, MOD OR DEL THE RECORD. *DTSCS85 00788 ******************************************************************DTSCS85 00789 SKIP1 DTSCS85 00790 P7000-REQUEST-EDIT. DTSCS85 00791 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS85 00792 SKIP1 DTSCS85 00793 IF LCCM-F09-88 DTSCS85 00794 PERFORM P7100-EDIT-ADD THRU P7100-EXIT DTSCS85 00795 ELSE DTSCS85 00796 IF LCCM-F10-88 DTSCS85 00797 PERFORM P7200-EDIT-MOD THRU P7200-EXIT DTSCS85 00798 ELSE DTSCS85 00799 IF LCCM-F23-88 DTSCS85 00800 PERFORM P7300-EDIT-DEL THRU P7300-EXIT DTSCS85 00801 ELSE DTSCS85 00802 GO TO S899-ABEND. DTSCS85 00803 SKIP3 DTSCS85 00804 *------------------------------------------------------ DTSCS85 00805 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCS85 00806 * IN ORDER TO CONTINUE TO ATTEMPT AN ADD THE SCREEN MUST REMAIN DTSCS85 00807 * IN A 'CLEAR' STATE. THE SCREEN MUST BE IN 'INQUIRE' STATUS DTSCS85 00808 * IF MOD OR DEL FUNCTIONS ARE BEING REQUESTED. DTSCS85 00809 *------------------------------------------------------ DTSCS85 00810 SKIP1 DTSCS85 00811 IF LCCM-MSG DTSCS85 00812 NEXT SENTENCE DTSCS85 00813 ELSE DTSCS85 00814 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCS85 00815 IF LCCM-F09-88 DTSCS85 00816 SET LCCM-SCR-ADD-LOCKED TO TRUE DTSCS85 00817 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS85 00818 ELSE DTSCS85 00819 IF LCCM-F10-88 DTSCS85 00820 SET LCCM-SCR-MOD-LOCKED TO TRUE DTSCS85 00821 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS85 00822 ELSE DTSCS85 00823 IF LCCM-F23-88 DTSCS85 00824 SET LCCM-SCR-DEL-LOCKED TO TRUE DTSCS85 00825 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID. DTSCS85 00826 SKIP1 DTSCS85 00827 SET RESP-SEND-MAP TO TRUE. DTSCS85 00828 P7000-EXIT. DTSCS85 00829 EXIT. DTSCS85 00830 /*****************************************************************DTSCS85 00831 * ADD FUNCTION WAS REQUESTED *DTSCS85 00832 ******************************************************************DTSCS85 00833 SKIP1 DTSCS85 00834 P7100-EDIT-ADD. DTSCS85 00835 *------------------------------------------------------ DTSCS85 00836 * ADD REQUIRES THAT THE SCREEN WAS IN THE CLEAR STATE DTSCS85 00837 *------------------------------------------------------ DTSCS85 00838 IF NOT LCCM-SCR-CLEAR DTSCS85 00839 MOVE EMSG-ADD-PRECEDED TO LCCM-MSG-ID DTSCS85 00840 GO TO P7100-EXIT. DTSCS85 00841 SKIP1 DTSCS85 00842 PERFORM S1001-SCREEN-KEY-EDITS THRU S1001-EXIT. DTSCS85 00843 SKIP1 DTSCS85 00844 IF LCCM-NO-MSG DTSCS85 00845 PERFORM S8010-READ-FFAZ THRU S8010-EXIT DTSCS85 00846 IF L831-OK-88 DTSCS85 00847 MOVE EMSG-RECORD-EXISTS TO WRK-MSG-AREA DTSCS85 00848 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS85 00849 ELSE DTSCS85 00850 PERFORM S1002-SCREEN-DATA-EDITS THRU S1002-EXIT. DTSCS85 00851 P7100-EXIT. DTSCS85 00852 EXIT. DTSCS85 00853 /*****************************************************************DTSCS85 00854 * MODIFICATION FUNCTION WAS REQUESTED *DTSCS85 00855 ******************************************************************DTSCS85 00856 SKIP1 DTSCS85 00857 P7200-EDIT-MOD. DTSCS85 00858 *----------------------------------------------------- DTSCS85 00859 * MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS85 00860 * INQUIRED DTSCS85 00861 *----------------------------------------------------- DTSCS85 00862 IF NOT LCCM-SCR-INQUIRE DTSCS85 00863 MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-ID DTSCS85 00864 GO TO P7200-EXIT. DTSCS85 00865 SKIP3 DTSCS85 00866 *----------------------------------------------------- DTSCS85 00867 * CONTROL FIELD(S) MAY NOT BE CHANGED DURING THE MOD DTSCS85 00868 *----------------------------------------------------- DTSCS85 00869 MOVE LCCM-SCR-KEY-AREA TO WRK-KEY-AREA. DTSCS85 00870 IF MAP-TERRITORY NOT = WRK-FLD-TERRITORY DTSCS85 00871 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS85 00872 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS85 00873 GO TO P7200-EXIT. DTSCS85 00874 SKIP1 DTSCS85 00875 PERFORM S1001-SCREEN-KEY-EDITS THRU S1001-EXIT. DTSCS85 00876 SKIP1 DTSCS85 00877 IF LCCM-NO-MSG DTSCS85 00878 PERFORM S8010-READ-FFAZ THRU S8010-EXIT DTSCS85 00879 IF L831-NO-REC-88 DTSCS85 00880 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS85 00881 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS85 00882 ELSE DTSCS85 00883 PERFORM S1002-SCREEN-DATA-EDITS THRU S1002-EXIT. DTSCS85 00884 P7200-EXIT. DTSCS85 00885 EXIT. DTSCS85 00886 /*****************************************************************DTSCS85 00887 * DELETE FUNCTION WAS REQUESTED *DTSCS85 00888 ******************************************************************DTSCS85 00889 SKIP1 DTSCS85 00890 P7300-EDIT-DEL. DTSCS85 00891 *----------------------------------------------------- DTSCS85 00892 * DELETE REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS85 00893 * INQUIRED DTSCS85 00894 *----------------------------------------------------- DTSCS85 00895 IF NOT LCCM-SCR-INQUIRE DTSCS85 00896 MOVE EMSG-DEL-PRECEDED TO LCCM-MSG-ID DTSCS85 00897 GO TO P7300-EXIT. DTSCS85 00898 SKIP3 DTSCS85 00899 *----------------------------------------------------- DTSCS85 00900 * CONTROL FIELD(S) MAY NOT BE CHANGED DURING A DELETE DTSCS85 00901 *----------------------------------------------------- DTSCS85 00902 MOVE LCCM-SCR-KEY-AREA TO WRK-KEY-AREA. DTSCS85 00903 IF MAP-TERRITORY NOT = WRK-FLD-TERRITORY DTSCS85 00904 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS85 00905 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS85 00906 GO TO P7300-EXIT. DTSCS85 00907 SKIP1 DTSCS85 00908 IF LCCM-NO-MSG DTSCS85 00909 PERFORM S8010-READ-FFAZ THRU S8010-EXIT DTSCS85 00910 IF L831-NO-REC-88 DTSCS85 00911 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS85 00912 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS85 00913 P7300-EXIT. DTSCS85 00914 EXIT. DTSCS85 00915 /*****************************************************************DTSCS85 00916 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED *DTSCS85 00917 ******************************************************************DTSCS85 00918 SKIP1 DTSCS85 00919 P8000-REQUEST-UPDATE. DTSCS85 00920 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS85 00921 SKIP1 DTSCS85 00922 IF LCCM-SCR-ADD-LOCKED DTSCS85 00923 PERFORM P8100-ADD THRU P8100-EXIT DTSCS85 00924 ELSE DTSCS85 00925 IF LCCM-SCR-MOD-LOCKED DTSCS85 00926 PERFORM P8200-MOD THRU P8200-EXIT DTSCS85 00927 ELSE DTSCS85 00928 IF LCCM-SCR-DEL-LOCKED DTSCS85 00929 PERFORM P8300-DEL THRU P8300-EXIT DTSCS85 00930 ELSE DTSCS85 00931 GO TO S899-ABEND. DTSCS85 00932 SKIP1 DTSCS85 00933 SET RESP-SEND-MAP TO TRUE. DTSCS85 00934 P8000-EXIT. DTSCS85 00935 EXIT. DTSCS85 00936 /*****************************************************************DTSCS85 00937 * *DTSCS85 00938 ******************************************************************DTSCS85 00939 SKIP1 DTSCS85 00940 P8100-ADD. DTSCS85 00941 SET LCCM-SCR-CLEAR TO TRUE. DTSCS85 00942 SKIP1 DTSCS85 00943 IF LCCM-F12-88 DTSCS85 00944 MOVE PMSG-ADD-CANCELED TO LCCM-MSG-ID DTSCS85 00945 GO TO P8100-EXIT. DTSCS85 00946 SKIP1 DTSCS85 00947 PERFORM S8010-READ-FFAZ THRU S8010-EXIT. DTSCS85 00948 IF L831-OK-88 DTSCS85 00949 MOVE EMSG-RECORD-EXISTS TO WRK-MSG-AREA DTSCS85 00950 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS85 00951 GO TO P8100-EXIT. DTSCS85 00952 SKIP1 DTSCS85 00953 MOVE LOW-VALUES TO FFAZ-DATA-AREA. DTSCS85 00954 SKIP1 DTSCS85 00955 PERFORM P8900-CONSTRUCT-FFAZ THRU P8900-EXIT. DTSCS85 00956 SKIP1 DTSCS85 00957 MOVE LCCM-CURR-RUN-DATE TO FFAZ-ESTB-DATE. DTSCS85 00958 MOVE LCCM-CURR-RUN-DATE TO FFAZ-CHNG-DATE. DTSCS85 00959 SKIP1 DTSCS85 00960 PERFORM S831-WRITE THRU S831-EXIT. DTSCS85 00961 SKIP1 DTSCS85 00962 MOVE LOW-VALUES TO MAP-AREA. DTSCS85 00963 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS85 00964 MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS85 00965 P8100-EXIT. DTSCS85 00966 EXIT. DTSCS85 00967 /*****************************************************************DTSCS85 00968 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS85 00969 ******************************************************************DTSCS85 00970 SKIP1 DTSCS85 00971 P8200-MOD. DTSCS85 00972 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS85 00973 SKIP1 DTSCS85 00974 IF LCCM-F12-88 DTSCS85 00975 MOVE PMSG-MOD-CANCELED TO LCCM-MSG-ID DTSCS85 00976 GO TO P8200-EXIT. DTSCS85 00977 SKIP1 DTSCS85 00978 PERFORM S8010-READ-FFAZ THRU S8010-EXIT. DTSCS85 00979 IF L831-NO-REC-88 DTSCS85 00980 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS85 00981 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS85 00982 GO TO P8200-EXIT. DTSCS85 00983 SKIP1 DTSCS85 00984 PERFORM P8900-CONSTRUCT-FFAZ THRU P8900-EXIT. DTSCS85 00985 SKIP1 DTSCS85 00986 MOVE LCCM-CURR-RUN-DATE TO FFAZ-CHNG-DATE. DTSCS85 00987 SKIP1 DTSCS85 00988 PERFORM S831-REWRITE THRU S831-EXIT. DTSCS85 00989 SKIP1 DTSCS85 00990 MOVE FFAZ-CHNG-DATE TO L001-FED-8-DATE-9. DTSCS85 00991 SET L001-FROM-FED-8 TO TRUE. DTSCS85 00992 PERFORM S001-DATE THRU S001-EXIT. DTSCS85 00993 MOVE L001-SLASH-DATE TO MAP-CHNG-DATE. DTSCS85 00994 SKIP1 DTSCS85 00995 MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS85 00996 P8200-EXIT. DTSCS85 00997 EXIT. DTSCS85 00998 /*****************************************************************DTSCS85 00999 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS85 01000 ******************************************************************DTSCS85 01001 SKIP1 DTSCS85 01002 P8300-DEL. DTSCS85 01003 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS85 01004 SKIP1 DTSCS85 01005 IF LCCM-F12-88 DTSCS85 01006 MOVE PMSG-DEL-CANCELED TO LCCM-MSG-ID DTSCS85 01007 GO TO P8300-EXIT. DTSCS85 01008 SKIP1 DTSCS85 01009 PERFORM S8010-READ-FFAZ THRU S8010-EXIT. DTSCS85 01010 IF NOT L831-OK-88 DTSCS85 01011 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS85 01012 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS85 01013 GO TO P8300-EXIT. DTSCS85 01014 SKIP1 DTSCS85 01015 PERFORM S831-DELETE THRU S831-EXIT. DTSCS85 01016 SKIP1 DTSCS85 01017 MOVE LOW-VALUES TO LCCM-SCR-KEY-AREA. DTSCS85 01018 SET LCCM-SCR-CLEAR TO TRUE. DTSCS85 01019 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS85 01020 SKIP1 DTSCS85 01021 MOVE LOW-VALUES TO MAP-AREA. DTSCS85 01022 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS85 01023 SKIP1 DTSCS85 01024 MOVE FFAZ-FLD-TERRITORY TO MAP-TERRITORY. DTSCS85 01025 SKIP1 DTSCS85 01026 MOVE PMSG-DEL-SUCCESSFUL TO LCCM-MSG-ID. DTSCS85 01027 P8300-EXIT. DTSCS85 01028 EXIT. DTSCS85 01029 EJECT DTSCS85 01030 P8900-CONSTRUCT-FFAZ. DTSCS85 01031 SKIP1 DTSCS85 01032 MOVE MAP-REP-ID (1) TO FFAZ-FLD-REP-ID (1). DTSCS85 01033 SKIP1 DTSCS85 01034 IF MAP-REP-ID (2) = LOW-VALUE DTSCS85 01035 SET FFAZ-SINGLE-REP TO TRUE DTSCS85 01036 MOVE LOW-VALUE TO FFAZ-FLD-REP-ID (2) DTSCS85 01037 FFAZ-FLD-REP-ID (3) DTSCS85 01038 FFAZ-FLD-REP-ID (4) DTSCS85 01039 FFAZ-FLD-REP-ID (5) DTSCS85 01040 FFAZ-FLD-REP-ID (6) DTSCS85 01041 FFAZ-FLD-REP-ID (7) DTSCS85 01042 FFAZ-FLD-REP-ID (8) DTSCS85 01043 FFAZ-FLD-REP-ID (9) DTSCS85 01044 FFAZ-FLD-REP-ID (10) DTSCS85 01045 ELSE DTSCS85 01046 SET FFAZ-MULTIPLE-REPS TO TRUE DTSCS85 01047 MOVE MAP-REP-ID (2) TO FFAZ-FLD-REP-ID (2) DTSCS85 01048 MOVE MAP-REP-ID (3) TO FFAZ-FLD-REP-ID (3) DTSCS85 01049 MOVE MAP-REP-ID (4) TO FFAZ-FLD-REP-ID (4) DTSCS85 01050 MOVE MAP-REP-ID (5) TO FFAZ-FLD-REP-ID (5) DTSCS85 01051 MOVE MAP-REP-ID (6) TO FFAZ-FLD-REP-ID (6) DTSCS85 01052 MOVE MAP-REP-ID (7) TO FFAZ-FLD-REP-ID (7) DTSCS85 01053 MOVE MAP-REP-ID (8) TO FFAZ-FLD-REP-ID (8) DTSCS85 01054 MOVE MAP-REP-ID (9) TO FFAZ-FLD-REP-ID (9) DTSCS85 01055 MOVE MAP-REP-ID (10) TO FFAZ-FLD-REP-ID (10). DTSCS85 01056 SKIP1 DTSCS85 01057 P8900-EXIT. DTSCS85 01058 EXIT. DTSCS85 01059 /*****************************************************************DTSCS85 01060 * LINKS TO UTILITY MODULES DTSCS85 01061 ******************************************************************DTSCS85 01062 SKIP1 DTSCS85 01063 S001-DATE. DTSCS85 01064 EXEC CICS LINK DTSCS85 01065 PROGRAM ('DTSCU001') DTSCS85 01066 COMMAREA (L001-COMM-AREA) DTSCS85 01067 END-EXEC. DTSCS85 01068 S001-EXIT. DTSCS85 01069 EXIT. DTSCS85 01070 SKIP3 DTSCS85 01071 S062-READ-REP. DTSCS85 01072 EXEC CICS LINK DTSCS85 01073 PROGRAM ('DTSCU062') DTSCS85 01074 COMMAREA (L062-COMM-AREA) DTSCS85 01075 END-EXEC. DTSCS85 01076 SKIP1 DTSCS85 01077 IF L062-FILE-CLOSED DTSCS85 01078 MOVE L062-MSG-AREA TO LCCM-MSG-AREA DTSCS85 01079 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS85 01080 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS85 01081 GO TO MAINLINE-EXIT. DTSCS85 01082 S062-EXIT. DTSCS85 01083 EXIT. DTSCS85 01084 EJECT DTSCS85 01085 S803-REQ-SCR-ID-EDIT. DTSCS85 01086 EXEC CICS LINK DTSCS85 01087 PROGRAM ('DTSCU803') DTSCS85 01088 COMMAREA (DFHCOMMAREA) DTSCS85 01089 END-EXEC. DTSCS85 01090 S803-EXIT. DTSCS85 01091 EXIT. DTSCS85 01092 SKIP3 DTSCS85 01093 S804-INVALID-KEY. DTSCS85 01094 EXEC CICS LINK DTSCS85 01095 PROGRAM ('DTSCU804') DTSCS85 01096 COMMAREA (DFHCOMMAREA) DTSCS85 01097 END-EXEC. DTSCS85 01098 S804-EXIT. DTSCS85 01099 EXIT. DTSCS85 01100 SKIP3 DTSCS85 01101 S805-MSG-AREA. DTSCS85 01102 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS85 01103 SKIP1 DTSCS85 01104 EXEC CICS LINK DTSCS85 01105 PROGRAM ('DTSCU805') DTSCS85 01106 COMMAREA (L805-COMM-AREA) DTSCS85 01107 END-EXEC. DTSCS85 01108 SKIP1 DTSCS85 01109 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS85 01110 S805-EXIT. DTSCS85 01111 EXIT. DTSCS85 01112 EJECT DTSCS85 01113 S831-READ. DTSCS85 01114 SET L831-READ-88 TO TRUE. DTSCS85 01115 GO TO S831-IO. DTSCS85 01116 SKIP1 DTSCS85 01117 S831-START-BROWSE. DTSCS85 01118 SET L831-START-BROWSE-88 TO TRUE. DTSCS85 01119 GO TO S831-IO. DTSCS85 01120 SKIP1 DTSCS85 01121 S831-READ-NEXT. DTSCS85 01122 SET L831-READ-NEXT-88 TO TRUE. DTSCS85 01123 GO TO S831-IO. DTSCS85 01124 SKIP1 DTSCS85 01125 S831-READ-PREV. DTSCS85 01126 SET L831-READ-PREV-88 TO TRUE. DTSCS85 01127 GO TO S831-IO. DTSCS85 01128 SKIP1 DTSCS85 01129 S831-END-BROWSE. DTSCS85 01130 SET L831-END-BROWSE-88 TO TRUE. DTSCS85 01131 GO TO S831-IO. DTSCS85 01132 SKIP1 DTSCS85 01133 S831-REWRITE. DTSCS85 01134 SET L831-REWRITE-88 TO TRUE. DTSCS85 01135 GO TO S831-IO. DTSCS85 01136 SKIP1 DTSCS85 01137 S831-WRITE. DTSCS85 01138 SET L831-WRITE-88 TO TRUE. DTSCS85 01139 GO TO S831-IO. DTSCS85 01140 SKIP1 DTSCS85 01141 S831-DELETE. DTSCS85 01142 SET L831-DELETE-88 TO TRUE. DTSCS85 01143 GO TO S831-IO. DTSCS85 01144 SKIP1 DTSCS85 01145 S831-IO. DTSCS85 01146 SKIP1 DTSCS85 01147 EXEC CICS LINK DTSCS85 01148 PROGRAM ('DTSCU831') DTSCS85 01149 COMMAREA (L831-COMM-AREA) DTSCS85 01150 END-EXEC. DTSCS85 01151 SKIP1 DTSCS85 01152 IF L831-FILE-CLOSED-88 DTSCS85 01153 MOVE L831-MSG-AREA TO LCCM-MSG-AREA DTSCS85 01154 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS85 01155 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS85 01156 GO TO MAINLINE-EXIT. DTSCS85 01157 S831-EXIT. DTSCS85 01158 EXIT. DTSCS85 01159 SKIP3 DTSCS85 01160 S851-SCREEN-PROCESSING. DTSCS85 01161 EXEC CICS LINK DTSCS85 01162 PROGRAM ('DTSCU851') DTSCS85 01163 COMMAREA (L851-COMM-AREA) DTSCS85 01164 END-EXEC. DTSCS85 01165 S851-EXIT. DTSCS85 01166 EXIT. DTSCS85 01167 SKIP3 DTSCS85 01168 S899-ABEND. DTSCS85 01169 EXEC CICS ABEND DTSCS85 01170 ABCODE(WRK-ABEND-CD) DTSCS85 01171 END-EXEC. DTSCS85 01172 *S899-EXIT. DTSCS85 01173 * EXIT. DTSCS85 01174 /*****************************************************************DTSCS85 01175 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS85 01176 ******************************************************************DTSCS85 01177 SKIP1 DTSCS85 01178 S1001-SCREEN-KEY-EDITS. DTSCS85 01179 SKIP1 DTSCS85 01180 PERFORM S1100-TERRITORY THRU S1100-EXIT. DTSCS85 01181 SKIP1 DTSCS85 01182 S1001-EXIT. DTSCS85 01183 EXIT. DTSCS85 01184 SKIP3 DTSCS85 01185 S1002-SCREEN-DATA-EDITS. DTSCS85 01186 SKIP1 DTSCS85 01187 PERFORM S1210-REP-1 THRU S1210-EXIT. DTSCS85 01188 PERFORM S1220-REP-2 THRU S1220-EXIT. DTSCS85 01189 PERFORM S1230-REP-REST THRU S1230-EXIT DTSCS85 01190 VARYING MAP-IDX FROM 3 BY 1 DTSCS85 01191 UNTIL MAP-IDX GREATER THAN 10. DTSCS85 01192 SKIP1 DTSCS85 01193 S1002-EXIT. DTSCS85 01194 EXIT. DTSCS85 01195 EJECT DTSCS85 01196 S1100-TERRITORY. DTSCS85 01197 INSPECT MAP-TERRITORY CONVERTING LOW-VALUE TO SPACE. DTSCS85 01198 IF MAP-TERRITORY = SPACE DTSCS85 01199 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS85 01200 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS85 01201 ELSE DTSCS85 01202 IF MAP-TERRITORY NUMERIC DTSCS85 01203 NEXT SENTENCE DTSCS85 01204 ELSE DTSCS85 01205 MOVE MAP-TERRITORY TO C072-ST DTSCS85 01206 IF C072-US-88 OR C072-CANADA-88 DTSCS85 01207 NEXT SENTENCE DTSCS85 01208 ELSE DTSCS85 01209 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS85 01210 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS85 01211 S1100-EXIT. DTSCS85 01212 EXIT. DTSCS85 01213 SKIP3 DTSCS85 01214 S1101-ERROR. DTSCS85 01215 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-TERRITORY-A. DTSCS85 01216 IF LCCM-NO-MSG DTSCS85 01217 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS85 01218 MOVE CATB-CURSOR TO MAP-TERRITORY-L DTSCS85 01219 SET CURSOR-SET-YES TO TRUE. DTSCS85 01220 S1101-EXIT. DTSCS85 01221 EXIT. DTSCS85 01222 EJECT DTSCS85 01223 S1210-REP-1. DTSCS85 01224 SET MAP-IDX TO +1. DTSCS85 01225 PERFORM S1211-VERIFY THRU S1211-EXIT. DTSCS85 01226 S1210-EXIT. DTSCS85 01227 EXIT. DTSCS85 01228 SKIP3 DTSCS85 01229 S1211-VERIFY. DTSCS85 01230 MOVE MAP-REP-ID (MAP-IDX) TO L062-FLD-REP-ID. DTSCS85 01231 PERFORM S062-READ-REP THRU S062-EXIT. DTSCS85 01232 IF L062-NOT-VALID DTSCS85 01233 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS85 01234 PERFORM S1291-ERROR THRU S1291-EXIT DTSCS85 01235 GO TO S1211-EXIT. DTSCS85 01236 IF L062-FIELD-DESK-88 OR L062-DEFAULT-FLD-REP-88 DTSCS85 01237 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS85 01238 PERFORM S1291-ERROR THRU S1291-EXIT. DTSCS85 01239 S1211-EXIT. DTSCS85 01240 EXIT. DTSCS85 01241 SKIP3 DTSCS85 01242 S1220-REP-2. DTSCS85 01243 INSPECT MAP-REP-ID (2) CONVERTING SPACE TO LOW-VALUE. DTSCS85 01244 IF MAP-REP-ID (2) NOT = LOW-VALUE DTSCS85 01245 SET MAP-IDX TO +2 DTSCS85 01246 PERFORM S1211-VERIFY THRU S1211-EXIT. DTSCS85 01247 S1220-EXIT. DTSCS85 01248 EXIT. DTSCS85 01249 SKIP3 DTSCS85 01250 S1230-REP-REST. DTSCS85 01251 INSPECT MAP-REP-ID (MAP-IDX) CONVERTING SPACE TO LOW-VALUE. DTSCS85 01252 IF MAP-REP-ID (MAP-IDX) NOT = MAP-REP-ID (2) DTSCS85 01253 IF MAP-REP-ID (MAP-IDX) = LOW-VALUE DTSCS85 01254 OR MAP-REP-ID (2) = LOW-VALUE DTSCS85 01255 MOVE MSG-E851-AREA TO WRK-MSG-AREA DTSCS85 01256 PERFORM S1291-ERROR THRU S1291-EXIT DTSCS85 01257 ELSE DTSCS85 01258 PERFORM S1211-VERIFY THRU S1211-EXIT. DTSCS85 01259 S1230-EXIT. DTSCS85 01260 EXIT. DTSCS85 01261 SKIP3 DTSCS85 01262 S1291-ERROR. DTSCS85 01263 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-REP-ID-A (MAP-IDX). DTSCS85 01264 IF LCCM-NO-MSG DTSCS85 01265 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS85 01266 MOVE CATB-CURSOR TO MAP-REP-ID-L (MAP-IDX) DTSCS85 01267 SET CURSOR-SET-YES TO TRUE. DTSCS85 01268 S1291-EXIT. DTSCS85 01269 EXIT. DTSCS85 01270 EJECT DTSCS85 01271 /*****************************************************************DTSCS85 01272 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCS85 01273 ******************************************************************DTSCS85 01274 S5100-SET-LOCK-ATTRB. DTSCS85 01275 MOVE CATB-ASKIP-BRT-MDTON TO SCR-ATB-AN DTSCS85 01276 SCR-ATB-NUM. DTSCS85 01277 SKIP1 DTSCS85 01278 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS85 01279 SKIP1 DTSCS85 01280 MOVE CATB-ASKIP-BRT-MDTON TO MAP-TERRITORY-A DTSCS85 01281 MAP-GOTO-A. DTSCS85 01282 S5100-EXIT. DTSCS85 01283 EXIT. DTSCS85 01284 SKIP3 DTSCS85 01285 ******************************************************************DTSCS85 01286 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS85 01287 ******************************************************************DTSCS85 01288 S5200-SET-UPDATE-ATTRB. DTSCS85 01289 MOVE CATB-UNPROT-BRT-AN-MDTON TO SCR-ATB-AN. DTSCS85 01290 MOVE CATB-UNPROT-BRT-NUM-MDTON TO SCR-ATB-NUM. DTSCS85 01291 SKIP1 DTSCS85 01292 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS85 01293 S5200-EXIT. DTSCS85 01294 EXIT. DTSCS85 01295 SKIP3 DTSCS85 01296 ******************************************************************DTSCS85 01297 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS85 01298 ******************************************************************DTSCS85 01299 S5300-SET-INQ-ATTRB. DTSCS85 01300 MOVE CATB-ASKIP-BRT-MDTOFF TO SCR-ATB-AN DTSCS85 01301 SCR-ATB-NUM. DTSCS85 01302 SKIP1 DTSCS85 01303 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS85 01304 S5300-EXIT. DTSCS85 01305 EXIT. DTSCS85 01306 SKIP3 DTSCS85 01307 ******************************************************************DTSCS85 01308 * DO IT *DTSCS85 01309 ******************************************************************DTSCS85 01310 S5900-SET-ATTRB. DTSCS85 01311 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-TERRITORY-A. DTSCS85 01312 SKIP1 DTSCS85 01313 MOVE CATB-ASKIP-NORM-MDTON TO MAP-TERRITORY-DESC-A. DTSCS85 01314 SKIP1 DTSCS85 01315 MOVE SCR-ATB-AN TO MAP-REP-ID-A (1) DTSCS85 01316 MAP-REP-ID-A (2) DTSCS85 01317 MAP-REP-ID-A (3) DTSCS85 01318 MAP-REP-ID-A (4) DTSCS85 01319 MAP-REP-ID-A (5) DTSCS85 01320 MAP-REP-ID-A (6) DTSCS85 01321 MAP-REP-ID-A (7) DTSCS85 01322 MAP-REP-ID-A (8) DTSCS85 01323 MAP-REP-ID-A (9) DTSCS85 01324 MAP-REP-ID-A (10). DTSCS85 01325 SKIP1 DTSCS85 01326 MOVE CATB-ASKIP-BRT-MDTON TO MAP-ESTB-DATE-A DTSCS85 01327 MAP-CHNG-DATE-A. DTSCS85 01328 SKIP1 DTSCS85 01329 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS85 01330 S5900-EXIT. DTSCS85 01331 EXIT. DTSCS85 01332 /*****************************************************************DTSCS85 01333 * READ PREPARATION ROUTINES *DTSCS85 01334 ******************************************************************DTSCS85 01335 S8010-READ-FFAZ. DTSCS85 01336 MOVE LOW-VALUES TO FFAZ-KEY-AREA. DTSCS85 01337 SET FFAZ-FAZ-88 TO TRUE. DTSCS85 01338 MOVE MAP-TERRITORY TO FFAZ-FLD-TERRITORY. DTSCS85 01339 PERFORM S831-READ THRU S831-EXIT. DTSCS85 01340 S8010-EXIT. DTSCS85 01341 EXIT. DTSCS85 01342 /*****************************************************************DTSCS85 01343 * MAP ROUTINES *DTSCS85 01344 ******************************************************************DTSCS85 01345 S9100-RECEIVE. DTSCS85 01346 SET L851-RECEIVE-88 TO TRUE. DTSCS85 01347 SKIP1 DTSCS85 01348 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS85 01349 SKIP1 DTSCS85 01350 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS85 01351 SKIP1 DTSCS85 01352 MOVE L851-AID TO LCCM-AID. DTSCS85 01353 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS85 01354 S9100-EXIT. DTSCS85 01355 EXIT. DTSCS85 01356 SKIP3 DTSCS85 01357 S9200-SEND-DATAONLY. DTSCS85 01358 MOVE LOW-VALUES TO MAP-AREA. DTSCS85 01359 SKIP1 DTSCS85 01360 IF LCCM-NO-MSG DTSCS85 01361 NEXT SENTENCE DTSCS85 01362 ELSE DTSCS85 01363 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS85 01364 SKIP1 DTSCS85 01365 IF CURSOR-SET-GOTO DTSCS85 01366 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS85 01367 ELSE DTSCS85 01368 MOVE CATB-CURSOR TO MAP-TERRITORY-L. DTSCS85 01369 SKIP1 DTSCS85 01370 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS85 01371 SKIP1 DTSCS85 01372 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS85 01373 SKIP1 DTSCS85 01374 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS85 01375 S9200-EXIT. DTSCS85 01376 EXIT. DTSCS85 01377 SKIP3 DTSCS85 01378 S9300-SEND-MAP. DTSCS85 01379 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS85 01380 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS85 01381 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS85 01382 SKIP1 DTSCS85 01383 IF SCR-ACCESS-UPDATE DTSCS85 01384 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS85 01385 ELSE DTSCS85 01386 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS85 01387 SKIP1 DTSCS85 01388 PERFORM S9331-DSCR-TERRITORY THRU S9331-EXIT. CL**3 01389 SKIP1 DTSCS85 01390 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS85 01391 SKIP1 DTSCS85 01392 IF CURSOR-SET-NO DTSCS85 01393 MOVE CATB-CURSOR TO MAP-TERRITORY-L. DTSCS85 01394 SKIP1 DTSCS85 01395 SET L851-SEND-88 TO TRUE. DTSCS85 01396 SKIP1 DTSCS85 01397 PERFORM S9800-NAME-FILL THRU S9800-EXIT DTSCS85 01398 VARYING MAP-IDX FROM 1 BY 1 DTSCS85 01399 UNTIL MAP-IDX GREATER THAN 10. DTSCS85 01400 SKIP1 DTSCS85 01401 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS85 01402 SKIP1 DTSCS85 01403 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS85 01404 S9300-EXIT. DTSCS85 01405 EXIT. DTSCS85 01406 SKIP3 DTSCS85 01407 S9310-UPDATE-FKEYS. DTSCS85 01408 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS85 01409 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS85 01410 MOVE CFKD-ADD TO MAP-KEY-ADD. DTSCS85 01411 MOVE CFKD-MOD TO MAP-KEY-MOD. DTSCS85 01412 MOVE CFKD-DEL TO MAP-KEY-DEL. DTSCS85 01413 SKIP1 DTSCS85 01414 IF LCCM-SCR-CLEAR DTSCS85 01415 MOVE LOW-VALUES TO MAP-KEY-MOD DTSCS85 01416 MAP-KEY-DEL DTSCS85 01417 ELSE DTSCS85 01418 IF LCCM-SCR-UPDATE-LOCKED DTSCS85 01419 MOVE LOW-VALUES TO MAP-KEY-BACK DTSCS85 01420 MAP-KEY-FWRD DTSCS85 01421 MAP-KEY-ADD DTSCS85 01422 MAP-KEY-MOD DTSCS85 01423 MAP-KEY-DEL DTSCS85 01424 ELSE DTSCS85 01425 MOVE LOW-VALUES TO MAP-KEY-ADD. DTSCS85 01426 S9310-EXIT. DTSCS85 01427 EXIT. DTSCS85 01428 SKIP3 DTSCS85 01429 S9320-INQUIRY-FKEYS. DTSCS85 01430 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS85 01431 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS85 01432 MOVE LOW-VALUES TO MAP-KEY-ADD DTSCS85 01433 MAP-KEY-MOD DTSCS85 01434 MAP-KEY-DEL. DTSCS85 01435 S9320-EXIT. DTSCS85 01436 EXIT. DTSCS85 01437 EJECT DTSCS85 01438 S9331-DSCR-TERRITORY. DTSCS85 01439 * IF MAP-TERRITORY = SPACE OR LOW-VALUE DTSCS85 01440 IF MAP-TERRITORY NOT NUMERIC DTSCS85 01441 MOVE SPACE TO MAP-TERRITORY-DESC DTSCS85 01442 GO TO S9331-EXIT. DTSCS85 01443 DTSCS85 01444 DTSCS85 01445 * MOVE ALL '?' TO MAP-TERRITORY-DESC. CL**3 01446 DTSCS85 01447 S9331-EXIT. CL**3 01448 EXIT. CL**3 01449 S9800-NAME-FILL. DTSCS85 01450 IF MAP-REP-ID (MAP-IDX) = LOW-VALUE DTSCS85 01451 MOVE LOW-VALUE TO MAP-REP-NAME (MAP-IDX) DTSCS85 01452 ELSE DTSCS85 01453 MOVE MAP-REP-ID (MAP-IDX) TO L062-FLD-REP-ID DTSCS85 01454 PERFORM S062-READ-REP THRU S062-EXIT DTSCS85 01455 MOVE L062-NAME TO MAP-REP-NAME (MAP-IDX). DTSCS85 01456 S9800-EXIT. DTSCS85 01457 EXIT. DTSCS85 01458 SKIP3 DTSCS85 01459 S9900-PREPARE-SEND. DTSCS85 01460 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS85 01461 LCCM-SCR-ID. DTSCS85 01462 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS85 01463 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS85 01464 S9900-EXIT. DTSCS85 01465 EXIT. DTSCS85