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