2418 lines
189 KiB
COBOL
2418 lines
189 KiB
COBOL
00001 IDENTIFICATION DIVISION. 07/18/00
|
|
00002 PROGRAM-ID. DTSCS88. DTSCS88
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LV001
|
|
00004 DATE-WRITTEN. SEPTEMBER 1998. DTSCS88
|
|
00005 DATE-COMPILED. DTSCS88
|
|
00006 DTSCS88
|
|
00007 DTSCS88
|
|
00008 ***** DTSCS88
|
|
00009 * DTSCS88
|
|
00010 * FUNCTION: FISCAL AGENT INQUIRY/UPDATE DTSCS88
|
|
00011 * SCREEN PROCESSOR. DTSCS88
|
|
00012 * DTSCS88
|
|
00013 * DTSCS88
|
|
00014 * MODIFICATION LOG: DTSCS88
|
|
00015 * DTSCS88
|
|
00016 * 06/12/2000 INITIAL DEVELOPMENT. MODIFIED FROM DTSCS7A. DTSCS88
|
|
00017 * REFERENCE RFP: PROGRAMMER: ZL1 DTSCS88
|
|
00018 * DTSCS88
|
|
00019 * XX/XX/XXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS88
|
|
00020 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS88
|
|
00021 * RERFERENCE RFP: #**** PROGRAMMER: XXX DTSCS88
|
|
00022 * DTSCS88
|
|
00023 * DTSCS88
|
|
00024 * DESCRIPTION: DTSCS88
|
|
00025 * DTSCS88
|
|
00026 * DTSCS88
|
|
00027 * CLEAR: DTSCS88
|
|
00028 * DTSCS88
|
|
00029 * FIELD(S) DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO). DTSCS88
|
|
00030 * DTSCS88
|
|
00031 * DTSCS88
|
|
00032 * DTSCS88
|
|
00033 * INQUIRY: DTSCS88
|
|
00034 * DTSCS88
|
|
00035 * CONTROL FIELD(S): MAP-EMP-NO. DTSCS88
|
|
00036 * DTSCS88
|
|
00037 * JUMP IN: DISPLAY DATA ASSOCIATED WITH LCCM-EMP-NO. DTSCS88
|
|
00038 * DTSCS88
|
|
00039 * ENTER: DISPLAY DATA ASSOCIATED WITH MAP-EMP-NO. DTSCS88
|
|
00040 * DTSCS88
|
|
00041 * STANDARD LCCM-EMP-NO MAINTENANCE. DTSCS88
|
|
00042 * DTSCS88
|
|
00043 * DTSCS88
|
|
00044 * UPDATE: DTSCS88
|
|
00045 * DTSCS88
|
|
00046 * ADD: F9 DTSCS88
|
|
00047 * MOD: F10 DTSCS88
|
|
00048 * DELETE: F23 DTSCS88
|
|
00049 * DTSCS88
|
|
00050 * DTSCS88
|
|
00051 * RECORDS READ: DTSCS88
|
|
00052 * DTSCS88
|
|
00053 * MASTER: DTSCS88
|
|
00054 * DTSCS88
|
|
00055 * MPRF. DTSCS88
|
|
00056 * FFIS. DTSCS88
|
|
00057 * DTSCS88
|
|
00058 * DTSCS88
|
|
00059 * ALTERNATE INDEX: DTSCS88
|
|
00060 * DTSCS88
|
|
00061 * NONE. DTSCS88
|
|
00062 * DTSCS88
|
|
00063 * DTSCS88
|
|
00064 * REFERENCE: DTSCS88
|
|
00065 * DTSCS88
|
|
00066 * NONE. DTSCS88
|
|
00067 * DTSCS88
|
|
00068 * DTSCS88
|
|
00069 * ACCOUNTING TRANSACTION COLLECTION: DTSCS88
|
|
00070 * DTSCS88
|
|
00071 * NONE. DTSCS88
|
|
00072 * DTSCS88
|
|
00073 * DTSCS88
|
|
00074 * RECORDS UPDATED: DTSCS88
|
|
00075 * DTSCS88
|
|
00076 * MASTER: DTSCS88
|
|
00077 * DTSCS88
|
|
00078 * NONE. DTSCS88
|
|
00079 * DTSCS88
|
|
00080 * DTSCS88
|
|
00081 * REFERENCE: DTSCS88
|
|
00082 * DTSCS88
|
|
00083 * FFIS (ADD, REWRITE, DELETE). DTSCS88
|
|
00084 * DTSCS88
|
|
00085 * DTSCS88
|
|
00086 * ACCOUNTING TRANSACTION COLLECTION: DTSCS88
|
|
00087 * DTSCS88
|
|
00088 * NONE. DTSCS88
|
|
00089 * DTSCS88
|
|
00090 * DTSCS88
|
|
00091 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCS88
|
|
00092 * DTSCS88
|
|
00093 * NONE. DTSCS88
|
|
00094 * DTSCS88
|
|
00095 * DTSCS88
|
|
00096 * TEMPORARY STORAGE USAGE: DTSCS88
|
|
00097 * DTSCS88
|
|
00098 * NONE. DTSCS88
|
|
00099 * DTSCS88
|
|
00100 * DTSCS88
|
|
00101 * MODULES LINKED TO: DTSCS88
|
|
00102 * DTSCS88
|
|
00103 * DTSCU001 DATE CONVERSION. DTSCS88
|
|
00104 * DTSCU004 YRQ CONVERSION. DTSCS88
|
|
00105 * DTSCU018 EMP NO FROM SCREEN FORMAT/EDIT. DTSCS88
|
|
00106 * DTSCU021 TELEPHONE NUMBER FROM SCREEN FORMAT/EDIT. DTSCS88
|
|
00107 * DTSCU072 ADDRESS EDIT. DTSCS88
|
|
00108 * DTSCU073 TELEPHONE NUMBER EDIT. DTSCS88
|
|
00109 * DTSCU221 MAINTENANCE OF PRF UPDATE FIELDS. DTSCS88
|
|
00110 * DTSCU805 BUILD SCREEN MESSAGE LINE. DTSCS88
|
|
00111 * DTSCU810 MASTER FILE I/O DRIVER. DTSCS88
|
|
00112 * DTSCU831 REFERENCE FILE I/O DRIVER. DTSCS88
|
|
00113 * DTSCS88
|
|
00114 * DTSCS88
|
|
00115 * MAINTENANCE NOTES: DTSCS88
|
|
00116 * DTSCS88
|
|
00117 * A NON-KEY FIELD ADDED TO OR REMOVED FROM THE SCREEN DTSCS88
|
|
00118 * REQUIRES ATTENTION IN THE FOLLOWING AREAS: DTSCS88
|
|
00119 * ALTER PARAGRAPHS P6910/P6920, P8912, S5900 DTSCS88
|
|
00120 * ALTER AS APPROPRIATE PARAGRAPHS LISTED IN S1002 DTSCS88
|
|
00121 * ALTER THE SEND/RECEIVE AREA DEFINITION (DTSIS7A) DTSCS88
|
|
00122 * ALTER THE MAP (DTSM7A) AND ASSEMBLE THE MAPSET (DTSMSET) DTSCS88
|
|
00123 * DTSCS88
|
|
00124 ***** DTSCS88
|
|
00125 SKIP3 DTSCS88
|
|
00126 ENVIRONMENT DIVISION. DTSCS88
|
|
00127 SKIP3 DTSCS88
|
|
00128 DATA DIVISION. DTSCS88
|
|
00129 SKIP3 DTSCS88
|
|
00130 WORKING-STORAGE SECTION. DTSCS88
|
|
001305 77 PAN-VALET PICTURE X(24) VALUE '001DTSCS88 07/18/00'. DTSCS88
|
|
00131 SKIP3 DTSCS88
|
|
00132 01 WRK-AREA. DTSCS88
|
|
00133 05 WRK-ABEND-CD PIC X(04) VALUE 'S88 '. DTSCS88
|
|
00134 DTSCS88
|
|
00135 05 WRK-SCR-ID. DTSCS88
|
|
00136 10 WRK-SCR-ID-9 PIC 9(02) VALUE 88. DTSCS88
|
|
00137 DTSCS88
|
|
00138 05 WRK-F03-SCR-ID PIC X(02) VALUE '80'. DTSCS88
|
|
00139 DTSCS88
|
|
00140 05 WRK-TEXT-CNT-HOLD PIC S9(04) COMP. DTSCS88
|
|
00141 DTSCS88
|
|
00142 05 WRK-KEY-AREA. DTSCS88
|
|
00143 10 WRK-KEY-REC-TYPE PIC S9(04) COMP. DTSCS88
|
|
00144 10 WRK-KEY-FA-CD PIC X(03). DTSCS88
|
|
00145 10 WRK-KEY-FA-TYPE PIC X(02). DTSCS88
|
|
00146 10 FILLER PIC X(09). DTSCS88
|
|
00147 DTSCS88
|
|
00148 05 WRK-MAP-KEY-AREA. DTSCS88
|
|
00149 10 WRK-MAP-FA-CD PIC X(03). DTSCS88
|
|
00150 10 WRK-MAP-FA-TYPE PIC X(02). DTSCS88
|
|
00151 DTSCS88
|
|
00152 05 WRK-YRQ PIC 9(05). DTSCS88
|
|
00153 DTSCS88
|
|
00154 05 WRK-MSG-AREA PIC X(62). DTSCS88
|
|
00155 DTSCS88
|
|
00156 05 WRK-FFIS-IND PIC X(01). DTSCS88
|
|
00157 88 WRK-FFIS-YES-88 VALUE 'Y'. DTSCS88
|
|
00158 88 WRK-FFIS-NO-88 VALUE 'N'. DTSCS88
|
|
00159 DTSCS88
|
|
00160 05 WRK-FIS-ADDRESS-INFO. DTSCS88
|
|
00161 10 WRK-MAP-ADDR-IND PIC X(01). DTSCS88
|
|
00162 88 WRK-MAP-ADDR-BLANK VALUE '0'. DTSCS88
|
|
00163 88 WRK-MAP-ADDR-HAS-DATA VALUE '1'. DTSCS88
|
|
00164 10 HOLD-ATTRB-AREA. DTSCS88
|
|
00165 15 HOLD-ATTN-A PIC X(01). DTSCS88
|
|
00166 15 HOLD-DLV1-A PIC X(01). DTSCS88
|
|
00167 15 HOLD-DLV2-A PIC X(01). DTSCS88
|
|
00168 15 HOLD-CITY-A PIC X(01). DTSCS88
|
|
00169 15 HOLD-STAT-A PIC X(01). DTSCS88
|
|
00170 15 HOLD-ZIPC-A PIC X(01). DTSCS88
|
|
00171 DTSCS88
|
|
00172 05 WRK-FFIS-PHONE-NUMBERS. DTSCS88
|
|
00173 10 WRK-FFIS-PHONE. DTSCS88
|
|
00174 15 WRK-FFIS-PHONE-A-CD PIC X(03). DTSCS88
|
|
00175 15 WRK-FFIS-PHONE-PREF PIC X(03). DTSCS88
|
|
00176 15 WRK-FFIS-PHONE-SUFF PIC X(04). DTSCS88
|
|
00177 15 WRK-FFIS-PHONE-EXT PIC X(05). DTSCS88
|
|
00178 EJECT DTSCS88
|
|
00179 01 SCREEN-CONTROL. DTSCS88
|
|
00180 05 SCR-ACCESS-IND PIC X(01). DTSCS88
|
|
00181 88 SCR-ACCESS-INQ VALUE '1'. DTSCS88
|
|
00182 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS88
|
|
00183 DTSCS88
|
|
00184 05 CURSOR-SET-IND PIC X(01). DTSCS88
|
|
00185 88 CURSOR-SET-YES VALUE 'Y'. DTSCS88
|
|
00186 88 CURSOR-SET-NO VALUE 'N'. DTSCS88
|
|
00187 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS88
|
|
00188 DTSCS88
|
|
00189 05 REQ-IND PIC X(01). DTSCS88
|
|
00190 88 REQ-ERROR VALUE 'O'. DTSCS88
|
|
00191 88 REQ-JUMP VALUE 'J'. DTSCS88
|
|
00192 88 REQ-INQUIRE VALUE 'I'. DTSCS88
|
|
00193 88 REQ-CLEAR VALUE 'C'. DTSCS88
|
|
00194 88 REQ-EDIT VALUE 'E'. DTSCS88
|
|
00195 88 REQ-UPDATE VALUE 'U'. DTSCS88
|
|
00196 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS88
|
|
00197 DTSCS88
|
|
00198 05 RESP-IND PIC X(01). DTSCS88
|
|
00199 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS88
|
|
00200 88 RESP-SEND-MAP VALUE 'M'. DTSCS88
|
|
00201 88 RESP-JUMP VALUE 'J'. DTSCS88
|
|
00202 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS88
|
|
00203 DTSCS88
|
|
00204 05 SCR-NEW-KEY-IND PIC X(01). DTSCS88
|
|
00205 DTSCS88
|
|
00206 05 SCR-ATB-AN PIC X(01). DTSCS88
|
|
00207 DTSCS88
|
|
00208 05 SCR-ATB-NUM PIC X(01). DTSCS88
|
|
00209 EJECT DTSCS88
|
|
00210 01 MSG-LITERALS. DTSCS88
|
|
00211 05 MSG-E883-AREA. DTSCS88
|
|
00212 10 FILLER PIC X(04) VALUE 'E883'. DTSCS88
|
|
00213 10 FILLER PIC X(40) DTSCS88
|
|
00214 VALUE 'DISK SIZE NOT ALLOWED FOR MEDIA = C, R O'. DTSCS88
|
|
00215 10 FILLER PIC X(20) DTSCS88
|
|
00216 VALUE 'R I '. DTSCS88
|
|
00217 DTSCS88
|
|
00218 05 MSG-E884-AREA. DTSCS88
|
|
00219 10 FILLER PIC X(04) VALUE 'E884'. DTSCS88
|
|
00220 10 FILLER PIC X(40) DTSCS88
|
|
00221 VALUE 'DISK SIZE INCOMPATIBLE WITH MEDIA TYPE '. DTSCS88
|
|
00222 10 FILLER PIC X(20) DTSCS88
|
|
00223 VALUE ' '. DTSCS88
|
|
00224 DTSCS88
|
|
00225 05 MSG-E885-AREA. DTSCS88
|
|
00226 10 FILLER PIC X(04) VALUE 'E885'. DTSCS88
|
|
00227 10 FILLER PIC X(40) DTSCS88
|
|
00228 VALUE 'DISK SIZE INVALID '. DTSCS88
|
|
00229 10 FILLER PIC X(20) DTSCS88
|
|
00230 VALUE ' '. DTSCS88
|
|
00231 DTSCS88
|
|
00232 EJECT DTSCS88
|
|
00233 01 L001-COMM-AREA. DTSCS88
|
|
00234 ++INCLUDE DTSIL001 DTSCS88
|
|
00235 EJECT DTSCS88
|
|
00236 01 L004-COMM-AREA. DTSCS88
|
|
00237 ++INCLUDE DTSIL004 DTSCS88
|
|
00238 EJECT DTSCS88
|
|
00239 01 L018-COMM-AREA. DTSCS88
|
|
00240 ++INCLUDE DTSIL018 DTSCS88
|
|
00241 EJECT DTSCS88
|
|
00242 01 L021-COMM-AREA. DTSCS88
|
|
00243 ++INCLUDE DTSIL021 DTSCS88
|
|
00244 EJECT DTSCS88
|
|
00245 01 L072-COMM-AREA. DTSCS88
|
|
00246 ++INCLUDE DTSIL072 DTSCS88
|
|
00247 EJECT DTSCS88
|
|
00248 01 L073-COMM-AREA. DTSCS88
|
|
00249 ++INCLUDE DTSIL073 DTSCS88
|
|
00250 EJECT DTSCS88
|
|
00251 01 L221-COMM-AREA. DTSCS88
|
|
00252 ++INCLUDE DTSIL221 DTSCS88
|
|
00253 EJECT DTSCS88
|
|
00254 01 L805-COMM-AREA. DTSCS88
|
|
00255 ++INCLUDE DTSIL805 DTSCS88
|
|
00256 EJECT DTSCS88
|
|
00257 01 L831-COMM-AREA. DTSCS88
|
|
00258 05 L831-CONTROL-BLOCK. DTSCS88
|
|
00259 ++INCLUDE DTSIL831 DTSCS88
|
|
00260 EJECT DTSCS88
|
|
00261 05 FCOMM-REC. DTSCS88
|
|
00262 ++INCLUDE DTSIFSKL DTSCS88
|
|
00263 EJECT DTSCS88
|
|
00264 05 FFIS-REC REDEFINES FCOMM-REC. DTSCS88
|
|
00265 ++INCLUDE DTSIFFIS DTSCS88
|
|
00266 EJECT DTSCS88
|
|
00267 DTSCS88
|
|
00268 * MAP DEFINITION DTSCS88
|
|
00269 01 L851-COMM-AREA. DTSCS88
|
|
00270 ++INCLUDE DTSIL851 DTSCS88
|
|
00271 SKIP3 DTSCS88
|
|
00272 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS88
|
|
00273 ++INCLUDE DTSIS88 DTSCS88
|
|
00274 EJECT DTSCS88
|
|
00275 01 CATB-LITERALS. DTSCS88
|
|
00276 ++INCLUDE DTSICATB DTSCS88
|
|
00277 SKIP3 DTSCS88
|
|
00278 01 CFKD-LITERALS. DTSCS88
|
|
00279 ++INCLUDE DTSICFKD DTSCS88
|
|
00280 EJECT DTSCS88
|
|
00281 01 CECD-LITERALS. DTSCS88
|
|
00282 ++INCLUDE DTSICECD DTSCS88
|
|
00283 SKIP3 DTSCS88
|
|
00284 01 CPCD-LITERALS. DTSCS88
|
|
00285 ++INCLUDE DTSICPCD DTSCS88
|
|
00286 EJECT DTSCS88
|
|
00287 LINKAGE SECTION. DTSCS88
|
|
00288 SKIP3 DTSCS88
|
|
00289 01 DFHCOMMAREA. DTSCS88
|
|
00290 ++INCLUDE DTSILCCM DTSCS88
|
|
00291 SKIP3 DTSCS88
|
|
00292 15 FILLER REDEFINES LCCM-SCR-HOLD-AREA. DTSCS88
|
|
00293 20 LCCM-HOLD-ADDRESS PIC X(171). DTSCS88
|
|
00294 20 LCCM-SCR-KEY-AREA PIC X(16). DTSCS88
|
|
00295 EJECT DTSCS88
|
|
00296 ******************************************************************DTSCS88
|
|
00297 * *DTSCS88
|
|
00298 ******************************************************************DTSCS88
|
|
00299 DTSCS88
|
|
00300 PROCEDURE DIVISION. DTSCS88
|
|
00301 SKIP2 DTSCS88
|
|
00302 DTSCS88
|
|
00303 SET CURSOR-SET-NO TO TRUE. DTSCS88
|
|
00304 DTSCS88
|
|
00305 MOVE LOW-VALUES TO MAP-AREA. DTSCS88
|
|
00306 DTSCS88
|
|
00307 SET SCR-ACCESS-INQ TO TRUE. DTSCS88
|
|
00308 DTSCS88
|
|
00309 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-9) DTSCS88
|
|
00310 TO SCR-ACCESS-IND. DTSCS88
|
|
00311 DTSCS88
|
|
00312 MOVE SPACE TO REQ-IND. DTSCS88
|
|
00313 DTSCS88
|
|
00314 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS88
|
|
00315 DTSCS88
|
|
00316 DTSCS88
|
|
00317 *----------------------------------------------------- DTSCS88
|
|
00318 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS88
|
|
00319 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS88
|
|
00320 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS88
|
|
00321 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS88
|
|
00322 * DTSCS88
|
|
00323 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS88
|
|
00324 * PROCESSED. DTSCS88
|
|
00325 * DTSCS88
|
|
00326 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS88
|
|
00327 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS88
|
|
00328 * WORK STATION OPERATOR. DTSCS88
|
|
00329 *----------------------------------------------------- DTSCS88
|
|
00330 DTSCS88
|
|
00331 MOVE SPACE TO RESP-IND. DTSCS88
|
|
00332 DTSCS88
|
|
00333 IF REQ-ERROR DTSCS88
|
|
00334 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS88
|
|
00335 ELSE DTSCS88
|
|
00336 IF REQ-JUMP DTSCS88
|
|
00337 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS88
|
|
00338 ELSE DTSCS88
|
|
00339 IF REQ-CLEAR DTSCS88
|
|
00340 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS88
|
|
00341 ELSE DTSCS88
|
|
00342 IF REQ-CURSOR-TO-GOTO DTSCS88
|
|
00343 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS88
|
|
00344 ELSE DTSCS88
|
|
00345 IF REQ-INQUIRE DTSCS88
|
|
00346 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS88
|
|
00347 ELSE DTSCS88
|
|
00348 IF REQ-EDIT DTSCS88
|
|
00349 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS88
|
|
00350 ELSE DTSCS88
|
|
00351 IF REQ-UPDATE DTSCS88
|
|
00352 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS88
|
|
00353 ELSE DTSCS88
|
|
00354 GO TO S899-ABEND. DTSCS88
|
|
00355 DTSCS88
|
|
00356 DTSCS88
|
|
00357 *----------------------------------------------------- DTSCS88
|
|
00358 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS88
|
|
00359 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS88
|
|
00360 *----------------------------------------------------- DTSCS88
|
|
00361 DTSCS88
|
|
00362 IF RESP-SEND-MAP DTSCS88
|
|
00363 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS88
|
|
00364 SET LCCM-END-TASK-88 TO TRUE DTSCS88
|
|
00365 ELSE DTSCS88
|
|
00366 IF RESP-SEND-MSGONLY DTSCS88
|
|
00367 OR RESP-CURSOR-TO-GOTO DTSCS88
|
|
00368 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS88
|
|
00369 SET LCCM-END-TASK-88 TO TRUE DTSCS88
|
|
00370 ELSE DTSCS88
|
|
00371 IF RESP-JUMP DTSCS88
|
|
00372 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS88
|
|
00373 ELSE DTSCS88
|
|
00374 GO TO S899-ABEND. DTSCS88
|
|
00375 DTSCS88
|
|
00376 DTSCS88
|
|
00377 MAINLINE-EXIT. DTSCS88
|
|
00378 DTSCS88
|
|
00379 EXEC CICS DTSCS88
|
|
00380 RETURN DTSCS88
|
|
00381 END-EXEC. DTSCS88
|
|
00382 DTSCS88
|
|
00383 DTSCS88
|
|
00384 GOBACK. DTSCS88
|
|
00385 EJECT DTSCS88
|
|
00386 /*****************************************************************DTSCS88
|
|
00387 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS88
|
|
00388 ******************************************************************DTSCS88
|
|
00389 DTSCS88
|
|
00390 P1000-ANALYZE-REQUEST. DTSCS88
|
|
00391 DTSCS88
|
|
00392 *----------------------------------------------------- DTSCS88
|
|
00393 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS88
|
|
00394 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS88
|
|
00395 * REPLACED WITH ENTER) DTSCS88
|
|
00396 *----------------------------------------------------- DTSCS88
|
|
00397 DTSCS88
|
|
00398 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS88
|
|
00399 SET LCCM-ENTER-88 TO TRUE DTSCS88
|
|
00400 SET REQ-INQUIRE TO TRUE DTSCS88
|
|
00401 GO TO P1000-EXIT. DTSCS88
|
|
00402 DTSCS88
|
|
00403 DTSCS88
|
|
00404 *----------------------------------------------------- DTSCS88
|
|
00405 * MAP IS RECEIVED DTSCS88
|
|
00406 *----------------------------------------------------- DTSCS88
|
|
00407 DTSCS88
|
|
00408 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS88
|
|
00409 DTSCS88
|
|
00410 DTSCS88
|
|
00411 *----------------------------------------------------- DTSCS88
|
|
00412 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS88
|
|
00413 * WORK STATION DTSCS88
|
|
00414 *----------------------------------------------------- DTSCS88
|
|
00415 DTSCS88
|
|
00416 IF LCCM-CLEAR-88 DTSCS88
|
|
00417 SET REQ-CLEAR TO TRUE DTSCS88
|
|
00418 GO TO P1000-EXIT. DTSCS88
|
|
00419 DTSCS88
|
|
00420 DTSCS88
|
|
00421 *----------------------------------------------------- DTSCS88
|
|
00422 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS88
|
|
00423 *----------------------------------------------------- DTSCS88
|
|
00424 DTSCS88
|
|
00425 IF LCCM-SCR-UPDATE-LOCKED DTSCS88
|
|
00426 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS88
|
|
00427 GO TO P1000-EXIT. DTSCS88
|
|
00428 DTSCS88
|
|
00429 DTSCS88
|
|
00430 *----------------------------------------------------- DTSCS88
|
|
00431 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS88
|
|
00432 *----------------------------------------------------- DTSCS88
|
|
00433 DTSCS88
|
|
00434 IF LCCM-PA2-88 DTSCS88
|
|
00435 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS88
|
|
00436 GO TO P1000-EXIT. DTSCS88
|
|
00437 DTSCS88
|
|
00438 DTSCS88
|
|
00439 *----------------------------------------------------- DTSCS88
|
|
00440 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS88
|
|
00441 *----------------------------------------------------- DTSCS88
|
|
00442 DTSCS88
|
|
00443 IF LCCM-PA-88 DTSCS88
|
|
00444 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS88
|
|
00445 SET REQ-ERROR TO TRUE DTSCS88
|
|
00446 GO TO P1000-EXIT. DTSCS88
|
|
00447 DTSCS88
|
|
00448 DTSCS88
|
|
00449 *----------------------------------------------------- DTSCS88
|
|
00450 * F12 PRESSED WHEN UPDATE NOT IN PROGRESS IS A DTSCS88
|
|
00451 * REQUEST TO CLEAR THE SCREEN DTSCS88
|
|
00452 *----------------------------------------------------- DTSCS88
|
|
00453 DTSCS88
|
|
00454 IF LCCM-F12-88 DTSCS88
|
|
00455 MOVE LOW-VALUES TO MAP-AREA DTSCS88
|
|
00456 SET REQ-CLEAR TO TRUE DTSCS88
|
|
00457 GO TO P1000-EXIT. DTSCS88
|
|
00458 DTSCS88
|
|
00459 DTSCS88
|
|
00460 *----------------------------------------------------- DTSCS88
|
|
00461 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS88
|
|
00462 *----------------------------------------------------- DTSCS88
|
|
00463 DTSCS88
|
|
00464 IF LCCM-F03-88 DTSCS88
|
|
00465 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS88
|
|
00466 SET REQ-JUMP TO TRUE DTSCS88
|
|
00467 GO TO P1000-EXIT. DTSCS88
|
|
00468 DTSCS88
|
|
00469 DTSCS88
|
|
00470 *----------------------------------------------------- DTSCS88
|
|
00471 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS88
|
|
00472 *----------------------------------------------------- DTSCS88
|
|
00473 DTSCS88
|
|
00474 IF LCCM-F04-88 DTSCS88
|
|
00475 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS88
|
|
00476 SET REQ-JUMP TO TRUE DTSCS88
|
|
00477 GO TO P1000-EXIT. DTSCS88
|
|
00478 DTSCS88
|
|
00479 DTSCS88
|
|
00480 *---------------------------------------------------------- DTSCS88
|
|
00481 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS88
|
|
00482 * CORRESPONDENCE SCREEN. DTSCS88
|
|
00483 *---------------------------------------------------------- DTSCS88
|
|
00484 DTSCS88
|
|
00485 IF LCCM-F14-88 DTSCS88
|
|
00486 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS88
|
|
00487 SET REQ-JUMP TO TRUE DTSCS88
|
|
00488 GO TO P1000-EXIT. DTSCS88
|
|
00489 DTSCS88
|
|
00490 DTSCS88
|
|
00491 *----------------------------------------------------- DTSCS88
|
|
00492 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS88
|
|
00493 * REQUESTED SCREEN TYPE DTSCS88
|
|
00494 *----------------------------------------------------- DTSCS88
|
|
00495 DTSCS88
|
|
00496 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS88
|
|
00497 NEXT SENTENCE DTSCS88
|
|
00498 ELSE DTSCS88
|
|
00499 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS88
|
|
00500 SET REQ-JUMP TO TRUE DTSCS88
|
|
00501 GO TO P1000-EXIT. DTSCS88
|
|
00502 DTSCS88
|
|
00503 DTSCS88
|
|
00504 *----------------------------------------------------- DTSCS88
|
|
00505 * IF REQUEST TO UPDATE THE DATA (ADD, MOD, DEL) DTSCS88
|
|
00506 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS88
|
|
00507 *----------------------------------------------------- DTSCS88
|
|
00508 DTSCS88
|
|
00509 IF LCCM-F09-88 OR LCCM-F10-88 OR LCCM-F23-88 DTSCS88
|
|
00510 IF SCR-ACCESS-UPDATE DTSCS88
|
|
00511 SET REQ-EDIT TO TRUE DTSCS88
|
|
00512 GO TO P1000-EXIT DTSCS88
|
|
00513 ELSE DTSCS88
|
|
00514 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS88
|
|
00515 SET REQ-ERROR TO TRUE DTSCS88
|
|
00516 GO TO P1000-EXIT. DTSCS88
|
|
00517 DTSCS88
|
|
00518 DTSCS88
|
|
00519 *----------------------------------------------------- DTSCS88
|
|
00520 * IF INQUIRY TYPE KEY PRESSED (ENTER, PAGE DOWN, DTSCS88
|
|
00521 * PAGE UP), INDICATE INQUIRY REQUEST DTSCS88
|
|
00522 *----------------------------------------------------- DTSCS88
|
|
00523 DTSCS88
|
|
00524 IF LCCM-ENTER-88 OR LCCM-F07-88 OR LCCM-F08-88 DTSCS88
|
|
00525 SET REQ-INQUIRE TO TRUE DTSCS88
|
|
00526 GO TO P1000-EXIT. DTSCS88
|
|
00527 DTSCS88
|
|
00528 DTSCS88
|
|
00529 *----------------------------------------------------- DTSCS88
|
|
00530 * ANY OTHER KEY IS INVALID DTSCS88
|
|
00531 *----------------------------------------------------- DTSCS88
|
|
00532 DTSCS88
|
|
00533 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS88
|
|
00534 DTSCS88
|
|
00535 SET REQ-ERROR TO TRUE. DTSCS88
|
|
00536 P1000-EXIT. DTSCS88
|
|
00537 EXIT. DTSCS88
|
|
00538 DTSCS88
|
|
00539 DTSCS88
|
|
00540 DTSCS88
|
|
00541 ******************************************************************DTSCS88
|
|
00542 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS88
|
|
00543 ******************************************************************DTSCS88
|
|
00544 DTSCS88
|
|
00545 P1100-UPDATE-LOCKED. DTSCS88
|
|
00546 DTSCS88
|
|
00547 *----------------------------------------------------- DTSCS88
|
|
00548 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS88
|
|
00549 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCS88
|
|
00550 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS88
|
|
00551 *----------------------------------------------------- DTSCS88
|
|
00552 DTSCS88
|
|
00553 IF LCCM-ENTER-88 OR LCCM-F12-88 DTSCS88
|
|
00554 SET REQ-UPDATE TO TRUE DTSCS88
|
|
00555 ELSE DTSCS88
|
|
00556 SET REQ-ERROR TO TRUE DTSCS88
|
|
00557 IF LCCM-SCR-ADD-LOCKED DTSCS88
|
|
00558 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-AREA DTSCS88
|
|
00559 ELSE DTSCS88
|
|
00560 IF LCCM-SCR-MOD-LOCKED DTSCS88
|
|
00561 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-AREA DTSCS88
|
|
00562 ELSE DTSCS88
|
|
00563 IF LCCM-SCR-DEL-LOCKED DTSCS88
|
|
00564 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-AREA DTSCS88
|
|
00565 ELSE DTSCS88
|
|
00566 GO TO S899-ABEND. DTSCS88
|
|
00567 P1100-EXIT. DTSCS88
|
|
00568 EXIT. DTSCS88
|
|
00569 /*****************************************************************DTSCS88
|
|
00570 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS88
|
|
00571 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS88
|
|
00572 ******************************************************************DTSCS88
|
|
00573 DTSCS88
|
|
00574 P2000-REQUEST-ERROR. DTSCS88
|
|
00575 IF LCCM-MSG DTSCS88
|
|
00576 SET RESP-SEND-MSGONLY TO TRUE DTSCS88
|
|
00577 ELSE DTSCS88
|
|
00578 GO TO S899-ABEND. DTSCS88
|
|
00579 P2000-EXIT. DTSCS88
|
|
00580 EXIT. DTSCS88
|
|
00581 /*****************************************************************DTSCS88
|
|
00582 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS88
|
|
00583 ******************************************************************DTSCS88
|
|
00584 DTSCS88
|
|
00585 P3000-REQUEST-JUMP. DTSCS88
|
|
00586 DTSCS88
|
|
00587 *----------------------------------------------------- DTSCS88
|
|
00588 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS88
|
|
00589 * BY USER DTSCS88
|
|
00590 *----------------------------------------------------- DTSCS88
|
|
00591 DTSCS88
|
|
00592 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS88
|
|
00593 DTSCS88
|
|
00594 DTSCS88
|
|
00595 *----------------------------------------------------- DTSCS88
|
|
00596 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS88
|
|
00597 *----------------------------------------------------- DTSCS88
|
|
00598 DTSCS88
|
|
00599 IF LCCM-MSG DTSCS88
|
|
00600 SET RESP-SEND-MSGONLY TO TRUE DTSCS88
|
|
00601 SET CURSOR-SET-GOTO TO TRUE DTSCS88
|
|
00602 GO TO P3000-EXIT. DTSCS88
|
|
00603 DTSCS88
|
|
00604 *----------------------------------------------------- DTSCS88
|
|
00605 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS88
|
|
00606 *----------------------------------------------------- DTSCS88
|
|
00607 DTSCS88
|
|
00608 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS88
|
|
00609 LCCM-SCR-HOLD-AREA. DTSCS88
|
|
00610 DTSCS88
|
|
00611 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS88
|
|
00612 DTSCS88
|
|
00613 SET RESP-JUMP TO TRUE. DTSCS88
|
|
00614 P3000-EXIT. DTSCS88
|
|
00615 EXIT. DTSCS88
|
|
00616 /*****************************************************************DTSCS88
|
|
00617 * CLEAR KEY WAS PRESSED *DTSCS88
|
|
00618 ******************************************************************DTSCS88
|
|
00619 DTSCS88
|
|
00620 P4000-REQUEST-CLEAR. DTSCS88
|
|
00621 IF SCR-ACCESS-UPDATE DTSCS88
|
|
00622 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS88
|
|
00623 ELSE DTSCS88
|
|
00624 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS88
|
|
00625 DTSCS88
|
|
00626 DTSCS88
|
|
00627 *----------------------------------------------------- DTSCS88
|
|
00628 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS88
|
|
00629 * FIELDS FROM EARLIER REQUESTS DTSCS88
|
|
00630 *----------------------------------------------------- DTSCS88
|
|
00631 DTSCS88
|
|
00632 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA. DTSCS88
|
|
00633 DTSCS88
|
|
00634 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS88
|
|
00635 DTSCS88
|
|
00636 SET LCCM-SCR-CLEAR TO TRUE. DTSCS88
|
|
00637 DTSCS88
|
|
00638 SET RESP-SEND-MAP TO TRUE. DTSCS88
|
|
00639 P4000-EXIT. DTSCS88
|
|
00640 EXIT. DTSCS88
|
|
00641 /*****************************************************************DTSCS88
|
|
00642 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS88
|
|
00643 ******************************************************************DTSCS88
|
|
00644 DTSCS88
|
|
00645 P5000-CURSOR-TO-GOTO. DTSCS88
|
|
00646 SET CURSOR-SET-GOTO TO TRUE. DTSCS88
|
|
00647 DTSCS88
|
|
00648 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS88
|
|
00649 P5000-EXIT. DTSCS88
|
|
00650 EXIT. DTSCS88
|
|
00651 /*****************************************************************DTSCS88
|
|
00652 * INQUIRY WAS REQUESTED *DTSCS88
|
|
00653 ******************************************************************DTSCS88
|
|
00654 DTSCS88
|
|
00655 P6000-REQUEST-INQUIRE. DTSCS88
|
|
00656 MOVE LOW-VALUES TO FFIS-KEY-AREA. DTSCS88
|
|
00657 SET FFIS-FIS-88 TO TRUE. DTSCS88
|
|
00658 SKIP1 DTSCS88
|
|
00659 MOVE MAP-FISC-AGNT-CD TO WRK-MAP-FA-CD. DTSCS88
|
|
00660 MOVE MAP-FISC-AGNT-SRVC TO WRK-MAP-FA-TYPE. DTSCS88
|
|
00661 MOVE LOW-VALUES TO MAP-AREA. DTSCS88
|
|
00662 MOVE WRK-MAP-FA-CD TO MAP-FISC-AGNT-CD. DTSCS88
|
|
00663 MOVE WRK-MAP-FA-TYPE TO MAP-FISC-AGNT-SRVC. DTSCS88
|
|
00664 SKIP1 DTSCS88
|
|
00665 INSPECT MAP-FISC-AGNT-CD CONVERTING LOW-VALUE TO SPACE. DTSCS88
|
|
00666 MOVE MAP-FISC-AGNT-CD TO FFIS-FISCAL-AGENT-CD. DTSCS88
|
|
00667 INSPECT MAP-FISC-AGNT-SRVC CONVERTING LOW-VALUE TO SPACE. DTSCS88
|
|
00668 MOVE MAP-FISC-AGNT-SRVC TO FFIS-SERVICE-TYPE. DTSCS88
|
|
00669 SKIP1 DTSCS88
|
|
00670 IF LCCM-SCR-INQUIRE DTSCS88
|
|
00671 AND FFIS-KEY-AREA = LCCM-SCR-KEY-AREA DTSCS88
|
|
00672 MOVE 'N' TO SCR-NEW-KEY-IND DTSCS88
|
|
00673 ELSE DTSCS88
|
|
00674 MOVE 'Y' TO SCR-NEW-KEY-IND. DTSCS88
|
|
00675 SKIP1 DTSCS88
|
|
00676 IF SCR-ACCESS-UPDATE DTSCS88
|
|
00677 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS88
|
|
00678 ELSE DTSCS88
|
|
00679 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS88
|
|
00680 SKIP1 DTSCS88
|
|
00681 SET LCCM-SCR-CLEAR TO TRUE. DTSCS88
|
|
00682 MOVE LOW-VALUES TO LCCM-SCR-KEY-AREA. DTSCS88
|
|
00683 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS88
|
|
00684 SKIP1 DTSCS88
|
|
00685 IF LCCM-MSG DTSCS88
|
|
00686 NEXT SENTENCE DTSCS88
|
|
00687 ELSE DTSCS88
|
|
00688 IF LCCM-ENTER-88 DTSCS88
|
|
00689 PERFORM P6100-NO-PAGE THRU P6100-EXIT DTSCS88
|
|
00690 ELSE DTSCS88
|
|
00691 IF LCCM-F07-88 DTSCS88
|
|
00692 PERFORM P6200-PAGE-BACK THRU P6200-EXIT DTSCS88
|
|
00693 ELSE DTSCS88
|
|
00694 IF LCCM-F08-88 DTSCS88
|
|
00695 PERFORM P6300-PAGE-NEXT THRU P6300-EXIT DTSCS88
|
|
00696 ELSE DTSCS88
|
|
00697 GO TO S899-ABEND. DTSCS88
|
|
00698 SKIP1 DTSCS88
|
|
00699 SET RESP-SEND-MAP TO TRUE. DTSCS88
|
|
00700 P6000-EXIT. DTSCS88
|
|
00701 EXIT. DTSCS88
|
|
00702 EJECT DTSCS88
|
|
00703 P6100-NO-PAGE. DTSCS88
|
|
00704 IF MAP-FISC-AGNT-CD = SPACES DTSCS88
|
|
00705 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS88
|
|
00706 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS88
|
|
00707 GO TO P6100-EXIT DTSCS88
|
|
00708 END-IF. DTSCS88
|
|
00709 DTSCS88
|
|
00710 MOVE FFIS-KEY-AREA TO WRK-KEY-AREA. DTSCS88
|
|
00711 PERFORM S831-START-BROWSE THRU S831-EXIT. DTSCS88
|
|
00712 IF L831-NO-REC-88 DTSCS88
|
|
00713 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS88
|
|
00714 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS88
|
|
00715 GO TO P6100-EXIT. DTSCS88
|
|
00716 SKIP1 DTSCS88
|
|
00717 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS88
|
|
00718 P6100-EXIT. DTSCS88
|
|
00719 EXIT. DTSCS88
|
|
00720 EJECT DTSCS88
|
|
00721 P6200-PAGE-BACK. DTSCS88
|
|
00722 MOVE FFIS-KEY-AREA TO WRK-KEY-AREA. DTSCS88
|
|
00723 PERFORM S831-START-BROWSE THRU S831-EXIT. DTSCS88
|
|
00724 IF L831-NO-REC-88 DTSCS88
|
|
00725 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS88
|
|
00726 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS88
|
|
00727 GO TO P6200-EXIT. DTSCS88
|
|
00728 SKIP1 DTSCS88
|
|
00729 IF (SCR-NEW-KEY-IND = 'Y') DTSCS88
|
|
00730 AND DTSCS88
|
|
00731 (WRK-KEY-AREA = FFIS-KEY-AREA) DTSCS88
|
|
00732 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS88
|
|
00733 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS88
|
|
00734 GO TO P6200-EXIT. DTSCS88
|
|
00735 SKIP1 DTSCS88
|
|
00736 PERFORM S831-READ-PREV THRU S831-EXIT. DTSCS88
|
|
00737 IF L831-NO-REC-88 DTSCS88
|
|
00738 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS88
|
|
00739 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS88
|
|
00740 GO TO P6200-EXIT. DTSCS88
|
|
00741 SKIP1 DTSCS88
|
|
00742 PERFORM S831-READ-PREV THRU S831-EXIT. DTSCS88
|
|
00743 IF L831-NO-REC-88 DTSCS88
|
|
00744 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS88
|
|
00745 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-AREA DTSCS88
|
|
00746 ELSE DTSCS88
|
|
00747 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS88
|
|
00748 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS88
|
|
00749 P6200-EXIT. DTSCS88
|
|
00750 EXIT. DTSCS88
|
|
00751 EJECT DTSCS88
|
|
00752 P6300-PAGE-NEXT. DTSCS88
|
|
00753 MOVE FFIS-KEY-AREA TO WRK-KEY-AREA. DTSCS88
|
|
00754 PERFORM S831-START-BROWSE THRU S831-EXIT. DTSCS88
|
|
00755 IF L831-NO-REC-88 DTSCS88
|
|
00756 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS88
|
|
00757 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS88
|
|
00758 GO TO P6300-EXIT. DTSCS88
|
|
00759 SKIP1 DTSCS88
|
|
00760 IF (SCR-NEW-KEY-IND = 'N') DTSCS88
|
|
00761 AND DTSCS88
|
|
00762 (WRK-KEY-AREA = FFIS-KEY-AREA) DTSCS88
|
|
00763 NEXT SENTENCE DTSCS88
|
|
00764 ELSE DTSCS88
|
|
00765 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS88
|
|
00766 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS88
|
|
00767 GO TO P6300-EXIT. DTSCS88
|
|
00768 SKIP1 DTSCS88
|
|
00769 PERFORM S831-READ-NEXT THRU S831-EXIT. DTSCS88
|
|
00770 IF L831-NO-REC-88 DTSCS88
|
|
00771 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS88
|
|
00772 MOVE PMSG-LAST-PAGE TO LCCM-MSG-AREA DTSCS88
|
|
00773 ELSE DTSCS88
|
|
00774 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS88
|
|
00775 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS88
|
|
00776 P6300-EXIT. DTSCS88
|
|
00777 EXIT. DTSCS88
|
|
00778 /*****************************************************************DTSCS88
|
|
00779 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCS88
|
|
00780 ******************************************************************DTSCS88
|
|
00781 DTSCS88
|
|
00782 P6900-CONSTRUCT-SCREEN. DTSCS88
|
|
00783 DTSCS88
|
|
00784 MOVE FFIS-FISCAL-AGENT-CD TO MAP-FISC-AGNT-CD. DTSCS88
|
|
00785 DTSCS88
|
|
00786 MOVE FFIS-NAME TO MAP-FISC-AGNT-NAME. DTSCS88
|
|
00787 DTSCS88
|
|
00788 MOVE FFIS-SERVICE-TYPE TO MAP-FISC-AGNT-SRVC. DTSCS88
|
|
00789 DTSCS88
|
|
00790 MOVE SPACES TO MAP-FISC-AGNT-SRVC-DESC. DTSCS88
|
|
00791 DTSCS88
|
|
00792 EVALUATE TRUE DTSCS88
|
|
00793 WHEN FFIS-SERVICE-UC30-88 DTSCS88
|
|
00794 SET MAP-SERVICE-UC30-DESC-88 TO TRUE DTSCS88
|
|
00795 WHEN FFIS-SERVICE-BEN-CHG-88 DTSCS88
|
|
00796 SET MAP-SERVICE-BEN-CHG-DESC-88 TO TRUE DTSCS88
|
|
00797 WHEN FFIS-SERVICE-CORRESPOND-88 DTSCS88
|
|
00798 SET MAP-SERVICE-CORRESPOND-DESC-88 TO TRUE. DTSCS88
|
|
00799 DTSCS88
|
|
00800 MOVE FFIS-BUSINESS-CONTACT-NAME TO MAP-BUSINESS-NAME. DTSCS88
|
|
00801 DTSCS88
|
|
00802 MOVE FFIS-BUSINESS-CONTACT-EMAIL TO MAP-BUSINESS-EMAIL. DTSCS88
|
|
00803 DTSCS88
|
|
00804 IF FFIS-BUSINESS-VOICE NOT = SPACE DTSCS88
|
|
00805 MOVE FFIS-BUSINESS-VOICE-AREA-CD DTSCS88
|
|
00806 TO MAP-BUSINESS-VOICE-A-CD DTSCS88
|
|
00807 MOVE FFIS-BUSINESS-VOICE-PREFIX DTSCS88
|
|
00808 TO MAP-BUSINESS-VOICE-PREF DTSCS88
|
|
00809 MOVE FFIS-BUSINESS-VOICE-SUFFIX DTSCS88
|
|
00810 TO MAP-BUSINESS-VOICE-SUFF DTSCS88
|
|
00811 MOVE FFIS-BUSINESS-VOICE-EXT DTSCS88
|
|
00812 TO MAP-BUSINESS-VOICE-EXT. DTSCS88
|
|
00813 DTSCS88
|
|
00814 IF FFIS-BUSINESS-FAX NOT = SPACE DTSCS88
|
|
00815 MOVE FFIS-BUSINESS-FAX-AREA-CD DTSCS88
|
|
00816 TO MAP-BUSINESS-FAX-A-CD DTSCS88
|
|
00817 MOVE FFIS-BUSINESS-FAX-PREFIX DTSCS88
|
|
00818 TO MAP-BUSINESS-FAX-PREF DTSCS88
|
|
00819 MOVE FFIS-BUSINESS-FAX-SUFFIX DTSCS88
|
|
00820 TO MAP-BUSINESS-FAX-SUFF DTSCS88
|
|
00821 MOVE FFIS-BUSINESS-FAX-EXT DTSCS88
|
|
00822 TO MAP-BUSINESS-FAX-EXT. DTSCS88
|
|
00823 DTSCS88
|
|
00824 MOVE FFIS-MEDIA-CONTACT-NAME TO MAP-MEDIA-NAME. DTSCS88
|
|
00825 DTSCS88
|
|
00826 MOVE FFIS-MEDIA-CONTACT-EMAIL TO MAP-MEDIA-EMAIL. DTSCS88
|
|
00827 DTSCS88
|
|
00828 IF FFIS-MEDIA-VOICE NOT = SPACE DTSCS88
|
|
00829 MOVE FFIS-MEDIA-VOICE-AREA-CD DTSCS88
|
|
00830 TO MAP-MEDIA-VOICE-A-CD DTSCS88
|
|
00831 MOVE FFIS-MEDIA-VOICE-PREFIX DTSCS88
|
|
00832 TO MAP-MEDIA-VOICE-PREF DTSCS88
|
|
00833 MOVE FFIS-MEDIA-VOICE-SUFFIX DTSCS88
|
|
00834 TO MAP-MEDIA-VOICE-SUFF DTSCS88
|
|
00835 MOVE FFIS-MEDIA-VOICE-EXT DTSCS88
|
|
00836 TO MAP-MEDIA-VOICE-EXT. DTSCS88
|
|
00837 DTSCS88
|
|
00838 IF FFIS-MEDIA-FAX NOT = SPACE DTSCS88
|
|
00839 MOVE FFIS-MEDIA-FAX-AREA-CD DTSCS88
|
|
00840 TO MAP-MEDIA-FAX-A-CD DTSCS88
|
|
00841 MOVE FFIS-MEDIA-FAX-PREFIX DTSCS88
|
|
00842 TO MAP-MEDIA-FAX-PREF DTSCS88
|
|
00843 MOVE FFIS-MEDIA-FAX-SUFFIX DTSCS88
|
|
00844 TO MAP-MEDIA-FAX-SUFF DTSCS88
|
|
00845 MOVE FFIS-MEDIA-FAX-EXT DTSCS88
|
|
00846 TO MAP-MEDIA-FAX-EXT. DTSCS88
|
|
00847 DTSCS88
|
|
00848 DTSCS88
|
|
00849 MOVE FFIS-ATTN-LINE TO MAP-FISC-AGNT-ATTN. DTSCS88
|
|
00850 DTSCS88
|
|
00851 MOVE FFIS-DELIV-LINE-1 TO MAP-FISC-AGNT-DLV1. DTSCS88
|
|
00852 DTSCS88
|
|
00853 MOVE FFIS-DELIV-LINE-2 TO MAP-FISC-AGNT-DLV2. DTSCS88
|
|
00854 DTSCS88
|
|
00855 MOVE FFIS-CITY TO MAP-FISC-AGNT-CITY. DTSCS88
|
|
00856 DTSCS88
|
|
00857 MOVE FFIS-ST TO MAP-FISC-AGNT-STATE. DTSCS88
|
|
00858 DTSCS88
|
|
00859 MOVE FFIS-ZIP TO MAP-FISC-AGNT-ZIPC. DTSCS88
|
|
00860 DTSCS88
|
|
00861 MOVE FFIS-MEDIA-TYPE-CD TO MAP-MEDIA-TYPE-CD. DTSCS88
|
|
00862 DTSCS88
|
|
00863 MOVE SPACES TO MAP-MEDIA-TYPE-DSCR. DTSCS88
|
|
00864 DTSCS88
|
|
00865 EVALUATE TRUE DTSCS88
|
|
00866 WHEN FFIS-MEDIA-CART-TAPE-88 DTSCS88
|
|
00867 SET MAP-MEDIA-TYPE-CART-TAPE-88 TO TRUE DTSCS88
|
|
00868 WHEN FFIS-MEDIA-DISKETTE-88 DTSCS88
|
|
00869 SET MAP-MEDIA-TYPE-DISKETTE-88 TO TRUE DTSCS88
|
|
00870 WHEN FFIS-MEDIA-INTERNET-88 DTSCS88
|
|
00871 SET MAP-MEDIA-TYPE-INTERNET-88 TO TRUE DTSCS88
|
|
00872 WHEN FFIS-MEDIA-REEL-TAPE-88 DTSCS88
|
|
00873 SET MAP-MEDIA-TYPE-REEL-TAPE-88 TO TRUE. DTSCS88
|
|
00874 DTSCS88
|
|
00875 MOVE FFIS-DISK-SIZE TO MAP-DISK-SIZE. DTSCS88
|
|
00876 DTSCS88
|
|
00877 MOVE FFIS-MEDIA-CHANGE-DATE TO L001-FED-8-DATE-9. DTSCS88
|
|
00878 DTSCS88
|
|
00879 SET L001-FROM-FED-8 TO TRUE. DTSCS88
|
|
00880 DTSCS88
|
|
00881 PERFORM S001-DATE THRU S001-EXIT. DTSCS88
|
|
00882 DTSCS88
|
|
00883 MOVE L001-SLASH-DATE TO MAP-MEDIA-CHNG-DATE. DTSCS88
|
|
00884 DTSCS88
|
|
00885 DTSCS88
|
|
00886 MOVE FFIS-ESTB-DATE TO L001-FED-8-DATE-9. DTSCS88
|
|
00887 DTSCS88
|
|
00888 SET L001-FROM-FED-8 TO TRUE. DTSCS88
|
|
00889 DTSCS88
|
|
00890 PERFORM S001-DATE THRU S001-EXIT. DTSCS88
|
|
00891 DTSCS88
|
|
00892 MOVE L001-SLASH-DATE TO MAP-ESTB-DATE. DTSCS88
|
|
00893 DTSCS88
|
|
00894 DTSCS88
|
|
00895 MOVE FFIS-CHNG-DATE TO L001-FED-8-DATE-9. DTSCS88
|
|
00896 DTSCS88
|
|
00897 SET L001-FROM-FED-8 TO TRUE. DTSCS88
|
|
00898 DTSCS88
|
|
00899 PERFORM S001-DATE THRU S001-EXIT. DTSCS88
|
|
00900 DTSCS88
|
|
00901 MOVE L001-SLASH-DATE TO MAP-CHNG-DATE. DTSCS88
|
|
00902 DTSCS88
|
|
00903 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS88
|
|
00904 DTSCS88
|
|
00905 MOVE FFIS-KEY-AREA TO LCCM-SCR-KEY-AREA. DTSCS88
|
|
00906 DTSCS88
|
|
00907 IF FFIS-SERVICE-TYPE = '03' DTSCS88
|
|
00908 MOVE CATB-ASKIP-BRT-MDTON TO MAP-DISK-SIZE-A DTSCS88
|
|
00909 MAP-MEDIA-TYPE-CD-A. DTSCS88
|
|
00910 P6900-EXIT. DTSCS88
|
|
00911 EXIT. DTSCS88
|
|
00912 /*****************************************************************DTSCS88
|
|
00913 * FUNCTION KEY TO ADD, MOD OR DEL THE RECORD WAS PRESSED. *DTSCS88
|
|
00914 ******************************************************************DTSCS88
|
|
00915 DTSCS88
|
|
00916 P7000-REQUEST-EDIT. DTSCS88
|
|
00917 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS88
|
|
00918 DTSCS88
|
|
00919 IF LCCM-F09-88 DTSCS88
|
|
00920 PERFORM P7100-EDIT-ADD THRU P7100-EXIT DTSCS88
|
|
00921 ELSE DTSCS88
|
|
00922 IF LCCM-F10-88 DTSCS88
|
|
00923 PERFORM P7200-EDIT-MOD THRU P7200-EXIT DTSCS88
|
|
00924 ELSE DTSCS88
|
|
00925 IF LCCM-F23-88 DTSCS88
|
|
00926 PERFORM P7300-EDIT-DEL THRU P7300-EXIT DTSCS88
|
|
00927 ELSE DTSCS88
|
|
00928 GO TO S899-ABEND. DTSCS88
|
|
00929 DTSCS88
|
|
00930 DTSCS88
|
|
00931 *------------------------------------------------------ DTSCS88
|
|
00932 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCS88
|
|
00933 * IN ORDER TO CONTINUE TO ATTEMPT AN ADD THE SCREEN MUST REMAIN DTSCS88
|
|
00934 * IN A 'CLEAR' STATE. THE SCREEN MUST BE IN 'INQUIRE' STATUS DTSCS88
|
|
00935 * IF MOD OR DEL FUNCTIONS ARE BEING REQUESTED. DTSCS88
|
|
00936 *------------------------------------------------------ DTSCS88
|
|
00937 DTSCS88
|
|
00938 IF LCCM-MSG DTSCS88
|
|
00939 NEXT SENTENCE DTSCS88
|
|
00940 ELSE DTSCS88
|
|
00941 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCS88
|
|
00942 IF LCCM-F09-88 DTSCS88
|
|
00943 SET LCCM-SCR-ADD-LOCKED TO TRUE DTSCS88
|
|
00944 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-AREA DTSCS88
|
|
00945 ELSE DTSCS88
|
|
00946 IF LCCM-F10-88 DTSCS88
|
|
00947 SET LCCM-SCR-MOD-LOCKED TO TRUE DTSCS88
|
|
00948 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-AREA DTSCS88
|
|
00949 ELSE DTSCS88
|
|
00950 IF LCCM-F23-88 DTSCS88
|
|
00951 SET LCCM-SCR-DEL-LOCKED TO TRUE DTSCS88
|
|
00952 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-AREA. DTSCS88
|
|
00953 DTSCS88
|
|
00954 SET RESP-SEND-MAP TO TRUE. DTSCS88
|
|
00955 P7000-EXIT. DTSCS88
|
|
00956 EXIT. DTSCS88
|
|
00957 /*****************************************************************DTSCS88
|
|
00958 * ADD FUNCTION WAS REQUESTED *DTSCS88
|
|
00959 ******************************************************************DTSCS88
|
|
00960 DTSCS88
|
|
00961 P7100-EDIT-ADD. DTSCS88
|
|
00962 DTSCS88
|
|
00963 *----------------------------------------------------- DTSCS88
|
|
00964 * ADD REQUIRES THAT THE SCREEN WAS IN THE CLEAR STATE DTSCS88
|
|
00965 *----------------------------------------------------- DTSCS88
|
|
00966 DTSCS88
|
|
00967 IF NOT LCCM-SCR-CLEAR DTSCS88
|
|
00968 MOVE EMSG-ADD-PRECEDED TO LCCM-MSG-AREA DTSCS88
|
|
00969 GO TO P7100-EXIT. DTSCS88
|
|
00970 DTSCS88
|
|
00971 PERFORM S1001-SCREEN-KEY-EDITS THRU S1001-EXIT. DTSCS88
|
|
00972 DTSCS88
|
|
00973 SKIP1 DTSCS88
|
|
00974 IF LCCM-NO-MSG DTSCS88
|
|
00975 PERFORM S8010-READ-FFIS THRU S8010-EXIT DTSCS88
|
|
00976 IF L831-OK-88 DTSCS88
|
|
00977 MOVE EMSG-RECORD-EXISTS TO WRK-MSG-AREA DTSCS88
|
|
00978 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS88
|
|
00979 ELSE DTSCS88
|
|
00980 PERFORM S1002-SCREEN-DATA-EDITS THRU S1002-EXIT. DTSCS88
|
|
00981 P7100-EXIT. DTSCS88
|
|
00982 EXIT. DTSCS88
|
|
00983 /*****************************************************************DTSCS88
|
|
00984 * MODIFICATION FUNCTION WAS REQUESTED *DTSCS88
|
|
00985 ******************************************************************DTSCS88
|
|
00986 DTSCS88
|
|
00987 P7200-EDIT-MOD. DTSCS88
|
|
00988 DTSCS88
|
|
00989 *----------------------------------------------------- DTSCS88
|
|
00990 * MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS88
|
|
00991 * INQUIRED DTSCS88
|
|
00992 *----------------------------------------------------- DTSCS88
|
|
00993 DTSCS88
|
|
00994 IF NOT LCCM-SCR-INQUIRE DTSCS88
|
|
00995 MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-AREA DTSCS88
|
|
00996 GO TO P7200-EXIT. DTSCS88
|
|
00997 DTSCS88
|
|
00998 SKIP3 DTSCS88
|
|
00999 *----------------------------------------------------- DTSCS88
|
|
01000 * CONTROL FIELD(S) MAY NOT BE CHANGED DURING THE MOD DTSCS88
|
|
01001 *----------------------------------------------------- DTSCS88
|
|
01002 MOVE LCCM-SCR-KEY-AREA TO WRK-KEY-AREA. DTSCS88
|
|
01003 IF MAP-FISC-AGNT-CD NOT = WRK-KEY-FA-CD OR DTSCS88
|
|
01004 MAP-FISC-AGNT-SRVC NOT = WRK-KEY-FA-TYPE DTSCS88
|
|
01005 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS88
|
|
01006 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS88
|
|
01007 GO TO P7200-EXIT. DTSCS88
|
|
01008 SKIP1 DTSCS88
|
|
01009 PERFORM S1001-SCREEN-KEY-EDITS THRU S1001-EXIT. DTSCS88
|
|
01010 SKIP1 DTSCS88
|
|
01011 IF LCCM-NO-MSG DTSCS88
|
|
01012 PERFORM S8010-READ-FFIS THRU S8010-EXIT DTSCS88
|
|
01013 IF L831-NO-REC-88 DTSCS88
|
|
01014 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS88
|
|
01015 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS88
|
|
01016 ELSE DTSCS88
|
|
01017 PERFORM S1002-SCREEN-DATA-EDITS THRU S1002-EXIT. DTSCS88
|
|
01018 P7200-EXIT. DTSCS88
|
|
01019 EXIT. DTSCS88
|
|
01020 /*****************************************************************DTSCS88
|
|
01021 * DELETE FUNCTION WAS REQUESTED *DTSCS88
|
|
01022 ******************************************************************DTSCS88
|
|
01023 DTSCS88
|
|
01024 P7300-EDIT-DEL. DTSCS88
|
|
01025 DTSCS88
|
|
01026 *----------------------------------------------------- DTSCS88
|
|
01027 * DELETE REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS88
|
|
01028 * INQUIRED DTSCS88
|
|
01029 *----------------------------------------------------- DTSCS88
|
|
01030 DTSCS88
|
|
01031 IF NOT LCCM-SCR-INQUIRE DTSCS88
|
|
01032 MOVE EMSG-DEL-PRECEDED TO LCCM-MSG-AREA DTSCS88
|
|
01033 GO TO P7300-EXIT. DTSCS88
|
|
01034 *----------------------------------------------------- DTSCS88
|
|
01035 * CONTROL FIELD(S) MAY NOT BE CHANGED DURING A DELETE DTSCS88
|
|
01036 *----------------------------------------------------- DTSCS88
|
|
01037 MOVE LCCM-SCR-KEY-AREA TO WRK-KEY-AREA. DTSCS88
|
|
01038 IF MAP-FISC-AGNT-CD NOT = WRK-KEY-FA-CD OR DTSCS88
|
|
01039 MAP-FISC-AGNT-SRVC NOT = WRK-KEY-FA-TYPE DTSCS88
|
|
01040 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS88
|
|
01041 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS88
|
|
01042 GO TO P7300-EXIT. DTSCS88
|
|
01043 SKIP1 DTSCS88
|
|
01044 IF LCCM-NO-MSG DTSCS88
|
|
01045 PERFORM S8010-READ-FFIS THRU S8010-EXIT DTSCS88
|
|
01046 IF L831-NO-REC-88 DTSCS88
|
|
01047 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS88
|
|
01048 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS88
|
|
01049 P7300-EXIT. DTSCS88
|
|
01050 EXIT. DTSCS88
|
|
01051 DTSCS88
|
|
01052 /*****************************************************************DTSCS88
|
|
01053 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED *DTSCS88
|
|
01054 ******************************************************************DTSCS88
|
|
01055 DTSCS88
|
|
01056 P8000-REQUEST-UPDATE. DTSCS88
|
|
01057 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS88
|
|
01058 DTSCS88
|
|
01059 IF LCCM-SCR-ADD-LOCKED DTSCS88
|
|
01060 PERFORM P8100-ADD THRU P8100-EXIT DTSCS88
|
|
01061 ELSE DTSCS88
|
|
01062 IF LCCM-SCR-MOD-LOCKED DTSCS88
|
|
01063 PERFORM P8200-MOD THRU P8200-EXIT DTSCS88
|
|
01064 ELSE DTSCS88
|
|
01065 IF LCCM-SCR-DEL-LOCKED DTSCS88
|
|
01066 PERFORM P8300-DEL THRU P8300-EXIT DTSCS88
|
|
01067 ELSE DTSCS88
|
|
01068 GO TO S899-ABEND. DTSCS88
|
|
01069 DTSCS88
|
|
01070 SET RESP-SEND-MAP TO TRUE. DTSCS88
|
|
01071 P8000-EXIT. DTSCS88
|
|
01072 EXIT. DTSCS88
|
|
01073 /*****************************************************************DTSCS88
|
|
01074 * *DTSCS88
|
|
01075 ******************************************************************DTSCS88
|
|
01076 DTSCS88
|
|
01077 P8100-ADD. DTSCS88
|
|
01078 SET LCCM-SCR-CLEAR TO TRUE. DTSCS88
|
|
01079 DTSCS88
|
|
01080 IF LCCM-F12-88 DTSCS88
|
|
01081 MOVE PMSG-ADD-CANCELED TO LCCM-MSG-AREA DTSCS88
|
|
01082 GO TO P8100-EXIT. DTSCS88
|
|
01083 DTSCS88
|
|
01084 PERFORM S8010-READ-FFIS THRU S8010-EXIT. DTSCS88
|
|
01085 DTSCS88
|
|
01086 IF L831-OK-88 DTSCS88
|
|
01087 MOVE EMSG-RECORD-EXISTS TO WRK-MSG-AREA DTSCS88
|
|
01088 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS88
|
|
01089 GO TO P8100-EXIT. DTSCS88
|
|
01090 SKIP1 DTSCS88
|
|
01091 MOVE LOW-VALUES TO FFIS-DATA-AREA. DTSCS88
|
|
01092 SKIP1 DTSCS88
|
|
01093 PERFORM P8900-INITILIZE-FFIS THRU P8900-EXIT. DTSCS88
|
|
01094 SKIP1 DTSCS88
|
|
01095 PERFORM P8910-CONSTRUCT-FFIS THRU P8910-EXIT. DTSCS88
|
|
01096 SKIP1 DTSCS88
|
|
01097 PERFORM S831-WRITE THRU S831-EXIT. DTSCS88
|
|
01098 SKIP1 DTSCS88
|
|
01099 MOVE LOW-VALUES TO MAP-AREA. DTSCS88
|
|
01100 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS88
|
|
01101 MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-AREA. DTSCS88
|
|
01102 P8100-EXIT. DTSCS88
|
|
01103 SKIP1 DTSCS88
|
|
01104 /*****************************************************************DTSCS88
|
|
01105 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS88
|
|
01106 ******************************************************************DTSCS88
|
|
01107 DTSCS88
|
|
01108 P8200-MOD. DTSCS88
|
|
01109 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS88
|
|
01110 DTSCS88
|
|
01111 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS88
|
|
01112 DTSCS88
|
|
01113 IF LCCM-F12-88 DTSCS88
|
|
01114 MOVE PMSG-MOD-CANCELED TO LCCM-MSG-AREA DTSCS88
|
|
01115 GO TO P8200-EXIT. DTSCS88
|
|
01116 DTSCS88
|
|
01117 PERFORM S8010-READ-FFIS THRU S8010-EXIT. DTSCS88
|
|
01118 IF L831-NO-REC-88 DTSCS88
|
|
01119 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS88
|
|
01120 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS88
|
|
01121 GO TO P8200-EXIT. DTSCS88
|
|
01122 SKIP1 DTSCS88
|
|
01123 PERFORM P8910-CONSTRUCT-FFIS THRU P8910-EXIT. DTSCS88
|
|
01124 SKIP1 DTSCS88
|
|
01125 PERFORM S831-REWRITE THRU S831-EXIT. DTSCS88
|
|
01126 SKIP1 DTSCS88
|
|
01127 MOVE FFIS-CHNG-DATE TO L001-FED-8-DATE-9. DTSCS88
|
|
01128 SET L001-FROM-FED-8 TO TRUE. DTSCS88
|
|
01129 PERFORM S001-DATE THRU S001-EXIT. DTSCS88
|
|
01130 MOVE L001-SLASH-DATE TO MAP-CHNG-DATE. DTSCS88
|
|
01131 SKIP1 DTSCS88
|
|
01132 MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-AREA. DTSCS88
|
|
01133 DTSCS88
|
|
01134 P8200-EXIT. DTSCS88
|
|
01135 EXIT. DTSCS88
|
|
01136 /*****************************************************************DTSCS88
|
|
01137 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS88
|
|
01138 ******************************************************************DTSCS88
|
|
01139 DTSCS88
|
|
01140 P8300-DEL. DTSCS88
|
|
01141 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS88
|
|
01142 DTSCS88
|
|
01143 IF LCCM-F12-88 DTSCS88
|
|
01144 MOVE PMSG-DEL-CANCELED TO LCCM-MSG-AREA DTSCS88
|
|
01145 GO TO P8300-EXIT. DTSCS88
|
|
01146 DTSCS88
|
|
01147 PERFORM S8010-READ-FFIS THRU S8010-EXIT. DTSCS88
|
|
01148 DTSCS88
|
|
01149 IF NOT L831-OK-88 DTSCS88
|
|
01150 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS88
|
|
01151 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS88
|
|
01152 GO TO P8300-EXIT. DTSCS88
|
|
01153 SKIP1 DTSCS88
|
|
01154 PERFORM S831-DELETE THRU S831-EXIT. DTSCS88
|
|
01155 SKIP1 DTSCS88
|
|
01156 MOVE LOW-VALUES TO LCCM-SCR-KEY-AREA. DTSCS88
|
|
01157 SET LCCM-SCR-CLEAR TO TRUE. DTSCS88
|
|
01158 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS88
|
|
01159 SKIP1 DTSCS88
|
|
01160 MOVE LOW-VALUES TO MAP-AREA. DTSCS88
|
|
01161 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS88
|
|
01162 SKIP1 DTSCS88
|
|
01163 MOVE PMSG-DEL-SUCCESSFUL TO LCCM-MSG-ID. DTSCS88
|
|
01164 P8300-EXIT. DTSCS88
|
|
01165 EXIT. DTSCS88
|
|
01166 /*****************************************************************DTSCS88
|
|
01167 * *DTSCS88
|
|
01168 ******************************************************************DTSCS88
|
|
01169 P8900-INITILIZE-FFIS. DTSCS88
|
|
01170 MOVE LOW-VALUES TO FFIS-DATA-AREA. DTSCS88
|
|
01171 MOVE +0 TO FFIS-PURGE-DATE DTSCS88
|
|
01172 FFIS-MEDIA-CHANGE-DATE. DTSCS88
|
|
01173 DTSCS88
|
|
01174 MOVE SPACES TO FFIS-NAME DTSCS88
|
|
01175 FFIS-DISK-SIZE DTSCS88
|
|
01176 FFIS-MEDIA-TYPE-CD DTSCS88
|
|
01177 FFIS-BUSINESS-CONTACT-NAME DTSCS88
|
|
01178 FFIS-BUSINESS-CONTACT-EMAIL DTSCS88
|
|
01179 FFIS-BUSINESS-PHONE-NUMBERS DTSCS88
|
|
01180 FFIS-MEDIA-CONTACT-NAME DTSCS88
|
|
01181 FFIS-MEDIA-CONTACT-EMAIL DTSCS88
|
|
01182 FFIS-MEDIA-PHONE-NUMBERS DTSCS88
|
|
01183 FFIS-ADDR. DTSCS88
|
|
01184 DTSCS88
|
|
01185 DTSCS88
|
|
01186 MOVE LCCM-CURR-RUN-DATE TO FFIS-ESTB-DATE DTSCS88
|
|
01187 FFIS-CHNG-DATE DTSCS88
|
|
01188 FFIS-MEDIA-CHANGE-DATE. DTSCS88
|
|
01189 P8900-EXIT. DTSCS88
|
|
01190 EXIT. DTSCS88
|
|
01191 DTSCS88
|
|
01192 DTSCS88
|
|
01193 P8910-CONSTRUCT-FFIS. DTSCS88
|
|
01194 IF MAP-FISC-AGNT-NAME NOT = FFIS-NAME DTSCS88
|
|
01195 MOVE MAP-FISC-AGNT-NAME TO FFIS-NAME DTSCS88
|
|
01196 MOVE LCCM-CURR-RUN-DATE TO FFIS-CHNG-DATE. DTSCS88
|
|
01197 DTSCS88
|
|
01198 IF MAP-MEDIA-TYPE-CD NOT = FFIS-MEDIA-TYPE-CD DTSCS88
|
|
01199 MOVE MAP-MEDIA-TYPE-CD TO FFIS-MEDIA-TYPE-CD DTSCS88
|
|
01200 MOVE LCCM-CURR-RUN-DATE TO FFIS-CHNG-DATE DTSCS88
|
|
01201 FFIS-MEDIA-CHANGE-DATE DTSCS88
|
|
01202 EVALUATE TRUE DTSCS88
|
|
01203 WHEN FFIS-MEDIA-CART-TAPE-88 DTSCS88
|
|
01204 SET MAP-MEDIA-TYPE-CART-TAPE-88 TO TRUE DTSCS88
|
|
01205 WHEN FFIS-MEDIA-DISKETTE-88 DTSCS88
|
|
01206 SET MAP-MEDIA-TYPE-DISKETTE-88 TO TRUE DTSCS88
|
|
01207 WHEN FFIS-MEDIA-INTERNET-88 DTSCS88
|
|
01208 SET MAP-MEDIA-TYPE-INTERNET-88 TO TRUE DTSCS88
|
|
01209 WHEN FFIS-MEDIA-REEL-TAPE-88 DTSCS88
|
|
01210 SET MAP-MEDIA-TYPE-REEL-TAPE-88 TO TRUE. DTSCS88
|
|
01211 DTSCS88
|
|
01212 IF MAP-DISK-SIZE NOT = FFIS-DISK-SIZE DTSCS88
|
|
01213 MOVE MAP-DISK-SIZE TO FFIS-DISK-SIZE DTSCS88
|
|
01214 MOVE LCCM-CURR-RUN-DATE TO FFIS-CHNG-DATE. DTSCS88
|
|
01215 DTSCS88
|
|
01216 IF MAP-BUSINESS-NAME NOT = FFIS-BUSINESS-CONTACT-NAME DTSCS88
|
|
01217 MOVE MAP-BUSINESS-NAME TO FFIS-BUSINESS-CONTACT-NAME DTSCS88
|
|
01218 MOVE LCCM-CURR-RUN-DATE TO FFIS-CHNG-DATE. DTSCS88
|
|
01219 DTSCS88
|
|
01220 IF MAP-BUSINESS-EMAIL NOT = FFIS-BUSINESS-CONTACT-EMAIL DTSCS88
|
|
01221 MOVE MAP-BUSINESS-EMAIL TO DTSCS88
|
|
01222 FFIS-BUSINESS-CONTACT-EMAIL DTSCS88
|
|
01223 MOVE LCCM-CURR-RUN-DATE TO FFIS-CHNG-DATE. DTSCS88
|
|
01224 DTSCS88
|
|
01225 IF MAP-MEDIA-NAME NOT = FFIS-MEDIA-CONTACT-NAME DTSCS88
|
|
01226 MOVE MAP-MEDIA-NAME TO FFIS-MEDIA-CONTACT-NAME DTSCS88
|
|
01227 MOVE LCCM-CURR-RUN-DATE TO FFIS-CHNG-DATE. DTSCS88
|
|
01228 DTSCS88
|
|
01229 IF MAP-MEDIA-EMAIL NOT = DTSCS88
|
|
01230 FFIS-MEDIA-CONTACT-EMAIL DTSCS88
|
|
01231 MOVE MAP-MEDIA-EMAIL DTSCS88
|
|
01232 TO FFIS-MEDIA-CONTACT-EMAIL DTSCS88
|
|
01233 MOVE LCCM-CURR-RUN-DATE TO FFIS-CHNG-DATE. DTSCS88
|
|
01234 DTSCS88
|
|
01235 MOVE LCCM-HOLD-ADDRESS TO L072-ADDRESS. DTSCS88
|
|
01236 DTSCS88
|
|
01237 IF L072-ATTN-LINE NOT = FFIS-ATTN-LINE DTSCS88
|
|
01238 MOVE L072-ATTN-LINE TO FFIS-ATTN-LINE DTSCS88
|
|
01239 MOVE LCCM-CURR-RUN-DATE TO FFIS-CHNG-DATE. DTSCS88
|
|
01240 DTSCS88
|
|
01241 IF L072-DELIV-LINE-1 NOT = FFIS-DELIV-LINE-1 DTSCS88
|
|
01242 MOVE L072-DELIV-LINE-1 TO FFIS-DELIV-LINE-1 DTSCS88
|
|
01243 MOVE LCCM-CURR-RUN-DATE TO FFIS-CHNG-DATE. DTSCS88
|
|
01244 DTSCS88
|
|
01245 IF L072-DELIV-LINE-2 NOT = FFIS-DELIV-LINE-2 DTSCS88
|
|
01246 MOVE L072-DELIV-LINE-2 TO FFIS-DELIV-LINE-2 DTSCS88
|
|
01247 MOVE LCCM-CURR-RUN-DATE TO FFIS-CHNG-DATE. DTSCS88
|
|
01248 DTSCS88
|
|
01249 IF L072-CITY NOT = FFIS-CITY DTSCS88
|
|
01250 MOVE L072-CITY TO FFIS-CITY DTSCS88
|
|
01251 MOVE LCCM-CURR-RUN-DATE TO FFIS-CHNG-DATE. DTSCS88
|
|
01252 DTSCS88
|
|
01253 IF L072-ST NOT = FFIS-ST DTSCS88
|
|
01254 MOVE L072-ST TO FFIS-ST DTSCS88
|
|
01255 MOVE LCCM-CURR-RUN-DATE TO FFIS-CHNG-DATE. DTSCS88
|
|
01256 DTSCS88
|
|
01257 IF L072-ZIP NOT = FFIS-ZIP DTSCS88
|
|
01258 MOVE L072-ZIP TO FFIS-ZIP DTSCS88
|
|
01259 MOVE LCCM-CURR-RUN-DATE TO FFIS-CHNG-DATE. DTSCS88
|
|
01260 DTSCS88
|
|
01261 DTSCS88
|
|
01262 IF L072-ADVANCED-BARCODE NOT = FFIS-ADVANCED-BARCODE DTSCS88
|
|
01263 MOVE L072-ADVANCED-BARCODE TO FFIS-ADVANCED-BARCODE DTSCS88
|
|
01264 MOVE LCCM-CURR-RUN-DATE TO FFIS-CHNG-DATE. DTSCS88
|
|
01265 DTSCS88
|
|
01266 DTSCS88
|
|
01267 PERFORM P8912-UPDATE-PHONES THRU P8912-EXIT. DTSCS88
|
|
01268 DTSCS88
|
|
01269 P8910-EXIT. DTSCS88
|
|
01270 EXIT. DTSCS88
|
|
01271 DTSCS88
|
|
01272 DTSCS88
|
|
01273 P8912-UPDATE-PHONES. DTSCS88
|
|
01274 MOVE FFIS-BUSINESS-VOICE TO WRK-FFIS-PHONE. DTSCS88
|
|
01275 DTSCS88
|
|
01276 MOVE MAP-BUSINESS-VOICE-AREA TO L021-S-TNO-AREA. DTSCS88
|
|
01277 DTSCS88
|
|
01278 PERFORM S021-TELNO-FROM-SCREEN THRU S021-EXIT. DTSCS88
|
|
01279 DTSCS88
|
|
01280 IF L021-TNO NOT = WRK-FFIS-PHONE DTSCS88
|
|
01281 MOVE L021-TNO TO WRK-FFIS-PHONE DTSCS88
|
|
01282 MOVE WRK-FFIS-PHONE TO FFIS-BUSINESS-VOICE DTSCS88
|
|
01283 MOVE LCCM-CURR-RUN-DATE TO FFIS-CHNG-DATE. DTSCS88
|
|
01284 DTSCS88
|
|
01285 MOVE FFIS-BUSINESS-FAX TO WRK-FFIS-PHONE. DTSCS88
|
|
01286 DTSCS88
|
|
01287 MOVE MAP-BUSINESS-FAX-AREA TO L021-S-TNO-AREA. DTSCS88
|
|
01288 DTSCS88
|
|
01289 PERFORM S021-TELNO-FROM-SCREEN THRU S021-EXIT. DTSCS88
|
|
01290 DTSCS88
|
|
01291 IF L021-TNO NOT = WRK-FFIS-PHONE DTSCS88
|
|
01292 MOVE L021-TNO TO WRK-FFIS-PHONE DTSCS88
|
|
01293 MOVE WRK-FFIS-PHONE TO FFIS-BUSINESS-FAX DTSCS88
|
|
01294 MOVE LCCM-CURR-RUN-DATE TO FFIS-CHNG-DATE. DTSCS88
|
|
01295 DTSCS88
|
|
01296 MOVE FFIS-MEDIA-VOICE TO WRK-FFIS-PHONE. DTSCS88
|
|
01297 DTSCS88
|
|
01298 MOVE MAP-MEDIA-VOICE-AREA TO L021-S-TNO-AREA. DTSCS88
|
|
01299 DTSCS88
|
|
01300 PERFORM S021-TELNO-FROM-SCREEN THRU S021-EXIT. DTSCS88
|
|
01301 DTSCS88
|
|
01302 IF L021-TNO NOT = WRK-FFIS-PHONE DTSCS88
|
|
01303 MOVE L021-TNO TO WRK-FFIS-PHONE DTSCS88
|
|
01304 MOVE WRK-FFIS-PHONE TO FFIS-MEDIA-VOICE DTSCS88
|
|
01305 MOVE LCCM-CURR-RUN-DATE TO FFIS-CHNG-DATE. DTSCS88
|
|
01306 DTSCS88
|
|
01307 MOVE FFIS-MEDIA-FAX TO WRK-FFIS-PHONE. DTSCS88
|
|
01308 DTSCS88
|
|
01309 MOVE MAP-MEDIA-FAX-AREA TO L021-S-TNO-AREA. DTSCS88
|
|
01310 DTSCS88
|
|
01311 PERFORM S021-TELNO-FROM-SCREEN THRU S021-EXIT. DTSCS88
|
|
01312 DTSCS88
|
|
01313 IF L021-TNO NOT = WRK-FFIS-PHONE DTSCS88
|
|
01314 MOVE L021-TNO TO WRK-FFIS-PHONE DTSCS88
|
|
01315 MOVE WRK-FFIS-PHONE TO FFIS-MEDIA-FAX DTSCS88
|
|
01316 MOVE LCCM-CURR-RUN-DATE TO FFIS-CHNG-DATE. DTSCS88
|
|
01317 P8912-EXIT. DTSCS88
|
|
01318 EXIT. DTSCS88
|
|
01319 DTSCS88
|
|
01320 DTSCS88
|
|
01321 /*****************************************************************DTSCS88
|
|
01322 * LINKS TO UTILITY MODULES DTSCS88
|
|
01323 ******************************************************************DTSCS88
|
|
01324 DTSCS88
|
|
01325 S001-DATE. DTSCS88
|
|
01326 EXEC CICS LINK DTSCS88
|
|
01327 PROGRAM ('DTSCU001') DTSCS88
|
|
01328 COMMAREA (L001-COMM-AREA) DTSCS88
|
|
01329 END-EXEC. DTSCS88
|
|
01330 S001-EXIT. DTSCS88
|
|
01331 EXIT. DTSCS88
|
|
01332 DTSCS88
|
|
01333 DTSCS88
|
|
01334 DTSCS88
|
|
01335 S004-FIND-QUARTER. DTSCS88
|
|
01336 EXEC CICS LINK DTSCS88
|
|
01337 PROGRAM ('DTSCU004') DTSCS88
|
|
01338 COMMAREA (L004-COMM-AREA) DTSCS88
|
|
01339 END-EXEC. DTSCS88
|
|
01340 S004-EXIT. DTSCS88
|
|
01341 EXIT. DTSCS88
|
|
01342 DTSCS88
|
|
01343 S021-TELNO-FROM-SCREEN. DTSCS88
|
|
01344 EXEC CICS LINK DTSCS88
|
|
01345 PROGRAM ('DTSCU021') DTSCS88
|
|
01346 COMMAREA (L021-COMM-AREA) DTSCS88
|
|
01347 END-EXEC. DTSCS88
|
|
01348 S021-EXIT. DTSCS88
|
|
01349 EXIT. DTSCS88
|
|
01350 DTSCS88
|
|
01351 DTSCS88
|
|
01352 DTSCS88
|
|
01353 S072-ADDRESS-EDIT. DTSCS88
|
|
01354 EXEC CICS LINK DTSCS88
|
|
01355 PROGRAM ('DTSCU072') DTSCS88
|
|
01356 COMMAREA (L072-COMM-AREA) DTSCS88
|
|
01357 END-EXEC. DTSCS88
|
|
01358 S072-EXIT. DTSCS88
|
|
01359 EXIT. DTSCS88
|
|
01360 DTSCS88
|
|
01361 DTSCS88
|
|
01362 DTSCS88
|
|
01363 S073-TELNO-EDIT. DTSCS88
|
|
01364 EXEC CICS LINK DTSCS88
|
|
01365 PROGRAM ('DTSCU073') DTSCS88
|
|
01366 COMMAREA (L073-COMM-AREA) DTSCS88
|
|
01367 END-EXEC. DTSCS88
|
|
01368 S073-EXIT. DTSCS88
|
|
01369 EXIT. DTSCS88
|
|
01370 DTSCS88
|
|
01371 DTSCS88
|
|
01372 DTSCS88
|
|
01373 S803-REQ-SCR-ID-EDIT. DTSCS88
|
|
01374 EXEC CICS LINK DTSCS88
|
|
01375 PROGRAM ('DTSCU803') DTSCS88
|
|
01376 COMMAREA (DFHCOMMAREA) DTSCS88
|
|
01377 END-EXEC. DTSCS88
|
|
01378 S803-EXIT. DTSCS88
|
|
01379 EXIT. DTSCS88
|
|
01380 DTSCS88
|
|
01381 DTSCS88
|
|
01382 DTSCS88
|
|
01383 S804-INVALID-KEY. DTSCS88
|
|
01384 EXEC CICS LINK DTSCS88
|
|
01385 PROGRAM ('DTSCU804') DTSCS88
|
|
01386 COMMAREA (DFHCOMMAREA) DTSCS88
|
|
01387 END-EXEC. DTSCS88
|
|
01388 S804-EXIT. DTSCS88
|
|
01389 EXIT. DTSCS88
|
|
01390 DTSCS88
|
|
01391 DTSCS88
|
|
01392 DTSCS88
|
|
01393 S805-MSG-AREA. DTSCS88
|
|
01394 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS88
|
|
01395 DTSCS88
|
|
01396 EXEC CICS LINK DTSCS88
|
|
01397 PROGRAM ('DTSCU805') DTSCS88
|
|
01398 COMMAREA (L805-COMM-AREA) DTSCS88
|
|
01399 END-EXEC. DTSCS88
|
|
01400 DTSCS88
|
|
01401 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS88
|
|
01402 S805-EXIT. DTSCS88
|
|
01403 EXIT. DTSCS88
|
|
01404 DTSCS88
|
|
01405 DTSCS88
|
|
01406 DTSCS88
|
|
01407 S831-START-BROWSE. DTSCS88
|
|
01408 SET L831-START-BROWSE-88 TO TRUE. DTSCS88
|
|
01409 GO TO S831-IO. DTSCS88
|
|
01410 DTSCS88
|
|
01411 S831-READ. DTSCS88
|
|
01412 SET L831-READ-88 TO TRUE. DTSCS88
|
|
01413 GO TO S831-IO. DTSCS88
|
|
01414 DTSCS88
|
|
01415 S831-READ-PREV. DTSCS88
|
|
01416 SET L831-READ-PREV-88 TO TRUE. DTSCS88
|
|
01417 GO TO S831-IO. DTSCS88
|
|
01418 DTSCS88
|
|
01419 S831-READ-NEXT. DTSCS88
|
|
01420 SET L831-READ-NEXT-88 TO TRUE. DTSCS88
|
|
01421 GO TO S831-IO. DTSCS88
|
|
01422 DTSCS88
|
|
01423 S831-END-BROWSE. DTSCS88
|
|
01424 SET L831-END-BROWSE-88 TO TRUE. DTSCS88
|
|
01425 GO TO S831-IO. DTSCS88
|
|
01426 DTSCS88
|
|
01427 S831-REWRITE. DTSCS88
|
|
01428 SET L831-REWRITE-88 TO TRUE. DTSCS88
|
|
01429 GO TO S831-IO. DTSCS88
|
|
01430 DTSCS88
|
|
01431 S831-WRITE. DTSCS88
|
|
01432 SET L831-WRITE-88 TO TRUE. DTSCS88
|
|
01433 GO TO S831-IO. DTSCS88
|
|
01434 DTSCS88
|
|
01435 S831-DELETE. DTSCS88
|
|
01436 SET L831-DELETE-88 TO TRUE. DTSCS88
|
|
01437 GO TO S831-IO. DTSCS88
|
|
01438 DTSCS88
|
|
01439 S831-IO. DTSCS88
|
|
01440 DTSCS88
|
|
01441 EXEC CICS LINK DTSCS88
|
|
01442 PROGRAM ('DTSCU831') DTSCS88
|
|
01443 COMMAREA (L831-COMM-AREA) DTSCS88
|
|
01444 END-EXEC. DTSCS88
|
|
01445 DTSCS88
|
|
01446 IF L831-FILE-CLOSED-88 DTSCS88
|
|
01447 MOVE L831-MSG-AREA TO LCCM-MSG-AREA DTSCS88
|
|
01448 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS88
|
|
01449 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS88
|
|
01450 GO TO MAINLINE-EXIT. DTSCS88
|
|
01451 S831-EXIT. DTSCS88
|
|
01452 EXIT. DTSCS88
|
|
01453 DTSCS88
|
|
01454 DTSCS88
|
|
01455 S851-SCREEN-PROCESSING. DTSCS88
|
|
01456 EXEC CICS LINK DTSCS88
|
|
01457 PROGRAM ('DTSCU851') DTSCS88
|
|
01458 COMMAREA (L851-COMM-AREA) DTSCS88
|
|
01459 END-EXEC. DTSCS88
|
|
01460 S851-EXIT. DTSCS88
|
|
01461 EXIT. DTSCS88
|
|
01462 DTSCS88
|
|
01463 DTSCS88
|
|
01464 DTSCS88
|
|
01465 S899-ABEND. DTSCS88
|
|
01466 EXEC CICS ABEND DTSCS88
|
|
01467 ABCODE(WRK-ABEND-CD) DTSCS88
|
|
01468 END-EXEC. DTSCS88
|
|
01469 *S899-EXIT. DTSCS88
|
|
01470 *****EXIT. DTSCS88
|
|
01471 /*****************************************************************DTSCS88
|
|
01472 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS88
|
|
01473 ******************************************************************DTSCS88
|
|
01474 DTSCS88
|
|
01475 S1001-SCREEN-KEY-EDITS. DTSCS88
|
|
01476 PERFORM S1100-MAP-KEY THRU S1100-EXIT. DTSCS88
|
|
01477 S1001-EXIT. DTSCS88
|
|
01478 EXIT. DTSCS88
|
|
01479 DTSCS88
|
|
01480 S1002-SCREEN-DATA-EDITS. DTSCS88
|
|
01481 MOVE LOW-VALUES TO MAP-FISC-AGNT-CASS-CD. DTSCS88
|
|
01482 DTSCS88
|
|
01483 PERFORM S1300-FISC-AGNT-NAME THRU S1300-EXIT. DTSCS88
|
|
01484 DTSCS88
|
|
01485 PERFORM S1400-BUSINESS-NAME THRU S1400-EXIT. DTSCS88
|
|
01486 DTSCS88
|
|
01487 PERFORM S1500-BUSINESS-VOICE THRU S1500-EXIT. DTSCS88
|
|
01488 DTSCS88
|
|
01489 PERFORM S1600-BUSINESS-FAX THRU S1600-EXIT. DTSCS88
|
|
01490 DTSCS88
|
|
01491 PERFORM S1700-BUSINESS-EMAIL THRU S1700-EXIT. DTSCS88
|
|
01492 DTSCS88
|
|
01493 PERFORM S1800-MEDIA-VOICE THRU S1800-EXIT. DTSCS88
|
|
01494 DTSCS88
|
|
01495 PERFORM S1900-MEDIA-FAX THRU S1900-EXIT. DTSCS88
|
|
01496 DTSCS88
|
|
01497 PERFORM S2000-MEDIA-EMAIL THRU S2000-EXIT. DTSCS88
|
|
01498 DTSCS88
|
|
01499 PERFORM S2100-FFIS-ADDR THRU S2100-EXIT. DTSCS88
|
|
01500 DTSCS88
|
|
01501 PERFORM S2200-MEDIA-TYPE THRU S2200-EXIT. DTSCS88
|
|
01502 DTSCS88
|
|
01503 PERFORM S2300-DISK-SIZE THRU S2300-EXIT. DTSCS88
|
|
01504 DTSCS88
|
|
01505 S1002-EXIT. DTSCS88
|
|
01506 EXIT. DTSCS88
|
|
01507 /*****************************************************************DTSCS88
|
|
01508 * EMP-NO IS THE ONLY KEY FIELD FOR MPRF *DTSCS88
|
|
01509 ******************************************************************DTSCS88
|
|
01510 DTSCS88
|
|
01511 S1100-MAP-KEY. DTSCS88
|
|
01512 DTSCS88
|
|
01513 IF MAP-FISC-AGNT-CD = LOW-VALUES DTSCS88
|
|
01514 MOVE SPACES TO MAP-FISC-AGNT-CD. DTSCS88
|
|
01515 DTSCS88
|
|
01516 IF MAP-FISC-AGNT-SRVC = LOW-VALUES DTSCS88
|
|
01517 MOVE SPACES TO MAP-FISC-AGNT-SRVC. DTSCS88
|
|
01518 DTSCS88
|
|
01519 IF MAP-FISC-AGNT-CD = SPACES DTSCS88
|
|
01520 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS88
|
|
01521 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS88
|
|
01522 DTSCS88
|
|
01523 IF MAP-FISC-AGNT-SRVC = SPACES DTSCS88
|
|
01524 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS88
|
|
01525 PERFORM S1102-ERROR THRU S1102-EXIT. DTSCS88
|
|
01526 DTSCS88
|
|
01527 IF NOT MAP-SERVICE-VALID-88 DTSCS88
|
|
01528 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS88
|
|
01529 PERFORM S1102-ERROR THRU S1102-EXIT. DTSCS88
|
|
01530 S1100-EXIT. DTSCS88
|
|
01531 EXIT. DTSCS88
|
|
01532 DTSCS88
|
|
01533 DTSCS88
|
|
01534 S1101-ERROR. DTSCS88
|
|
01535 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-FISC-AGNT-CD-A. DTSCS88
|
|
01536 DTSCS88
|
|
01537 IF LCCM-NO-MSG DTSCS88
|
|
01538 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS88
|
|
01539 MOVE CATB-CURSOR TO MAP-FISC-AGNT-CD-L DTSCS88
|
|
01540 SET CURSOR-SET-YES TO TRUE. DTSCS88
|
|
01541 S1101-EXIT. DTSCS88
|
|
01542 EXIT. DTSCS88
|
|
01543 DTSCS88
|
|
01544 S1102-ERROR. DTSCS88
|
|
01545 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-FISC-AGNT-SRVC-A. DTSCS88
|
|
01546 DTSCS88
|
|
01547 IF LCCM-NO-MSG DTSCS88
|
|
01548 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS88
|
|
01549 MOVE CATB-CURSOR TO MAP-FISC-AGNT-SRVC-L DTSCS88
|
|
01550 SET CURSOR-SET-YES TO TRUE. DTSCS88
|
|
01551 S1102-EXIT. DTSCS88
|
|
01552 EXIT. DTSCS88
|
|
01553 /*****************************************************************DTSCS88
|
|
01554 * *DTSCS88
|
|
01555 ******************************************************************DTSCS88
|
|
01556 DTSCS88
|
|
01557 S1300-FISC-AGNT-NAME. DTSCS88
|
|
01558 DTSCS88
|
|
01559 IF MAP-FISC-AGNT-NAME > SPACES DTSCS88
|
|
01560 NEXT SENTENCE DTSCS88
|
|
01561 ELSE DTSCS88
|
|
01562 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS88
|
|
01563 PERFORM S1301-ERROR THRU S1301-EXIT. DTSCS88
|
|
01564 S1300-EXIT. DTSCS88
|
|
01565 EXIT. DTSCS88
|
|
01566 DTSCS88
|
|
01567 DTSCS88
|
|
01568 DTSCS88
|
|
01569 S1301-ERROR. DTSCS88
|
|
01570 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-FISC-AGNT-NAME-A. DTSCS88
|
|
01571 DTSCS88
|
|
01572 IF LCCM-NO-MSG DTSCS88
|
|
01573 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS88
|
|
01574 MOVE CATB-CURSOR TO MAP-FISC-AGNT-NAME-L DTSCS88
|
|
01575 SET CURSOR-SET-YES TO TRUE. DTSCS88
|
|
01576 S1301-EXIT. DTSCS88
|
|
01577 EXIT. DTSCS88
|
|
01578 DTSCS88
|
|
01579 /*****************************************************************DTSCS88
|
|
01580 * *DTSCS88
|
|
01581 ******************************************************************DTSCS88
|
|
01582 DTSCS88
|
|
01583 S1400-BUSINESS-NAME. DTSCS88
|
|
01584 DTSCS88
|
|
01585 IF MAP-BUSINESS-NAME > SPACES DTSCS88
|
|
01586 NEXT SENTENCE DTSCS88
|
|
01587 ELSE DTSCS88
|
|
01588 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS88
|
|
01589 PERFORM S1401-ERROR THRU S1401-EXIT. DTSCS88
|
|
01590 S1400-EXIT. DTSCS88
|
|
01591 EXIT. DTSCS88
|
|
01592 DTSCS88
|
|
01593 DTSCS88
|
|
01594 DTSCS88
|
|
01595 S1401-ERROR. DTSCS88
|
|
01596 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-FISC-AGNT-NAME-A. DTSCS88
|
|
01597 DTSCS88
|
|
01598 IF LCCM-NO-MSG DTSCS88
|
|
01599 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS88
|
|
01600 MOVE CATB-CURSOR TO MAP-BUSINESS-NAME-L DTSCS88
|
|
01601 SET CURSOR-SET-YES TO TRUE. DTSCS88
|
|
01602 S1401-EXIT. DTSCS88
|
|
01603 EXIT. DTSCS88
|
|
01604 DTSCS88
|
|
01605 DTSCS88
|
|
01606 ******************************************************************DTSCS88
|
|
01607 * *DTSCS88
|
|
01608 ******************************************************************DTSCS88
|
|
01609 DTSCS88
|
|
01610 S1500-BUSINESS-VOICE. DTSCS88
|
|
01611 DTSCS88
|
|
01612 MOVE MAP-BUSINESS-VOICE-AREA TO L021-S-TNO-AREA. DTSCS88
|
|
01613 DTSCS88
|
|
01614 PERFORM S021-TELNO-FROM-SCREEN THRU S021-EXIT. DTSCS88
|
|
01615 DTSCS88
|
|
01616 IF L021-NO-ENTRY DTSCS88
|
|
01617 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS88
|
|
01618 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS88
|
|
01619 GO TO S1500-EXIT DTSCS88
|
|
01620 END-IF. DTSCS88
|
|
01621 DTSCS88
|
|
01622 IF L021-VALID DTSCS88
|
|
01623 MOVE L021-TNO TO L073-TELEPHONE DTSCS88
|
|
01624 PERFORM S073-TELNO-EDIT THRU S073-EXIT DTSCS88
|
|
01625 IF L073-NOT-VALID DTSCS88
|
|
01626 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS88
|
|
01627 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS88
|
|
01628 ELSE DTSCS88
|
|
01629 MOVE L073-AREA-CD TO MAP-BUSINESS-VOICE-A-CD DTSCS88
|
|
01630 MOVE L073-PREFIX TO MAP-BUSINESS-VOICE-PREF DTSCS88
|
|
01631 MOVE L073-SUFFIX TO MAP-BUSINESS-VOICE-SUFF DTSCS88
|
|
01632 MOVE L073-EXT TO MAP-BUSINESS-VOICE-EXT DTSCS88
|
|
01633 ELSE DTSCS88
|
|
01634 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS88
|
|
01635 PERFORM S1501-ERROR THRU S1501-EXIT. DTSCS88
|
|
01636 S1500-EXIT. DTSCS88
|
|
01637 EXIT. DTSCS88
|
|
01638 DTSCS88
|
|
01639 DTSCS88
|
|
01640 S1501-ERROR. DTSCS88
|
|
01641 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS88
|
|
01642 TO MAP-BUSINESS-VOICE-A-CD-A DTSCS88
|
|
01643 MAP-BUSINESS-VOICE-PREF-A DTSCS88
|
|
01644 MAP-BUSINESS-VOICE-SUFF-A DTSCS88
|
|
01645 MAP-BUSINESS-VOICE-EXT-A. DTSCS88
|
|
01646 DTSCS88
|
|
01647 IF LCCM-NO-MSG DTSCS88
|
|
01648 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS88
|
|
01649 MOVE CATB-CURSOR TO MAP-BUSINESS-VOICE-A-CD-L DTSCS88
|
|
01650 SET CURSOR-SET-YES TO TRUE. DTSCS88
|
|
01651 S1501-EXIT. DTSCS88
|
|
01652 EXIT. DTSCS88
|
|
01653 DTSCS88
|
|
01654 DTSCS88
|
|
01655 S1600-BUSINESS-FAX. DTSCS88
|
|
01656 MOVE MAP-BUSINESS-FAX-AREA TO L021-S-TNO-AREA. DTSCS88
|
|
01657 DTSCS88
|
|
01658 PERFORM S021-TELNO-FROM-SCREEN THRU S021-EXIT. DTSCS88
|
|
01659 DTSCS88
|
|
01660 IF L021-NOT-VALID DTSCS88
|
|
01661 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS88
|
|
01662 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS88
|
|
01663 ELSE DTSCS88
|
|
01664 IF L021-VALID DTSCS88
|
|
01665 MOVE L021-TNO TO L073-TELEPHONE DTSCS88
|
|
01666 PERFORM S073-TELNO-EDIT THRU S073-EXIT DTSCS88
|
|
01667 IF L073-NOT-VALID DTSCS88
|
|
01668 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS88
|
|
01669 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS88
|
|
01670 ELSE DTSCS88
|
|
01671 MOVE L073-AREA-CD TO MAP-BUSINESS-FAX-A-CD DTSCS88
|
|
01672 MOVE L073-PREFIX TO MAP-BUSINESS-FAX-PREF DTSCS88
|
|
01673 MOVE L073-SUFFIX TO MAP-BUSINESS-FAX-SUFF DTSCS88
|
|
01674 MOVE L073-EXT TO MAP-BUSINESS-FAX-EXT. DTSCS88
|
|
01675 S1600-EXIT. DTSCS88
|
|
01676 EXIT. DTSCS88
|
|
01677 DTSCS88
|
|
01678 DTSCS88
|
|
01679 S1601-ERROR. DTSCS88
|
|
01680 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS88
|
|
01681 TO MAP-BUSINESS-FAX-A-CD-A DTSCS88
|
|
01682 MAP-BUSINESS-FAX-PREF-A DTSCS88
|
|
01683 MAP-BUSINESS-FAX-SUFF-A DTSCS88
|
|
01684 MAP-BUSINESS-FAX-EXT-A. DTSCS88
|
|
01685 DTSCS88
|
|
01686 IF LCCM-NO-MSG DTSCS88
|
|
01687 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS88
|
|
01688 MOVE CATB-CURSOR TO MAP-BUSINESS-FAX-A-CD-L DTSCS88
|
|
01689 SET CURSOR-SET-YES TO TRUE. DTSCS88
|
|
01690 S1601-EXIT. DTSCS88
|
|
01691 EXIT. DTSCS88
|
|
01692 DTSCS88
|
|
01693 DTSCS88
|
|
01694 DTSCS88
|
|
01695 DTSCS88
|
|
01696 S1700-BUSINESS-EMAIL. DTSCS88
|
|
01697 INSPECT MAP-BUSINESS-EMAIL CONVERTING LOW-VALUE TO SPACE. DTSCS88
|
|
01698 S1700-EXIT. DTSCS88
|
|
01699 EXIT. DTSCS88
|
|
01700 DTSCS88
|
|
01701 DTSCS88
|
|
01702 ******************************************************************DTSCS88
|
|
01703 * *DTSCS88
|
|
01704 ******************************************************************DTSCS88
|
|
01705 DTSCS88
|
|
01706 S1800-MEDIA-VOICE. DTSCS88
|
|
01707 MOVE MAP-MEDIA-VOICE-AREA TO L021-S-TNO-AREA. DTSCS88
|
|
01708 DTSCS88
|
|
01709 PERFORM S021-TELNO-FROM-SCREEN THRU S021-EXIT. DTSCS88
|
|
01710 DTSCS88
|
|
01711 IF L021-NOT-VALID DTSCS88
|
|
01712 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS88
|
|
01713 PERFORM S1801-ERROR THRU S1801-EXIT DTSCS88
|
|
01714 ELSE DTSCS88
|
|
01715 IF L021-VALID DTSCS88
|
|
01716 MOVE L021-TNO TO L073-TELEPHONE DTSCS88
|
|
01717 PERFORM S073-TELNO-EDIT THRU S073-EXIT DTSCS88
|
|
01718 IF L073-NOT-VALID DTSCS88
|
|
01719 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS88
|
|
01720 PERFORM S1801-ERROR THRU S1801-EXIT DTSCS88
|
|
01721 ELSE DTSCS88
|
|
01722 MOVE L073-AREA-CD TO MAP-MEDIA-VOICE-A-CD DTSCS88
|
|
01723 MOVE L073-PREFIX TO MAP-MEDIA-VOICE-PREF DTSCS88
|
|
01724 MOVE L073-SUFFIX TO MAP-MEDIA-VOICE-SUFF DTSCS88
|
|
01725 MOVE L073-EXT TO MAP-MEDIA-VOICE-EXT. DTSCS88
|
|
01726 S1800-EXIT. DTSCS88
|
|
01727 EXIT. DTSCS88
|
|
01728 DTSCS88
|
|
01729 DTSCS88
|
|
01730 DTSCS88
|
|
01731 S1801-ERROR. DTSCS88
|
|
01732 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS88
|
|
01733 TO MAP-MEDIA-VOICE-A-CD-A DTSCS88
|
|
01734 MAP-MEDIA-VOICE-PREF-A DTSCS88
|
|
01735 MAP-MEDIA-VOICE-SUFF-A DTSCS88
|
|
01736 MAP-MEDIA-VOICE-EXT-A. DTSCS88
|
|
01737 DTSCS88
|
|
01738 IF LCCM-NO-MSG DTSCS88
|
|
01739 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS88
|
|
01740 MOVE CATB-CURSOR TO MAP-MEDIA-VOICE-A-CD-L DTSCS88
|
|
01741 SET CURSOR-SET-YES TO TRUE. DTSCS88
|
|
01742 S1801-EXIT. DTSCS88
|
|
01743 EXIT. DTSCS88
|
|
01744 DTSCS88
|
|
01745 ******************************************************************DTSCS88
|
|
01746 * *DTSCS88
|
|
01747 ******************************************************************DTSCS88
|
|
01748 DTSCS88
|
|
01749 S1900-MEDIA-FAX. DTSCS88
|
|
01750 MOVE MAP-MEDIA-FAX-AREA TO L021-S-TNO-AREA. DTSCS88
|
|
01751 DTSCS88
|
|
01752 PERFORM S021-TELNO-FROM-SCREEN THRU S021-EXIT. DTSCS88
|
|
01753 DTSCS88
|
|
01754 IF L021-NOT-VALID DTSCS88
|
|
01755 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS88
|
|
01756 PERFORM S1901-ERROR THRU S1901-EXIT DTSCS88
|
|
01757 ELSE DTSCS88
|
|
01758 IF L021-VALID DTSCS88
|
|
01759 MOVE L021-TNO TO L073-TELEPHONE DTSCS88
|
|
01760 PERFORM S073-TELNO-EDIT THRU S073-EXIT DTSCS88
|
|
01761 IF L073-NOT-VALID DTSCS88
|
|
01762 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS88
|
|
01763 PERFORM S1901-ERROR THRU S1901-EXIT DTSCS88
|
|
01764 ELSE DTSCS88
|
|
01765 MOVE L073-AREA-CD TO MAP-MEDIA-FAX-A-CD DTSCS88
|
|
01766 MOVE L073-PREFIX TO MAP-MEDIA-FAX-PREF DTSCS88
|
|
01767 MOVE L073-SUFFIX TO MAP-MEDIA-FAX-SUFF DTSCS88
|
|
01768 MOVE L073-EXT TO MAP-MEDIA-FAX-EXT. DTSCS88
|
|
01769 S1900-EXIT. DTSCS88
|
|
01770 EXIT. DTSCS88
|
|
01771 DTSCS88
|
|
01772 DTSCS88
|
|
01773 DTSCS88
|
|
01774 DTSCS88
|
|
01775 S1901-ERROR. DTSCS88
|
|
01776 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS88
|
|
01777 TO MAP-MEDIA-FAX-A-CD-A DTSCS88
|
|
01778 MAP-MEDIA-FAX-PREF-A DTSCS88
|
|
01779 MAP-MEDIA-FAX-SUFF-A DTSCS88
|
|
01780 MAP-MEDIA-FAX-EXT-A. DTSCS88
|
|
01781 DTSCS88
|
|
01782 IF LCCM-NO-MSG DTSCS88
|
|
01783 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS88
|
|
01784 MOVE CATB-CURSOR TO MAP-MEDIA-FAX-A-CD-L DTSCS88
|
|
01785 SET CURSOR-SET-YES TO TRUE. DTSCS88
|
|
01786 S1901-EXIT. DTSCS88
|
|
01787 EXIT. DTSCS88
|
|
01788 DTSCS88
|
|
01789 DTSCS88
|
|
01790 ******************************************************************DTSCS88
|
|
01791 * *DTSCS88
|
|
01792 ******************************************************************DTSCS88
|
|
01793 DTSCS88
|
|
01794 S2000-MEDIA-EMAIL. DTSCS88
|
|
01795 INSPECT MAP-MEDIA-EMAIL CONVERTING LOW-VALUE TO SPACE. DTSCS88
|
|
01796 S2000-EXIT. DTSCS88
|
|
01797 EXIT. DTSCS88
|
|
01798 /*****************************************************************DTSCS88
|
|
01799 * STEP THROUGH ELF ADDRESS *DTSCS88
|
|
01800 ******************************************************************DTSCS88
|
|
01801 DTSCS88
|
|
01802 S2100-FFIS-ADDR. DTSCS88
|
|
01803 PERFORM S8010-READ-FFIS THRU S8010-EXIT. DTSCS88
|
|
01804 DTSCS88
|
|
01805 IF L831-OK-88 DTSCS88
|
|
01806 SET WRK-FFIS-YES-88 TO TRUE DTSCS88
|
|
01807 ELSE DTSCS88
|
|
01808 SET WRK-FFIS-NO-88 TO TRUE. DTSCS88
|
|
01809 DTSCS88
|
|
01810 IF MAP-FISC-AGNT-ATTN = SPACES OR LOW-VALUES DTSCS88
|
|
01811 MOVE SPACES TO MAP-FISC-AGNT-ATTN. DTSCS88
|
|
01812 DTSCS88
|
|
01813 IF MAP-FISC-AGNT-DLV1 = SPACES OR LOW-VALUES DTSCS88
|
|
01814 MOVE SPACES TO MAP-FISC-AGNT-DLV1. DTSCS88
|
|
01815 DTSCS88
|
|
01816 IF MAP-FISC-AGNT-DLV2 = SPACES OR LOW-VALUES DTSCS88
|
|
01817 MOVE SPACES TO MAP-FISC-AGNT-DLV2. DTSCS88
|
|
01818 DTSCS88
|
|
01819 IF MAP-FISC-AGNT-CASS-IND = SPACES OR LOW-VALUES DTSCS88
|
|
01820 MOVE SPACES TO MAP-FISC-AGNT-CASS-IND. DTSCS88
|
|
01821 DTSCS88
|
|
01822 IF MAP-FISC-AGNT-CITY = SPACES OR LOW-VALUES DTSCS88
|
|
01823 MOVE SPACES TO MAP-FISC-AGNT-CITY. DTSCS88
|
|
01824 DTSCS88
|
|
01825 IF MAP-FISC-AGNT-STATE = SPACES OR LOW-VALUES DTSCS88
|
|
01826 MOVE SPACES TO MAP-FISC-AGNT-STATE. DTSCS88
|
|
01827 DTSCS88
|
|
01828 IF MAP-FISC-AGNT-ZIPC = SPACES OR LOW-VALUES DTSCS88
|
|
01829 MOVE SPACES TO MAP-FISC-AGNT-ZIPC. DTSCS88
|
|
01830 DTSCS88
|
|
01831 PERFORM S2110-IS-MAP-ADDR-BLANK THRU S2110-EXIT. DTSCS88
|
|
01832 DTSCS88
|
|
01833 MOVE SPACE TO L072-ADDRESS. DTSCS88
|
|
01834 DTSCS88
|
|
01835 IF WRK-MAP-ADDR-HAS-DATA DTSCS88
|
|
01836 PERFORM S2120-ADDR THRU S2120-EXIT DTSCS88
|
|
01837 ELSE DTSCS88
|
|
01838 MOVE SPACE TO LCCM-HOLD-ADDRESS DTSCS88
|
|
01839 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS88
|
|
01840 PERFORM S2102-ERROR THRU S2102-EXIT. DTSCS88
|
|
01841 DTSCS88
|
|
01842 MOVE MAP-FISC-AGNT-STATE TO L073-ST. DTSCS88
|
|
01843 DTSCS88
|
|
01844 MOVE MAP-FISC-AGNT-ZIPC TO L073-ZIP. DTSCS88
|
|
01845 S2100-EXIT. DTSCS88
|
|
01846 EXIT. DTSCS88
|
|
01847 DTSCS88
|
|
01848 DTSCS88
|
|
01849 DTSCS88
|
|
01850 S2102-ERROR. DTSCS88
|
|
01851 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-FISC-AGNT-ATTN-A. DTSCS88
|
|
01852 DTSCS88
|
|
01853 IF LCCM-NO-MSG DTSCS88
|
|
01854 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS88
|
|
01855 MOVE CATB-CURSOR TO MAP-FISC-AGNT-ATTN-L DTSCS88
|
|
01856 SET CURSOR-SET-YES TO TRUE. DTSCS88
|
|
01857 S2102-EXIT. DTSCS88
|
|
01858 EXIT. DTSCS88
|
|
01859 DTSCS88
|
|
01860 /*****************************************************************DTSCS88
|
|
01861 * *DTSCS88
|
|
01862 ******************************************************************DTSCS88
|
|
01863 S2110-IS-MAP-ADDR-BLANK. DTSCS88
|
|
01864 IF ( MAP-FISC-AGNT-ATTN = SPACE OR LOW-VALUE ) DTSCS88
|
|
01865 AND ( MAP-FISC-AGNT-DLV1 = SPACE OR LOW-VALUE ) DTSCS88
|
|
01866 AND ( MAP-FISC-AGNT-DLV2 = SPACE OR LOW-VALUE ) DTSCS88
|
|
01867 AND ( MAP-FISC-AGNT-CITY = SPACE OR LOW-VALUE ) DTSCS88
|
|
01868 AND ( MAP-FISC-AGNT-STATE = SPACE OR LOW-VALUE ) DTSCS88
|
|
01869 AND ( MAP-FISC-AGNT-ZIPC = SPACE OR LOW-VALUE ) DTSCS88
|
|
01870 MOVE SPACE TO MAP-FISC-AGNT-CASS-IND DTSCS88
|
|
01871 MAP-FISC-AGNT-CASS-CD DTSCS88
|
|
01872 SET WRK-MAP-ADDR-BLANK TO TRUE DTSCS88
|
|
01873 ELSE DTSCS88
|
|
01874 SET WRK-MAP-ADDR-HAS-DATA TO TRUE. DTSCS88
|
|
01875 S2110-EXIT. DTSCS88
|
|
01876 EXIT. DTSCS88
|
|
01877 DTSCS88
|
|
01878 DTSCS88
|
|
01879 DTSCS88
|
|
01880 /*****************************************************************DTSCS88
|
|
01881 * *DTSCS88
|
|
01882 ******************************************************************DTSCS88
|
|
01883 DTSCS88
|
|
01884 S2120-ADDR. DTSCS88
|
|
01885 MOVE MAP-FISC-AGNT-CASS-IND TO L072-CASS-IND. DTSCS88
|
|
01886 DTSCS88
|
|
01887 SET L072-MTAD-88 TO TRUE. DTSCS88
|
|
01888 DTSCS88
|
|
01889 MOVE MAP-FISC-AGNT-NAME TO L072-NAME. DTSCS88
|
|
01890 DTSCS88
|
|
01891 MOVE MAP-FISC-AGNT-ATTN TO L072-ATTN-LINE. DTSCS88
|
|
01892 DTSCS88
|
|
01893 MOVE MAP-FISC-AGNT-DLV1 TO L072-DELIV-LINE-1. DTSCS88
|
|
01894 DTSCS88
|
|
01895 MOVE MAP-FISC-AGNT-DLV2 TO L072-DELIV-LINE-2. DTSCS88
|
|
01896 DTSCS88
|
|
01897 MOVE MAP-FISC-AGNT-CITY TO L072-CITY. DTSCS88
|
|
01898 DTSCS88
|
|
01899 MOVE MAP-FISC-AGNT-STATE TO L072-ST. DTSCS88
|
|
01900 DTSCS88
|
|
01901 MOVE MAP-FISC-AGNT-ZIPC TO L072-ZIP. DTSCS88
|
|
01902 DTSCS88
|
|
01903 DTSCS88
|
|
01904 * DEFAULT L072-CASS-IND IS BLANK, SO 'Y' IS DELIBERATE. DTSCS88
|
|
01905 DTSCS88
|
|
01906 IF L072-CASS-IND = 'Y' DTSCS88
|
|
01907 OR WRK-FFIS-NO-88 DTSCS88
|
|
01908 NEXT SENTENCE DTSCS88
|
|
01909 ELSE DTSCS88
|
|
01910 IF L072-ATTN-LINE = FFIS-ATTN-LINE DTSCS88
|
|
01911 AND L072-DELIV-LINE-1 = FFIS-DELIV-LINE-1 DTSCS88
|
|
01912 AND L072-DELIV-LINE-2 = FFIS-DELIV-LINE-2 DTSCS88
|
|
01913 AND L072-CITY = FFIS-CITY DTSCS88
|
|
01914 AND L072-ST = FFIS-ST DTSCS88
|
|
01915 AND L072-ZIP = FFIS-ZIP DTSCS88
|
|
01916 MOVE FFIS-ADVANCED-BARCODE DTSCS88
|
|
01917 TO L072-ADVANCED-BARCODE DTSCS88
|
|
01918 MOVE L072-ADDRESS TO LCCM-HOLD-ADDRESS DTSCS88
|
|
01919 GO TO S2120-EXIT. DTSCS88
|
|
01920 DTSCS88
|
|
01921 DTSCS88
|
|
01922 PERFORM S072-ADDRESS-EDIT THRU S072-EXIT. DTSCS88
|
|
01923 DTSCS88
|
|
01924 MOVE L072-ADDRESS TO LCCM-HOLD-ADDRESS. DTSCS88
|
|
01925 DTSCS88
|
|
01926 MOVE L072-CASS-IND TO MAP-FISC-AGNT-CASS-IND. DTSCS88
|
|
01927 DTSCS88
|
|
01928 MOVE L072-CASS-RETURN-CODES TO MAP-FISC-AGNT-CASS-CD. DTSCS88
|
|
01929 DTSCS88
|
|
01930 DTSCS88
|
|
01931 IF L072-ATTN-LINE-NOT-VALID-88 DTSCS88
|
|
01932 PERFORM S2121-ERROR THRU S2121-EXIT DTSCS88
|
|
01933 ELSE DTSCS88
|
|
01934 MOVE L072-ATTN-LINE TO MAP-FISC-AGNT-ATTN DTSCS88
|
|
01935 IF L072-ATTN-LINE-CHANGED-88 DTSCS88
|
|
01936 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS88
|
|
01937 TO MAP-FISC-AGNT-ATTN-A. DTSCS88
|
|
01938 DTSCS88
|
|
01939 DTSCS88
|
|
01940 IF L072-DELIV-LINE-1-NOT-VALID-88 DTSCS88
|
|
01941 PERFORM S2122-ERROR THRU S2122-EXIT DTSCS88
|
|
01942 ELSE DTSCS88
|
|
01943 MOVE L072-DELIV-LINE-1 TO MAP-FISC-AGNT-DLV1 DTSCS88
|
|
01944 IF L072-DELIV-LINE-1-CHANGED-88 DTSCS88
|
|
01945 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS88
|
|
01946 TO MAP-FISC-AGNT-DLV1-A. DTSCS88
|
|
01947 DTSCS88
|
|
01948 DTSCS88
|
|
01949 IF L072-DELIV-LINE-2-NOT-VALID-88 DTSCS88
|
|
01950 PERFORM S2123-ERROR THRU S2123-EXIT DTSCS88
|
|
01951 ELSE DTSCS88
|
|
01952 MOVE L072-DELIV-LINE-2 TO MAP-FISC-AGNT-DLV2 DTSCS88
|
|
01953 IF L072-DELIV-LINE-2-CHANGED-88 DTSCS88
|
|
01954 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS88
|
|
01955 TO MAP-FISC-AGNT-DLV2-A. DTSCS88
|
|
01956 DTSCS88
|
|
01957 DTSCS88
|
|
01958 IF L072-CITY-NOT-VALID-88 DTSCS88
|
|
01959 PERFORM S2124-ERROR THRU S2124-EXIT DTSCS88
|
|
01960 ELSE DTSCS88
|
|
01961 MOVE L072-CITY TO MAP-FISC-AGNT-CITY DTSCS88
|
|
01962 IF L072-CITY-CHANGED-88 DTSCS88
|
|
01963 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS88
|
|
01964 TO MAP-FISC-AGNT-CITY-A. DTSCS88
|
|
01965 DTSCS88
|
|
01966 DTSCS88
|
|
01967 IF L072-ST-NOT-VALID-88 DTSCS88
|
|
01968 PERFORM S2125-ERROR THRU S2125-EXIT DTSCS88
|
|
01969 ELSE DTSCS88
|
|
01970 MOVE L072-ST TO MAP-FISC-AGNT-STATE DTSCS88
|
|
01971 IF L072-ST-CHANGED-88 DTSCS88
|
|
01972 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS88
|
|
01973 TO MAP-FISC-AGNT-STATE-A. DTSCS88
|
|
01974 DTSCS88
|
|
01975 DTSCS88
|
|
01976 IF L072-ZIP-NOT-VALID-88 DTSCS88
|
|
01977 PERFORM S2126-ERROR THRU S2126-EXIT DTSCS88
|
|
01978 ELSE DTSCS88
|
|
01979 MOVE L072-ZIP TO MAP-FISC-AGNT-ZIPC DTSCS88
|
|
01980 IF L072-ZIP-CHANGED-88 DTSCS88
|
|
01981 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS88
|
|
01982 TO MAP-FISC-AGNT-ZIPC-A. DTSCS88
|
|
01983 DTSCS88
|
|
01984 DTSCS88
|
|
01985 IF L072-ADDRESS-NOT-VALID-88 DTSCS88
|
|
01986 IF LCCM-NO-MSG DTSCS88
|
|
01987 PERFORM S2121-ERROR THRU S2121-EXIT. DTSCS88
|
|
01988 S2120-EXIT. DTSCS88
|
|
01989 EXIT. DTSCS88
|
|
01990 DTSCS88
|
|
01991 DTSCS88
|
|
01992 DTSCS88
|
|
01993 S2121-ERROR. DTSCS88
|
|
01994 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-FISC-AGNT-ATTN-A. DTSCS88
|
|
01995 DTSCS88
|
|
01996 IF LCCM-NO-MSG DTSCS88
|
|
01997 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS88
|
|
01998 MOVE CATB-CURSOR TO MAP-FISC-AGNT-ATTN-L DTSCS88
|
|
01999 SET CURSOR-SET-YES TO TRUE. DTSCS88
|
|
02000 S2121-EXIT. DTSCS88
|
|
02001 EXIT. DTSCS88
|
|
02002 DTSCS88
|
|
02003 DTSCS88
|
|
02004 DTSCS88
|
|
02005 S2122-ERROR. DTSCS88
|
|
02006 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-FISC-AGNT-DLV1-A. DTSCS88
|
|
02007 DTSCS88
|
|
02008 IF LCCM-NO-MSG DTSCS88
|
|
02009 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS88
|
|
02010 MOVE CATB-CURSOR TO MAP-FISC-AGNT-DLV1-L DTSCS88
|
|
02011 SET CURSOR-SET-YES TO TRUE. DTSCS88
|
|
02012 S2122-EXIT. DTSCS88
|
|
02013 EXIT. DTSCS88
|
|
02014 DTSCS88
|
|
02015 DTSCS88
|
|
02016 DTSCS88
|
|
02017 S2123-ERROR. DTSCS88
|
|
02018 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-FISC-AGNT-DLV2-A. DTSCS88
|
|
02019 DTSCS88
|
|
02020 IF LCCM-NO-MSG DTSCS88
|
|
02021 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS88
|
|
02022 MOVE CATB-CURSOR TO MAP-FISC-AGNT-DLV2-L DTSCS88
|
|
02023 SET CURSOR-SET-YES TO TRUE. DTSCS88
|
|
02024 S2123-EXIT. DTSCS88
|
|
02025 EXIT. DTSCS88
|
|
02026 DTSCS88
|
|
02027 DTSCS88
|
|
02028 DTSCS88
|
|
02029 S2124-ERROR. DTSCS88
|
|
02030 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-FISC-AGNT-CITY-A. DTSCS88
|
|
02031 DTSCS88
|
|
02032 IF LCCM-NO-MSG DTSCS88
|
|
02033 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS88
|
|
02034 MOVE CATB-CURSOR TO MAP-FISC-AGNT-CITY-L DTSCS88
|
|
02035 SET CURSOR-SET-YES TO TRUE. DTSCS88
|
|
02036 S2124-EXIT. DTSCS88
|
|
02037 EXIT. DTSCS88
|
|
02038 DTSCS88
|
|
02039 DTSCS88
|
|
02040 DTSCS88
|
|
02041 S2125-ERROR. DTSCS88
|
|
02042 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-FISC-AGNT-STATE-A. DTSCS88
|
|
02043 DTSCS88
|
|
02044 IF LCCM-NO-MSG DTSCS88
|
|
02045 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS88
|
|
02046 MOVE CATB-CURSOR TO MAP-FISC-AGNT-STATE-L DTSCS88
|
|
02047 SET CURSOR-SET-YES TO TRUE. DTSCS88
|
|
02048 S2125-EXIT. DTSCS88
|
|
02049 EXIT. DTSCS88
|
|
02050 DTSCS88
|
|
02051 DTSCS88
|
|
02052 DTSCS88
|
|
02053 S2126-ERROR. DTSCS88
|
|
02054 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-FISC-AGNT-ZIPC-A. DTSCS88
|
|
02055 DTSCS88
|
|
02056 IF LCCM-NO-MSG DTSCS88
|
|
02057 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS88
|
|
02058 MOVE CATB-CURSOR TO MAP-FISC-AGNT-ZIPC-L DTSCS88
|
|
02059 SET CURSOR-SET-YES TO TRUE. DTSCS88
|
|
02060 S2126-EXIT. DTSCS88
|
|
02061 EXIT. DTSCS88
|
|
02062 DTSCS88
|
|
02063 /*****************************************************************DTSCS88
|
|
02064 * *DTSCS88
|
|
02065 ******************************************************************DTSCS88
|
|
02066 DTSCS88
|
|
02067 S2200-MEDIA-TYPE. DTSCS88
|
|
02068 IF MAP-FISC-AGNT-SRVC = '03' DTSCS88
|
|
02069 MOVE SPACES TO MAP-MEDIA-TYPE-CD DTSCS88
|
|
02070 GO TO S2200-EXIT DTSCS88
|
|
02071 END-IF. DTSCS88
|
|
02072 DTSCS88
|
|
02073 IF MAP-MEDIA-VALID-88 DTSCS88
|
|
02074 NEXT SENTENCE DTSCS88
|
|
02075 ELSE DTSCS88
|
|
02076 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS88
|
|
02077 PERFORM S2201-ERROR THRU S2201-EXIT. DTSCS88
|
|
02078 S2200-EXIT. DTSCS88
|
|
02079 EXIT. DTSCS88
|
|
02080 DTSCS88
|
|
02081 DTSCS88
|
|
02082 DTSCS88
|
|
02083 S2201-ERROR. DTSCS88
|
|
02084 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-MEDIA-TYPE-CD-A. DTSCS88
|
|
02085 DTSCS88
|
|
02086 IF LCCM-NO-MSG DTSCS88
|
|
02087 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS88
|
|
02088 MOVE CATB-CURSOR TO MAP-MEDIA-TYPE-CD-L DTSCS88
|
|
02089 SET CURSOR-SET-YES TO TRUE. DTSCS88
|
|
02090 S2201-EXIT. DTSCS88
|
|
02091 EXIT. DTSCS88
|
|
02092 /*****************************************************************DTSCS88
|
|
02093 * *DTSCS88
|
|
02094 ******************************************************************DTSCS88
|
|
02095 DTSCS88
|
|
02096 S2300-DISK-SIZE. DTSCS88
|
|
02097 IF MAP-FISC-AGNT-SRVC = '03' DTSCS88
|
|
02098 MOVE SPACES TO MAP-DISK-SIZE DTSCS88
|
|
02099 GO TO S2300-EXIT DTSCS88
|
|
02100 END-IF. DTSCS88
|
|
02101 DTSCS88
|
|
02102 IF MAP-DISK-SIZE = SPACES OR LOW-VALUES DTSCS88
|
|
02103 MOVE SPACE TO MAP-DISK-SIZE. DTSCS88
|
|
02104 DTSCS88
|
|
02105 IF MAP-DISK-VALID-88 DTSCS88
|
|
02106 NEXT SENTENCE DTSCS88
|
|
02107 ELSE DTSCS88
|
|
02108 MOVE MSG-E885-AREA TO WRK-MSG-AREA DTSCS88
|
|
02109 PERFORM S2301-ERROR THRU S2301-EXIT. DTSCS88
|
|
02110 DTSCS88
|
|
02111 IF MAP-MEDIA-DISKETTE-88 DTSCS88
|
|
02112 IF MAP-DISK-NONE-88 DTSCS88
|
|
02113 MOVE MSG-E884-AREA TO WRK-MSG-AREA DTSCS88
|
|
02114 PERFORM S2301-ERROR THRU S2301-EXIT DTSCS88
|
|
02115 ELSE DTSCS88
|
|
02116 NEXT SENTENCE DTSCS88
|
|
02117 ELSE DTSCS88
|
|
02118 IF NOT MAP-DISK-NONE-88 DTSCS88
|
|
02119 MOVE MSG-E883-AREA TO WRK-MSG-AREA DTSCS88
|
|
02120 PERFORM S2301-ERROR THRU S2301-EXIT. DTSCS88
|
|
02121 S2300-EXIT. DTSCS88
|
|
02122 EXIT. DTSCS88
|
|
02123 DTSCS88
|
|
02124 DTSCS88
|
|
02125 DTSCS88
|
|
02126 S2301-ERROR. DTSCS88
|
|
02127 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-DISK-SIZE-A. DTSCS88
|
|
02128 DTSCS88
|
|
02129 IF LCCM-NO-MSG DTSCS88
|
|
02130 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS88
|
|
02131 MOVE CATB-CURSOR TO MAP-DISK-SIZE-L DTSCS88
|
|
02132 SET CURSOR-SET-YES TO TRUE. DTSCS88
|
|
02133 S2301-EXIT. DTSCS88
|
|
02134 EXIT. DTSCS88
|
|
02135 /*****************************************************************DTSCS88
|
|
02136 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCS88
|
|
02137 ******************************************************************DTSCS88
|
|
02138 DTSCS88
|
|
02139 S5100-SET-LOCK-ATTRB. DTSCS88
|
|
02140 MOVE CATB-ASKIP-BRT-MDTON TO SCR-ATB-AN DTSCS88
|
|
02141 SCR-ATB-NUM. DTSCS88
|
|
02142 DTSCS88
|
|
02143 PERFORM S5110-HOLD-ATTRB THRU S5110-EXIT. DTSCS88
|
|
02144 DTSCS88
|
|
02145 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS88
|
|
02146 DTSCS88
|
|
02147 PERFORM S5120-RESTORE-ATTRB THRU S5120-EXIT. DTSCS88
|
|
02148 DTSCS88
|
|
02149 MOVE CATB-ASKIP-BRT-MDTON TO MAP-FISC-AGNT-CD-A DTSCS88
|
|
02150 MAP-FISC-AGNT-SRVC-A DTSCS88
|
|
02151 MAP-GOTO-A. DTSCS88
|
|
02152 S5100-EXIT. DTSCS88
|
|
02153 EXIT. DTSCS88
|
|
02154 DTSCS88
|
|
02155 DTSCS88
|
|
02156 DTSCS88
|
|
02157 S5110-HOLD-ATTRB. DTSCS88
|
|
02158 MOVE MAP-FISC-AGNT-ATTN-A TO HOLD-ATTN-A. DTSCS88
|
|
02159 DTSCS88
|
|
02160 MOVE MAP-FISC-AGNT-DLV1-A TO HOLD-DLV1-A. DTSCS88
|
|
02161 DTSCS88
|
|
02162 MOVE MAP-FISC-AGNT-DLV2-A TO HOLD-DLV2-A. DTSCS88
|
|
02163 DTSCS88
|
|
02164 MOVE MAP-FISC-AGNT-CITY-A TO HOLD-CITY-A. DTSCS88
|
|
02165 DTSCS88
|
|
02166 MOVE MAP-FISC-AGNT-STATE-A TO HOLD-STAT-A. DTSCS88
|
|
02167 DTSCS88
|
|
02168 MOVE MAP-FISC-AGNT-ZIPC-A TO HOLD-ZIPC-A. DTSCS88
|
|
02169 S5110-EXIT. DTSCS88
|
|
02170 EXIT. DTSCS88
|
|
02171 DTSCS88
|
|
02172 DTSCS88
|
|
02173 DTSCS88
|
|
02174 S5120-RESTORE-ATTRB. DTSCS88
|
|
02175 IF HOLD-ATTN-A = CATB-UNPROT-NORM-AN-MDTON DTSCS88
|
|
02176 MOVE CATB-ASKIP-NORM-MDTON TO MAP-FISC-AGNT-ATTN-A. DTSCS88
|
|
02177 DTSCS88
|
|
02178 IF HOLD-DLV1-A = CATB-UNPROT-NORM-AN-MDTON DTSCS88
|
|
02179 MOVE CATB-ASKIP-NORM-MDTON TO MAP-FISC-AGNT-DLV1-A. DTSCS88
|
|
02180 DTSCS88
|
|
02181 IF HOLD-DLV2-A = CATB-UNPROT-NORM-AN-MDTON DTSCS88
|
|
02182 MOVE CATB-ASKIP-NORM-MDTON TO MAP-FISC-AGNT-DLV2-A. DTSCS88
|
|
02183 DTSCS88
|
|
02184 IF HOLD-CITY-A = CATB-UNPROT-NORM-AN-MDTON DTSCS88
|
|
02185 MOVE CATB-ASKIP-NORM-MDTON TO MAP-FISC-AGNT-CITY-A. DTSCS88
|
|
02186 DTSCS88
|
|
02187 IF HOLD-STAT-A = CATB-UNPROT-NORM-AN-MDTON DTSCS88
|
|
02188 MOVE CATB-ASKIP-NORM-MDTON TO MAP-FISC-AGNT-STATE-A. DTSCS88
|
|
02189 DTSCS88
|
|
02190 IF HOLD-ZIPC-A = CATB-UNPROT-NORM-AN-MDTON DTSCS88
|
|
02191 MOVE CATB-ASKIP-NORM-MDTON TO MAP-FISC-AGNT-ZIPC-A. DTSCS88
|
|
02192 S5120-EXIT. DTSCS88
|
|
02193 EXIT. DTSCS88
|
|
02194 DTSCS88
|
|
02195 DTSCS88
|
|
02196 DTSCS88
|
|
02197 ******************************************************************DTSCS88
|
|
02198 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS88
|
|
02199 ******************************************************************DTSCS88
|
|
02200 DTSCS88
|
|
02201 S5200-SET-UPDATE-ATTRB. DTSCS88
|
|
02202 MOVE CATB-UNPROT-BRT-AN-MDTON TO SCR-ATB-AN. DTSCS88
|
|
02203 DTSCS88
|
|
02204 MOVE CATB-UNPROT-BRT-NUM-MDTON TO SCR-ATB-NUM. DTSCS88
|
|
02205 DTSCS88
|
|
02206 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS88
|
|
02207 S5200-EXIT. DTSCS88
|
|
02208 EXIT. DTSCS88
|
|
02209 DTSCS88
|
|
02210 DTSCS88
|
|
02211 DTSCS88
|
|
02212 ******************************************************************DTSCS88
|
|
02213 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS88
|
|
02214 ******************************************************************DTSCS88
|
|
02215 DTSCS88
|
|
02216 S5300-SET-INQ-ATTRB. DTSCS88
|
|
02217 MOVE CATB-ASKIP-BRT-MDTOFF TO SCR-ATB-AN DTSCS88
|
|
02218 SCR-ATB-NUM. DTSCS88
|
|
02219 DTSCS88
|
|
02220 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS88
|
|
02221 S5300-EXIT. DTSCS88
|
|
02222 EXIT. DTSCS88
|
|
02223 /*****************************************************************DTSCS88
|
|
02224 * *DTSCS88
|
|
02225 ******************************************************************DTSCS88
|
|
02226 DTSCS88
|
|
02227 S5900-SET-ATTRB. DTSCS88
|
|
02228 DTSCS88
|
|
02229 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS88
|
|
02230 DTSCS88
|
|
02231 MOVE CATB-ASKIP-BRT-MDTON TO MAP-FISC-AGNT-SRVC-DESC-A DTSCS88
|
|
02232 MAP-MEDIA-TYPE-DSCR-A DTSCS88
|
|
02233 MAP-MEDIA-CHNG-DATE-A DTSCS88
|
|
02234 MAP-ESTB-DATE-A DTSCS88
|
|
02235 MAP-CHNG-DATE-A DTSCS88
|
|
02236 MAP-FISC-AGNT-CASS-CD-A. DTSCS88
|
|
02237 DTSCS88
|
|
02238 MOVE SCR-ATB-AN TO MAP-FISC-AGNT-CD-A DTSCS88
|
|
02239 MAP-FISC-AGNT-NAME-A DTSCS88
|
|
02240 MAP-FISC-AGNT-SRVC-A DTSCS88
|
|
02241 MAP-BUSINESS-NAME-A DTSCS88
|
|
02242 MAP-BUSINESS-EMAIL-A DTSCS88
|
|
02243 MAP-DISK-SIZE-A DTSCS88
|
|
02244 MAP-MEDIA-TYPE-CD-A DTSCS88
|
|
02245 MAP-MEDIA-NAME-A DTSCS88
|
|
02246 MAP-MEDIA-EMAIL-A DTSCS88
|
|
02247 MAP-BUSINESS-VOICE-A-CD-A DTSCS88
|
|
02248 MAP-BUSINESS-VOICE-PREF-A DTSCS88
|
|
02249 MAP-BUSINESS-VOICE-SUFF-A DTSCS88
|
|
02250 MAP-BUSINESS-VOICE-EXT-A DTSCS88
|
|
02251 MAP-BUSINESS-FAX-A-CD-A DTSCS88
|
|
02252 MAP-BUSINESS-FAX-PREF-A DTSCS88
|
|
02253 MAP-BUSINESS-FAX-SUFF-A DTSCS88
|
|
02254 MAP-BUSINESS-FAX-EXT-A DTSCS88
|
|
02255 MAP-MEDIA-VOICE-A-CD-A DTSCS88
|
|
02256 MAP-MEDIA-VOICE-PREF-A DTSCS88
|
|
02257 MAP-MEDIA-VOICE-SUFF-A DTSCS88
|
|
02258 MAP-MEDIA-VOICE-EXT-A DTSCS88
|
|
02259 MAP-MEDIA-FAX-A-CD-A DTSCS88
|
|
02260 MAP-MEDIA-FAX-PREF-A DTSCS88
|
|
02261 MAP-MEDIA-FAX-SUFF-A DTSCS88
|
|
02262 MAP-MEDIA-FAX-EXT-A DTSCS88
|
|
02263 MAP-FISC-AGNT-ATTN-A DTSCS88
|
|
02264 MAP-FISC-AGNT-DLV1-A DTSCS88
|
|
02265 MAP-FISC-AGNT-DLV2-A DTSCS88
|
|
02266 MAP-FISC-AGNT-CASS-IND-A DTSCS88
|
|
02267 MAP-FISC-AGNT-CITY-A DTSCS88
|
|
02268 MAP-FISC-AGNT-STATE-A DTSCS88
|
|
02269 MAP-FISC-AGNT-ZIPC-A. DTSCS88
|
|
02270 S5900-EXIT. DTSCS88
|
|
02271 EXIT. DTSCS88
|
|
02272 /*****************************************************************DTSCS88
|
|
02273 * FILE READ COMMON PREPARATION ROUTINES *DTSCS88
|
|
02274 ******************************************************************DTSCS88
|
|
02275 DTSCS88
|
|
02276 DTSCS88
|
|
02277 S8010-READ-FFIS. DTSCS88
|
|
02278 MOVE LOW-VALUES TO FFIS-KEY-AREA. DTSCS88
|
|
02279 DTSCS88
|
|
02280 MOVE MAP-FISC-AGNT-CD TO FFIS-FISCAL-AGENT-CD. DTSCS88
|
|
02281 MOVE MAP-FISC-AGNT-SRVC TO FFIS-SERVICE-TYPE. DTSCS88
|
|
02282 DTSCS88
|
|
02283 SET FFIS-FIS-88 TO TRUE. DTSCS88
|
|
02284 DTSCS88
|
|
02285 MOVE FFIS-KEY-AREA TO FSKL-KEY-AREA. DTSCS88
|
|
02286 DTSCS88
|
|
02287 PERFORM S831-READ THRU S831-EXIT. DTSCS88
|
|
02288 S8010-EXIT. DTSCS88
|
|
02289 EXIT. DTSCS88
|
|
02290 /*****************************************************************DTSCS88
|
|
02291 * MAP ROUTINES *DTSCS88
|
|
02292 ******************************************************************DTSCS88
|
|
02293 DTSCS88
|
|
02294 S9100-RECEIVE. DTSCS88
|
|
02295 SET L851-RECEIVE-88 TO TRUE. DTSCS88
|
|
02296 DTSCS88
|
|
02297 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS88
|
|
02298 DTSCS88
|
|
02299 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS88
|
|
02300 DTSCS88
|
|
02301 MOVE L851-AID TO LCCM-AID. DTSCS88
|
|
02302 DTSCS88
|
|
02303 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS88
|
|
02304 S9100-EXIT. DTSCS88
|
|
02305 EXIT. DTSCS88
|
|
02306 DTSCS88
|
|
02307 DTSCS88
|
|
02308 DTSCS88
|
|
02309 ******************************************************************DTSCS88
|
|
02310 * *DTSCS88
|
|
02311 ******************************************************************DTSCS88
|
|
02312 DTSCS88
|
|
02313 S9200-SEND-DATAONLY. DTSCS88
|
|
02314 MOVE LOW-VALUES TO MAP-AREA. DTSCS88
|
|
02315 DTSCS88
|
|
02316 IF LCCM-NO-MSG DTSCS88
|
|
02317 NEXT SENTENCE DTSCS88
|
|
02318 ELSE DTSCS88
|
|
02319 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS88
|
|
02320 DTSCS88
|
|
02321 IF CURSOR-SET-GOTO DTSCS88
|
|
02322 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS88
|
|
02323 ELSE DTSCS88
|
|
02324 MOVE CATB-CURSOR TO MAP-FISC-AGNT-CD-L. DTSCS88
|
|
02325 DTSCS88
|
|
02326 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS88
|
|
02327 DTSCS88
|
|
02328 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS88
|
|
02329 DTSCS88
|
|
02330 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS88
|
|
02331 S9200-EXIT. DTSCS88
|
|
02332 EXIT. DTSCS88
|
|
02333 DTSCS88
|
|
02334 DTSCS88
|
|
02335 DTSCS88
|
|
02336 ******************************************************************DTSCS88
|
|
02337 * *DTSCS88
|
|
02338 ******************************************************************DTSCS88
|
|
02339 DTSCS88
|
|
02340 S9300-SEND-MAP. DTSCS88
|
|
02341 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS88
|
|
02342 DTSCS88
|
|
02343 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS88
|
|
02344 DTSCS88
|
|
02345 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS88
|
|
02346 DTSCS88
|
|
02347 IF SCR-ACCESS-UPDATE DTSCS88
|
|
02348 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS88
|
|
02349 ELSE DTSCS88
|
|
02350 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS88
|
|
02351 DTSCS88
|
|
02352 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS88
|
|
02353 DTSCS88
|
|
02354 IF CURSOR-SET-NO DTSCS88
|
|
02355 MOVE CATB-CURSOR TO MAP-FISC-AGNT-CD-L. DTSCS88
|
|
02356 DTSCS88
|
|
02357 SET L851-SEND-88 TO TRUE. DTSCS88
|
|
02358 DTSCS88
|
|
02359 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS88
|
|
02360 DTSCS88
|
|
02361 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS88
|
|
02362 S9300-EXIT. DTSCS88
|
|
02363 EXIT. DTSCS88
|
|
02364 DTSCS88
|
|
02365 DTSCS88
|
|
02366 DTSCS88
|
|
02367 S9310-UPDATE-FKEYS. DTSCS88
|
|
02368 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS88
|
|
02369 DTSCS88
|
|
02370 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS88
|
|
02371 DTSCS88
|
|
02372 MOVE CFKD-ADD TO MAP-KEY-ADD. DTSCS88
|
|
02373 DTSCS88
|
|
02374 MOVE CFKD-MOD TO MAP-KEY-MOD. DTSCS88
|
|
02375 DTSCS88
|
|
02376 MOVE CFKD-DEL TO MAP-KEY-DEL. DTSCS88
|
|
02377 DTSCS88
|
|
02378 IF LCCM-SCR-CLEAR DTSCS88
|
|
02379 MOVE LOW-VALUES TO MAP-KEY-MOD DTSCS88
|
|
02380 MAP-KEY-DEL DTSCS88
|
|
02381 ELSE DTSCS88
|
|
02382 IF LCCM-SCR-INQUIRE DTSCS88
|
|
02383 MOVE LOW-VALUES TO MAP-KEY-ADD DTSCS88
|
|
02384 ELSE DTSCS88
|
|
02385 IF LCCM-SCR-UPDATE-LOCKED DTSCS88
|
|
02386 MOVE LOW-VALUES TO MAP-KEY-BACK DTSCS88
|
|
02387 MAP-KEY-FWRD DTSCS88
|
|
02388 MAP-KEY-ADD DTSCS88
|
|
02389 MAP-KEY-MOD DTSCS88
|
|
02390 MAP-KEY-DEL. DTSCS88
|
|
02391 S9310-EXIT. DTSCS88
|
|
02392 EXIT. DTSCS88
|
|
02393 DTSCS88
|
|
02394 DTSCS88
|
|
02395 DTSCS88
|
|
02396 S9320-INQUIRY-FKEYS. DTSCS88
|
|
02397 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS88
|
|
02398 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS88
|
|
02399 MOVE LOW-VALUES TO MAP-KEY-ADD DTSCS88
|
|
02400 MAP-KEY-MOD DTSCS88
|
|
02401 MAP-KEY-DEL. DTSCS88
|
|
02402 S9320-EXIT. DTSCS88
|
|
02403 EXIT. DTSCS88
|
|
02404 /*****************************************************************DTSCS88
|
|
02405 * *DTSCS88
|
|
02406 ******************************************************************DTSCS88
|
|
02407 DTSCS88
|
|
02408 S9900-PREPARE-SEND. DTSCS88
|
|
02409 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS88
|
|
02410 LCCM-SCR-ID. DTSCS88
|
|
02411 DTSCS88
|
|
02412 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS88
|
|
02413 DTSCS88
|
|
02414 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS88
|
|
02415 S9900-EXIT. DTSCS88
|
|
02416 EXIT. DTSCS88
|