1797 lines
140 KiB
COBOL
1797 lines
140 KiB
COBOL
00001 IDENTIFICATION DIVISION. 05/05/25
|
|
00002 PROGRAM-ID. DTSCS7D. DTSCS7D
|
|
00003 AUTHOR. NORTHROP GRUMMEN. LV003
|
|
00004 DATE-WRITTEN. JANUARY 2003. DTSCS7D
|
|
00005 DATE-COMPILED. DTSCS7D
|
|
00006 DTSCS7D
|
|
00007 ***** DTSCS7D
|
|
00008 * DTSCS7D
|
|
00009 * FUNCTION: EMPLOYER WAGE REQUEST SCREEN PROCESSOR. DTSCS7D
|
|
00010 * DTSCS7D
|
|
00011 * DTSCS7D
|
|
00012 * MODIFICATION LOG: DTSCS7D
|
|
00013 * DTSCS7D
|
|
00014 * 01/02/03 INITIAL DEVELOPMENT. COPIED FROM DTSCS76. DTSCS7D
|
|
00015 * PROGRAMMER: SCM DTSCS7D
|
|
00016 * DTSCS7D
|
|
00017 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS7D
|
|
00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS7D
|
|
00019 * REFERENCE RFP: #*** PROGRAMMER: XXX DTSCS7D
|
|
00020 * DTSCS7D
|
|
00021 * DTSCS7D
|
|
00022 * DESCRIPTION: DTSCS7D
|
|
00023 * DTSCS7D
|
|
00024 * DTSCS7D
|
|
00025 * CLEAR: DTSCS7D
|
|
00026 * DTSCS7D
|
|
00027 * FIELD DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO). DTSCS7D
|
|
00028 * DTSCS7D
|
|
00029 * DTSCS7D
|
|
00030 * JUMP: DTSCS7D
|
|
00031 * DTSCS7D
|
|
00032 * NONE. DTSCS7D
|
|
00033 * DTSCS7D
|
|
00034 * DTSCS7D
|
|
00035 * INQUIRY: DTSCS7D
|
|
00036 * DTSCS7D
|
|
00037 * CONTROL FIELD(S): MAP-EMP-NO. DTSCS7D
|
|
00038 * DTSCS7D
|
|
00039 * JUMP IN: DISPLAY PRIMARY NAME ASSOCIATED WITH LCCM-EMP-NO. DTSCS7D
|
|
00040 * DTSCS7D
|
|
00041 * ENTER: DISPLAY PRIMARY NAME ASSOCIATED WITH LCCM-EMP-NO. DTSCS7D
|
|
00042 * DTSCS7D
|
|
00043 * STANDARD LCCM-EMP-NO. DTSCS7D
|
|
00044 * DTSCS7D
|
|
00045 * DTSCS7D
|
|
00046 * UPDATE: DTSCS7D
|
|
00047 * DTSCS7D
|
|
00048 * ADD DTSCS7D
|
|
00049 * DTSCS7D
|
|
00050 * DOES NOT UPDATE THE MASTER FILE. WRITES DTSIR751 DTSCS7D
|
|
00051 * RECORD TO THE ON-LINE ACTIVITY FILE. OPTIONALLY DTSCS7D
|
|
00052 * WRITES A DTSIR901 LABEL RECORD TO OLA FILE. DTSCS7D
|
|
00053 * DTSCS7D
|
|
00054 * RECORDS READ: DTSCS7D
|
|
00055 * DTSCS7D
|
|
00056 * MASTER: DTSCS7D
|
|
00057 * DTSCS7D
|
|
00058 * MPRF DTSCS7D
|
|
00059 * MSOL DTSCS7D
|
|
00060 * MRTE DTSCS7D
|
|
00061 * MRPT DTSCS7D
|
|
00062 * DTSCS7D
|
|
00063 * ALTERNATE INDEX: DTSCS7D
|
|
00064 * DTSCS7D
|
|
00065 * NONE. DTSCS7D
|
|
00066 * DTSCS7D
|
|
00067 * REFERENCE: DTSCS7D
|
|
00068 * DTSCS7D
|
|
00069 * NONE. DTSCS7D
|
|
00070 * DTSCS7D
|
|
00071 * DTSCS7D
|
|
00072 * ACCOUNTING TRANSACTION COLLECTION: DTSCS7D
|
|
00073 * DTSCS7D
|
|
00074 * NONE. DTSCS7D
|
|
00075 * DTSCS7D
|
|
00076 * DTSCS7D
|
|
00077 * RECORDS UPDATED: DTSCS7D
|
|
00078 * DTSCS7D
|
|
00079 * MASTER: DTSCS7D
|
|
00080 * DTSCS7D
|
|
00081 * NONE. DTSCS7D
|
|
00082 * DTSCS7D
|
|
00083 * DTSCS7D
|
|
00084 * REFERENCE: DTSCS7D
|
|
00085 * DTSCS7D
|
|
00086 * NONE. DTSCS7D
|
|
00087 * DTSCS7D
|
|
00088 * DTSCS7D
|
|
00089 * ACCOUNTING TRANSACTION COLLECTION: DTSCS7D
|
|
00090 * DTSCS7D
|
|
00091 * NONE. DTSCS7D
|
|
00092 * DTSCS7D
|
|
00093 * DTSCS7D
|
|
00094 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCS7D
|
|
00095 * DTSCS7D
|
|
00096 * WRITE A DTSIR751 RECORD. DTSCS7D
|
|
00097 * DTSCS7D
|
|
00098 * TEMPORARY STORAGE USAGE: DTSCS7D
|
|
00099 * DTSCS7D
|
|
00100 * NONE. DTSCS7D
|
|
00101 * DTSCS7D
|
|
00102 * DTSCS7D
|
|
00103 * MODULES LINKED TO: DTSCS7D
|
|
00104 * DTSCS7D
|
|
00105 * DTSCU004 QUARTER EDIT/CONVERSION. DTSCS7D
|
|
00106 * DTSCU016 QUARTER/YEAR FROM SCREEN FORMAT/EDIT. DTSCS7D
|
|
00107 * DTSCU018 EMP NO FROM SCREEN FORMAT/EDIT. DTSCS7D
|
|
00108 * DTSCU082 OPERATOR ID EDIT/LOOKUP. DTSCS7D
|
|
00109 * DTSCU111 ADDRESS LOOKUP. DTSCS7D
|
|
00110 * DTSCU112 FORMAT ADDRESS FOR MAILING. DTSCS7D
|
|
00111 * DTSCU810 MASTER FILE INPUT/OUTPUT. DTSCS7D
|
|
00112 * DTSCU825 ON-LINE ACTIVITY FILE OUTPUT. DTSCS7D
|
|
00113 * DTSCS7D
|
|
00114 ***** DTSCS7D
|
|
00115 DTSCS7D
|
|
00116 ENVIRONMENT DIVISION. DTSCS7D
|
|
00117 DTSCS7D
|
|
00118 DATA DIVISION. DTSCS7D
|
|
00119 DTSCS7D
|
|
00120 WORKING-STORAGE SECTION. DTSCS7D
|
|
001205 77 PAN-VALET PICTURE X(24) VALUE '003DTSCS7D 05/05/25'. DTSCS7D
|
|
00121 77 PAN-VALET PICTURE X(24) VALUE '008DTSCS7D 05/05/25'. DTSCS7D
|
|
00122 DTSCS7D
|
|
00123 01 SW-AREA. DTSCS7D
|
|
00124 05 WRK-ABEND-CD PIC X(04) VALUE 'S7D '. DTSCS7D
|
|
00125 DTSCS7D
|
|
00126 05 WRK-SCR-ID. DTSCS7D
|
|
00127 10 WRK-SCR-ID-A PIC X(02) VALUE '7D'. DTSCS7D
|
|
00128 DTSCS7D
|
|
00129 05 WRK-F03-SCR-ID PIC X(02) VALUE '70'. DTSCS7D
|
|
00130 DTSCS7D
|
|
00131 05 WRK-FINL-IND-OK PIC X(01). DTSCS7D
|
|
00132 DTSCS7D
|
|
00133 05 SCR-ACCESS-IND PIC X(01). DTSCS7D
|
|
00134 88 SCR-ACCESS-INQ VALUE '1'. DTSCS7D
|
|
00135 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS7D
|
|
00136 DTSCS7D
|
|
00137 05 CURSOR-SET-IND PIC X(01). DTSCS7D
|
|
00138 88 CURSOR-SET-YES VALUE 'Y'. DTSCS7D
|
|
00139 88 CURSOR-SET-NO VALUE 'N'. DTSCS7D
|
|
00140 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS7D
|
|
00141 DTSCS7D
|
|
00142 05 REQ-IND PIC X(01). DTSCS7D
|
|
00143 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS7D
|
|
00144 88 REQ-ERROR VALUE 'O'. DTSCS7D
|
|
00145 88 REQ-JUMP VALUE 'J'. DTSCS7D
|
|
00146 88 REQ-UPDATE VALUE 'U'. DTSCS7D
|
|
00147 88 REQ-INQUIRE VALUE 'I'. DTSCS7D
|
|
00148 88 REQ-CLEAR VALUE 'C'. DTSCS7D
|
|
00149 88 REQ-EDIT VALUE 'E'. DTSCS7D
|
|
00150 DTSCS7D
|
|
00151 05 RESP-IND PIC X(01). DTSCS7D
|
|
00152 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS7D
|
|
00153 88 RESP-SEND-MAP VALUE 'M'. DTSCS7D
|
|
00154 88 RESP-JUMP VALUE 'J'. DTSCS7D
|
|
00155 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS7D
|
|
00156 DTSCS7D
|
|
00157 05 WRK-MSG-AREA PIC X(64). DTSCS7D
|
|
00158 DTSCS7D
|
|
00159 05 WRK-ATB-AN PIC X(01). DTSCS7D
|
|
00160 DTSCS7D
|
|
00161 05 WRK-ATB-NUM PIC X(01). DTSCS7D
|
|
00162 DTSCS7D
|
|
00163 05 WRK-NO-DEFAULT PIC X(01). DTSCS7D
|
|
00164 DTSCS7D
|
|
00165 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSCS7D
|
|
00166 DTSCS7D
|
|
00167 05 WRK-MPRF-IND PIC X(01). DTSCS7D
|
|
00168 88 WRK-MPRF-NONE-88 VALUE ' '. DTSCS7D
|
|
00169 88 WRK-MPRF-YES-88 VALUE 'Y'. DTSCS7D
|
|
00170 88 WRK-MPRF-NO-88 VALUE 'N'. DTSCS7D
|
|
00171 DTSCS7D
|
|
00172 05 WRK-MAILING-ADDRESS-AREA. DTSCS7D
|
|
00173 10 WRK-MAILING-ADDRESS. DTSCS7D
|
|
00174 15 FILLER OCCURS 5 PIC X(40). DTSCS7D
|
|
00175 10 WRK-ZIP PIC X(10). DTSCS7D
|
|
00176 10 WRK-ADVANCED-BARCODE PIC X(14). DTSCS7D
|
|
00177 DTSCS7D
|
|
00178 05 WRK-TELEPHONE-AREA. DTSCS7D
|
|
00179 10 FILLER PIC X(01) VALUE '('. DTSCS7D
|
|
00180 10 WRK-VOICE-AREA-CD PIC X(03). DTSCS7D
|
|
00181 10 FILLER PIC X(02) VALUE ')'. DTSCS7D
|
|
00182 10 WRK-VOICE-PREFIX PIC X(03). DTSCS7D
|
|
00183 10 FILLER PIC X(01) VALUE '-'. DTSCS7D
|
|
00184 10 WRK-VOICE-SUFFIX PIC X(04). DTSCS7D
|
|
00185 DTSCS7D
|
|
00186 05 WRK-DISPLAY PIC 9(11). DTSCS7D
|
|
00187 DTSCS7D
|
|
00188 05 FILLER REDEFINES WRK-DISPLAY. DTSCS7D
|
|
00189 10 FILLER PIC X(05). DTSCS7D
|
|
00190 10 WRK-DISPLAY-EMP-NO-1 PIC X(03). DTSCS7D
|
|
00191 10 WRK-DISPLAY-EMP-NO-2 PIC X(03). DTSCS7D
|
|
00192 DTSCS7D
|
|
00193 05 FILLER REDEFINES WRK-DISPLAY. DTSCS7D
|
|
00194 10 FILLER PIC X(05). DTSCS7D
|
|
00195 10 WRK-DISPLAY-YR PIC X(02). DTSCS7D
|
|
00196 10 WRK-DISPLAY-MO PIC X(02). DTSCS7D
|
|
00197 10 WRK-DISPLAY-DA PIC X(02). DTSCS7D
|
|
00198 DTSCS7D
|
|
00199 05 FILLER REDEFINES WRK-DISPLAY. DTSCS7D
|
|
00200 10 FILLER PIC X(06). DTSCS7D
|
|
00201 10 WRK-DISPLAY-YRQ PIC X(05). DTSCS7D
|
|
00202 10 FILLER REDEFINES WRK-DISPLAY-YRQ. DTSCS7D
|
|
00203 15 FILLER PIC XX. DTSCS7D
|
|
00204 15 WRK-DISPLAY-YRQ-Y PIC 99. DTSCS7D
|
|
00205 15 WRK-DISPLAY-YRQ-Q PIC 9. DTSCS7D
|
|
00206 DTSCS7D
|
|
00207 EJECT DTSCS7D
|
|
00208 01 MSG-LITERALS. DTSCS7D
|
|
00209 05 MSG-E7D1-AREA. DTSCS7D
|
|
00210 10 FILLER PIC X(04) VALUE 'E7D1'. DTSCS7D
|
|
00211 10 FILLER PIC X(30) DTSCS7D
|
|
00212 VALUE 'SSN MUST BE ENTERED '. DTSCS7D
|
|
00213 10 FILLER PIC X(30) DTSCS7D
|
|
00214 VALUE ' '. DTSCS7D
|
|
00215 DTSCS7D
|
|
00216 05 MSG-E7D2-AREA. DTSCS7D
|
|
00217 10 FILLER PIC X(04) VALUE 'E7D2'. DTSCS7D
|
|
00218 10 FILLER PIC X(30) DTSCS7D
|
|
00219 VALUE 'SSN NOT IN CLAIMANT FILE; RE-E'. DTSCS7D
|
|
00220 10 FILLER PIC X(30) DTSCS7D
|
|
00221 VALUE 'NTER. '. DTSCS7D
|
|
00222 DTSCS7D
|
|
00223 05 MSG-E7D3-AREA. DTSCS7D
|
|
00224 10 FILLER PIC X(04) VALUE 'E7D3'. DTSCS7D
|
|
00225 10 FILLER PIC X(52) VALUE DTSCS7D
|
|
00226 'EITHER EMPLOYER NUMBER OR NAME & ADDRESS IS REQUIRED'. DTSCS7D
|
|
00227 DTSCS7D
|
|
00228 05 MSG-E7D4-AREA. DTSCS7D
|
|
00229 10 FILLER PIC X(04) VALUE 'E7D4'. DTSCS7D
|
|
00230 10 FILLER PIC X(47) VALUE DTSCS7D
|
|
00231 'ENTER EITHER EMPLOYER NUMBER OR NAME & ADDRESS,'. DTSCS7D
|
|
00232 10 FILLER PIC X(08) DTSCS7D
|
|
00233 VALUE 'NOT BOTH'. DTSCS7D
|
|
00234 DTSCS7D
|
|
00235 05 MSG-E7D5-AREA. DTSCS7D
|
|
00236 10 FILLER PIC X(04) VALUE 'E7D5'. DTSCS7D
|
|
00237 10 FILLER PIC X(47) VALUE DTSCS7D
|
|
00238 'INCOMPLETE/INVALID ADDRESS ENTERED FOR EMPLOYER'. DTSCS7D
|
|
00239 DTSCS7D
|
|
00240 05 MSG-E7D6-AREA. DTSCS7D
|
|
00241 10 FILLER PIC X(04) VALUE 'E7D6'. DTSCS7D
|
|
00242 10 FILLER PIC X(33) VALUE DTSCS7D
|
|
00243 'INVALID ENTRY. MUST BE (Y, N, L)'. DTSCS7D
|
|
00244 DTSCS7D
|
|
00245 05 MSG-E7D7-AREA. DTSCS7D
|
|
00246 10 FILLER PIC X(04) VALUE 'E7D7'. DTSCS7D
|
|
00247 10 FILLER PIC X(40) VALUE DTSCS7D
|
|
00248 'EMPLOYER ADDRESS COULD NOT BE CONFIRMED'. DTSCS7D
|
|
00249 DTSCS7D
|
|
00250 05 MSG-E7D8-AREA. DTSCS7D
|
|
00251 10 FILLER PIC X(04) VALUE 'E7D8'. DTSCS7D
|
|
00252 10 FILLER PIC X(32) VALUE DTSCS7D
|
|
00253 'EMPLOYER DOES NOT EXIST IN DUTAS'. DTSCS7D
|
|
00254 DTSCS7D
|
|
00255 05 MSG-E7D9-AREA. DTSCS7D
|
|
00256 10 FILLER PIC X(04) VALUE 'E7D9'. DTSCS7D
|
|
00257 10 FILLER PIC X(37) VALUE DTSCS7D
|
|
00258 'DO NOT ENTER EMPLOYER OR QTR(S) WHEN'. DTSCS7D
|
|
00259 10 FILLER PIC X(14) DTSCS7D
|
|
00260 VALUE 'MAIL LABEL = L'. DTSCS7D
|
|
00261 DTSCS7D
|
|
00262 05 MSG-E7D10-AREA. DTSCS7D
|
|
00263 10 FILLER PIC X(05) VALUE 'E7D10'. DTSCS7D
|
|
00264 10 FILLER PIC X(51) VALUE DTSCS7D
|
|
00265 'EITHER EMPLOYER NUMBER OR EMPLOYER NAME IS REQUIRED'. DTSCS7D
|
|
00266 DTSCS7D
|
|
00267 *01 ESP072D-COMM-AREA. CL**3
|
|
00268 *++INCLUDE ESPLINKC CL**3
|
|
00269 * EJECT CL**3
|
|
00270 01 L001-COMM-AREA. DTSCS7D
|
|
00271 ++INCLUDE DTSIL001 DTSCS7D
|
|
00272 EJECT DTSCS7D
|
|
00273 01 L004-COMM-AREA. DTSCS7D
|
|
00274 ++INCLUDE DTSIL004 DTSCS7D
|
|
00275 EJECT DTSCS7D
|
|
00276 01 L006-COMM-AREA. DTSCS7D
|
|
00277 ++INCLUDE DTSIL006 DTSCS7D
|
|
00278 EJECT DTSCS7D
|
|
00279 01 L013-COMM-AREA. DTSCS7D
|
|
00280 ++INCLUDE DTSIL013 DTSCS7D
|
|
00281 EJECT DTSCS7D
|
|
00282 01 L015-COMM-AREA. DTSCS7D
|
|
00283 ++INCLUDE DTSIL015 DTSCS7D
|
|
00284 EJECT DTSCS7D
|
|
00285 01 L016-COMM-AREA. DTSCS7D
|
|
00286 ++INCLUDE DTSIL016 DTSCS7D
|
|
00287 EJECT DTSCS7D
|
|
00288 01 L018-COMM-AREA. DTSCS7D
|
|
00289 ++INCLUDE DTSIL018 DTSCS7D
|
|
00290 EJECT DTSCS7D
|
|
00291 01 L020-COMM-AREA. DTSCS7D
|
|
00292 ++INCLUDE DTSIL020 DTSCS7D
|
|
00293 EJECT DTSCS7D
|
|
00294 01 L072-COMM-AREA. DTSCS7D
|
|
00295 ++INCLUDE DTSIL072 DTSCS7D
|
|
00296 EJECT DTSCS7D
|
|
00297 01 L081-COMM-AREA. DTSCS7D
|
|
00298 ++INCLUDE DTSIL081 DTSCS7D
|
|
00299 EJECT DTSCS7D
|
|
00300 01 L082-COMM-AREA. DTSCS7D
|
|
00301 ++INCLUDE DTSIL082 DTSCS7D
|
|
00302 EJECT DTSCS7D
|
|
00303 01 L112-COMM-AREA. DTSCS7D
|
|
00304 ++INCLUDE DTSIL112 DTSCS7D
|
|
00305 EJECT DTSCS7D
|
|
00306 01 L381-COMM-AREA. DTSCS7D
|
|
00307 ++INCLUDE DTSIL381 DTSCS7D
|
|
00308 EJECT DTSCS7D
|
|
00309 01 L410-COMM-AREA. DTSCS7D
|
|
00310 ++INCLUDE DTSIL410 DTSCS7D
|
|
00311 EJECT DTSCS7D
|
|
00312 01 L805-COMM-AREA. DTSCS7D
|
|
00313 ++INCLUDE DTSIL805 DTSCS7D
|
|
00314 EJECT DTSCS7D
|
|
00315 01 L810-COMM-AREA. DTSCS7D
|
|
00316 05 L810-CONTROL-BLOCK. DTSCS7D
|
|
00317 ++INCLUDE DTSIL810 DTSCS7D
|
|
00318 EJECT DTSCS7D
|
|
00319 05 MSKL-REC. DTSCS7D
|
|
00320 ++INCLUDE DTSIMSKL DTSCS7D
|
|
00321 EJECT DTSCS7D
|
|
00322 01 MPRF-REC. DTSCS7D
|
|
00323 ++INCLUDE DTSIMPRF DTSCS7D
|
|
00324 EJECT DTSCS7D
|
|
00325 01 MTAD-REC. DTSCS7D
|
|
00326 ++INCLUDE DTSIMTAD DTSCS7D
|
|
00327 EJECT DTSCS7D
|
|
00328 01 L851-COMM-AREA. DTSCS7D
|
|
00329 ++INCLUDE DTSIL851 DTSCS7D
|
|
00330 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS7D
|
|
00331 EJECT DTSCS7D
|
|
00332 ++INCLUDE DTSIS7D DTSCS7D
|
|
00333 EJECT DTSCS7D
|
|
00334 01 L825-COMM-AREA. DTSCS7D
|
|
00335 05 L825-CONTROL-BLOCK. DTSCS7D
|
|
00336 ++INCLUDE DTSIL825 DTSCS7D
|
|
00337 EJECT DTSCS7D
|
|
00338 05 RSKL-REC. DTSCS7D
|
|
00339 ++INCLUDE DTSIRSK1 DTSCS7D
|
|
00340 EJECT DTSCS7D
|
|
00341 01 R751-REC. DTSCS7D
|
|
00342 ++INCLUDE DTSIR751 DTSCS7D
|
|
00343 EJECT DTSCS7D
|
|
00344 01 R901-REC. DTSCS7D
|
|
00345 ++INCLUDE DTSIR901 DTSCS7D
|
|
00346 EJECT DTSCS7D
|
|
00347 01 CATB-LITERALS. DTSCS7D
|
|
00348 ++INCLUDE DTSICATB DTSCS7D
|
|
00349 DTSCS7D
|
|
00350 01 CFKD-LITERALS. DTSCS7D
|
|
00351 ++INCLUDE DTSICFKD DTSCS7D
|
|
00352 DTSCS7D
|
|
00353 01 CECD-LITERALS. DTSCS7D
|
|
00354 ++INCLUDE DTSICECD DTSCS7D
|
|
00355 DTSCS7D
|
|
00356 01 CPCD-LITERALS. DTSCS7D
|
|
00357 ++INCLUDE DTSICPCD DTSCS7D
|
|
00358 DTSCS7D
|
|
00359 LINKAGE SECTION. DTSCS7D
|
|
00360 DTSCS7D
|
|
00361 01 DFHCOMMAREA. DTSCS7D
|
|
00362 ++INCLUDE DTSILCCM DTSCS7D
|
|
00363 EJECT DTSCS7D
|
|
00364 PROCEDURE DIVISION. DTSCS7D
|
|
00365 DTSCS7D
|
|
00366 MOVE +0 TO WRK-EMP-NO. DTSCS7D
|
|
00367 DTSCS7D
|
|
00368 SET WRK-MPRF-NONE-88 TO TRUE. DTSCS7D
|
|
00369 DTSCS7D
|
|
00370 MOVE LOW-VALUES TO MAP-AREA. DTSCS7D
|
|
00371 DTSCS7D
|
|
00372 SET CURSOR-SET-NO TO TRUE. DTSCS7D
|
|
00373 DTSCS7D
|
|
00374 PERFORM P0100-ACCESS-SEARCH THRU P0100-EXIT DTSCS7D
|
|
00375 VARYING LCCM-NONUM-IDX FROM +1 BY +1 DTSCS7D
|
|
00376 UNTIL LCCM-NONUM-IDX > LCCM-SCR-NONUM-CNT. DTSCS7D
|
|
00377 DTSCS7D
|
|
00378 MOVE SPACE TO REQ-IND. DTSCS7D
|
|
00379 DTSCS7D
|
|
00380 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS7D
|
|
00381 DTSCS7D
|
|
00382 *----------------------------------------------------- DTSCS7D
|
|
00383 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS7D
|
|
00384 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS7D
|
|
00385 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS7D
|
|
00386 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS7D
|
|
00387 * DTSCS7D
|
|
00388 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS7D
|
|
00389 * PROCESSED. DTSCS7D
|
|
00390 * DTSCS7D
|
|
00391 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS7D
|
|
00392 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS7D
|
|
00393 * WORK STATION OPERATOR. DTSCS7D
|
|
00394 *----------------------------------------------------- DTSCS7D
|
|
00395 DTSCS7D
|
|
00396 MOVE SPACE TO RESP-IND. DTSCS7D
|
|
00397 DTSCS7D
|
|
00398 IF REQ-ERROR DTSCS7D
|
|
00399 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS7D
|
|
00400 ELSE DTSCS7D
|
|
00401 IF REQ-JUMP DTSCS7D
|
|
00402 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS7D
|
|
00403 ELSE DTSCS7D
|
|
00404 IF REQ-CLEAR DTSCS7D
|
|
00405 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS7D
|
|
00406 ELSE DTSCS7D
|
|
00407 IF REQ-CURSOR-TO-GOTO DTSCS7D
|
|
00408 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS7D
|
|
00409 ELSE DTSCS7D
|
|
00410 IF REQ-INQUIRE DTSCS7D
|
|
00411 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS7D
|
|
00412 ELSE DTSCS7D
|
|
00413 IF REQ-EDIT DTSCS7D
|
|
00414 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS7D
|
|
00415 ELSE DTSCS7D
|
|
00416 IF REQ-UPDATE DTSCS7D
|
|
00417 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS7D
|
|
00418 ELSE DTSCS7D
|
|
00419 GO TO S899-ABEND. DTSCS7D
|
|
00420 DTSCS7D
|
|
00421 *----------------------------------------------------- DTSCS7D
|
|
00422 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS7D
|
|
00423 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS7D
|
|
00424 *----------------------------------------------------- DTSCS7D
|
|
00425 DTSCS7D
|
|
00426 IF RESP-SEND-MAP DTSCS7D
|
|
00427 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS7D
|
|
00428 SET LCCM-END-TASK-88 TO TRUE DTSCS7D
|
|
00429 ELSE DTSCS7D
|
|
00430 IF RESP-SEND-MSGONLY DTSCS7D
|
|
00431 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS7D
|
|
00432 SET LCCM-END-TASK-88 TO TRUE DTSCS7D
|
|
00433 ELSE DTSCS7D
|
|
00434 IF RESP-JUMP DTSCS7D
|
|
00435 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS7D
|
|
00436 ELSE DTSCS7D
|
|
00437 IF RESP-CURSOR-TO-GOTO DTSCS7D
|
|
00438 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS7D
|
|
00439 SET LCCM-END-TASK-88 TO TRUE DTSCS7D
|
|
00440 ELSE DTSCS7D
|
|
00441 GO TO S899-ABEND. DTSCS7D
|
|
00442 DTSCS7D
|
|
00443 MAINLINE-EXIT. DTSCS7D
|
|
00444 DTSCS7D
|
|
00445 EXEC CICS DTSCS7D
|
|
00446 RETURN DTSCS7D
|
|
00447 END-EXEC. DTSCS7D
|
|
00448 DTSCS7D
|
|
00449 GOBACK. DTSCS7D
|
|
00450 EJECT DTSCS7D
|
|
00451 P0100-ACCESS-SEARCH. DTSCS7D
|
|
00452 IF LCCM-SCR-NONUM-ID (LCCM-NONUM-IDX) = WRK-SCR-ID-A DTSCS7D
|
|
00453 MOVE LCCM-SCR-NONUM-ACCESS-IND (LCCM-NONUM-IDX) DTSCS7D
|
|
00454 TO SCR-ACCESS-IND. DTSCS7D
|
|
00455 P0100-EXIT. DTSCS7D
|
|
00456 EXIT. DTSCS7D
|
|
00457 DTSCS7D
|
|
00458 ******************************************************************DTSCS7D
|
|
00459 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS7D
|
|
00460 ******************************************************************DTSCS7D
|
|
00461 DTSCS7D
|
|
00462 P1000-ANALYZE-REQUEST. DTSCS7D
|
|
00463 DTSCS7D
|
|
00464 *----------------------------------------------------- DTSCS7D
|
|
00465 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS7D
|
|
00466 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS7D
|
|
00467 * REPLACED WITH ENTER) DTSCS7D
|
|
00468 *----------------------------------------------------- DTSCS7D
|
|
00469 DTSCS7D
|
|
00470 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS7D
|
|
00471 SET LCCM-ENTER-88 TO TRUE DTSCS7D
|
|
00472 SET REQ-INQUIRE TO TRUE DTSCS7D
|
|
00473 IF LCCM-EMP-NO > ZERO DTSCS7D
|
|
00474 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS7D
|
|
00475 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS7D
|
|
00476 END-IF DTSCS7D
|
|
00477 GO TO P1000-EXIT. DTSCS7D
|
|
00478 DTSCS7D
|
|
00479 *----------------------------------------------------- DTSCS7D
|
|
00480 * RECEIVE THE MAP DTSCS7D
|
|
00481 *----------------------------------------------------- DTSCS7D
|
|
00482 DTSCS7D
|
|
00483 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS7D
|
|
00484 DTSCS7D
|
|
00485 *----------------------------------------------------- DTSCS7D
|
|
00486 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS7D
|
|
00487 * WORK STATION DTSCS7D
|
|
00488 *----------------------------------------------------- DTSCS7D
|
|
00489 DTSCS7D
|
|
00490 IF LCCM-CLEAR-88 DTSCS7D
|
|
00491 SET REQ-CLEAR TO TRUE DTSCS7D
|
|
00492 GO TO P1000-EXIT. DTSCS7D
|
|
00493 DTSCS7D
|
|
00494 *----------------------------------------------------- DTSCS7D
|
|
00495 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS7D
|
|
00496 *----------------------------------------------------- DTSCS7D
|
|
00497 DTSCS7D
|
|
00498 IF LCCM-SCR-UPDATE-LOCKED DTSCS7D
|
|
00499 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS7D
|
|
00500 GO TO P1000-EXIT. DTSCS7D
|
|
00501 DTSCS7D
|
|
00502 *----------------------------------------------------- DTSCS7D
|
|
00503 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS7D
|
|
00504 *----------------------------------------------------- DTSCS7D
|
|
00505 DTSCS7D
|
|
00506 IF LCCM-PA2-88 DTSCS7D
|
|
00507 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS7D
|
|
00508 GO TO P1000-EXIT. DTSCS7D
|
|
00509 DTSCS7D
|
|
00510 *----------------------------------------------------- DTSCS7D
|
|
00511 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS7D
|
|
00512 *----------------------------------------------------- DTSCS7D
|
|
00513 DTSCS7D
|
|
00514 IF LCCM-PA-88 DTSCS7D
|
|
00515 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS7D
|
|
00516 SET REQ-ERROR TO TRUE DTSCS7D
|
|
00517 GO TO P1000-EXIT. DTSCS7D
|
|
00518 DTSCS7D
|
|
00519 *----------------------------------------------------- DTSCS7D
|
|
00520 * IF F12 KEY IS PRESSED AND UPDATE NOT IN PROGRESS DTSCS7D
|
|
00521 * CLEAR SCREEN DTSCS7D
|
|
00522 *----------------------------------------------------- DTSCS7D
|
|
00523 DTSCS7D
|
|
00524 IF LCCM-F12-88 DTSCS7D
|
|
00525 MOVE LOW-VALUES TO MAP-AREA DTSCS7D
|
|
00526 SET REQ-CLEAR TO TRUE DTSCS7D
|
|
00527 GO TO P1000-EXIT. DTSCS7D
|
|
00528 DTSCS7D
|
|
00529 *----------------------------------------------------- DTSCS7D
|
|
00530 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS7D
|
|
00531 *----------------------------------------------------- DTSCS7D
|
|
00532 DTSCS7D
|
|
00533 IF LCCM-F03-88 DTSCS7D
|
|
00534 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS7D
|
|
00535 SET REQ-JUMP TO TRUE DTSCS7D
|
|
00536 GO TO P1000-EXIT. DTSCS7D
|
|
00537 DTSCS7D
|
|
00538 *----------------------------------------------------- DTSCS7D
|
|
00539 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS7D
|
|
00540 *----------------------------------------------------- DTSCS7D
|
|
00541 DTSCS7D
|
|
00542 IF LCCM-F04-88 DTSCS7D
|
|
00543 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS7D
|
|
00544 SET REQ-JUMP TO TRUE DTSCS7D
|
|
00545 GO TO P1000-EXIT. DTSCS7D
|
|
00546 DTSCS7D
|
|
00547 *----------------------------------------------------- DTSCS7D
|
|
00548 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS7D
|
|
00549 * CORRESPONDENCE SCREEN DTSCS7D
|
|
00550 *----------------------------------------------------- DTSCS7D
|
|
00551 DTSCS7D
|
|
00552 IF LCCM-F14-88 DTSCS7D
|
|
00553 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS7D
|
|
00554 SET REQ-JUMP TO TRUE DTSCS7D
|
|
00555 GO TO P1000-EXIT. DTSCS7D
|
|
00556 DTSCS7D
|
|
00557 *----------------------------------------------------- DTSCS7D
|
|
00558 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS7D
|
|
00559 * REQUESTED SCREEN TYPE DTSCS7D
|
|
00560 *----------------------------------------------------- DTSCS7D
|
|
00561 DTSCS7D
|
|
00562 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS7D
|
|
00563 NEXT SENTENCE DTSCS7D
|
|
00564 ELSE DTSCS7D
|
|
00565 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS7D
|
|
00566 SET REQ-JUMP TO TRUE DTSCS7D
|
|
00567 GO TO P1000-EXIT. DTSCS7D
|
|
00568 DTSCS7D
|
|
00569 *----------------------------------------------------- DTSCS7D
|
|
00570 * IF REQUEST TO UPDATE THE DATA (ADD) DTSCS7D
|
|
00571 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS7D
|
|
00572 *----------------------------------------------------- DTSCS7D
|
|
00573 DTSCS7D
|
|
00574 IF LCCM-F09-88 DTSCS7D
|
|
00575 IF SCR-ACCESS-UPDATE DTSCS7D
|
|
00576 SET REQ-EDIT TO TRUE DTSCS7D
|
|
00577 GO TO P1000-EXIT DTSCS7D
|
|
00578 ELSE DTSCS7D
|
|
00579 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS7D
|
|
00580 SET REQ-ERROR TO TRUE DTSCS7D
|
|
00581 GO TO P1000-EXIT. DTSCS7D
|
|
00582 DTSCS7D
|
|
00583 *----------------------------------------------------- DTSCS7D
|
|
00584 * IF INQUIRY KEY IS PRESSED (ENTER), INDICATE DTSCS7D
|
|
00585 * INQUIRY REQUESTED. DTSCS7D
|
|
00586 *----------------------------------------------------- DTSCS7D
|
|
00587 DTSCS7D
|
|
00588 IF LCCM-ENTER-88 DTSCS7D
|
|
00589 SET REQ-INQUIRE TO TRUE DTSCS7D
|
|
00590 GO TO P1000-EXIT. DTSCS7D
|
|
00591 DTSCS7D
|
|
00592 *----------------------------------------------------- DTSCS7D
|
|
00593 * ANY OTHER KEY IS INVALID DTSCS7D
|
|
00594 *----------------------------------------------------- DTSCS7D
|
|
00595 DTSCS7D
|
|
00596 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS7D
|
|
00597 DTSCS7D
|
|
00598 SET REQ-ERROR TO TRUE. DTSCS7D
|
|
00599 P1000-EXIT. DTSCS7D
|
|
00600 EXIT. DTSCS7D
|
|
00601 DTSCS7D
|
|
00602 ******************************************************************DTSCS7D
|
|
00603 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS7D
|
|
00604 ******************************************************************DTSCS7D
|
|
00605 DTSCS7D
|
|
00606 P1100-UPDATE-LOCKED. DTSCS7D
|
|
00607 DTSCS7D
|
|
00608 *----------------------------------------------------- DTSCS7D
|
|
00609 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS7D
|
|
00610 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER OR F9 DTSCS7D
|
|
00611 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS7D
|
|
00612 *----------------------------------------------------- DTSCS7D
|
|
00613 DTSCS7D
|
|
00614 IF LCCM-ENTER-88 OR LCCM-F12-88 OR LCCM-F09-88 DTSCS7D
|
|
00615 SET REQ-UPDATE TO TRUE DTSCS7D
|
|
00616 IF LCCM-F09-88 DTSCS7D
|
|
00617 SET LCCM-ENTER-88 TO TRUE DTSCS7D
|
|
00618 END-IF DTSCS7D
|
|
00619 ELSE DTSCS7D
|
|
00620 SET REQ-ERROR TO TRUE DTSCS7D
|
|
00621 IF LCCM-SCR-ADD-LOCKED DTSCS7D
|
|
00622 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS7D
|
|
00623 ELSE DTSCS7D
|
|
00624 GO TO S899-ABEND. DTSCS7D
|
|
00625 P1100-EXIT. DTSCS7D
|
|
00626 EXIT. DTSCS7D
|
|
00627 ******************************************************************DTSCS7D
|
|
00628 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS7D
|
|
00629 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS7D
|
|
00630 ******************************************************************DTSCS7D
|
|
00631 DTSCS7D
|
|
00632 P2000-REQUEST-ERROR. DTSCS7D
|
|
00633 IF LCCM-MSG DTSCS7D
|
|
00634 SET RESP-SEND-MSGONLY TO TRUE DTSCS7D
|
|
00635 ELSE DTSCS7D
|
|
00636 GO TO S899-ABEND. DTSCS7D
|
|
00637 P2000-EXIT. DTSCS7D
|
|
00638 EXIT. DTSCS7D
|
|
00639 ******************************************************************DTSCS7D
|
|
00640 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS7D
|
|
00641 ******************************************************************DTSCS7D
|
|
00642 DTSCS7D
|
|
00643 P3000-REQUEST-JUMP. DTSCS7D
|
|
00644 DTSCS7D
|
|
00645 *----------------------------------------------------- DTSCS7D
|
|
00646 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS7D
|
|
00647 * BY USER DTSCS7D
|
|
00648 *----------------------------------------------------- DTSCS7D
|
|
00649 DTSCS7D
|
|
00650 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS7D
|
|
00651 DTSCS7D
|
|
00652 *----------------------------------------------------- DTSCS7D
|
|
00653 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS7D
|
|
00654 *----------------------------------------------------- DTSCS7D
|
|
00655 DTSCS7D
|
|
00656 IF LCCM-MSG DTSCS7D
|
|
00657 SET RESP-SEND-MSGONLY TO TRUE DTSCS7D
|
|
00658 SET CURSOR-SET-GOTO TO TRUE DTSCS7D
|
|
00659 GO TO P3000-EXIT. DTSCS7D
|
|
00660 DTSCS7D
|
|
00661 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS7D
|
|
00662 DTSCS7D
|
|
00663 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS7D
|
|
00664 DTSCS7D
|
|
00665 IF L018-VALID DTSCS7D
|
|
00666 MOVE L018-EMP-NO TO LCCM-EMP-NO. DTSCS7D
|
|
00667 DTSCS7D
|
|
00668 *----------------------------------------------------- DTSCS7D
|
|
00669 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS7D
|
|
00670 *----------------------------------------------------- DTSCS7D
|
|
00671 DTSCS7D
|
|
00672 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS7D
|
|
00673 LCCM-SCR-HOLD-AREA. DTSCS7D
|
|
00674 DTSCS7D
|
|
00675 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS7D
|
|
00676 DTSCS7D
|
|
00677 SET RESP-JUMP TO TRUE. DTSCS7D
|
|
00678 P3000-EXIT. DTSCS7D
|
|
00679 EXIT. DTSCS7D
|
|
00680 ******************************************************************DTSCS7D
|
|
00681 * CLEAR KEY WAS PRESSED *DTSCS7D
|
|
00682 ******************************************************************DTSCS7D
|
|
00683 DTSCS7D
|
|
00684 P4000-REQUEST-CLEAR. DTSCS7D
|
|
00685 SET LCCM-SCR-CLEAR TO TRUE. DTSCS7D
|
|
00686 DTSCS7D
|
|
00687 IF SCR-ACCESS-UPDATE DTSCS7D
|
|
00688 PERFORM S8200-SET-UPDATE-ATTRB THRU S8200-EXIT DTSCS7D
|
|
00689 ELSE DTSCS7D
|
|
00690 PERFORM S8300-SET-INQ-ATTRB THRU S8300-EXIT. DTSCS7D
|
|
00691 DTSCS7D
|
|
00692 *----------------------------------------------------- DTSCS7D
|
|
00693 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS7D
|
|
00694 * FIELDS FROM EARLIER REQUESTS DTSCS7D
|
|
00695 *----------------------------------------------------- DTSCS7D
|
|
00696 DTSCS7D
|
|
00697 IF LCCM-EMP-NO > ZERO DTSCS7D
|
|
00698 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS7D
|
|
00699 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS7D
|
|
00700 DTSCS7D
|
|
00701 MOVE ZERO TO LCCM-EMP-NO. DTSCS7D
|
|
00702 DTSCS7D
|
|
00703 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA. DTSCS7D
|
|
00704 DTSCS7D
|
|
00705 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS7D
|
|
00706 DTSCS7D
|
|
00707 SET RESP-SEND-MAP TO TRUE. DTSCS7D
|
|
00708 P4000-EXIT. DTSCS7D
|
|
00709 EXIT. DTSCS7D
|
|
00710 DTSCS7D
|
|
00711 ******************************************************************DTSCS7D
|
|
00712 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS7D
|
|
00713 ******************************************************************DTSCS7D
|
|
00714 DTSCS7D
|
|
00715 P5000-CURSOR-TO-GOTO. DTSCS7D
|
|
00716 SET CURSOR-SET-GOTO TO TRUE. DTSCS7D
|
|
00717 DTSCS7D
|
|
00718 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS7D
|
|
00719 P5000-EXIT. DTSCS7D
|
|
00720 EXIT. DTSCS7D
|
|
00721 DTSCS7D
|
|
00722 ******************************************************************DTSCS7D
|
|
00723 * INQUIRY WAS REQUESTED *DTSCS7D
|
|
00724 ******************************************************************DTSCS7D
|
|
00725 DTSCS7D
|
|
00726 P6000-REQUEST-INQUIRE. DTSCS7D
|
|
00727 SET LCCM-SCR-CLEAR TO TRUE. DTSCS7D
|
|
00728 DTSCS7D
|
|
00729 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS7D
|
|
00730 DTSCS7D
|
|
00731 SET RESP-SEND-MAP TO TRUE. DTSCS7D
|
|
00732 DTSCS7D
|
|
00733 IF SCR-ACCESS-UPDATE DTSCS7D
|
|
00734 PERFORM S8200-SET-UPDATE-ATTRB THRU S8200-EXIT DTSCS7D
|
|
00735 ELSE DTSCS7D
|
|
00736 PERFORM S8300-SET-INQ-ATTRB THRU S8300-EXIT. DTSCS7D
|
|
00737 DTSCS7D
|
|
00738 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS7D
|
|
00739 P6000-EXIT. DTSCS7D
|
|
00740 EXIT. DTSCS7D
|
|
00741 DTSCS7D
|
|
00742 ******************************************************************DTSCS7D
|
|
00743 * FUNCTION KEY TO ADD THE RECORD WAS PRESSED. *DTSCS7D
|
|
00744 ******************************************************************DTSCS7D
|
|
00745 DTSCS7D
|
|
00746 P7000-REQUEST-EDIT. DTSCS7D
|
|
00747 PERFORM S8200-SET-UPDATE-ATTRB THRU S8200-EXIT. DTSCS7D
|
|
00748 DTSCS7D
|
|
00749 IF LCCM-F09-88 DTSCS7D
|
|
00750 PERFORM P7100-EDIT-ADD THRU P7100-EXIT DTSCS7D
|
|
00751 ELSE DTSCS7D
|
|
00752 GO TO S899-ABEND. DTSCS7D
|
|
00753 DTSCS7D
|
|
00754 *------------------------------------------------------ DTSCS7D
|
|
00755 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCS7D
|
|
00756 * IN ORDER TO CONTINUE TO ATTEMPT AN ADD THE SCREEN MUST DTSCS7D
|
|
00757 * REMAIN IN 'CLEAR' STATUS. DTSCS7D
|
|
00758 *------------------------------------------------------ DTSCS7D
|
|
00759 DTSCS7D
|
|
00760 IF LCCM-MSG DTSCS7D
|
|
00761 NEXT SENTENCE DTSCS7D
|
|
00762 ELSE DTSCS7D
|
|
00763 PERFORM S8100-SET-LOCK-ATTRB THRU S8100-EXIT DTSCS7D
|
|
00764 IF LCCM-F09-88 DTSCS7D
|
|
00765 SET LCCM-SCR-ADD-LOCKED TO TRUE DTSCS7D
|
|
00766 MOVE PMSG-ALT-ADD-CONFIRM TO LCCM-MSG-ID. DTSCS7D
|
|
00767 DTSCS7D
|
|
00768 SET RESP-SEND-MAP TO TRUE. DTSCS7D
|
|
00769 DTSCS7D
|
|
00770 P7000-EXIT. DTSCS7D
|
|
00771 EXIT. DTSCS7D
|
|
00772 ******************************************************************DTSCS7D
|
|
00773 * ADD FUNCTION WAS REQUESTED *DTSCS7D
|
|
00774 ******************************************************************DTSCS7D
|
|
00775 DTSCS7D
|
|
00776 P7100-EDIT-ADD. DTSCS7D
|
|
00777 *----------------------------------------------------- DTSCS7D
|
|
00778 * ADD REQUIRES THAT THE SCREEN BE IN A CLEARED STATE DTSCS7D
|
|
00779 * MAP-EMP-NO IS REQUIRED UNLESS MAP EMPLOYER NAME AND DTSCS7D
|
|
00780 * ADDRESS ARE ENTERED. IF BOTH ARE ENTERED, DISPLAY DTSCS7D
|
|
00781 * ERROR MESSAGE. DTSCS7D
|
|
00782 *----------------------------------------------------- DTSCS7D
|
|
00783 DTSCS7D
|
|
00784 IF MAP-EMP-NO-1 GREATER SPACES DTSCS7D
|
|
00785 OR MAP-EMP-NO-2 GREATER SPACES DTSCS7D
|
|
00786 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS7D
|
|
00787 DTSCS7D
|
|
00788 IF LCCM-MSG DTSCS7D
|
|
00789 GO TO P7100-EXIT. DTSCS7D
|
|
00790 DTSCS7D
|
|
00791 MOVE MAP-FINL-IND-OK TO WRK-FINL-IND-OK. DTSCS7D
|
|
00792 DTSCS7D
|
|
00793 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS7D
|
|
00794 IF LCCM-MSG DTSCS7D
|
|
00795 GO TO P7100-EXIT. DTSCS7D
|
|
00796 DTSCS7D
|
|
00797 IF MAP-MAIL-LABEL EQUAL 'L' DTSCS7D
|
|
00798 MOVE L081-CLAIMANT-NAME TO MAP-DE-NAME DTSCS7D
|
|
00799 MOVE SPACES TO MAP-DE-ADDR1 DTSCS7D
|
|
00800 MOVE SPACES TO MAP-DE-ADDR2 DTSCS7D
|
|
00801 MOVE SPACES TO MAP-DE-CITY DTSCS7D
|
|
00802 MOVE SPACES TO MAP-DE-STATE DTSCS7D
|
|
00803 MOVE SPACES TO MAP-DE-ZIP DTSCS7D
|
|
00804 MOVE SPACES TO MAP-DE-ATTN. DTSCS7D
|
|
00805 DTSCS7D
|
|
00806 P7100-EXIT. DTSCS7D
|
|
00807 EXIT. DTSCS7D
|
|
00808 ******************************************************************DTSCS7D
|
|
00809 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED *DTSCS7D
|
|
00810 ******************************************************************DTSCS7D
|
|
00811 DTSCS7D
|
|
00812 P8000-REQUEST-UPDATE. DTSCS7D
|
|
00813 IF LCCM-SCR-ADD-LOCKED DTSCS7D
|
|
00814 PERFORM P8100-ADD THRU P8100-EXIT DTSCS7D
|
|
00815 ELSE DTSCS7D
|
|
00816 GO TO S899-ABEND. DTSCS7D
|
|
00817 DTSCS7D
|
|
00818 SET RESP-SEND-MAP TO TRUE. DTSCS7D
|
|
00819 P8000-EXIT. DTSCS7D
|
|
00820 EXIT. DTSCS7D
|
|
00821 DTSCS7D
|
|
00822 P8100-ADD. DTSCS7D
|
|
00823 SET LCCM-SCR-CLEAR TO TRUE. DTSCS7D
|
|
00824 DTSCS7D
|
|
00825 PERFORM S8200-SET-UPDATE-ATTRB THRU S8200-EXIT. DTSCS7D
|
|
00826 DTSCS7D
|
|
00827 IF LCCM-F12-88 DTSCS7D
|
|
00828 MOVE PMSG-ADD-CANCELED TO LCCM-MSG-ID DTSCS7D
|
|
00829 GO TO P8100-EXIT. DTSCS7D
|
|
00830 DTSCS7D
|
|
00831 IF MAP-EMP-NO-1 NOT GREATER SPACES DTSCS7D
|
|
00832 AND MAP-EMP-NO-2 NOT GREATER SPACES DTSCS7D
|
|
00833 OR MAP-MAIL-LABEL EQUAL 'L' DTSCS7D
|
|
00834 GO TO P8100-ADD-1. DTSCS7D
|
|
00835 DTSCS7D
|
|
00836 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS7D
|
|
00837 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS7D
|
|
00838 MOVE ALL '?' TO WRK-MAILING-ADDRESS-AREA. DTSCS7D
|
|
00839 DTSCS7D
|
|
00840 MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME, DTSCS7D
|
|
00841 L112-NAME. DTSCS7D
|
|
00842 MOVE MTAD-ADDRESS TO L112-ADDRESS. DTSCS7D
|
|
00843 DTSCS7D
|
|
00844 GO TO P8100-ADD-2. DTSCS7D
|
|
00845 DTSCS7D
|
|
00846 P8100-ADD-1. DTSCS7D
|
|
00847 MOVE MAP-DE-NAME TO L112-PRIMARY-NAME, DTSCS7D
|
|
00848 L112-NAME. DTSCS7D
|
|
00849 MOVE MAP-DE-ADDR1 TO L112-DELIV-LINE-1. DTSCS7D
|
|
00850 MOVE MAP-DE-ADDR2 TO L112-DELIV-LINE-2. DTSCS7D
|
|
00851 MOVE MAP-DE-CITY TO L112-CITY. DTSCS7D
|
|
00852 MOVE MAP-DE-STATE TO L112-ST. DTSCS7D
|
|
00853 MOVE MAP-DE-ZIP TO L112-ZIP. DTSCS7D
|
|
00854 MOVE MAP-DE-ATTN TO L112-ATTN-LINE. DTSCS7D
|
|
00855 MOVE SPACES TO L112-ADVANCED-BARCODE. DTSCS7D
|
|
00856 DTSCS7D
|
|
00857 P8100-ADD-2. DTSCS7D
|
|
00858 SET L112-TAD-ADDR-88 TO TRUE. DTSCS7D
|
|
00859 SET L112-ANCHOR-FIRST-88 TO TRUE. DTSCS7D
|
|
00860 DTSCS7D
|
|
00861 PERFORM S112-ADDR-FORMAT THRU S112-EXIT. DTSCS7D
|
|
00862 DTSCS7D
|
|
00863 MOVE L112-MAILING-ADDRESS TO WRK-MAILING-ADDRESS. DTSCS7D
|
|
00864 MOVE L112-ZIP TO WRK-ZIP. DTSCS7D
|
|
00865 MOVE L112-ADVANCED-BARCODE TO WRK-ADVANCED-BARCODE. DTSCS7D
|
|
00866 DTSCS7D
|
|
00867 IF MAP-MAIL-LABEL EQUAL 'L' OR 'Y' DTSCS7D
|
|
00868 PERFORM P8910-R901-RECORD THRU P8910-EXIT. DTSCS7D
|
|
00869 DTSCS7D
|
|
00870 IF MAP-MAIL-LABEL NOT EQUAL 'L' DTSCS7D
|
|
00871 PERFORM P8980-R751-RECORD THRU P8980-EXIT. DTSCS7D
|
|
00872 DTSCS7D
|
|
00873 MOVE LOW-VALUES TO MAP-AREA. DTSCS7D
|
|
00874 PERFORM S8200-SET-UPDATE-ATTRB THRU S8200-EXIT. DTSCS7D
|
|
00875 IF LCCM-EMP-NO GREATER ZEROS DTSCS7D
|
|
00876 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS7D
|
|
00877 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS7D
|
|
00878 DTSCS7D
|
|
00879 MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS7D
|
|
00880 MOVE ZEROS TO LCCM-EMP-NO. DTSCS7D
|
|
00881 DTSCS7D
|
|
00882 IF MAP-MAIL-LABEL NOT GREATER SPACES DTSCS7D
|
|
00883 AND WRK-NO-DEFAULT NOT EQUAL 'Y' DTSCS7D
|
|
00884 MOVE 'Y' TO MAP-MAIL-LABEL. DTSCS7D
|
|
00885 P8100-EXIT. DTSCS7D
|
|
00886 EXIT. DTSCS7D
|
|
00887 DTSCS7D
|
|
00888 ***** DTSCS7D
|
|
00889 * MACIR901 LABEL REPORT RECORD. DTSCS7D
|
|
00890 ***** DTSCS7D
|
|
00891 P8910-R901-RECORD. DTSCS7D
|
|
00892 SET R901-ON-REQUEST-88 TO TRUE. DTSCS7D
|
|
00893 DTSCS7D
|
|
00894 MOVE LOW-VALUES TO R901-SORT-VAR-AREA. DTSCS7D
|
|
00895 DTSCS7D
|
|
00896 MOVE +01 TO R901-LABEL-CNT. DTSCS7D
|
|
00897 DTSCS7D
|
|
00898 MOVE LCCM-RESP-OP-ID TO R901-GRP1-OP-ID. DTSCS7D
|
|
00899 DTSCS7D
|
|
00900 MOVE WRK-EMP-NO TO R901-GRP1-EMP-NO DTSCS7D
|
|
00901 R901-EMP-NO. DTSCS7D
|
|
00902 DTSCS7D
|
|
00903 MOVE WRK-MAILING-ADDRESS TO R901-FMT-ADDR. DTSCS7D
|
|
00904 DTSCS7D
|
|
00905 MOVE WRK-ZIP TO R901-ZIP. DTSCS7D
|
|
00906 DTSCS7D
|
|
00907 MOVE WRK-ADVANCED-BARCODE TO R901-ADVANCED-BARCODE. DTSCS7D
|
|
00908 DTSCS7D
|
|
00909 MOVE LENGTH OF R901-REC TO R901-LENGTH. DTSCS7D
|
|
00910 DTSCS7D
|
|
00911 MOVE R901-REC TO RSKL-REC. DTSCS7D
|
|
00912 DTSCS7D
|
|
00913 PERFORM S825-WRITE THRU S825-EXIT. DTSCS7D
|
|
00914 P8910-EXIT. DTSCS7D
|
|
00915 EXIT. DTSCS7D
|
|
00916 DTSCS7D
|
|
00917 ***** DTSCS7D
|
|
00918 * MACIR901 ELF LABEL REPORT RECORD. DTSCS7D
|
|
00919 ***** DTSCS7D
|
|
00920 DTSCS7D
|
|
00921 P8980-R751-RECORD. DTSCS7D
|
|
00922 MOVE WRK-EMP-NO TO R751-EMP-NO. DTSCS7D
|
|
00923 IF WRK-EMP-NO GREATER ZEROS DTSCS7D
|
|
00924 MOVE MPRF-PRIMARY-NAME TO R751-EMP-PRIMARY-NAME DTSCS7D
|
|
00925 ELSE DTSCS7D
|
|
00926 MOVE MAP-DE-NAME TO R751-EMP-PRIMARY-NAME. DTSCS7D
|
|
00927 DTSCS7D
|
|
00928 MOVE MAP-SSN-AREA TO L020-S-SSN-AREA. DTSCS7D
|
|
00929 PERFORM S020-SCREEN-SSN THRU S020-EXIT. DTSCS7D
|
|
00930 MOVE L020-SSN TO R751-SSN. DTSCS7D
|
|
00931 DTSCS7D
|
|
00932 MOVE MAP-CLAIMANT-NAME TO R751-CLAIMANT-NAME. DTSCS7D
|
|
00933 MOVE LCCM-OP-NAME TO R751-OP-NAME. DTSCS7D
|
|
00934 MOVE LCCM-CURR-MAIL-DATE TO R751-MAIL-DATE. DTSCS7D
|
|
00935 MOVE LENGTH OF R751-REC TO R751-LENGTH. DTSCS7D
|
|
00936 DTSCS7D
|
|
00937 IF MAP-WR-YRQ1-YR GREATER SPACES DTSCS7D
|
|
00938 MOVE MAP-WR-YRQ1-AREA TO L016-S-YRQ-AREA DTSCS7D
|
|
00939 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT DTSCS7D
|
|
00940 MOVE L016-YRQ TO R751-YRQ DTSCS7D
|
|
00941 MOVE R751-REC TO RSKL-REC DTSCS7D
|
|
00942 PERFORM S825-WRITE THRU S825-EXIT. DTSCS7D
|
|
00943 DTSCS7D
|
|
00944 IF MAP-WR-YRQ2-YR GREATER SPACES DTSCS7D
|
|
00945 MOVE MAP-WR-YRQ2-AREA TO L016-S-YRQ-AREA DTSCS7D
|
|
00946 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT DTSCS7D
|
|
00947 MOVE L016-YRQ TO R751-YRQ DTSCS7D
|
|
00948 MOVE R751-REC TO RSKL-REC DTSCS7D
|
|
00949 PERFORM S825-WRITE THRU S825-EXIT. DTSCS7D
|
|
00950 DTSCS7D
|
|
00951 IF MAP-WR-YRQ3-YR GREATER SPACES DTSCS7D
|
|
00952 MOVE MAP-WR-YRQ3-AREA TO L016-S-YRQ-AREA DTSCS7D
|
|
00953 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT DTSCS7D
|
|
00954 MOVE L016-YRQ TO R751-YRQ DTSCS7D
|
|
00955 MOVE R751-REC TO RSKL-REC DTSCS7D
|
|
00956 PERFORM S825-WRITE THRU S825-EXIT. DTSCS7D
|
|
00957 DTSCS7D
|
|
00958 IF MAP-WR-YRQ4-YR GREATER SPACES DTSCS7D
|
|
00959 MOVE MAP-WR-YRQ4-AREA TO L016-S-YRQ-AREA DTSCS7D
|
|
00960 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT DTSCS7D
|
|
00961 MOVE L016-YRQ TO R751-YRQ DTSCS7D
|
|
00962 MOVE R751-REC TO RSKL-REC DTSCS7D
|
|
00963 PERFORM S825-WRITE THRU S825-EXIT. DTSCS7D
|
|
00964 DTSCS7D
|
|
00965 P8980-EXIT. DTSCS7D
|
|
00966 EXIT. DTSCS7D
|
|
00967 DTSCS7D
|
|
00968 ******************************************************************DTSCS7D
|
|
00969 * LINKS TO UTILITY MODULES DTSCS7D
|
|
00970 ******************************************************************DTSCS7D
|
|
00971 DTSCS7D
|
|
00972 S001-FROM-FED-8. DTSCS7D
|
|
00973 SET L001-FROM-FED-8 TO TRUE. DTSCS7D
|
|
00974 GO TO S001-LINK. DTSCS7D
|
|
00975 DTSCS7D
|
|
00976 S001-FROM-ABS-DAY. DTSCS7D
|
|
00977 SET L001-FROM-ABS-DAY TO TRUE. DTSCS7D
|
|
00978 GO TO S001-LINK. DTSCS7D
|
|
00979 DTSCS7D
|
|
00980 S001-LINK. DTSCS7D
|
|
00981 EXEC CICS LINK DTSCS7D
|
|
00982 PROGRAM ('DTSCU001') DTSCS7D
|
|
00983 COMMAREA (L001-COMM-AREA) DTSCS7D
|
|
00984 END-EXEC. DTSCS7D
|
|
00985 S001-EXIT. DTSCS7D
|
|
00986 EXIT. DTSCS7D
|
|
00987 DTSCS7D
|
|
00988 S004-FROM-5. DTSCS7D
|
|
00989 SET L004-FROM-5 TO TRUE. DTSCS7D
|
|
00990 GO TO S004-LINK. DTSCS7D
|
|
00991 DTSCS7D
|
|
00992 S004-FROM-DATE. DTSCS7D
|
|
00993 SET L004-FROM-DATE TO TRUE. DTSCS7D
|
|
00994 GO TO S004-LINK. DTSCS7D
|
|
00995 DTSCS7D
|
|
00996 S004-FROM-ABS. DTSCS7D
|
|
00997 SET L004-FROM-ABS TO TRUE. DTSCS7D
|
|
00998 GO TO S004-LINK. DTSCS7D
|
|
00999 DTSCS7D
|
|
01000 S004-LINK. DTSCS7D
|
|
01001 EXEC CICS LINK DTSCS7D
|
|
01002 PROGRAM ('DTSCU004') DTSCS7D
|
|
01003 COMMAREA (L004-COMM-AREA) DTSCS7D
|
|
01004 END-EXEC. DTSCS7D
|
|
01005 S004-EXIT. DTSCS7D
|
|
01006 EXIT. DTSCS7D
|
|
01007 DTSCS7D
|
|
01008 S006-LINK. DTSCS7D
|
|
01009 EXEC CICS LINK DTSCS7D
|
|
01010 PROGRAM ('DTSCU006') DTSCS7D
|
|
01011 COMMAREA (L006-COMM-AREA) DTSCS7D
|
|
01012 END-EXEC. DTSCS7D
|
|
01013 S006-EXIT. DTSCS7D
|
|
01014 EXIT. DTSCS7D
|
|
01015 DTSCS7D
|
|
01016 S016-YRQ-FROM-SCREEN. DTSCS7D
|
|
01017 EXEC CICS LINK DTSCS7D
|
|
01018 PROGRAM('DTSCU016') DTSCS7D
|
|
01019 COMMAREA(L016-COMM-AREA) DTSCS7D
|
|
01020 END-EXEC. DTSCS7D
|
|
01021 S016-EXIT. DTSCS7D
|
|
01022 EXIT. DTSCS7D
|
|
01023 DTSCS7D
|
|
01024 S018-EMP-NO-FROM-SCREEN. DTSCS7D
|
|
01025 EXEC CICS LINK DTSCS7D
|
|
01026 PROGRAM('DTSCU018') DTSCS7D
|
|
01027 COMMAREA(L018-COMM-AREA) DTSCS7D
|
|
01028 END-EXEC. DTSCS7D
|
|
01029 S018-EXIT. DTSCS7D
|
|
01030 EXIT. DTSCS7D
|
|
01031 DTSCS7D
|
|
01032 S020-SCREEN-SSN. DTSCS7D
|
|
01033 EXEC CICS LINK DTSCS7D
|
|
01034 PROGRAM ('DTSCU020') DTSCS7D
|
|
01035 COMMAREA (L020-COMM-AREA) DTSCS7D
|
|
01036 END-EXEC. DTSCS7D
|
|
01037 S020-EXIT. DTSCS7D
|
|
01038 EXIT. DTSCS7D
|
|
01039 DTSCS7D
|
|
01040 S072-EDIT-ADDRESS. DTSCS7D
|
|
01041 EXEC CICS LINK DTSCS7D
|
|
01042 PROGRAM ('DTSCU072') DTSCS7D
|
|
01043 COMMAREA (L072-COMM-AREA) DTSCS7D
|
|
01044 END-EXEC. DTSCS7D
|
|
01045 S072-EXIT. DTSCS7D
|
|
01046 EXIT. DTSCS7D
|
|
01047 DTSCS7D
|
|
01048 S081-CLAIMANT-NAME-LOOKUP. DTSCS7D
|
|
01049 EXEC CICS LINK DTSCS7D
|
|
01050 PROGRAM('DTSCU081') DTSCS7D
|
|
01051 COMMAREA(L081-COMM-AREA) DTSCS7D
|
|
01052 END-EXEC. DTSCS7D
|
|
01053 DTSCS7D
|
|
01054 IF L081-FILE-CLOSED DTSCS7D
|
|
01055 MOVE L081-MSG-AREA TO LCCM-MSG-AREA DTSCS7D
|
|
01056 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS7D
|
|
01057 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS7D
|
|
01058 GO TO MAINLINE-EXIT. DTSCS7D
|
|
01059 S081-EXIT. DTSCS7D
|
|
01060 EXIT. DTSCS7D
|
|
01061 DTSCS7D
|
|
01062 *S081A-CONVERT-CLAIMANT-NAME. DTSCS7D
|
|
01063 * DTSCS7D
|
|
01064 * EXEC CICS LINK DTSCS7D
|
|
01065 * PROGRAM('ESP072D') DTSCS7D
|
|
01066 * COMMAREA(ESP072D-COMM-AREA) DTSCS7D
|
|
01067 * LENGTH(COM-LEN) DTSCS7D
|
|
01068 * END-EXEC. DTSCS7D
|
|
01069 DTSCS7D
|
|
01070 *S081A-EXIT. DTSCS7D
|
|
01071 EXIT. DTSCS7D
|
|
01072 DTSCS7D
|
|
01073 S112-ADDR-FORMAT. DTSCS7D
|
|
01074 EXEC CICS LINK DTSCS7D
|
|
01075 PROGRAM('DTSCU112') DTSCS7D
|
|
01076 COMMAREA(L112-COMM-AREA) DTSCS7D
|
|
01077 END-EXEC. DTSCS7D
|
|
01078 S112-EXIT. DTSCS7D
|
|
01079 EXIT. DTSCS7D
|
|
01080 DTSCS7D
|
|
01081 S803-REQ-SCR-ID-EDIT. DTSCS7D
|
|
01082 EXEC CICS LINK DTSCS7D
|
|
01083 PROGRAM ('DTSCU803') DTSCS7D
|
|
01084 COMMAREA (DFHCOMMAREA) DTSCS7D
|
|
01085 END-EXEC. DTSCS7D
|
|
01086 S803-EXIT. DTSCS7D
|
|
01087 EXIT. DTSCS7D
|
|
01088 DTSCS7D
|
|
01089 S804-INVALID-KEY. DTSCS7D
|
|
01090 EXEC CICS LINK DTSCS7D
|
|
01091 PROGRAM ('DTSCU804') DTSCS7D
|
|
01092 COMMAREA (DFHCOMMAREA) DTSCS7D
|
|
01093 END-EXEC. DTSCS7D
|
|
01094 S804-EXIT. DTSCS7D
|
|
01095 EXIT. DTSCS7D
|
|
01096 DTSCS7D
|
|
01097 S805-MSG-AREA. DTSCS7D
|
|
01098 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS7D
|
|
01099 DTSCS7D
|
|
01100 EXEC CICS LINK DTSCS7D
|
|
01101 PROGRAM ('DTSCU805') DTSCS7D
|
|
01102 COMMAREA (L805-COMM-AREA) DTSCS7D
|
|
01103 END-EXEC. DTSCS7D
|
|
01104 DTSCS7D
|
|
01105 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS7D
|
|
01106 S805-EXIT. DTSCS7D
|
|
01107 EXIT. DTSCS7D
|
|
01108 DTSCS7D
|
|
01109 S810-READ. DTSCS7D
|
|
01110 SET L810-READ-88 TO TRUE. DTSCS7D
|
|
01111 GO TO S810-IO. DTSCS7D
|
|
01112 DTSCS7D
|
|
01113 S810-START-BROWSE. DTSCS7D
|
|
01114 SET L810-START-BROWSE-88 TO TRUE. DTSCS7D
|
|
01115 GO TO S810-IO. DTSCS7D
|
|
01116 DTSCS7D
|
|
01117 S810-READ-NEXT. DTSCS7D
|
|
01118 SET L810-READ-NEXT-88 TO TRUE. DTSCS7D
|
|
01119 GO TO S810-IO. DTSCS7D
|
|
01120 DTSCS7D
|
|
01121 S810-READ-PREV. DTSCS7D
|
|
01122 SET L810-READ-PREV-88 TO TRUE. DTSCS7D
|
|
01123 GO TO S810-IO. DTSCS7D
|
|
01124 DTSCS7D
|
|
01125 S810-END-BROWSE. DTSCS7D
|
|
01126 SET L810-END-BROWSE-88 TO TRUE. DTSCS7D
|
|
01127 GO TO S810-IO. DTSCS7D
|
|
01128 DTSCS7D
|
|
01129 S810-COUNT. DTSCS7D
|
|
01130 SET L810-COUNT-88 TO TRUE. DTSCS7D
|
|
01131 GO TO S810-IO. DTSCS7D
|
|
01132 DTSCS7D
|
|
01133 S810-IO. DTSCS7D
|
|
01134 EXEC CICS LINK DTSCS7D
|
|
01135 PROGRAM ('DTSCU810') DTSCS7D
|
|
01136 COMMAREA (L810-COMM-AREA) DTSCS7D
|
|
01137 END-EXEC. DTSCS7D
|
|
01138 DTSCS7D
|
|
01139 IF L810-FILE-CLOSED-88 DTSCS7D
|
|
01140 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS7D
|
|
01141 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS7D
|
|
01142 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS7D
|
|
01143 GO TO MAINLINE-EXIT. DTSCS7D
|
|
01144 S810-EXIT. DTSCS7D
|
|
01145 EXIT. DTSCS7D
|
|
01146 DTSCS7D
|
|
01147 S825-WRITE. DTSCS7D
|
|
01148 SET L825-WRITE-88 TO TRUE. DTSCS7D
|
|
01149 GO TO S825-O. DTSCS7D
|
|
01150 DTSCS7D
|
|
01151 S825-O. DTSCS7D
|
|
01152 DTSCS7D
|
|
01153 EXEC CICS LINK DTSCS7D
|
|
01154 PROGRAM ('DTSCU825') DTSCS7D
|
|
01155 COMMAREA (L825-COMM-AREA) DTSCS7D
|
|
01156 END-EXEC. DTSCS7D
|
|
01157 DTSCS7D
|
|
01158 IF L825-FILE-CLOSED-88 DTSCS7D
|
|
01159 MOVE L825-MSG-AREA TO LCCM-MSG-AREA DTSCS7D
|
|
01160 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS7D
|
|
01161 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS7D
|
|
01162 GO TO MAINLINE-EXIT. DTSCS7D
|
|
01163 S825-EXIT. DTSCS7D
|
|
01164 EXIT. DTSCS7D
|
|
01165 DTSCS7D
|
|
01166 S851-SCREEN-PROCESSING. DTSCS7D
|
|
01167 EXEC CICS LINK DTSCS7D
|
|
01168 PROGRAM ('DTSCU851') DTSCS7D
|
|
01169 COMMAREA (L851-COMM-AREA) DTSCS7D
|
|
01170 END-EXEC. DTSCS7D
|
|
01171 S851-EXIT. DTSCS7D
|
|
01172 EXIT. DTSCS7D
|
|
01173 DTSCS7D
|
|
01174 S899-ABEND. DTSCS7D
|
|
01175 EXEC CICS ABEND DTSCS7D
|
|
01176 ABCODE(WRK-ABEND-CD) DTSCS7D
|
|
01177 END-EXEC. DTSCS7D
|
|
01178 S899-EXIT. DTSCS7D
|
|
01179 EXIT. DTSCS7D
|
|
01180 DTSCS7D
|
|
01181 ******************************************************************DTSCS7D
|
|
01182 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS7D
|
|
01183 ******************************************************************DTSCS7D
|
|
01184 DTSCS7D
|
|
01185 S1000-SCREEN-EDITS. DTSCS7D
|
|
01186 PERFORM S2600-WAGE-REQUEST THRU S2600-EXIT. DTSCS7D
|
|
01187 DTSCS7D
|
|
01188 IF LCCM-MSG DTSCS7D
|
|
01189 GO TO S1000-EXIT. DTSCS7D
|
|
01190 DTSCS7D
|
|
01191 IF MAP-SSN-1 NOT GREATER SPACES DTSCS7D
|
|
01192 MOVE MSG-E7D1-AREA TO WRK-MSG-AREA DTSCS7D
|
|
01193 PERFORM S1195-ERROR THRU S1195-EXIT DTSCS7D
|
|
01194 GO TO S1000-EXIT. DTSCS7D
|
|
01195 DTSCS7D
|
|
01196 IF MAP-MAIL-LABEL NOT EQUAL 'Y' AND 'N' AND 'L' DTSCS7D
|
|
01197 MOVE 'Y' TO WRK-NO-DEFAULT DTSCS7D
|
|
01198 MOVE MSG-E7D6-AREA TO WRK-MSG-AREA DTSCS7D
|
|
01199 PERFORM S1197-ERROR THRU S1197-EXIT DTSCS7D
|
|
01200 GO TO S1000-EXIT. DTSCS7D
|
|
01201 DTSCS7D
|
|
01202 S1000-SE-1. DTSCS7D
|
|
01203 IF MAP-MAIL-LABEL EQUAL 'L' DTSCS7D
|
|
01204 IF MAP-EMP-NO-1 GREATER SPACES DTSCS7D
|
|
01205 OR MAP-EMP-NO-2 GREATER SPACES DTSCS7D
|
|
01206 OR MAP-DE-NAME GREATER SPACES DTSCS7D
|
|
01207 AND MAP-DE-NAME NOT EQUAL L081-CLAIMANT-NAME DTSCS7D
|
|
01208 OR MAP-DE-ADDR1 GREATER SPACES DTSCS7D
|
|
01209 AND MAP-DE-ADDR1 NOT EQUAL L081-CLAIMANT-STREET DTSCS7D
|
|
01210 OR MAP-DE-ADDR2 GREATER SPACES DTSCS7D
|
|
01211 OR MAP-DE-CITY GREATER SPACES DTSCS7D
|
|
01212 AND MAP-DE-CITY NOT EQUAL L081-CLAIMANT-CITY DTSCS7D
|
|
01213 OR MAP-DE-STATE GREATER SPACES DTSCS7D
|
|
01214 AND MAP-DE-STATE NOT EQUAL L081-CLAIMANT-STATE DTSCS7D
|
|
01215 OR MAP-DE-ZIP GREATER SPACES DTSCS7D
|
|
01216 AND MAP-DE-ZIP NOT EQUAL L081-CLAIMANT-ZIP (1:5) DTSCS7D
|
|
01217 OR MAP-DE-ATTN GREATER SPACES DTSCS7D
|
|
01218 OR MAP-WR-YRQ1-YR GREATER SPACES DTSCS7D
|
|
01219 OR MAP-WR-YRQ1-Q GREATER SPACES DTSCS7D
|
|
01220 OR MAP-WR-YRQ2-YR GREATER SPACES DTSCS7D
|
|
01221 OR MAP-WR-YRQ2-Q GREATER SPACES DTSCS7D
|
|
01222 OR MAP-WR-YRQ3-YR GREATER SPACES DTSCS7D
|
|
01223 OR MAP-WR-YRQ3-Q GREATER SPACES DTSCS7D
|
|
01224 OR MAP-WR-YRQ4-YR GREATER SPACES DTSCS7D
|
|
01225 OR MAP-WR-YRQ4-Q GREATER SPACES DTSCS7D
|
|
01226 MOVE MSG-E7D9-AREA TO WRK-MSG-AREA DTSCS7D
|
|
01227 PERFORM S1194-ERROR THRU S1194-EXIT DTSCS7D
|
|
01228 GO TO S1000-EXIT DTSCS7D
|
|
01229 ELSE DTSCS7D
|
|
01230 GO TO S1000-EXIT. DTSCS7D
|
|
01231 DTSCS7D
|
|
01232 IF MAP-EMP-NO-1 NOT GREATER SPACES DTSCS7D
|
|
01233 AND MAP-EMP-NO-2 NOT GREATER SPACES DTSCS7D
|
|
01234 AND MAP-DE-NAME NOT GREATER SPACES DTSCS7D
|
|
01235 AND MAP-DE-ADDR1 NOT GREATER SPACES DTSCS7D
|
|
01236 AND MAP-DE-ADDR2 NOT GREATER SPACES DTSCS7D
|
|
01237 AND MAP-DE-CITY NOT GREATER SPACES DTSCS7D
|
|
01238 AND MAP-DE-STATE NOT GREATER SPACES DTSCS7D
|
|
01239 AND MAP-DE-ZIP NOT GREATER SPACES DTSCS7D
|
|
01240 AND MAP-DE-ATTN NOT GREATER SPACES DTSCS7D
|
|
01241 MOVE MSG-E7D3-AREA TO WRK-MSG-AREA DTSCS7D
|
|
01242 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS7D
|
|
01243 GO TO S1000-EXIT. DTSCS7D
|
|
01244 DTSCS7D
|
|
01245 IF (MAP-EMP-NO-1 GREATER SPACES DTSCS7D
|
|
01246 OR MAP-EMP-NO-2 GREATER SPACES) DTSCS7D
|
|
01247 AND (MAP-DE-NAME GREATER SPACES DTSCS7D
|
|
01248 OR MAP-DE-ADDR1 GREATER SPACES DTSCS7D
|
|
01249 OR MAP-DE-ADDR1 GREATER SPACES DTSCS7D
|
|
01250 OR MAP-DE-CITY GREATER SPACES DTSCS7D
|
|
01251 OR MAP-DE-STATE GREATER SPACES DTSCS7D
|
|
01252 OR MAP-DE-ZIP GREATER SPACES DTSCS7D
|
|
01253 OR MAP-DE-ATTN GREATER SPACES) DTSCS7D
|
|
01254 MOVE MSG-E7D4-AREA TO WRK-MSG-AREA DTSCS7D
|
|
01255 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS7D
|
|
01256 GO TO S1000-EXIT. DTSCS7D
|
|
01257 DTSCS7D
|
|
01258 IF MAP-EMP-NO-1 GREATER SPACES DTSCS7D
|
|
01259 OR MAP-EMP-NO-2 GREATER SPACES DTSCS7D
|
|
01260 PERFORM S1110-READ-MPRF THRU S1110-EXIT DTSCS7D
|
|
01261 IF WRK-MPRF-NO-88 DTSCS7D
|
|
01262 MOVE MSG-E7D8-AREA TO WRK-MSG-AREA DTSCS7D
|
|
01263 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS7D
|
|
01264 GO TO S1000-EXIT DTSCS7D
|
|
01265 ELSE DTSCS7D
|
|
01266 MOVE WRK-EMP-NO TO LCCM-EMP-NO DTSCS7D
|
|
01267 GO TO S1000-EXIT. DTSCS7D
|
|
01268 DTSCS7D
|
|
01269 IF MAP-MAIL-LABEL EQUAL 'N' DTSCS7D
|
|
01270 IF MAP-DE-NAME GREATER SPACES DTSCS7D
|
|
01271 GO TO S1000-EXIT DTSCS7D
|
|
01272 ELSE DTSCS7D
|
|
01273 MOVE MSG-E7D10-AREA TO WRK-MSG-AREA DTSCS7D
|
|
01274 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS7D
|
|
01275 GO TO S1000-EXIT. DTSCS7D
|
|
01276 DTSCS7D
|
|
01277 IF MAP-DE-NAME NOT GREATER SPACES DTSCS7D
|
|
01278 OR MAP-DE-ADDR1 NOT GREATER SPACES DTSCS7D
|
|
01279 OR MAP-DE-CITY NOT GREATER SPACES DTSCS7D
|
|
01280 OR MAP-DE-STATE NOT GREATER SPACES DTSCS7D
|
|
01281 OR MAP-DE-STATE NOT ALPHABETIC DTSCS7D
|
|
01282 OR MAP-DE-ZIP NOT GREATER SPACES DTSCS7D
|
|
01283 MOVE MSG-E7D5-AREA TO WRK-MSG-AREA DTSCS7D
|
|
01284 PERFORM S1198-ERROR THRU S1198-EXIT DTSCS7D
|
|
01285 GO TO S1000-EXIT. DTSCS7D
|
|
01286 DTSCS7D
|
|
01287 PERFORM S1200-FORMAT-FINALIST THRU S1200-EXIT. DTSCS7D
|
|
01288 DTSCS7D
|
|
01289 IF L072-ADDRESS-VALID-88 DTSCS7D
|
|
01290 MOVE 'ADDRESS MADE STANDARD BY FINALIST' TO DTSCS7D
|
|
01291 MAP-FINL-LITERAL. DTSCS7D
|
|
01292 DTSCS7D
|
|
01293 IF L072-ADDRESS-VALID-88 DTSCS7D
|
|
01294 OR WRK-FINL-IND-OK EQUAL 'Y' DTSCS7D
|
|
01295 MOVE L072-ATTN-LINE TO MAP-DE-ATTN DTSCS7D
|
|
01296 MOVE L072-DELIV-LINE-1 TO MAP-DE-ADDR1 DTSCS7D
|
|
01297 MOVE L072-DELIV-LINE-2 TO MAP-DE-ADDR2 DTSCS7D
|
|
01298 MOVE L072-CITY TO MAP-DE-CITY DTSCS7D
|
|
01299 MOVE L072-ST TO MAP-DE-STATE DTSCS7D
|
|
01300 MOVE L072-ZIP (1:5) TO MAP-DE-ZIP DTSCS7D
|
|
01301 MOVE L072-ZIP (7:4) TO MAP-ZIP-W4 DTSCS7D
|
|
01302 ELSE DTSCS7D
|
|
01303 MOVE MSG-E7D7-AREA TO WRK-MSG-AREA DTSCS7D
|
|
01304 PERFORM S1196-ERROR THRU S1196-EXIT. DTSCS7D
|
|
01305 DTSCS7D
|
|
01306 S1000-EXIT. DTSCS7D
|
|
01307 EXIT. DTSCS7D
|
|
01308 DTSCS7D
|
|
01309 S1100-EDIT-KEY. DTSCS7D
|
|
01310 PERFORM S1101-EMP-NO THRU S1101-EXIT. DTSCS7D
|
|
01311 S1100-EXIT. DTSCS7D
|
|
01312 EXIT. DTSCS7D
|
|
01313 DTSCS7D
|
|
01314 S1101-EMP-NO. DTSCS7D
|
|
01315 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS7D
|
|
01316 DTSCS7D
|
|
01317 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS7D
|
|
01318 DTSCS7D
|
|
01319 IF L018-NO-ENTRY DTSCS7D
|
|
01320 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS7D
|
|
01321 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS7D
|
|
01322 GO TO S1101-EXIT. DTSCS7D
|
|
01323 DTSCS7D
|
|
01324 IF L018-NOT-VALID DTSCS7D
|
|
01325 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS7D
|
|
01326 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS7D
|
|
01327 GO TO S1101-EXIT. DTSCS7D
|
|
01328 DTSCS7D
|
|
01329 MOVE L018-EMP-NO TO WRK-EMP-NO. DTSCS7D
|
|
01330 S1101-EXIT. DTSCS7D
|
|
01331 EXIT. DTSCS7D
|
|
01332 DTSCS7D
|
|
01333 S1110-READ-MPRF. DTSCS7D
|
|
01334 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS7D
|
|
01335 DTSCS7D
|
|
01336 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS7D
|
|
01337 DTSCS7D
|
|
01338 SET MPRF-PRF-88 TO TRUE. DTSCS7D
|
|
01339 DTSCS7D
|
|
01340 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS7D
|
|
01341 DTSCS7D
|
|
01342 PERFORM S810-READ THRU S810-EXIT. DTSCS7D
|
|
01343 DTSCS7D
|
|
01344 IF L810-NO-REC-88 DTSCS7D
|
|
01345 SET WRK-MPRF-NO-88 TO TRUE DTSCS7D
|
|
01346 ELSE DTSCS7D
|
|
01347 MOVE MSKL-REC TO MPRF-REC DTSCS7D
|
|
01348 SET WRK-MPRF-YES-88 TO TRUE DTSCS7D
|
|
01349 PERFORM S1120-READ-MTAD THRU S1120-EXIT. DTSCS7D
|
|
01350 S1110-EXIT. DTSCS7D
|
|
01351 EXIT. DTSCS7D
|
|
01352 DTSCS7D
|
|
01353 S1120-READ-MTAD. DTSCS7D
|
|
01354 MOVE LOW-VALUES TO MTAD-KEY-AREA. DTSCS7D
|
|
01355 MOVE WRK-EMP-NO TO MTAD-EMP-NO. DTSCS7D
|
|
01356 SET MTAD-TAD-88 TO TRUE. DTSCS7D
|
|
01357 MOVE +001 TO MTAD-ID-NO. DTSCS7D
|
|
01358 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSCS7D
|
|
01359 DTSCS7D
|
|
01360 PERFORM S810-READ THRU S810-EXIT. DTSCS7D
|
|
01361 IF L810-NO-REC-88 DTSCS7D
|
|
01362 GO TO S899-ABEND. DTSCS7D
|
|
01363 DTSCS7D
|
|
01364 MOVE MSKL-REC TO MTAD-REC. DTSCS7D
|
|
01365 S1120-EXIT. EXIT. DTSCS7D
|
|
01366 DTSCS7D
|
|
01367 S1194-ERROR. DTSCS7D
|
|
01368 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-MAIL-LABEL-A. DTSCS7D
|
|
01369 DTSCS7D
|
|
01370 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA. DTSCS7D
|
|
01371 MOVE CATB-CURSOR TO MAP-MAIL-LABEL-L. DTSCS7D
|
|
01372 SET CURSOR-SET-YES TO TRUE. DTSCS7D
|
|
01373 S1194-EXIT. DTSCS7D
|
|
01374 EXIT. DTSCS7D
|
|
01375 DTSCS7D
|
|
01376 S1195-ERROR. DTSCS7D
|
|
01377 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-SSN-1-A, DTSCS7D
|
|
01378 MAP-SSN-2-A, DTSCS7D
|
|
01379 MAP-SSN-3-A. DTSCS7D
|
|
01380 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA. DTSCS7D
|
|
01381 MOVE CATB-CURSOR TO MAP-SSN-1-L. DTSCS7D
|
|
01382 SET CURSOR-SET-YES TO TRUE. DTSCS7D
|
|
01383 S1195-EXIT. DTSCS7D
|
|
01384 EXIT. DTSCS7D
|
|
01385 DTSCS7D
|
|
01386 S1196-ERROR. DTSCS7D
|
|
01387 MOVE DTSCS7D
|
|
01388 'FINALIST COULD NOT CONFIRM ADDRESS, ACCEPT? (Y OR N)' TO DTSCS7D
|
|
01389 MAP-FINL-LITERAL. DTSCS7D
|
|
01390 DTSCS7D
|
|
01391 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA. DTSCS7D
|
|
01392 MOVE CATB-CURSOR TO MAP-FINL-IND-OK-L. DTSCS7D
|
|
01393 MOVE CATB-ASKIP-NORM-MDTON TO MAP-FINL-LITERAL-A. DTSCS7D
|
|
01394 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-FINL-IND-OK-A. DTSCS7D
|
|
01395 SET CURSOR-SET-YES TO TRUE. DTSCS7D
|
|
01396 S1196-EXIT. DTSCS7D
|
|
01397 EXIT. DTSCS7D
|
|
01398 DTSCS7D
|
|
01399 S1197-ERROR. DTSCS7D
|
|
01400 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-MAIL-LABEL-A. DTSCS7D
|
|
01401 DTSCS7D
|
|
01402 IF LCCM-NO-MSG DTSCS7D
|
|
01403 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS7D
|
|
01404 MOVE CATB-CURSOR TO MAP-MAIL-LABEL-L DTSCS7D
|
|
01405 SET CURSOR-SET-YES TO TRUE. DTSCS7D
|
|
01406 S1197-EXIT. DTSCS7D
|
|
01407 EXIT. DTSCS7D
|
|
01408 DTSCS7D
|
|
01409 S1198-ERROR. DTSCS7D
|
|
01410 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-DE-NAME-A DTSCS7D
|
|
01411 MAP-DE-ADDR1-A DTSCS7D
|
|
01412 MAP-DE-ADDR2-A DTSCS7D
|
|
01413 MAP-DE-CITY-A DTSCS7D
|
|
01414 MAP-DE-STATE-A DTSCS7D
|
|
01415 MAP-DE-ZIP-A, DTSCS7D
|
|
01416 MAP-DE-ATTN-A. DTSCS7D
|
|
01417 IF LCCM-NO-MSG DTSCS7D
|
|
01418 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS7D
|
|
01419 MOVE CATB-CURSOR TO MAP-DE-NAME-L DTSCS7D
|
|
01420 SET CURSOR-SET-YES TO TRUE. DTSCS7D
|
|
01421 S1198-EXIT. DTSCS7D
|
|
01422 EXIT. DTSCS7D
|
|
01423 DTSCS7D
|
|
01424 S1199-ERROR. DTSCS7D
|
|
01425 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS7D
|
|
01426 MAP-EMP-NO-2-A. DTSCS7D
|
|
01427 DTSCS7D
|
|
01428 IF LCCM-NO-MSG DTSCS7D
|
|
01429 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS7D
|
|
01430 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L DTSCS7D
|
|
01431 SET CURSOR-SET-YES TO TRUE. DTSCS7D
|
|
01432 S1199-EXIT. DTSCS7D
|
|
01433 EXIT. DTSCS7D
|
|
01434 DTSCS7D
|
|
01435 S1200-FORMAT-FINALIST. DTSCS7D
|
|
01436 SET L072-MTAD-88 TO TRUE. DTSCS7D
|
|
01437 MOVE SPACE TO L072-ADDRESS. DTSCS7D
|
|
01438 MOVE MAP-DE-NAME TO L072-NAME. DTSCS7D
|
|
01439 MOVE MAP-DE-ATTN TO L072-ATTN-LINE. DTSCS7D
|
|
01440 MOVE MAP-DE-ADDR1 TO L072-DELIV-LINE-1. DTSCS7D
|
|
01441 MOVE MAP-DE-ADDR2 TO L072-DELIV-LINE-2. DTSCS7D
|
|
01442 MOVE MAP-DE-CITY TO L072-CITY. DTSCS7D
|
|
01443 MOVE MAP-DE-STATE TO L072-ST. DTSCS7D
|
|
01444 MOVE MAP-DE-ZIP TO L072-ZIP. DTSCS7D
|
|
01445 DTSCS7D
|
|
01446 PERFORM S072-EDIT-ADDRESS THRU S072-EXIT. DTSCS7D
|
|
01447 DTSCS7D
|
|
01448 S1200-EXIT. DTSCS7D
|
|
01449 EXIT. DTSCS7D
|
|
01450 DTSCS7D
|
|
01451 S1301-ERROR. DTSCS7D
|
|
01452 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-MAIL-LABEL-A. DTSCS7D
|
|
01453 DTSCS7D
|
|
01454 IF LCCM-NO-MSG DTSCS7D
|
|
01455 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS7D
|
|
01456 MOVE CATB-CURSOR TO MAP-MAIL-LABEL-L DTSCS7D
|
|
01457 SET CURSOR-SET-YES TO TRUE. DTSCS7D
|
|
01458 S1301-EXIT. DTSCS7D
|
|
01459 EXIT. DTSCS7D
|
|
01460 DTSCS7D
|
|
01461 S2600-WAGE-REQUEST. DTSCS7D
|
|
01462 MOVE MAP-SSN-AREA TO L020-S-SSN-AREA. DTSCS7D
|
|
01463 PERFORM S020-SCREEN-SSN THRU S020-EXIT. DTSCS7D
|
|
01464 IF L020-NO-ENTRY DTSCS7D
|
|
01465 GO TO S2600-EXIT DTSCS7D
|
|
01466 ELSE DTSCS7D
|
|
01467 IF L020-NOT-VALID DTSCS7D
|
|
01468 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS7D
|
|
01469 PERFORM S2601-ERROR THRU S2601-EXIT DTSCS7D
|
|
01470 GO TO S2600-EXIT. DTSCS7D
|
|
01471 DTSCS7D
|
|
01472 MOVE L020-SSN TO L081-CLAIMANT-SSN. DTSCS7D
|
|
01473 PERFORM S081-CLAIMANT-NAME-LOOKUP THRU S081-EXIT. DTSCS7D
|
|
01474 IF L081-NAME-FOUND DTSCS7D
|
|
01475 MOVE L081-CLAIMANT-NAME TO MAP-CLAIMANT-NAME DTSCS7D
|
|
01476 ELSE DTSCS7D
|
|
01477 MOVE SPACES TO MAP-CLAIMANT-NAME DTSCS7D
|
|
01478 MOVE MSG-E7D2-AREA TO WRK-MSG-AREA DTSCS7D
|
|
01479 PERFORM S2601-ERROR THRU S2601-EXIT DTSCS7D
|
|
01480 GO TO S2600-EXIT. DTSCS7D
|
|
01481 DTSCS7D
|
|
01482 MOVE LCCM-CURR-RUN-DATE TO L004-DATE. DTSCS7D
|
|
01483 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSCS7D
|
|
01484 ADD +4 TO L004-ABS-QTR. DTSCS7D
|
|
01485 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSCS7D
|
|
01486 DTSCS7D
|
|
01487 IF MAP-MAIL-LABEL EQUAL 'L' DTSCS7D
|
|
01488 GO TO S2600-EXIT. DTSCS7D
|
|
01489 DTSCS7D
|
|
01490 MOVE MAP-WR-YRQ1-AREA TO L016-S-YRQ-AREA. DTSCS7D
|
|
01491 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT. DTSCS7D
|
|
01492 IF L016-NO-ENTRY DTSCS7D
|
|
01493 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS7D
|
|
01494 PERFORM S2602-ERROR THRU S2602-EXIT DTSCS7D
|
|
01495 GO TO S2600-EXIT DTSCS7D
|
|
01496 ELSE DTSCS7D
|
|
01497 IF L016-NOT-VALID DTSCS7D
|
|
01498 OR L016-YRQ > L004-QTR-5-9 DTSCS7D
|
|
01499 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS7D
|
|
01500 PERFORM S2602-ERROR THRU S2602-EXIT DTSCS7D
|
|
01501 GO TO S2600-EXIT. DTSCS7D
|
|
01502 DTSCS7D
|
|
01503 IF MAP-WR-YRQ2-YR NOT GREATER SPACES DTSCS7D
|
|
01504 AND MAP-WR-YRQ2-Q NOT GREATER SPACES DTSCS7D
|
|
01505 GO TO S2600-CHECK-YRQ3. DTSCS7D
|
|
01506 DTSCS7D
|
|
01507 MOVE MAP-WR-YRQ2-AREA TO L016-S-YRQ-AREA DTSCS7D
|
|
01508 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT DTSCS7D
|
|
01509 IF L016-NO-ENTRY DTSCS7D
|
|
01510 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS7D
|
|
01511 PERFORM S2603-ERROR THRU S2603-EXIT DTSCS7D
|
|
01512 GO TO S2600-EXIT DTSCS7D
|
|
01513 ELSE DTSCS7D
|
|
01514 IF L016-NOT-VALID DTSCS7D
|
|
01515 OR L016-YRQ > L004-QTR-5-9 DTSCS7D
|
|
01516 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS7D
|
|
01517 PERFORM S2603-ERROR THRU S2603-EXIT DTSCS7D
|
|
01518 GO TO S2600-EXIT. DTSCS7D
|
|
01519 DTSCS7D
|
|
01520 S2600-CHECK-YRQ3. DTSCS7D
|
|
01521 IF MAP-WR-YRQ3-YR NOT GREATER SPACES DTSCS7D
|
|
01522 AND MAP-WR-YRQ3-Q NOT GREATER SPACES DTSCS7D
|
|
01523 GO TO S2600-CHECK-YRQ4. DTSCS7D
|
|
01524 DTSCS7D
|
|
01525 MOVE MAP-WR-YRQ3-AREA TO L016-S-YRQ-AREA DTSCS7D
|
|
01526 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT DTSCS7D
|
|
01527 IF L016-NO-ENTRY DTSCS7D
|
|
01528 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS7D
|
|
01529 PERFORM S2604-ERROR THRU S2604-EXIT DTSCS7D
|
|
01530 GO TO S2600-EXIT DTSCS7D
|
|
01531 ELSE DTSCS7D
|
|
01532 IF L016-NOT-VALID DTSCS7D
|
|
01533 OR L016-YRQ > L004-QTR-5-9 DTSCS7D
|
|
01534 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS7D
|
|
01535 PERFORM S2604-ERROR THRU S2604-EXIT DTSCS7D
|
|
01536 GO TO S2600-EXIT. DTSCS7D
|
|
01537 DTSCS7D
|
|
01538 S2600-CHECK-YRQ4. DTSCS7D
|
|
01539 IF MAP-WR-YRQ4-YR NOT GREATER SPACES DTSCS7D
|
|
01540 AND MAP-WR-YRQ4-Q NOT GREATER SPACES DTSCS7D
|
|
01541 GO TO S2600-EXIT. DTSCS7D
|
|
01542 DTSCS7D
|
|
01543 MOVE MAP-WR-YRQ4-AREA TO L016-S-YRQ-AREA DTSCS7D
|
|
01544 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT DTSCS7D
|
|
01545 IF L016-NO-ENTRY DTSCS7D
|
|
01546 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS7D
|
|
01547 PERFORM S2605-ERROR THRU S2605-EXIT DTSCS7D
|
|
01548 GO TO S2600-EXIT DTSCS7D
|
|
01549 ELSE DTSCS7D
|
|
01550 IF L016-NOT-VALID DTSCS7D
|
|
01551 OR L016-YRQ > L004-QTR-5-9 DTSCS7D
|
|
01552 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS7D
|
|
01553 PERFORM S2605-ERROR THRU S2605-EXIT DTSCS7D
|
|
01554 GO TO S2600-EXIT. DTSCS7D
|
|
01555 S2600-EXIT. DTSCS7D
|
|
01556 EXIT. DTSCS7D
|
|
01557 DTSCS7D
|
|
01558 S2601-ERROR. DTSCS7D
|
|
01559 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-SSN-1-A DTSCS7D
|
|
01560 MAP-SSN-2-A DTSCS7D
|
|
01561 MAP-SSN-3-A. DTSCS7D
|
|
01562 IF LCCM-NO-MSG DTSCS7D
|
|
01563 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS7D
|
|
01564 MOVE CATB-CURSOR TO MAP-SSN-1-L DTSCS7D
|
|
01565 SET CURSOR-SET-YES TO TRUE. DTSCS7D
|
|
01566 S2601-EXIT. EXIT. DTSCS7D
|
|
01567 DTSCS7D
|
|
01568 S2602-ERROR. DTSCS7D
|
|
01569 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-WR-YRQ1-YR-A DTSCS7D
|
|
01570 MAP-WR-YRQ1-Q-A. DTSCS7D
|
|
01571 IF LCCM-NO-MSG DTSCS7D
|
|
01572 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS7D
|
|
01573 MOVE CATB-CURSOR TO MAP-WR-YRQ1-YR-L DTSCS7D
|
|
01574 SET CURSOR-SET-YES TO TRUE. DTSCS7D
|
|
01575 S2602-EXIT. DTSCS7D
|
|
01576 EXIT. DTSCS7D
|
|
01577 S2603-ERROR. DTSCS7D
|
|
01578 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-WR-YRQ2-YR-A DTSCS7D
|
|
01579 MAP-WR-YRQ2-Q-A. DTSCS7D
|
|
01580 IF LCCM-NO-MSG DTSCS7D
|
|
01581 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS7D
|
|
01582 MOVE CATB-CURSOR TO MAP-WR-YRQ2-YR-L DTSCS7D
|
|
01583 SET CURSOR-SET-YES TO TRUE. DTSCS7D
|
|
01584 S2603-EXIT. DTSCS7D
|
|
01585 EXIT. DTSCS7D
|
|
01586 S2604-ERROR. DTSCS7D
|
|
01587 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-WR-YRQ3-YR-A DTSCS7D
|
|
01588 MAP-WR-YRQ3-Q-A. DTSCS7D
|
|
01589 IF LCCM-NO-MSG DTSCS7D
|
|
01590 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS7D
|
|
01591 MOVE CATB-CURSOR TO MAP-WR-YRQ3-YR-L DTSCS7D
|
|
01592 SET CURSOR-SET-YES TO TRUE. DTSCS7D
|
|
01593 S2604-EXIT. DTSCS7D
|
|
01594 EXIT. DTSCS7D
|
|
01595 S2605-ERROR. DTSCS7D
|
|
01596 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-WR-YRQ4-YR-A DTSCS7D
|
|
01597 MAP-WR-YRQ4-Q-A. DTSCS7D
|
|
01598 IF LCCM-NO-MSG DTSCS7D
|
|
01599 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS7D
|
|
01600 MOVE CATB-CURSOR TO MAP-WR-YRQ4-YR-L DTSCS7D
|
|
01601 SET CURSOR-SET-YES TO TRUE. DTSCS7D
|
|
01602 S2605-EXIT. DTSCS7D
|
|
01603 EXIT. DTSCS7D
|
|
01604 EJECT DTSCS7D
|
|
01605 DTSCS7D
|
|
01606 S8100-SET-LOCK-ATTRB. DTSCS7D
|
|
01607 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS7D
|
|
01608 WRK-ATB-NUM. DTSCS7D
|
|
01609 DTSCS7D
|
|
01610 PERFORM S8900-SET-ATTRB THRU S8900-EXIT. DTSCS7D
|
|
01611 DTSCS7D
|
|
01612 MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-NO-1-A DTSCS7D
|
|
01613 MAP-EMP-NO-2-A DTSCS7D
|
|
01614 MAP-GOTO-A. DTSCS7D
|
|
01615 S8100-EXIT. DTSCS7D
|
|
01616 EXIT. DTSCS7D
|
|
01617 DTSCS7D
|
|
01618 ******************************************************************DTSCS7D
|
|
01619 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS7D
|
|
01620 ******************************************************************DTSCS7D
|
|
01621 S8200-SET-UPDATE-ATTRB. DTSCS7D
|
|
01622 MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN. DTSCS7D
|
|
01623 DTSCS7D
|
|
01624 MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM. DTSCS7D
|
|
01625 DTSCS7D
|
|
01626 PERFORM S8900-SET-ATTRB THRU S8900-EXIT. DTSCS7D
|
|
01627 S8200-EXIT. DTSCS7D
|
|
01628 EXIT. DTSCS7D
|
|
01629 DTSCS7D
|
|
01630 ******************************************************************DTSCS7D
|
|
01631 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS7D
|
|
01632 ******************************************************************DTSCS7D
|
|
01633 S8300-SET-INQ-ATTRB. DTSCS7D
|
|
01634 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS7D
|
|
01635 WRK-ATB-NUM. DTSCS7D
|
|
01636 DTSCS7D
|
|
01637 PERFORM S8900-SET-ATTRB THRU S8900-EXIT. DTSCS7D
|
|
01638 S8300-EXIT. DTSCS7D
|
|
01639 EXIT. DTSCS7D
|
|
01640 DTSCS7D
|
|
01641 S8900-SET-ATTRB. DTSCS7D
|
|
01642 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS7D
|
|
01643 MAP-EMP-NO-2-A. DTSCS7D
|
|
01644 DTSCS7D
|
|
01645 MOVE CATB-ASKIP-BRT-MDTON TO MAP-PRIMARY-NAME-A, DTSCS7D
|
|
01646 MAP-TELEPHONE-A, DTSCS7D
|
|
01647 MAP-CLAIMANT-NAME-A DTSCS7D
|
|
01648 MAP-FINL-LITERAL-A. DTSCS7D
|
|
01649 DTSCS7D
|
|
01650 MOVE WRK-ATB-NUM TO MAP-SSN-1-A DTSCS7D
|
|
01651 MAP-SSN-2-A DTSCS7D
|
|
01652 MAP-SSN-3-A DTSCS7D
|
|
01653 MAP-WR-YRQ1-YR-A DTSCS7D
|
|
01654 MAP-WR-YRQ1-Q-A DTSCS7D
|
|
01655 MAP-WR-YRQ2-YR-A DTSCS7D
|
|
01656 MAP-WR-YRQ2-Q-A DTSCS7D
|
|
01657 MAP-WR-YRQ3-YR-A DTSCS7D
|
|
01658 MAP-WR-YRQ3-Q-A DTSCS7D
|
|
01659 MAP-WR-YRQ4-YR-A DTSCS7D
|
|
01660 MAP-WR-YRQ4-Q-A. DTSCS7D
|
|
01661 DTSCS7D
|
|
01662 MOVE WRK-ATB-AN TO MAP-DE-NAME-A DTSCS7D
|
|
01663 MAP-DE-ADDR1-A DTSCS7D
|
|
01664 MAP-DE-ADDR2-A DTSCS7D
|
|
01665 MAP-DE-CITY-A DTSCS7D
|
|
01666 MAP-DE-STATE-A DTSCS7D
|
|
01667 MAP-DE-ZIP-A DTSCS7D
|
|
01668 MAP-DE-ATTN-A DTSCS7D
|
|
01669 MAP-MAIL-LABEL-A DTSCS7D
|
|
01670 MAP-FINL-IND-OK-A. DTSCS7D
|
|
01671 DTSCS7D
|
|
01672 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS7D
|
|
01673 S8900-EXIT. DTSCS7D
|
|
01674 EXIT. DTSCS7D
|
|
01675 DTSCS7D
|
|
01676 ******************************************************************DTSCS7D
|
|
01677 * MAP ROUTINES *DTSCS7D
|
|
01678 ******************************************************************DTSCS7D
|
|
01679 S9100-RECEIVE. DTSCS7D
|
|
01680 SET L851-RECEIVE-88 TO TRUE. DTSCS7D
|
|
01681 DTSCS7D
|
|
01682 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS7D
|
|
01683 DTSCS7D
|
|
01684 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS7D
|
|
01685 DTSCS7D
|
|
01686 MOVE L851-AID TO LCCM-AID. DTSCS7D
|
|
01687 DTSCS7D
|
|
01688 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS7D
|
|
01689 S9100-EXIT. DTSCS7D
|
|
01690 EXIT. DTSCS7D
|
|
01691 DTSCS7D
|
|
01692 S9200-SEND-DATAONLY. DTSCS7D
|
|
01693 MOVE LOW-VALUES TO MAP-AREA. DTSCS7D
|
|
01694 DTSCS7D
|
|
01695 IF LCCM-NO-MSG DTSCS7D
|
|
01696 NEXT SENTENCE DTSCS7D
|
|
01697 ELSE DTSCS7D
|
|
01698 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS7D
|
|
01699 DTSCS7D
|
|
01700 IF CURSOR-SET-GOTO DTSCS7D
|
|
01701 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS7D
|
|
01702 ELSE DTSCS7D
|
|
01703 MOVE CATB-CURSOR TO MAP-SSN-1-L. DTSCS7D
|
|
01704 DTSCS7D
|
|
01705 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS7D
|
|
01706 DTSCS7D
|
|
01707 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS7D
|
|
01708 DTSCS7D
|
|
01709 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS7D
|
|
01710 S9200-EXIT. DTSCS7D
|
|
01711 EXIT. DTSCS7D
|
|
01712 DTSCS7D
|
|
01713 S9300-SEND-MAP. DTSCS7D
|
|
01714 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS7D
|
|
01715 DTSCS7D
|
|
01716 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS7D
|
|
01717 DTSCS7D
|
|
01718 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS7D
|
|
01719 DTSCS7D
|
|
01720 IF SCR-ACCESS-UPDATE DTSCS7D
|
|
01721 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS7D
|
|
01722 ELSE DTSCS7D
|
|
01723 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS7D
|
|
01724 DTSCS7D
|
|
01725 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCS7D
|
|
01726 DTSCS7D
|
|
01727 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS7D
|
|
01728 DTSCS7D
|
|
01729 IF CURSOR-SET-NO DTSCS7D
|
|
01730 MOVE CATB-CURSOR TO MAP-SSN-1-L. DTSCS7D
|
|
01731 DTSCS7D
|
|
01732 SET L851-SEND-88 TO TRUE. DTSCS7D
|
|
01733 DTSCS7D
|
|
01734 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS7D
|
|
01735 DTSCS7D
|
|
01736 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS7D
|
|
01737 S9300-EXIT. DTSCS7D
|
|
01738 EXIT. DTSCS7D
|
|
01739 DTSCS7D
|
|
01740 S9310-UPDATE-FKEYS. DTSCS7D
|
|
01741 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS7D
|
|
01742 DTSCS7D
|
|
01743 MOVE CFKD-ADD TO MAP-KEY-ADD. DTSCS7D
|
|
01744 DTSCS7D
|
|
01745 IF LCCM-SCR-CLEAR DTSCS7D
|
|
01746 NEXT SENTENCE DTSCS7D
|
|
01747 ELSE DTSCS7D
|
|
01748 IF LCCM-SCR-INQUIRE DTSCS7D
|
|
01749 NEXT SENTENCE DTSCS7D
|
|
01750 ELSE DTSCS7D
|
|
01751 IF LCCM-SCR-UPDATE-LOCKED DTSCS7D
|
|
01752 MOVE LOW-VALUES TO MAP-KEY-ADD DTSCS7D
|
|
01753 ELSE DTSCS7D
|
|
01754 NEXT SENTENCE. DTSCS7D
|
|
01755 S9310-EXIT. DTSCS7D
|
|
01756 EXIT. DTSCS7D
|
|
01757 DTSCS7D
|
|
01758 S9320-INQUIRY-FKEYS. DTSCS7D
|
|
01759 MOVE LOW-VALUES TO MAP-KEY-ADD. DTSCS7D
|
|
01760 DTSCS7D
|
|
01761 S9320-EXIT. DTSCS7D
|
|
01762 EXIT. DTSCS7D
|
|
01763 DTSCS7D
|
|
01764 S9330-DSCR-FIELDS. DTSCS7D
|
|
01765 MOVE LOW-VALUES TO MAP-PRIMARY-NAME, DTSCS7D
|
|
01766 MAP-CLAIMANT-NAME, DTSCS7D
|
|
01767 MAP-TELEPHONE. DTSCS7D
|
|
01768 DTSCS7D
|
|
01769 MOVE L081-CLAIMANT-NAME TO MAP-CLAIMANT-NAME CL**2
|
|
01770 DTSCS7D
|
|
01771 IF WRK-MPRF-YES-88 DTSCS7D
|
|
01772 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME DTSCS7D
|
|
01773 MOVE MTAD-VOICE-1-AREA-CD TO WRK-VOICE-AREA-CD DTSCS7D
|
|
01774 MOVE MTAD-VOICE-1-PREFIX TO WRK-VOICE-PREFIX DTSCS7D
|
|
01775 MOVE MTAD-VOICE-1-SUFFIX TO WRK-VOICE-SUFFIX DTSCS7D
|
|
01776 MOVE WRK-TELEPHONE-AREA TO MAP-TELEPHONE DTSCS7D
|
|
01777 ELSE DTSCS7D
|
|
01778 IF WRK-MPRF-NO-88 DTSCS7D
|
|
01779 MOVE '*** NOT FOUND ***' TO MAP-PRIMARY-NAME. DTSCS7D
|
|
01780 S9330-EXIT. DTSCS7D
|
|
01781 EXIT. DTSCS7D
|
|
01782 DTSCS7D
|
|
01783 S9900-PREPARE-SEND. DTSCS7D
|
|
01784 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS7D
|
|
01785 LCCM-SCR-ID. DTSCS7D
|
|
01786 DTSCS7D
|
|
01787 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS7D
|
|
01788 DTSCS7D
|
|
01789 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS7D
|
|
01790 DTSCS7D
|
|
01791 IF MAP-MAIL-LABEL NOT GREATER SPACES DTSCS7D
|
|
01792 AND WRK-NO-DEFAULT NOT EQUAL 'Y' DTSCS7D
|
|
01793 MOVE 'Y' TO MAP-MAIL-LABEL. DTSCS7D
|
|
01794 S9900-EXIT. DTSCS7D
|
|
01795 EXIT. DTSCS7D
|