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