3376 lines
264 KiB
COBOL
3376 lines
264 KiB
COBOL
00001 IDENTIFICATION DIVISION. 02/07/12
|
|
00002 PROGRAM-ID. DTSCS69. DTSCS69
|
|
00003 AUTHOR. NGI. LV003
|
|
00004 DATE-WRITTEN. OCT 2009. DTSCS69
|
|
00005 DATE-COMPILED. DTSCS69
|
|
00006 SKIP3 DTSCS69
|
|
00007 ***** DTSCS69
|
|
00008 * DTSCS69
|
|
00009 * FUNCTION: AUDIT SCHEDULING INQUIRY/UPDATE DTSCS69
|
|
00010 * SCREEN PROCESSOR. DTSCS69
|
|
00011 * DTSCS69
|
|
00012 * DTSCS69
|
|
00013 * MODIFICATION LOG: DTSCS69
|
|
00014 * DTSCS69
|
|
00015 * 10/19/09 INITIAL DEVLOPMENT. COPIED FROM DTSCS64 DTSCS69
|
|
00016 * REFERENCE RFP: PROGRAMMER: ZL1 DTSCS69
|
|
00017 * DTSCS69
|
|
00018 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS69
|
|
00019 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS69
|
|
00020 * WORK ORDER: PROGRAMMER: XXX DTSCS69
|
|
00021 * DTSCS69
|
|
00022 * DTSCS69
|
|
00023 * DESCRIPTION: DTSCS69
|
|
00024 * DTSCS69
|
|
00025 * CLEAR: DTSCS69
|
|
00026 * DTSCS69
|
|
00027 * FIELD DISPLAYED: MAP-ASSIGN-NO (FROM LCCM-ASSIGN-NO). DTSCS69
|
|
00028 * DTSCS69
|
|
00029 * DTSCS69
|
|
00030 * JUMP: DTSCS69
|
|
00031 * DTSCS69
|
|
00032 * F17 REGISTRATION INQUIRY (11). DTSCS69
|
|
00033 * F21 FIELD ASSIGNMENT INQUIRY/UPDATE (62). DTSCS69
|
|
00034 * F22 AUDIT RESULTS INQUIRY/UPDATE (63). DTSCS69
|
|
00035 * DTSCS69
|
|
00036 * DTSCS69
|
|
00037 * INQUIRY: DTSCS69
|
|
00038 * DTSCS69
|
|
00039 * CONTROL FIELD(S): MAP-ASSIGN-NO. DTSCS69
|
|
00040 * DTSCS69
|
|
00041 * JUMP IN: IF LCCM-ASSIGN-NO = LCCM-SCR69-HOLD-AREA DTSCS69
|
|
00042 * ASSIGN-NO DTSCS69
|
|
00043 * DISPLAY RECORD INDICATED BY DTSCS69
|
|
00044 * LCCM-SCR69-HOLD-AREA DTSCS69
|
|
00045 * ELSE DTSCS69
|
|
00046 * DISPLAY LAST PAGE OF DATA ASSOCIATED DTSCS69
|
|
00047 * WITH LCCM-ASSIGN-NO. DTSCS69
|
|
00048 * DTSCS69
|
|
00049 * ENTER, F05, F06, F07, F08: STANDARD PAGING. DTSCS69
|
|
00050 * DTSCS69
|
|
00051 * DISPLAY SEQUENCE: ASCENDING ON DTSCS69
|
|
00052 * MAUY-CALENDAR-YEAR. DTSCS69
|
|
00053 * DTSCS69
|
|
00054 * PAGE INITIALLY DISPLAYED: LAST. DTSCS69
|
|
00055 * DTSCS69
|
|
00056 * JUMP OUT: NO SPECIAL PROCESSING. DTSCS69
|
|
00057 * DTSCS69
|
|
00058 * NOTE. IF MFAS-NON-AUDIT-88, THEN RATHER THEN DISPLAYING DTSCS69
|
|
00059 * THE MAUY RECORD, DISPLAY AN ERROR MESSAGE. DTSCS69
|
|
00060 * DTSCS69
|
|
00061 * DTSCS69
|
|
00062 * LCCM DATA ELEMENT MAINTENANCE: DTSCS69
|
|
00063 * DTSCS69
|
|
00064 * STANDARD LCCM-ASSIGN-NO MAINTENANCE. DTSCS69
|
|
00065 * DTSCS69
|
|
00066 * MAINTAIN LCCM-EMP-NO IN SYNC WITH LCCM-ASSIGN-NO. DTSCS69
|
|
00067 * DTSCS69
|
|
00068 * STORE PAGING CONTROL INFORMATION IN LCCM-SCR-HOLD-AREA. DTSCS69
|
|
00069 * DTSCS69
|
|
00070 * DTSCS69
|
|
00071 * UPDATE: DTSCS69
|
|
00072 * DTSCS69
|
|
00073 * ADD DTSCS69
|
|
00074 * MOD DTSCS69
|
|
00075 * DEL DTSCS69
|
|
00076 * DTSCS69
|
|
00077 * DTSCS69
|
|
00078 * RECORDS READ: DTSCS69
|
|
00079 * DTSCS69
|
|
00080 * MASTER: DTSCS69
|
|
00081 * DTSCS69
|
|
00082 * MPRF DTSCS69
|
|
00083 * MFAS DTSCS69
|
|
00084 * MAUR DTSCS69
|
|
00085 * MAUY DTSCS69
|
|
00086 * DTSCS69
|
|
00087 * DTSCS69
|
|
00088 * ALTERNATE INDEX: DTSCS69
|
|
00089 * DTSCS69
|
|
00090 * IFAN. DTSCS69
|
|
00091 * DTSCS69
|
|
00092 * DTSCS69
|
|
00093 * REFERENCE: DTSCS69
|
|
00094 * DTSCS69
|
|
00095 * NONE. DTSCS69
|
|
00096 * DTSCS69
|
|
00097 * DTSCS69
|
|
00098 * ACCOUNTING TRANSACTION COLLECTION: DTSCS69
|
|
00099 * DTSCS69
|
|
00100 * NONE. DTSCS69
|
|
00101 * DTSCS69
|
|
00102 * DTSCS69
|
|
00103 * RECORDS UPDATED: DTSCS69
|
|
00104 * DTSCS69
|
|
00105 * MASTER: DTSCS69
|
|
00106 * DTSCS69
|
|
00107 * MAUY (ADD, REWRITE, DELETE) DTSCS69
|
|
00108 * DTSCS69
|
|
00109 * DTSCS69
|
|
00110 * REFERENCE: DTSCS69
|
|
00111 * DTSCS69
|
|
00112 * NONE. DTSCS69
|
|
00113 * DTSCS69
|
|
00114 * DTSCS69
|
|
00115 * ACCOUNTING TRANSACTION COLLECTION: DTSCS69
|
|
00116 * DTSCS69
|
|
00117 * NONE. DTSCS69
|
|
00118 * DTSCS69
|
|
00119 * DTSCS69
|
|
00120 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCS69
|
|
00121 * DTSCS69
|
|
00122 * NONE. DTSCS69
|
|
00123 * DTSCS69
|
|
00124 * DTSCS69
|
|
00125 * TEMPORARY STORAGE USAGE: DTSCS69
|
|
00126 * DTSCS69
|
|
00127 * NONE DTSCS69
|
|
00128 * DTSCS69
|
|
00129 * DTSCS69
|
|
00130 * MODULES LINKED TO: DTSCS69
|
|
00131 * DTSCS69
|
|
00132 * DTSCS69
|
|
00133 * DTSCU001 DATE EDIT/CONVERSION. DTSCS69
|
|
00134 * DTSCU022 FIELD ASSIGNMENT NUMBER FROM SCREEN FORMAT/EDIT. DTSCS69
|
|
00135 * DTSCU221 MPRF-UPDATE DATA ELEMENT MAINTENANCE. DTSCS69
|
|
00136 * DTSCU810 MASTER FILE INPUT/OUTPUT. DTSCS69
|
|
00137 * DTSCS69
|
|
00138 * DTSCS69
|
|
00139 ***** DTSCS69
|
|
00140 DTSCS69
|
|
00141 ENVIRONMENT DIVISION. DTSCS69
|
|
00142 DTSCS69
|
|
00143 DATA DIVISION. DTSCS69
|
|
00144 DTSCS69
|
|
00145 WORKING-STORAGE SECTION. DTSCS69
|
|
001455 77 PAN-VALET PICTURE X(24) VALUE '003DTSCS69 02/07/12'. DTSCS69
|
|
00146 DTSCS69
|
|
00147 01 WRK-AREA. DTSCS69
|
|
00148 05 WRK-ABEND-CD PIC X(04) VALUE 'S69 '. DTSCS69
|
|
00149 DTSCS69
|
|
00150 05 WRK-SCR-ID. DTSCS69
|
|
00151 10 WRK-SCR-ID-N PIC 9(02) VALUE 69. DTSCS69
|
|
00152 DTSCS69
|
|
00153 05 WRK-F03-SCR-ID PIC X(02) VALUE '60'. DTSCS69
|
|
00154 DTSCS69
|
|
00155 05 SCR-ACCESS-IND PIC X(01). DTSCS69
|
|
00156 88 SCR-ACCESS-INQ VALUE '1'. DTSCS69
|
|
00157 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS69
|
|
00158 DTSCS69
|
|
00159 05 CURSOR-SET-IND PIC X(01). DTSCS69
|
|
00160 88 CURSOR-SET-YES VALUE 'Y'. DTSCS69
|
|
00161 88 CURSOR-SET-NO VALUE 'N'. DTSCS69
|
|
00162 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS69
|
|
00163 DTSCS69
|
|
00164 05 REQ-IND PIC X(01). DTSCS69
|
|
00165 88 REQ-ERROR VALUE 'O'. DTSCS69
|
|
00166 88 REQ-JUMP VALUE 'J'. DTSCS69
|
|
00167 88 REQ-INQUIRE VALUE 'I'. DTSCS69
|
|
00168 88 REQ-CLEAR VALUE 'C'. DTSCS69
|
|
00169 88 REQ-EDIT VALUE 'E'. DTSCS69
|
|
00170 88 REQ-UPDATE VALUE 'U'. DTSCS69
|
|
00171 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS69
|
|
00172 DTSCS69
|
|
00173 05 RESP-IND PIC X(01). DTSCS69
|
|
00174 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS69
|
|
00175 88 RESP-SEND-MAP VALUE 'M'. DTSCS69
|
|
00176 88 RESP-JUMP VALUE 'J'. DTSCS69
|
|
00177 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS69
|
|
00178 DTSCS69
|
|
00179 05 WRK-SEQ-NO PIC X(03). DTSCS69
|
|
00180 05 WRK-ID-NO PIC S9(03) COMP-3. DTSCS69
|
|
00181 05 WRK-AUDIT-DATE PIC S9(09) COMP-3. DTSCS69
|
|
00182 DTSCS69
|
|
00183 05 WRK-AUDIT-TIME. DTSCS69
|
|
00184 10 WRK-AUDIT-TIME-HH PIC 9(02) COMP-3. DTSCS69
|
|
00185 10 WRK-AUDIT-TIME-MM PIC 9(02) COMP-3. DTSCS69
|
|
00186 10 WRK-AUDIT-TIME-SS PIC 9(02) COMP-3. DTSCS69
|
|
00187 05 WRK-AUDIT-TIME-N PIC S9(06) COMP-3. DTSCS69
|
|
00188 DTSCS69
|
|
00189 05 WRK-MFSL-PHONE-NUMBERS. DTSCS69
|
|
00190 10 WRK-MFSL-PHONE OCCURS 3. DTSCS69
|
|
00191 15 WRK-MFSL-PHONE-A-CD PIC X(03). DTSCS69
|
|
00192 15 WRK-MFSL-PHONE-PREF PIC X(03). DTSCS69
|
|
00193 15 WRK-MFSL-PHONE-SUFF PIC X(04). DTSCS69
|
|
00194 15 WRK-MFSL-PHONE-EXT PIC X(05). DTSCS69
|
|
00195 05 WRK-331-CONSTANTS. DTSCS69
|
|
00196 10 FILLER PIC X(11) VALUE 'MFSL-VOICE1'. DTSCS69
|
|
00197 10 FILLER PIC X(11) VALUE 'MFSL-VOICE2'. DTSCS69
|
|
00198 10 FILLER PIC X(11) VALUE 'MFSL-FAX '. DTSCS69
|
|
00199 05 FILLER REDEFINES WRK-331-CONSTANTS. DTSCS69
|
|
00200 10 WRK-331-FIELD-NAME OCCURS 3 PIC X(11). DTSCS69
|
|
00201 SKIP3 DTSCS69
|
|
00202 DTSCS69
|
|
00203 05 WRK-MSG-AREA PIC X(64). DTSCS69
|
|
00204 DTSCS69
|
|
00205 05 WRK-ATB-AN PIC X(01). DTSCS69
|
|
00206 05 WRK-ATB-NUM PIC X(01). DTSCS69
|
|
00207 DTSCS69
|
|
00208 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSCS69
|
|
00209 05 WRK-ASSIGN-NO PIC S9(09) COMP-3. DTSCS69
|
|
00210 05 WRK-PHONE PIC 9(03). DTSCS69
|
|
00211 05 MFSL-REC-CHANGED PIC S9(01). DTSCS69
|
|
00212 05 WRITE-R615-REC PIC S9(01). DTSCS69
|
|
00213 DTSCS69
|
|
00214 05 WRK-MPRF-IND PIC X(01). DTSCS69
|
|
00215 88 WRK-MPRF-YES-88 VALUE 'Y'. DTSCS69
|
|
00216 88 WRK-MPRF-NO-88 VALUE 'N'. DTSCS69
|
|
00217 DTSCS69
|
|
00218 05 WRK-DISPLAY PIC 9(11). DTSCS69
|
|
00219 DTSCS69
|
|
00220 05 FILLER REDEFINES WRK-DISPLAY. DTSCS69
|
|
00221 10 FILLER PIC X(04). DTSCS69
|
|
00222 10 WRK-DISPLAY-ASSIGN-NO-1 PIC X(02). DTSCS69
|
|
00223 10 WRK-DISPLAY-ASSIGN-NO-2 PIC X(05). DTSCS69
|
|
00224 DTSCS69
|
|
00225 05 FILLER REDEFINES WRK-DISPLAY. DTSCS69
|
|
00226 10 FILLER PIC X(05). DTSCS69
|
|
00227 10 WRK-DISPLAY-EMP-NO-1 PIC X(03). DTSCS69
|
|
00228 10 WRK-DISPLAY-EMP-NO-2 PIC X(03). DTSCS69
|
|
00229 DTSCS69
|
|
00230 05 FILLER REDEFINES WRK-DISPLAY. DTSCS69
|
|
00231 10 FILLER PIC 9(05). DTSCS69
|
|
00232 10 WRK-DISPLAY-YR PIC 9(02). DTSCS69
|
|
00233 10 WRK-DISPLAY-MO PIC 9(02). DTSCS69
|
|
00234 10 WRK-DISPLAY-DA PIC 9(02). DTSCS69
|
|
00235 10 WRK-DISPLAY-CAL-YR REDEFINES WRK-DISPLAY-DA DTSCS69
|
|
00236 PIC 9(02). DTSCS69
|
|
00237 DTSCS69
|
|
00238 05 FILLER REDEFINES WRK-DISPLAY. DTSCS69
|
|
00239 10 FILLER PIC X(05). DTSCS69
|
|
00240 10 WRK-DISPLAY-HH PIC X(02). DTSCS69
|
|
00241 10 WRK-DISPLAY-MM PIC X(02). DTSCS69
|
|
00242 10 WRK-DISPLAY-SS PIC X(02). DTSCS69
|
|
00243 05 FILLER REDEFINES WRK-DISPLAY. DTSCS69
|
|
00244 10 FILLER PIC X(09). DTSCS69
|
|
00245 10 WRK-DISPLAY-ID-NO PIC X(02). DTSCS69
|
|
00246 SKIP3 DTSCS69
|
|
00247 05 INQUIRY-CONTROL-AREA. DTSCS69
|
|
00248 10 LAST-REC-NUM PIC S9(08) COMP. DTSCS69
|
|
00249 10 WS-REC-NUM PIC S9(08) COMP. DTSCS69
|
|
00250 DTSCS69
|
|
00251 10 LAST-REC-KEY-AREA PIC X(16). DTSCS69
|
|
00252 10 SCR-REC-KEY-AREA PIC X(16). DTSCS69
|
|
00253 DTSCS69
|
|
00254 10 WS-REC-FOUND-IND PIC X(01). DTSCS69
|
|
00255 10 WRK-OCC PIC S9(04) COMP. DTSCS69
|
|
00256 EJECT DTSCS69
|
|
00257 * SCREEN SPECIFIC ERROR MESSAGES DTSCS69
|
|
00258 DTSCS69
|
|
00259 01 MSG-LITERALS. DTSCS69
|
|
00260 DTSCS69
|
|
00261 05 MSG-E691-AREA. DTSCS69
|
|
00262 10 FILLER PIC X(04) VALUE 'E691'. DTSCS69
|
|
00263 10 FILLER PIC X(30) DTSCS69
|
|
00264 VALUE 'AUDIT MUST BE ACTIVE TO SCHEDU'. DTSCS69
|
|
00265 10 FILLER PIC X(30) DTSCS69
|
|
00266 VALUE 'LE AN APPOINTMENT '. DTSCS69
|
|
00267 DTSCS69
|
|
00268 05 MSG-E692-AREA. DTSCS69
|
|
00269 10 FILLER PIC X(04) VALUE 'E692'. DTSCS69
|
|
00270 10 FILLER PIC X(30) DTSCS69
|
|
00271 VALUE 'ASSIGNMENT NO DOES NOT EXIST.'. DTSCS69
|
|
00272 10 FILLER PIC X(30) DTSCS69
|
|
00273 VALUE ' '. DTSCS69
|
|
00274 DTSCS69
|
|
00275 05 MSG-E693-AREA. DTSCS69
|
|
00276 10 FILLER PIC X(04) VALUE 'E693'. DTSCS69
|
|
00277 10 FILLER PIC X(30) DTSCS69
|
|
00278 VALUE 'NON AUDIT ASSIGNMENT '. DTSCS69
|
|
00279 10 FILLER PIC X(30) DTSCS69
|
|
00280 VALUE ' '. DTSCS69
|
|
00281 DTSCS69
|
|
00282 05 MSG-E694-AREA. DTSCS69
|
|
00283 10 FILLER PIC X(04) VALUE 'E694'. DTSCS69
|
|
00284 10 FILLER PIC X(30) DTSCS69
|
|
00285 VALUE 'AUDIT DATE MUST BE > THAN STAR'. DTSCS69
|
|
00286 10 FILLER PIC X(30) DTSCS69
|
|
00287 VALUE 'T DATE '. DTSCS69
|
|
00288 DTSCS69
|
|
00289 05 MSG-E695-AREA. DTSCS69
|
|
00290 10 FILLER PIC X(04) VALUE 'E695'. DTSCS69
|
|
00291 10 MSG-EMP-NO-IN-ERR PIC 999B999. DTSCS69
|
|
00292 10 MSG-E695-MSG PIC X(50) VALUE DTSCS69
|
|
00293 ' ALTERNATE INDEX FILE ERROR - CONTACT DP'. DTSCS69
|
|
00294 DTSCS69
|
|
00295 05 MSG-E696-AREA. DTSCS69
|
|
00296 10 FILLER PIC X(04) VALUE 'E696'. DTSCS69
|
|
00297 10 FILLER PIC X(30) DTSCS69
|
|
00298 VALUE 'CANNOT SCHEDULE APPOINTMENT, A'. DTSCS69
|
|
00299 10 FILLER PIC X(30) DTSCS69
|
|
00300 VALUE 'UDIT HAS BEEN KILLED OR HELD.'. DTSCS69
|
|
00301 DTSCS69
|
|
00302 EJECT DTSCS69
|
|
00303 01 L001-COMM-AREA. DTSCS69
|
|
00304 ++INCLUDE DTSIL001 DTSCS69
|
|
00305 EJECT DTSCS69
|
|
00306 01 L007-COMM-AREA. DTSCS69
|
|
00307 ++INCLUDE DTSIL007 DTSCS69
|
|
00308 EJECT DTSCS69
|
|
00309 01 L011-COMM-AREA. DTSCS69
|
|
00310 ++INCLUDE DTSIL011 DTSCS69
|
|
00311 EJECT DTSCS69
|
|
00312 01 L013-COMM-AREA. DTSCS69
|
|
00313 ++INCLUDE DTSIL013 DTSCS69
|
|
00314 EJECT DTSCS69
|
|
00315 01 L018-COMM-AREA. DTSCS69
|
|
00316 ++INCLUDE DTSIL018 DTSCS69
|
|
00317 EJECT DTSCS69
|
|
00318 01 L015-COMM-AREA. DTSCS69
|
|
00319 ++INCLUDE DTSIL015 DTSCS69
|
|
00320 EJECT DTSCS69
|
|
00321 01 L021-COMM-AREA. DTSCS69
|
|
00322 ++INCLUDE DTSIL021 DTSCS69
|
|
00323 EJECT DTSCS69
|
|
00324 01 L025-COMM-AREA. DTSCS69
|
|
00325 ++INCLUDE DTSIL025 DTSCS69
|
|
00326 EJECT DTSCS69
|
|
00327 01 L062-COMM-AREA. DTSCS69
|
|
00328 ++INCLUDE DTSIL062 DTSCS69
|
|
00329 EJECT DTSCS69
|
|
00330 01 L072-COMM-AREA. DTSCS69
|
|
00331 ++INCLUDE DTSIL072 DTSCS69
|
|
00332 EJECT DTSCS69
|
|
00333 01 L073-COMM-AREA. DTSCS69
|
|
00334 ++INCLUDE DTSIL073 DTSCS69
|
|
00335 EJECT DTSCS69
|
|
00336 01 L331-COMM-AREA. DTSCS69
|
|
00337 ++INCLUDE DTSIL331 DTSCS69
|
|
00338 EJECT DTSCS69
|
|
00339 01 L111-COMM-AREA. DTSCS69
|
|
00340 ++INCLUDE DTSIL111 DTSCS69
|
|
00341 EJECT DTSCS69
|
|
00342 01 L112-COMM-AREA. DTSCS69
|
|
00343 ++INCLUDE DTSIL112 DTSCS69
|
|
00344 EJECT DTSCS69
|
|
00345 01 L022-COMM-AREA. DTSCS69
|
|
00346 ++INCLUDE DTSIL022 DTSCS69
|
|
00347 EJECT DTSCS69
|
|
00348 01 L203-COMM-AREA. DTSCS69
|
|
00349 ++INCLUDE DTSIL203 DTSCS69
|
|
00350 EJECT DTSCS69
|
|
00351 01 L221-COMM-AREA. DTSCS69
|
|
00352 ++INCLUDE DTSIL221 DTSCS69
|
|
00353 EJECT DTSCS69
|
|
00354 01 L805-COMM-AREA. DTSCS69
|
|
00355 ++INCLUDE DTSIL805 DTSCS69
|
|
00356 EJECT DTSCS69
|
|
00357 01 L810-COMM-AREA. DTSCS69
|
|
00358 05 L810-CONTROL-BLOCK. DTSCS69
|
|
00359 ++INCLUDE DTSIL810 DTSCS69
|
|
00360 EJECT DTSCS69
|
|
00361 05 MSKL-REC. DTSCS69
|
|
00362 ++INCLUDE DTSIMSKL DTSCS69
|
|
00363 EJECT DTSCS69
|
|
00364 * DTSCS69
|
|
00365 01 R615-REC. DTSCS69
|
|
00366 ++INCLUDE DTSIR615 DTSCS69
|
|
00367 EJECT DTSCS69
|
|
00368 * DTSCS69
|
|
00369 01 MPRF-REC. DTSCS69
|
|
00370 ++INCLUDE DTSIMPRF DTSCS69
|
|
00371 EJECT DTSCS69
|
|
00372 01 MFAS-REC. DTSCS69
|
|
00373 ++INCLUDE DTSIMFAS DTSCS69
|
|
00374 EJECT DTSCS69
|
|
00375 01 MFSL-REC. DTSCS69
|
|
00376 ++INCLUDE DTSIMFSL DTSCS69
|
|
00377 EJECT DTSCS69
|
|
00378 01 L851-COMM-AREA. DTSCS69
|
|
00379 ++INCLUDE DTSIL851 DTSCS69
|
|
00380 DTSCS69
|
|
00381 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS69
|
|
00382 ++INCLUDE DTSIS69 DTSCS69
|
|
00383 EJECT DTSCS69
|
|
00384 01 L821-COMM-AREA. DTSCS69
|
|
00385 05 L821-CONTROL-BLOCK. DTSCS69
|
|
00386 ++INCLUDE DTSIL821 DTSCS69
|
|
00387 DTSCS69
|
|
00388 05 ISKL-REC. DTSCS69
|
|
00389 ++INCLUDE DTSIISKL DTSCS69
|
|
00390 05 FILLER REDEFINES ISKL-REC. DTSCS69
|
|
00391 ++INCLUDE DTSIIFAN DTSCS69
|
|
00392 01 L825-COMM-AREA. DTSCS69
|
|
00393 05 L825-CONTROL-BLOCK. DTSCS69
|
|
00394 ++INCLUDE DTSIL825 DTSCS69
|
|
00395 DTSCS69
|
|
00396 05 RSKL-REC. DTSCS69
|
|
00397 ++INCLUDE DTSIRSK1 DTSCS69
|
|
00398 EJECT DTSCS69
|
|
00399 01 CATB-LITERALS. DTSCS69
|
|
00400 ++INCLUDE DTSICATB DTSCS69
|
|
00401 DTSCS69
|
|
00402 01 CFKD-LITERALS. DTSCS69
|
|
00403 ++INCLUDE DTSICFKD DTSCS69
|
|
00404 DTSCS69
|
|
00405 01 CECD-LITERALS. DTSCS69
|
|
00406 ++INCLUDE DTSICECD DTSCS69
|
|
00407 DTSCS69
|
|
00408 01 CPCD-LITERALS. DTSCS69
|
|
00409 ++INCLUDE DTSICPCD DTSCS69
|
|
00410 DTSCS69
|
|
00411 01 MMAX-LITERALS. DTSCS69
|
|
00412 ++INCLUDE DTSIMMAX DTSCS69
|
|
00413 EJECT DTSCS69
|
|
00414 LINKAGE SECTION. DTSCS69
|
|
00415 DTSCS69
|
|
00416 01 DFHCOMMAREA. DTSCS69
|
|
00417 ++INCLUDE DTSILCCM DTSCS69
|
|
00418 EJECT DTSCS69
|
|
00419 ******************************************************************DTSCS69
|
|
00420 * *DTSCS69
|
|
00421 ******************************************************************DTSCS69
|
|
00422 DTSCS69
|
|
00423 PROCEDURE DIVISION. DTSCS69
|
|
00424 DTSCS69
|
|
00425 MOVE +0 TO WRK-EMP-NO. DTSCS69
|
|
00426 SET WRK-MPRF-NO-88 TO TRUE. DTSCS69
|
|
00427 MOVE +0 TO WRK-ID-NO. DTSCS69
|
|
00428 MOVE +0 TO WRK-ASSIGN-NO. DTSCS69
|
|
00429 DTSCS69
|
|
00430 MOVE LOW-VALUES TO MAP-AREA. DTSCS69
|
|
00431 DTSCS69
|
|
00432 SET CURSOR-SET-NO TO TRUE. DTSCS69
|
|
00433 DTSCS69
|
|
00434 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N) DTSCS69
|
|
00435 TO SCR-ACCESS-IND. DTSCS69
|
|
00436 DTSCS69
|
|
00437 MOVE SPACE TO REQ-IND. DTSCS69
|
|
00438 DTSCS69
|
|
00439 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS69
|
|
00440 DTSCS69
|
|
00441 *----------------------------------------------------- DTSCS69
|
|
00442 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS69
|
|
00443 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS69
|
|
00444 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS69
|
|
00445 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS69
|
|
00446 * DTSCS69
|
|
00447 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS69
|
|
00448 * PROCESSED. DTSCS69
|
|
00449 * DTSCS69
|
|
00450 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS69
|
|
00451 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS69
|
|
00452 * WORK STATION OPERATOR. DTSCS69
|
|
00453 *----------------------------------------------------- DTSCS69
|
|
00454 DTSCS69
|
|
00455 MOVE SPACE TO RESP-IND. DTSCS69
|
|
00456 DTSCS69
|
|
00457 IF REQ-ERROR DTSCS69
|
|
00458 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS69
|
|
00459 ELSE DTSCS69
|
|
00460 IF REQ-JUMP DTSCS69
|
|
00461 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS69
|
|
00462 ELSE DTSCS69
|
|
00463 IF REQ-CLEAR DTSCS69
|
|
00464 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS69
|
|
00465 ELSE DTSCS69
|
|
00466 IF REQ-CURSOR-TO-GOTO DTSCS69
|
|
00467 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS69
|
|
00468 ELSE DTSCS69
|
|
00469 IF REQ-INQUIRE DTSCS69
|
|
00470 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS69
|
|
00471 ELSE DTSCS69
|
|
00472 IF REQ-EDIT DTSCS69
|
|
00473 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS69
|
|
00474 ELSE DTSCS69
|
|
00475 IF REQ-UPDATE DTSCS69
|
|
00476 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS69
|
|
00477 ELSE DTSCS69
|
|
00478 GO TO S899-ABEND. DTSCS69
|
|
00479 DTSCS69
|
|
00480 *----------------------------------------------------- DTSCS69
|
|
00481 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS69
|
|
00482 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS69
|
|
00483 *----------------------------------------------------- DTSCS69
|
|
00484 DTSCS69
|
|
00485 IF RESP-SEND-MAP DTSCS69
|
|
00486 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS69
|
|
00487 SET LCCM-END-TASK-88 TO TRUE DTSCS69
|
|
00488 ELSE DTSCS69
|
|
00489 IF RESP-SEND-MSGONLY DTSCS69
|
|
00490 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS69
|
|
00491 SET LCCM-END-TASK-88 TO TRUE DTSCS69
|
|
00492 ELSE DTSCS69
|
|
00493 IF RESP-JUMP DTSCS69
|
|
00494 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS69
|
|
00495 ELSE DTSCS69
|
|
00496 IF RESP-CURSOR-TO-GOTO DTSCS69
|
|
00497 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS69
|
|
00498 SET LCCM-END-TASK-88 TO TRUE DTSCS69
|
|
00499 ELSE DTSCS69
|
|
00500 GO TO S899-ABEND. DTSCS69
|
|
00501 DTSCS69
|
|
00502 MAINLINE-EXIT. DTSCS69
|
|
00503 DTSCS69
|
|
00504 EXEC CICS DTSCS69
|
|
00505 RETURN DTSCS69
|
|
00506 END-EXEC. DTSCS69
|
|
00507 DTSCS69
|
|
00508 GOBACK. DTSCS69
|
|
00509 EJECT DTSCS69
|
|
00510 /*****************************************************************DTSCS69
|
|
00511 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS69
|
|
00512 ******************************************************************DTSCS69
|
|
00513 P1000-ANALYZE-REQUEST. DTSCS69
|
|
00514 DTSCS69
|
|
00515 *----------------------------------------------------- DTSCS69
|
|
00516 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS69
|
|
00517 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS69
|
|
00518 * REPLACED WITH ENTER) DTSCS69
|
|
00519 *----------------------------------------------------- DTSCS69
|
|
00520 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS69
|
|
00521 SET LCCM-ENTER-88 TO TRUE DTSCS69
|
|
00522 IF LCCM-ASSIGN-NO > ZERO DTSCS69
|
|
00523 SET REQ-INQUIRE TO TRUE DTSCS69
|
|
00524 MOVE LCCM-ASSIGN-NO TO WRK-DISPLAY DTSCS69
|
|
00525 MOVE WRK-DISPLAY-ASSIGN-NO-1 TO MAP-ASSIGN-NO-1 DTSCS69
|
|
00526 MOVE WRK-DISPLAY-ASSIGN-NO-2 TO MAP-ASSIGN-NO-2 DTSCS69
|
|
00527 IF LCCM-EMP-NO > ZERO DTSCS69
|
|
00528 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS69
|
|
00529 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS69
|
|
00530 ELSE DTSCS69
|
|
00531 SET REQ-INQUIRE TO TRUE DTSCS69
|
|
00532 ELSE DTSCS69
|
|
00533 SET REQ-INQUIRE TO TRUE DTSCS69
|
|
00534 END-IF DTSCS69
|
|
00535 GO TO P1000-EXIT. DTSCS69
|
|
00536 DTSCS69
|
|
00537 *----------------------------------------------------- DTSCS69
|
|
00538 * MAP IS RECEIVED DTSCS69
|
|
00539 *----------------------------------------------------- DTSCS69
|
|
00540 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS69
|
|
00541 DTSCS69
|
|
00542 *----------------------------------------------------- DTSCS69
|
|
00543 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS69
|
|
00544 * WORK STATION DTSCS69
|
|
00545 *----------------------------------------------------- DTSCS69
|
|
00546 IF LCCM-CLEAR-88 DTSCS69
|
|
00547 SET REQ-CLEAR TO TRUE DTSCS69
|
|
00548 GO TO P1000-EXIT. DTSCS69
|
|
00549 DTSCS69
|
|
00550 *----------------------------------------------------- DTSCS69
|
|
00551 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS69
|
|
00552 *----------------------------------------------------- DTSCS69
|
|
00553 IF LCCM-SCR-UPDATE-LOCKED DTSCS69
|
|
00554 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS69
|
|
00555 GO TO P1000-EXIT. DTSCS69
|
|
00556 DTSCS69
|
|
00557 *----------------------------------------------------- DTSCS69
|
|
00558 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS69
|
|
00559 *----------------------------------------------------- DTSCS69
|
|
00560 IF LCCM-PA2-88 DTSCS69
|
|
00561 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS69
|
|
00562 GO TO P1000-EXIT. DTSCS69
|
|
00563 DTSCS69
|
|
00564 *----------------------------------------------------- DTSCS69
|
|
00565 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS69
|
|
00566 *----------------------------------------------------- DTSCS69
|
|
00567 IF LCCM-PA-88 DTSCS69
|
|
00568 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS69
|
|
00569 SET REQ-ERROR TO TRUE DTSCS69
|
|
00570 GO TO P1000-EXIT. DTSCS69
|
|
00571 DTSCS69
|
|
00572 *----------------------------------------------------- DTSCS69
|
|
00573 * IF F12 IS PRESSED AND UPDATE NOT IN PROGRESS THEN DTSCS69
|
|
00574 * CLEAR SCREEN DTSCS69
|
|
00575 *----------------------------------------------------- DTSCS69
|
|
00576 IF LCCM-F12-88 DTSCS69
|
|
00577 MOVE LOW-VALUES TO MAP-AREA DTSCS69
|
|
00578 SET REQ-CLEAR TO TRUE DTSCS69
|
|
00579 GO TO P1000-EXIT. DTSCS69
|
|
00580 DTSCS69
|
|
00581 *----------------------------------------------------- DTSCS69
|
|
00582 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS69
|
|
00583 *----------------------------------------------------- DTSCS69
|
|
00584 IF LCCM-F03-88 DTSCS69
|
|
00585 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS69
|
|
00586 SET REQ-JUMP TO TRUE DTSCS69
|
|
00587 GO TO P1000-EXIT. DTSCS69
|
|
00588 DTSCS69
|
|
00589 *----------------------------------------------------- DTSCS69
|
|
00590 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS69
|
|
00591 *----------------------------------------------------- DTSCS69
|
|
00592 IF LCCM-F04-88 DTSCS69
|
|
00593 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS69
|
|
00594 SET REQ-JUMP TO TRUE DTSCS69
|
|
00595 GO TO P1000-EXIT. DTSCS69
|
|
00596 DTSCS69
|
|
00597 *--------------------------------------------------------- DTSCS69
|
|
00598 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS69
|
|
00599 * CORRESPONDENCE SCREEN. DTSCS69
|
|
00600 *--------------------------------------------------------- DTSCS69
|
|
00601 DTSCS69
|
|
00602 IF LCCM-F14-88 DTSCS69
|
|
00603 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS69
|
|
00604 SET REQ-JUMP TO TRUE DTSCS69
|
|
00605 GO TO P1000-EXIT. DTSCS69
|
|
00606 DTSCS69
|
|
00607 *----------------------------------------------------- DTSCS69
|
|
00608 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS69
|
|
00609 * REQUESTED SCREEN TYPE DTSCS69
|
|
00610 *----------------------------------------------------- DTSCS69
|
|
00611 * IF LCCM-F17-88 DTSCS69
|
|
00612 * MOVE '11' TO LCCM-REQ-SCR-ID DTSCS69
|
|
00613 * SET REQ-JUMP TO TRUE DTSCS69
|
|
00614 * GO TO P1000-EXIT. DTSCS69
|
|
00615 * DTSCS69
|
|
00616 * IF LCCM-F21-88 DTSCS69
|
|
00617 * MOVE '62' TO LCCM-REQ-SCR-ID DTSCS69
|
|
00618 * SET REQ-JUMP TO TRUE DTSCS69
|
|
00619 * GO TO P1000-EXIT. DTSCS69
|
|
00620 * DTSCS69
|
|
00621 * IF LCCM-F22-88 DTSCS69
|
|
00622 * MOVE '63' TO LCCM-REQ-SCR-ID DTSCS69
|
|
00623 * SET REQ-JUMP TO TRUE DTSCS69
|
|
00624 * GO TO P1000-EXIT. DTSCS69
|
|
00625 * DTSCS69
|
|
00626 *----------------------------------------------------- DTSCS69
|
|
00627 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS69
|
|
00628 * REQUESTED SCREEN TYPE DTSCS69
|
|
00629 *----------------------------------------------------- DTSCS69
|
|
00630 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS69
|
|
00631 NEXT SENTENCE DTSCS69
|
|
00632 ELSE DTSCS69
|
|
00633 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS69
|
|
00634 SET REQ-JUMP TO TRUE DTSCS69
|
|
00635 GO TO P1000-EXIT. DTSCS69
|
|
00636 DTSCS69
|
|
00637 *----------------------------------------------------- DTSCS69
|
|
00638 * IF REQUEST TO UPDATE THE DATA (ADD,MOD,DEL) DTSCS69
|
|
00639 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS69
|
|
00640 *----------------------------------------------------- DTSCS69
|
|
00641 IF LCCM-F09-88 DTSCS69
|
|
00642 OR LCCM-F10-88 DTSCS69
|
|
00643 * OR LCCM-F23-88 DTSCS69
|
|
00644 IF SCR-ACCESS-UPDATE DTSCS69
|
|
00645 SET REQ-EDIT TO TRUE DTSCS69
|
|
00646 GO TO P1000-EXIT DTSCS69
|
|
00647 ELSE DTSCS69
|
|
00648 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS69
|
|
00649 SET REQ-ERROR TO TRUE DTSCS69
|
|
00650 GO TO P1000-EXIT. DTSCS69
|
|
00651 DTSCS69
|
|
00652 *----------------------------------------------------- DTSCS69
|
|
00653 * IF INQUIRY TYPE KEY PRESSED (ENTER, F5, F6, F7, DTSCS69
|
|
00654 * OR F8), INDICATE INQUIRY REQUEST DTSCS69
|
|
00655 *----------------------------------------------------- DTSCS69
|
|
00656 IF LCCM-INQUIRY-88 DTSCS69
|
|
00657 SET REQ-INQUIRE TO TRUE DTSCS69
|
|
00658 GO TO P1000-EXIT. DTSCS69
|
|
00659 DTSCS69
|
|
00660 *----------------------------------------------------- DTSCS69
|
|
00661 * ANY OTHER KEY IS INVALID DTSCS69
|
|
00662 *----------------------------------------------------- DTSCS69
|
|
00663 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS69
|
|
00664 SET REQ-ERROR TO TRUE. DTSCS69
|
|
00665 P1000-EXIT. DTSCS69
|
|
00666 EXIT. DTSCS69
|
|
00667 DTSCS69
|
|
00668 ******************************************************************DTSCS69
|
|
00669 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS69
|
|
00670 ******************************************************************DTSCS69
|
|
00671 DTSCS69
|
|
00672 P1100-UPDATE-LOCKED. DTSCS69
|
|
00673 *----------------------------------------------------- DTSCS69
|
|
00674 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS69
|
|
00675 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCS69
|
|
00676 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS69
|
|
00677 *----------------------------------------------------- DTSCS69
|
|
00678 IF LCCM-ENTER-88 OR LCCM-F12-88 DTSCS69
|
|
00679 SET REQ-UPDATE TO TRUE DTSCS69
|
|
00680 ELSE DTSCS69
|
|
00681 SET REQ-ERROR TO TRUE DTSCS69
|
|
00682 IF LCCM-SCR-ADD-LOCKED DTSCS69
|
|
00683 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS69
|
|
00684 ELSE DTSCS69
|
|
00685 IF LCCM-SCR-MOD-LOCKED DTSCS69
|
|
00686 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS69
|
|
00687 ELSE DTSCS69
|
|
00688 IF LCCM-SCR-DEL-LOCKED DTSCS69
|
|
00689 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID DTSCS69
|
|
00690 ELSE DTSCS69
|
|
00691 GO TO S899-ABEND. DTSCS69
|
|
00692 P1100-EXIT. DTSCS69
|
|
00693 EXIT. DTSCS69
|
|
00694 /*****************************************************************DTSCS69
|
|
00695 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS69
|
|
00696 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS69
|
|
00697 ******************************************************************DTSCS69
|
|
00698 DTSCS69
|
|
00699 P2000-REQUEST-ERROR. DTSCS69
|
|
00700 IF LCCM-MSG DTSCS69
|
|
00701 SET RESP-SEND-MSGONLY TO TRUE DTSCS69
|
|
00702 ELSE DTSCS69
|
|
00703 GO TO S899-ABEND. DTSCS69
|
|
00704 P2000-EXIT. DTSCS69
|
|
00705 EXIT. DTSCS69
|
|
00706 /*****************************************************************DTSCS69
|
|
00707 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS69
|
|
00708 ******************************************************************DTSCS69
|
|
00709 DTSCS69
|
|
00710 P3000-REQUEST-JUMP. DTSCS69
|
|
00711 *----------------------------------------------------- DTSCS69
|
|
00712 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS69
|
|
00713 * BY USER DTSCS69
|
|
00714 *----------------------------------------------------- DTSCS69
|
|
00715 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS69
|
|
00716 DTSCS69
|
|
00717 *----------------------------------------------------- DTSCS69
|
|
00718 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS69
|
|
00719 *----------------------------------------------------- DTSCS69
|
|
00720 IF LCCM-MSG DTSCS69
|
|
00721 SET RESP-SEND-MSGONLY TO TRUE DTSCS69
|
|
00722 SET CURSOR-SET-GOTO TO TRUE DTSCS69
|
|
00723 GO TO P3000-EXIT. DTSCS69
|
|
00724 SKIP3 DTSCS69
|
|
00725 MOVE MAP-ASSIGN-NO-AREA TO L022-S-ASSIGN-NO-AREA. DTSCS69
|
|
00726 PERFORM S022-ASSIGN-NO-FROM-SCREEN THRU S022-EXIT. DTSCS69
|
|
00727 IF L022-VALID DTSCS69
|
|
00728 MOVE L022-ASSIGN-NO TO LCCM-ASSIGN-NO. DTSCS69
|
|
00729 DTSCS69
|
|
00730 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS69
|
|
00731 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS69
|
|
00732 IF L018-VALID DTSCS69
|
|
00733 MOVE L018-EMP-NO TO LCCM-EMP-NO. DTSCS69
|
|
00734 DTSCS69
|
|
00735 *----------------------------------------------------- DTSCS69
|
|
00736 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS69
|
|
00737 *----------------------------------------------------- DTSCS69
|
|
00738 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS69
|
|
00739 LCCM-SCR-HOLD-AREA. DTSCS69
|
|
00740 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS69
|
|
00741 SET RESP-JUMP TO TRUE. DTSCS69
|
|
00742 P3000-EXIT. DTSCS69
|
|
00743 EXIT. DTSCS69
|
|
00744 /*****************************************************************DTSCS69
|
|
00745 * CLEAR KEY WAS PRESSED *DTSCS69
|
|
00746 ******************************************************************DTSCS69
|
|
00747 DTSCS69
|
|
00748 P4000-REQUEST-CLEAR. DTSCS69
|
|
00749 DTSCS69
|
|
00750 *----------------------------------------------------- DTSCS69
|
|
00751 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS69
|
|
00752 * FIELDS FROM EARLIER REQUESTS DTSCS69
|
|
00753 *----------------------------------------------------- DTSCS69
|
|
00754 IF LCCM-ASSIGN-NO > ZERO DTSCS69
|
|
00755 MOVE LCCM-ASSIGN-NO TO WRK-DISPLAY DTSCS69
|
|
00756 MOVE WRK-DISPLAY-ASSIGN-NO-1 TO MAP-ASSIGN-NO-1 DTSCS69
|
|
00757 MOVE WRK-DISPLAY-ASSIGN-NO-2 TO MAP-ASSIGN-NO-2. DTSCS69
|
|
00758 DTSCS69
|
|
00759 IF LCCM-EMP-NO > ZERO DTSCS69
|
|
00760 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS69
|
|
00761 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS69
|
|
00762 DTSCS69
|
|
00763 MOVE ZERO TO LCCM-ASSIGN-NO DTSCS69
|
|
00764 MOVE ZERO TO LCCM-EMP-NO DTSCS69
|
|
00765 DTSCS69
|
|
00766 MOVE LOW-VALUES TO LCCM-SCR69-HOLD-AREA. DTSCS69
|
|
00767 DTSCS69
|
|
00768 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS69
|
|
00769 DTSCS69
|
|
00770 SET LCCM-SCR-CLEAR TO TRUE. DTSCS69
|
|
00771 DTSCS69
|
|
00772 IF SCR-ACCESS-UPDATE DTSCS69
|
|
00773 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS69
|
|
00774 ELSE DTSCS69
|
|
00775 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS69
|
|
00776 MOVE 'N' TO MAP-AUDIT-CASS MAP-MAIL-CASS. DTSCS69
|
|
00777 SET RESP-SEND-MAP TO TRUE. DTSCS69
|
|
00778 P4000-EXIT. DTSCS69
|
|
00779 EXIT. DTSCS69
|
|
00780 /*****************************************************************DTSCS69
|
|
00781 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS69
|
|
00782 ******************************************************************DTSCS69
|
|
00783 DTSCS69
|
|
00784 P5000-CURSOR-TO-GOTO. DTSCS69
|
|
00785 SET CURSOR-SET-GOTO TO TRUE. DTSCS69
|
|
00786 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS69
|
|
00787 P5000-EXIT. DTSCS69
|
|
00788 EXIT. DTSCS69
|
|
00789 /*****************************************************************DTSCS69
|
|
00790 * INQUIRY WAS REQUESTED *DTSCS69
|
|
00791 ******************************************************************DTSCS69
|
|
00792 DTSCS69
|
|
00793 P6000-REQUEST-INQUIRE. DTSCS69
|
|
00794 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS69
|
|
00795 MOVE MAP-SEQ-NO-1 TO WRK-SEQ-NO. DTSCS69
|
|
00796 MOVE MAP-ASSIGN-NO-AREA TO L022-S-ASSIGN-NO-AREA. DTSCS69
|
|
00797 MOVE LOW-VALUES TO MAP-AREA. DTSCS69
|
|
00798 MOVE L018-S-EMP-NO-AREA TO MAP-EMP-NO-AREA. DTSCS69
|
|
00799 MOVE WRK-SEQ-NO TO MAP-SEQ-NO-1. DTSCS69
|
|
00800 MOVE L022-S-ASSIGN-NO-AREA TO MAP-ASSIGN-NO-AREA. DTSCS69
|
|
00801 DTSCS69
|
|
00802 SET LCCM-SCR-CLEAR TO TRUE. DTSCS69
|
|
00803 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS69
|
|
00804 DTSCS69
|
|
00805 SET RESP-SEND-MAP TO TRUE. DTSCS69
|
|
00806 DTSCS69
|
|
00807 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS69
|
|
00808 DTSCS69
|
|
00809 MOVE LCCM-SCR69-HOLD-AREA TO SCR-REC-KEY-AREA. DTSCS69
|
|
00810 MOVE LOW-VALUES TO LCCM-SCR69-HOLD-AREA. DTSCS69
|
|
00811 DTSCS69
|
|
00812 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS69
|
|
00813 IF LCCM-MSG DTSCS69
|
|
00814 GO TO P6000-EXIT. DTSCS69
|
|
00815 DTSCS69
|
|
00816 DTSCS69
|
|
00817 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS69
|
|
00818 DTSCS69
|
|
00819 MOVE WRK-ASSIGN-NO TO LCCM-ASSIGN-NO. DTSCS69
|
|
00820 DTSCS69
|
|
00821 IF SCR-ACCESS-UPDATE DTSCS69
|
|
00822 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS69
|
|
00823 DTSCS69
|
|
00824 PERFORM P6050-COUNT-LAST THRU P6050-EXIT. DTSCS69
|
|
00825 DTSCS69
|
|
00826 IF LCCM-MSG DTSCS69
|
|
00827 GO TO P6000-EXIT. DTSCS69
|
|
00828 DTSCS69
|
|
00829 PERFORM P6100-LOCATE-REC THRU P6100-EXIT. DTSCS69
|
|
00830 IF LCCM-MSG DTSCS69
|
|
00831 GO TO P6000-EXIT. DTSCS69
|
|
00832 DTSCS69
|
|
00833 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS69
|
|
00834 DTSCS69
|
|
00835 MOVE MFSL-KEY-AREA TO LCCM-SCR69-HOLD-AREA. DTSCS69
|
|
00836 DTSCS69
|
|
00837 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS69
|
|
00838 DTSCS69
|
|
00839 IF MFSL-STATUS-CD NOT = 'P' DTSCS69
|
|
00840 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT DTSCS69
|
|
00841 ELSE DTSCS69
|
|
00842 IF SCR-ACCESS-UPDATE DTSCS69
|
|
00843 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS69
|
|
00844 P6000-EXIT. DTSCS69
|
|
00845 EXIT. DTSCS69
|
|
00846 EJECT DTSCS69
|
|
00847 P6050-COUNT-LAST. DTSCS69
|
|
00848 PERFORM S8220-MFSL-COUNT THRU S8220-EXIT. DTSCS69
|
|
00849 SKIP1 DTSCS69
|
|
00850 IF L810-RECORD-CNT = +0 DTSCS69
|
|
00851 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS69
|
|
00852 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS69
|
|
00853 ELSE DTSCS69
|
|
00854 MOVE L810-RECORD-CNT TO LAST-REC-NUM DTSCS69
|
|
00855 MOVE MSKL-KEY-AREA TO LAST-REC-KEY-AREA. DTSCS69
|
|
00856 P6050-EXIT. DTSCS69
|
|
00857 EXIT. DTSCS69
|
|
00858 EJECT DTSCS69
|
|
00859 P6100-LOCATE-REC. DTSCS69
|
|
00860 *------------------------------------------------------------ DTSCS69
|
|
00861 * IF, AT THE LAST USE OF THIS SCREEN, A RECORD FOR DTSCS69
|
|
00862 * EMPLOYER NUMBER LCCM-EMP-NO WAS DISPLAYED ON THE DTSCS69
|
|
00863 * SCREEN, THEN BASE THE PAGING LOGIC ON THE LAST RECORD DTSCS69
|
|
00864 * DISPLAYED ON THIS SCREEN; OTHERWISE, DISPLAY THE DTSCS69
|
|
00865 * RECORD WITH THE GREATEST MFSL-SEQ-NO (THE MOST DTSCS69
|
|
00866 * RECENT SEQ-NUMBER ASSOCIATED WITH ASSIGN-NO). DTSCS69
|
|
00867 *------------------------------------------------------------ DTSCS69
|
|
00868 DTSCS69
|
|
00869 IF SCR-REC-KEY-AREA = LOW-VALUES DTSCS69
|
|
00870 PERFORM P6140-LAST-REC THRU P6140-EXIT DTSCS69
|
|
00871 GO TO P6100-EXIT. DTSCS69
|
|
00872 DTSCS69
|
|
00873 MOVE SCR-REC-KEY-AREA TO MFSL-KEY-AREA. DTSCS69
|
|
00874 DTSCS69
|
|
00875 IF WRK-ASSIGN-NO = MFSL-ASSIGN-NO DTSCS69
|
|
00876 NEXT SENTENCE DTSCS69
|
|
00877 ELSE DTSCS69
|
|
00878 PERFORM P6140-LAST-REC THRU P6140-EXIT DTSCS69
|
|
00879 GO TO P6100-EXIT. DTSCS69
|
|
00880 DTSCS69
|
|
00881 IF LCCM-F05-88 DTSCS69
|
|
00882 PERFORM P6110-FIRST-REC THRU P6110-EXIT DTSCS69
|
|
00883 GO TO P6100-EXIT. DTSCS69
|
|
00884 DTSCS69
|
|
00885 IF LCCM-F06-88 DTSCS69
|
|
00886 PERFORM P6140-LAST-REC THRU P6140-EXIT DTSCS69
|
|
00887 GO TO P6100-EXIT. DTSCS69
|
|
00888 DTSCS69
|
|
00889 MOVE LOW-VALUES TO MFSL-KEY-AREA. DTSCS69
|
|
00890 MOVE WRK-EMP-NO TO MFSL-EMP-NO. DTSCS69
|
|
00891 MOVE WRK-ASSIGN-NO TO MFSL-ASSIGN-NO. DTSCS69
|
|
00892 * MOVE MAP-SEQ-NO-N TO MFSL-ID-NO DTSCS69
|
|
00893 SET MFSL-FSL-88 TO TRUE. DTSCS69
|
|
00894 MOVE MFSL-KEY-AREA TO MSKL-KEY-AREA. DTSCS69
|
|
00895 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS69
|
|
00896 IF L810-NO-REC-88 DTSCS69
|
|
00897 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS69
|
|
00898 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS69
|
|
00899 GO TO P6100-EXIT. DTSCS69
|
|
00900 DTSCS69
|
|
00901 MOVE +0 TO WS-REC-NUM. DTSCS69
|
|
00902 MOVE 'N' TO WS-REC-FOUND-IND. DTSCS69
|
|
00903 PERFORM P6190-BROWSE-MFSL THRU P6190-EXIT DTSCS69
|
|
00904 UNTIL (L810-NO-REC-88) DTSCS69
|
|
00905 OR DTSCS69
|
|
00906 (WS-REC-FOUND-IND = 'Y'). DTSCS69
|
|
00907 DTSCS69
|
|
00908 IF L810-NO-REC-88 DTSCS69
|
|
00909 PERFORM P6140-LAST-REC THRU P6140-EXIT DTSCS69
|
|
00910 GO TO P6100-EXIT. DTSCS69
|
|
00911 DTSCS69
|
|
00912 IF LCCM-ENTER-88 DTSCS69
|
|
00913 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS69
|
|
00914 GO TO P6100-EXIT. DTSCS69
|
|
00915 DTSCS69
|
|
00916 IF LCCM-F07-88 DTSCS69
|
|
00917 PERFORM P6120-PREV-REC THRU P6120-EXIT DTSCS69
|
|
00918 GO TO P6100-EXIT. DTSCS69
|
|
00919 DTSCS69
|
|
00920 IF LCCM-F08-88 DTSCS69
|
|
00921 PERFORM P6130-NEXT-REC THRU P6130-EXIT DTSCS69
|
|
00922 GO TO P6100-EXIT. DTSCS69
|
|
00923 DTSCS69
|
|
00924 GO TO S899-ABEND. DTSCS69
|
|
00925 P6100-EXIT. DTSCS69
|
|
00926 EXIT. DTSCS69
|
|
00927 DTSCS69
|
|
00928 P6110-FIRST-REC. DTSCS69
|
|
00929 MOVE LOW-VALUES TO MFSL-KEY-AREA. DTSCS69
|
|
00930 MOVE WRK-EMP-NO TO MFSL-EMP-NO. DTSCS69
|
|
00931 MOVE WRK-ASSIGN-NO TO MFSL-ASSIGN-NO. DTSCS69
|
|
00932 SET MFSL-FSL-88 TO TRUE. DTSCS69
|
|
00933 MOVE MFSL-KEY-AREA TO MSKL-KEY-AREA. DTSCS69
|
|
00934 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS69
|
|
00935 IF L810-NO-REC-88 DTSCS69
|
|
00936 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS69
|
|
00937 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS69
|
|
00938 GO TO P6110-EXIT. DTSCS69
|
|
00939 DTSCS69
|
|
00940 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS69
|
|
00941 DTSCS69
|
|
00942 MOVE MSKL-REC TO MFSL-REC. DTSCS69
|
|
00943 DTSCS69
|
|
00944 IF MFSL-ASSIGN-NO = WRK-ASSIGN-NO DTSCS69
|
|
00945 NEXT SENTENCE DTSCS69
|
|
00946 ELSE DTSCS69
|
|
00947 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS69
|
|
00948 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS69
|
|
00949 GO TO P6110-EXIT. DTSCS69
|
|
00950 DTSCS69
|
|
00951 MOVE +1 TO WS-REC-NUM. DTSCS69
|
|
00952 P6110-EXIT. DTSCS69
|
|
00953 EXIT. DTSCS69
|
|
00954 DTSCS69
|
|
00955 P6120-PREV-REC. DTSCS69
|
|
00956 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCS69
|
|
00957 IF L810-NO-REC-88 DTSCS69
|
|
00958 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS69
|
|
00959 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS69
|
|
00960 GO TO P6120-EXIT. DTSCS69
|
|
00961 DTSCS69
|
|
00962 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCS69
|
|
00963 IF L810-NO-REC-88 DTSCS69
|
|
00964 GO TO P6120-EXIT. DTSCS69
|
|
00965 DTSCS69
|
|
00966 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS69
|
|
00967 DTSCS69
|
|
00968 SUBTRACT 1 FROM WS-REC-NUM. DTSCS69
|
|
00969 DTSCS69
|
|
00970 MOVE MSKL-REC TO MFSL-REC. DTSCS69
|
|
00971 DTSCS69
|
|
00972 IF MFSL-ASSIGN-NO = WRK-ASSIGN-NO DTSCS69
|
|
00973 NEXT SENTENCE DTSCS69
|
|
00974 ELSE DTSCS69
|
|
00975 PERFORM P6110-FIRST-REC THRU P6110-EXIT. DTSCS69
|
|
00976 P6120-EXIT. DTSCS69
|
|
00977 EXIT. DTSCS69
|
|
00978 DTSCS69
|
|
00979 P6130-NEXT-REC. DTSCS69
|
|
00980 IF MFSL-KEY-AREA > SCR-REC-KEY-AREA DTSCS69
|
|
00981 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS69
|
|
00982 GO TO P6130-EXIT. DTSCS69
|
|
00983 DTSCS69
|
|
00984 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS69
|
|
00985 DTSCS69
|
|
00986 IF L810-NO-REC-88 DTSCS69
|
|
00987 GO TO P6130-EXIT. DTSCS69
|
|
00988 DTSCS69
|
|
00989 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS69
|
|
00990 DTSCS69
|
|
00991 ADD +1 TO WS-REC-NUM. DTSCS69
|
|
00992 DTSCS69
|
|
00993 MOVE MSKL-REC TO MFSL-REC. DTSCS69
|
|
00994 DTSCS69
|
|
00995 IF MFSL-ASSIGN-NO = WRK-ASSIGN-NO DTSCS69
|
|
00996 NEXT SENTENCE DTSCS69
|
|
00997 ELSE DTSCS69
|
|
00998 PERFORM P6140-LAST-REC THRU P6140-EXIT. DTSCS69
|
|
00999 P6130-EXIT. DTSCS69
|
|
01000 EXIT. DTSCS69
|
|
01001 DTSCS69
|
|
01002 P6140-LAST-REC. DTSCS69
|
|
01003 MOVE LAST-REC-KEY-AREA TO MSKL-KEY-AREA. DTSCS69
|
|
01004 PERFORM S810-READ THRU S810-EXIT. DTSCS69
|
|
01005 IF L810-NO-REC-88 DTSCS69
|
|
01006 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS69
|
|
01007 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS69
|
|
01008 GO TO P6140-EXIT. DTSCS69
|
|
01009 DTSCS69
|
|
01010 MOVE MSKL-REC TO MFSL-REC. DTSCS69
|
|
01011 DTSCS69
|
|
01012 MOVE LAST-REC-NUM TO WS-REC-NUM. DTSCS69
|
|
01013 P6140-EXIT. DTSCS69
|
|
01014 EXIT. DTSCS69
|
|
01015 DTSCS69
|
|
01016 P6190-BROWSE-MFSL. DTSCS69
|
|
01017 MOVE MSKL-REC TO MFSL-REC. DTSCS69
|
|
01018 DTSCS69
|
|
01019 IF MFSL-ASSIGN-NO = WRK-ASSIGN-NO DTSCS69
|
|
01020 NEXT SENTENCE DTSCS69
|
|
01021 ELSE DTSCS69
|
|
01022 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS69
|
|
01023 SET L810-NO-REC-88 TO TRUE DTSCS69
|
|
01024 GO TO P6190-EXIT. DTSCS69
|
|
01025 DTSCS69
|
|
01026 ADD +1 TO WS-REC-NUM. DTSCS69
|
|
01027 IF MFSL-KEY-AREA NOT < SCR-REC-KEY-AREA DTSCS69
|
|
01028 MOVE 'Y' TO WS-REC-FOUND-IND DTSCS69
|
|
01029 ELSE DTSCS69
|
|
01030 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS69
|
|
01031 P6190-EXIT. DTSCS69
|
|
01032 EXIT. DTSCS69
|
|
01033 /*****************************************************************DTSCS69
|
|
01034 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCS69
|
|
01035 ******************************************************************DTSCS69
|
|
01036 DTSCS69
|
|
01037 P6900-CONSTRUCT-SCREEN. DTSCS69
|
|
01038 PERFORM P6910-FROM-MFSL THRU P6910-EXIT. DTSCS69
|
|
01039 PERFORM P6920-FROM-MFAS THRU P6920-EXIT. DTSCS69
|
|
01040 MOVE 'N' TO MAP-AUDIT-CASS MAP-MAIL-CASS. DTSCS69
|
|
01041 PERFORM P6990-PAGE-NUMBER THRU P6990-EXIT. DTSCS69
|
|
01042 P6900-EXIT. DTSCS69
|
|
01043 EXIT. DTSCS69
|
|
01044 DTSCS69
|
|
01045 P6910-FROM-MFSL. DTSCS69
|
|
01046 MOVE MFSL-ID-NO TO WRK-DISPLAY. DTSCS69
|
|
01047 MOVE WRK-DISPLAY-ID-NO TO MAP-SEQ-NO-1. DTSCS69
|
|
01048 MOVE MFSL-NAME TO MAP-CONTACT-NAME. DTSCS69
|
|
01049 MOVE MFSL-EMAIL-ADDRESS TO MAP-EMAIL. DTSCS69
|
|
01050 DTSCS69
|
|
01051 IF MFSL-AUDIT-DATE > 0 DTSCS69
|
|
01052 MOVE MFSL-AUDIT-DATE TO WRK-DISPLAY DTSCS69
|
|
01053 MOVE WRK-DISPLAY-MO TO MAP-AUDIT-MO DTSCS69
|
|
01054 MOVE WRK-DISPLAY-DA TO MAP-AUDIT-DA DTSCS69
|
|
01055 MOVE WRK-DISPLAY-YR TO MAP-AUDIT-YR. DTSCS69
|
|
01056 DTSCS69
|
|
01057 IF MFSL-AUDIT-TIME > ZEROS DTSCS69
|
|
01058 MOVE MFSL-AUDIT-TIME TO WRK-DISPLAY DTSCS69
|
|
01059 MOVE WRK-DISPLAY-HH TO MAP-AUDIT-TIME-HH DTSCS69
|
|
01060 MOVE WRK-DISPLAY-MM TO MAP-AUDIT-TIME-MM DTSCS69
|
|
01061 ELSE DTSCS69
|
|
01062 MOVE 10 TO MAP-AUDIT-TIME-HH DTSCS69
|
|
01063 MOVE 00 TO MAP-AUDIT-TIME-MM. DTSCS69
|
|
01064 DTSCS69
|
|
01065 MOVE MFSL-STATUS-CD TO MAP-STATUS-CD. DTSCS69
|
|
01066 IF MFSL-STATUS-CD = 'P' DTSCS69
|
|
01067 MOVE 'PENDING' TO MAP-STATUS-CD-DSCR DTSCS69
|
|
01068 ELSE DTSCS69
|
|
01069 IF MFSL-STATUS-CD = 'C' DTSCS69
|
|
01070 MOVE 'COMPLETED' TO MAP-STATUS-CD-DSCR DTSCS69
|
|
01071 ELSE DTSCS69
|
|
01072 IF MFSL-STATUS-CD = 'K' DTSCS69
|
|
01073 MOVE 'CANCELLED' TO MAP-STATUS-CD-DSCR. DTSCS69
|
|
01074 DTSCS69
|
|
01075 IF MFSL-VOICE-1 > SPACES DTSCS69
|
|
01076 MOVE MFSL-VOICE-1-AREA-CD TO MAP-PHONE-A-CD(1) DTSCS69
|
|
01077 MOVE MFSL-VOICE-1-PREFIX TO MAP-PHONE-PREF(1) DTSCS69
|
|
01078 MOVE MFSL-VOICE-1-SUFFIX TO MAP-PHONE-SUFF(1) DTSCS69
|
|
01079 MOVE MFSL-VOICE-1-EXT TO MAP-PHONE-EXT(1). DTSCS69
|
|
01080 DTSCS69
|
|
01081 IF MFSL-VOICE-2 > SPACES DTSCS69
|
|
01082 MOVE MFSL-VOICE-2-AREA-CD TO MAP-PHONE-A-CD(2) DTSCS69
|
|
01083 MOVE MFSL-VOICE-2-PREFIX TO MAP-PHONE-PREF(2) DTSCS69
|
|
01084 MOVE MFSL-VOICE-2-SUFFIX TO MAP-PHONE-SUFF(2) DTSCS69
|
|
01085 MOVE MFSL-VOICE-2-EXT TO MAP-PHONE-EXT(2). DTSCS69
|
|
01086 DTSCS69
|
|
01087 IF MFSL-FAX > SPACES DTSCS69
|
|
01088 MOVE MFSL-FAX-AREA-CD TO MAP-PHONE-A-CD(3) DTSCS69
|
|
01089 MOVE MFSL-FAX-PREFIX TO MAP-PHONE-PREF(3) DTSCS69
|
|
01090 MOVE MFSL-FAX-SUFFIX TO MAP-PHONE-SUFF(3) DTSCS69
|
|
01091 MOVE MFSL-FAX-EXT TO MAP-PHONE-EXT(3). DTSCS69
|
|
01092 DTSCS69
|
|
01093 MOVE MFSL-ATTN-LINE TO MAP-AUDIT-ATTN-LINE DTSCS69
|
|
01094 MOVE MFSL-DELIV-LINE-1 TO MAP-AUDIT-DLV1-LINE DTSCS69
|
|
01095 MOVE MFSL-DELIV-LINE-2 TO MAP-AUDIT-DLV2-LINE DTSCS69
|
|
01096 MOVE MFSL-CITY TO MAP-AUDIT-CITY DTSCS69
|
|
01097 MOVE MFSL-ST TO MAP-AUDIT-STAT DTSCS69
|
|
01098 MOVE MFSL-ZIP TO MAP-AUDIT-ZIP. DTSCS69
|
|
01099 DTSCS69
|
|
01100 MOVE MFSL-ATTN-MAIL TO MAP-MAIL-ATTN-LINE DTSCS69
|
|
01101 MOVE MFSL-DELIV-MAIL-1 TO MAP-MAIL-DLV1-LINE DTSCS69
|
|
01102 MOVE MFSL-DELIV-MAIL-2 TO MAP-MAIL-DLV2-LINE DTSCS69
|
|
01103 MOVE MFSL-CITY-MAIL TO MAP-MAIL-CITY DTSCS69
|
|
01104 MOVE MFSL-ST-MAIL TO MAP-MAIL-STAT DTSCS69
|
|
01105 MOVE MFSL-ZIP-MAIL TO MAP-MAIL-ZIP. DTSCS69
|
|
01106 DTSCS69
|
|
01107 MOVE MFSL-CREATE-OP-ID TO MAP-ESTB-OP-ID. DTSCS69
|
|
01108 MOVE MFSL-CHANGE-OP-ID TO MAP-CHNG-OP-ID. DTSCS69
|
|
01109 DTSCS69
|
|
01110 MOVE MFSL-ESTB-DATE TO L001-FED-8-DATE-9. DTSCS69
|
|
01111 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSCS69
|
|
01112 MOVE L001-SLASH-DATE TO MAP-ESTB-DATE DTSCS69
|
|
01113 DTSCS69
|
|
01114 MOVE MFSL-CHNG-DATE TO L001-FED-8-DATE-9. DTSCS69
|
|
01115 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSCS69
|
|
01116 MOVE L001-SLASH-DATE TO MAP-CHNG-DATE. DTSCS69
|
|
01117 DTSCS69
|
|
01118 P6910-EXIT. DTSCS69
|
|
01119 EXIT. DTSCS69
|
|
01120 DTSCS69
|
|
01121 P6920-FROM-MFAS. DTSCS69
|
|
01122 IF MFAS-FLD-REP-FIELD-DESK-88 DTSCS69
|
|
01123 IF LCCM-OP-IS-FLD-DESK-88 DTSCS69
|
|
01124 MOVE SPACE TO MAP-FLD-REP-ID DTSCS69
|
|
01125 ELSE DTSCS69
|
|
01126 MOVE MFAS-FLD-REP-ID TO MAP-FLD-REP-ID DTSCS69
|
|
01127 ELSE DTSCS69
|
|
01128 MOVE MFAS-FLD-REP-ID TO MAP-FLD-REP-ID DTSCS69
|
|
01129 END-IF. DTSCS69
|
|
01130 DTSCS69
|
|
01131 P6920-EXIT. DTSCS69
|
|
01132 EXIT. DTSCS69
|
|
01133 DTSCS69
|
|
01134 P6990-PAGE-NUMBER. DTSCS69
|
|
01135 MOVE WS-REC-NUM TO MAP-CURR-PAGE. DTSCS69
|
|
01136 MOVE LAST-REC-NUM TO MAP-LAST-PAGE. DTSCS69
|
|
01137 DTSCS69
|
|
01138 IF WS-REC-NUM = +1 DTSCS69
|
|
01139 IF LAST-REC-NUM = +1 DTSCS69
|
|
01140 MOVE PMSG-ONLY-PAGE TO LCCM-MSG-AREA DTSCS69
|
|
01141 ELSE DTSCS69
|
|
01142 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-AREA DTSCS69
|
|
01143 ELSE DTSCS69
|
|
01144 IF WS-REC-NUM = LAST-REC-NUM DTSCS69
|
|
01145 MOVE PMSG-LAST-PAGE TO LCCM-MSG-AREA. DTSCS69
|
|
01146 P6990-EXIT. DTSCS69
|
|
01147 EXIT. DTSCS69
|
|
01148 /*****************************************************************DTSCS69
|
|
01149 * FUNCTION KEY TO ADD, MOD OR DEL THE RECORD WAS PRESSED. *DTSCS69
|
|
01150 ******************************************************************DTSCS69
|
|
01151 DTSCS69
|
|
01152 P7000-REQUEST-EDIT. DTSCS69
|
|
01153 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS69
|
|
01154 DTSCS69
|
|
01155 IF LCCM-F09-88 DTSCS69
|
|
01156 PERFORM P7100-EDIT-ADD THRU P7100-EXIT DTSCS69
|
|
01157 ELSE DTSCS69
|
|
01158 IF LCCM-F10-88 DTSCS69
|
|
01159 PERFORM P7200-EDIT-MOD THRU P7200-EXIT DTSCS69
|
|
01160 ELSE DTSCS69
|
|
01161 * IF LCCM-F23-88 DTSCS69
|
|
01162 * PERFORM P7300-EDIT-DEL THRU P7300-EXIT DTSCS69
|
|
01163 * ELSE DTSCS69
|
|
01164 GO TO S899-ABEND. DTSCS69
|
|
01165 DTSCS69
|
|
01166 *------------------------------------------------------ DTSCS69
|
|
01167 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCS69
|
|
01168 * IN ORDER TO CONTINUE TO ATTEMPT A MOD THE SCREEN MUST DTSCS69
|
|
01169 * REMAIN IN 'INQUIRE' STATUS. DTSCS69
|
|
01170 *------------------------------------------------------ DTSCS69
|
|
01171 DTSCS69
|
|
01172 IF LCCM-MSG DTSCS69
|
|
01173 NEXT SENTENCE DTSCS69
|
|
01174 ELSE DTSCS69
|
|
01175 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCS69
|
|
01176 IF LCCM-F09-88 DTSCS69
|
|
01177 SET LCCM-SCR-ADD-LOCKED TO TRUE DTSCS69
|
|
01178 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS69
|
|
01179 ELSE DTSCS69
|
|
01180 IF LCCM-F10-88 DTSCS69
|
|
01181 SET LCCM-SCR-MOD-LOCKED TO TRUE DTSCS69
|
|
01182 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID. DTSCS69
|
|
01183 * ELSE DTSCS69
|
|
01184 * IF LCCM-F23-88 DTSCS69
|
|
01185 * SET LCCM-SCR-DEL-LOCKED TO TRUE DTSCS69
|
|
01186 * MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID. DTSCS69
|
|
01187 DTSCS69
|
|
01188 SET RESP-SEND-MAP TO TRUE. DTSCS69
|
|
01189 P7000-EXIT. DTSCS69
|
|
01190 EXIT. DTSCS69
|
|
01191 /*****************************************************************DTSCS69
|
|
01192 * ADD FUNCTION WAS REQUESTED *DTSCS69
|
|
01193 ******************************************************************DTSCS69
|
|
01194 DTSCS69
|
|
01195 P7100-EDIT-ADD. DTSCS69
|
|
01196 *----------------------------------------------------- DTSCS69
|
|
01197 * ADDITION REQUIRES THAT THE SCREEN WAS CLEARED FIRST DTSCS69
|
|
01198 *----------------------------------------------------- DTSCS69
|
|
01199 IF NOT LCCM-SCR-CLEAR DTSCS69
|
|
01200 MOVE EMSG-ADD-PRECEDED TO LCCM-MSG-ID DTSCS69
|
|
01201 GO TO P7100-EXIT. DTSCS69
|
|
01202 DTSCS69
|
|
01203 *----------------------------------------------------- DTSCS69
|
|
01204 * DTSCS69
|
|
01205 *----------------------------------------------------- DTSCS69
|
|
01206 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS69
|
|
01207 IF LCCM-MSG DTSCS69
|
|
01208 GO TO P7100-EXIT. DTSCS69
|
|
01209 DTSCS69
|
|
01210 MOVE WRK-ASSIGN-NO TO LCCM-ASSIGN-NO. DTSCS69
|
|
01211 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS69
|
|
01212 DTSCS69
|
|
01213 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS69
|
|
01214 DTSCS69
|
|
01215 IF LCCM-MSG DTSCS69
|
|
01216 GO TO P7100-EXIT. DTSCS69
|
|
01217 DTSCS69
|
|
01218 IF WRK-ID-NO = +0 DTSCS69
|
|
01219 PERFORM S8220-MFSL-COUNT THRU S8220-EXIT DTSCS69
|
|
01220 IF L810-RECORD-CNT = +0 DTSCS69
|
|
01221 MOVE +1 TO MAP-SEQ-NO-N WRK-ID-NO DTSCS69
|
|
01222 ELSE DTSCS69
|
|
01223 MOVE MSKL-KEY-AREA TO MFSL-KEY-AREA DTSCS69
|
|
01224 IF MFSL-ID-NO = +999 DTSCS69
|
|
01225 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS69
|
|
01226 PERFORM S2101-ERROR THROUGH S2101-EXIT DTSCS69
|
|
01227 ELSE DTSCS69
|
|
01228 ADD +1, MFSL-ID-NO GIVING MAP-SEQ-NO-N WRK-ID-NO DTSCS69
|
|
01229 ELSE DTSCS69
|
|
01230 PERFORM S8210-READ-MFSL THRU S8210-EXIT DTSCS69
|
|
01231 IF L810-OK-88 DTSCS69
|
|
01232 MOVE EMSG-RECORD-EXISTS TO WRK-MSG-AREA DTSCS69
|
|
01233 PERFORM S2101-ERROR THROUGH S2101-EXIT DTSCS69
|
|
01234 GO TO P7100-EXIT. DTSCS69
|
|
01235 DTSCS69
|
|
01236 IF LCCM-MSG DTSCS69
|
|
01237 GO TO P7100-EXIT. DTSCS69
|
|
01238 DTSCS69
|
|
01239 DTSCS69
|
|
01240 P7100-EXIT. DTSCS69
|
|
01241 EXIT. DTSCS69
|
|
01242 /*****************************************************************DTSCS69
|
|
01243 * MODIFICATION FUNCTION WAS REQUESTED *DTSCS69
|
|
01244 ******************************************************************DTSCS69
|
|
01245 DTSCS69
|
|
01246 P7200-EDIT-MOD. DTSCS69
|
|
01247 *----------------------------------------------------- DTSCS69
|
|
01248 * MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS69
|
|
01249 * INQUIRED DTSCS69
|
|
01250 *----------------------------------------------------- DTSCS69
|
|
01251 IF NOT LCCM-SCR-INQUIRE DTSCS69
|
|
01252 MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-ID DTSCS69
|
|
01253 GO TO P7200-EXIT. DTSCS69
|
|
01254 DTSCS69
|
|
01255 *----------------------------------------------------- DTSCS69
|
|
01256 * MAP-ASSIGN-NO MAY NOT BE CHANGED DURING THE MOD DTSCS69
|
|
01257 *----------------------------------------------------- DTSCS69
|
|
01258 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS69
|
|
01259 IF LCCM-MSG DTSCS69
|
|
01260 GO TO P7200-EXIT. DTSCS69
|
|
01261 DTSCS69
|
|
01262 IF LCCM-ASSIGN-NO NOT = WRK-ASSIGN-NO DTSCS69
|
|
01263 MOVE EMSG-NO-ASSIGN-NO-CHANGE TO WRK-MSG-AREA DTSCS69
|
|
01264 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS69
|
|
01265 GO TO P7200-EXIT. DTSCS69
|
|
01266 DTSCS69
|
|
01267 IF LCCM-EMP-NO NOT = WRK-EMP-NO DTSCS69
|
|
01268 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS69
|
|
01269 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS69
|
|
01270 GO TO P7200-EXIT DTSCS69
|
|
01271 ELSE DTSCS69
|
|
01272 MOVE LCCM-SCR69-HOLD-AREA TO MFSL-KEY-AREA DTSCS69
|
|
01273 IF WRK-ID-NO = MFSL-ID-NO DTSCS69
|
|
01274 NEXT SENTENCE DTSCS69
|
|
01275 ELSE DTSCS69
|
|
01276 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS69
|
|
01277 PERFORM S2101-ERROR THRU S2101-EXIT DTSCS69
|
|
01278 GO TO P7200-EXIT. DTSCS69
|
|
01279 DTSCS69
|
|
01280 MOVE LCCM-SCR69-HOLD-AREA TO MSKL-KEY-AREA. DTSCS69
|
|
01281 PERFORM S810-READ THRU S810-EXIT. DTSCS69
|
|
01282 IF L810-OK-88 DTSCS69
|
|
01283 MOVE MSKL-REC TO MFSL-REC DTSCS69
|
|
01284 ELSE DTSCS69
|
|
01285 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS69
|
|
01286 PERFORM S2101-ERROR THROUGH S2101-EXIT DTSCS69
|
|
01287 GO TO P7200-EXIT. DTSCS69
|
|
01288 DTSCS69
|
|
01289 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS69
|
|
01290 DTSCS69
|
|
01291 P7200-EXIT. DTSCS69
|
|
01292 EXIT. DTSCS69
|
|
01293 /*****************************************************************DTSCS69
|
|
01294 * DELETE FUNCTION WAS REQUESTED *DTSCS69
|
|
01295 ******************************************************************DTSCS69
|
|
01296 DTSCS69
|
|
01297 P7300-EDIT-DEL. DTSCS69
|
|
01298 *----------------------------------------------------- DTSCS69
|
|
01299 * DELETION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS69
|
|
01300 * INQUIRED DTSCS69
|
|
01301 *----------------------------------------------------- DTSCS69
|
|
01302 IF NOT LCCM-SCR-INQUIRE DTSCS69
|
|
01303 MOVE EMSG-DEL-PRECEDED TO LCCM-MSG-ID DTSCS69
|
|
01304 GO TO P7300-EXIT. DTSCS69
|
|
01305 DTSCS69
|
|
01306 *----------------------------------------------------- DTSCS69
|
|
01307 * MAP-ASSIGN-NO MAY NOT BE CHANGED DURING THE DEL DTSCS69
|
|
01308 *----------------------------------------------------- DTSCS69
|
|
01309 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS69
|
|
01310 IF LCCM-MSG DTSCS69
|
|
01311 GO TO P7300-EXIT. DTSCS69
|
|
01312 DTSCS69
|
|
01313 PERFORM S1130-READ-MPRF THRU S1130-EXIT. DTSCS69
|
|
01314 DTSCS69
|
|
01315 PERFORM S1115-READ-MFAS THRU S1115-EXIT. DTSCS69
|
|
01316 DTSCS69
|
|
01317 IF LCCM-ASSIGN-NO NOT = WRK-ASSIGN-NO DTSCS69
|
|
01318 MOVE EMSG-NO-ASSIGN-NO-CHANGE TO WRK-MSG-AREA DTSCS69
|
|
01319 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS69
|
|
01320 GO TO P7300-EXIT. DTSCS69
|
|
01321 DTSCS69
|
|
01322 DTSCS69
|
|
01323 P7300-EXIT. DTSCS69
|
|
01324 EXIT. DTSCS69
|
|
01325 /*****************************************************************DTSCS69
|
|
01326 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED *DTSCS69
|
|
01327 ******************************************************************DTSCS69
|
|
01328 DTSCS69
|
|
01329 P8000-REQUEST-UPDATE. DTSCS69
|
|
01330 DTSCS69
|
|
01331 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS69
|
|
01332 DTSCS69
|
|
01333 IF LCCM-SCR-ADD-LOCKED DTSCS69
|
|
01334 PERFORM P8100-ADD THRU P8100-EXIT DTSCS69
|
|
01335 ELSE DTSCS69
|
|
01336 IF LCCM-SCR-MOD-LOCKED DTSCS69
|
|
01337 PERFORM P8200-MOD THRU P8200-EXIT DTSCS69
|
|
01338 ELSE DTSCS69
|
|
01339 * IF LCCM-SCR-DEL-LOCKED DTSCS69
|
|
01340 * PERFORM P8300-DEL THRU P8300-EXIT DTSCS69
|
|
01341 * ELSE DTSCS69
|
|
01342 GO TO S899-ABEND. DTSCS69
|
|
01343 DTSCS69
|
|
01344 SET RESP-SEND-MAP TO TRUE. DTSCS69
|
|
01345 P8000-EXIT. DTSCS69
|
|
01346 EXIT. DTSCS69
|
|
01347 /*****************************************************************DTSCS69
|
|
01348 * *DTSCS69
|
|
01349 ******************************************************************DTSCS69
|
|
01350 DTSCS69
|
|
01351 P8100-ADD. DTSCS69
|
|
01352 SET LCCM-SCR-CLEAR TO TRUE. DTSCS69
|
|
01353 DTSCS69
|
|
01354 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS69
|
|
01355 DTSCS69
|
|
01356 IF LCCM-F12-88 DTSCS69
|
|
01357 MOVE PMSG-ADD-CANCELED TO LCCM-MSG-ID DTSCS69
|
|
01358 GO TO P8100-EXIT. DTSCS69
|
|
01359 DTSCS69
|
|
01360 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS69
|
|
01361 DTSCS69
|
|
01362 MOVE 'A' TO L221-UPDATE-FUNCTION. DTSCS69
|
|
01363 PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS69
|
|
01364 IF LCCM-MSG DTSCS69
|
|
01365 GO TO P8100-EXIT. DTSCS69
|
|
01366 DTSCS69
|
|
01367 PERFORM S8210-READ-MFSL THRU S8210-EXIT. DTSCS69
|
|
01368 IF L810-NO-REC-88 DTSCS69
|
|
01369 PERFORM P8110-CONSTRUCT-MFSL THRU P8110-EXIT DTSCS69
|
|
01370 ELSE DTSCS69
|
|
01371 MOVE EMSG-RECORD-EXISTS TO WRK-MSG-AREA DTSCS69
|
|
01372 PERFORM S1199-ERROR THRU S1199-EXIT. DTSCS69
|
|
01373 DTSCS69
|
|
01374 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS69
|
|
01375 DTSCS69
|
|
01376 IF LCCM-MSG DTSCS69
|
|
01377 GO TO P8100-EXIT. DTSCS69
|
|
01378 DTSCS69
|
|
01379 MOVE MFSL-KEY-AREA TO LCCM-SCR69-HOLD-AREA. DTSCS69
|
|
01380 SET LCCM-ENTER-88 TO TRUE. DTSCS69
|
|
01381 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT. DTSCS69
|
|
01382 DTSCS69
|
|
01383 MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS69
|
|
01384 DTSCS69
|
|
01385 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS69
|
|
01386 P8100-EXIT. DTSCS69
|
|
01387 EXIT. DTSCS69
|
|
01388 DTSCS69
|
|
01389 P8110-CONSTRUCT-MFSL. DTSCS69
|
|
01390 MOVE +0 TO MFSL-PURGE-DATE DTSCS69
|
|
01391 MOVE LOW-VALUE TO MFSL-DATA-AREA DTSCS69
|
|
01392 INITIALIZE MFSL-DATA-AREA DTSCS69
|
|
01393 MOVE MAP-CONTACT-NAME TO MFSL-NAME. DTSCS69
|
|
01394 MOVE MAP-EMAIL TO MFSL-EMAIL-ADDRESS. DTSCS69
|
|
01395 MOVE MAP-PHONE-A-CD(1) TO MFSL-VOICE-1-AREA-CD DTSCS69
|
|
01396 MOVE MAP-PHONE-PREF(1) TO MFSL-VOICE-1-PREFIX DTSCS69
|
|
01397 MOVE MAP-PHONE-SUFF(1) TO MFSL-VOICE-1-SUFFIX DTSCS69
|
|
01398 MOVE MAP-PHONE-EXT(1) TO MFSL-VOICE-1-EXT. DTSCS69
|
|
01399 DTSCS69
|
|
01400 MOVE MAP-PHONE-A-CD(2) TO MFSL-VOICE-2-AREA-CD DTSCS69
|
|
01401 MOVE MAP-PHONE-PREF(2) TO MFSL-VOICE-2-PREFIX DTSCS69
|
|
01402 MOVE MAP-PHONE-SUFF(2) TO MFSL-VOICE-2-SUFFIX DTSCS69
|
|
01403 MOVE MAP-PHONE-EXT(2) TO MFSL-VOICE-2-EXT. DTSCS69
|
|
01404 DTSCS69
|
|
01405 MOVE MAP-PHONE-A-CD(3) TO MFSL-FAX-AREA-CD DTSCS69
|
|
01406 MOVE MAP-PHONE-PREF(3) TO MFSL-FAX-PREFIX DTSCS69
|
|
01407 MOVE MAP-PHONE-SUFF(3) TO MFSL-FAX-SUFFIX DTSCS69
|
|
01408 MOVE MAP-PHONE-EXT(3) TO MFSL-FAX-EXT. DTSCS69
|
|
01409 DTSCS69
|
|
01410 MOVE MAP-AUDIT-ATTN-LINE TO MFSL-ATTN-LINE DTSCS69
|
|
01411 MOVE MAP-AUDIT-DLV1-LINE TO MFSL-DELIV-LINE-1 DTSCS69
|
|
01412 MOVE MAP-AUDIT-DLV2-LINE TO MFSL-DELIV-LINE-2 DTSCS69
|
|
01413 MOVE MAP-AUDIT-CITY TO MFSL-CITY DTSCS69
|
|
01414 MOVE MAP-AUDIT-STAT TO MFSL-ST DTSCS69
|
|
01415 MOVE MAP-AUDIT-ZIP TO MFSL-ZIP DTSCS69
|
|
01416 MOVE SPACES TO MFSL-ADVANCED-BARCODE. DTSCS69
|
|
01417 DTSCS69
|
|
01418 MOVE MAP-MAIL-ATTN-LINE TO MFSL-ATTN-MAIL DTSCS69
|
|
01419 MOVE MAP-MAIL-DLV1-LINE TO MFSL-DELIV-MAIL-1 DTSCS69
|
|
01420 MOVE MAP-MAIL-DLV2-LINE TO MFSL-DELIV-MAIL-2 DTSCS69
|
|
01421 MOVE MAP-MAIL-CITY TO MFSL-CITY-MAIL DTSCS69
|
|
01422 MOVE MAP-MAIL-STAT TO MFSL-ST-MAIL DTSCS69
|
|
01423 MOVE MAP-MAIL-ZIP TO MFSL-ZIP-MAIL DTSCS69
|
|
01424 MOVE SPACES TO MFSL-ADVANCED-BARCODE-MAIL. DTSCS69
|
|
01425 DTSCS69
|
|
01426 MOVE MAP-AUDIT-DATE-AREA TO L015-S-DATE-AREA. DTSCS69
|
|
01427 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS69
|
|
01428 MOVE L015-DATE TO MFSL-AUDIT-DATE. DTSCS69
|
|
01429 MOVE MAP-STATUS-CD TO MFSL-STATUS-CD. DTSCS69
|
|
01430 DTSCS69
|
|
01431 MOVE MAP-AUDIT-TIME-AREA TO L025-S-TIME-AREA. DTSCS69
|
|
01432 MOVE ZEROS TO L025-S-SC. DTSCS69
|
|
01433 PERFORM S025-TIME-FROM-SCREEN THRU S025-EXIT. DTSCS69
|
|
01434 DTSCS69
|
|
01435 MOVE L025-TIME TO MFSL-AUDIT-TIME. DTSCS69
|
|
01436 ADD +1 TO LCCM-TASK-START-ABSTIME. DTSCS69
|
|
01437 MOVE LCCM-TASK-START-ABSTIME TO MFSL-ESTB-ABSTIME. DTSCS69
|
|
01438 SET MFSL-NOT-CONVERTED-88 TO TRUE. DTSCS69
|
|
01439 MOVE LCCM-CURR-RUN-DATE TO MFSL-ESTB-DATE. DTSCS69
|
|
01440 MOVE LCCM-CURR-RUN-DATE TO MFSL-CHNG-DATE. DTSCS69
|
|
01441 MOVE LCCM-OP-ID TO MFSL-CREATE-OP-ID DTSCS69
|
|
01442 MFSL-CHANGE-OP-ID. DTSCS69
|
|
01443 MOVE MFSL-REC TO MSKL-REC. DTSCS69
|
|
01444 PERFORM S810-WRITE THRU S810-EXIT. DTSCS69
|
|
01445 DTSCS69
|
|
01446 PERFORM P9600-WRITE-R615 THRU P9600-EXIT. DTSCS69
|
|
01447 P8110-EXIT. DTSCS69
|
|
01448 EXIT. DTSCS69
|
|
01449 /*****************************************************************DTSCS69
|
|
01450 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS69
|
|
01451 ******************************************************************DTSCS69
|
|
01452 DTSCS69
|
|
01453 P8200-MOD. DTSCS69
|
|
01454 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS69
|
|
01455 DTSCS69
|
|
01456 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS69
|
|
01457 DTSCS69
|
|
01458 IF LCCM-F12-88 DTSCS69
|
|
01459 MOVE PMSG-MOD-CANCELED TO LCCM-MSG-ID DTSCS69
|
|
01460 GO TO P8200-EXIT. DTSCS69
|
|
01461 DTSCS69
|
|
01462 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS69
|
|
01463 DTSCS69
|
|
01464 MOVE 'M' TO L221-UPDATE-FUNCTION. DTSCS69
|
|
01465 PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS69
|
|
01466 IF LCCM-MSG DTSCS69
|
|
01467 GO TO P8200-EXIT. DTSCS69
|
|
01468 DTSCS69
|
|
01469 PERFORM S8210-READ-MFSL THRU S8210-EXIT. DTSCS69
|
|
01470 IF L810-OK-88 DTSCS69
|
|
01471 PERFORM P8210-UPDATE-MFSL THRU P8210-EXIT DTSCS69
|
|
01472 ELSE DTSCS69
|
|
01473 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS69
|
|
01474 PERFORM S1199-ERROR THRU S1199-EXIT. DTSCS69
|
|
01475 DTSCS69
|
|
01476 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS69
|
|
01477 DTSCS69
|
|
01478 IF LCCM-MSG DTSCS69
|
|
01479 GO TO P8200-EXIT. DTSCS69
|
|
01480 MOVE MFSL-KEY-AREA TO LCCM-SCR69-HOLD-AREA. DTSCS69
|
|
01481 DTSCS69
|
|
01482 SET LCCM-ENTER-88 TO TRUE. DTSCS69
|
|
01483 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT. DTSCS69
|
|
01484 DTSCS69
|
|
01485 MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS69
|
|
01486 DTSCS69
|
|
01487 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS69
|
|
01488 P8200-EXIT. DTSCS69
|
|
01489 EXIT. DTSCS69
|
|
01490 EJECT DTSCS69
|
|
01491 P8210-UPDATE-MFSL. DTSCS69
|
|
01492 MOVE MSKL-REC TO MFSL-REC. DTSCS69
|
|
01493 MOVE ZEROS TO MFSL-REC-CHANGED. DTSCS69
|
|
01494 MOVE ZEROS TO WRITE-R615-REC. DTSCS69
|
|
01495 MOVE WRK-EMP-NO TO L331-EMP-NO. DTSCS69
|
|
01496 MOVE LCCM-CURR-RUN-DATE TO L331-CURR-RUN-DATE. DTSCS69
|
|
01497 MOVE LCCM-TASK-START-ABSTIME TO L331-UPDATE-ABSTIME. DTSCS69
|
|
01498 MOVE LCCM-OP-ID TO L331-OP-ID. DTSCS69
|
|
01499 DTSCS69
|
|
01500 IF MAP-CONTACT-NAME NOT = MFSL-NAME DTSCS69
|
|
01501 MOVE 'MFSL-NAME' TO L331-FIELD-NAME DTSCS69
|
|
01502 MOVE MFSL-NAME TO L331-FROM-VALUE DTSCS69
|
|
01503 MOVE MAP-CONTACT-NAME TO L331-TO-VALUE DTSCS69
|
|
01504 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS69
|
|
01505 MOVE MAP-CONTACT-NAME TO MFSL-NAME DTSCS69
|
|
01506 MOVE +1 TO MFSL-REC-CHANGED DTSCS69
|
|
01507 MOVE LCCM-OP-ID TO MFSL-CHANGE-OP-ID DTSCS69
|
|
01508 MOVE LCCM-CURR-RUN-DATE TO MFSL-CHNG-DATE. DTSCS69
|
|
01509 DTSCS69
|
|
01510 IF MAP-EMAIL NOT = MFSL-EMAIL-ADDRESS DTSCS69
|
|
01511 MOVE 'MFSL-EMAIL' TO L331-FIELD-NAME DTSCS69
|
|
01512 MOVE MFSL-EMAIL-ADDRESS TO L331-FROM-VALUE DTSCS69
|
|
01513 MOVE MAP-EMAIL TO L331-TO-VALUE DTSCS69
|
|
01514 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS69
|
|
01515 MOVE MAP-EMAIL TO MFSL-EMAIL-ADDRESS DTSCS69
|
|
01516 MOVE +1 TO MFSL-REC-CHANGED DTSCS69
|
|
01517 MOVE LCCM-OP-ID TO MFSL-CHANGE-OP-ID DTSCS69
|
|
01518 MOVE LCCM-CURR-RUN-DATE TO MFSL-CHNG-DATE. DTSCS69
|
|
01519 DTSCS69
|
|
01520 MOVE MAP-AUDIT-TIME-AREA TO L025-S-TIME-AREA. DTSCS69
|
|
01521 MOVE ZEROS TO L025-S-SC. DTSCS69
|
|
01522 DTSCS69
|
|
01523 PERFORM S025-TIME-FROM-SCREEN THRU S025-EXIT. DTSCS69
|
|
01524 DTSCS69
|
|
01525 IF L025-TIME NOT = MFSL-AUDIT-TIME DTSCS69
|
|
01526 MOVE 'MFSL-AUDIT-TIME' TO L331-FIELD-NAME DTSCS69
|
|
01527 MOVE MFSL-AUDIT-TIME TO L331-FROM-VALUE DTSCS69
|
|
01528 MOVE L025-TIME TO L331-TO-VALUE DTSCS69
|
|
01529 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS69
|
|
01530 MOVE L025-TIME TO MFSL-AUDIT-TIME DTSCS69
|
|
01531 MOVE LCCM-OP-ID TO MFSL-CHANGE-OP-ID DTSCS69
|
|
01532 MOVE +1 TO MFSL-REC-CHANGED DTSCS69
|
|
01533 MOVE LCCM-CURR-RUN-DATE TO MFSL-CHNG-DATE. DTSCS69
|
|
01534 DTSCS69
|
|
01535 IF MAP-STATUS-CD NOT = MFSL-STATUS-CD DTSCS69
|
|
01536 MOVE 'MFSL-STATUS-CD' TO L331-FIELD-NAME DTSCS69
|
|
01537 MOVE MFSL-STATUS-CD TO L331-FROM-VALUE DTSCS69
|
|
01538 MOVE MAP-STATUS-CD TO L331-TO-VALUE DTSCS69
|
|
01539 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS69
|
|
01540 MOVE MAP-STATUS-CD TO MFSL-STATUS-CD DTSCS69
|
|
01541 MOVE LCCM-OP-ID TO MFSL-CHANGE-OP-ID DTSCS69
|
|
01542 MOVE +1 TO MFSL-REC-CHANGED DTSCS69
|
|
01543 MOVE LCCM-CURR-RUN-DATE TO MFSL-CHNG-DATE. DTSCS69
|
|
01544 DTSCS69
|
|
01545 IF MAP-AUDIT-ATTN-LINE NOT = MFSL-ATTN-LINE DTSCS69
|
|
01546 MOVE 'MFSL-ATTN-LINE' TO L331-FIELD-NAME DTSCS69
|
|
01547 MOVE MFSL-ATTN-LINE TO L331-FROM-VALUE DTSCS69
|
|
01548 MOVE MAP-AUDIT-ATTN-LINE TO L331-TO-VALUE DTSCS69
|
|
01549 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS69
|
|
01550 MOVE MAP-AUDIT-ATTN-LINE TO MFSL-ATTN-LINE DTSCS69
|
|
01551 MOVE +1 TO MFSL-REC-CHANGED DTSCS69
|
|
01552 MOVE LCCM-OP-ID TO MFSL-CHANGE-OP-ID DTSCS69
|
|
01553 MOVE LCCM-CURR-RUN-DATE TO MFSL-CHNG-DATE. DTSCS69
|
|
01554 DTSCS69
|
|
01555 IF MAP-AUDIT-DLV1-LINE NOT = MFSL-DELIV-LINE-1 DTSCS69
|
|
01556 MOVE 'MFSL-DELIV-LINE-1' TO L331-FIELD-NAME DTSCS69
|
|
01557 MOVE MFSL-DELIV-LINE-1 TO L331-FROM-VALUE DTSCS69
|
|
01558 MOVE MAP-AUDIT-DLV1-LINE TO L331-TO-VALUE DTSCS69
|
|
01559 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS69
|
|
01560 MOVE MAP-AUDIT-DLV1-LINE TO MFSL-DELIV-LINE-1 DTSCS69
|
|
01561 MOVE +1 TO MFSL-REC-CHANGED DTSCS69
|
|
01562 MOVE LCCM-OP-ID TO MFSL-CHANGE-OP-ID DTSCS69
|
|
01563 MOVE LCCM-CURR-RUN-DATE TO MFSL-CHNG-DATE. DTSCS69
|
|
01564 DTSCS69
|
|
01565 IF MAP-AUDIT-DLV2-LINE NOT = MFSL-DELIV-LINE-2 DTSCS69
|
|
01566 MOVE 'MFSL-DELIV-LINE-2' TO L331-FIELD-NAME DTSCS69
|
|
01567 MOVE MFSL-DELIV-LINE-2 TO L331-FROM-VALUE DTSCS69
|
|
01568 MOVE MAP-AUDIT-DLV2-LINE TO L331-TO-VALUE DTSCS69
|
|
01569 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS69
|
|
01570 MOVE MAP-AUDIT-DLV2-LINE TO MFSL-DELIV-LINE-2 DTSCS69
|
|
01571 MOVE +1 TO MFSL-REC-CHANGED DTSCS69
|
|
01572 MOVE LCCM-OP-ID TO MFSL-CHANGE-OP-ID DTSCS69
|
|
01573 MOVE LCCM-CURR-RUN-DATE TO MFSL-CHNG-DATE. DTSCS69
|
|
01574 DTSCS69
|
|
01575 IF MAP-AUDIT-CITY NOT = MFSL-CITY DTSCS69
|
|
01576 MOVE 'MFSL-CITY' TO L331-FIELD-NAME DTSCS69
|
|
01577 MOVE MFSL-CITY TO L331-FROM-VALUE DTSCS69
|
|
01578 MOVE MAP-AUDIT-CITY TO L331-TO-VALUE DTSCS69
|
|
01579 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS69
|
|
01580 MOVE +1 TO MFSL-REC-CHANGED DTSCS69
|
|
01581 MOVE LCCM-OP-ID TO MFSL-CHANGE-OP-ID DTSCS69
|
|
01582 MOVE MAP-AUDIT-CITY TO MFSL-CITY DTSCS69
|
|
01583 MOVE LCCM-CURR-RUN-DATE TO MFSL-CHNG-DATE. DTSCS69
|
|
01584 DTSCS69
|
|
01585 IF MAP-AUDIT-STAT NOT = MFSL-ST DTSCS69
|
|
01586 MOVE 'MFSL-ST' TO L331-FIELD-NAME DTSCS69
|
|
01587 MOVE MFSL-ST TO L331-FROM-VALUE DTSCS69
|
|
01588 MOVE MAP-AUDIT-STAT TO L331-TO-VALUE DTSCS69
|
|
01589 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS69
|
|
01590 MOVE +1 TO MFSL-REC-CHANGED DTSCS69
|
|
01591 MOVE LCCM-OP-ID TO MFSL-CHANGE-OP-ID DTSCS69
|
|
01592 MOVE MAP-AUDIT-STAT TO MFSL-ST DTSCS69
|
|
01593 MOVE LCCM-CURR-RUN-DATE TO MFSL-CHNG-DATE. DTSCS69
|
|
01594 DTSCS69
|
|
01595 IF MAP-AUDIT-ZIP NOT = MFSL-ZIP DTSCS69
|
|
01596 MOVE 'MFSL-ZIP' TO L331-FIELD-NAME DTSCS69
|
|
01597 MOVE MFSL-ZIP TO L331-FROM-VALUE DTSCS69
|
|
01598 MOVE MAP-AUDIT-ZIP TO L331-TO-VALUE DTSCS69
|
|
01599 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS69
|
|
01600 MOVE MAP-AUDIT-ZIP TO MFSL-ZIP DTSCS69
|
|
01601 MOVE +1 TO MFSL-REC-CHANGED DTSCS69
|
|
01602 MOVE LCCM-OP-ID TO MFSL-CHANGE-OP-ID DTSCS69
|
|
01603 MOVE LCCM-CURR-RUN-DATE TO MFSL-CHNG-DATE. DTSCS69
|
|
01604 DTSCS69
|
|
01605 IF MAP-MAIL-ATTN-LINE NOT = MFSL-ATTN-MAIL DTSCS69
|
|
01606 MOVE 'MFSL-ATTN-MAIL' TO L331-FIELD-NAME DTSCS69
|
|
01607 MOVE MFSL-ATTN-MAIL TO L331-FROM-VALUE DTSCS69
|
|
01608 MOVE MAP-MAIL-ATTN-LINE TO L331-TO-VALUE DTSCS69
|
|
01609 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS69
|
|
01610 MOVE +1 TO MFSL-REC-CHANGED DTSCS69
|
|
01611 MOVE +1 TO WRITE-R615-REC DTSCS69
|
|
01612 MOVE LCCM-OP-ID TO MFSL-CHANGE-OP-ID DTSCS69
|
|
01613 MOVE MAP-MAIL-ATTN-LINE TO MFSL-ATTN-MAIL DTSCS69
|
|
01614 MOVE LCCM-CURR-RUN-DATE TO MFSL-CHNG-DATE. DTSCS69
|
|
01615 DTSCS69
|
|
01616 IF MAP-MAIL-DLV1-LINE NOT = MFSL-DELIV-MAIL-1 DTSCS69
|
|
01617 MOVE 'MFSL-DELIV-MAIL-1' TO L331-FIELD-NAME DTSCS69
|
|
01618 MOVE MFSL-DELIV-MAIL-1 TO L331-FROM-VALUE DTSCS69
|
|
01619 MOVE MAP-MAIL-DLV1-LINE TO L331-TO-VALUE DTSCS69
|
|
01620 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS69
|
|
01621 MOVE MAP-MAIL-DLV1-LINE TO MFSL-DELIV-MAIL-1 DTSCS69
|
|
01622 MOVE +1 TO MFSL-REC-CHANGED DTSCS69
|
|
01623 MOVE +1 TO WRITE-R615-REC DTSCS69
|
|
01624 MOVE LCCM-OP-ID TO MFSL-CHANGE-OP-ID DTSCS69
|
|
01625 MOVE LCCM-CURR-RUN-DATE TO MFSL-CHNG-DATE. DTSCS69
|
|
01626 DTSCS69
|
|
01627 IF MAP-MAIL-DLV2-LINE NOT = MFSL-DELIV-MAIL-2 DTSCS69
|
|
01628 MOVE 'MFSL-DELIV-MAIL-2' TO L331-FIELD-NAME DTSCS69
|
|
01629 MOVE MFSL-DELIV-MAIL-2 TO L331-FROM-VALUE DTSCS69
|
|
01630 MOVE MAP-MAIL-DLV2-LINE TO L331-TO-VALUE DTSCS69
|
|
01631 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS69
|
|
01632 MOVE MAP-MAIL-DLV2-LINE TO MFSL-DELIV-MAIL-2 DTSCS69
|
|
01633 MOVE +1 TO MFSL-REC-CHANGED DTSCS69
|
|
01634 MOVE +1 TO WRITE-R615-REC DTSCS69
|
|
01635 MOVE LCCM-OP-ID TO MFSL-CHANGE-OP-ID DTSCS69
|
|
01636 MOVE LCCM-CURR-RUN-DATE TO MFSL-CHNG-DATE. DTSCS69
|
|
01637 DTSCS69
|
|
01638 IF MAP-MAIL-CITY NOT = MFSL-CITY-MAIL DTSCS69
|
|
01639 MOVE 'MFSL-CITY-MAIL' TO L331-FIELD-NAME DTSCS69
|
|
01640 MOVE MFSL-CITY-MAIL TO L331-FROM-VALUE DTSCS69
|
|
01641 MOVE MAP-MAIL-CITY TO L331-TO-VALUE DTSCS69
|
|
01642 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS69
|
|
01643 MOVE MAP-MAIL-CITY TO MFSL-CITY-MAIL DTSCS69
|
|
01644 MOVE +1 TO MFSL-REC-CHANGED DTSCS69
|
|
01645 MOVE +1 TO WRITE-R615-REC DTSCS69
|
|
01646 MOVE LCCM-OP-ID TO MFSL-CHANGE-OP-ID DTSCS69
|
|
01647 MOVE LCCM-CURR-RUN-DATE TO MFSL-CHNG-DATE. DTSCS69
|
|
01648 DTSCS69
|
|
01649 IF MAP-MAIL-STAT NOT = MFSL-ST-MAIL DTSCS69
|
|
01650 MOVE 'MFSL-ST-MAIL' TO L331-FIELD-NAME DTSCS69
|
|
01651 MOVE MFSL-ST-MAIL TO L331-FROM-VALUE DTSCS69
|
|
01652 MOVE MAP-MAIL-STAT TO L331-TO-VALUE DTSCS69
|
|
01653 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS69
|
|
01654 MOVE +1 TO MFSL-REC-CHANGED DTSCS69
|
|
01655 MOVE +1 TO WRITE-R615-REC DTSCS69
|
|
01656 MOVE LCCM-OP-ID TO MFSL-CHANGE-OP-ID DTSCS69
|
|
01657 MOVE MAP-MAIL-STAT TO MFSL-ST-MAIL DTSCS69
|
|
01658 MOVE LCCM-CURR-RUN-DATE TO MFSL-CHNG-DATE. DTSCS69
|
|
01659 DTSCS69
|
|
01660 IF MAP-MAIL-ZIP NOT = MFSL-ZIP-MAIL DTSCS69
|
|
01661 MOVE 'MFSL-ZIP-MAIL' TO L331-FIELD-NAME DTSCS69
|
|
01662 MOVE MFSL-ZIP-MAIL TO L331-FROM-VALUE DTSCS69
|
|
01663 MOVE MAP-MAIL-ZIP TO L331-TO-VALUE DTSCS69
|
|
01664 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS69
|
|
01665 MOVE MAP-MAIL-ZIP TO MFSL-ZIP-MAIL DTSCS69
|
|
01666 MOVE +1 TO MFSL-REC-CHANGED DTSCS69
|
|
01667 MOVE +1 TO WRITE-R615-REC DTSCS69
|
|
01668 MOVE LCCM-OP-ID TO MFSL-CHANGE-OP-ID DTSCS69
|
|
01669 MOVE LCCM-CURR-RUN-DATE TO MFSL-CHNG-DATE. DTSCS69
|
|
01670 DTSCS69
|
|
01671 MOVE MFSL-VOICE-1 TO WRK-MFSL-PHONE (1). DTSCS69
|
|
01672 MOVE MFSL-VOICE-2 TO WRK-MFSL-PHONE (2). DTSCS69
|
|
01673 MOVE MFSL-FAX TO WRK-MFSL-PHONE (3). DTSCS69
|
|
01674 PERFORM P8220-UPDATE-PHONES THRU P8220-EXIT DTSCS69
|
|
01675 VARYING WRK-PHONE FROM 1 BY 1 DTSCS69
|
|
01676 UNTIL WRK-PHONE GREATER THAN 3. DTSCS69
|
|
01677 MOVE WRK-MFSL-PHONE (1) TO MFSL-VOICE-1. DTSCS69
|
|
01678 MOVE WRK-MFSL-PHONE (2) TO MFSL-VOICE-2. DTSCS69
|
|
01679 MOVE WRK-MFSL-PHONE (3) TO MFSL-FAX. DTSCS69
|
|
01680 MOVE LCCM-CURR-RUN-DATE TO MFSL-CHNG-DATE. DTSCS69
|
|
01681 MOVE LCCM-OP-ID TO MFSL-CHANGE-OP-ID. DTSCS69
|
|
01682 MOVE MFSL-REC TO MSKL-REC. DTSCS69
|
|
01683 IF MFSL-REC-CHANGED > 0 DTSCS69
|
|
01684 PERFORM S810-REWRITE THRU S810-EXIT. DTSCS69
|
|
01685 IF WRITE-R615-REC > 0 DTSCS69
|
|
01686 PERFORM P9600-WRITE-R615 THRU P9600-EXIT. DTSCS69
|
|
01687 P8210-EXIT. DTSCS69
|
|
01688 EXIT. DTSCS69
|
|
01689 P8220-UPDATE-PHONES. DTSCS69
|
|
01690 MOVE MAP-PHONE-AREA (WRK-PHONE) TO L021-S-TNO-AREA. DTSCS69
|
|
01691 PERFORM S021-TELNO-FROM-SCREEN THRU S021-EXIT. DTSCS69
|
|
01692 IF L021-TNO NOT = WRK-MFSL-PHONE (WRK-PHONE) DTSCS69
|
|
01693 MOVE WRK-331-FIELD-NAME (WRK-PHONE) TO L331-FIELD-NAME DTSCS69
|
|
01694 MOVE SPACE TO L331-FROM-VALUE DTSCS69
|
|
01695 L331-TO-VALUE DTSCS69
|
|
01696 STRING WRK-MFSL-PHONE-A-CD (WRK-PHONE) DTSCS69
|
|
01697 ' ' DTSCS69
|
|
01698 WRK-MFSL-PHONE-PREF (WRK-PHONE) DTSCS69
|
|
01699 ' ' DTSCS69
|
|
01700 WRK-MFSL-PHONE-SUFF (WRK-PHONE) DTSCS69
|
|
01701 ' ' DTSCS69
|
|
01702 WRK-MFSL-PHONE-EXT (WRK-PHONE) DELIMITED BY SIZE DTSCS69
|
|
01703 INTO L331-FROM-VALUE DTSCS69
|
|
01704 STRING L021-TNO-AREA-CD DTSCS69
|
|
01705 ' ' DTSCS69
|
|
01706 L021-TNO-PREFIX DTSCS69
|
|
01707 ' ' DTSCS69
|
|
01708 L021-TNO-SUFFIX DTSCS69
|
|
01709 ' ' DTSCS69
|
|
01710 L021-TNO-EXT DELIMITED BY SIZE DTSCS69
|
|
01711 INTO L331-TO-VALUE DTSCS69
|
|
01712 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS69
|
|
01713 MOVE +1 TO MFSL-REC-CHANGED DTSCS69
|
|
01714 MOVE LCCM-OP-ID TO MFSL-CHANGE-OP-ID DTSCS69
|
|
01715 MOVE L021-TNO TO WRK-MFSL-PHONE (WRK-PHONE). DTSCS69
|
|
01716 DTSCS69
|
|
01717 P8220-EXIT. EXIT. DTSCS69
|
|
01718 /*****************************************************************DTSCS69
|
|
01719 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS69
|
|
01720 ******************************************************************DTSCS69
|
|
01721 DTSCS69
|
|
01722 P8810-LOCK-EMPLOYER. DTSCS69
|
|
01723 MOVE WRK-EMP-NO TO L221-EMP-NO. DTSCS69
|
|
01724 MOVE LCCM-SCR-ABSTIME TO L221-SCR-ABSTIME. DTSCS69
|
|
01725 MOVE LCCM-TASK-ID TO L221-UPDATE-TASK-ID. DTSCS69
|
|
01726 MOVE LCCM-OP-ID TO L221-UPDATE-OP-ID. DTSCS69
|
|
01727 MOVE LCCM-CICS-TERM-ID TO L221-UPDATE-TERMID. DTSCS69
|
|
01728 MOVE LCCM-TASK-NETNAME TO L221-UPDATE-NETNAME. DTSCS69
|
|
01729 MOVE LCCM-TASK-START-DATE TO L221-UPDATE-START-DATE. DTSCS69
|
|
01730 MOVE LCCM-TASK-START-TIME TO L221-UPDATE-START-TIME. DTSCS69
|
|
01731 MOVE WRK-SCR-ID TO L221-UPDATE-SCR-ID. DTSCS69
|
|
01732 DTSCS69
|
|
01733 PERFORM S221-EMP-LOCK THRU S221-EXIT. DTSCS69
|
|
01734 P8810-EXIT. DTSCS69
|
|
01735 EXIT. DTSCS69
|
|
01736 EJECT DTSCS69
|
|
01737 DTSCS69
|
|
01738 /*****************************************************************DTSCS69
|
|
01739 * LINKS TO UTILITY MODULES DTSCS69
|
|
01740 ******************************************************************DTSCS69
|
|
01741 DTSCS69
|
|
01742 S001-FROM-FED-8. DTSCS69
|
|
01743 SET L001-FROM-FED-8 TO TRUE. DTSCS69
|
|
01744 GO TO S001-DATE. DTSCS69
|
|
01745 DTSCS69
|
|
01746 S001-FROM-ABS-DATE. DTSCS69
|
|
01747 SET L001-FROM-ABS-DAY TO TRUE. DTSCS69
|
|
01748 GO TO S001-DATE. DTSCS69
|
|
01749 DTSCS69
|
|
01750 S001-DATE. DTSCS69
|
|
01751 EXEC CICS LINK DTSCS69
|
|
01752 PROGRAM('DTSCU001') DTSCS69
|
|
01753 COMMAREA(L001-COMM-AREA) DTSCS69
|
|
01754 END-EXEC. DTSCS69
|
|
01755 S001-EXIT. DTSCS69
|
|
01756 EXIT. DTSCS69
|
|
01757 DTSCS69
|
|
01758 S013-COUNT-FROM-SCREEN. DTSCS69
|
|
01759 EXEC CICS LINK DTSCS69
|
|
01760 PROGRAM ('DTSCU013') DTSCS69
|
|
01761 COMMAREA (L013-COMM-AREA) DTSCS69
|
|
01762 END-EXEC. DTSCS69
|
|
01763 S013-EXIT. DTSCS69
|
|
01764 EXIT. DTSCS69
|
|
01765 SKIP3 DTSCS69
|
|
01766 S018-EMP-NO-FROM-SCREEN. DTSCS69
|
|
01767 EXEC CICS LINK DTSCS69
|
|
01768 PROGRAM ('DTSCU018') DTSCS69
|
|
01769 COMMAREA (L018-COMM-AREA) DTSCS69
|
|
01770 END-EXEC. DTSCS69
|
|
01771 S018-EXIT. DTSCS69
|
|
01772 EXIT. DTSCS69
|
|
01773 SKIP3 DTSCS69
|
|
01774 DTSCS69
|
|
01775 S022-ASSIGN-NO-FROM-SCREEN. DTSCS69
|
|
01776 EXEC CICS LINK DTSCS69
|
|
01777 PROGRAM('DTSCU022') DTSCS69
|
|
01778 COMMAREA(L022-COMM-AREA) DTSCS69
|
|
01779 END-EXEC. DTSCS69
|
|
01780 S022-EXIT. DTSCS69
|
|
01781 EXIT. DTSCS69
|
|
01782 DTSCS69
|
|
01783 S021-TELNO-FROM-SCREEN. DTSCS69
|
|
01784 EXEC CICS LINK DTSCS69
|
|
01785 PROGRAM ('DTSCU021') DTSCS69
|
|
01786 COMMAREA (L021-COMM-AREA) DTSCS69
|
|
01787 END-EXEC. DTSCS69
|
|
01788 S021-EXIT. DTSCS69
|
|
01789 EXIT. DTSCS69
|
|
01790 S025-TIME-FROM-SCREEN. DTSCS69
|
|
01791 EXEC CICS LINK DTSCS69
|
|
01792 PROGRAM('DTSCU025') DTSCS69
|
|
01793 COMMAREA(L025-COMM-AREA) DTSCS69
|
|
01794 END-EXEC. DTSCS69
|
|
01795 S025-EXIT. DTSCS69
|
|
01796 EXIT. DTSCS69
|
|
01797 S073-TELNO-EDIT. DTSCS69
|
|
01798 EXEC CICS LINK DTSCS69
|
|
01799 PROGRAM ('DTSCU073') DTSCS69
|
|
01800 COMMAREA (L073-COMM-AREA) DTSCS69
|
|
01801 END-EXEC. DTSCS69
|
|
01802 S073-EXIT. DTSCS69
|
|
01803 EXIT. DTSCS69
|
|
01804 SKIP3 DTSCS69
|
|
01805 S015-DATE-FROM-SCREEN. DTSCS69
|
|
01806 EXEC CICS LINK DTSCS69
|
|
01807 PROGRAM ('DTSCU015') DTSCS69
|
|
01808 COMMAREA (L015-COMM-AREA) DTSCS69
|
|
01809 END-EXEC. DTSCS69
|
|
01810 S015-EXIT. DTSCS69
|
|
01811 EXIT. DTSCS69
|
|
01812 S062-FLD-REP-ID-DESC. DTSCS69
|
|
01813 EXEC CICS LINK DTSCS69
|
|
01814 PROGRAM('DTSCU062') DTSCS69
|
|
01815 COMMAREA(L062-COMM-AREA) DTSCS69
|
|
01816 END-EXEC. DTSCS69
|
|
01817 S062-EXIT. DTSCS69
|
|
01818 EXIT. DTSCS69
|
|
01819 S072-EDIT-ADDRESS. DTSCS69
|
|
01820 EXEC CICS LINK DTSCS69
|
|
01821 PROGRAM ('DTSCU072') DTSCS69
|
|
01822 COMMAREA (L072-COMM-AREA) DTSCS69
|
|
01823 END-EXEC. DTSCS69
|
|
01824 S072-EXIT. DTSCS69
|
|
01825 EXIT. DTSCS69
|
|
01826 SKIP3 DTSCS69
|
|
01827 S111-ADDR-LOOKUP. DTSCS69
|
|
01828 EXEC CICS LINK DTSCS69
|
|
01829 PROGRAM('DTSCU111') DTSCS69
|
|
01830 COMMAREA(L111-COMM-AREA) DTSCS69
|
|
01831 END-EXEC. DTSCS69
|
|
01832 DTSCS69
|
|
01833 IF L111-FILE-CLOSED-88 DTSCS69
|
|
01834 MOVE L111-MSG-AREA TO LCCM-MSG-AREA DTSCS69
|
|
01835 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS69
|
|
01836 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS69
|
|
01837 GO TO MAINLINE-EXIT. DTSCS69
|
|
01838 S111-EXIT. DTSCS69
|
|
01839 EXIT. DTSCS69
|
|
01840 S112-ADDR-FORMAT. DTSCS69
|
|
01841 EXEC CICS LINK DTSCS69
|
|
01842 PROGRAM('DTSCU112') DTSCS69
|
|
01843 COMMAREA(L112-COMM-AREA) DTSCS69
|
|
01844 END-EXEC. DTSCS69
|
|
01845 S112-EXIT. EXIT. DTSCS69
|
|
01846 S203-DETER-ZIPS. DTSCS69
|
|
01847 EXEC CICS LINK DTSCS69
|
|
01848 PROGRAM ('DTSCU203') DTSCS69
|
|
01849 COMMAREA (L203-COMM-AREA) DTSCS69
|
|
01850 END-EXEC. DTSCS69
|
|
01851 DTSCS69
|
|
01852 IF L203-FILE-CLOSED-88 DTSCS69
|
|
01853 MOVE L203-MSG-AREA TO LCCM-MSG-AREA DTSCS69
|
|
01854 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS69
|
|
01855 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS69
|
|
01856 GO TO MAINLINE-EXIT. DTSCS69
|
|
01857 S203-EXIT. DTSCS69
|
|
01858 EXIT. DTSCS69
|
|
01859 DTSCS69
|
|
01860 S221-EMP-LOCK. DTSCS69
|
|
01861 SET L221-START-UPDATE TO TRUE. DTSCS69
|
|
01862 GO TO S221-EMP-LOCK-UNLOCK. DTSCS69
|
|
01863 DTSCS69
|
|
01864 S221-EMP-UNLOCK. DTSCS69
|
|
01865 SET L221-END-UPDATE TO TRUE. DTSCS69
|
|
01866 GO TO S221-EMP-LOCK-UNLOCK. DTSCS69
|
|
01867 DTSCS69
|
|
01868 S221-EMP-LOCK-UNLOCK. DTSCS69
|
|
01869 EXEC CICS LINK DTSCS69
|
|
01870 PROGRAM('DTSCU221') DTSCS69
|
|
01871 COMMAREA(L221-COMM-AREA) DTSCS69
|
|
01872 END-EXEC. DTSCS69
|
|
01873 DTSCS69
|
|
01874 IF L221-FILE-CLOSED DTSCS69
|
|
01875 MOVE L221-MSG-AREA TO LCCM-MSG-AREA DTSCS69
|
|
01876 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS69
|
|
01877 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS69
|
|
01878 GO TO MAINLINE-EXIT. DTSCS69
|
|
01879 DTSCS69
|
|
01880 IF L221-NOT-OK DTSCS69
|
|
01881 MOVE L221-MSG-AREA TO LCCM-MSG-AREA. DTSCS69
|
|
01882 S221-EXIT. DTSCS69
|
|
01883 EXIT. DTSCS69
|
|
01884 DTSCS69
|
|
01885 S331-EMP-WRITE-MLOG. DTSCS69
|
|
01886 EXEC CICS LINK DTSCS69
|
|
01887 PROGRAM ('DTSCU331') DTSCS69
|
|
01888 COMMAREA (L331-COMM-AREA) DTSCS69
|
|
01889 END-EXEC. DTSCS69
|
|
01890 DTSCS69
|
|
01891 IF L331-FILE-CLOSED DTSCS69
|
|
01892 MOVE L331-MSG-AREA TO LCCM-MSG-AREA DTSCS69
|
|
01893 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS69
|
|
01894 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS69
|
|
01895 GO TO MAINLINE-EXIT. DTSCS69
|
|
01896 S331-EXIT. DTSCS69
|
|
01897 EXIT. DTSCS69
|
|
01898 S803-REQ-SCR-ID-EDIT. DTSCS69
|
|
01899 EXEC CICS LINK DTSCS69
|
|
01900 PROGRAM ('DTSCU803') DTSCS69
|
|
01901 COMMAREA (DFHCOMMAREA) DTSCS69
|
|
01902 END-EXEC. DTSCS69
|
|
01903 S803-EXIT. DTSCS69
|
|
01904 EXIT. DTSCS69
|
|
01905 DTSCS69
|
|
01906 S804-INVALID-KEY. DTSCS69
|
|
01907 EXEC CICS LINK DTSCS69
|
|
01908 PROGRAM ('DTSCU804') DTSCS69
|
|
01909 COMMAREA (DFHCOMMAREA) DTSCS69
|
|
01910 END-EXEC. DTSCS69
|
|
01911 S804-EXIT. DTSCS69
|
|
01912 EXIT. DTSCS69
|
|
01913 DTSCS69
|
|
01914 S805-MSG-AREA. DTSCS69
|
|
01915 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS69
|
|
01916 DTSCS69
|
|
01917 EXEC CICS LINK DTSCS69
|
|
01918 PROGRAM ('DTSCU805') DTSCS69
|
|
01919 COMMAREA (L805-COMM-AREA) DTSCS69
|
|
01920 END-EXEC. DTSCS69
|
|
01921 DTSCS69
|
|
01922 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS69
|
|
01923 S805-EXIT. DTSCS69
|
|
01924 EXIT. DTSCS69
|
|
01925 EJECT DTSCS69
|
|
01926 S810-READ. DTSCS69
|
|
01927 SET L810-READ-88 TO TRUE. DTSCS69
|
|
01928 GO TO S810-IO. DTSCS69
|
|
01929 DTSCS69
|
|
01930 S810-START-BROWSE. DTSCS69
|
|
01931 SET L810-START-BROWSE-88 TO TRUE. DTSCS69
|
|
01932 GO TO S810-IO. DTSCS69
|
|
01933 DTSCS69
|
|
01934 S810-READ-NEXT. DTSCS69
|
|
01935 SET L810-READ-NEXT-88 TO TRUE. DTSCS69
|
|
01936 GO TO S810-IO. DTSCS69
|
|
01937 DTSCS69
|
|
01938 S810-READ-PREV. DTSCS69
|
|
01939 SET L810-READ-PREV-88 TO TRUE. DTSCS69
|
|
01940 GO TO S810-IO. DTSCS69
|
|
01941 DTSCS69
|
|
01942 S810-END-BROWSE. DTSCS69
|
|
01943 SET L810-END-BROWSE-88 TO TRUE. DTSCS69
|
|
01944 GO TO S810-IO. DTSCS69
|
|
01945 DTSCS69
|
|
01946 S810-COUNT. DTSCS69
|
|
01947 SET L810-COUNT-88 TO TRUE. DTSCS69
|
|
01948 GO TO S810-IO. DTSCS69
|
|
01949 DTSCS69
|
|
01950 S810-REWRITE. DTSCS69
|
|
01951 SET L810-REWRITE-88 TO TRUE. DTSCS69
|
|
01952 GO TO S810-IO. DTSCS69
|
|
01953 DTSCS69
|
|
01954 S810-WRITE. DTSCS69
|
|
01955 SET L810-WRITE-88 TO TRUE. DTSCS69
|
|
01956 GO TO S810-IO. DTSCS69
|
|
01957 DTSCS69
|
|
01958 S810-IO. DTSCS69
|
|
01959 DTSCS69
|
|
01960 EXEC CICS LINK DTSCS69
|
|
01961 PROGRAM ('DTSCU810') DTSCS69
|
|
01962 COMMAREA (L810-COMM-AREA) DTSCS69
|
|
01963 END-EXEC. DTSCS69
|
|
01964 DTSCS69
|
|
01965 IF L810-FILE-CLOSED-88 DTSCS69
|
|
01966 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS69
|
|
01967 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS69
|
|
01968 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS69
|
|
01969 GO TO MAINLINE-EXIT. DTSCS69
|
|
01970 S810-EXIT. DTSCS69
|
|
01971 EXIT. DTSCS69
|
|
01972 EJECT DTSCS69
|
|
01973 S821-START-BROWSE. DTSCS69
|
|
01974 SET L821-START-BROWSE-88 TO TRUE. DTSCS69
|
|
01975 GO TO S821-MASTER-IO. DTSCS69
|
|
01976 S821-END-BROWSE. DTSCS69
|
|
01977 SET L821-END-BROWSE-88 TO TRUE. DTSCS69
|
|
01978 GO TO S821-MASTER-IO. DTSCS69
|
|
01979 S821-READ-PREV. DTSCS69
|
|
01980 SET L821-READ-PREV-88 TO TRUE. DTSCS69
|
|
01981 GO TO S821-MASTER-IO. DTSCS69
|
|
01982 S821-READ-NEXT. DTSCS69
|
|
01983 SET L821-READ-NEXT-88 TO TRUE. DTSCS69
|
|
01984 GO TO S821-MASTER-IO. DTSCS69
|
|
01985 S821-MASTER-IO. DTSCS69
|
|
01986 EXEC CICS LINK DTSCS69
|
|
01987 PROGRAM ('DTSCU821') DTSCS69
|
|
01988 COMMAREA (L821-COMM-AREA) DTSCS69
|
|
01989 END-EXEC. DTSCS69
|
|
01990 IF L821-FILE-CLOSED-88 DTSCS69
|
|
01991 MOVE L821-MSG-AREA TO LCCM-MSG-AREA DTSCS69
|
|
01992 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS69
|
|
01993 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS69
|
|
01994 GO TO MAINLINE-EXIT DTSCS69
|
|
01995 END-IF. DTSCS69
|
|
01996 S821-EXIT. EXIT. DTSCS69
|
|
01997 S825-WRITE. DTSCS69
|
|
01998 SET L825-WRITE-88 TO TRUE. DTSCS69
|
|
01999 DTSCS69
|
|
02000 EXEC CICS LINK DTSCS69
|
|
02001 PROGRAM ('DTSCU825') DTSCS69
|
|
02002 COMMAREA (L825-COMM-AREA) DTSCS69
|
|
02003 END-EXEC. DTSCS69
|
|
02004 IF L825-FILE-CLOSED-88 DTSCS69
|
|
02005 MOVE L825-MSG-AREA TO LCCM-MSG-AREA DTSCS69
|
|
02006 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS69
|
|
02007 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS69
|
|
02008 GO TO MAINLINE-EXIT. DTSCS69
|
|
02009 S825-EXIT. DTSCS69
|
|
02010 EXIT. DTSCS69
|
|
02011 EJECT DTSCS69
|
|
02012 S851-SCREEN-PROCESSING. DTSCS69
|
|
02013 EXEC CICS LINK DTSCS69
|
|
02014 PROGRAM ('DTSCU851') DTSCS69
|
|
02015 COMMAREA (L851-COMM-AREA) DTSCS69
|
|
02016 END-EXEC. DTSCS69
|
|
02017 S851-EXIT. DTSCS69
|
|
02018 EXIT. DTSCS69
|
|
02019 DTSCS69
|
|
02020 S899-ABEND. DTSCS69
|
|
02021 EXEC CICS ABEND DTSCS69
|
|
02022 ABCODE(WRK-ABEND-CD) DTSCS69
|
|
02023 END-EXEC. DTSCS69
|
|
02024 S899-EXIT. DTSCS69
|
|
02025 EXIT. DTSCS69
|
|
02026 /*****************************************************************DTSCS69
|
|
02027 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS69
|
|
02028 ******************************************************************DTSCS69
|
|
02029 DTSCS69
|
|
02030 S1000-SCREEN-EDITS. DTSCS69
|
|
02031 MOVE ZEROS TO WRK-PHONE. DTSCS69
|
|
02032 PERFORM S2100-SEQ-NO THRU S2100-EXIT. DTSCS69
|
|
02033 PERFORM S1200-PHONE THRU S1200-EXIT 3 TIMES. DTSCS69
|
|
02034 PERFORM S1300-CONTACT-NAME THRU S1300-EXIT DTSCS69
|
|
02035 PERFORM S1500-AUDIT-TIME THRU S1500-EXIT DTSCS69
|
|
02036 PERFORM S1600-STATUS-CD THRU S1600-EXIT DTSCS69
|
|
02037 DTSCS69
|
|
02038 IF LCCM-F09-88 DTSCS69
|
|
02039 PERFORM S1400-AUDIT-DATE THRU S1400-EXIT DTSCS69
|
|
02040 PERFORM S1700-ADDR-TYPE THRU S1700-EXIT DTSCS69
|
|
02041 PERFORM S1800-ADDR-ID-NO THRU S1800-EXIT DTSCS69
|
|
02042 PERFORM S2000-MAIL-TYPE THRU S2000-EXIT DTSCS69
|
|
02043 PERFORM S2020-MAIL-ID-NO THRU S2020-EXIT. DTSCS69
|
|
02044 DTSCS69
|
|
02045 PERFORM S2250-AUDIT-CASS THRU S2250-EXIT DTSCS69
|
|
02046 PERFORM S2200-AUDIT-ADDRESS THRU S2200-EXIT DTSCS69
|
|
02047 PERFORM S2450-MAIL-CASS THRU S2450-EXIT DTSCS69
|
|
02048 PERFORM S2400-MAIL-ADDRESS THRU S2400-EXIT. DTSCS69
|
|
02049 DTSCS69
|
|
02050 S1000-EXIT. EXIT. DTSCS69
|
|
02051 EJECT DTSCS69
|
|
02052 /*****************************************************************DTSCS69
|
|
02053 * DTSCS69
|
|
02054 ******************************************************************DTSCS69
|
|
02055 S1100-EDIT-KEY. DTSCS69
|
|
02056 PERFORM S1101-EMP-NO THRU S1101-EXIT. DTSCS69
|
|
02057 PERFORM S1102-ASSIGN-NO THRU S1102-EXIT. DTSCS69
|
|
02058 PERFORM S2100-SEQ-NO THRU S2100-EXIT. DTSCS69
|
|
02059 S1100-EXIT. EXIT. DTSCS69
|
|
02060 /*****************************************************************DTSCS69
|
|
02061 * DTSCS69
|
|
02062 ******************************************************************DTSCS69
|
|
02063 S1101-EMP-NO. DTSCS69
|
|
02064 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS69
|
|
02065 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS69
|
|
02066 DTSCS69
|
|
02067 IF L018-NO-ENTRY DTSCS69
|
|
02068 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS69
|
|
02069 PERFORM S1198-ERROR THRU S1198-EXIT DTSCS69
|
|
02070 GO TO S1101-EXIT. DTSCS69
|
|
02071 DTSCS69
|
|
02072 IF L018-NOT-VALID DTSCS69
|
|
02073 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS69
|
|
02074 PERFORM S1198-ERROR THRU S1198-EXIT DTSCS69
|
|
02075 GO TO S1101-EXIT. DTSCS69
|
|
02076 DTSCS69
|
|
02077 MOVE L018-EMP-NO TO WRK-EMP-NO. DTSCS69
|
|
02078 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS69
|
|
02079 S1101-EXIT. EXIT. DTSCS69
|
|
02080 DTSCS69
|
|
02081 S1110-READ-MPRF. DTSCS69
|
|
02082 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS69
|
|
02083 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS69
|
|
02084 SET MPRF-PRF-88 TO TRUE. DTSCS69
|
|
02085 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS69
|
|
02086 PERFORM S810-READ THRU S810-EXIT. DTSCS69
|
|
02087 IF L810-NO-REC-88 DTSCS69
|
|
02088 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS69
|
|
02089 PERFORM S1198-ERROR THRU S1198-EXIT DTSCS69
|
|
02090 ELSE DTSCS69
|
|
02091 MOVE MSKL-REC TO MPRF-REC DTSCS69
|
|
02092 SET WRK-MPRF-YES-88 TO TRUE. DTSCS69
|
|
02093 S1110-EXIT. EXIT. DTSCS69
|
|
02094 S1102-ASSIGN-NO. DTSCS69
|
|
02095 MOVE MAP-ASSIGN-NO-AREA TO L022-S-ASSIGN-NO-AREA. DTSCS69
|
|
02096 PERFORM S022-ASSIGN-NO-FROM-SCREEN THRU S022-EXIT. DTSCS69
|
|
02097 DTSCS69
|
|
02098 IF L022-NO-ENTRY DTSCS69
|
|
02099 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS69
|
|
02100 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS69
|
|
02101 GO TO S1102-EXIT. DTSCS69
|
|
02102 DTSCS69
|
|
02103 IF L022-NOT-VALID DTSCS69
|
|
02104 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS69
|
|
02105 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS69
|
|
02106 GO TO S1102-EXIT. DTSCS69
|
|
02107 DTSCS69
|
|
02108 MOVE L022-ASSIGN-NO TO WRK-ASSIGN-NO. DTSCS69
|
|
02109 PERFORM S1115-READ-MFAS THRU S1115-EXIT. DTSCS69
|
|
02110 S1102-EXIT. EXIT. DTSCS69
|
|
02111 DTSCS69
|
|
02112 /*****************************************************************DTSCS69
|
|
02113 * DTSCS69
|
|
02114 ******************************************************************DTSCS69
|
|
02115 S1115-READ-MFAS. DTSCS69
|
|
02116 MOVE LOW-VALUES TO MFAS-KEY-AREA. DTSCS69
|
|
02117 MOVE WRK-ASSIGN-NO TO MFAS-ASSIGN-NO. DTSCS69
|
|
02118 MOVE WRK-EMP-NO TO MFAS-EMP-NO. DTSCS69
|
|
02119 SET MFAS-FAS-88 TO TRUE. DTSCS69
|
|
02120 DTSCS69
|
|
02121 MOVE MFAS-KEY-AREA TO MSKL-KEY-AREA. DTSCS69
|
|
02122 DTSCS69
|
|
02123 PERFORM S810-READ THRU S810-EXIT. DTSCS69
|
|
02124 DTSCS69
|
|
02125 IF L810-NO-REC-88 DTSCS69
|
|
02126 SET L821-NO-REC-88 TO TRUE DTSCS69
|
|
02127 MOVE EMSG-NO-ASSIGNMENT TO WRK-MSG-AREA DTSCS69
|
|
02128 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS69
|
|
02129 GO TO S1115-EXIT DTSCS69
|
|
02130 ELSE DTSCS69
|
|
02131 MOVE MSKL-REC TO MFAS-REC DTSCS69
|
|
02132 END-IF. DTSCS69
|
|
02133 DTSCS69
|
|
02134 IF MFAS-NON-AUDIT-88 DTSCS69
|
|
02135 MOVE MSG-E693-AREA TO WRK-MSG-AREA DTSCS69
|
|
02136 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS69
|
|
02137 GO TO S1115-EXIT. DTSCS69
|
|
02138 DTSCS69
|
|
02139 IF MFAS-STATUS-PROCESSED-88 OR DTSCS69
|
|
02140 MFAS-STATUS-COMPLETE-88 OR DTSCS69
|
|
02141 MFAS-STATUS-ACTIVE-88 DTSCS69
|
|
02142 CONTINUE DTSCS69
|
|
02143 ELSE DTSCS69
|
|
02144 MOVE MSG-E696-AREA TO WRK-MSG-AREA DTSCS69
|
|
02145 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS69
|
|
02146 GO TO S1115-EXIT DTSCS69
|
|
02147 END-IF. DTSCS69
|
|
02148 DTSCS69
|
|
02149 S1115-EXIT. DTSCS69
|
|
02150 EXIT. DTSCS69
|
|
02151 /*****************************************************************DTSCS69
|
|
02152 * DTSCS69
|
|
02153 ******************************************************************DTSCS69
|
|
02154 /*****************************************************************DTSCS69
|
|
02155 * DTSCS69
|
|
02156 ******************************************************************DTSCS69
|
|
02157 S1130-READ-MPRF. DTSCS69
|
|
02158 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS69
|
|
02159 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS69
|
|
02160 SET MPRF-PRF-88 TO TRUE. DTSCS69
|
|
02161 DTSCS69
|
|
02162 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS69
|
|
02163 DTSCS69
|
|
02164 PERFORM S810-READ THRU S810-EXIT. DTSCS69
|
|
02165 DTSCS69
|
|
02166 IF L810-NO-REC-88 DTSCS69
|
|
02167 MOVE WRK-EMP-NO TO MSG-EMP-NO-IN-ERR DTSCS69
|
|
02168 MOVE MSG-E695-AREA TO LCCM-MSG-AREA DTSCS69
|
|
02169 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS69
|
|
02170 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS69
|
|
02171 GO TO MAINLINE-EXIT DTSCS69
|
|
02172 ELSE DTSCS69
|
|
02173 MOVE MSKL-REC TO MPRF-REC DTSCS69
|
|
02174 SET WRK-MPRF-YES-88 TO TRUE DTSCS69
|
|
02175 END-IF. DTSCS69
|
|
02176 DTSCS69
|
|
02177 S1130-EXIT. DTSCS69
|
|
02178 EXIT. DTSCS69
|
|
02179 DTSCS69
|
|
02180 S1198-ERROR. DTSCS69
|
|
02181 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS69
|
|
02182 MAP-EMP-NO-2-A. DTSCS69
|
|
02183 IF LCCM-NO-MSG DTSCS69
|
|
02184 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS69
|
|
02185 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L DTSCS69
|
|
02186 SET CURSOR-SET-YES TO TRUE. DTSCS69
|
|
02187 S1198-EXIT. EXIT. DTSCS69
|
|
02188 DTSCS69
|
|
02189 S1199-ERROR. DTSCS69
|
|
02190 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-ASSIGN-NO-1-A DTSCS69
|
|
02191 MAP-ASSIGN-NO-2-A. DTSCS69
|
|
02192 IF LCCM-NO-MSG DTSCS69
|
|
02193 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS69
|
|
02194 MOVE CATB-CURSOR TO MAP-ASSIGN-NO-1-L DTSCS69
|
|
02195 SET CURSOR-SET-YES TO TRUE. DTSCS69
|
|
02196 S1199-EXIT. EXIT. DTSCS69
|
|
02197 DTSCS69
|
|
02198 /*****************************************************************DTSCS69
|
|
02199 * DTSCS69
|
|
02200 ******************************************************************DTSCS69
|
|
02201 S1200-PHONE. DTSCS69
|
|
02202 ADD 1 TO WRK-PHONE. DTSCS69
|
|
02203 MOVE MAP-PHONE-AREA (WRK-PHONE) TO L021-S-TNO-AREA. DTSCS69
|
|
02204 PERFORM S021-TELNO-FROM-SCREEN THRU S021-EXIT. DTSCS69
|
|
02205 IF L021-NOT-VALID DTSCS69
|
|
02206 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS69
|
|
02207 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS69
|
|
02208 ELSE DTSCS69
|
|
02209 IF L021-VALID DTSCS69
|
|
02210 MOVE L021-TNO TO L073-TELEPHONE DTSCS69
|
|
02211 PERFORM S073-TELNO-EDIT THRU S073-EXIT DTSCS69
|
|
02212 IF L073-NOT-VALID DTSCS69
|
|
02213 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS69
|
|
02214 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS69
|
|
02215 ELSE DTSCS69
|
|
02216 MOVE L073-AREA-CD TO MAP-PHONE-A-CD(WRK-PHONE) DTSCS69
|
|
02217 MOVE L073-PREFIX TO MAP-PHONE-PREF(WRK-PHONE) DTSCS69
|
|
02218 MOVE L073-SUFFIX TO MAP-PHONE-SUFF(WRK-PHONE) DTSCS69
|
|
02219 MOVE L073-EXT TO MAP-PHONE-EXT(WRK-PHONE). DTSCS69
|
|
02220 S1200-EXIT. DTSCS69
|
|
02221 EXIT. DTSCS69
|
|
02222 DTSCS69
|
|
02223 S1201-ERROR. DTSCS69
|
|
02224 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS69
|
|
02225 TO MAP-PHONE-A-CD-A(WRK-PHONE) DTSCS69
|
|
02226 MAP-PHONE-PREF-A(WRK-PHONE) DTSCS69
|
|
02227 MAP-PHONE-SUFF-A(WRK-PHONE) DTSCS69
|
|
02228 MAP-PHONE-EXT-A(WRK-PHONE). DTSCS69
|
|
02229 IF LCCM-NO-MSG DTSCS69
|
|
02230 SET CURSOR-SET-YES TO TRUE DTSCS69
|
|
02231 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS69
|
|
02232 MOVE CATB-CURSOR TO MAP-PHONE-A-CD-L(WRK-PHONE). DTSCS69
|
|
02233 S1201-EXIT. DTSCS69
|
|
02234 EXIT. DTSCS69
|
|
02235 /*****************************************************************DTSCS69
|
|
02236 * DTSCS69
|
|
02237 ******************************************************************DTSCS69
|
|
02238 DTSCS69
|
|
02239 S1300-CONTACT-NAME. DTSCS69
|
|
02240 DTSCS69
|
|
02241 INSPECT MAP-CONTACT-NAME DTSCS69
|
|
02242 CONVERTING LOW-VALUES TO SPACES. DTSCS69
|
|
02243 IF MAP-CONTACT-NAME = SPACES DTSCS69
|
|
02244 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS69
|
|
02245 PERFORM S1301-ERROR THRU S1301-EXIT. DTSCS69
|
|
02246 DTSCS69
|
|
02247 S1300-EXIT. DTSCS69
|
|
02248 EXIT. DTSCS69
|
|
02249 DTSCS69
|
|
02250 S1301-ERROR. DTSCS69
|
|
02251 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS69
|
|
02252 TO MAP-CONTACT-NAME-A. DTSCS69
|
|
02253 DTSCS69
|
|
02254 IF LCCM-NO-MSG DTSCS69
|
|
02255 SET CURSOR-SET-YES TO TRUE DTSCS69
|
|
02256 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS69
|
|
02257 MOVE CATB-CURSOR TO MAP-CONTACT-NAME-L. DTSCS69
|
|
02258 S1301-EXIT. DTSCS69
|
|
02259 EXIT. DTSCS69
|
|
02260 /*****************************************************************DTSCS69
|
|
02261 * DTSCS69
|
|
02262 ******************************************************************DTSCS69
|
|
02263 S1400-AUDIT-DATE. DTSCS69
|
|
02264 MOVE +0 TO WRK-AUDIT-DATE. DTSCS69
|
|
02265 DTSCS69
|
|
02266 MOVE MAP-AUDIT-DATE-AREA TO L015-S-DATE-AREA. DTSCS69
|
|
02267 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS69
|
|
02268 DTSCS69
|
|
02269 IF L015-NO-ENTRY DTSCS69
|
|
02270 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS69
|
|
02271 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS69
|
|
02272 GO TO S1400-EXIT. DTSCS69
|
|
02273 DTSCS69
|
|
02274 IF L015-NOT-VALID DTSCS69
|
|
02275 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS69
|
|
02276 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS69
|
|
02277 GO TO S1400-EXIT DTSCS69
|
|
02278 ELSE DTSCS69
|
|
02279 MOVE L015-DATE TO WRK-AUDIT-DATE. DTSCS69
|
|
02280 DTSCS69
|
|
02281 IF L015-DATE < MFAS-START-DATE DTSCS69
|
|
02282 MOVE MSG-E694-AREA TO WRK-MSG-AREA DTSCS69
|
|
02283 PERFORM S1401-ERROR THRU S1401-EXIT. DTSCS69
|
|
02284 DTSCS69
|
|
02285 S1400-EXIT. EXIT. DTSCS69
|
|
02286 S1401-ERROR. DTSCS69
|
|
02287 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-AUDIT-MO-A DTSCS69
|
|
02288 MAP-AUDIT-DA-A DTSCS69
|
|
02289 MAP-AUDIT-YR-A. DTSCS69
|
|
02290 IF LCCM-NO-MSG DTSCS69
|
|
02291 SET CURSOR-SET-YES TO TRUE DTSCS69
|
|
02292 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS69
|
|
02293 MOVE CATB-CURSOR TO MAP-AUDIT-MO-L. DTSCS69
|
|
02294 S1401-EXIT. EXIT. DTSCS69
|
|
02295 DTSCS69
|
|
02296 S1500-AUDIT-TIME. DTSCS69
|
|
02297 IF MAP-AUDIT-TIME-HH = LOW-VALUES DTSCS69
|
|
02298 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS69
|
|
02299 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS69
|
|
02300 GO TO S1500-EXIT. DTSCS69
|
|
02301 DTSCS69
|
|
02302 IF MAP-AUDIT-TIME-HH < 08 OR > 17 DTSCS69
|
|
02303 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS69
|
|
02304 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS69
|
|
02305 GO TO S1500-EXIT. DTSCS69
|
|
02306 DTSCS69
|
|
02307 IF MAP-AUDIT-TIME-MM = LOW-VALUES DTSCS69
|
|
02308 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS69
|
|
02309 PERFORM S1502-ERROR THRU S1502-EXIT DTSCS69
|
|
02310 GO TO S1500-EXIT. DTSCS69
|
|
02311 DTSCS69
|
|
02312 IF MAP-AUDIT-TIME-MM < 00 OR > 60 DTSCS69
|
|
02313 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS69
|
|
02314 PERFORM S1502-ERROR THRU S1502-EXIT. DTSCS69
|
|
02315 DTSCS69
|
|
02316 S1500-EXIT. EXIT. DTSCS69
|
|
02317 DTSCS69
|
|
02318 S1501-ERROR. DTSCS69
|
|
02319 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-AUDIT-TIME-HH-A. DTSCS69
|
|
02320 IF LCCM-NO-MSG DTSCS69
|
|
02321 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS69
|
|
02322 MOVE CATB-CURSOR TO MAP-AUDIT-TIME-HH-L DTSCS69
|
|
02323 SET CURSOR-SET-YES TO TRUE. DTSCS69
|
|
02324 S1501-EXIT. EXIT. DTSCS69
|
|
02325 S1502-ERROR. DTSCS69
|
|
02326 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-AUDIT-TIME-MM-A. DTSCS69
|
|
02327 IF LCCM-NO-MSG DTSCS69
|
|
02328 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS69
|
|
02329 MOVE CATB-CURSOR TO MAP-AUDIT-TIME-MM-L DTSCS69
|
|
02330 SET CURSOR-SET-YES TO TRUE. DTSCS69
|
|
02331 S1502-EXIT. EXIT. DTSCS69
|
|
02332 /*****************************************************************DTSCS69
|
|
02333 * DTSCS69
|
|
02334 ******************************************************************DTSCS69
|
|
02335 S1600-STATUS-CD. DTSCS69
|
|
02336 IF MAP-STATUS-CD = SPACES OR LOW-VALUES DTSCS69
|
|
02337 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS69
|
|
02338 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS69
|
|
02339 GO TO S1600-EXIT. DTSCS69
|
|
02340 DTSCS69
|
|
02341 IF MAP-STATUS-CD = 'P' OR 'C' OR 'K' DTSCS69
|
|
02342 NEXT SENTENCE DTSCS69
|
|
02343 ELSE DTSCS69
|
|
02344 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS69
|
|
02345 PERFORM S1601-ERROR THRU S1601-EXIT. DTSCS69
|
|
02346 S1600-EXIT. EXIT. DTSCS69
|
|
02347 DTSCS69
|
|
02348 S1601-ERROR. DTSCS69
|
|
02349 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-STATUS-CD-A. DTSCS69
|
|
02350 IF LCCM-NO-MSG DTSCS69
|
|
02351 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS69
|
|
02352 MOVE CATB-CURSOR TO MAP-STATUS-CD-L DTSCS69
|
|
02353 SET CURSOR-SET-YES TO TRUE. DTSCS69
|
|
02354 S1601-EXIT. EXIT. DTSCS69
|
|
02355 /*****************************************************************DTSCS69
|
|
02356 * DTSCS69
|
|
02357 ******************************************************************DTSCS69
|
|
02358 S1700-ADDR-TYPE. DTSCS69
|
|
02359 IF MAP-ADDR-VALID-88 DTSCS69
|
|
02360 NEXT SENTENCE DTSCS69
|
|
02361 ELSE DTSCS69
|
|
02362 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS69
|
|
02363 PERFORM S1701-ERROR THRU S1701-EXIT. DTSCS69
|
|
02364 S1700-EXIT. EXIT. DTSCS69
|
|
02365 DTSCS69
|
|
02366 S1701-ERROR. DTSCS69
|
|
02367 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ADDR-TYPE-A. DTSCS69
|
|
02368 IF LCCM-NO-MSG DTSCS69
|
|
02369 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS69
|
|
02370 MOVE CATB-CURSOR TO MAP-ADDR-TYPE-L DTSCS69
|
|
02371 SET CURSOR-SET-YES TO TRUE. DTSCS69
|
|
02372 S1701-EXIT. EXIT. DTSCS69
|
|
02373 /*****************************************************************DTSCS69
|
|
02374 * DTSCS69
|
|
02375 ******************************************************************DTSCS69
|
|
02376 S1800-ADDR-ID-NO. DTSCS69
|
|
02377 INSPECT MAP-ADDR-ID-NO DTSCS69
|
|
02378 CONVERTING LOW-VALUES TO SPACES. DTSCS69
|
|
02379 DTSCS69
|
|
02380 IF MAP-ADDR-ID-NO = SPACES DTSCS69
|
|
02381 IF MAP-ADDR-TAD-88 DTSCS69
|
|
02382 PERFORM S1830-ADDR-TAD THRU S1830-EXIT DTSCS69
|
|
02383 GO TO S1800-EXIT DTSCS69
|
|
02384 ELSE DTSCS69
|
|
02385 IF MAP-ADDR-NONE-88 DTSCS69
|
|
02386 PERFORM S1840-REQUIRE-ADDRESS THRU S1840-EXIT DTSCS69
|
|
02387 GO TO S1800-EXIT DTSCS69
|
|
02388 ELSE DTSCS69
|
|
02389 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS69
|
|
02390 PERFORM S1801-ERROR THRU S1801-EXIT DTSCS69
|
|
02391 GO TO S1800-EXIT. DTSCS69
|
|
02392 DTSCS69
|
|
02393 IF MAP-ADDR-NONE-88 OR MAP-ADDR-TAD-88 DTSCS69
|
|
02394 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS69
|
|
02395 PERFORM S1801-ERROR THRU S1801-EXIT DTSCS69
|
|
02396 GO TO S1800-EXIT. DTSCS69
|
|
02397 DTSCS69
|
|
02398 MOVE MAP-ADDR-ID-NO-AREA TO L013-S-CNT-AREA. DTSCS69
|
|
02399 MOVE +1 TO L013-MIN-CNT DTSCS69
|
|
02400 MOVE +999 TO L013-MAX-CNT. DTSCS69
|
|
02401 DTSCS69
|
|
02402 PERFORM S013-COUNT-FROM-SCREEN THRU S013-EXIT. DTSCS69
|
|
02403 DTSCS69
|
|
02404 IF L013-VALID DTSCS69
|
|
02405 MOVE L013-CNT TO MAP-ADDR-ID-NO-Z DTSCS69
|
|
02406 IF MAP-ADDR-TAA-OPO-88 DTSCS69
|
|
02407 PERFORM S1850-ADDR-TAA-OPO THRU S1850-EXIT DTSCS69
|
|
02408 ELSE DTSCS69
|
|
02409 NEXT SENTENCE DTSCS69
|
|
02410 ELSE DTSCS69
|
|
02411 IF L013-NO-ENTRY DTSCS69
|
|
02412 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS69
|
|
02413 PERFORM S1801-ERROR THRU S1801-EXIT DTSCS69
|
|
02414 ELSE DTSCS69
|
|
02415 IF L013-INVALID-NEGATIVE DTSCS69
|
|
02416 MOVE EMSG-INVALID-NEGATIVE TO WRK-MSG-AREA DTSCS69
|
|
02417 PERFORM S1801-ERROR THRU S1801-EXIT DTSCS69
|
|
02418 ELSE DTSCS69
|
|
02419 IF L013-EXCEEDS-MIN-MAX DTSCS69
|
|
02420 MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA DTSCS69
|
|
02421 PERFORM S1801-ERROR THRU S1801-EXIT DTSCS69
|
|
02422 ELSE DTSCS69
|
|
02423 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS69
|
|
02424 PERFORM S1801-ERROR THRU S1801-EXIT. DTSCS69
|
|
02425 S1800-EXIT. EXIT. DTSCS69
|
|
02426 DTSCS69
|
|
02427 S1801-ERROR. DTSCS69
|
|
02428 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-ADDR-ID-NO-A DTSCS69
|
|
02429 IF LCCM-NO-MSG DTSCS69
|
|
02430 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS69
|
|
02431 MOVE CATB-CURSOR TO MAP-ADDR-ID-NO-L DTSCS69
|
|
02432 SET CURSOR-SET-YES TO TRUE. DTSCS69
|
|
02433 S1801-EXIT. EXIT. DTSCS69
|
|
02434 S1830-ADDR-TAD. DTSCS69
|
|
02435 MOVE WRK-EMP-NO TO L111-EMP-NO. DTSCS69
|
|
02436 IF MAP-ADDR-TAX-88 DTSCS69
|
|
02437 SET L111-LOOKUP-TAD-88 TO TRUE DTSCS69
|
|
02438 SET L111-ID-NO-TAD-MAIL-88 TO TRUE DTSCS69
|
|
02439 ELSE DTSCS69
|
|
02440 IF MAP-ADDR-PHY-88 DTSCS69
|
|
02441 SET L111-LOOKUP-TAD-88 TO TRUE DTSCS69
|
|
02442 SET L111-ID-NO-TAD-PHYS-88 TO TRUE DTSCS69
|
|
02443 ELSE DTSCS69
|
|
02444 GO TO S899-ABEND. DTSCS69
|
|
02445 DTSCS69
|
|
02446 PERFORM S111-ADDR-LOOKUP THRU S111-EXIT. DTSCS69
|
|
02447 DTSCS69
|
|
02448 IF L111-ADDR-NOT-FOUND-88 DTSCS69
|
|
02449 MOVE EMSG-NO-ADDRESS TO WRK-MSG-AREA DTSCS69
|
|
02450 PERFORM S1801-ERROR THRU S1801-EXIT DTSCS69
|
|
02451 GO TO S1830-EXIT. DTSCS69
|
|
02452 DTSCS69
|
|
02453 PERFORM S1860-FORMAT-ADDR THRU S1860-EXIT. DTSCS69
|
|
02454 S1830-EXIT. DTSCS69
|
|
02455 EXIT. DTSCS69
|
|
02456 S1840-REQUIRE-ADDRESS. DTSCS69
|
|
02457 INSPECT MAP-AUDIT-ATTN-LINE DTSCS69
|
|
02458 CONVERTING LOW-VALUES TO SPACES. DTSCS69
|
|
02459 INSPECT MAP-AUDIT-DLV1-LINE DTSCS69
|
|
02460 CONVERTING LOW-VALUES TO SPACES. DTSCS69
|
|
02461 INSPECT MAP-AUDIT-DLV2-LINE DTSCS69
|
|
02462 CONVERTING LOW-VALUES TO SPACES. DTSCS69
|
|
02463 INSPECT MAP-AUDIT-CITY DTSCS69
|
|
02464 CONVERTING LOW-VALUES TO SPACES. DTSCS69
|
|
02465 INSPECT MAP-AUDIT-STAT DTSCS69
|
|
02466 CONVERTING LOW-VALUES TO SPACES. DTSCS69
|
|
02467 INSPECT MAP-AUDIT-ZIP DTSCS69
|
|
02468 CONVERTING LOW-VALUES TO SPACES. DTSCS69
|
|
02469 DTSCS69
|
|
02470 IF (MAP-AUDIT-DLV2-LINE = SPACES) AND DTSCS69
|
|
02471 (MAP-AUDIT-CITY = SPACES) AND DTSCS69
|
|
02472 (MAP-AUDIT-STAT = SPACES) AND DTSCS69
|
|
02473 (MAP-AUDIT-ZIP = SPACES) DTSCS69
|
|
02474 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS69
|
|
02475 PERFORM S1841-ERROR THRU S1841-EXIT. DTSCS69
|
|
02476 S1840-EXIT. DTSCS69
|
|
02477 EXIT. DTSCS69
|
|
02478 DTSCS69
|
|
02479 DTSCS69
|
|
02480 S1841-ERROR. DTSCS69
|
|
02481 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS69
|
|
02482 TO MAP-AUDIT-ATTN-LINE-A DTSCS69
|
|
02483 MAP-AUDIT-DLV1-LINE-A DTSCS69
|
|
02484 MAP-AUDIT-DLV2-LINE-A DTSCS69
|
|
02485 MAP-AUDIT-CITY-A DTSCS69
|
|
02486 MAP-AUDIT-STAT-A. DTSCS69
|
|
02487 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-AUDIT-ZIP-A. DTSCS69
|
|
02488 IF LCCM-NO-MSG DTSCS69
|
|
02489 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS69
|
|
02490 MOVE CATB-CURSOR TO MAP-AUDIT-ATTN-LINE-L DTSCS69
|
|
02491 SET CURSOR-SET-YES TO TRUE. DTSCS69
|
|
02492 S1841-EXIT. EXIT. DTSCS69
|
|
02493 DTSCS69
|
|
02494 S1850-ADDR-TAA-OPO. DTSCS69
|
|
02495 MOVE WRK-EMP-NO TO L111-EMP-NO. DTSCS69
|
|
02496 IF MAP-ADDR-TAX-ALT-88 DTSCS69
|
|
02497 SET L111-LOOKUP-TAA-88 TO TRUE DTSCS69
|
|
02498 ELSE DTSCS69
|
|
02499 IF MAP-ADDR-OPO-88 DTSCS69
|
|
02500 SET L111-LOOKUP-OPO-88 TO TRUE DTSCS69
|
|
02501 ELSE DTSCS69
|
|
02502 GO TO S899-ABEND. DTSCS69
|
|
02503 DTSCS69
|
|
02504 IF L013-CNT = 0 DTSCS69
|
|
02505 MOVE 1 TO L111-ID-NO DTSCS69
|
|
02506 ELSE DTSCS69
|
|
02507 MOVE L013-CNT TO L111-ID-NO. DTSCS69
|
|
02508 DTSCS69
|
|
02509 PERFORM S111-ADDR-LOOKUP THRU S111-EXIT. DTSCS69
|
|
02510 DTSCS69
|
|
02511 IF L111-ADDR-NOT-FOUND-88 DTSCS69
|
|
02512 MOVE EMSG-NO-ADDRESS TO WRK-MSG-AREA DTSCS69
|
|
02513 PERFORM S1801-ERROR THRU S1801-EXIT DTSCS69
|
|
02514 GO TO S1850-EXIT. DTSCS69
|
|
02515 DTSCS69
|
|
02516 PERFORM S1860-FORMAT-ADDR THRU S1860-EXIT. DTSCS69
|
|
02517 S1850-EXIT. DTSCS69
|
|
02518 EXIT. DTSCS69
|
|
02519 S1860-FORMAT-ADDR. DTSCS69
|
|
02520 MOVE L111-ADDR-TYPE TO L112-ADDR-TYPE. DTSCS69
|
|
02521 SET L112-ANCHOR-LAST-88 TO TRUE. DTSCS69
|
|
02522 MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME. DTSCS69
|
|
02523 MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA. DTSCS69
|
|
02524 IF L112-OPO-ADDR-88 DTSCS69
|
|
02525 SET L112-TAD-ADDR-88 TO TRUE. DTSCS69
|
|
02526 DTSCS69
|
|
02527 PERFORM S112-ADDR-FORMAT THRU S112-EXIT. DTSCS69
|
|
02528 DTSCS69
|
|
02529 MOVE L112-ATTN-LINE TO MAP-AUDIT-ATTN-LINE. DTSCS69
|
|
02530 MOVE L112-DELIV-LINE-1 TO MAP-AUDIT-DLV1-LINE. DTSCS69
|
|
02531 MOVE L112-DELIV-LINE-2 TO MAP-AUDIT-DLV2-LINE. DTSCS69
|
|
02532 MOVE L112-CITY TO MAP-AUDIT-CITY. DTSCS69
|
|
02533 MOVE L112-ST TO MAP-AUDIT-STAT. DTSCS69
|
|
02534 MOVE L112-ZIP TO MAP-AUDIT-ZIP. DTSCS69
|
|
02535 S1860-EXIT. EXIT. DTSCS69
|
|
02536 /*****************************************************************DTSCS69
|
|
02537 * DTSCS69
|
|
02538 ******************************************************************DTSCS69
|
|
02539 S2000-MAIL-TYPE. DTSCS69
|
|
02540 IF MAP-MAIL-VALID-88 DTSCS69
|
|
02541 NEXT SENTENCE DTSCS69
|
|
02542 ELSE DTSCS69
|
|
02543 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS69
|
|
02544 PERFORM S2001-ERROR THRU S2001-EXIT. DTSCS69
|
|
02545 S2000-EXIT. EXIT. DTSCS69
|
|
02546 DTSCS69
|
|
02547 S2001-ERROR. DTSCS69
|
|
02548 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-MAIL-TYPE-A. DTSCS69
|
|
02549 IF LCCM-NO-MSG DTSCS69
|
|
02550 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS69
|
|
02551 MOVE CATB-CURSOR TO MAP-MAIL-TYPE-L DTSCS69
|
|
02552 SET CURSOR-SET-YES TO TRUE. DTSCS69
|
|
02553 S2001-EXIT. EXIT. DTSCS69
|
|
02554 /*****************************************************************DTSCS69
|
|
02555 * DTSCS69
|
|
02556 ******************************************************************DTSCS69
|
|
02557 S2020-MAIL-ID-NO. DTSCS69
|
|
02558 INSPECT MAP-MAIL-ID-NO DTSCS69
|
|
02559 CONVERTING LOW-VALUES TO SPACES. DTSCS69
|
|
02560 DTSCS69
|
|
02561 INSPECT MAP-MAIL-CITY DTSCS69
|
|
02562 CONVERTING LOW-VALUES TO SPACES. DTSCS69
|
|
02563 DTSCS69
|
|
02564 IF MAP-MAIL-ID-NO = SPACES DTSCS69
|
|
02565 IF MAP-MAIL-TAD-88 DTSCS69
|
|
02566 PERFORM S2030-ADDR-TAD THRU S2030-EXIT DTSCS69
|
|
02567 GO TO S2020-EXIT DTSCS69
|
|
02568 ELSE DTSCS69
|
|
02569 IF MAP-MAIL-NONE-88 AND MAP-MAIL-CITY = SPACES DTSCS69
|
|
02570 SET MAP-MAIL-TAD-88 TO TRUE DTSCS69
|
|
02571 PERFORM S2030-ADDR-TAD THRU S2030-EXIT DTSCS69
|
|
02572 GO TO S2020-EXIT DTSCS69
|
|
02573 ELSE DTSCS69
|
|
02574 IF MAP-MAIL-CITY > SPACES DTSCS69
|
|
02575 GO TO S2020-EXIT DTSCS69
|
|
02576 ELSE DTSCS69
|
|
02577 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS69
|
|
02578 PERFORM S2021-ERROR THRU S2021-EXIT DTSCS69
|
|
02579 GO TO S2020-EXIT. DTSCS69
|
|
02580 DTSCS69
|
|
02581 IF MAP-MAIL-NONE-88 OR MAP-MAIL-TAD-88 DTSCS69
|
|
02582 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS69
|
|
02583 PERFORM S2021-ERROR THRU S2021-EXIT DTSCS69
|
|
02584 GO TO S2020-EXIT. DTSCS69
|
|
02585 DTSCS69
|
|
02586 MOVE MAP-MAIL-ID-NO-AREA TO L013-S-CNT-AREA. DTSCS69
|
|
02587 MOVE +1 TO L013-MIN-CNT DTSCS69
|
|
02588 MOVE +999 TO L013-MAX-CNT. DTSCS69
|
|
02589 DTSCS69
|
|
02590 PERFORM S013-COUNT-FROM-SCREEN THRU S013-EXIT. DTSCS69
|
|
02591 DTSCS69
|
|
02592 IF L013-VALID DTSCS69
|
|
02593 MOVE L013-CNT TO MAP-MAIL-ID-NO-Z DTSCS69
|
|
02594 IF MAP-MAIL-TAA-OPO-88 DTSCS69
|
|
02595 PERFORM S2050-ADDR-TAA-OPO THRU S2050-EXIT DTSCS69
|
|
02596 ELSE DTSCS69
|
|
02597 NEXT SENTENCE DTSCS69
|
|
02598 ELSE DTSCS69
|
|
02599 IF L013-NO-ENTRY DTSCS69
|
|
02600 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS69
|
|
02601 PERFORM S2021-ERROR THRU S2021-EXIT DTSCS69
|
|
02602 ELSE DTSCS69
|
|
02603 IF L013-INVALID-NEGATIVE DTSCS69
|
|
02604 MOVE EMSG-INVALID-NEGATIVE TO WRK-MSG-AREA DTSCS69
|
|
02605 PERFORM S2021-ERROR THRU S2021-EXIT DTSCS69
|
|
02606 ELSE DTSCS69
|
|
02607 IF L013-EXCEEDS-MIN-MAX DTSCS69
|
|
02608 MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA DTSCS69
|
|
02609 PERFORM S2021-ERROR THRU S2021-EXIT DTSCS69
|
|
02610 ELSE DTSCS69
|
|
02611 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS69
|
|
02612 PERFORM S2021-ERROR THRU S2021-EXIT. DTSCS69
|
|
02613 S2020-EXIT. EXIT. DTSCS69
|
|
02614 DTSCS69
|
|
02615 S2021-ERROR. DTSCS69
|
|
02616 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-MAIL-ID-NO-A DTSCS69
|
|
02617 IF LCCM-NO-MSG DTSCS69
|
|
02618 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS69
|
|
02619 MOVE CATB-CURSOR TO MAP-MAIL-ID-NO-L DTSCS69
|
|
02620 SET CURSOR-SET-YES TO TRUE. DTSCS69
|
|
02621 S2021-EXIT. EXIT. DTSCS69
|
|
02622 S2030-ADDR-TAD. DTSCS69
|
|
02623 MOVE WRK-EMP-NO TO L111-EMP-NO. DTSCS69
|
|
02624 IF MAP-MAIL-TAX-88 DTSCS69
|
|
02625 SET L111-LOOKUP-TAD-88 TO TRUE DTSCS69
|
|
02626 SET L111-ID-NO-TAD-MAIL-88 TO TRUE DTSCS69
|
|
02627 ELSE DTSCS69
|
|
02628 IF MAP-MAIL-PHY-88 DTSCS69
|
|
02629 SET L111-LOOKUP-TAD-88 TO TRUE DTSCS69
|
|
02630 SET L111-ID-NO-TAD-PHYS-88 TO TRUE DTSCS69
|
|
02631 ELSE DTSCS69
|
|
02632 GO TO S899-ABEND. DTSCS69
|
|
02633 DTSCS69
|
|
02634 PERFORM S111-ADDR-LOOKUP THRU S111-EXIT. DTSCS69
|
|
02635 DTSCS69
|
|
02636 IF L111-ADDR-NOT-FOUND-88 DTSCS69
|
|
02637 MOVE EMSG-NO-ADDRESS TO WRK-MSG-AREA DTSCS69
|
|
02638 PERFORM S2021-ERROR THRU S2021-EXIT DTSCS69
|
|
02639 GO TO S2030-EXIT. DTSCS69
|
|
02640 DTSCS69
|
|
02641 PERFORM S2060-FORMAT-ADDR THRU S2060-EXIT. DTSCS69
|
|
02642 S2030-EXIT. DTSCS69
|
|
02643 EXIT. DTSCS69
|
|
02644 S2040-REQUIRE-MAIL-ADDR. DTSCS69
|
|
02645 INSPECT MAP-MAIL-ATTN-LINE DTSCS69
|
|
02646 CONVERTING LOW-VALUES TO SPACES. DTSCS69
|
|
02647 INSPECT MAP-MAIL-DLV1-LINE DTSCS69
|
|
02648 CONVERTING LOW-VALUES TO SPACES. DTSCS69
|
|
02649 INSPECT MAP-MAIL-DLV2-LINE DTSCS69
|
|
02650 CONVERTING LOW-VALUES TO SPACES. DTSCS69
|
|
02651 INSPECT MAP-MAIL-CITY DTSCS69
|
|
02652 CONVERTING LOW-VALUES TO SPACES. DTSCS69
|
|
02653 INSPECT MAP-MAIL-STAT DTSCS69
|
|
02654 CONVERTING LOW-VALUES TO SPACES. DTSCS69
|
|
02655 INSPECT MAP-MAIL-ZIP DTSCS69
|
|
02656 CONVERTING LOW-VALUES TO SPACES. DTSCS69
|
|
02657 DTSCS69
|
|
02658 IF (MAP-MAIL-DLV2-LINE = SPACES) AND DTSCS69
|
|
02659 (MAP-MAIL-CITY = SPACES) AND DTSCS69
|
|
02660 (MAP-MAIL-STAT = SPACES) AND DTSCS69
|
|
02661 (MAP-MAIL-ZIP = SPACES) DTSCS69
|
|
02662 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS69
|
|
02663 PERFORM S2041-ERROR THRU S2041-EXIT. DTSCS69
|
|
02664 S2040-EXIT. DTSCS69
|
|
02665 EXIT. DTSCS69
|
|
02666 DTSCS69
|
|
02667 DTSCS69
|
|
02668 S2041-ERROR. DTSCS69
|
|
02669 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS69
|
|
02670 TO MAP-MAIL-ATTN-LINE-A DTSCS69
|
|
02671 MAP-MAIL-DLV1-LINE-A DTSCS69
|
|
02672 MAP-MAIL-DLV2-LINE-A DTSCS69
|
|
02673 MAP-MAIL-CITY-A DTSCS69
|
|
02674 MAP-MAIL-STAT-A. DTSCS69
|
|
02675 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-MAIL-ZIP-A. DTSCS69
|
|
02676 IF LCCM-NO-MSG DTSCS69
|
|
02677 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS69
|
|
02678 MOVE CATB-CURSOR TO MAP-MAIL-ATTN-LINE-L DTSCS69
|
|
02679 SET CURSOR-SET-YES TO TRUE. DTSCS69
|
|
02680 S2041-EXIT. EXIT. DTSCS69
|
|
02681 DTSCS69
|
|
02682 S2050-ADDR-TAA-OPO. DTSCS69
|
|
02683 MOVE WRK-EMP-NO TO L111-EMP-NO. DTSCS69
|
|
02684 IF MAP-MAIL-TAX-ALT-88 DTSCS69
|
|
02685 SET L111-LOOKUP-TAA-88 TO TRUE DTSCS69
|
|
02686 ELSE DTSCS69
|
|
02687 IF MAP-MAIL-OPO-88 DTSCS69
|
|
02688 SET L111-LOOKUP-OPO-88 TO TRUE DTSCS69
|
|
02689 ELSE DTSCS69
|
|
02690 GO TO S899-ABEND. DTSCS69
|
|
02691 DTSCS69
|
|
02692 IF L013-CNT = 0 DTSCS69
|
|
02693 MOVE 1 TO L111-ID-NO DTSCS69
|
|
02694 ELSE DTSCS69
|
|
02695 MOVE L013-CNT TO L111-ID-NO. DTSCS69
|
|
02696 DTSCS69
|
|
02697 PERFORM S111-ADDR-LOOKUP THRU S111-EXIT. DTSCS69
|
|
02698 DTSCS69
|
|
02699 IF L111-ADDR-NOT-FOUND-88 DTSCS69
|
|
02700 MOVE EMSG-NO-ADDRESS TO WRK-MSG-AREA DTSCS69
|
|
02701 PERFORM S2021-ERROR THRU S2021-EXIT DTSCS69
|
|
02702 GO TO S2050-EXIT. DTSCS69
|
|
02703 DTSCS69
|
|
02704 PERFORM S2060-FORMAT-ADDR THRU S2060-EXIT. DTSCS69
|
|
02705 S2050-EXIT. DTSCS69
|
|
02706 EXIT. DTSCS69
|
|
02707 S2060-FORMAT-ADDR. DTSCS69
|
|
02708 MOVE L111-ADDR-TYPE TO L112-ADDR-TYPE. DTSCS69
|
|
02709 SET L112-ANCHOR-LAST-88 TO TRUE. DTSCS69
|
|
02710 MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME. DTSCS69
|
|
02711 MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA. DTSCS69
|
|
02712 IF L112-OPO-ADDR-88 DTSCS69
|
|
02713 SET L112-TAD-ADDR-88 TO TRUE. DTSCS69
|
|
02714 DTSCS69
|
|
02715 PERFORM S112-ADDR-FORMAT THRU S112-EXIT. DTSCS69
|
|
02716 DTSCS69
|
|
02717 MOVE L112-ATTN-LINE TO MAP-MAIL-ATTN-LINE. DTSCS69
|
|
02718 MOVE L112-DELIV-LINE-1 TO MAP-MAIL-DLV1-LINE. DTSCS69
|
|
02719 MOVE L112-DELIV-LINE-2 TO MAP-MAIL-DLV2-LINE. DTSCS69
|
|
02720 MOVE L112-CITY TO MAP-MAIL-CITY DTSCS69
|
|
02721 MOVE L112-ST TO MAP-MAIL-STAT DTSCS69
|
|
02722 MOVE L112-ZIP TO MAP-MAIL-ZIP. DTSCS69
|
|
02723 S2060-EXIT. EXIT. DTSCS69
|
|
02724 * DTSCS69
|
|
02725 S2100-SEQ-NO. DTSCS69
|
|
02726 MOVE MAP-SEQ-NO-AREA TO L013-S-CNT-AREA. DTSCS69
|
|
02727 MOVE +1 TO L013-MIN-CNT. DTSCS69
|
|
02728 MOVE +999 TO L013-MAX-CNT. DTSCS69
|
|
02729 PERFORM S013-COUNT-FROM-SCREEN THRU S013-EXIT. DTSCS69
|
|
02730 SKIP1 DTSCS69
|
|
02731 IF L013-NO-ENTRY DTSCS69
|
|
02732 MOVE +0 TO WRK-ID-NO DTSCS69
|
|
02733 ELSE DTSCS69
|
|
02734 IF L013-VALID DTSCS69
|
|
02735 MOVE L013-CNT TO WRK-ID-NO DTSCS69
|
|
02736 MAP-SEQ-NO-N DTSCS69
|
|
02737 ELSE DTSCS69
|
|
02738 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS69
|
|
02739 PERFORM S2101-ERROR THRU S2101-EXIT. DTSCS69
|
|
02740 S2100-EXIT. EXIT. DTSCS69
|
|
02741 SKIP3 DTSCS69
|
|
02742 S2101-ERROR. DTSCS69
|
|
02743 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-SEQ-NO-A. DTSCS69
|
|
02744 IF LCCM-NO-MSG DTSCS69
|
|
02745 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS69
|
|
02746 MOVE CATB-CURSOR TO MAP-SEQ-NO-L DTSCS69
|
|
02747 SET CURSOR-SET-YES TO TRUE. DTSCS69
|
|
02748 S2101-EXIT. EXIT. DTSCS69
|
|
02749 DTSCS69
|
|
02750 S2200-AUDIT-ADDRESS. DTSCS69
|
|
02751 INSPECT MAP-AUDIT-ATTN-LINE DTSCS69
|
|
02752 CONVERTING LOW-VALUES TO SPACES. DTSCS69
|
|
02753 INSPECT MAP-AUDIT-DLV1-LINE DTSCS69
|
|
02754 CONVERTING LOW-VALUES TO SPACES. DTSCS69
|
|
02755 INSPECT MAP-AUDIT-DLV2-LINE DTSCS69
|
|
02756 CONVERTING LOW-VALUES TO SPACES. DTSCS69
|
|
02757 INSPECT MAP-AUDIT-CITY DTSCS69
|
|
02758 CONVERTING LOW-VALUES TO SPACES. DTSCS69
|
|
02759 INSPECT MAP-AUDIT-STAT DTSCS69
|
|
02760 CONVERTING LOW-VALUES TO SPACES. DTSCS69
|
|
02761 INSPECT MAP-AUDIT-ZIP DTSCS69
|
|
02762 CONVERTING LOW-VALUES TO SPACES. DTSCS69
|
|
02763 DTSCS69
|
|
02764 IF (MAP-AUDIT-DLV2-LINE = SPACES) AND DTSCS69
|
|
02765 (MAP-AUDIT-CITY = SPACES) AND DTSCS69
|
|
02766 (MAP-AUDIT-STAT = SPACES) AND DTSCS69
|
|
02767 (MAP-AUDIT-ZIP = SPACES) DTSCS69
|
|
02768 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS69
|
|
02769 PERFORM S2201-ERROR THRU S2201-EXIT DTSCS69
|
|
02770 GO TO S2200-EXIT. DTSCS69
|
|
02771 PERFORM S2300-EDIT-AUDIT-ADDRESS THRU S2300-EXIT. DTSCS69
|
|
02772 S2200-EXIT. DTSCS69
|
|
02773 EXIT. DTSCS69
|
|
02774 DTSCS69
|
|
02775 DTSCS69
|
|
02776 S2201-ERROR. DTSCS69
|
|
02777 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS69
|
|
02778 TO MAP-AUDIT-ATTN-LINE-A DTSCS69
|
|
02779 MAP-AUDIT-DLV1-LINE-A DTSCS69
|
|
02780 MAP-AUDIT-DLV2-LINE-A DTSCS69
|
|
02781 MAP-AUDIT-CITY-A DTSCS69
|
|
02782 MAP-AUDIT-STAT-A. DTSCS69
|
|
02783 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-AUDIT-ZIP-A. DTSCS69
|
|
02784 IF LCCM-NO-MSG DTSCS69
|
|
02785 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS69
|
|
02786 MOVE CATB-CURSOR TO MAP-AUDIT-ATTN-LINE-L DTSCS69
|
|
02787 SET CURSOR-SET-YES TO TRUE. DTSCS69
|
|
02788 S2201-EXIT. EXIT. DTSCS69
|
|
02789 S2250-AUDIT-CASS. DTSCS69
|
|
02790 IF MAP-AUDIT-CASS = 'Y' OR 'N' DTSCS69
|
|
02791 NEXT SENTENCE DTSCS69
|
|
02792 ELSE DTSCS69
|
|
02793 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS69
|
|
02794 PERFORM S2251-ERROR THRU S2251-EXIT. DTSCS69
|
|
02795 S2250-EXIT. EXIT. DTSCS69
|
|
02796 DTSCS69
|
|
02797 S2251-ERROR. DTSCS69
|
|
02798 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-AUDIT-CASS-A. DTSCS69
|
|
02799 IF LCCM-NO-MSG DTSCS69
|
|
02800 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS69
|
|
02801 MOVE CATB-CURSOR TO MAP-AUDIT-CASS-L DTSCS69
|
|
02802 SET CURSOR-SET-YES TO TRUE. DTSCS69
|
|
02803 S2251-EXIT. EXIT. DTSCS69
|
|
02804 S2300-EDIT-AUDIT-ADDRESS. DTSCS69
|
|
02805 MOVE MAP-AUDIT-CASS TO L072-CASS-IND. DTSCS69
|
|
02806 DTSCS69
|
|
02807 IF L072-CASS-IND = 'N' DTSCS69
|
|
02808 GO TO S2300-EXIT. DTSCS69
|
|
02809 DTSCS69
|
|
02810 SET L072-MTAD-88 TO TRUE. DTSCS69
|
|
02811 MOVE MAP-PRIMARY-NAME TO L072-NAME. DTSCS69
|
|
02812 MOVE MAP-AUDIT-ATTN-LINE TO L072-ATTN-LINE. DTSCS69
|
|
02813 MOVE MAP-AUDIT-DLV1-LINE TO L072-DELIV-LINE-1. DTSCS69
|
|
02814 MOVE MAP-AUDIT-DLV2-LINE TO L072-DELIV-LINE-2. DTSCS69
|
|
02815 MOVE MAP-AUDIT-CITY TO L072-CITY. DTSCS69
|
|
02816 MOVE MAP-AUDIT-STAT TO L072-ST. DTSCS69
|
|
02817 MOVE MAP-AUDIT-ZIP TO L072-ZIP. DTSCS69
|
|
02818 SKIP1 DTSCS69
|
|
02819 PERFORM S072-EDIT-ADDRESS THRU S072-EXIT. DTSCS69
|
|
02820 DTSCS69
|
|
02821 IF L072-ATTN-LINE-NOT-VALID-88 DTSCS69
|
|
02822 PERFORM S2301-ERROR THRU S2301-EXIT DTSCS69
|
|
02823 ELSE DTSCS69
|
|
02824 MOVE L072-ATTN-LINE TO MAP-AUDIT-ATTN-LINE DTSCS69
|
|
02825 IF L072-ATTN-LINE-CHANGED-88 DTSCS69
|
|
02826 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS69
|
|
02827 TO MAP-AUDIT-ATTN-LINE-A. DTSCS69
|
|
02828 IF L072-DELIV-LINE-1-NOT-VALID-88 DTSCS69
|
|
02829 PERFORM S2302-ERROR THRU S2302-EXIT DTSCS69
|
|
02830 ELSE DTSCS69
|
|
02831 MOVE L072-DELIV-LINE-1 TO MAP-AUDIT-DLV1-LINE DTSCS69
|
|
02832 IF L072-DELIV-LINE-1-CHANGED-88 DTSCS69
|
|
02833 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS69
|
|
02834 TO MAP-AUDIT-DLV1-LINE-A. DTSCS69
|
|
02835 IF L072-DELIV-LINE-2-NOT-VALID-88 DTSCS69
|
|
02836 PERFORM S2303-ERROR THRU S2303-EXIT DTSCS69
|
|
02837 ELSE DTSCS69
|
|
02838 MOVE L072-DELIV-LINE-2 TO MAP-AUDIT-DLV2-LINE DTSCS69
|
|
02839 IF L072-DELIV-LINE-2-CHANGED-88 DTSCS69
|
|
02840 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS69
|
|
02841 TO MAP-AUDIT-DLV2-LINE-A. DTSCS69
|
|
02842 IF L072-CITY-NOT-VALID-88 DTSCS69
|
|
02843 PERFORM S2304-ERROR THRU S2304-EXIT DTSCS69
|
|
02844 ELSE DTSCS69
|
|
02845 MOVE L072-CITY TO MAP-AUDIT-CITY DTSCS69
|
|
02846 IF L072-CITY-CHANGED-88 DTSCS69
|
|
02847 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS69
|
|
02848 TO MAP-AUDIT-CITY-A. DTSCS69
|
|
02849 IF L072-ST-NOT-VALID-88 DTSCS69
|
|
02850 PERFORM S2305-ERROR THRU S2305-EXIT DTSCS69
|
|
02851 ELSE DTSCS69
|
|
02852 MOVE L072-ST TO MAP-AUDIT-STAT DTSCS69
|
|
02853 IF L072-ST-CHANGED-88 DTSCS69
|
|
02854 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS69
|
|
02855 TO MAP-AUDIT-STAT-A. DTSCS69
|
|
02856 IF L072-ZIP-NOT-VALID-88 DTSCS69
|
|
02857 PERFORM S2306-ERROR THRU S2306-EXIT DTSCS69
|
|
02858 ELSE DTSCS69
|
|
02859 MOVE L072-ZIP TO MAP-AUDIT-ZIP DTSCS69
|
|
02860 IF L072-ZIP-CHANGED-88 DTSCS69
|
|
02861 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS69
|
|
02862 TO MAP-AUDIT-ZIP-A. DTSCS69
|
|
02863 IF L072-ADDRESS-NOT-VALID-88 DTSCS69
|
|
02864 IF LCCM-NO-MSG DTSCS69
|
|
02865 PERFORM S2301-ERROR THRU S2301-EXIT. DTSCS69
|
|
02866 SKIP1 DTSCS69
|
|
02867 S2300-EXIT. EXIT. DTSCS69
|
|
02868 SKIP3 DTSCS69
|
|
02869 S2301-ERROR. DTSCS69
|
|
02870 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-AUDIT-ATTN-LINE-A. DTSCS69
|
|
02871 IF LCCM-NO-MSG DTSCS69
|
|
02872 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS69
|
|
02873 MOVE CATB-CURSOR TO MAP-AUDIT-ATTN-LINE-L DTSCS69
|
|
02874 SET CURSOR-SET-YES TO TRUE. DTSCS69
|
|
02875 S2301-EXIT. EXIT. DTSCS69
|
|
02876 S2302-ERROR. DTSCS69
|
|
02877 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-AUDIT-DLV1-LINE-A. DTSCS69
|
|
02878 IF LCCM-NO-MSG DTSCS69
|
|
02879 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS69
|
|
02880 MOVE CATB-CURSOR TO MAP-AUDIT-DLV1-LINE-L DTSCS69
|
|
02881 SET CURSOR-SET-YES TO TRUE. DTSCS69
|
|
02882 S2302-EXIT. EXIT. DTSCS69
|
|
02883 SKIP3 DTSCS69
|
|
02884 S2303-ERROR. DTSCS69
|
|
02885 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-AUDIT-DLV2-LINE-A. DTSCS69
|
|
02886 IF LCCM-NO-MSG DTSCS69
|
|
02887 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS69
|
|
02888 MOVE CATB-CURSOR TO MAP-AUDIT-DLV2-LINE-L DTSCS69
|
|
02889 SET CURSOR-SET-YES TO TRUE. DTSCS69
|
|
02890 S2303-EXIT. EXIT. DTSCS69
|
|
02891 S2304-ERROR. DTSCS69
|
|
02892 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-AUDIT-CITY-A. DTSCS69
|
|
02893 IF LCCM-NO-MSG DTSCS69
|
|
02894 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS69
|
|
02895 MOVE CATB-CURSOR TO MAP-AUDIT-CITY-L DTSCS69
|
|
02896 SET CURSOR-SET-YES TO TRUE. DTSCS69
|
|
02897 S2304-EXIT. EXIT. DTSCS69
|
|
02898 SKIP3 DTSCS69
|
|
02899 S2305-ERROR. DTSCS69
|
|
02900 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-AUDIT-STAT-A. DTSCS69
|
|
02901 IF LCCM-NO-MSG DTSCS69
|
|
02902 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS69
|
|
02903 MOVE CATB-CURSOR TO MAP-AUDIT-STAT-L DTSCS69
|
|
02904 SET CURSOR-SET-YES TO TRUE. DTSCS69
|
|
02905 S2305-EXIT. EXIT. DTSCS69
|
|
02906 S2306-ERROR. DTSCS69
|
|
02907 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-AUDIT-ZIP-A. DTSCS69
|
|
02908 IF LCCM-NO-MSG DTSCS69
|
|
02909 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS69
|
|
02910 MOVE CATB-CURSOR TO MAP-AUDIT-ZIP-L DTSCS69
|
|
02911 SET CURSOR-SET-YES TO TRUE. DTSCS69
|
|
02912 S2306-EXIT. EXIT. DTSCS69
|
|
02913 SKIP3 DTSCS69
|
|
02914 S2400-MAIL-ADDRESS. DTSCS69
|
|
02915 INSPECT MAP-MAIL-ATTN-LINE DTSCS69
|
|
02916 CONVERTING LOW-VALUES TO SPACES. DTSCS69
|
|
02917 INSPECT MAP-MAIL-DLV1-LINE DTSCS69
|
|
02918 CONVERTING LOW-VALUES TO SPACES. DTSCS69
|
|
02919 INSPECT MAP-MAIL-DLV2-LINE DTSCS69
|
|
02920 CONVERTING LOW-VALUES TO SPACES. DTSCS69
|
|
02921 INSPECT MAP-MAIL-CITY DTSCS69
|
|
02922 CONVERTING LOW-VALUES TO SPACES. DTSCS69
|
|
02923 INSPECT MAP-MAIL-STAT DTSCS69
|
|
02924 CONVERTING LOW-VALUES TO SPACES. DTSCS69
|
|
02925 INSPECT MAP-MAIL-ZIP DTSCS69
|
|
02926 CONVERTING LOW-VALUES TO SPACES. DTSCS69
|
|
02927 DTSCS69
|
|
02928 IF (MAP-MAIL-DLV2-LINE = SPACES) AND DTSCS69
|
|
02929 (MAP-MAIL-CITY = SPACES) AND DTSCS69
|
|
02930 (MAP-MAIL-STAT = SPACES) AND DTSCS69
|
|
02931 (MAP-MAIL-ZIP = SPACES) DTSCS69
|
|
02932 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS69
|
|
02933 PERFORM S2401-ERROR THRU S2401-EXIT DTSCS69
|
|
02934 GO TO S2400-EXIT. DTSCS69
|
|
02935 PERFORM S2500-EDIT-MAIL-ADDRESS THRU S2500-EXIT. DTSCS69
|
|
02936 S2400-EXIT. DTSCS69
|
|
02937 EXIT. DTSCS69
|
|
02938 DTSCS69
|
|
02939 DTSCS69
|
|
02940 S2401-ERROR. DTSCS69
|
|
02941 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS69
|
|
02942 TO MAP-MAIL-ATTN-LINE-A DTSCS69
|
|
02943 MAP-MAIL-DLV1-LINE-A DTSCS69
|
|
02944 MAP-MAIL-DLV2-LINE-A DTSCS69
|
|
02945 MAP-MAIL-CITY-A DTSCS69
|
|
02946 MAP-MAIL-STAT-A. DTSCS69
|
|
02947 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-MAIL-ZIP-A. DTSCS69
|
|
02948 IF LCCM-NO-MSG DTSCS69
|
|
02949 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS69
|
|
02950 MOVE CATB-CURSOR TO MAP-MAIL-ATTN-LINE-L DTSCS69
|
|
02951 SET CURSOR-SET-YES TO TRUE. DTSCS69
|
|
02952 S2401-EXIT. EXIT. DTSCS69
|
|
02953 S2450-MAIL-CASS. DTSCS69
|
|
02954 IF MAP-MAIL-CASS = 'Y' OR 'N' DTSCS69
|
|
02955 NEXT SENTENCE DTSCS69
|
|
02956 ELSE DTSCS69
|
|
02957 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS69
|
|
02958 PERFORM S2451-ERROR THRU S2451-EXIT. DTSCS69
|
|
02959 S2450-EXIT. EXIT. DTSCS69
|
|
02960 DTSCS69
|
|
02961 S2451-ERROR. DTSCS69
|
|
02962 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-MAIL-CASS-A. DTSCS69
|
|
02963 IF LCCM-NO-MSG DTSCS69
|
|
02964 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS69
|
|
02965 MOVE CATB-CURSOR TO MAP-MAIL-CASS-L DTSCS69
|
|
02966 SET CURSOR-SET-YES TO TRUE. DTSCS69
|
|
02967 S2451-EXIT. EXIT. DTSCS69
|
|
02968 S2500-EDIT-MAIL-ADDRESS. DTSCS69
|
|
02969 DTSCS69
|
|
02970 MOVE MAP-MAIL-CASS TO L072-CASS-IND. DTSCS69
|
|
02971 IF L072-CASS-IND = 'N' DTSCS69
|
|
02972 GO TO S2500-EXIT. DTSCS69
|
|
02973 DTSCS69
|
|
02974 SET L072-MTAD-88 TO TRUE. DTSCS69
|
|
02975 MOVE MAP-PRIMARY-NAME TO L072-NAME. DTSCS69
|
|
02976 MOVE MAP-MAIL-ATTN-LINE TO L072-ATTN-LINE. DTSCS69
|
|
02977 MOVE MAP-MAIL-DLV1-LINE TO L072-DELIV-LINE-1. DTSCS69
|
|
02978 MOVE MAP-MAIL-DLV2-LINE TO L072-DELIV-LINE-2. DTSCS69
|
|
02979 MOVE MAP-MAIL-CITY TO L072-CITY. DTSCS69
|
|
02980 MOVE MAP-MAIL-STAT TO L072-ST. DTSCS69
|
|
02981 MOVE MAP-MAIL-ZIP TO L072-ZIP. DTSCS69
|
|
02982 SKIP1 DTSCS69
|
|
02983 PERFORM S072-EDIT-ADDRESS THRU S072-EXIT. DTSCS69
|
|
02984 DTSCS69
|
|
02985 IF L072-ATTN-LINE-NOT-VALID-88 DTSCS69
|
|
02986 PERFORM S2501-ERROR THRU S2501-EXIT DTSCS69
|
|
02987 ELSE DTSCS69
|
|
02988 MOVE L072-ATTN-LINE TO MAP-MAIL-ATTN-LINE DTSCS69
|
|
02989 IF L072-ATTN-LINE-CHANGED-88 DTSCS69
|
|
02990 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS69
|
|
02991 TO MAP-MAIL-ATTN-LINE-A. DTSCS69
|
|
02992 IF L072-DELIV-LINE-1-NOT-VALID-88 DTSCS69
|
|
02993 PERFORM S2502-ERROR THRU S2502-EXIT DTSCS69
|
|
02994 ELSE DTSCS69
|
|
02995 MOVE L072-DELIV-LINE-1 TO MAP-MAIL-DLV1-LINE DTSCS69
|
|
02996 IF L072-DELIV-LINE-1-CHANGED-88 DTSCS69
|
|
02997 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS69
|
|
02998 TO MAP-MAIL-DLV1-LINE-A. DTSCS69
|
|
02999 IF L072-DELIV-LINE-2-NOT-VALID-88 DTSCS69
|
|
03000 PERFORM S2503-ERROR THRU S2503-EXIT DTSCS69
|
|
03001 ELSE DTSCS69
|
|
03002 MOVE L072-DELIV-LINE-2 TO MAP-MAIL-DLV2-LINE DTSCS69
|
|
03003 IF L072-DELIV-LINE-2-CHANGED-88 DTSCS69
|
|
03004 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS69
|
|
03005 TO MAP-MAIL-DLV2-LINE-A. DTSCS69
|
|
03006 IF L072-CITY-NOT-VALID-88 DTSCS69
|
|
03007 PERFORM S2504-ERROR THRU S2504-EXIT DTSCS69
|
|
03008 ELSE DTSCS69
|
|
03009 MOVE L072-CITY TO MAP-MAIL-CITY DTSCS69
|
|
03010 IF L072-CITY-CHANGED-88 DTSCS69
|
|
03011 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS69
|
|
03012 TO MAP-MAIL-CITY-A. DTSCS69
|
|
03013 IF L072-ST-NOT-VALID-88 DTSCS69
|
|
03014 PERFORM S2505-ERROR THRU S2505-EXIT DTSCS69
|
|
03015 ELSE DTSCS69
|
|
03016 MOVE L072-ST TO MAP-MAIL-STAT DTSCS69
|
|
03017 IF L072-ST-CHANGED-88 DTSCS69
|
|
03018 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS69
|
|
03019 TO MAP-MAIL-STAT-A. DTSCS69
|
|
03020 IF L072-ZIP-NOT-VALID-88 DTSCS69
|
|
03021 PERFORM S2506-ERROR THRU S2506-EXIT DTSCS69
|
|
03022 ELSE DTSCS69
|
|
03023 MOVE L072-ZIP TO MAP-MAIL-ZIP DTSCS69
|
|
03024 IF L072-ZIP-CHANGED-88 DTSCS69
|
|
03025 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS69
|
|
03026 TO MAP-AUDIT-ZIP-A. DTSCS69
|
|
03027 IF L072-ADDRESS-NOT-VALID-88 DTSCS69
|
|
03028 IF LCCM-NO-MSG DTSCS69
|
|
03029 PERFORM S2501-ERROR THRU S2501-EXIT. DTSCS69
|
|
03030 SKIP1 DTSCS69
|
|
03031 S2500-EXIT. EXIT. DTSCS69
|
|
03032 SKIP3 DTSCS69
|
|
03033 S2501-ERROR. DTSCS69
|
|
03034 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-MAIL-ATTN-LINE-A. DTSCS69
|
|
03035 IF LCCM-NO-MSG DTSCS69
|
|
03036 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS69
|
|
03037 MOVE CATB-CURSOR TO MAP-MAIL-ATTN-LINE-L DTSCS69
|
|
03038 SET CURSOR-SET-YES TO TRUE. DTSCS69
|
|
03039 S2501-EXIT. EXIT. DTSCS69
|
|
03040 S2502-ERROR. DTSCS69
|
|
03041 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-MAIL-DLV1-LINE-A. DTSCS69
|
|
03042 IF LCCM-NO-MSG DTSCS69
|
|
03043 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS69
|
|
03044 MOVE CATB-CURSOR TO MAP-MAIL-DLV1-LINE-L DTSCS69
|
|
03045 SET CURSOR-SET-YES TO TRUE. DTSCS69
|
|
03046 S2502-EXIT. EXIT. DTSCS69
|
|
03047 SKIP3 DTSCS69
|
|
03048 S2503-ERROR. DTSCS69
|
|
03049 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-MAIL-DLV2-LINE-A. DTSCS69
|
|
03050 IF LCCM-NO-MSG DTSCS69
|
|
03051 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS69
|
|
03052 MOVE CATB-CURSOR TO MAP-MAIL-DLV2-LINE-L DTSCS69
|
|
03053 SET CURSOR-SET-YES TO TRUE. DTSCS69
|
|
03054 S2503-EXIT. EXIT. DTSCS69
|
|
03055 S2504-ERROR. DTSCS69
|
|
03056 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-MAIL-CITY-A. DTSCS69
|
|
03057 IF LCCM-NO-MSG DTSCS69
|
|
03058 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS69
|
|
03059 MOVE CATB-CURSOR TO MAP-MAIL-CITY-L DTSCS69
|
|
03060 SET CURSOR-SET-YES TO TRUE. DTSCS69
|
|
03061 S2504-EXIT. EXIT. DTSCS69
|
|
03062 SKIP3 DTSCS69
|
|
03063 S2505-ERROR. DTSCS69
|
|
03064 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-MAIL-STAT-A. DTSCS69
|
|
03065 IF LCCM-NO-MSG DTSCS69
|
|
03066 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS69
|
|
03067 MOVE CATB-CURSOR TO MAP-MAIL-STAT-L DTSCS69
|
|
03068 SET CURSOR-SET-YES TO TRUE. DTSCS69
|
|
03069 S2505-EXIT. EXIT. DTSCS69
|
|
03070 S2506-ERROR. DTSCS69
|
|
03071 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-MAIL-ZIP-A. DTSCS69
|
|
03072 IF LCCM-NO-MSG DTSCS69
|
|
03073 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS69
|
|
03074 MOVE CATB-CURSOR TO MAP-MAIL-ZIP-L DTSCS69
|
|
03075 SET CURSOR-SET-YES TO TRUE. DTSCS69
|
|
03076 S2506-EXIT. EXIT. DTSCS69
|
|
03077 P9600-WRITE-R615. DTSCS69
|
|
03078 MOVE LENGTH OF R615-REC TO R615-LENGTH. DTSCS69
|
|
03079 MOVE MFAS-START-YRQ TO R615-AUDIT-START-YRQ. DTSCS69
|
|
03080 MOVE MFAS-END-YRQ TO R615-AUDIT-END-YRQ. DTSCS69
|
|
03081 DTSCS69
|
|
03082 MOVE LCCM-TASK-START-DATE TO R615-STMT-DATE. DTSCS69
|
|
03083 MOVE MAP-AUDIT-DATE-AREA TO L015-S-DATE-AREA. DTSCS69
|
|
03084 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS69
|
|
03085 MOVE L015-DATE TO R615-AUDIT-SCHED-DATE. DTSCS69
|
|
03086 MOVE WRK-EMP-NO TO R615-EMP-NO. DTSCS69
|
|
03087 MOVE MFSL-ASSIGN-NO TO R615-ASSIGN-NO. DTSCS69
|
|
03088 MOVE MFAS-FLD-REP-ID TO R615-FIELD-REP-ID. DTSCS69
|
|
03089 MOVE L025-TIME TO R615-AUDIT-SCHED-TIME. DTSCS69
|
|
03090 SET L112-TAD-ADDR-88 TO TRUE DTSCS69
|
|
03091 SET L112-ANCHOR-LAST-88 TO TRUE DTSCS69
|
|
03092 MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME DTSCS69
|
|
03093 MOVE MAP-MAIL-ATTN-LINE TO L112-ATTN-LINE DTSCS69
|
|
03094 MOVE MAP-MAIL-DLV1-LINE TO L112-DELIV-LINE-1 DTSCS69
|
|
03095 MOVE MAP-MAIL-DLV2-LINE TO L112-DELIV-LINE-2 DTSCS69
|
|
03096 MOVE MAP-MAIL-CITY TO L112-CITY DTSCS69
|
|
03097 MOVE MAP-MAIL-STAT TO L112-ST DTSCS69
|
|
03098 MOVE MAP-MAIL-ZIP TO L112-ZIP DTSCS69
|
|
03099 PERFORM S112-ADDR-FORMAT THRU S112-EXIT. DTSCS69
|
|
03100 DTSCS69
|
|
03101 MOVE L112-MAILING-ADDRESS TO R615-FMT-ADDR. DTSCS69
|
|
03102 DTSCS69
|
|
03103 MOVE L112-ZIP TO R615-ZIP. DTSCS69
|
|
03104 DTSCS69
|
|
03105 MOVE L112-ADVANCED-BARCODE TO R615-ADVANCED-BARCODE. DTSCS69
|
|
03106 DTSCS69
|
|
03107 MOVE R615-REC TO RSKL-REC. DTSCS69
|
|
03108 DTSCS69
|
|
03109 PERFORM S825-WRITE THRU S825-EXIT. DTSCS69
|
|
03110 P9600-EXIT. EXIT. DTSCS69
|
|
03111 DTSCS69
|
|
03112 /*****************************************************************DTSCS69
|
|
03113 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCS69
|
|
03114 ******************************************************************DTSCS69
|
|
03115 S5100-SET-LOCK-ATTRB. DTSCS69
|
|
03116 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS69
|
|
03117 WRK-ATB-NUM. DTSCS69
|
|
03118 DTSCS69
|
|
03119 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS69
|
|
03120 DTSCS69
|
|
03121 MOVE CATB-ASKIP-BRT-MDTON TO MAP-ASSIGN-NO-1-A DTSCS69
|
|
03122 MAP-ASSIGN-NO-2-A DTSCS69
|
|
03123 MAP-EMP-NO-1-A DTSCS69
|
|
03124 MAP-EMP-NO-2-A DTSCS69
|
|
03125 MAP-SEQ-NO-A DTSCS69
|
|
03126 MAP-GOTO-A. DTSCS69
|
|
03127 S5100-EXIT. DTSCS69
|
|
03128 EXIT. DTSCS69
|
|
03129 DTSCS69
|
|
03130 ******************************************************************DTSCS69
|
|
03131 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS69
|
|
03132 ******************************************************************DTSCS69
|
|
03133 S5200-SET-UPDATE-ATTRB. DTSCS69
|
|
03134 MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN. DTSCS69
|
|
03135 MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM. DTSCS69
|
|
03136 DTSCS69
|
|
03137 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS69
|
|
03138 DTSCS69
|
|
03139 S5200-EXIT. DTSCS69
|
|
03140 EXIT. DTSCS69
|
|
03141 DTSCS69
|
|
03142 ******************************************************************DTSCS69
|
|
03143 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS69
|
|
03144 ******************************************************************DTSCS69
|
|
03145 S5300-SET-INQ-ATTRB. DTSCS69
|
|
03146 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS69
|
|
03147 WRK-ATB-NUM. DTSCS69
|
|
03148 DTSCS69
|
|
03149 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS69
|
|
03150 MOVE CATB-ASKIP-BRT-MDTON TO MAP-AUDIT-MO-A DTSCS69
|
|
03151 MAP-AUDIT-DA-A DTSCS69
|
|
03152 MAP-AUDIT-YR-A DTSCS69
|
|
03153 MAP-ADDR-TYPE-A DTSCS69
|
|
03154 MAP-ADDR-ID-NO-A DTSCS69
|
|
03155 MAP-MAIL-TYPE-A DTSCS69
|
|
03156 MAP-MAIL-ID-NO-A. DTSCS69
|
|
03157 S5300-EXIT. DTSCS69
|
|
03158 EXIT. DTSCS69
|
|
03159 DTSCS69
|
|
03160 S5900-SET-ATTRB. DTSCS69
|
|
03161 MOVE ZEROS TO WRK-PHONE. DTSCS69
|
|
03162 PERFORM S5901-PHONE-NUMBER THRU S5901-EXIT 3 TIMES. DTSCS69
|
|
03163 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-ASSIGN-NO-1-A DTSCS69
|
|
03164 MAP-ASSIGN-NO-2-A DTSCS69
|
|
03165 MAP-EMP-NO-1-A DTSCS69
|
|
03166 MAP-EMP-NO-2-A DTSCS69
|
|
03167 MAP-SEQ-NO-A. DTSCS69
|
|
03168 IF LCCM-SCR-CLEAR DTSCS69
|
|
03169 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-AUDIT-MO-A DTSCS69
|
|
03170 MAP-AUDIT-DA-A DTSCS69
|
|
03171 MAP-AUDIT-YR-A DTSCS69
|
|
03172 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-ADDR-TYPE-A DTSCS69
|
|
03173 MAP-ADDR-ID-NO-A DTSCS69
|
|
03174 MAP-MAIL-TYPE-A DTSCS69
|
|
03175 MAP-MAIL-ID-NO-A DTSCS69
|
|
03176 ELSE DTSCS69
|
|
03177 MOVE CATB-ASKIP-BRT-MDTON TO MAP-AUDIT-MO-A DTSCS69
|
|
03178 MAP-AUDIT-DA-A DTSCS69
|
|
03179 MAP-AUDIT-YR-A DTSCS69
|
|
03180 MAP-ADDR-TYPE-A DTSCS69
|
|
03181 MAP-ADDR-ID-NO-A DTSCS69
|
|
03182 MAP-MAIL-TYPE-A DTSCS69
|
|
03183 MAP-MAIL-ID-NO-A. DTSCS69
|
|
03184 MOVE WRK-ATB-AN TO MAP-CONTACT-NAME-A DTSCS69
|
|
03185 MAP-EMAIL-A DTSCS69
|
|
03186 MAP-STATUS-CD-A DTSCS69
|
|
03187 MAP-AUDIT-TIME-HH-A DTSCS69
|
|
03188 MAP-AUDIT-TIME-MM-A DTSCS69
|
|
03189 MAP-AUDIT-CASS-A DTSCS69
|
|
03190 MAP-AUDIT-ATTN-LINE-A DTSCS69
|
|
03191 MAP-AUDIT-DLV1-LINE-A DTSCS69
|
|
03192 MAP-AUDIT-DLV2-LINE-A DTSCS69
|
|
03193 MAP-AUDIT-CITY-A DTSCS69
|
|
03194 MAP-AUDIT-STAT-A DTSCS69
|
|
03195 MAP-AUDIT-ZIP-A DTSCS69
|
|
03196 MAP-MAIL-CASS-A DTSCS69
|
|
03197 MAP-MAIL-ATTN-LINE-A DTSCS69
|
|
03198 MAP-MAIL-DLV1-LINE-A DTSCS69
|
|
03199 MAP-MAIL-DLV2-LINE-A DTSCS69
|
|
03200 MAP-MAIL-CITY-A DTSCS69
|
|
03201 MAP-MAIL-STAT-A DTSCS69
|
|
03202 MAP-MAIL-ZIP-A. DTSCS69
|
|
03203 DTSCS69
|
|
03204 MOVE CATB-ASKIP-BRT-MDTON TO MAP-PRIMARY-NAME-A DTSCS69
|
|
03205 MAP-CURR-PAGE-A DTSCS69
|
|
03206 MAP-CHNG-OP-ID-A DTSCS69
|
|
03207 MAP-CHNG-DATE-A DTSCS69
|
|
03208 MAP-ESTB-OP-ID-A DTSCS69
|
|
03209 MAP-ESTB-DATE-A DTSCS69
|
|
03210 MAP-FLD-REP-ID-A DTSCS69
|
|
03211 MAP-STATUS-CD-DSCR-A DTSCS69
|
|
03212 MAP-FLD-REP-ID-DESC-A DTSCS69
|
|
03213 MAP-LAST-PAGE-A. DTSCS69
|
|
03214 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS69
|
|
03215 DTSCS69
|
|
03216 S5900-EXIT. DTSCS69
|
|
03217 EXIT. DTSCS69
|
|
03218 EJECT DTSCS69
|
|
03219 S5901-PHONE-NUMBER. DTSCS69
|
|
03220 ADD 1 TO WRK-PHONE. DTSCS69
|
|
03221 MOVE WRK-ATB-NUM TO MAP-PHONE-A-CD-A(WRK-PHONE) DTSCS69
|
|
03222 MAP-PHONE-PREF-A(WRK-PHONE) DTSCS69
|
|
03223 MAP-PHONE-SUFF-A(WRK-PHONE) DTSCS69
|
|
03224 MAP-PHONE-EXT-A(WRK-PHONE). DTSCS69
|
|
03225 S5901-EXIT. DTSCS69
|
|
03226 EXIT. DTSCS69
|
|
03227 EJECT DTSCS69
|
|
03228 S8210-READ-MFSL. DTSCS69
|
|
03229 MOVE LOW-VALUES TO MFSL-KEY-AREA. DTSCS69
|
|
03230 MOVE WRK-EMP-NO TO MFSL-EMP-NO. DTSCS69
|
|
03231 MOVE WRK-ASSIGN-NO TO MFSL-ASSIGN-NO. DTSCS69
|
|
03232 SET MFSL-FSL-88 TO TRUE. DTSCS69
|
|
03233 MOVE WRK-ID-NO TO MFSL-ID-NO. DTSCS69
|
|
03234 MOVE MFSL-KEY-AREA TO MSKL-KEY-AREA. DTSCS69
|
|
03235 PERFORM S810-READ THRU S810-EXIT. DTSCS69
|
|
03236 IF L810-OK-88 DTSCS69
|
|
03237 MOVE MSKL-REC TO MFSL-REC. DTSCS69
|
|
03238 S8210-EXIT. EXIT. DTSCS69
|
|
03239 S8220-MFSL-COUNT. DTSCS69
|
|
03240 MOVE LOW-VALUES TO MFSL-KEY-AREA. DTSCS69
|
|
03241 MOVE WRK-EMP-NO TO MFSL-EMP-NO. DTSCS69
|
|
03242 SET MFSL-FSL-88 TO TRUE. DTSCS69
|
|
03243 MOVE WRK-ASSIGN-NO TO MFSL-ASSIGN-NO. DTSCS69
|
|
03244 MOVE MFSL-KEY-AREA TO MSKL-KEY-AREA. DTSCS69
|
|
03245 PERFORM S810-COUNT THRU S810-EXIT. DTSCS69
|
|
03246 DTSCS69
|
|
03247 S8220-EXIT. DTSCS69
|
|
03248 EXIT. DTSCS69
|
|
03249 EJECT DTSCS69
|
|
03250 /*****************************************************************DTSCS69
|
|
03251 * MAP ROUTINES *DTSCS69
|
|
03252 ******************************************************************DTSCS69
|
|
03253 S9100-RECEIVE. DTSCS69
|
|
03254 SET L851-RECEIVE-88 TO TRUE. DTSCS69
|
|
03255 DTSCS69
|
|
03256 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS69
|
|
03257 DTSCS69
|
|
03258 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS69
|
|
03259 DTSCS69
|
|
03260 MOVE L851-AID TO LCCM-AID. DTSCS69
|
|
03261 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS69
|
|
03262 S9100-EXIT. DTSCS69
|
|
03263 EXIT. DTSCS69
|
|
03264 DTSCS69
|
|
03265 S9200-SEND-DATAONLY. DTSCS69
|
|
03266 MOVE LOW-VALUES TO MAP-AREA. DTSCS69
|
|
03267 DTSCS69
|
|
03268 IF LCCM-NO-MSG DTSCS69
|
|
03269 NEXT SENTENCE DTSCS69
|
|
03270 ELSE DTSCS69
|
|
03271 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS69
|
|
03272 DTSCS69
|
|
03273 IF CURSOR-SET-GOTO DTSCS69
|
|
03274 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS69
|
|
03275 ELSE DTSCS69
|
|
03276 MOVE CATB-CURSOR TO MAP-ASSIGN-NO-1-L. DTSCS69
|
|
03277 DTSCS69
|
|
03278 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS69
|
|
03279 DTSCS69
|
|
03280 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS69
|
|
03281 DTSCS69
|
|
03282 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS69
|
|
03283 S9200-EXIT. DTSCS69
|
|
03284 EXIT. DTSCS69
|
|
03285 DTSCS69
|
|
03286 S9300-SEND-MAP. DTSCS69
|
|
03287 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS69
|
|
03288 MOVE SPACES TO MAP-SYS-TIME. DTSCS69
|
|
03289 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS69
|
|
03290 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS69
|
|
03291 DTSCS69
|
|
03292 IF SCR-ACCESS-UPDATE DTSCS69
|
|
03293 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS69
|
|
03294 ELSE DTSCS69
|
|
03295 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS69
|
|
03296 DTSCS69
|
|
03297 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCS69
|
|
03298 DTSCS69
|
|
03299 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS69
|
|
03300 DTSCS69
|
|
03301 IF CURSOR-SET-NO DTSCS69
|
|
03302 MOVE CATB-CURSOR TO MAP-ASSIGN-NO-1-L. DTSCS69
|
|
03303 DTSCS69
|
|
03304 SET L851-SEND-88 TO TRUE. DTSCS69
|
|
03305 DTSCS69
|
|
03306 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS69
|
|
03307 DTSCS69
|
|
03308 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS69
|
|
03309 S9300-EXIT. DTSCS69
|
|
03310 EXIT. DTSCS69
|
|
03311 DTSCS69
|
|
03312 S9310-UPDATE-FKEYS. DTSCS69
|
|
03313 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS69
|
|
03314 DTSCS69
|
|
03315 DTSCS69
|
|
03316 IF LCCM-SCR-CLEAR DTSCS69
|
|
03317 MOVE CFKD-ADD TO MAP-KEY-ADD DTSCS69
|
|
03318 ELSE DTSCS69
|
|
03319 IF LCCM-SCR-INQUIRE DTSCS69
|
|
03320 MOVE CFKD-MOD TO MAP-KEY-MOD DTSCS69
|
|
03321 * MOVE CFKD-DEL TO MAP-KEY-DEL DTSCS69
|
|
03322 ELSE DTSCS69
|
|
03323 IF LCCM-SCR-UPDATE-LOCKED DTSCS69
|
|
03324 MOVE LOW-VALUES TO MAP-KEY-FIRST DTSCS69
|
|
03325 MAP-KEY-LAST DTSCS69
|
|
03326 MAP-KEY-BACK DTSCS69
|
|
03327 MAP-KEY-FWRD. DTSCS69
|
|
03328 S9310-EXIT. DTSCS69
|
|
03329 EXIT. DTSCS69
|
|
03330 DTSCS69
|
|
03331 S9320-INQUIRY-FKEYS. DTSCS69
|
|
03332 MOVE CFKD-FIRST TO MAP-KEY-FIRST. DTSCS69
|
|
03333 MOVE CFKD-LAST TO MAP-KEY-LAST. DTSCS69
|
|
03334 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS69
|
|
03335 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS69
|
|
03336 DTSCS69
|
|
03337 MOVE LOW-VALUES TO MAP-KEY-ADD DTSCS69
|
|
03338 MAP-KEY-MOD DTSCS69
|
|
03339 MAP-KEY-DEL. DTSCS69
|
|
03340 DTSCS69
|
|
03341 * PERFORM S9321-JUMP-KEYS THRU S9321-EXIT. DTSCS69
|
|
03342 S9320-EXIT. DTSCS69
|
|
03343 EXIT. DTSCS69
|
|
03344 DTSCS69
|
|
03345 *S9321-JUMP-KEYS. DTSCS69
|
|
03346 * MOVE CFKD-REG-INQ TO MAP-KEY-REG-INQ. DTSCS69
|
|
03347 * MOVE CFKD-ASSIGN TO MAP-KEY-ASSIGN. DTSCS69
|
|
03348 * MOVE CFKD-AUDIT-RSLT-22 TO MAP-KEY-AUDIT-RSLT. DTSCS69
|
|
03349 *S9321-EXIT. DTSCS69
|
|
03350 * EXIT. DTSCS69
|
|
03351 * DTSCS69
|
|
03352 S9330-DSCR-FIELDS. DTSCS69
|
|
03353 IF WRK-MPRF-YES-88 DTSCS69
|
|
03354 MOVE WRK-EMP-NO TO WRK-DISPLAY DTSCS69
|
|
03355 MOVE WRK-DISPLAY-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS69
|
|
03356 MOVE WRK-DISPLAY-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS69
|
|
03357 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME. DTSCS69
|
|
03358 DTSCS69
|
|
03359 IF MAP-FLD-REP-ID = SPACES OR LOW-VALUES DTSCS69
|
|
03360 MOVE LOW-VALUES TO MAP-FLD-REP-ID-DESC DTSCS69
|
|
03361 ELSE DTSCS69
|
|
03362 MOVE MAP-FLD-REP-ID TO L062-FLD-REP-ID DTSCS69
|
|
03363 PERFORM S062-FLD-REP-ID-DESC THRU S062-EXIT DTSCS69
|
|
03364 MOVE L062-NAME TO MAP-FLD-REP-ID-DESC. DTSCS69
|
|
03365 DTSCS69
|
|
03366 S9330-EXIT. EXIT. DTSCS69
|
|
03367 DTSCS69
|
|
03368 S9900-PREPARE-SEND. DTSCS69
|
|
03369 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS69
|
|
03370 LCCM-SCR-ID. DTSCS69
|
|
03371 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS69
|
|
03372 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS69
|
|
03373 S9900-EXIT. DTSCS69
|
|
03374 EXIT. DTSCS69
|