1506 lines
118 KiB
COBOL
1506 lines
118 KiB
COBOL
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
|