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