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