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