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