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