3597 lines
281 KiB
COBOL
3597 lines
281 KiB
COBOL
00001 IDENTIFICATION DIVISION. 02/07/12
|
|
00002 PROGRAM-ID. DTSCS62. DTSCS62
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV058
|
|
00004 DATE-WRITTEN. MAY 1994. DTSCS62
|
|
00005 DATE-COMPILED. DTSCS62
|
|
00006 SKIP3 DTSCS62
|
|
00007 ***** DTSCS62
|
|
00008 * DTSCS62
|
|
00009 * FUNCTION: FIELD ASSIGNMENT INQUIRY/UPDATE DTSCS62
|
|
00010 * SCREEN PROCESSOR. DTSCS62
|
|
00011 * DTSCS62
|
|
00012 * DTSCS62
|
|
00013 * MODIFICATION LOG: DTSCS62
|
|
00014 * DTSCS62
|
|
00015 * 11/14/1998 INITIAL DEVELOPMENT. COPIED FROM MACCS62. DTSCS62
|
|
00016 * WORK ORDER: PROGRAMMER: ZL1 DTSCS62
|
|
00017 * DTSCS62
|
|
00018 * 04/20/1999 MODIFED TO ALLOW USERS WITH INQUIRY ACCESS TO DTSCS62
|
|
00019 * REQUEST TAX OR WAGES EXTRACTS BY USING THE DTSCS62
|
|
00020 * F5 KEY. DTSCS62
|
|
00021 * DTSCS62
|
|
00022 * 10/16/1999 FIX NUMEROUS BUGS AND LOGICAL INCONSISTENCIES. DTSCS62
|
|
00023 * REFERENCE: CLEANUP PROGRAMMER: EHH DTSCS62
|
|
00024 * DTSCS62
|
|
00025 * 02/21/2001 ALLOW USERS WITHOUT FIELD DESK AUTHORITY ACCESS DTSCS62
|
|
00026 * TO CERTAIN FIELDS. SEE S1000. DTSCS62
|
|
00027 * REFERENCE: REQUEST FROM FRANK PROGRAMMER: GD DTSCS62
|
|
00028 * DTSCS62
|
|
00029 * 03/05/2008 MODIFIED P6910 FOR AUTOMATIC AUDIT ASSIGNMENTS. DTSCS62
|
|
00030 * FOR AUDIT ASSIGNMENTS GENERATED BY THE SYSTEM DTSCS62
|
|
00031 * THAT ARE IN HELD STATUS, SET THE TAX AND WAGE DTSCS62
|
|
00032 * DOWNLOAD INDICATORS TO YES. DTSCS62
|
|
00033 * REFERENCE: PROGRAMMER: GD DTSCS62
|
|
00034 * DTSCS62
|
|
00035 * XX/XX/XXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS62
|
|
00036 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS62
|
|
00037 * REFERENCE: PROGRAMMER: XXX DTSCS62
|
|
00038 * DTSCS62
|
|
00039 * DTSCS62
|
|
00040 * DESCRIPTION: DTSCS62
|
|
00041 * DTSCS62
|
|
00042 * DTSCS62
|
|
00043 * CLEAR: DTSCS62
|
|
00044 * DTSCS62
|
|
00045 * FIELD DISPLAYED: NONE. DTSCS62
|
|
00046 * DTSCS62
|
|
00047 * DTSCS62
|
|
00048 * JUMP: DTSCS62
|
|
00049 * DTSCS62
|
|
00050 * DTSCS62
|
|
00051 * INQUIRY: DTSCS62
|
|
00052 * DTSCS62
|
|
00053 * CONTROL FIELD: MAP-ASSIGN-NO DTSCS62
|
|
00054 * DTSCS62
|
|
00055 * JUMP IN: DISPLAY THE FIELD ASSIGNMENT ASSOCIATED WITH DTSCS62
|
|
00056 * LCCM-ASSIGN-NO. DTSCS62
|
|
00057 * DTSCS62
|
|
00058 * ENTER: DISPLAY THE FIELD ASSIGNMENT ASSOCIATED WITH DTSCS62
|
|
00059 * MAP-ASSIGN-NO. DTSCS62
|
|
00060 * DTSCS62
|
|
00061 * JUMP OUT: NO SPECIAL PROCESSING. DTSCS62
|
|
00062 * DTSCS62
|
|
00063 * DTSCS62
|
|
00064 * LCCM DATA ELEMENT MAINTENANCE. DTSCS62
|
|
00065 * DTSCS62
|
|
00066 * STANDARD LCCM-ASSIGN-NO MAINTENANCE. DTSCS62
|
|
00067 * DTSCS62
|
|
00068 * MAINTAIN LCCM-EMP-NO IN SYNC WITH LCCM-ASSIGN-NO. DTSCS62
|
|
00069 * DTSCS62
|
|
00070 * STANDARD LCCM-RESP-OP-ID MAINTENANCE. DTSCS62
|
|
00071 * DTSCS62
|
|
00072 * STANDARD LCCM-OP-PRINTER-ID MAINTENANCE. DTSCS62
|
|
00073 * DTSCS62
|
|
00074 * DTSCS62
|
|
00075 * UPDATE: DTSCS62
|
|
00076 * DTSCS62
|
|
00077 * MOD DTSCS62
|
|
00078 * DTSCS62
|
|
00079 * UPDATE THE MFAS RECORD. DTSCS62
|
|
00080 * DTSCS62
|
|
00081 * IF MAP-COPY-CNT IS GREATER THAN ZERO, DTSCS62
|
|
00082 * THEN LINK TO DTSCU351 FOR ON-LINE PRINT OF THE FIELD DTSCS62
|
|
00083 * ASSIGNMENT MEMORANDUM. DTSCS62
|
|
00084 * DTSCS62
|
|
00085 * DTSCS62
|
|
00086 * DEL DTSCS62
|
|
00087 * DTSCS62
|
|
00088 * IF MAP-STATUS-CD = 'P', THEN DELETE IS NOT ALLOWED. DTSCS62
|
|
00089 * DTSCS62
|
|
00090 * THUS, WE CAN BE ASSURED, THAT IF DELETE IS ALLOWED, DTSCS62
|
|
00091 * NO MAUR RECORD EXISTS AND NO MAUY RECORDS EXIST. DTSCS62
|
|
00092 * DTSCS62
|
|
00093 * DELETE THE MFAS RECORD. DTSCS62
|
|
00094 * DTSCS62
|
|
00095 * IF A CORRESPONDING MFAR RECORDS EXIST, THEN DELETE DTSCS62
|
|
00096 * THE MFAR RECORDS. DTSCS62
|
|
00097 * DTSCS62
|
|
00098 * MAINTIAN MPRF-MFAS-IND. DTSCS62
|
|
00099 * DTSCS62
|
|
00100 * DTSCS62
|
|
00101 * DTSCS62
|
|
00102 * RECORDS READ: DTSCS62
|
|
00103 * DTSCS62
|
|
00104 * MASTER: DTSCS62
|
|
00105 * DTSCS62
|
|
00106 * MPRF DTSCS62
|
|
00107 * MFAS DTSCS62
|
|
00108 * MFAR DTSCS62
|
|
00109 * DTSCS62
|
|
00110 * DTSCS62
|
|
00111 * ALTERNATE INDEX: DTSCS62
|
|
00112 * DTSCS62
|
|
00113 * IFAN DTSCS62
|
|
00114 * DTSCS62
|
|
00115 * DTSCS62
|
|
00116 * REFERENCE: DTSCS62
|
|
00117 * DTSCS62
|
|
00118 * NONE. DTSCS62
|
|
00119 * DTSCS62
|
|
00120 * DTSCS62
|
|
00121 * ACCOUNTING TRANSACTION COLLECTION: DTSCS62
|
|
00122 * DTSCS62
|
|
00123 * NONE. DTSCS62
|
|
00124 * DTSCS62
|
|
00125 * DTSCS62
|
|
00126 * RECORDS UPDATED: DTSCS62
|
|
00127 * DTSCS62
|
|
00128 * MASTER: DTSCS62
|
|
00129 * DTSCS62
|
|
00130 * MPRF (REWRITE) DTSCS62
|
|
00131 * MFAS (REWRITE,DELETE) DTSCS62
|
|
00132 * MFAR (DELETE) DTSCS62
|
|
00133 * DTSCS62
|
|
00134 * DTSCS62
|
|
00135 * REFERENCE: DTSCS62
|
|
00136 * DTSCS62
|
|
00137 * NONE. DTSCS62
|
|
00138 * DTSCS62
|
|
00139 * DTSCS62
|
|
00140 * ACCOUNTING TRANSACTION COLLECTION: DTSCS62
|
|
00141 * DTSCS62
|
|
00142 * NONE. DTSCS62
|
|
00143 * DTSCS62
|
|
00144 * DTSCS62
|
|
00145 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCS62
|
|
00146 * DTSCS62
|
|
00147 * IF MAP-TAX-EXTRACT = 'Y' DTSCS62
|
|
00148 * WRITE A T021 (TRN-CD = '01') RECORD. DTSCS62
|
|
00149 * DTSCS62
|
|
00150 * IF MAP-WAGE-EXTRACT = 'Y' DTSCS62
|
|
00151 * WRITE A T021 (TRN-CD = '02') RECORD. DTSCS62
|
|
00152 * DTSCS62
|
|
00153 * IF (MFAS-STATUS-CD IS CHANGED TO 'C') DTSCS62
|
|
00154 * AND DTSCS62
|
|
00155 * (MFAS-AUDIT-88) DTSCS62
|
|
00156 * WRITE A R608 RECORD. DTSCS62
|
|
00157 * DTSCS62
|
|
00158 * DTSCS62
|
|
00159 * TEMPORARY STORAGE USAGE: DTSCS62
|
|
00160 * DTSCS62
|
|
00161 * NONE. DTSCS62
|
|
00162 * DTSCS62
|
|
00163 * DTSCS62
|
|
00164 * MODULES LINKED TO: DTSCS62
|
|
00165 * DTSCS62
|
|
00166 * DTSCU001 DATE EDIT/CONVERSION. DTSCS62
|
|
00167 * DTSCU004 QUARTER EDIT/CONVERSION. DTSCS62
|
|
00168 * DTSCU015 DATE FROM SCREEN FORMAT/EDIT. DTSCS62
|
|
00169 * DTSCU018 EMP NO FROM SCREEN FORMAT/EDIT. DTSCS62
|
|
00170 * DTSCU020 SOCIAL SECURITY NUMBER FROM SCREEN FORMAT/EDIT. DTSCS62
|
|
00171 * DTSCU022 ASSIGNMENT NO FROM SCREEN FORMAT/EDIT. DTSCS62
|
|
00172 * DTSCU024 YEAR/QUARTER RANGE FROM SCREEN FORMAT/EDIT. DTSCS62
|
|
00173 * DTSCU038 R&A CODES EDIT/DESCRIPTION. DTSCS62
|
|
00174 * DTSCU039 SIC CODE EDIT/DESCRIPTION. DTSCS62
|
|
00175 * DTSCU061 FIELD ZIP/FIELD REP ID. DTSCS62
|
|
00176 * DTSCU062 FIELD REP ID EDIT/DESCRIPTION. DTSCS62
|
|
00177 * DTSCU063 FIELD ASSIGNMENT TYPE EDIT/DESCRIPTION. DTSCS62
|
|
00178 * DTSCU071 NAME EDIT/CONVERSION. DTSCS62
|
|
00179 * DTSCU081 CLAIMANT NAME LOOKUP. DTSCS62
|
|
00180 * DTSCU082 OPERATOR ID EDIT/LOOKUP. DTSCS62
|
|
00181 * DTSCU221 MPRF-UPDATE DATA ELEMENT MAINTENANCE. DTSCS62
|
|
00182 * DTSCU331 MODIFICATION LOG UPDATE. DTSCS62
|
|
00183 * DTSCU351 FIELD ASSIGNMENT MEMORANDUM PRINT. DTSCS62
|
|
00184 * DTSCU810 MASTER FILE INPUT/OUTPUT. DTSCS62
|
|
00185 * DTSCU825 ON-LINE ACTIVITY FILE OUTPUT. DTSCS62
|
|
00186 * DTSCS62
|
|
00187 * DTSCS62
|
|
00188 DTSCS62
|
|
00189 ENVIRONMENT DIVISION. DTSCS62
|
|
00190 DTSCS62
|
|
00191 DATA DIVISION. DTSCS62
|
|
00192 DTSCS62
|
|
00193 WORKING-STORAGE SECTION. DTSCS62
|
|
001935 77 PAN-VALET PICTURE X(24) VALUE '058DTSCS62 02/07/12'. DTSCS62
|
|
00194 DTSCS62
|
|
00195 01 WRK-AREA. DTSCS62
|
|
00196 05 WRK-ABEND-CD PIC X(04) VALUE 'S62 '. DTSCS62
|
|
00197 DTSCS62
|
|
00198 05 WRK-MODULE-NAME. DTSCS62
|
|
00199 10 FILLER PIC X(05) VALUE 'DTSCS'. DTSCS62
|
|
00200 10 WRK-SCR-ID. DTSCS62
|
|
00201 15 WRK-SCR-ID-N PIC 9(02) VALUE 62. DTSCS62
|
|
00202 DTSCS62
|
|
00203 05 WRK-F03-SCR-ID PIC X(02) VALUE '60'. DTSCS62
|
|
00204 DTSCS62
|
|
00205 05 WS-REC-FOUND-IND PIC X(01). DTSCS62
|
|
00206 DTSCS62
|
|
00207 05 WRK-EXTRACT-REQ-IND PIC X(01). DTSCS62
|
|
00208 88 WRK-EXTRACT-REQ-YES-88 VALUE 'Y'. DTSCS62
|
|
00209 88 WRK-EXTRACT-REQ-NO-88 VALUE 'N'. DTSCS62
|
|
00210 DTSCS62
|
|
00211 05 SCR-ACCESS-IND PIC X(01). DTSCS62
|
|
00212 88 SCR-ACCESS-INQ VALUE '1'. DTSCS62
|
|
00213 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS62
|
|
00214 DTSCS62
|
|
00215 05 CURSOR-SET-IND PIC X(01). DTSCS62
|
|
00216 88 CURSOR-SET-YES VALUE 'Y'. DTSCS62
|
|
00217 88 CURSOR-SET-NO VALUE 'N'. DTSCS62
|
|
00218 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS62
|
|
00219 DTSCS62
|
|
00220 05 REQ-IND PIC X(01). DTSCS62
|
|
00221 88 REQ-ERROR VALUE 'O'. DTSCS62
|
|
00222 88 REQ-JUMP VALUE 'J'. DTSCS62
|
|
00223 88 REQ-INQUIRE VALUE 'I'. DTSCS62
|
|
00224 88 REQ-CLEAR VALUE 'C'. DTSCS62
|
|
00225 88 REQ-EDIT VALUE 'E'. DTSCS62
|
|
00226 88 REQ-UPDATE VALUE 'U'. DTSCS62
|
|
00227 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS62
|
|
00228 DTSCS62
|
|
00229 05 RESP-IND PIC X(01). DTSCS62
|
|
00230 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS62
|
|
00231 88 RESP-SEND-MAP VALUE 'M'. DTSCS62
|
|
00232 88 RESP-JUMP VALUE 'J'. DTSCS62
|
|
00233 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS62
|
|
00234 DTSCS62
|
|
00235 05 WRK-MSG-AREA PIC X(64). DTSCS62
|
|
00236 DTSCS62
|
|
00237 05 WRK-ATB-AN PIC X(01). DTSCS62
|
|
00238 05 WRK-ATB-NUM PIC X(01). DTSCS62
|
|
00239 DTSCS62
|
|
00240 05 WRK-ASSIGN-NO PIC S9(09) COMP-3. DTSCS62
|
|
00241 DTSCS62
|
|
00242 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSCS62
|
|
00243 DTSCS62
|
|
00244 05 WRK-CTR PIC S9(04) COMP. DTSCS62
|
|
00245 DTSCS62
|
|
00246 05 WRK-MPRF-IND PIC X(01). DTSCS62
|
|
00247 88 WRK-MPRF-YES-88 VALUE 'Y'. DTSCS62
|
|
00248 88 WRK-MPRF-NO-88 VALUE 'N'. DTSCS62
|
|
00249 DTSCS62
|
|
00250 05 WRK-UPDATE-MPRF-IND PIC X(01). DTSCS62
|
|
00251 88 WRK-UPDATE-MPRF VALUE 'Y'. DTSCS62
|
|
00252 88 WRK-UPDATE-MPRF-NO VALUE 'N'. DTSCS62
|
|
00253 DTSCS62
|
|
00254 05 WRK-ACCESS-ASSIGN-IND PIC X(01) VALUE 'Y'. DTSCS62
|
|
00255 88 WRK-ACCESS-ASSIGN-YES VALUE 'Y'. DTSCS62
|
|
00256 88 WRK-ACCESS-ASSIGN-NO VALUE 'N'. DTSCS62
|
|
00257 DTSCS62
|
|
00258 05 WRK-DISPLAY PIC 9(11). DTSCS62
|
|
00259 DTSCS62
|
|
00260 05 FILLER REDEFINES WRK-DISPLAY. DTSCS62
|
|
00261 10 FILLER PIC X(05). DTSCS62
|
|
00262 10 WRK-DISPLAY-EMP-NO-1 PIC X(03). DTSCS62
|
|
00263 10 WRK-DISPLAY-EMP-NO-2 PIC X(03). DTSCS62
|
|
00264 DTSCS62
|
|
00265 05 FILLER REDEFINES WRK-DISPLAY. DTSCS62
|
|
00266 10 FILLER PIC X(04). DTSCS62
|
|
00267 10 WRK-DISPLAY-ASSIGN-NO-1 PIC X(02). DTSCS62
|
|
00268 10 WRK-DISPLAY-ASSIGN-NO-2 PIC X(05). DTSCS62
|
|
00269 DTSCS62
|
|
00270 05 FILLER REDEFINES WRK-DISPLAY. DTSCS62
|
|
00271 10 FILLER PIC X(08). DTSCS62
|
|
00272 10 WRK-DISPLAY-QTR-YR PIC X(02). DTSCS62
|
|
00273 10 WRK-DISPLAY-QTR-Q PIC X(01). DTSCS62
|
|
00274 DTSCS62
|
|
00275 05 FILLER REDEFINES WRK-DISPLAY. DTSCS62
|
|
00276 10 FILLER PIC 9(05). DTSCS62
|
|
00277 10 WRK-DISPLAY-YR PIC 9(02). DTSCS62
|
|
00278 10 WRK-DISPLAY-MO PIC 9(02). DTSCS62
|
|
00279 10 WRK-DISPLAY-DA PIC 9(02). DTSCS62
|
|
00280 DTSCS62
|
|
00281 05 FILLER REDEFINES WRK-DISPLAY. DTSCS62
|
|
00282 10 FILLER PIC X(02). DTSCS62
|
|
00283 10 WRK-DISPLAY-SSN-1 PIC X(03). DTSCS62
|
|
00284 10 WRK-DISPLAY-SSN-2 PIC X(02). DTSCS62
|
|
00285 10 WRK-DISPLAY-SSN-3 PIC X(04). DTSCS62
|
|
00286 DTSCS62
|
|
00287 05 FILLER REDEFINES WRK-DISPLAY. DTSCS62
|
|
00288 10 FILLER PIC X(09). DTSCS62
|
|
00289 10 WRK-DISPLAY-A-YR PIC X(02). DTSCS62
|
|
00290 DTSCS62
|
|
00291 * 05 WRK-ASSIGN-TYPE-ERROR-IND PIC X(01). DTSCS62
|
|
00292 * 88 WRK-ASSIGN-TYPE-ERROR-YES VALUE 'Y'. DTSCS62
|
|
00293 * 88 WRK-ASSIGN-TYPE-ERROR-NO VALUE 'N'. DTSCS62
|
|
00294 DTSCS62
|
|
00295 05 WRK-START-DATE-ERROR-IND PIC X(01). DTSCS62
|
|
00296 88 WRK-START-DATE-ERROR-YES VALUE 'Y'. DTSCS62
|
|
00297 88 WRK-START-DATE-ERROR-NO VALUE 'N'. DTSCS62
|
|
00298 DTSCS62
|
|
00299 05 WRK-MFAS-IND PIC X(01). DTSCS62
|
|
00300 DTSCS62
|
|
00301 05 WRK-START-DATE PIC S9(09) COMP-3. DTSCS62
|
|
00302 DTSCS62
|
|
00303 05 WRK-L331-REC-OCC-ID PIC X(20). DTSCS62
|
|
00304 05 FILLER REDEFINES WRK-L331-REC-OCC-ID. DTSCS62
|
|
00305 10 WRK-L331-ASSIGN-NO PIC 9(09). DTSCS62
|
|
00306 10 FILLER PIC X(11). DTSCS62
|
|
00307 DTSCS62
|
|
00308 * SCREEN SPECIFIC ERROR MESSAGES DTSCS62
|
|
00309 DTSCS62
|
|
00310 01 MSG-LITERALS. DTSCS62
|
|
00311 DTSCS62
|
|
00312 05 MSG-E621-AREA. DTSCS62
|
|
00313 10 FILLER PIC X(04) VALUE 'E621'. DTSCS62
|
|
00314 10 FILLER PIC X(30) DTSCS62
|
|
00315 VALUE 'CAN NOT CHANGE AN AUDIT TO A N'. DTSCS62
|
|
00316 10 FILLER PIC X(30) DTSCS62
|
|
00317 VALUE 'ON-AUDIT IF PROCESSED. '. DTSCS62
|
|
00318 DTSCS62
|
|
00319 05 MSG-E622-AREA. DTSCS62
|
|
00320 10 FILLER PIC X(04) VALUE 'E622'. DTSCS62
|
|
00321 10 FILLER PIC X(30) DTSCS62
|
|
00322 VALUE 'STATUS MAY NOT BE CHANGED TO/F'. DTSCS62
|
|
00323 10 FILLER PIC X(30) DTSCS62
|
|
00324 VALUE 'ROM PROCESSED - USE AUDIT RSLT'. DTSCS62
|
|
00325 DTSCS62
|
|
00326 05 MSG-E623-AREA. DTSCS62
|
|
00327 10 FILLER PIC X(04) VALUE 'E623'. DTSCS62
|
|
00328 10 FILLER PIC X(11) VALUE DTSCS62
|
|
00329 'ASSIGNMENT '. DTSCS62
|
|
00330 10 FILLER PIC X(10) VALUE ' MODIFIED.'.DTSCS62
|
|
00331 10 WRK-PRINTER-MSG PIC X(34) VALUE SPACES. DTSCS62
|
|
00332 DTSCS62
|
|
00333 05 MSG-E624-AREA. DTSCS62
|
|
00334 10 FILLER PIC X(04) VALUE 'E624'. DTSCS62
|
|
00335 10 FILLER PIC X(30) DTSCS62
|
|
00336 VALUE 'ASSIGNMENTS WITH A STATUS OF P'. DTSCS62
|
|
00337 10 FILLER PIC X(30) DTSCS62
|
|
00338 VALUE 'ROCESSED MAY NOT BE DELETED. '. DTSCS62
|
|
00339 DTSCS62
|
|
00340 05 MSG-E625-AREA. DTSCS62
|
|
00341 10 FILLER PIC X(04) VALUE 'E625'. DTSCS62
|
|
00342 10 FILLER PIC X(30) DTSCS62
|
|
00343 VALUE 'RELATED EMPLOYER IS CHARGING O'. DTSCS62
|
|
00344 10 FILLER PIC X(30) DTSCS62
|
|
00345 VALUE 'NLY NOT ALLOWED '. DTSCS62
|
|
00346 DTSCS62
|
|
00347 05 MSG-E626-AREA. DTSCS62
|
|
00348 10 FILLER PIC X(04) VALUE 'E626'. DTSCS62
|
|
00349 10 MSG-EMP-NO-IN-ERR PIC 999B999. DTSCS62
|
|
00350 10 MSG-E626-MSG PIC X(50) VALUE DTSCS62
|
|
00351 ' ALTERNATE INDEX FILE ERROR - CONTACT DP'. DTSCS62
|
|
00352 DTSCS62
|
|
00353 05 MSG-E627-AREA. DTSCS62
|
|
00354 10 FILLER PIC X(04) VALUE 'E627'. DTSCS62
|
|
00355 10 FILLER PIC X(60) VALUE DTSCS62
|
|
00356 'COMPLETED DATE MUST BE <= CURRENT RUN DATE'. DTSCS62
|
|
00357 DTSCS62
|
|
00358 05 MSG-E628-AREA. DTSCS62
|
|
00359 10 FILLER PIC X(04) VALUE 'E628'. DTSCS62
|
|
00360 10 FILLER PIC X(60) VALUE DTSCS62
|
|
00361 'COMPLETED DATE MUST BE <= PROCESSED DATE'. DTSCS62
|
|
00362 DTSCS62
|
|
00363 05 MSG-E629-AREA. DTSCS62
|
|
00364 10 FILLER PIC X(04) VALUE 'E629'. DTSCS62
|
|
00365 10 FILLER PIC X(60) VALUE DTSCS62
|
|
00366 'YRQ RANGE REQUIRED FOR EXTRACT'. DTSCS62
|
|
00367 DTSCS62
|
|
00368 05 MSG-E630-AREA. DTSCS62
|
|
00369 10 FILLER PIC X(04) VALUE 'E630'. DTSCS62
|
|
00370 10 FILLER PIC X(60) VALUE DTSCS62
|
|
00371 'COMPLETED DATE CANNOT BE < THAN START DATE '. DTSCS62
|
|
00372 DTSCS62
|
|
00373 05 MSG-E62A-AREA. DTSCS62
|
|
00374 10 FILLER PIC X(04) VALUE 'E62A'. DTSCS62
|
|
00375 10 FILLER PIC X(60) VALUE DTSCS62
|
|
00376 'NOT AN AUDIT ASSIGNMENT ENTRY NOT ALLOWED'. DTSCS62
|
|
00377 DTSCS62
|
|
00378 05 MSG-E62B-AREA. DTSCS62
|
|
00379 10 FILLER PIC X(04) VALUE 'E62B'. DTSCS62
|
|
00380 10 FILLER PIC X(60) VALUE DTSCS62
|
|
00381 'AUDIT ASSIGNMENT ENTRY IS REQUIRED'. DTSCS62
|
|
00382 DTSCS62
|
|
00383 05 MSG-E62C-AREA. DTSCS62
|
|
00384 10 FILLER PIC X(04) VALUE 'E62C'. DTSCS62
|
|
00385 10 FILLER PIC X(60) VALUE DTSCS62
|
|
00386 'START DATE MUST BE <= ASSIGNMENT DUE DATE'. DTSCS62
|
|
00387 DTSCS62
|
|
00388 05 MSG-E62D-AREA. DTSCS62
|
|
00389 10 FILLER PIC X(04) VALUE 'E62D'. DTSCS62
|
|
00390 10 FILLER PIC X(32) VALUE DTSCS62
|
|
00391 'ASSIGNMENT STATUS IS "H" OR "K" '. DTSCS62
|
|
00392 10 FILLER PIC X(28) VALUE DTSCS62
|
|
00393 ' COMPLETED DATE NOT ALLOWED '. DTSCS62
|
|
00394 DTSCS62
|
|
00395 05 MSG-E62E-AREA. DTSCS62
|
|
00396 10 FILLER PIC X(04) VALUE 'E62E'. DTSCS62
|
|
00397 10 FILLER PIC X(30) VALUE DTSCS62
|
|
00398 'EMPLOYER WRITTEN OFF - EXTRACT'. DTSCS62
|
|
00399 10 FILLER PIC X(30) VALUE DTSCS62
|
|
00400 ' NOT ALLOWED '. DTSCS62
|
|
00401 DTSCS62
|
|
00402 05 MSG-E62F-AREA. DTSCS62
|
|
00403 10 FILLER PIC X(04) VALUE 'E62F'. DTSCS62
|
|
00404 10 FILLER PIC X(30) VALUE DTSCS62
|
|
00405 'EXTRACT REQUESTED - PLEASE SPE'. DTSCS62
|
|
00406 10 FILLER PIC X(30) VALUE DTSCS62
|
|
00407 'CIFY EXTRACT TYPE(S) '. DTSCS62
|
|
00408 DTSCS62
|
|
00409 05 MSG-E62G-AREA. DTSCS62
|
|
00410 10 FILLER PIC X(04) VALUE 'E62G'. DTSCS62
|
|
00411 10 FILLER PIC X(30) VALUE DTSCS62
|
|
00412 'AUDIT ASSIGNMENT - YRQ MODIFIC'. DTSCS62
|
|
00413 10 FILLER PIC X(30) VALUE DTSCS62
|
|
00414 'ATION NOT ALLOWED '. DTSCS62
|
|
00415 05 MSG-E62H-AREA. DTSCS62
|
|
00416 10 FILLER PIC X(04) VALUE 'E62H'. DTSCS62
|
|
00417 10 FILLER PIC X(30) VALUE DTSCS62
|
|
00418 'CANNOT CHANGE STATUS; AUDIT AS'. DTSCS62
|
|
00419 10 FILLER PIC X(30) VALUE DTSCS62
|
|
00420 'SIGNMENT PENDING. PLEASE CLOSE'. DTSCS62
|
|
00421 EJECT DTSCS62
|
|
00422 01 WRK-R907-MSG-TABLE. DTSCS62
|
|
00423 05 WRK-R907-MSG1. DTSCS62
|
|
00424 10 WRK-R907-MSG1-ID PIC X(11) DTSCS62
|
|
00425 VALUE 'DTSCS62 695'. DTSCS62
|
|
00426 10 WRK-R907-MSG1-SHORT-TEXT PIC X(20) DTSCS62
|
|
00427 VALUE 'NO IN-STATE FLD REP'. DTSCS62
|
|
00428 10 WRK-R907-MSG1-LONG-TEXT. DTSCS62
|
|
00429 15 FILLER PIC X(30) DTSCS62
|
|
00430 VALUE 'AUDIT SURVEY CARD NOT PRINTED:'. DTSCS62
|
|
00431 15 FILLER PIC X(30) DTSCS62
|
|
00432 VALUE 'NO IN-STATE FIELD REP ASSIGNED'. DTSCS62
|
|
00433 01 L001-COMM-AREA. DTSCS62
|
|
00434 ++INCLUDE DTSIL001 DTSCS62
|
|
00435 EJECT DTSCS62
|
|
00436 01 L004-COMM-AREA. DTSCS62
|
|
00437 ++INCLUDE DTSIL004 DTSCS62
|
|
00438 EJECT DTSCS62
|
|
00439 01 L015-COMM-AREA. DTSCS62
|
|
00440 ++INCLUDE DTSIL015 DTSCS62
|
|
00441 EJECT DTSCS62
|
|
00442 01 L018-COMM-AREA. DTSCS62
|
|
00443 ++INCLUDE DTSIL018 DTSCS62
|
|
00444 EJECT DTSCS62
|
|
00445 01 L020-COMM-AREA. DTSCS62
|
|
00446 ++INCLUDE DTSIL020 DTSCS62
|
|
00447 EJECT DTSCS62
|
|
00448 01 L022-COMM-AREA. DTSCS62
|
|
00449 ++INCLUDE DTSIL022 DTSCS62
|
|
00450 EJECT DTSCS62
|
|
00451 01 L024-COMM-AREA. DTSCS62
|
|
00452 ++INCLUDE DTSIL024 DTSCS62
|
|
00453 EJECT DTSCS62
|
|
00454 01 L036-COMM-AREA. DTSCS62
|
|
00455 ++INCLUDE DTSIL036 DTSCS62
|
|
00456 EJECT DTSCS62
|
|
00457 01 L038-COMM-AREA. DTSCS62
|
|
00458 ++INCLUDE DTSIL038 DTSCS62
|
|
00459 EJECT DTSCS62
|
|
00460 01 L039-COMM-AREA. DTSCS62
|
|
00461 ++INCLUDE DTSIL039 DTSCS62
|
|
00462 EJECT DTSCS62
|
|
00463 01 L061-COMM-AREA. DTSCS62
|
|
00464 ++INCLUDE DTSIL061 DTSCS62
|
|
00465 EJECT DTSCS62
|
|
00466 01 L062-COMM-AREA. DTSCS62
|
|
00467 ++INCLUDE DTSIL062 DTSCS62
|
|
00468 EJECT DTSCS62
|
|
00469 01 L063-COMM-AREA. DTSCS62
|
|
00470 ++INCLUDE DTSIL063 DTSCS62
|
|
00471 EJECT DTSCS62
|
|
00472 01 L071-COMM-AREA. DTSCS62
|
|
00473 ++INCLUDE DTSIL071 DTSCS62
|
|
00474 EJECT DTSCS62
|
|
00475 01 L081-COMM-AREA. DTSCS62
|
|
00476 ++INCLUDE DTSIL081 DTSCS62
|
|
00477 EJECT DTSCS62
|
|
00478 01 L082-COMM-AREA. DTSCS62
|
|
00479 ++INCLUDE DTSIL082 DTSCS62
|
|
00480 EJECT DTSCS62
|
|
00481 01 L111-COMM-AREA. DTSCS62
|
|
00482 ++INCLUDE DTSIL111 DTSCS62
|
|
00483 EJECT DTSCS62
|
|
00484 01 L112-COMM-AREA. DTSCS62
|
|
00485 ++INCLUDE DTSIL112 DTSCS62
|
|
00486 EJECT DTSCS62
|
|
00487 01 L221-COMM-AREA. DTSCS62
|
|
00488 ++INCLUDE DTSIL221 DTSCS62
|
|
00489 EJECT DTSCS62
|
|
00490 01 L331-COMM-AREA. DTSCS62
|
|
00491 ++INCLUDE DTSIL331 DTSCS62
|
|
00492 EJECT DTSCS62
|
|
00493 *01 L351-COMM-AREA. DTSCS62
|
|
00494 ***INCLUDE DTSIL351 DTSCS62
|
|
00495 EJECT DTSCS62
|
|
00496 01 L805-COMM-AREA. DTSCS62
|
|
00497 ++INCLUDE DTSIL805 DTSCS62
|
|
00498 EJECT DTSCS62
|
|
00499 01 L810-COMM-AREA. DTSCS62
|
|
00500 05 L810-CONTROL-BLOCK. DTSCS62
|
|
00501 ++INCLUDE DTSIL810 DTSCS62
|
|
00502 EJECT DTSCS62
|
|
00503 05 MSKL-REC. DTSCS62
|
|
00504 ++INCLUDE DTSIMSKL DTSCS62
|
|
00505 EJECT DTSCS62
|
|
00506 01 MPRF-REC. DTSCS62
|
|
00507 ++INCLUDE DTSIMPRF DTSCS62
|
|
00508 EJECT DTSCS62
|
|
00509 01 MFAS-REC. DTSCS62
|
|
00510 ++INCLUDE DTSIMFAS DTSCS62
|
|
00511 EJECT DTSCS62
|
|
00512 01 MFSL-REC. DTSCS62
|
|
00513 ++INCLUDE DTSIMFSL DTSCS62
|
|
00514 EJECT DTSCS62
|
|
00515 01 MFAR-REC. DTSCS62
|
|
00516 ++INCLUDE DTSIMFAR DTSCS62
|
|
00517 EJECT DTSCS62
|
|
00518 01 L821-COMM-AREA. DTSCS62
|
|
00519 05 L821-CONTROL-BLOCK. DTSCS62
|
|
00520 ++INCLUDE DTSIL821 DTSCS62
|
|
00521 DTSCS62
|
|
00522 05 ISKL-REC. DTSCS62
|
|
00523 ++INCLUDE DTSIISKL DTSCS62
|
|
00524 DTSCS62
|
|
00525 05 FILLER REDEFINES ISKL-REC. DTSCS62
|
|
00526 ++INCLUDE DTSIIFAN DTSCS62
|
|
00527 EJECT DTSCS62
|
|
00528 01 L825-COMM-AREA. DTSCS62
|
|
00529 05 L825-CONTROL-BLOCK. DTSCS62
|
|
00530 ++INCLUDE DTSIL825 DTSCS62
|
|
00531 DTSCS62
|
|
00532 05 RSKL-REC. DTSCS62
|
|
00533 ++INCLUDE DTSIRSK1 DTSCS62
|
|
00534 EJECT DTSCS62
|
|
00535 ***** DTSCS62
|
|
00536 * OLE REPORTS WRITTEN DTSCS62
|
|
00537 ***** DTSCS62
|
|
00538 DTSCS62
|
|
00539 01 T021-REC. DTSCS62
|
|
00540 ++INCLUDE DTSIT021 DTSCS62
|
|
00541 DTSCS62
|
|
00542 DTSCS62
|
|
00543 DTSCS62
|
|
00544 01 R608-REC. DTSCS62
|
|
00545 ++INCLUDE DTSIR608 DTSCS62
|
|
00546 DTSCS62
|
|
00547 DTSCS62
|
|
00548 DTSCS62
|
|
00549 01 R907-REC. DTSCS62
|
|
00550 ++INCLUDE DTSIR907 DTSCS62
|
|
00551 EJECT DTSCS62
|
|
00552 01 L851-COMM-AREA. DTSCS62
|
|
00553 ++INCLUDE DTSIL851 DTSCS62
|
|
00554 DTSCS62
|
|
00555 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS62
|
|
00556 ++INCLUDE DTSIS62 DTSCS62
|
|
00557 EJECT DTSCS62
|
|
00558 01 CATB-LITERALS. DTSCS62
|
|
00559 ++INCLUDE DTSICATB DTSCS62
|
|
00560 DTSCS62
|
|
00561 01 CFKD-LITERALS. DTSCS62
|
|
00562 ++INCLUDE DTSICFKD DTSCS62
|
|
00563 DTSCS62
|
|
00564 01 CECD-LITERALS. DTSCS62
|
|
00565 ++INCLUDE DTSICECD DTSCS62
|
|
00566 DTSCS62
|
|
00567 01 CPCD-LITERALS. DTSCS62
|
|
00568 ++INCLUDE DTSICPCD DTSCS62
|
|
00569 DTSCS62
|
|
00570 01 MMAX-LITERALS. DTSCS62
|
|
00571 ++INCLUDE DTSIMMAX DTSCS62
|
|
00572 EJECT DTSCS62
|
|
00573 LINKAGE SECTION. DTSCS62
|
|
00574 DTSCS62
|
|
00575 01 DFHCOMMAREA. DTSCS62
|
|
00576 ++INCLUDE DTSILCCM DTSCS62
|
|
00577 EJECT DTSCS62
|
|
00578 PROCEDURE DIVISION. DTSCS62
|
|
00579 DTSCS62
|
|
00580 MOVE +0 TO WRK-ASSIGN-NO. DTSCS62
|
|
00581 SET WRK-MPRF-NO-88 TO TRUE. DTSCS62
|
|
00582 SET WRK-EXTRACT-REQ-NO-88 TO TRUE. DTSCS62
|
|
00583 DTSCS62
|
|
00584 MOVE LOW-VALUES TO MAP-AREA. DTSCS62
|
|
00585 DTSCS62
|
|
00586 SET CURSOR-SET-NO TO TRUE. DTSCS62
|
|
00587 DTSCS62
|
|
00588 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N) DTSCS62
|
|
00589 TO SCR-ACCESS-IND. DTSCS62
|
|
00590 DTSCS62
|
|
00591 MOVE SPACE TO REQ-IND. DTSCS62
|
|
00592 DTSCS62
|
|
00593 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS62
|
|
00594 DTSCS62
|
|
00595 *----------------------------------------------------- DTSCS62
|
|
00596 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS62
|
|
00597 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS62
|
|
00598 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS62
|
|
00599 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS62
|
|
00600 * DTSCS62
|
|
00601 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS62
|
|
00602 * PROCESSED. DTSCS62
|
|
00603 * DTSCS62
|
|
00604 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS62
|
|
00605 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS62
|
|
00606 * WORK STATION OPERATOR. DTSCS62
|
|
00607 *----------------------------------------------------- DTSCS62
|
|
00608 DTSCS62
|
|
00609 MOVE SPACE TO RESP-IND. DTSCS62
|
|
00610 DTSCS62
|
|
00611 IF REQ-ERROR DTSCS62
|
|
00612 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS62
|
|
00613 ELSE DTSCS62
|
|
00614 IF REQ-JUMP DTSCS62
|
|
00615 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS62
|
|
00616 ELSE DTSCS62
|
|
00617 IF REQ-CLEAR DTSCS62
|
|
00618 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS62
|
|
00619 ELSE DTSCS62
|
|
00620 IF REQ-CURSOR-TO-GOTO DTSCS62
|
|
00621 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS62
|
|
00622 ELSE DTSCS62
|
|
00623 IF REQ-INQUIRE DTSCS62
|
|
00624 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS62
|
|
00625 ELSE DTSCS62
|
|
00626 IF REQ-EDIT DTSCS62
|
|
00627 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS62
|
|
00628 ELSE DTSCS62
|
|
00629 IF REQ-UPDATE DTSCS62
|
|
00630 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS62
|
|
00631 ELSE DTSCS62
|
|
00632 GO TO S899-ABEND. DTSCS62
|
|
00633 DTSCS62
|
|
00634 *----------------------------------------------------- DTSCS62
|
|
00635 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS62
|
|
00636 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS62
|
|
00637 *----------------------------------------------------- DTSCS62
|
|
00638 DTSCS62
|
|
00639 IF RESP-SEND-MAP DTSCS62
|
|
00640 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS62
|
|
00641 SET LCCM-END-TASK-88 TO TRUE DTSCS62
|
|
00642 ELSE DTSCS62
|
|
00643 IF RESP-SEND-MSGONLY DTSCS62
|
|
00644 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS62
|
|
00645 SET LCCM-END-TASK-88 TO TRUE DTSCS62
|
|
00646 ELSE DTSCS62
|
|
00647 IF RESP-JUMP DTSCS62
|
|
00648 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS62
|
|
00649 ELSE DTSCS62
|
|
00650 IF RESP-CURSOR-TO-GOTO DTSCS62
|
|
00651 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS62
|
|
00652 SET LCCM-END-TASK-88 TO TRUE DTSCS62
|
|
00653 ELSE DTSCS62
|
|
00654 GO TO S899-ABEND. DTSCS62
|
|
00655 DTSCS62
|
|
00656 MAINLINE-EXIT. DTSCS62
|
|
00657 DTSCS62
|
|
00658 EXEC CICS DTSCS62
|
|
00659 RETURN DTSCS62
|
|
00660 END-EXEC. DTSCS62
|
|
00661 DTSCS62
|
|
00662 GOBACK. DTSCS62
|
|
00663 EJECT DTSCS62
|
|
00664 /*****************************************************************DTSCS62
|
|
00665 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS62
|
|
00666 ******************************************************************DTSCS62
|
|
00667 P1000-ANALYZE-REQUEST. DTSCS62
|
|
00668 DTSCS62
|
|
00669 *----------------------------------------------------- DTSCS62
|
|
00670 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS62
|
|
00671 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS62
|
|
00672 * REPLACED WITH ENTER) DTSCS62
|
|
00673 *----------------------------------------------------- DTSCS62
|
|
00674 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS62
|
|
00675 SET LCCM-ENTER-88 TO TRUE DTSCS62
|
|
00676 IF LCCM-ASSIGN-NO > ZERO DTSCS62
|
|
00677 SET REQ-INQUIRE TO TRUE DTSCS62
|
|
00678 MOVE LCCM-ASSIGN-NO TO WRK-DISPLAY DTSCS62
|
|
00679 MOVE WRK-DISPLAY-ASSIGN-NO-1 TO MAP-ASSIGN-NO-1 DTSCS62
|
|
00680 MOVE WRK-DISPLAY-ASSIGN-NO-2 TO MAP-ASSIGN-NO-2 DTSCS62
|
|
00681 ELSE DTSCS62
|
|
00682 SET REQ-INQUIRE TO TRUE DTSCS62
|
|
00683 END-IF DTSCS62
|
|
00684 GO TO P1000-EXIT. DTSCS62
|
|
00685 DTSCS62
|
|
00686 *----------------------------------------------------- DTSCS62
|
|
00687 * MAP IS RECEIVED DTSCS62
|
|
00688 *----------------------------------------------------- DTSCS62
|
|
00689 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS62
|
|
00690 DTSCS62
|
|
00691 *----------------------------------------------------- DTSCS62
|
|
00692 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS62
|
|
00693 * WORK STATION DTSCS62
|
|
00694 *----------------------------------------------------- DTSCS62
|
|
00695 IF LCCM-CLEAR-88 DTSCS62
|
|
00696 SET REQ-CLEAR TO TRUE DTSCS62
|
|
00697 GO TO P1000-EXIT. DTSCS62
|
|
00698 DTSCS62
|
|
00699 *----------------------------------------------------- DTSCS62
|
|
00700 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS62
|
|
00701 *----------------------------------------------------- DTSCS62
|
|
00702 IF LCCM-SCR-UPDATE-LOCKED DTSCS62
|
|
00703 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS62
|
|
00704 GO TO P1000-EXIT. DTSCS62
|
|
00705 DTSCS62
|
|
00706 *----------------------------------------------------- DTSCS62
|
|
00707 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS62
|
|
00708 *----------------------------------------------------- DTSCS62
|
|
00709 IF LCCM-PA2-88 DTSCS62
|
|
00710 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS62
|
|
00711 GO TO P1000-EXIT. DTSCS62
|
|
00712 DTSCS62
|
|
00713 *----------------------------------------------------- DTSCS62
|
|
00714 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS62
|
|
00715 *----------------------------------------------------- DTSCS62
|
|
00716 IF LCCM-PA-88 DTSCS62
|
|
00717 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS62
|
|
00718 SET REQ-ERROR TO TRUE DTSCS62
|
|
00719 GO TO P1000-EXIT. DTSCS62
|
|
00720 DTSCS62
|
|
00721 *----------------------------------------------------- DTSCS62
|
|
00722 * IF F12 KEY IS PRESSED AND UPDATE NOT IN PROGRESS DTSCS62
|
|
00723 * CLEAR SCREEN DTSCS62
|
|
00724 *----------------------------------------------------- DTSCS62
|
|
00725 IF LCCM-F12-88 DTSCS62
|
|
00726 MOVE LOW-VALUES TO MAP-AREA DTSCS62
|
|
00727 SET REQ-CLEAR TO TRUE DTSCS62
|
|
00728 GO TO P1000-EXIT. DTSCS62
|
|
00729 DTSCS62
|
|
00730 *----------------------------------------------------- DTSCS62
|
|
00731 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS62
|
|
00732 *----------------------------------------------------- DTSCS62
|
|
00733 IF LCCM-F03-88 DTSCS62
|
|
00734 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS62
|
|
00735 SET REQ-JUMP TO TRUE DTSCS62
|
|
00736 GO TO P1000-EXIT. DTSCS62
|
|
00737 DTSCS62
|
|
00738 *----------------------------------------------------- DTSCS62
|
|
00739 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS62
|
|
00740 *----------------------------------------------------- DTSCS62
|
|
00741 IF LCCM-F04-88 DTSCS62
|
|
00742 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS62
|
|
00743 SET REQ-JUMP TO TRUE DTSCS62
|
|
00744 GO TO P1000-EXIT. DTSCS62
|
|
00745 DTSCS62
|
|
00746 *--------------------------------------------------------- DTSCS62
|
|
00747 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS62
|
|
00748 * CORRESPONDENCE SCREEN. DTSCS62
|
|
00749 *--------------------------------------------------------- DTSCS62
|
|
00750 DTSCS62
|
|
00751 IF LCCM-F14-88 DTSCS62
|
|
00752 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS62
|
|
00753 SET REQ-JUMP TO TRUE DTSCS62
|
|
00754 GO TO P1000-EXIT. DTSCS62
|
|
00755 DTSCS62
|
|
00756 *--------------------------------------------------------- DTSCS62
|
|
00757 * IF REGISTRATION INQUIRY SCREEN KEY PRESSED, DTSCS62
|
|
00758 * THEN JUMP TO REGISTRATION INQUIRY SCREEN. DTSCS62
|
|
00759 *--------------------------------------------------------- DTSCS62
|
|
00760 * DTSCS62
|
|
00761 * IF LCCM-F17-88 DTSCS62
|
|
00762 * MOVE '11' TO LCCM-REQ-SCR-ID DTSCS62
|
|
00763 * SET REQ-JUMP TO TRUE DTSCS62
|
|
00764 * GO TO P1000-EXIT. DTSCS62
|
|
00765 * DTSCS62
|
|
00766 * IF LCCM-F21-88 DTSCS62
|
|
00767 * MOVE '63' TO LCCM-REQ-SCR-ID DTSCS62
|
|
00768 * SET REQ-JUMP TO TRUE DTSCS62
|
|
00769 * GO TO P1000-EXIT. DTSCS62
|
|
00770 * DTSCS62
|
|
00771 * IF LCCM-F22-88 DTSCS62
|
|
00772 * MOVE '65' TO LCCM-REQ-SCR-ID DTSCS62
|
|
00773 * SET REQ-JUMP TO TRUE DTSCS62
|
|
00774 * GO TO P1000-EXIT. DTSCS62
|
|
00775 * DTSCS62
|
|
00776 *----------------------------------------------------- DTSCS62
|
|
00777 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS62
|
|
00778 * REQUESTED SCREEN TYPE DTSCS62
|
|
00779 *----------------------------------------------------- DTSCS62
|
|
00780 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS62
|
|
00781 NEXT SENTENCE DTSCS62
|
|
00782 ELSE DTSCS62
|
|
00783 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS62
|
|
00784 SET REQ-JUMP TO TRUE DTSCS62
|
|
00785 GO TO P1000-EXIT. DTSCS62
|
|
00786 DTSCS62
|
|
00787 *----------------------------------------------------- DTSCS62
|
|
00788 * IF REQUEST TO UPDATE THE DATA (MOD,DEL) DTSCS62
|
|
00789 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS62
|
|
00790 * FIELD STAFF HAS UPDATE ACCESS TO THIS SCREEN, DTSCS62
|
|
00791 * BUT ONLY HAS AUTHORITY TO CHANGE CERTAIN DATA DTSCS62
|
|
00792 * ELEMENTS. SEE S1000. ONLY THE FIELD DESK CAN DTSCS62
|
|
00793 * DELETE AN ASSIGNMENT. DTSCS62
|
|
00794 *----------------------------------------------------- DTSCS62
|
|
00795 DTSCS62
|
|
00796 IF LCCM-F10-88 DTSCS62
|
|
00797 OR LCCM-F23-88 DTSCS62
|
|
00798 IF SCR-ACCESS-UPDATE DTSCS62
|
|
00799 SET REQ-EDIT TO TRUE DTSCS62
|
|
00800 GO TO P1000-EXIT DTSCS62
|
|
00801 ELSE DTSCS62
|
|
00802 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS62
|
|
00803 SET REQ-ERROR TO TRUE DTSCS62
|
|
00804 GO TO P1000-EXIT. DTSCS62
|
|
00805 DTSCS62
|
|
00806 IF LCCM-F23-88 DTSCS62
|
|
00807 IF SCR-ACCESS-UPDATE DTSCS62
|
|
00808 AND LCCM-OP-IS-FLD-DESK-88 DTSCS62
|
|
00809 SET REQ-EDIT TO TRUE DTSCS62
|
|
00810 GO TO P1000-EXIT DTSCS62
|
|
00811 ELSE DTSCS62
|
|
00812 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS62
|
|
00813 SET REQ-ERROR TO TRUE DTSCS62
|
|
00814 GO TO P1000-EXIT. DTSCS62
|
|
00815 DTSCS62
|
|
00816 *----------------------------------------------------- DTSCS62
|
|
00817 * IF INQUIRY TYPE KEY PRESSED (ENTER) DTSCS62
|
|
00818 * INDICATE INQUIRY REQUEST DTSCS62
|
|
00819 *----------------------------------------------------- DTSCS62
|
|
00820 IF LCCM-ENTER-88 DTSCS62
|
|
00821 SET REQ-INQUIRE TO TRUE DTSCS62
|
|
00822 GO TO P1000-EXIT. DTSCS62
|
|
00823 DTSCS62
|
|
00824 *----------------------------------------------------- DTSCS62
|
|
00825 * ANY OTHER KEY IS INVALID DTSCS62
|
|
00826 *----------------------------------------------------- DTSCS62
|
|
00827 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS62
|
|
00828 SET REQ-ERROR TO TRUE. DTSCS62
|
|
00829 P1000-EXIT. DTSCS62
|
|
00830 EXIT. DTSCS62
|
|
00831 DTSCS62
|
|
00832 ******************************************************************DTSCS62
|
|
00833 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS62
|
|
00834 ******************************************************************DTSCS62
|
|
00835 DTSCS62
|
|
00836 P1100-UPDATE-LOCKED. DTSCS62
|
|
00837 *----------------------------------------------------- DTSCS62
|
|
00838 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS62
|
|
00839 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCS62
|
|
00840 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS62
|
|
00841 *----------------------------------------------------- DTSCS62
|
|
00842 IF LCCM-ENTER-88 OR LCCM-F12-88 DTSCS62
|
|
00843 SET REQ-UPDATE TO TRUE DTSCS62
|
|
00844 ELSE DTSCS62
|
|
00845 SET REQ-ERROR TO TRUE DTSCS62
|
|
00846 IF LCCM-SCR-MOD-LOCKED DTSCS62
|
|
00847 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS62
|
|
00848 ELSE DTSCS62
|
|
00849 IF LCCM-SCR-DEL-LOCKED DTSCS62
|
|
00850 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID DTSCS62
|
|
00851 ELSE DTSCS62
|
|
00852 GO TO S899-ABEND. DTSCS62
|
|
00853 P1100-EXIT. DTSCS62
|
|
00854 EXIT. DTSCS62
|
|
00855 /*****************************************************************DTSCS62
|
|
00856 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPOFASD. *DTSCS62
|
|
00857 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS62
|
|
00858 ******************************************************************DTSCS62
|
|
00859 DTSCS62
|
|
00860 P2000-REQUEST-ERROR. DTSCS62
|
|
00861 IF LCCM-MSG DTSCS62
|
|
00862 SET RESP-SEND-MSGONLY TO TRUE DTSCS62
|
|
00863 ELSE DTSCS62
|
|
00864 GO TO S899-ABEND. DTSCS62
|
|
00865 P2000-EXIT. DTSCS62
|
|
00866 EXIT. DTSCS62
|
|
00867 /*****************************************************************DTSCS62
|
|
00868 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS62
|
|
00869 ******************************************************************DTSCS62
|
|
00870 DTSCS62
|
|
00871 P3000-REQUEST-JUMP. DTSCS62
|
|
00872 *----------------------------------------------------- DTSCS62
|
|
00873 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS62
|
|
00874 * BY USER DTSCS62
|
|
00875 *----------------------------------------------------- DTSCS62
|
|
00876 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS62
|
|
00877 DTSCS62
|
|
00878 *----------------------------------------------------- DTSCS62
|
|
00879 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS62
|
|
00880 *----------------------------------------------------- DTSCS62
|
|
00881 IF LCCM-MSG DTSCS62
|
|
00882 SET RESP-SEND-MSGONLY TO TRUE DTSCS62
|
|
00883 SET CURSOR-SET-GOTO TO TRUE DTSCS62
|
|
00884 GO TO P3000-EXIT. DTSCS62
|
|
00885 SKIP3 DTSCS62
|
|
00886 MOVE MAP-ASSIGN-NO-AREA TO L022-S-ASSIGN-NO-AREA. DTSCS62
|
|
00887 PERFORM S022-ASSIGN-NO-FROM-SCREEN THRU S022-EXIT. DTSCS62
|
|
00888 IF L022-VALID DTSCS62
|
|
00889 MOVE L022-ASSIGN-NO TO LCCM-ASSIGN-NO. DTSCS62
|
|
00890 DTSCS62
|
|
00891 *----------------------------------------------------- DTSCS62
|
|
00892 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS62
|
|
00893 *----------------------------------------------------- DTSCS62
|
|
00894 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS62
|
|
00895 LCCM-SCR-HOLD-AREA. DTSCS62
|
|
00896 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS62
|
|
00897 SET RESP-JUMP TO TRUE. DTSCS62
|
|
00898 P3000-EXIT. DTSCS62
|
|
00899 EXIT. DTSCS62
|
|
00900 /*****************************************************************DTSCS62
|
|
00901 * CLEAR KEY WAS PRESSED *DTSCS62
|
|
00902 ******************************************************************DTSCS62
|
|
00903 DTSCS62
|
|
00904 P4000-REQUEST-CLEAR. DTSCS62
|
|
00905 DTSCS62
|
|
00906 *----------------------------------------------------- DTSCS62
|
|
00907 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS62
|
|
00908 * FIELDS FROM EARLIER REQUESTS DTSCS62
|
|
00909 *----------------------------------------------------- DTSCS62
|
|
00910 IF LCCM-ASSIGN-NO > ZERO DTSCS62
|
|
00911 MOVE LCCM-ASSIGN-NO TO WRK-DISPLAY DTSCS62
|
|
00912 MOVE WRK-DISPLAY-ASSIGN-NO-1 TO MAP-ASSIGN-NO-1 DTSCS62
|
|
00913 MOVE WRK-DISPLAY-ASSIGN-NO-2 TO MAP-ASSIGN-NO-2 DTSCS62
|
|
00914 END-IF. DTSCS62
|
|
00915 DTSCS62
|
|
00916 MOVE ZERO TO LCCM-ASSIGN-NO. DTSCS62
|
|
00917 DTSCS62
|
|
00918 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS62
|
|
00919 DTSCS62
|
|
00920 SET LCCM-SCR-CLEAR TO TRUE. DTSCS62
|
|
00921 DTSCS62
|
|
00922 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS62
|
|
00923 DTSCS62
|
|
00924 SET RESP-SEND-MAP TO TRUE. DTSCS62
|
|
00925 P4000-EXIT. DTSCS62
|
|
00926 EXIT. DTSCS62
|
|
00927 /*****************************************************************DTSCS62
|
|
00928 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS62
|
|
00929 ******************************************************************DTSCS62
|
|
00930 DTSCS62
|
|
00931 P5000-CURSOR-TO-GOTO. DTSCS62
|
|
00932 SET CURSOR-SET-GOTO TO TRUE. DTSCS62
|
|
00933 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS62
|
|
00934 P5000-EXIT. DTSCS62
|
|
00935 EXIT. DTSCS62
|
|
00936 /*****************************************************************DTSCS62
|
|
00937 * INQUIRY WAS REQUESTED *DTSCS62
|
|
00938 ******************************************************************DTSCS62
|
|
00939 DTSCS62
|
|
00940 P6000-REQUEST-INQUIRE. DTSCS62
|
|
00941 DTSCS62
|
|
00942 MOVE MAP-ASSIGN-NO-AREA TO L022-S-ASSIGN-NO-AREA. DTSCS62
|
|
00943 MOVE LOW-VALUES TO MAP-AREA. DTSCS62
|
|
00944 MOVE L022-S-ASSIGN-NO-AREA TO MAP-ASSIGN-NO-AREA. DTSCS62
|
|
00945 DTSCS62
|
|
00946 SET LCCM-SCR-CLEAR TO TRUE. DTSCS62
|
|
00947 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS62
|
|
00948 DTSCS62
|
|
00949 SET RESP-SEND-MAP TO TRUE. DTSCS62
|
|
00950 DTSCS62
|
|
00951 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS62
|
|
00952 DTSCS62
|
|
00953 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS62
|
|
00954 IF LCCM-MSG DTSCS62
|
|
00955 GO TO P6000-EXIT. DTSCS62
|
|
00956 DTSCS62
|
|
00957 MOVE WRK-ASSIGN-NO TO LCCM-ASSIGN-NO. DTSCS62
|
|
00958 DTSCS62
|
|
00959 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS62
|
|
00960 DTSCS62
|
|
00961 PERFORM S1120-READ-MFAS THRU S1120-EXIT. DTSCS62
|
|
00962 DTSCS62
|
|
00963 IF LCCM-MSG DTSCS62
|
|
00964 GO TO P6000-EXIT. DTSCS62
|
|
00965 DTSCS62
|
|
00966 PERFORM S1130-READ-MPRF THRU S1130-EXIT. DTSCS62
|
|
00967 DTSCS62
|
|
00968 IF LCCM-MSG DTSCS62
|
|
00969 GO TO P6000-EXIT. DTSCS62
|
|
00970 DTSCS62
|
|
00971 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS62
|
|
00972 DTSCS62
|
|
00973 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS62
|
|
00974 DTSCS62
|
|
00975 IF SCR-ACCESS-UPDATE DTSCS62
|
|
00976 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS62
|
|
00977 P6000-EXIT. DTSCS62
|
|
00978 EXIT. DTSCS62
|
|
00979 /*****************************************************************DTSCS62
|
|
00980 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCS62
|
|
00981 ******************************************************************DTSCS62
|
|
00982 DTSCS62
|
|
00983 P6900-CONSTRUCT-SCREEN. DTSCS62
|
|
00984 PERFORM P6910-FROM-MFAS THRU P6910-EXIT. DTSCS62
|
|
00985 P6900-EXIT. DTSCS62
|
|
00986 EXIT. DTSCS62
|
|
00987 DTSCS62
|
|
00988 P6910-FROM-MFAS. DTSCS62
|
|
00989 MOVE WRK-EMP-NO TO WRK-DISPLAY. DTSCS62
|
|
00990 DTSCS62
|
|
00991 MOVE WRK-DISPLAY-EMP-NO-1 TO MAP-EMP-NO-1. DTSCS62
|
|
00992 MOVE WRK-DISPLAY-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS62
|
|
00993 DTSCS62
|
|
00994 MOVE MFAS-STATUS-CD TO MAP-STATUS-CD. DTSCS62
|
|
00995 DTSCS62
|
|
00996 IF MFAS-FLD-REP-FIELD-DESK-88 DTSCS62
|
|
00997 IF LCCM-OP-IS-FLD-DESK-88 DTSCS62
|
|
00998 MOVE SPACE TO MAP-FLD-REP-ID DTSCS62
|
|
00999 ELSE DTSCS62
|
|
01000 MOVE MFAS-FLD-REP-ID TO MAP-FLD-REP-ID DTSCS62
|
|
01001 ELSE DTSCS62
|
|
01002 MOVE MFAS-FLD-REP-ID TO MAP-FLD-REP-ID DTSCS62
|
|
01003 END-IF. DTSCS62
|
|
01004 DTSCS62
|
|
01005 MOVE MFAS-ASSIGN-TYPE TO MAP-ASSIGN-TYPE. DTSCS62
|
|
01006 DTSCS62
|
|
01007 MOVE MFAS-ATTACHMENTS-IND TO MAP-ATTACHMENTS-IND. DTSCS62
|
|
01008 DTSCS62
|
|
01009 MOVE MFAS-SOURCE-OP-ID TO MAP-SOURCE-OP-ID. DTSCS62
|
|
01010 DTSCS62
|
|
01011 MOVE MFAS-EMP-SIZE-IND TO MAP-EMP-SIZE-IND. DTSCS62
|
|
01012 DTSCS62
|
|
01013 MOVE MFAS-START-DATE TO WRK-DISPLAY. DTSCS62
|
|
01014 MOVE WRK-DISPLAY-MO TO MAP-START-DATE-MO. DTSCS62
|
|
01015 MOVE WRK-DISPLAY-DA TO MAP-START-DATE-DA. DTSCS62
|
|
01016 MOVE WRK-DISPLAY-YR TO MAP-START-DATE-YR. DTSCS62
|
|
01017 DTSCS62
|
|
01018 IF MFAS-DUE-DATE > 0 DTSCS62
|
|
01019 MOVE MFAS-DUE-DATE TO WRK-DISPLAY DTSCS62
|
|
01020 MOVE WRK-DISPLAY-MO TO MAP-DUE-DATE-MO DTSCS62
|
|
01021 MOVE WRK-DISPLAY-DA TO MAP-DUE-DATE-DA DTSCS62
|
|
01022 MOVE WRK-DISPLAY-YR TO MAP-DUE-DATE-YR. DTSCS62
|
|
01023 DTSCS62
|
|
01024 IF MFAS-COMPLETED-DATE > +0 DTSCS62
|
|
01025 MOVE MFAS-COMPLETED-DATE TO WRK-DISPLAY DTSCS62
|
|
01026 MOVE WRK-DISPLAY-MO TO MAP-COMPLETED-DATE-MO DTSCS62
|
|
01027 MOVE WRK-DISPLAY-DA TO MAP-COMPLETED-DATE-DA DTSCS62
|
|
01028 MOVE WRK-DISPLAY-YR TO MAP-COMPLETED-DATE-YR. DTSCS62
|
|
01029 DTSCS62
|
|
01030 IF MFAS-PROCESSED-DATE > +0 DTSCS62
|
|
01031 MOVE MFAS-PROCESSED-DATE TO L001-FED-8-DATE-9 DTSCS62
|
|
01032 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCS62
|
|
01033 MOVE L001-SLASH-DATE TO MAP-PROCESSED-DATE. DTSCS62
|
|
01034 DTSCS62
|
|
01035 IF MFAS-TAX-DOWNLOAD-DATE > +0 DTSCS62
|
|
01036 MOVE MFAS-TAX-DOWNLOAD-DATE TO L001-FED-8-DATE-9 DTSCS62
|
|
01037 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCS62
|
|
01038 MOVE L001-SLASH-DATE TO MAP-TAX-EXTRACT-DATE DTSCS62
|
|
01039 ELSE DTSCS62
|
|
01040 IF MFAS-VERIF-AUDIT-88 DTSCS62
|
|
01041 AND MFAS-SOURCE-OP-ID = 'SYSTEM' DTSCS62
|
|
01042 AND MFAS-STATUS-HELD-88 DTSCS62
|
|
01043 SET MAP-TAX-EXTRACT-YES TO TRUE DTSCS62
|
|
01044 END-IF DTSCS62
|
|
01045 END-IF. DTSCS62
|
|
01046 DTSCS62
|
|
01047 IF MFAS-WAGE-DOWNLOAD-DATE > +0 DTSCS62
|
|
01048 MOVE MFAS-WAGE-DOWNLOAD-DATE TO L001-FED-8-DATE-9 DTSCS62
|
|
01049 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCS62
|
|
01050 MOVE L001-SLASH-DATE TO MAP-WAGE-EXTRACT-DATE DTSCS62
|
|
01051 ELSE DTSCS62
|
|
01052 IF MFAS-VERIF-AUDIT-88 DTSCS62
|
|
01053 AND MFAS-SOURCE-OP-ID = 'SYSTEM' DTSCS62
|
|
01054 AND MFAS-STATUS-HELD-88 DTSCS62
|
|
01055 SET MAP-WAGE-EXTRACT-YES TO TRUE DTSCS62
|
|
01056 END-IF DTSCS62
|
|
01057 END-IF. DTSCS62
|
|
01058 DTSCS62
|
|
01059 IF MFAS-CLAIMANT-SSN > 0 DTSCS62
|
|
01060 MOVE MFAS-CLAIMANT-SSN TO WRK-DISPLAY DTSCS62
|
|
01061 MOVE WRK-DISPLAY-SSN-1 TO MAP-CLAIMANT-SSN-1 DTSCS62
|
|
01062 MOVE WRK-DISPLAY-SSN-2 TO MAP-CLAIMANT-SSN-2 DTSCS62
|
|
01063 MOVE WRK-DISPLAY-SSN-3 TO MAP-CLAIMANT-SSN-3. DTSCS62
|
|
01064 DTSCS62
|
|
01065 MOVE MFAS-CLAIMANT-NAME TO MAP-CLAIMANT-NAME. DTSCS62
|
|
01066 DTSCS62
|
|
01067 MOVE MFAS-SIC-CD TO MAP-SIC-CD. DTSCS62
|
|
01068 MOVE MFAS-OWN-CD TO MAP-OWN-CD. DTSCS62
|
|
01069 MOVE MFAS-NAICS-CD TO MAP-NAICS-CD DTSCS62
|
|
01070 DTSCS62
|
|
01071 IF MFAS-RELATED-EMP-NO > + 0 DTSCS62
|
|
01072 MOVE MFAS-RELATED-EMP-NO TO WRK-DISPLAY DTSCS62
|
|
01073 MOVE WRK-DISPLAY-EMP-NO-1 TO MAP-RELATED-EMP-NO-1 DTSCS62
|
|
01074 MOVE WRK-DISPLAY-EMP-NO-2 TO MAP-RELATED-EMP-NO-2. DTSCS62
|
|
01075 DTSCS62
|
|
01076 IF MFAS-START-YRQ > +0 DTSCS62
|
|
01077 MOVE MFAS-START-YRQ TO WRK-DISPLAY DTSCS62
|
|
01078 MOVE WRK-DISPLAY-QTR-Q TO MAP-AUDIT-START-Q DTSCS62
|
|
01079 MOVE WRK-DISPLAY-QTR-YR TO MAP-AUDIT-START-YR. DTSCS62
|
|
01080 DTSCS62
|
|
01081 IF MFAS-END-YRQ > +0 DTSCS62
|
|
01082 MOVE MFAS-END-YRQ TO WRK-DISPLAY DTSCS62
|
|
01083 MOVE WRK-DISPLAY-QTR-Q TO MAP-AUDIT-END-Q DTSCS62
|
|
01084 MOVE WRK-DISPLAY-QTR-YR TO MAP-AUDIT-END-YR. DTSCS62
|
|
01085 DTSCS62
|
|
01086 PERFORM VARYING WRK-CTR FROM 1 BY 1 DTSCS62
|
|
01087 UNTIL WRK-CTR > MFAS-SEL-CNT DTSCS62
|
|
01088 MOVE MFAS-AUDIT-SEL-REASON(WRK-CTR) DTSCS62
|
|
01089 TO MAP-AUDIT-SEL-REASON(WRK-CTR) DTSCS62
|
|
01090 END-PERFORM. DTSCS62
|
|
01091 DTSCS62
|
|
01092 PERFORM VARYING WRK-CTR FROM 1 BY 1 DTSCS62
|
|
01093 UNTIL WRK-CTR > MFAS-TEXT-CNT DTSCS62
|
|
01094 MOVE MFAS-TEXT(WRK-CTR) DTSCS62
|
|
01095 TO MAP-TEXT(WRK-CTR) DTSCS62
|
|
01096 END-PERFORM. DTSCS62
|
|
01097 DTSCS62
|
|
01098 P6910-EXIT. DTSCS62
|
|
01099 EXIT. DTSCS62
|
|
01100 /*****************************************************************DTSCS62
|
|
01101 * FUNCTION KEY TO ADD, MOD OR DEL THE RECORD WAS PRESSED. *DTSCS62
|
|
01102 ******************************************************************DTSCS62
|
|
01103 DTSCS62
|
|
01104 P7000-REQUEST-EDIT. DTSCS62
|
|
01105 DTSCS62
|
|
01106 IF LCCM-F10-88 DTSCS62
|
|
01107 PERFORM P7200-EDIT-MOD THRU P7200-EXIT DTSCS62
|
|
01108 ELSE DTSCS62
|
|
01109 IF LCCM-F23-88 DTSCS62
|
|
01110 PERFORM P7300-EDIT-DEL THRU P7300-EXIT DTSCS62
|
|
01111 ELSE DTSCS62
|
|
01112 GO TO S899-ABEND. DTSCS62
|
|
01113 DTSCS62
|
|
01114 *------------------------------------------------------ DTSCS62
|
|
01115 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCS62
|
|
01116 * IN ORDER TO CONTINUE TO ATTEMPT A MOD THE SCREEN MUST DTSCS62
|
|
01117 * REMAIN IN 'INQUIRE' STATUS. DTSCS62
|
|
01118 *------------------------------------------------------ DTSCS62
|
|
01119 DTSCS62
|
|
01120 IF LCCM-MSG DTSCS62
|
|
01121 NEXT SENTENCE DTSCS62
|
|
01122 ELSE DTSCS62
|
|
01123 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCS62
|
|
01124 IF LCCM-F10-88 DTSCS62
|
|
01125 SET LCCM-SCR-MOD-LOCKED TO TRUE DTSCS62
|
|
01126 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS62
|
|
01127 ELSE DTSCS62
|
|
01128 IF LCCM-F23-88 DTSCS62
|
|
01129 SET LCCM-SCR-DEL-LOCKED TO TRUE DTSCS62
|
|
01130 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID. DTSCS62
|
|
01131 DTSCS62
|
|
01132 SET RESP-SEND-MAP TO TRUE. DTSCS62
|
|
01133 P7000-EXIT. DTSCS62
|
|
01134 EXIT. DTSCS62
|
|
01135 /*****************************************************************DTSCS62
|
|
01136 * MODIFICATION FUNCTION WAS REQUESTED *DTSCS62
|
|
01137 ******************************************************************DTSCS62
|
|
01138 DTSCS62
|
|
01139 P7200-EDIT-MOD. DTSCS62
|
|
01140 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS62
|
|
01141 DTSCS62
|
|
01142 *----------------------------------------------------- DTSCS62
|
|
01143 * MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS62
|
|
01144 * INQUIRED DTSCS62
|
|
01145 *----------------------------------------------------- DTSCS62
|
|
01146 IF NOT LCCM-SCR-INQUIRE DTSCS62
|
|
01147 MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-ID DTSCS62
|
|
01148 GO TO P7200-EXIT. DTSCS62
|
|
01149 DTSCS62
|
|
01150 *----------------------------------------------------- DTSCS62
|
|
01151 * MAP-ASSIGN-NO MAY NOT BE CHANGED DURING THE MOD DTSCS62
|
|
01152 *----------------------------------------------------- DTSCS62
|
|
01153 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS62
|
|
01154 IF LCCM-MSG DTSCS62
|
|
01155 GO TO P7200-EXIT. DTSCS62
|
|
01156 DTSCS62
|
|
01157 IF LCCM-ASSIGN-NO NOT = WRK-ASSIGN-NO DTSCS62
|
|
01158 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS62
|
|
01159 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS62
|
|
01160 GO TO P7200-EXIT. DTSCS62
|
|
01161 DTSCS62
|
|
01162 PERFORM S1120-READ-MFAS THRU S1120-EXIT. DTSCS62
|
|
01163 DTSCS62
|
|
01164 IF LCCM-MSG DTSCS62
|
|
01165 GO TO P7200-EXIT. DTSCS62
|
|
01166 DTSCS62
|
|
01167 PERFORM S1130-READ-MPRF THRU S1130-EXIT. DTSCS62
|
|
01168 DTSCS62
|
|
01169 IF LCCM-MSG DTSCS62
|
|
01170 GO TO P7200-EXIT. DTSCS62
|
|
01171 DTSCS62
|
|
01172 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS62
|
|
01173 DTSCS62
|
|
01174 P7200-EXIT. DTSCS62
|
|
01175 EXIT. DTSCS62
|
|
01176 /*****************************************************************DTSCS62
|
|
01177 * DELETE FUNCTION WAS REQUESTED *DTSCS62
|
|
01178 ******************************************************************DTSCS62
|
|
01179 DTSCS62
|
|
01180 P7300-EDIT-DEL. DTSCS62
|
|
01181 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS62
|
|
01182 DTSCS62
|
|
01183 *----------------------------------------------------- DTSCS62
|
|
01184 * DELETION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS62
|
|
01185 * INQUIRED DTSCS62
|
|
01186 *----------------------------------------------------- DTSCS62
|
|
01187 IF NOT LCCM-SCR-INQUIRE DTSCS62
|
|
01188 MOVE EMSG-DEL-PRECEDED TO LCCM-MSG-ID DTSCS62
|
|
01189 GO TO P7300-EXIT. DTSCS62
|
|
01190 DTSCS62
|
|
01191 *----------------------------------------------------- DTSCS62
|
|
01192 * MAP-ASSIGN-NO MAY NOT BE CHANGED DURING THE DEL DTSCS62
|
|
01193 *----------------------------------------------------- DTSCS62
|
|
01194 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS62
|
|
01195 IF LCCM-MSG DTSCS62
|
|
01196 GO TO P7300-EXIT. DTSCS62
|
|
01197 DTSCS62
|
|
01198 PERFORM S1120-READ-MFAS THRU S1120-EXIT. DTSCS62
|
|
01199 DTSCS62
|
|
01200 IF LCCM-MSG DTSCS62
|
|
01201 GO TO P7300-EXIT. DTSCS62
|
|
01202 DTSCS62
|
|
01203 PERFORM S1130-READ-MPRF THRU S1130-EXIT. DTSCS62
|
|
01204 DTSCS62
|
|
01205 IF LCCM-MSG DTSCS62
|
|
01206 GO TO P7300-EXIT. DTSCS62
|
|
01207 DTSCS62
|
|
01208 IF LCCM-ASSIGN-NO NOT = WRK-ASSIGN-NO DTSCS62
|
|
01209 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS62
|
|
01210 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS62
|
|
01211 GO TO P7300-EXIT. DTSCS62
|
|
01212 DTSCS62
|
|
01213 IF MFAS-STATUS-CD = 'P' DTSCS62
|
|
01214 MOVE MSG-E624-AREA TO WRK-MSG-AREA DTSCS62
|
|
01215 PERFORM S1199-ERROR THRU S1199-EXIT. DTSCS62
|
|
01216 DTSCS62
|
|
01217 P7300-EXIT. DTSCS62
|
|
01218 EXIT. DTSCS62
|
|
01219 DTSCS62
|
|
01220 /*****************************************************************DTSCS62
|
|
01221 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED *DTSCS62
|
|
01222 ******************************************************************DTSCS62
|
|
01223 P8000-REQUEST-UPDATE. DTSCS62
|
|
01224 IF LCCM-SCR-MOD-LOCKED DTSCS62
|
|
01225 PERFORM P8200-MOD THRU P8200-EXIT DTSCS62
|
|
01226 ELSE DTSCS62
|
|
01227 IF LCCM-SCR-DEL-LOCKED DTSCS62
|
|
01228 PERFORM P8300-DEL THRU P8300-EXIT DTSCS62
|
|
01229 ELSE DTSCS62
|
|
01230 GO TO S899-ABEND. DTSCS62
|
|
01231 DTSCS62
|
|
01232 SET RESP-SEND-MAP TO TRUE. DTSCS62
|
|
01233 P8000-EXIT. DTSCS62
|
|
01234 EXIT. DTSCS62
|
|
01235 /*****************************************************************DTSCS62
|
|
01236 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS62
|
|
01237 ******************************************************************DTSCS62
|
|
01238 DTSCS62
|
|
01239 P8200-MOD. DTSCS62
|
|
01240 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS62
|
|
01241 DTSCS62
|
|
01242 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS62
|
|
01243 DTSCS62
|
|
01244 IF LCCM-F12-88 DTSCS62
|
|
01245 MOVE PMSG-MOD-CANCELED TO LCCM-MSG-ID DTSCS62
|
|
01246 GO TO P8200-EXIT. DTSCS62
|
|
01247 DTSCS62
|
|
01248 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS62
|
|
01249 MOVE 'M' TO L221-UPDATE-FUNCTION. DTSCS62
|
|
01250 PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS62
|
|
01251 IF LCCM-MSG DTSCS62
|
|
01252 GO TO P8200-EXIT. DTSCS62
|
|
01253 DTSCS62
|
|
01254 PERFORM P8900-INITIALIZE-L331 THRU P8900-EXIT. DTSCS62
|
|
01255 DTSCS62
|
|
01256 PERFORM S1120-READ-MFAS THRU S1120-EXIT. DTSCS62
|
|
01257 PERFORM S1130-READ-MPRF THRU S1130-EXIT. DTSCS62
|
|
01258 DTSCS62
|
|
01259 *----------------------------------------------------- DTSCS62
|
|
01260 * OPERATORS WITH FIELD DESK AUTHORITY MAY UPDATE ALL DTSCS62
|
|
01261 * AVAILABLE FIELDS. OTHER USERS WITH UPDATE ACCESS DTSCS62
|
|
01262 * TO THIS SCREEN MAY ONLY UPDATE CERTAIN FIELDS. DTSCS62
|
|
01263 *----------------------------------------------------- DTSCS62
|
|
01264 IF LCCM-OP-IS-FLD-DESK-88 DTSCS62
|
|
01265 PERFORM P8210-BUILD-MFAS-FLD-DSK THRU P8210-EXIT DTSCS62
|
|
01266 ELSE DTSCS62
|
|
01267 PERFORM P8220-BUILD-MFAS-PARTIAL THRU P8220-EXIT. DTSCS62
|
|
01268 DTSCS62
|
|
01269 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS62
|
|
01270 DTSCS62
|
|
01271 **** IF MAP-COPIES > +0 DTSCS62
|
|
01272 **** PERFORM P8250-FIELD-MEMO THRU P8250-EXIT. DTSCS62
|
|
01273 **** END-IF. DTSCS62
|
|
01274 DTSCS62
|
|
01275 **** MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS62
|
|
01276 *** MOVE MFAS-ASSIGN-NO TO WRK-MSG-ASSIGN-NO. DTSCS62
|
|
01277 MOVE MSG-E623-AREA TO LCCM-MSG-AREA. DTSCS62
|
|
01278 DTSCS62
|
|
01279 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS62
|
|
01280 P8200-EXIT. DTSCS62
|
|
01281 EXIT. DTSCS62
|
|
01282 EJECT DTSCS62
|
|
01283 P8210-BUILD-MFAS-FLD-DSK. DTSCS62
|
|
01284 MOVE SPACES TO WRK-L331-REC-OCC-ID. DTSCS62
|
|
01285 MOVE MFAS-ASSIGN-NO TO WRK-L331-ASSIGN-NO. DTSCS62
|
|
01286 MOVE WRK-L331-REC-OCC-ID TO L331-REC-OCC-ID. DTSCS62
|
|
01287 DTSCS62
|
|
01288 MOVE MAP-COMPLETED-DATE-AREA TO L015-S-DATE-AREA. DTSCS62
|
|
01289 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS62
|
|
01290 DTSCS62
|
|
01291 IF L015-DATE NOT = MFAS-COMPLETED-DATE DTSCS62
|
|
01292 MOVE 'MFAS-COMPLETED-DATE' TO L331-FIELD-NAME DTSCS62
|
|
01293 IF MFAS-COMPLETED-DATE = ZERO DTSCS62
|
|
01294 MOVE SPACES TO L331-FROM-VALUE DTSCS62
|
|
01295 ELSE DTSCS62
|
|
01296 MOVE MFAS-COMPLETED-DATE TO L001-FED-8-DATE-9 DTSCS62
|
|
01297 SET L001-FROM-FED-8 TO TRUE DTSCS62
|
|
01298 PERFORM S001-DATE THRU S001-EXIT DTSCS62
|
|
01299 MOVE L001-SLASH-DATE TO L331-FROM-VALUE DTSCS62
|
|
01300 END-IF DTSCS62
|
|
01301 IF L015-DATE = ZERO DTSCS62
|
|
01302 MOVE SPACES TO L331-TO-VALUE DTSCS62
|
|
01303 ELSE DTSCS62
|
|
01304 MOVE L015-DATE TO L001-FED-8-DATE-9 DTSCS62
|
|
01305 SET L001-FROM-FED-8 TO TRUE DTSCS62
|
|
01306 PERFORM S001-DATE THRU S001-EXIT DTSCS62
|
|
01307 MOVE L001-SLASH-DATE TO L331-TO-VALUE DTSCS62
|
|
01308 END-IF DTSCS62
|
|
01309 PERFORM S331-WRITE-MLOG THRU S331-EXIT. DTSCS62
|
|
01310 DTSCS62
|
|
01311 MOVE L015-DATE TO MFAS-COMPLETED-DATE DTSCS62
|
|
01312 DTSCS62
|
|
01313 * INFORMATION RETURNED FROM L063 WILL BE NEEDED DTSCS62
|
|
01314 MOVE MAP-ASSIGN-TYPE TO L063-TYPE. DTSCS62
|
|
01315 PERFORM S063-FIELD-ASSIGNMENT-EDIT THRU S063-EXIT. DTSCS62
|
|
01316 MOVE L063-AUDIT-IND TO MFAS-AUDIT-IND. DTSCS62
|
|
01317 MOVE L063-ACCOUNTING-DESK-IND TO MFAS-ACCOUNTING-DESK-IND. DTSCS62
|
|
01318 DTSCS62
|
|
01319 IF MAP-ASSIGN-TYPE NOT = MFAS-ASSIGN-TYPE DTSCS62
|
|
01320 MOVE 'MFAS-ASSIGN-TYPE' TO L331-FIELD-NAME DTSCS62
|
|
01321 MOVE MFAS-ASSIGN-TYPE TO L331-FROM-VALUE DTSCS62
|
|
01322 MOVE MAP-ASSIGN-TYPE TO L331-TO-VALUE DTSCS62
|
|
01323 PERFORM S331-WRITE-MLOG THRU S331-EXIT. DTSCS62
|
|
01324 DTSCS62
|
|
01325 MOVE MAP-ASSIGN-TYPE TO MFAS-ASSIGN-TYPE. DTSCS62
|
|
01326 DTSCS62
|
|
01327 IF (MFAS-STATUS-CD = 'A' AND MAP-STATUS-CD = 'C') DTSCS62
|
|
01328 AND DTSCS62
|
|
01329 (MFAS-AUDIT-88) DTSCS62
|
|
01330 MOVE MAP-FLD-REP-ID TO L061-FLD-REP-ID DTSCS62
|
|
01331 IF L061-FLD-DESK-88 DTSCS62
|
|
01332 MOVE LENGTH OF R907-REC TO R907-LENGTH DTSCS62
|
|
01333 MOVE '695' TO R907-MSG-ID DTSCS62
|
|
01334 MOVE WRK-EMP-NO TO R907-EMP-NO DTSCS62
|
|
01335 MOVE WRK-R907-MSG1-LONG-TEXT TO R907-MSG-TEXT DTSCS62
|
|
01336 MOVE WRK-MODULE-NAME TO R907-MODULE-NAME DTSCS62
|
|
01337 MOVE R907-REC TO RSKL-REC DTSCS62
|
|
01338 PERFORM S825-WRITE THRU S825-EXIT DTSCS62
|
|
01339 ELSE DTSCS62
|
|
01340 PERFORM P9500-WRITE-R608 THRU P9500-EXIT. DTSCS62
|
|
01341 DTSCS62
|
|
01342 IF MAP-STATUS-CD NOT = MFAS-STATUS-CD DTSCS62
|
|
01343 MOVE 'MFAS-STATUS-CD' TO L331-FIELD-NAME DTSCS62
|
|
01344 MOVE MFAS-STATUS-CD TO L331-FROM-VALUE DTSCS62
|
|
01345 MOVE MAP-STATUS-CD TO L331-TO-VALUE DTSCS62
|
|
01346 PERFORM S331-WRITE-MLOG THRU S331-EXIT. DTSCS62
|
|
01347 DTSCS62
|
|
01348 MOVE MAP-STATUS-CD TO MFAS-STATUS-CD. DTSCS62
|
|
01349 DTSCS62
|
|
01350 IF MAP-FLD-REP-ID NOT = MFAS-FLD-REP-ID DTSCS62
|
|
01351 MOVE 'MFAS-FLD-REP-ID' TO L331-FIELD-NAME DTSCS62
|
|
01352 MOVE MFAS-FLD-REP-ID TO L331-FROM-VALUE DTSCS62
|
|
01353 MOVE MAP-FLD-REP-ID TO L331-TO-VALUE DTSCS62
|
|
01354 PERFORM S331-WRITE-MLOG THRU S331-EXIT. DTSCS62
|
|
01355 DTSCS62
|
|
01356 MOVE MAP-FLD-REP-ID TO MFAS-FLD-REP-ID. DTSCS62
|
|
01357 MOVE MAP-ATTACHMENTS-IND TO MFAS-ATTACHMENTS-IND. DTSCS62
|
|
01358 DTSCS62
|
|
01359 MOVE MAP-START-DATE-AREA TO L015-S-DATE-AREA. DTSCS62
|
|
01360 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS62
|
|
01361 MOVE L015-DATE TO MFAS-START-DATE. DTSCS62
|
|
01362 DTSCS62
|
|
01363 MOVE MAP-DUE-DATE-AREA TO L015-S-DATE-AREA. DTSCS62
|
|
01364 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS62
|
|
01365 DTSCS62
|
|
01366 IF L015-DATE NOT = MFAS-DUE-DATE DTSCS62
|
|
01367 MOVE 'MFAS-DUE-DATE' TO L331-FIELD-NAME DTSCS62
|
|
01368 IF MFAS-DUE-DATE = ZERO DTSCS62
|
|
01369 MOVE SPACES TO L331-FROM-VALUE DTSCS62
|
|
01370 ELSE DTSCS62
|
|
01371 MOVE MFAS-DUE-DATE TO L001-FED-8-DATE-9 DTSCS62
|
|
01372 SET L001-FROM-FED-8 TO TRUE DTSCS62
|
|
01373 PERFORM S001-DATE THRU S001-EXIT DTSCS62
|
|
01374 MOVE L001-SLASH-DATE TO L331-FROM-VALUE DTSCS62
|
|
01375 END-IF DTSCS62
|
|
01376 IF L015-DATE = ZERO DTSCS62
|
|
01377 MOVE SPACES TO L331-TO-VALUE DTSCS62
|
|
01378 ELSE DTSCS62
|
|
01379 MOVE L015-DATE TO L001-FED-8-DATE-9 DTSCS62
|
|
01380 SET L001-FROM-FED-8 TO TRUE DTSCS62
|
|
01381 PERFORM S001-DATE THRU S001-EXIT DTSCS62
|
|
01382 MOVE L001-SLASH-DATE TO L331-TO-VALUE DTSCS62
|
|
01383 END-IF DTSCS62
|
|
01384 PERFORM S331-WRITE-MLOG THRU S331-EXIT. DTSCS62
|
|
01385 DTSCS62
|
|
01386 MOVE L015-DATE TO MFAS-DUE-DATE. DTSCS62
|
|
01387 DTSCS62
|
|
01388 DTSCS62
|
|
01389 IF MAP-TAX-EXTRACT-YES DTSCS62
|
|
01390 MOVE LCCM-CURR-RUN-DATE TO MFAS-TAX-DOWNLOAD-DATE DTSCS62
|
|
01391 MOVE MFAS-TAX-DOWNLOAD-DATE TO L001-FED-8-DATE-9 DTSCS62
|
|
01392 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCS62
|
|
01393 MOVE L001-SLASH-DATE TO MAP-TAX-EXTRACT-DATE DTSCS62
|
|
01394 END-IF. DTSCS62
|
|
01395 DTSCS62
|
|
01396 IF MAP-WAGE-EXTRACT-YES DTSCS62
|
|
01397 MOVE LCCM-CURR-RUN-DATE TO MFAS-WAGE-DOWNLOAD-DATE DTSCS62
|
|
01398 MOVE MFAS-WAGE-DOWNLOAD-DATE TO L001-FED-8-DATE-9 DTSCS62
|
|
01399 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCS62
|
|
01400 MOVE L001-SLASH-DATE TO MAP-WAGE-EXTRACT-DATE DTSCS62
|
|
01401 END-IF. DTSCS62
|
|
01402 DTSCS62
|
|
01403 MOVE MAP-SOURCE-OP-ID TO MFAS-SOURCE-OP-ID. DTSCS62
|
|
01404 MOVE MAP-CLAIMANT-SSN-AREA TO L020-S-SSN-AREA. DTSCS62
|
|
01405 PERFORM S020-SSN-FROM-SCREEN THRU S020-EXIT. DTSCS62
|
|
01406 IF L020-NO-ENTRY DTSCS62
|
|
01407 MOVE +0 TO MFAS-CLAIMANT-SSN DTSCS62
|
|
01408 MOVE SPACE TO MFAS-CLAIMANT-NAME DTSCS62
|
|
01409 ELSE DTSCS62
|
|
01410 MOVE MAP-CLAIMANT-NAME TO MFAS-CLAIMANT-NAME DTSCS62
|
|
01411 MOVE L020-SSN TO MFAS-CLAIMANT-SSN DTSCS62
|
|
01412 END-IF. DTSCS62
|
|
01413 DTSCS62
|
|
01414 MOVE MAP-RELATED-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS62
|
|
01415 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS62
|
|
01416 MOVE L018-EMP-NO TO MFAS-RELATED-EMP-NO. DTSCS62
|
|
01417 DTSCS62
|
|
01418 * IF MAP-SIC-CD = LOW-VALUES OR SPACES DTSCS62
|
|
01419 * MOVE SPACES TO MFAS-SIC-CD DTSCS62
|
|
01420 * ELSE DTSCS62
|
|
01421 * MOVE MAP-SIC-CD TO MFAS-SIC-CD DTSCS62
|
|
01422 * END-IF. DTSCS62
|
|
01423 * DTSCS62
|
|
01424 * IF MAP-OWN-CD = LOW-VALUES OR SPACES DTSCS62
|
|
01425 * MOVE SPACES TO MFAS-OWN-CD DTSCS62
|
|
01426 * ELSE DTSCS62
|
|
01427 * MOVE MAP-OWN-CD TO MFAS-OWN-CD DTSCS62
|
|
01428 * END-IF. DTSCS62
|
|
01429 * DTSCS62
|
|
01430 * IF MAP-NAICS-CD = LOW-VALUES OR SPACES DTSCS62
|
|
01431 * MOVE SPACES TO MFAS-NAICS-CD DTSCS62
|
|
01432 * ELSE DTSCS62
|
|
01433 * MOVE MAP-NAICS-CD TO MFAS-NAICS-CD DTSCS62
|
|
01434 * END-IF. DTSCS62
|
|
01435 DTSCS62
|
|
01436 MOVE MAP-EMP-SIZE-IND TO MFAS-EMP-SIZE-IND. DTSCS62
|
|
01437 DTSCS62
|
|
01438 MOVE MAP-AUDIT-START-YRQ-AREA TO L024-S-START-YRQ-AREA. DTSCS62
|
|
01439 MOVE MAP-AUDIT-END-YRQ-AREA TO L024-S-END-YRQ-AREA. DTSCS62
|
|
01440 PERFORM S024-EDIT-QTR-SPAN THRU S024-EXIT. DTSCS62
|
|
01441 IF L024-START-NO-ENTRY DTSCS62
|
|
01442 MOVE +0 TO MFAS-START-YRQ DTSCS62
|
|
01443 ELSE DTSCS62
|
|
01444 MOVE L024-START-YRQ TO MFAS-START-YRQ DTSCS62
|
|
01445 END-IF. DTSCS62
|
|
01446 DTSCS62
|
|
01447 IF L024-END-NO-ENTRY DTSCS62
|
|
01448 MOVE +0 TO MFAS-END-YRQ DTSCS62
|
|
01449 ELSE DTSCS62
|
|
01450 MOVE L024-END-YRQ TO MFAS-END-YRQ DTSCS62
|
|
01451 END-IF. DTSCS62
|
|
01452 DTSCS62
|
|
01453 PERFORM VARYING WRK-CTR FROM 1 BY 1 DTSCS62
|
|
01454 UNTIL WRK-CTR > MMAX-FAS-SEL-MAX DTSCS62
|
|
01455 IF MAP-AUDIT-SEL-REASON(WRK-CTR) = LOW-VALUES OR SPACES DTSCS62
|
|
01456 MOVE SPACES TO MFAS-AUDIT-SEL-REASON (WRK-CTR) DTSCS62
|
|
01457 ELSE DTSCS62
|
|
01458 MOVE MAP-AUDIT-SEL-REASON(WRK-CTR) DTSCS62
|
|
01459 TO MFAS-AUDIT-SEL-REASON(WRK-CTR) DTSCS62
|
|
01460 MOVE WRK-CTR TO MFAS-SEL-CNT DTSCS62
|
|
01461 END-IF DTSCS62
|
|
01462 END-PERFORM DTSCS62
|
|
01463 DTSCS62
|
|
01464 MOVE LCCM-CURR-RUN-DATE TO MFAS-CHNG-DATE DTSCS62
|
|
01465 DTSCS62
|
|
01466 MOVE +0 TO MFAS-TEXT-CNT. DTSCS62
|
|
01467 DTSCS62
|
|
01468 PERFORM P8216-TEXT THRU P8216-EXIT DTSCS62
|
|
01469 VARYING WRK-CTR FROM 1 BY 1 DTSCS62
|
|
01470 UNTIL WRK-CTR > MMAX-FAS-TEXT-MAX. DTSCS62
|
|
01471 DTSCS62
|
|
01472 DTSCS62
|
|
01473 MOVE MFAS-REC TO MSKL-REC. DTSCS62
|
|
01474 PERFORM S810-REWRITE THRU S810-EXIT. DTSCS62
|
|
01475 DTSCS62
|
|
01476 IF MAP-TAX-EXTRACT-YES DTSCS62
|
|
01477 SET T021-DOWNLOAD-TAX TO TRUE DTSCS62
|
|
01478 PERFORM P9100-CREATE-T021 THRU P9100-EXIT. DTSCS62
|
|
01479 DTSCS62
|
|
01480 IF MAP-WAGE-EXTRACT-YES DTSCS62
|
|
01481 SET T021-DOWNLOAD-WAGE TO TRUE DTSCS62
|
|
01482 PERFORM P9100-CREATE-T021 THRU P9100-EXIT. DTSCS62
|
|
01483 DTSCS62
|
|
01484 P8210-EXIT. DTSCS62
|
|
01485 EXIT. DTSCS62
|
|
01486 DTSCS62
|
|
01487 P8216-TEXT. DTSCS62
|
|
01488 IF MAP-TEXT(WRK-CTR) EQUAL LOW-VALUES OR SPACES DTSCS62
|
|
01489 MOVE SPACES TO MFAS-TEXT(WRK-CTR) DTSCS62
|
|
01490 ELSE DTSCS62
|
|
01491 MOVE MAP-TEXT(WRK-CTR) TO MFAS-TEXT(WRK-CTR) DTSCS62
|
|
01492 MOVE WRK-CTR TO MFAS-TEXT-CNT. DTSCS62
|
|
01493 P8216-EXIT. EXIT. DTSCS62
|
|
01494 DTSCS62
|
|
01495 P8220-BUILD-MFAS-PARTIAL. DTSCS62
|
|
01496 MOVE SPACES TO WRK-L331-REC-OCC-ID. DTSCS62
|
|
01497 MOVE MFAS-ASSIGN-NO TO WRK-L331-ASSIGN-NO. DTSCS62
|
|
01498 MOVE WRK-L331-REC-OCC-ID TO L331-REC-OCC-ID. DTSCS62
|
|
01499 DTSCS62
|
|
01500 MOVE MAP-COMPLETED-DATE-AREA TO L015-S-DATE-AREA. DTSCS62
|
|
01501 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS62
|
|
01502 DTSCS62
|
|
01503 IF L015-DATE NOT = MFAS-COMPLETED-DATE DTSCS62
|
|
01504 MOVE 'MFAS-COMPLETED-DATE' TO L331-FIELD-NAME DTSCS62
|
|
01505 IF MFAS-COMPLETED-DATE = ZERO DTSCS62
|
|
01506 MOVE SPACES TO L331-FROM-VALUE DTSCS62
|
|
01507 ELSE DTSCS62
|
|
01508 MOVE MFAS-COMPLETED-DATE TO L001-FED-8-DATE-9 DTSCS62
|
|
01509 SET L001-FROM-FED-8 TO TRUE DTSCS62
|
|
01510 PERFORM S001-DATE THRU S001-EXIT DTSCS62
|
|
01511 MOVE L001-SLASH-DATE TO L331-FROM-VALUE DTSCS62
|
|
01512 END-IF DTSCS62
|
|
01513 IF L015-DATE = ZERO DTSCS62
|
|
01514 MOVE SPACES TO L331-TO-VALUE DTSCS62
|
|
01515 ELSE DTSCS62
|
|
01516 MOVE L015-DATE TO L001-FED-8-DATE-9 DTSCS62
|
|
01517 SET L001-FROM-FED-8 TO TRUE DTSCS62
|
|
01518 PERFORM S001-DATE THRU S001-EXIT DTSCS62
|
|
01519 MOVE L001-SLASH-DATE TO L331-TO-VALUE DTSCS62
|
|
01520 END-IF DTSCS62
|
|
01521 PERFORM S331-WRITE-MLOG THRU S331-EXIT. DTSCS62
|
|
01522 DTSCS62
|
|
01523 MOVE L015-DATE TO MFAS-COMPLETED-DATE DTSCS62
|
|
01524 DTSCS62
|
|
01525 DTSCS62
|
|
01526 IF (MFAS-STATUS-CD = 'A' AND MAP-STATUS-CD = 'C') DTSCS62
|
|
01527 AND DTSCS62
|
|
01528 (MFAS-AUDIT-88) DTSCS62
|
|
01529 MOVE MAP-FLD-REP-ID TO L061-FLD-REP-ID DTSCS62
|
|
01530 IF L061-FLD-DESK-88 DTSCS62
|
|
01531 MOVE LENGTH OF R907-REC TO R907-LENGTH DTSCS62
|
|
01532 MOVE '695' TO R907-MSG-ID DTSCS62
|
|
01533 MOVE WRK-EMP-NO TO R907-EMP-NO DTSCS62
|
|
01534 MOVE WRK-R907-MSG1-LONG-TEXT TO R907-MSG-TEXT DTSCS62
|
|
01535 MOVE WRK-MODULE-NAME TO R907-MODULE-NAME DTSCS62
|
|
01536 MOVE R907-REC TO RSKL-REC DTSCS62
|
|
01537 PERFORM S825-WRITE THRU S825-EXIT DTSCS62
|
|
01538 ELSE DTSCS62
|
|
01539 PERFORM P9500-WRITE-R608 THRU P9500-EXIT. DTSCS62
|
|
01540 DTSCS62
|
|
01541 IF MAP-STATUS-CD NOT = MFAS-STATUS-CD DTSCS62
|
|
01542 MOVE 'MFAS-STATUS-CD' TO L331-FIELD-NAME DTSCS62
|
|
01543 MOVE MFAS-STATUS-CD TO L331-FROM-VALUE DTSCS62
|
|
01544 MOVE MAP-STATUS-CD TO L331-TO-VALUE DTSCS62
|
|
01545 PERFORM S331-WRITE-MLOG THRU S331-EXIT. DTSCS62
|
|
01546 DTSCS62
|
|
01547 MOVE MAP-STATUS-CD TO MFAS-STATUS-CD. DTSCS62
|
|
01548 DTSCS62
|
|
01549 IF MAP-TAX-EXTRACT-YES DTSCS62
|
|
01550 MOVE LCCM-CURR-RUN-DATE TO MFAS-TAX-DOWNLOAD-DATE DTSCS62
|
|
01551 MOVE MFAS-TAX-DOWNLOAD-DATE TO L001-FED-8-DATE-9 DTSCS62
|
|
01552 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCS62
|
|
01553 MOVE L001-SLASH-DATE TO MAP-TAX-EXTRACT-DATE DTSCS62
|
|
01554 END-IF. DTSCS62
|
|
01555 DTSCS62
|
|
01556 IF MAP-WAGE-EXTRACT-YES DTSCS62
|
|
01557 MOVE LCCM-CURR-RUN-DATE TO MFAS-WAGE-DOWNLOAD-DATE DTSCS62
|
|
01558 MOVE MFAS-WAGE-DOWNLOAD-DATE TO L001-FED-8-DATE-9 DTSCS62
|
|
01559 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCS62
|
|
01560 MOVE L001-SLASH-DATE TO MAP-WAGE-EXTRACT-DATE DTSCS62
|
|
01561 END-IF. DTSCS62
|
|
01562 DTSCS62
|
|
01563 IF MFAS-NON-AUDIT-88 DTSCS62
|
|
01564 PERFORM P8221-YRQ-DATES THRU P8221-EXIT. DTSCS62
|
|
01565 DTSCS62
|
|
01566 MOVE LCCM-CURR-RUN-DATE TO MFAS-CHNG-DATE DTSCS62
|
|
01567 DTSCS62
|
|
01568 MOVE +0 TO MFAS-TEXT-CNT. DTSCS62
|
|
01569 DTSCS62
|
|
01570 PERFORM P8216-TEXT THRU P8216-EXIT DTSCS62
|
|
01571 VARYING WRK-CTR FROM 1 BY 1 DTSCS62
|
|
01572 UNTIL WRK-CTR > MMAX-FAS-TEXT-MAX. DTSCS62
|
|
01573 DTSCS62
|
|
01574 MOVE MFAS-REC TO MSKL-REC. DTSCS62
|
|
01575 PERFORM S810-REWRITE THRU S810-EXIT. DTSCS62
|
|
01576 DTSCS62
|
|
01577 IF MAP-TAX-EXTRACT-YES DTSCS62
|
|
01578 SET T021-DOWNLOAD-TAX TO TRUE DTSCS62
|
|
01579 PERFORM P9100-CREATE-T021 THRU P9100-EXIT. DTSCS62
|
|
01580 DTSCS62
|
|
01581 IF MAP-WAGE-EXTRACT-YES DTSCS62
|
|
01582 SET T021-DOWNLOAD-WAGE TO TRUE DTSCS62
|
|
01583 PERFORM P9100-CREATE-T021 THRU P9100-EXIT. DTSCS62
|
|
01584 DTSCS62
|
|
01585 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT. DTSCS62
|
|
01586 DTSCS62
|
|
01587 P8220-EXIT. DTSCS62
|
|
01588 EXIT. DTSCS62
|
|
01589 DTSCS62
|
|
01590 P8221-YRQ-DATES. DTSCS62
|
|
01591 MOVE MAP-AUDIT-START-YRQ-AREA TO L024-S-START-YRQ-AREA. DTSCS62
|
|
01592 MOVE MAP-AUDIT-END-YRQ-AREA TO L024-S-END-YRQ-AREA. DTSCS62
|
|
01593 PERFORM S024-EDIT-QTR-SPAN THRU S024-EXIT. DTSCS62
|
|
01594 IF L024-START-NO-ENTRY DTSCS62
|
|
01595 NEXT SENTENCE DTSCS62
|
|
01596 ELSE DTSCS62
|
|
01597 MOVE L024-START-YRQ TO MFAS-START-YRQ DTSCS62
|
|
01598 END-IF. DTSCS62
|
|
01599 DTSCS62
|
|
01600 IF L024-END-NO-ENTRY DTSCS62
|
|
01601 NEXT SENTENCE DTSCS62
|
|
01602 ELSE DTSCS62
|
|
01603 MOVE L024-END-YRQ TO MFAS-END-YRQ DTSCS62
|
|
01604 END-IF. DTSCS62
|
|
01605 DTSCS62
|
|
01606 P8221-EXIT. DTSCS62
|
|
01607 EXIT. DTSCS62
|
|
01608 *P8250-FIELD-MEMO. DTSCS62
|
|
01609 *****MOVE MFAS-EMP-NO TO L351-EMP-NO. DTSCS62
|
|
01610 *****MOVE MFAS-ASSIGN-NO TO L351-ASSIGN-NO. DTSCS62
|
|
01611 *****MOVE MAP-PRINTER-ID TO L351-PRINTER-ID. DTSCS62
|
|
01612 *****MOVE MAP-COPIES TO L351-COPY-CNT. DTSCS62
|
|
01613 *****MOVE LCCM-TASK-START-DISP-DATE TO L351-TASK-START-DISP-DATE. DTSCS62
|
|
01614 *****MOVE LCCM-TASK-START-DISP-TIME TO L351-TASK-START-DISP-TIME. DTSCS62
|
|
01615 *****MOVE LCCM-TS-NAME-PREFIX TO L351-TS-NAME-PREFIX. DTSCS62
|
|
01616 DTSCS62
|
|
01617 *****PERFORM S351-PRINT THRU S351-EXIT. DTSCS62
|
|
01618 DTSCS62
|
|
01619 *****IF L351-PRINT-FAILED DTSCS62
|
|
01620 ********MOVE ' (BUT THE PRINT FAILED!)' TO WRK-PRINTER-MSG. DTSCS62
|
|
01621 *P8250-EXIT. EXIT. DTSCS62
|
|
01622 DTSCS62
|
|
01623 /*****************************************************************DTSCS62
|
|
01624 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS62
|
|
01625 ******************************************************************DTSCS62
|
|
01626 DTSCS62
|
|
01627 P8300-DEL. DTSCS62
|
|
01628 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS62
|
|
01629 DTSCS62
|
|
01630 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS62
|
|
01631 DTSCS62
|
|
01632 IF LCCM-F12-88 DTSCS62
|
|
01633 MOVE PMSG-DEL-CANCELED TO LCCM-MSG-ID DTSCS62
|
|
01634 GO TO P8300-EXIT. DTSCS62
|
|
01635 DTSCS62
|
|
01636 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS62
|
|
01637 DTSCS62
|
|
01638 MOVE 'D' TO L221-UPDATE-FUNCTION. DTSCS62
|
|
01639 PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS62
|
|
01640 IF LCCM-MSG DTSCS62
|
|
01641 GO TO P8300-EXIT. DTSCS62
|
|
01642 DTSCS62
|
|
01643 PERFORM S1120-READ-MFAS THRU S1120-EXIT. DTSCS62
|
|
01644 PERFORM S810-DELETE THRU S810-EXIT. DTSCS62
|
|
01645 DTSCS62
|
|
01646 PERFORM P8310-DELETE-MFAR THRU P8310-EXIT. DTSCS62
|
|
01647 PERFORM P8320-CHECK-OTHER THRU P8320-EXIT. DTSCS62
|
|
01648 DTSCS62
|
|
01649 DTSCS62
|
|
01650 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS62
|
|
01651 DTSCS62
|
|
01652 MOVE LOW-VALUES TO MAP-AREA. DTSCS62
|
|
01653 DTSCS62
|
|
01654 MOVE WRK-ASSIGN-NO TO WRK-DISPLAY. DTSCS62
|
|
01655 MOVE WRK-DISPLAY-ASSIGN-NO-1 TO MAP-ASSIGN-NO-1. DTSCS62
|
|
01656 MOVE WRK-DISPLAY-ASSIGN-NO-2 TO MAP-ASSIGN-NO-2. DTSCS62
|
|
01657 DTSCS62
|
|
01658 DTSCS62
|
|
01659 SET LCCM-SCR-CLEAR TO TRUE. DTSCS62
|
|
01660 DTSCS62
|
|
01661 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS62
|
|
01662 DTSCS62
|
|
01663 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS62
|
|
01664 DTSCS62
|
|
01665 MOVE PMSG-DEL-SUCCESSFUL TO LCCM-MSG-ID. DTSCS62
|
|
01666 P8300-EXIT. DTSCS62
|
|
01667 EXIT. DTSCS62
|
|
01668 EJECT DTSCS62
|
|
01669 DTSCS62
|
|
01670 P8310-DELETE-MFAR. DTSCS62
|
|
01671 MOVE LOW-VALUES TO MFAR-KEY-AREA. DTSCS62
|
|
01672 MOVE MFAS-EMP-NO TO MFAR-EMP-NO. DTSCS62
|
|
01673 MOVE MFAS-ASSIGN-NO TO MFAR-ASSIGN-NO. DTSCS62
|
|
01674 SET MFAR-FAR-88 TO TRUE. DTSCS62
|
|
01675 MOVE MFAR-KEY-AREA TO MSKL-KEY-AREA. DTSCS62
|
|
01676 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS62
|
|
01677 PERFORM P8311-LOOP THRU P8311-EXIT DTSCS62
|
|
01678 UNTIL L810-NO-REC-88. DTSCS62
|
|
01679 P8310-EXIT. DTSCS62
|
|
01680 EXIT. DTSCS62
|
|
01681 EJECT DTSCS62
|
|
01682 DTSCS62
|
|
01683 P8311-LOOP. DTSCS62
|
|
01684 MOVE MSKL-REC TO MFAR-REC. DTSCS62
|
|
01685 DTSCS62
|
|
01686 IF MFAR-ASSIGN-NO = MFAS-ASSIGN-NO DTSCS62
|
|
01687 NEXT SENTENCE DTSCS62
|
|
01688 ELSE DTSCS62
|
|
01689 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS62
|
|
01690 SET L810-NO-REC-88 TO TRUE DTSCS62
|
|
01691 GO TO P8311-EXIT. DTSCS62
|
|
01692 DTSCS62
|
|
01693 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS62
|
|
01694 PERFORM S810-DELETE THRU S810-EXIT. DTSCS62
|
|
01695 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS62
|
|
01696 P8311-EXIT. DTSCS62
|
|
01697 EXIT. DTSCS62
|
|
01698 EJECT DTSCS62
|
|
01699 DTSCS62
|
|
01700 P8320-CHECK-OTHER. DTSCS62
|
|
01701 PERFORM S1130-READ-MPRF THRU S1130-EXIT. DTSCS62
|
|
01702 DTSCS62
|
|
01703 MOVE MPRF-MFAS-IND TO WRK-MFAS-IND. DTSCS62
|
|
01704 DTSCS62
|
|
01705 MOVE LOW-VALUES TO MFAS-KEY-AREA. DTSCS62
|
|
01706 MOVE WRK-EMP-NO TO MFAS-EMP-NO. DTSCS62
|
|
01707 SET MFAS-FAS-88 TO TRUE. DTSCS62
|
|
01708 MOVE MFAS-KEY-AREA TO MSKL-KEY-AREA. DTSCS62
|
|
01709 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS62
|
|
01710 IF L810-OK-88 DTSCS62
|
|
01711 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS62
|
|
01712 SET MPRF-MFAS-EXISTS-88 TO TRUE DTSCS62
|
|
01713 ELSE DTSCS62
|
|
01714 SET MPRF-NO-MFAS-88 TO TRUE. DTSCS62
|
|
01715 IF WRK-MFAS-IND = MPRF-MFAS-IND DTSCS62
|
|
01716 NEXT SENTENCE DTSCS62
|
|
01717 ELSE DTSCS62
|
|
01718 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE DTSCS62
|
|
01719 MOVE MPRF-REC TO MSKL-REC DTSCS62
|
|
01720 PERFORM S810-REWRITE THRU S810-EXIT. DTSCS62
|
|
01721 P8320-EXIT. DTSCS62
|
|
01722 EXIT. DTSCS62
|
|
01723 EJECT DTSCS62
|
|
01724 DTSCS62
|
|
01725 P8810-LOCK-EMPLOYER. DTSCS62
|
|
01726 MOVE WRK-EMP-NO TO L221-EMP-NO. DTSCS62
|
|
01727 MOVE LCCM-SCR-ABSTIME TO L221-SCR-ABSTIME. DTSCS62
|
|
01728 MOVE LCCM-TASK-ID TO L221-UPDATE-TASK-ID. DTSCS62
|
|
01729 MOVE LCCM-OP-ID TO L221-UPDATE-OP-ID. DTSCS62
|
|
01730 MOVE LCCM-CICS-TERM-ID TO L221-UPDATE-TERMID. DTSCS62
|
|
01731 MOVE LCCM-TASK-NETNAME TO L221-UPDATE-NETNAME. DTSCS62
|
|
01732 MOVE LCCM-TASK-START-DATE TO L221-UPDATE-START-DATE. DTSCS62
|
|
01733 MOVE LCCM-TASK-START-TIME TO L221-UPDATE-START-TIME. DTSCS62
|
|
01734 MOVE WRK-SCR-ID TO L221-UPDATE-SCR-ID. DTSCS62
|
|
01735 DTSCS62
|
|
01736 PERFORM S221-EMP-LOCK THRU S221-EXIT. DTSCS62
|
|
01737 P8810-EXIT. DTSCS62
|
|
01738 EXIT. DTSCS62
|
|
01739 EJECT DTSCS62
|
|
01740 DTSCS62
|
|
01741 P8900-INITIALIZE-L331. DTSCS62
|
|
01742 MOVE WRK-EMP-NO TO L331-EMP-NO. DTSCS62
|
|
01743 DTSCS62
|
|
01744 MOVE LCCM-CURR-RUN-DATE TO L331-CURR-RUN-DATE. DTSCS62
|
|
01745 DTSCS62
|
|
01746 MOVE LCCM-TASK-START-ABSTIME TO L331-UPDATE-ABSTIME. DTSCS62
|
|
01747 DTSCS62
|
|
01748 MOVE LCCM-OP-ID TO L331-OP-ID. DTSCS62
|
|
01749 DTSCS62
|
|
01750 P8900-EXIT. DTSCS62
|
|
01751 EXIT. DTSCS62
|
|
01752 DTSCS62
|
|
01753 * DTSCS62
|
|
01754 P9100-CREATE-T021. DTSCS62
|
|
01755 MOVE WRK-EMP-NO TO T021-EMP-NO. DTSCS62
|
|
01756 MOVE LCCM-OP-ID TO T021-OP-ID. DTSCS62
|
|
01757 MOVE WRK-SCR-ID TO T021-SCR-ID. DTSCS62
|
|
01758 MOVE LCCM-TASK-START-DATE TO T021-SYS-DATE. DTSCS62
|
|
01759 MOVE LCCM-TASK-START-TIME TO T021-SYS-TIME. DTSCS62
|
|
01760 MOVE MFAS-ASSIGN-NO TO T021-ASSIGN-NO. DTSCS62
|
|
01761 MOVE LENGTH OF T021-REC TO T021-LENGTH. DTSCS62
|
|
01762 MOVE T021-REC TO RSKL-REC. DTSCS62
|
|
01763 PERFORM S825-WRITE THRU S825-EXIT. DTSCS62
|
|
01764 P9100-EXIT. DTSCS62
|
|
01765 EXIT. DTSCS62
|
|
01766 DTSCS62
|
|
01767 /*****************************************************************DTSCS62
|
|
01768 * E DTSCS62
|
|
01769 ******************************************************************DTSCS62
|
|
01770 DTSCS62
|
|
01771 P9500-WRITE-R608. DTSCS62
|
|
01772 MOVE LENGTH OF R608-REC TO R608-LENGTH. DTSCS62
|
|
01773 DTSCS62
|
|
01774 MOVE LCCM-OP-ID TO R608-OP-ID. DTSCS62
|
|
01775 DTSCS62
|
|
01776 MOVE WRK-EMP-NO TO R608-EMP-NO. DTSCS62
|
|
01777 DTSCS62
|
|
01778 MOVE MAP-FLD-REP-ID TO R608-FIELD-REP-ID. DTSCS62
|
|
01779 DTSCS62
|
|
01780 MOVE WRK-EMP-NO TO L111-EMP-NO. DTSCS62
|
|
01781 DTSCS62
|
|
01782 SET L111-LOOKUP-TAD-88 TO TRUE. DTSCS62
|
|
01783 DTSCS62
|
|
01784 SET L111-ID-NO-TAD-MAIL-88 TO TRUE. DTSCS62
|
|
01785 DTSCS62
|
|
01786 PERFORM S111-ADDR-LOOKUP THRU S111-EXIT. DTSCS62
|
|
01787 DTSCS62
|
|
01788 IF L111-ADDR-NOT-FOUND-88 DTSCS62
|
|
01789 MOVE ALL '*' TO L112-MAILING-ADDRESS DTSCS62
|
|
01790 L112-ZIP DTSCS62
|
|
01791 L112-ADVANCED-BARCODE DTSCS62
|
|
01792 ELSE DTSCS62
|
|
01793 SET L112-TAD-ADDR-88 TO TRUE DTSCS62
|
|
01794 SET L112-ANCHOR-LAST-88 TO TRUE DTSCS62
|
|
01795 MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME DTSCS62
|
|
01796 MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA DTSCS62
|
|
01797 PERFORM S112-ADDR-FORMAT THRU S112-EXIT. DTSCS62
|
|
01798 DTSCS62
|
|
01799 MOVE L112-MAILING-ADDRESS TO R608-FMT-ADDR. DTSCS62
|
|
01800 DTSCS62
|
|
01801 MOVE L112-ZIP TO R608-ZIP. DTSCS62
|
|
01802 DTSCS62
|
|
01803 MOVE L112-ADVANCED-BARCODE TO R608-ADVANCED-BARCODE. DTSCS62
|
|
01804 DTSCS62
|
|
01805 MOVE R608-REC TO RSKL-REC. DTSCS62
|
|
01806 DTSCS62
|
|
01807 PERFORM S825-WRITE THRU S825-EXIT. DTSCS62
|
|
01808 P9500-EXIT. EXIT. DTSCS62
|
|
01809 P9600-BROWSE-MFSL. DTSCS62
|
|
01810 MOVE MSKL-REC TO MFSL-REC. DTSCS62
|
|
01811 DTSCS62
|
|
01812 IF MFSL-ASSIGN-NO = WRK-ASSIGN-NO DTSCS62
|
|
01813 NEXT SENTENCE DTSCS62
|
|
01814 ELSE DTSCS62
|
|
01815 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS62
|
|
01816 SET L810-NO-REC-88 TO TRUE DTSCS62
|
|
01817 GO TO P9600-EXIT. DTSCS62
|
|
01818 DTSCS62
|
|
01819 IF MFSL-STATUS-CD = 'P' DTSCS62
|
|
01820 MOVE 'Y' TO WS-REC-FOUND-IND DTSCS62
|
|
01821 ELSE DTSCS62
|
|
01822 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS62
|
|
01823 P9600-EXIT. DTSCS62
|
|
01824 EXIT. DTSCS62
|
|
01825 /*****************************************************************DTSCS62
|
|
01826 * LINKS TO UTILITY MODULES DTSCS62
|
|
01827 ******************************************************************DTSCS62
|
|
01828 DTSCS62
|
|
01829 S001-FROM-FED-8. DTSCS62
|
|
01830 SET L001-FROM-FED-8 TO TRUE. DTSCS62
|
|
01831 GO TO S001-DATE. DTSCS62
|
|
01832 DTSCS62
|
|
01833 S001-FROM-ABS-DATE. DTSCS62
|
|
01834 SET L001-FROM-ABS-DAY TO TRUE. DTSCS62
|
|
01835 GO TO S001-DATE. DTSCS62
|
|
01836 DTSCS62
|
|
01837 S001-DATE. DTSCS62
|
|
01838 EXEC CICS LINK DTSCS62
|
|
01839 PROGRAM('DTSCU001') DTSCS62
|
|
01840 COMMAREA(L001-COMM-AREA) DTSCS62
|
|
01841 END-EXEC. DTSCS62
|
|
01842 S001-EXIT. DTSCS62
|
|
01843 EXIT. DTSCS62
|
|
01844 DTSCS62
|
|
01845 S004-FROM-5. DTSCS62
|
|
01846 SET L004-FROM-5 TO TRUE. DTSCS62
|
|
01847 GO TO S004-YRQ. DTSCS62
|
|
01848 DTSCS62
|
|
01849 S004-FROM-ABS. DTSCS62
|
|
01850 SET L004-FROM-ABS TO TRUE. DTSCS62
|
|
01851 GO TO S004-YRQ. DTSCS62
|
|
01852 DTSCS62
|
|
01853 S004-FROM-DATE. DTSCS62
|
|
01854 SET L004-FROM-DATE TO TRUE. DTSCS62
|
|
01855 GO TO S004-YRQ. DTSCS62
|
|
01856 DTSCS62
|
|
01857 S004-YRQ. DTSCS62
|
|
01858 EXEC CICS LINK DTSCS62
|
|
01859 PROGRAM('DTSCU004') DTSCS62
|
|
01860 COMMAREA(L004-COMM-AREA) DTSCS62
|
|
01861 END-EXEC. DTSCS62
|
|
01862 S004-EXIT. DTSCS62
|
|
01863 EXIT. DTSCS62
|
|
01864 DTSCS62
|
|
01865 S015-DATE-FROM-SCREEN. DTSCS62
|
|
01866 EXEC CICS LINK DTSCS62
|
|
01867 PROGRAM('DTSCU015') DTSCS62
|
|
01868 COMMAREA(L015-COMM-AREA) DTSCS62
|
|
01869 END-EXEC. DTSCS62
|
|
01870 S015-EXIT. DTSCS62
|
|
01871 EXIT. DTSCS62
|
|
01872 DTSCS62
|
|
01873 S018-EMP-NO-FROM-SCREEN. DTSCS62
|
|
01874 EXEC CICS LINK DTSCS62
|
|
01875 PROGRAM('DTSCU018') DTSCS62
|
|
01876 COMMAREA(L018-COMM-AREA) DTSCS62
|
|
01877 END-EXEC. DTSCS62
|
|
01878 S018-EXIT. DTSCS62
|
|
01879 EXIT. DTSCS62
|
|
01880 DTSCS62
|
|
01881 S020-SSN-FROM-SCREEN. DTSCS62
|
|
01882 EXEC CICS LINK DTSCS62
|
|
01883 PROGRAM('DTSCU020') DTSCS62
|
|
01884 COMMAREA(L020-COMM-AREA) DTSCS62
|
|
01885 END-EXEC. DTSCS62
|
|
01886 S020-EXIT. DTSCS62
|
|
01887 EXIT. DTSCS62
|
|
01888 DTSCS62
|
|
01889 S022-ASSIGN-NO-FROM-SCREEN. DTSCS62
|
|
01890 EXEC CICS LINK DTSCS62
|
|
01891 PROGRAM('DTSCU022') DTSCS62
|
|
01892 COMMAREA(L022-COMM-AREA) DTSCS62
|
|
01893 END-EXEC. DTSCS62
|
|
01894 S022-EXIT. DTSCS62
|
|
01895 EXIT. DTSCS62
|
|
01896 DTSCS62
|
|
01897 S024-EDIT-QTR-SPAN. DTSCS62
|
|
01898 SET L024-END-REQUIRED TO TRUE. DTSCS62
|
|
01899 EXEC CICS LINK DTSCS62
|
|
01900 PROGRAM('DTSCU024') DTSCS62
|
|
01901 COMMAREA(L024-COMM-AREA) DTSCS62
|
|
01902 END-EXEC. DTSCS62
|
|
01903 S024-EXIT. DTSCS62
|
|
01904 EXIT. DTSCS62
|
|
01905 DTSCS62
|
|
01906 S036-EDIT-STATUS-CD. DTSCS62
|
|
01907 SET L036-MFAS-STATUS-IND TO TRUE. DTSCS62
|
|
01908 GO TO S036-FS-EDIT-DSCR. DTSCS62
|
|
01909 DTSCS62
|
|
01910 S036-EMP-SIZE. DTSCS62
|
|
01911 SET L036-MFAS-EMP-SIZE-IND TO TRUE. DTSCS62
|
|
01912 GO TO S036-FS-EDIT-DSCR. DTSCS62
|
|
01913 DTSCS62
|
|
01914 S036-AUDIT-SEL-REASON. DTSCS62
|
|
01915 SET L036-MFAS-AUDIT-SEL-REASON TO TRUE. DTSCS62
|
|
01916 GO TO S036-FS-EDIT-DSCR. DTSCS62
|
|
01917 DTSCS62
|
|
01918 S036-FS-EDIT-DSCR. DTSCS62
|
|
01919 EXEC CICS LINK DTSCS62
|
|
01920 PROGRAM('DTSCU036') DTSCS62
|
|
01921 COMMAREA(L036-COMM-AREA) DTSCS62
|
|
01922 END-EXEC. DTSCS62
|
|
01923 S036-EXIT. DTSCS62
|
|
01924 EXIT. DTSCS62
|
|
01925 DTSCS62
|
|
01926 *S039-SIC-OWN-CODE-EDIT. DTSCS62
|
|
01927 *****EXEC CICS LINK DTSCS62
|
|
01928 ***** PROGRAM('DTSCU039') DTSCS62
|
|
01929 ***** COMMAREA(L039-COMM-AREA) DTSCS62
|
|
01930 ***** LENGTH(L039-LENGTH) DTSCS62
|
|
01931 *****END-EXEC. DTSCS62
|
|
01932 ***** DTSCS62
|
|
01933 *****IF L039-SIC-FILE-CLOSED DTSCS62
|
|
01934 ***** MOVE L039-MSG-AREA TO LCCM-MSG-AREA DTSCS62
|
|
01935 ***** SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS62
|
|
01936 ***** SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS62
|
|
01937 ***** GO TO MAINLINE-EXIT. DTSCS62
|
|
01938 ***** DTSCS62
|
|
01939 *S039-EXIT. DTSCS62
|
|
01940 *****EXIT. DTSCS62
|
|
01941 DTSCS62
|
|
01942 S061-FIELD-ZIP-REP-ID. DTSCS62
|
|
01943 EXEC CICS LINK DTSCS62
|
|
01944 PROGRAM('DTSCU061') DTSCS62
|
|
01945 COMMAREA(L061-COMM-AREA) DTSCS62
|
|
01946 END-EXEC. DTSCS62
|
|
01947 DTSCS62
|
|
01948 IF L061-FILE-CLOSED DTSCS62
|
|
01949 MOVE L061-MSG-AREA TO LCCM-MSG-AREA DTSCS62
|
|
01950 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS62
|
|
01951 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS62
|
|
01952 GO TO MAINLINE-EXIT. DTSCS62
|
|
01953 DTSCS62
|
|
01954 S061-EXIT. DTSCS62
|
|
01955 EXIT. DTSCS62
|
|
01956 DTSCS62
|
|
01957 S062-FLD-REP-ID-DESC. DTSCS62
|
|
01958 EXEC CICS LINK DTSCS62
|
|
01959 PROGRAM('DTSCU062') DTSCS62
|
|
01960 COMMAREA(L062-COMM-AREA) DTSCS62
|
|
01961 END-EXEC. DTSCS62
|
|
01962 DTSCS62
|
|
01963 IF L062-FILE-CLOSED DTSCS62
|
|
01964 MOVE L062-MSG-AREA TO LCCM-MSG-AREA DTSCS62
|
|
01965 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS62
|
|
01966 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS62
|
|
01967 GO TO MAINLINE-EXIT. DTSCS62
|
|
01968 DTSCS62
|
|
01969 S062-EXIT. DTSCS62
|
|
01970 EXIT. DTSCS62
|
|
01971 DTSCS62
|
|
01972 S063-FIELD-ASSIGNMENT-EDIT. DTSCS62
|
|
01973 EXEC CICS LINK DTSCS62
|
|
01974 PROGRAM('DTSCU063') DTSCS62
|
|
01975 COMMAREA(L063-COMM-AREA) DTSCS62
|
|
01976 END-EXEC. DTSCS62
|
|
01977 DTSCS62
|
|
01978 IF L063-FILE-CLOSED DTSCS62
|
|
01979 MOVE L063-MSG-AREA TO LCCM-MSG-AREA DTSCS62
|
|
01980 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS62
|
|
01981 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS62
|
|
01982 GO TO MAINLINE-EXIT. DTSCS62
|
|
01983 DTSCS62
|
|
01984 S063-EXIT. DTSCS62
|
|
01985 EXIT. DTSCS62
|
|
01986 DTSCS62
|
|
01987 S071-FROM-LAST-NAME-FIRST. DTSCS62
|
|
01988 SET L071-FROM-LAST-NAME-FIRST TO TRUE. DTSCS62
|
|
01989 GO TO S071-NAME-EDIT. DTSCS62
|
|
01990 DTSCS62
|
|
01991 S071-NAME-EDIT. DTSCS62
|
|
01992 EXEC CICS LINK DTSCS62
|
|
01993 PROGRAM('DTSCU071') DTSCS62
|
|
01994 COMMAREA(L071-COMM-AREA) DTSCS62
|
|
01995 END-EXEC. DTSCS62
|
|
01996 S071-EXIT. DTSCS62
|
|
01997 EXIT. DTSCS62
|
|
01998 DTSCS62
|
|
01999 S081-CLAIMANT-NAME. DTSCS62
|
|
02000 EXEC CICS LINK DTSCS62
|
|
02001 PROGRAM('DTSCU081') DTSCS62
|
|
02002 COMMAREA(L081-COMM-AREA) DTSCS62
|
|
02003 END-EXEC. DTSCS62
|
|
02004 DTSCS62
|
|
02005 IF L081-FILE-CLOSED DTSCS62
|
|
02006 MOVE L081-MSG-AREA TO LCCM-MSG-AREA DTSCS62
|
|
02007 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS62
|
|
02008 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS62
|
|
02009 GO TO MAINLINE-EXIT. DTSCS62
|
|
02010 DTSCS62
|
|
02011 S081-EXIT. DTSCS62
|
|
02012 EXIT. DTSCS62
|
|
02013 DTSCS62
|
|
02014 S082-OP-ID-EDIT. DTSCS62
|
|
02015 EXEC CICS LINK DTSCS62
|
|
02016 PROGRAM('DTSCU082') DTSCS62
|
|
02017 COMMAREA(L082-COMM-AREA) DTSCS62
|
|
02018 END-EXEC. DTSCS62
|
|
02019 DTSCS62
|
|
02020 IF L082-FILE-CLOSED DTSCS62
|
|
02021 MOVE L082-MSG-AREA TO LCCM-MSG-AREA DTSCS62
|
|
02022 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS62
|
|
02023 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS62
|
|
02024 GO TO MAINLINE-EXIT. DTSCS62
|
|
02025 DTSCS62
|
|
02026 S082-EXIT. DTSCS62
|
|
02027 EXIT. DTSCS62
|
|
02028 DTSCS62
|
|
02029 S111-ADDR-LOOKUP. DTSCS62
|
|
02030 EXEC CICS LINK DTSCS62
|
|
02031 PROGRAM('DTSCU111') DTSCS62
|
|
02032 COMMAREA(L111-COMM-AREA) DTSCS62
|
|
02033 END-EXEC. DTSCS62
|
|
02034 DTSCS62
|
|
02035 IF L111-FILE-CLOSED-88 DTSCS62
|
|
02036 MOVE L111-MSG-AREA TO LCCM-MSG-AREA DTSCS62
|
|
02037 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS62
|
|
02038 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS62
|
|
02039 GO TO MAINLINE-EXIT. DTSCS62
|
|
02040 DTSCS62
|
|
02041 S111-EXIT. DTSCS62
|
|
02042 EXIT. DTSCS62
|
|
02043 DTSCS62
|
|
02044 S112-ADDR-FORMAT. DTSCS62
|
|
02045 EXEC CICS LINK DTSCS62
|
|
02046 PROGRAM('DTSCU112') DTSCS62
|
|
02047 COMMAREA(L112-COMM-AREA) DTSCS62
|
|
02048 END-EXEC. DTSCS62
|
|
02049 DTSCS62
|
|
02050 S112-EXIT. DTSCS62
|
|
02051 EXIT. DTSCS62
|
|
02052 DTSCS62
|
|
02053 S221-EMP-LOCK. DTSCS62
|
|
02054 SET L221-START-UPDATE TO TRUE. DTSCS62
|
|
02055 GO TO S221-EMP-LOCK-UNLOCK. DTSCS62
|
|
02056 DTSCS62
|
|
02057 S221-EMP-UNLOCK. DTSCS62
|
|
02058 SET L221-END-UPDATE TO TRUE. DTSCS62
|
|
02059 GO TO S221-EMP-LOCK-UNLOCK. DTSCS62
|
|
02060 DTSCS62
|
|
02061 S221-EMP-LOCK-UNLOCK. DTSCS62
|
|
02062 EXEC CICS LINK DTSCS62
|
|
02063 PROGRAM('DTSCU221') DTSCS62
|
|
02064 COMMAREA(L221-COMM-AREA) DTSCS62
|
|
02065 END-EXEC. DTSCS62
|
|
02066 DTSCS62
|
|
02067 IF L221-FILE-CLOSED DTSCS62
|
|
02068 MOVE L221-MSG-AREA TO LCCM-MSG-AREA DTSCS62
|
|
02069 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS62
|
|
02070 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS62
|
|
02071 GO TO MAINLINE-EXIT. DTSCS62
|
|
02072 DTSCS62
|
|
02073 IF L221-NOT-OK DTSCS62
|
|
02074 MOVE L221-MSG-AREA TO LCCM-MSG-AREA. DTSCS62
|
|
02075 S221-EXIT. DTSCS62
|
|
02076 EXIT. DTSCS62
|
|
02077 DTSCS62
|
|
02078 DTSCS62
|
|
02079 S331-WRITE-MLOG. DTSCS62
|
|
02080 EXEC CICS LINK DTSCS62
|
|
02081 PROGRAM('DTSCU331') DTSCS62
|
|
02082 COMMAREA(L331-COMM-AREA) DTSCS62
|
|
02083 END-EXEC. DTSCS62
|
|
02084 DTSCS62
|
|
02085 IF L331-FILE-CLOSED DTSCS62
|
|
02086 MOVE L331-MSG-AREA TO LCCM-MSG-AREA DTSCS62
|
|
02087 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS62
|
|
02088 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS62
|
|
02089 GO TO MAINLINE-EXIT. DTSCS62
|
|
02090 DTSCS62
|
|
02091 S331-EXIT. DTSCS62
|
|
02092 EXIT. DTSCS62
|
|
02093 DTSCS62
|
|
02094 *S351-PRINT. DTSCS62
|
|
02095 *****EXEC CICS LINK DTSCS62
|
|
02096 *********PROGRAM('DTSCU351') DTSCS62
|
|
02097 *********COMMAREA(L351-COMM-AREA) DTSCS62
|
|
02098 *****END-EXEC. DTSCS62
|
|
02099 *S351-EXIT. DTSCS62
|
|
02100 *****EXIT. DTSCS62
|
|
02101 DTSCS62
|
|
02102 S803-REQ-SCR-ID-EDIT. DTSCS62
|
|
02103 EXEC CICS LINK DTSCS62
|
|
02104 PROGRAM ('DTSCU803') DTSCS62
|
|
02105 COMMAREA (DFHCOMMAREA) DTSCS62
|
|
02106 END-EXEC. DTSCS62
|
|
02107 S803-EXIT. DTSCS62
|
|
02108 EXIT. DTSCS62
|
|
02109 DTSCS62
|
|
02110 S804-INVALID-KEY. DTSCS62
|
|
02111 EXEC CICS LINK DTSCS62
|
|
02112 PROGRAM ('DTSCU804') DTSCS62
|
|
02113 COMMAREA (DFHCOMMAREA) DTSCS62
|
|
02114 END-EXEC. DTSCS62
|
|
02115 S804-EXIT. DTSCS62
|
|
02116 EXIT. DTSCS62
|
|
02117 DTSCS62
|
|
02118 S805-MSG-AREA. DTSCS62
|
|
02119 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS62
|
|
02120 DTSCS62
|
|
02121 EXEC CICS LINK DTSCS62
|
|
02122 PROGRAM ('DTSCU805') DTSCS62
|
|
02123 COMMAREA (L805-COMM-AREA) DTSCS62
|
|
02124 END-EXEC. DTSCS62
|
|
02125 DTSCS62
|
|
02126 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS62
|
|
02127 S805-EXIT. DTSCS62
|
|
02128 EXIT. DTSCS62
|
|
02129 EJECT DTSCS62
|
|
02130 S810-READ. DTSCS62
|
|
02131 SET L810-READ-88 TO TRUE. DTSCS62
|
|
02132 GO TO S810-IO. DTSCS62
|
|
02133 DTSCS62
|
|
02134 S810-START-BROWSE. DTSCS62
|
|
02135 SET L810-START-BROWSE-88 TO TRUE. DTSCS62
|
|
02136 GO TO S810-IO. DTSCS62
|
|
02137 DTSCS62
|
|
02138 S810-READ-NEXT. DTSCS62
|
|
02139 SET L810-READ-NEXT-88 TO TRUE. DTSCS62
|
|
02140 GO TO S810-IO. DTSCS62
|
|
02141 DTSCS62
|
|
02142 S810-READ-PREV. DTSCS62
|
|
02143 SET L810-READ-PREV-88 TO TRUE. DTSCS62
|
|
02144 GO TO S810-IO. DTSCS62
|
|
02145 DTSCS62
|
|
02146 S810-END-BROWSE. DTSCS62
|
|
02147 SET L810-END-BROWSE-88 TO TRUE. DTSCS62
|
|
02148 GO TO S810-IO. DTSCS62
|
|
02149 DTSCS62
|
|
02150 S810-COUNT. DTSCS62
|
|
02151 SET L810-COUNT-88 TO TRUE. DTSCS62
|
|
02152 GO TO S810-IO. DTSCS62
|
|
02153 DTSCS62
|
|
02154 S810-REWRITE. DTSCS62
|
|
02155 SET L810-REWRITE-88 TO TRUE. DTSCS62
|
|
02156 GO TO S810-IO. DTSCS62
|
|
02157 DTSCS62
|
|
02158 S810-WRITE. DTSCS62
|
|
02159 SET L810-WRITE-88 TO TRUE. DTSCS62
|
|
02160 GO TO S810-IO. DTSCS62
|
|
02161 DTSCS62
|
|
02162 S810-DELETE. DTSCS62
|
|
02163 SET L810-DELETE-88 TO TRUE. DTSCS62
|
|
02164 GO TO S810-IO. DTSCS62
|
|
02165 DTSCS62
|
|
02166 S810-IO. DTSCS62
|
|
02167 DTSCS62
|
|
02168 EXEC CICS LINK DTSCS62
|
|
02169 PROGRAM ('DTSCU810') DTSCS62
|
|
02170 COMMAREA (L810-COMM-AREA) DTSCS62
|
|
02171 END-EXEC. DTSCS62
|
|
02172 DTSCS62
|
|
02173 IF L810-FILE-CLOSED-88 DTSCS62
|
|
02174 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS62
|
|
02175 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS62
|
|
02176 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS62
|
|
02177 GO TO MAINLINE-EXIT. DTSCS62
|
|
02178 S810-EXIT. DTSCS62
|
|
02179 EXIT. DTSCS62
|
|
02180 EJECT DTSCS62
|
|
02181 S821-START-BROWSE. DTSCS62
|
|
02182 SET L821-START-BROWSE-88 TO TRUE. DTSCS62
|
|
02183 GO TO S821-ALT-IO. DTSCS62
|
|
02184 S821-END-BROWSE. DTSCS62
|
|
02185 SET L821-END-BROWSE-88 TO TRUE. DTSCS62
|
|
02186 GO TO S821-ALT-IO. DTSCS62
|
|
02187 S821-ALT-IO. DTSCS62
|
|
02188 EXEC CICS LINK DTSCS62
|
|
02189 PROGRAM ('DTSCU821') DTSCS62
|
|
02190 COMMAREA (L821-COMM-AREA) DTSCS62
|
|
02191 END-EXEC. DTSCS62
|
|
02192 IF L821-FILE-CLOSED-88 DTSCS62
|
|
02193 MOVE L821-MSG-AREA TO LCCM-MSG-AREA DTSCS62
|
|
02194 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS62
|
|
02195 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS62
|
|
02196 GO TO MAINLINE-EXIT. DTSCS62
|
|
02197 S821-EXIT. EXIT. DTSCS62
|
|
02198 DTSCS62
|
|
02199 S825-WRITE. DTSCS62
|
|
02200 SET L825-WRITE-88 TO TRUE. DTSCS62
|
|
02201 GO TO S825-O. DTSCS62
|
|
02202 DTSCS62
|
|
02203 S825-O. DTSCS62
|
|
02204 DTSCS62
|
|
02205 DTSCS62
|
|
02206 EXEC CICS LINK DTSCS62
|
|
02207 PROGRAM ('DTSCU825') DTSCS62
|
|
02208 COMMAREA (L825-COMM-AREA) DTSCS62
|
|
02209 END-EXEC. DTSCS62
|
|
02210 DTSCS62
|
|
02211 IF L825-FILE-CLOSED-88 DTSCS62
|
|
02212 MOVE L825-MSG-AREA TO LCCM-MSG-AREA DTSCS62
|
|
02213 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS62
|
|
02214 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS62
|
|
02215 GO TO MAINLINE-EXIT. DTSCS62
|
|
02216 S825-EXIT. DTSCS62
|
|
02217 EXIT. DTSCS62
|
|
02218 EJECT DTSCS62
|
|
02219 S851-SCREEN-PROCESSING. DTSCS62
|
|
02220 EXEC CICS LINK DTSCS62
|
|
02221 PROGRAM ('DTSCU851') DTSCS62
|
|
02222 COMMAREA (L851-COMM-AREA) DTSCS62
|
|
02223 END-EXEC. DTSCS62
|
|
02224 S851-EXIT. DTSCS62
|
|
02225 EXIT. DTSCS62
|
|
02226 DTSCS62
|
|
02227 S899-ABEND. DTSCS62
|
|
02228 EXEC CICS ABEND DTSCS62
|
|
02229 ABCODE(WRK-ABEND-CD) DTSCS62
|
|
02230 END-EXEC. DTSCS62
|
|
02231 S899-EXIT. DTSCS62
|
|
02232 EXIT. DTSCS62
|
|
02233 /*****************************************************************DTSCS62
|
|
02234 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS62
|
|
02235 * CERTAIN FIELDS ARE OPEN TO FIELD STAFF FOR UPDATE. DTSCS62
|
|
02236 * S1010 IS EXECUTED IF THE OPERATOR HAS FIELD DESK AUTHORITY DTSCS62
|
|
02237 * (FOR WHOM ALL FIELDS ARE AVAILABLE). DTSCS62
|
|
02238 * S1020 IS EXECUTED IF THE OPERATOR HAS ONLY UPDATE AUTHORTIY. DTSCS62
|
|
02239 ******************************************************************DTSCS62
|
|
02240 S1000-SCREEN-EDITS. DTSCS62
|
|
02241 DTSCS62
|
|
02242 IF LCCM-OP-IS-FLD-DESK-88 DTSCS62
|
|
02243 PERFORM S1010-FIELD-DESK-EDITS THRU S1010-EXIT DTSCS62
|
|
02244 ELSE DTSCS62
|
|
02245 PERFORM S1020-FIELD-REP-EDITS THRU S1020-EXIT. DTSCS62
|
|
02246 DTSCS62
|
|
02247 S1000-EXIT. DTSCS62
|
|
02248 EXIT. DTSCS62
|
|
02249 DTSCS62
|
|
02250 S1010-FIELD-DESK-EDITS. DTSCS62
|
|
02251 PERFORM S1200-COMPLETED-DATE THRU S1200-EXIT. DTSCS62
|
|
02252 PERFORM S1300-ASSIGN-STATUS THRU S1300-EXIT. DTSCS62
|
|
02253 PERFORM S1400-ASSIGN-TYPE THRU S1400-EXIT. DTSCS62
|
|
02254 DTSCS62
|
|
02255 IF LCCM-MSG DTSCS62
|
|
02256 GO TO S1010-EXIT. DTSCS62
|
|
02257 DTSCS62
|
|
02258 PERFORM S1500-START-DATE THRU S1500-EXIT. DTSCS62
|
|
02259 PERFORM S1600-DUE-DATE THRU S1600-EXIT. DTSCS62
|
|
02260 PERFORM S1700-FLD-REP-ID THRU S1700-EXIT. DTSCS62
|
|
02261 PERFORM S1800-ATTACHMENTS THRU S1800-EXIT. DTSCS62
|
|
02262 PERFORM S1900-SOURCE-OP-ID THRU S1900-EXIT. DTSCS62
|
|
02263 PERFORM S2000-TAX-EXTRACT THRU S2000-EXIT. DTSCS62
|
|
02264 PERFORM S2100-WAGE-EXTRACT THRU S2100-EXIT. DTSCS62
|
|
02265 PERFORM S2200-QTR-RANGE THRU S2200-EXIT. DTSCS62
|
|
02266 PERFORM S2300-EMP-SIZE-IND THRU S2300-EXIT DTSCS62
|
|
02267 PERFORM S2400-AUDIT-SEL-REASON THRU S2400-EXIT DTSCS62
|
|
02268 VARYING WRK-CTR FROM 1 BY 1 DTSCS62
|
|
02269 UNTIL WRK-CTR > MMAX-FAS-SEL-MAX. DTSCS62
|
|
02270 PERFORM S2500-RELATED-EMP-NO THRU S2500-EXIT. DTSCS62
|
|
02271 PERFORM S2600-CLAIMANT-SSN THRU S2600-EXIT. DTSCS62
|
|
02272 PERFORM S2700-CLAIMANT-NAME THRU S2700-EXIT. DTSCS62
|
|
02273 SKIP1 DTSCS62
|
|
02274 PERFORM S3100-TEXT THRU S3100-EXIT DTSCS62
|
|
02275 VARYING WRK-CTR FROM 1 BY 1 DTSCS62
|
|
02276 UNTIL WRK-CTR > MMAX-FAS-TEXT-MAX. DTSCS62
|
|
02277 SKIP1 DTSCS62
|
|
02278 IF LCCM-MSG DTSCS62
|
|
02279 GO TO S1010-EXIT. DTSCS62
|
|
02280 DTSCS62
|
|
02281 S1010-EXIT. DTSCS62
|
|
02282 EXIT. DTSCS62
|
|
02283 DTSCS62
|
|
02284 S1020-FIELD-REP-EDITS. DTSCS62
|
|
02285 PERFORM S1200-COMPLETED-DATE THRU S1200-EXIT. DTSCS62
|
|
02286 PERFORM S1300-ASSIGN-STATUS THRU S1300-EXIT. DTSCS62
|
|
02287 DTSCS62
|
|
02288 IF LCCM-MSG DTSCS62
|
|
02289 GO TO S1020-EXIT. DTSCS62
|
|
02290 DTSCS62
|
|
02291 PERFORM S2000-TAX-EXTRACT THRU S2000-EXIT. DTSCS62
|
|
02292 PERFORM S2100-WAGE-EXTRACT THRU S2100-EXIT. DTSCS62
|
|
02293 DTSCS62
|
|
02294 IF WRK-EXTRACT-REQ-YES-88 DTSCS62
|
|
02295 PERFORM S2200-QTR-RANGE THRU S2200-EXIT. DTSCS62
|
|
02296 DTSCS62
|
|
02297 PERFORM S3100-TEXT THRU S3100-EXIT DTSCS62
|
|
02298 VARYING WRK-CTR FROM 1 BY 1 DTSCS62
|
|
02299 UNTIL WRK-CTR > MMAX-FAS-TEXT-MAX. DTSCS62
|
|
02300 DTSCS62
|
|
02301 S1020-EXIT. DTSCS62
|
|
02302 EXIT. DTSCS62
|
|
02303 DTSCS62
|
|
02304 S1100-EDIT-KEY. DTSCS62
|
|
02305 PERFORM S1101-ASSIGN-NO THRU S1101-EXIT. DTSCS62
|
|
02306 S1100-EXIT. EXIT. DTSCS62
|
|
02307 /*****************************************************************DTSCS62
|
|
02308 * DTSCS62
|
|
02309 ******************************************************************DTSCS62
|
|
02310 S1101-ASSIGN-NO. DTSCS62
|
|
02311 MOVE MAP-ASSIGN-NO-AREA TO L022-S-ASSIGN-NO-AREA. DTSCS62
|
|
02312 PERFORM S022-ASSIGN-NO-FROM-SCREEN THRU S022-EXIT. DTSCS62
|
|
02313 DTSCS62
|
|
02314 IF L022-NO-ENTRY DTSCS62
|
|
02315 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS62
|
|
02316 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS62
|
|
02317 GO TO S1101-EXIT. DTSCS62
|
|
02318 DTSCS62
|
|
02319 IF L022-NOT-VALID DTSCS62
|
|
02320 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS62
|
|
02321 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS62
|
|
02322 GO TO S1101-EXIT. DTSCS62
|
|
02323 DTSCS62
|
|
02324 MOVE L022-ASSIGN-NO TO WRK-ASSIGN-NO DTSCS62
|
|
02325 DTSCS62
|
|
02326 PERFORM S1110-THRU-FAN THRU S1110-EXIT. DTSCS62
|
|
02327 DTSCS62
|
|
02328 S1101-EXIT. EXIT. DTSCS62
|
|
02329 DTSCS62
|
|
02330 S1110-THRU-FAN. DTSCS62
|
|
02331 MOVE LOW-VALUES TO IFAN-KEY-AREA. DTSCS62
|
|
02332 SET IFAN-FAN-88 TO TRUE. DTSCS62
|
|
02333 MOVE L022-ASSIGN-NO TO IFAN-ASSIGN-NO. DTSCS62
|
|
02334 MOVE ZEROS TO IFAN-EMP-NO. DTSCS62
|
|
02335 PERFORM S821-START-BROWSE THRU S821-EXIT. DTSCS62
|
|
02336 IF L821-OK-88 DTSCS62
|
|
02337 PERFORM S821-END-BROWSE THRU S821-EXIT DTSCS62
|
|
02338 IF IFAN-ASSIGN-NO = L022-ASSIGN-NO DTSCS62
|
|
02339 MOVE IFAN-EMP-NO TO WRK-EMP-NO DTSCS62
|
|
02340 ELSE DTSCS62
|
|
02341 SET L821-NO-REC-88 TO TRUE DTSCS62
|
|
02342 MOVE EMSG-NO-ASSIGNMENT TO WRK-MSG-AREA DTSCS62
|
|
02343 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS62
|
|
02344 GO TO S1110-EXIT DTSCS62
|
|
02345 ELSE DTSCS62
|
|
02346 MOVE EMSG-NO-ASSIGNMENT TO WRK-MSG-AREA DTSCS62
|
|
02347 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS62
|
|
02348 GO TO S1110-EXIT. DTSCS62
|
|
02349 DTSCS62
|
|
02350 S1110-EXIT. DTSCS62
|
|
02351 EXIT. DTSCS62
|
|
02352 DTSCS62
|
|
02353 S1120-READ-MFAS. DTSCS62
|
|
02354 MOVE LOW-VALUES TO MFAS-KEY-AREA. DTSCS62
|
|
02355 SET MFAS-FAS-88 TO TRUE. DTSCS62
|
|
02356 MOVE IFAN-EMP-NO TO MFAS-EMP-NO. DTSCS62
|
|
02357 MOVE IFAN-ASSIGN-NO TO MFAS-ASSIGN-NO. DTSCS62
|
|
02358 MOVE MFAS-KEY-AREA TO MSKL-KEY-AREA. DTSCS62
|
|
02359 DTSCS62
|
|
02360 PERFORM S810-READ THRU S810-EXIT. DTSCS62
|
|
02361 IF L810-NO-REC-88 DTSCS62
|
|
02362 MOVE IFAN-EMP-NO TO MSG-EMP-NO-IN-ERR DTSCS62
|
|
02363 MOVE MSG-E626-AREA TO LCCM-MSG-AREA DTSCS62
|
|
02364 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS62
|
|
02365 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS62
|
|
02366 GO TO MAINLINE-EXIT DTSCS62
|
|
02367 ELSE DTSCS62
|
|
02368 MOVE MSKL-REC TO MFAS-REC. DTSCS62
|
|
02369 S1120-EXIT. DTSCS62
|
|
02370 EXIT. DTSCS62
|
|
02371 DTSCS62
|
|
02372 S1130-READ-MPRF. DTSCS62
|
|
02373 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS62
|
|
02374 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS62
|
|
02375 SET MPRF-PRF-88 TO TRUE. DTSCS62
|
|
02376 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS62
|
|
02377 PERFORM S810-READ THRU S810-EXIT. DTSCS62
|
|
02378 IF L810-NO-REC-88 DTSCS62
|
|
02379 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS62
|
|
02380 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS62
|
|
02381 ELSE DTSCS62
|
|
02382 MOVE MSKL-REC TO MPRF-REC DTSCS62
|
|
02383 SET WRK-MPRF-YES-88 TO TRUE. DTSCS62
|
|
02384 S1130-EXIT. DTSCS62
|
|
02385 EXIT. DTSCS62
|
|
02386 DTSCS62
|
|
02387 S1199-ERROR. DTSCS62
|
|
02388 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-ASSIGN-NO-1-A DTSCS62
|
|
02389 MAP-ASSIGN-NO-2-A. DTSCS62
|
|
02390 IF LCCM-NO-MSG DTSCS62
|
|
02391 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS62
|
|
02392 MOVE CATB-CURSOR TO MAP-ASSIGN-NO-1-L DTSCS62
|
|
02393 SET CURSOR-SET-YES TO TRUE. DTSCS62
|
|
02394 S1199-EXIT. EXIT. DTSCS62
|
|
02395 DTSCS62
|
|
02396 /*****************************************************************DTSCS62
|
|
02397 * *DTSCS62
|
|
02398 ******************************************************************DTSCS62
|
|
02399 S1200-COMPLETED-DATE. DTSCS62
|
|
02400 DTSCS62
|
|
02401 MOVE MAP-COMPLETED-DATE-AREA TO L015-S-DATE-AREA. DTSCS62
|
|
02402 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS62
|
|
02403 DTSCS62
|
|
02404 IF L015-NO-ENTRY DTSCS62
|
|
02405 IF MAP-STATUS-CD = 'C' OR 'P' DTSCS62
|
|
02406 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS62
|
|
02407 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS62
|
|
02408 GO TO S1200-EXIT DTSCS62
|
|
02409 ELSE DTSCS62
|
|
02410 GO TO S1200-EXIT DTSCS62
|
|
02411 END-IF. DTSCS62
|
|
02412 DTSCS62
|
|
02413 IF MAP-STATUS-CD = 'A' DTSCS62
|
|
02414 AND L015-VALID DTSCS62
|
|
02415 MOVE 'C' TO MAP-STATUS-CD DTSCS62
|
|
02416 END-IF. DTSCS62
|
|
02417 DTSCS62
|
|
02418 IF MAP-STATUS-CD = 'C' DTSCS62
|
|
02419 OR MAP-STATUS-CD = 'P' DTSCS62
|
|
02420 IF L015-NOT-VALID DTSCS62
|
|
02421 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS62
|
|
02422 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS62
|
|
02423 ELSE DTSCS62
|
|
02424 PERFORM S1210-CROSS-EDITS THRU S1210-EXIT DTSCS62
|
|
02425 ELSE DTSCS62
|
|
02426 MOVE MSG-E62D-AREA TO WRK-MSG-AREA DTSCS62
|
|
02427 PERFORM S1201-ERROR THRU S1201-EXIT. DTSCS62
|
|
02428 S1200-EXIT. EXIT. DTSCS62
|
|
02429 DTSCS62
|
|
02430 S1201-ERROR. DTSCS62
|
|
02431 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-COMPLETED-DATE-MO-A DTSCS62
|
|
02432 MAP-COMPLETED-DATE-DA-A DTSCS62
|
|
02433 MAP-COMPLETED-DATE-YR-A. DTSCS62
|
|
02434 IF LCCM-NO-MSG DTSCS62
|
|
02435 SET CURSOR-SET-YES TO TRUE DTSCS62
|
|
02436 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS62
|
|
02437 MOVE CATB-CURSOR TO MAP-COMPLETED-DATE-MO-L. DTSCS62
|
|
02438 S1201-EXIT. EXIT. DTSCS62
|
|
02439 DTSCS62
|
|
02440 S1210-CROSS-EDITS. DTSCS62
|
|
02441 IF L015-DATE > LCCM-CURR-RUN-DATE DTSCS62
|
|
02442 MOVE MSG-E627-AREA TO WRK-MSG-AREA DTSCS62
|
|
02443 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS62
|
|
02444 GO TO S1210-EXIT. DTSCS62
|
|
02445 DTSCS62
|
|
02446 IF MFAS-PROCESSED-DATE = +0 DTSCS62
|
|
02447 NEXT SENTENCE DTSCS62
|
|
02448 ELSE DTSCS62
|
|
02449 IF L015-DATE > MFAS-PROCESSED-DATE DTSCS62
|
|
02450 MOVE MSG-E628-AREA TO WRK-MSG-AREA DTSCS62
|
|
02451 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS62
|
|
02452 GO TO S1210-EXIT. DTSCS62
|
|
02453 DTSCS62
|
|
02454 IF L015-DATE < MFAS-START-DATE DTSCS62
|
|
02455 MOVE MSG-E630-AREA TO WRK-MSG-AREA DTSCS62
|
|
02456 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS62
|
|
02457 GO TO S1210-EXIT. DTSCS62
|
|
02458 S1210-EXIT. DTSCS62
|
|
02459 EXIT. DTSCS62
|
|
02460 /*****************************************************************DTSCS62
|
|
02461 * *DTSCS62
|
|
02462 ******************************************************************DTSCS62
|
|
02463 S1300-ASSIGN-STATUS. DTSCS62
|
|
02464 DTSCS62
|
|
02465 MOVE MAP-STATUS-CD TO L036-CD. DTSCS62
|
|
02466 PERFORM S036-EDIT-STATUS-CD THRU S036-EXIT. DTSCS62
|
|
02467 MOVE L036-SHORT-DSCR TO MAP-STATUS-CD-DESC. DTSCS62
|
|
02468 DTSCS62
|
|
02469 IF L036-NOT-VALID DTSCS62
|
|
02470 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS62
|
|
02471 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS62
|
|
02472 GO TO S1300-EXIT DTSCS62
|
|
02473 ELSE DTSCS62
|
|
02474 IF (MFAS-STATUS-PROCESSED-88 DTSCS62
|
|
02475 AND MAP-STATUS-CD NOT = 'P') DTSCS62
|
|
02476 MOVE MSG-E622-AREA TO WRK-MSG-AREA DTSCS62
|
|
02477 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS62
|
|
02478 GO TO S1300-EXIT DTSCS62
|
|
02479 ELSE DTSCS62
|
|
02480 IF (NOT MFAS-STATUS-PROCESSED-88 DTSCS62
|
|
02481 AND MAP-STATUS-CD = 'P') DTSCS62
|
|
02482 MOVE MSG-E622-AREA TO WRK-MSG-AREA DTSCS62
|
|
02483 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS62
|
|
02484 GO TO S1300-EXIT DTSCS62
|
|
02485 END-IF. DTSCS62
|
|
02486 IF (NOT MFAS-STATUS-HELD-88 AND DTSCS62
|
|
02487 NOT MFAS-STATUS-KILLED-88 DTSCS62
|
|
02488 AND MAP-STATUS-CD = 'H' OR 'K') DTSCS62
|
|
02489 PERFORM S1350-CHECK-OPEN-APPN THRU S1350-EXIT DTSCS62
|
|
02490 IF WS-REC-FOUND-IND = 'Y' DTSCS62
|
|
02491 MOVE MSG-E62H-AREA TO WRK-MSG-AREA DTSCS62
|
|
02492 PERFORM S1301-ERROR THRU S1301-EXIT. DTSCS62
|
|
02493 S1300-EXIT. EXIT. DTSCS62
|
|
02494 DTSCS62
|
|
02495 S1301-ERROR. DTSCS62
|
|
02496 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-STATUS-CD-A. DTSCS62
|
|
02497 IF LCCM-NO-MSG DTSCS62
|
|
02498 SET CURSOR-SET-YES TO TRUE DTSCS62
|
|
02499 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS62
|
|
02500 MOVE CATB-CURSOR TO MAP-STATUS-CD-L. DTSCS62
|
|
02501 S1301-EXIT. EXIT. DTSCS62
|
|
02502 DTSCS62
|
|
02503 S1350-CHECK-OPEN-APPN. DTSCS62
|
|
02504 DTSCS62
|
|
02505 MOVE LOW-VALUES TO MFSL-KEY-AREA. DTSCS62
|
|
02506 MOVE WRK-EMP-NO TO MFSL-EMP-NO. DTSCS62
|
|
02507 MOVE WRK-ASSIGN-NO TO MFSL-ASSIGN-NO. DTSCS62
|
|
02508 SET MFSL-FSL-88 TO TRUE. DTSCS62
|
|
02509 MOVE MFSL-KEY-AREA TO MSKL-KEY-AREA. DTSCS62
|
|
02510 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS62
|
|
02511 IF L810-NO-REC-88 DTSCS62
|
|
02512 GO TO S1350-EXIT. DTSCS62
|
|
02513 DTSCS62
|
|
02514 MOVE 'N' TO WS-REC-FOUND-IND. DTSCS62
|
|
02515 PERFORM P9600-BROWSE-MFSL THRU P9600-EXIT DTSCS62
|
|
02516 UNTIL (L810-NO-REC-88) DTSCS62
|
|
02517 OR DTSCS62
|
|
02518 (WS-REC-FOUND-IND = 'Y'). DTSCS62
|
|
02519 DTSCS62
|
|
02520 S1350-EXIT. EXIT. DTSCS62
|
|
02521 /*****************************************************************DTSCS62
|
|
02522 * *DTSCS62
|
|
02523 ******************************************************************DTSCS62
|
|
02524 S1400-ASSIGN-TYPE. DTSCS62
|
|
02525 DTSCS62
|
|
02526 IF MAP-ASSIGN-TYPE EQUAL LOW-VALUES OR SPACES DTSCS62
|
|
02527 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS62
|
|
02528 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS62
|
|
02529 ELSE DTSCS62
|
|
02530 MOVE MAP-ASSIGN-TYPE TO L063-TYPE DTSCS62
|
|
02531 PERFORM S063-FIELD-ASSIGNMENT-EDIT THRU S063-EXIT DTSCS62
|
|
02532 IF L063-NOT-VALID DTSCS62
|
|
02533 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS62
|
|
02534 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS62
|
|
02535 ELSE DTSCS62
|
|
02536 PERFORM S1410-CROSS-EDITS THRU S1410-EXIT. DTSCS62
|
|
02537 DTSCS62
|
|
02538 S1400-EXIT. EXIT. DTSCS62
|
|
02539 DTSCS62
|
|
02540 S1401-ERROR. DTSCS62
|
|
02541 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-ASSIGN-TYPE-A. DTSCS62
|
|
02542 IF LCCM-NO-MSG DTSCS62
|
|
02543 SET CURSOR-SET-YES TO TRUE DTSCS62
|
|
02544 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS62
|
|
02545 MOVE CATB-CURSOR TO MAP-ASSIGN-TYPE-L. DTSCS62
|
|
02546 S1401-EXIT. EXIT. DTSCS62
|
|
02547 DTSCS62
|
|
02548 S1410-CROSS-EDITS. DTSCS62
|
|
02549 IF NOT L063-AUDIT-88 DTSCS62
|
|
02550 IF MFAS-STATUS-PROCESSED-88 DTSCS62
|
|
02551 MOVE MSG-E621-AREA TO WRK-MSG-AREA DTSCS62
|
|
02552 PERFORM S1401-ERROR THRU S1401-EXIT. DTSCS62
|
|
02553 S1410-EXIT. DTSCS62
|
|
02554 EXIT. DTSCS62
|
|
02555 /*****************************************************************DTSCS62
|
|
02556 * *DTSCS62
|
|
02557 ******************************************************************DTSCS62
|
|
02558 S1500-START-DATE. DTSCS62
|
|
02559 SET WRK-START-DATE-ERROR-NO TO TRUE. DTSCS62
|
|
02560 MOVE +0 TO WRK-START-DATE. DTSCS62
|
|
02561 DTSCS62
|
|
02562 MOVE MAP-START-DATE-AREA TO L015-S-DATE-AREA. DTSCS62
|
|
02563 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS62
|
|
02564 DTSCS62
|
|
02565 IF L015-NO-ENTRY DTSCS62
|
|
02566 IF L063-VERIF-AUDIT-88 DTSCS62
|
|
02567 PERFORM S1550-NEXT-QTR THRU S1550-EXIT DTSCS62
|
|
02568 ELSE DTSCS62
|
|
02569 MOVE LCCM-CURR-RUN-DATE TO WRK-DISPLAY DTSCS62
|
|
02570 WRK-START-DATE DTSCS62
|
|
02571 END-IF DTSCS62
|
|
02572 MOVE WRK-DISPLAY-MO TO MAP-START-DATE-MO DTSCS62
|
|
02573 MOVE WRK-DISPLAY-DA TO MAP-START-DATE-DA DTSCS62
|
|
02574 MOVE WRK-DISPLAY-YR TO MAP-START-DATE-YR DTSCS62
|
|
02575 ELSE DTSCS62
|
|
02576 IF L015-NOT-VALID DTSCS62
|
|
02577 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS62
|
|
02578 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS62
|
|
02579 ELSE DTSCS62
|
|
02580 MOVE L015-DATE TO WRK-START-DATE. DTSCS62
|
|
02581 S1500-EXIT. EXIT. DTSCS62
|
|
02582 DTSCS62
|
|
02583 S1501-ERROR. DTSCS62
|
|
02584 SET WRK-START-DATE-ERROR-YES TO TRUE. DTSCS62
|
|
02585 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-START-DATE-MO-A DTSCS62
|
|
02586 MAP-START-DATE-DA-A DTSCS62
|
|
02587 MAP-START-DATE-YR-A. DTSCS62
|
|
02588 IF LCCM-NO-MSG DTSCS62
|
|
02589 SET CURSOR-SET-YES TO TRUE DTSCS62
|
|
02590 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS62
|
|
02591 MOVE CATB-CURSOR TO MAP-START-DATE-MO-L. DTSCS62
|
|
02592 S1501-EXIT. EXIT. DTSCS62
|
|
02593 DTSCS62
|
|
02594 S1550-NEXT-QTR. DTSCS62
|
|
02595 MOVE LCCM-CURR-RUN-DATE TO L004-DATE. DTSCS62
|
|
02596 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSCS62
|
|
02597 ADD +1 TO L004-ABS-QTR. DTSCS62
|
|
02598 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSCS62
|
|
02599 MOVE L004-QTR-START-DATE TO WRK-DISPLAY DTSCS62
|
|
02600 WRK-START-DATE. DTSCS62
|
|
02601 S1550-EXIT. EXIT. DTSCS62
|
|
02602 /*****************************************************************DTSCS62
|
|
02603 * *DTSCS62
|
|
02604 ******************************************************************DTSCS62
|
|
02605 S1600-DUE-DATE. DTSCS62
|
|
02606 MOVE MAP-DUE-DATE-AREA TO L015-S-DATE-AREA. DTSCS62
|
|
02607 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS62
|
|
02608 DTSCS62
|
|
02609 IF MAP-STATUS-CD = 'K' DTSCS62
|
|
02610 IF L015-NO-ENTRY DTSCS62
|
|
02611 GO TO S1600-EXIT DTSCS62
|
|
02612 ELSE DTSCS62
|
|
02613 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS62
|
|
02614 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS62
|
|
02615 GO TO S1600-EXIT. DTSCS62
|
|
02616 DTSCS62
|
|
02617 IF L015-NO-ENTRY DTSCS62
|
|
02618 IF WRK-START-DATE-ERROR-YES DTSCS62
|
|
02619 NEXT SENTENCE DTSCS62
|
|
02620 ELSE DTSCS62
|
|
02621 IF L063-NO-DEFAULT-DUE-88 DTSCS62
|
|
02622 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS62
|
|
02623 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS62
|
|
02624 ELSE DTSCS62
|
|
02625 IF L063-DEFAULT-DUE-NXT-Q-END-88 DTSCS62
|
|
02626 MOVE LCCM-CURR-RUN-DATE TO L004-DATE DTSCS62
|
|
02627 PERFORM S004-FROM-DATE THRU S004-EXIT DTSCS62
|
|
02628 ADD +1 TO L004-ABS-QTR DTSCS62
|
|
02629 PERFORM S004-FROM-ABS THRU S004-EXIT DTSCS62
|
|
02630 MOVE L004-QTR-END-DATE TO WRK-DISPLAY DTSCS62
|
|
02631 MOVE WRK-DISPLAY-MO TO MAP-DUE-DATE-MO DTSCS62
|
|
02632 MOVE WRK-DISPLAY-DA TO MAP-DUE-DATE-DA DTSCS62
|
|
02633 MOVE WRK-DISPLAY-YR TO MAP-DUE-DATE-YR DTSCS62
|
|
02634 PERFORM S1610-START-DUE-CROSS-EDIT THRU S1610-EXIT DTSCS62
|
|
02635 ELSE DTSCS62
|
|
02636 MOVE WRK-START-DATE TO L001-FED-8-DATE-9 DTSCS62
|
|
02637 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCS62
|
|
02638 ADD L063-DEFAULT-DUE-DAYS TO L001-JUL-ABS-DAY DTSCS62
|
|
02639 PERFORM S001-FROM-ABS-DATE THRU S001-EXIT DTSCS62
|
|
02640 MOVE L001-FED-8-DATE-9 TO WRK-DISPLAY DTSCS62
|
|
02641 MOVE WRK-DISPLAY-MO TO MAP-DUE-DATE-MO DTSCS62
|
|
02642 MOVE WRK-DISPLAY-DA TO MAP-DUE-DATE-DA DTSCS62
|
|
02643 MOVE WRK-DISPLAY-YR TO MAP-DUE-DATE-YR DTSCS62
|
|
02644 PERFORM S1610-START-DUE-CROSS-EDIT THRU S1610-EXIT DTSCS62
|
|
02645 ELSE DTSCS62
|
|
02646 IF L015-NOT-VALID DTSCS62
|
|
02647 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS62
|
|
02648 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS62
|
|
02649 ELSE DTSCS62
|
|
02650 PERFORM S1610-START-DUE-CROSS-EDIT THRU S1610-EXIT. DTSCS62
|
|
02651 S1600-EXIT. EXIT. DTSCS62
|
|
02652 DTSCS62
|
|
02653 S1601-ERROR. DTSCS62
|
|
02654 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-DUE-DATE-MO-A DTSCS62
|
|
02655 MAP-DUE-DATE-DA-A DTSCS62
|
|
02656 MAP-DUE-DATE-YR-A. DTSCS62
|
|
02657 IF LCCM-NO-MSG DTSCS62
|
|
02658 SET CURSOR-SET-YES TO TRUE DTSCS62
|
|
02659 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS62
|
|
02660 MOVE CATB-CURSOR TO MAP-DUE-DATE-MO-L. DTSCS62
|
|
02661 S1601-EXIT. EXIT. DTSCS62
|
|
02662 DTSCS62
|
|
02663 S1610-START-DUE-CROSS-EDIT. DTSCS62
|
|
02664 IF WRK-START-DATE = +0 DTSCS62
|
|
02665 GO TO S1610-EXIT. DTSCS62
|
|
02666 DTSCS62
|
|
02667 MOVE MAP-DUE-DATE-AREA TO L015-S-DATE-AREA. DTSCS62
|
|
02668 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS62
|
|
02669 IF L015-VALID DTSCS62
|
|
02670 NEXT SENTENCE DTSCS62
|
|
02671 ELSE DTSCS62
|
|
02672 GO TO S1610-EXIT. DTSCS62
|
|
02673 DTSCS62
|
|
02674 IF WRK-START-DATE > L015-DATE DTSCS62
|
|
02675 MOVE MSG-E62C-AREA TO WRK-MSG-AREA DTSCS62
|
|
02676 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS62
|
|
02677 PERFORM S1601-ERROR THRU S1601-EXIT. DTSCS62
|
|
02678 S1610-EXIT. DTSCS62
|
|
02679 EXIT. DTSCS62
|
|
02680 /*****************************************************************DTSCS62
|
|
02681 * *DTSCS62
|
|
02682 ******************************************************************DTSCS62
|
|
02683 S1700-FLD-REP-ID. DTSCS62
|
|
02684 IF MAP-FLD-REP-ID EQUAL LOW-VALUES OR SPACES DTSCS62
|
|
02685 PERFORM S1710-GET-REP THRU S1710-EXIT DTSCS62
|
|
02686 ELSE DTSCS62
|
|
02687 MOVE MAP-FLD-REP-ID TO L062-FLD-REP-ID DTSCS62
|
|
02688 PERFORM S062-FLD-REP-ID-DESC THRU S062-EXIT DTSCS62
|
|
02689 IF L062-NOT-VALID DTSCS62
|
|
02690 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS62
|
|
02691 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS62
|
|
02692 ELSE DTSCS62
|
|
02693 NEXT SENTENCE. DTSCS62
|
|
02694 S1700-EXIT. EXIT. DTSCS62
|
|
02695 DTSCS62
|
|
02696 S1701-ERROR. DTSCS62
|
|
02697 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-FLD-REP-ID-A. DTSCS62
|
|
02698 IF LCCM-NO-MSG DTSCS62
|
|
02699 SET CURSOR-SET-YES TO TRUE DTSCS62
|
|
02700 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS62
|
|
02701 MOVE CATB-CURSOR TO MAP-FLD-REP-ID-L. DTSCS62
|
|
02702 S1701-EXIT. EXIT. DTSCS62
|
|
02703 DTSCS62
|
|
02704 S1710-GET-REP. DTSCS62
|
|
02705 IF LCCM-OP-IS-FLD-DESK-88 DTSCS62
|
|
02706 MOVE MPRF-FLD-ZIP TO L061-FLD-ZIP DTSCS62
|
|
02707 MOVE MPRF-FLD-ST TO L061-FLD-ST DTSCS62
|
|
02708 MOVE MPRF-EMP-NO TO L061-EMP-NO DTSCS62
|
|
02709 PERFORM S061-FIELD-ZIP-REP-ID THRU S061-EXIT DTSCS62
|
|
02710 MOVE L061-FLD-REP-ID TO MAP-FLD-REP-ID DTSCS62
|
|
02711 ELSE DTSCS62
|
|
02712 IF L063-ACCOUNTING-YES-88 DTSCS62
|
|
02713 MOVE 'AD' TO MAP-FLD-REP-ID DTSCS62
|
|
02714 ELSE DTSCS62
|
|
02715 MOVE 'FD' TO MAP-FLD-REP-ID DTSCS62
|
|
02716 END-IF DTSCS62
|
|
02717 END-IF. DTSCS62
|
|
02718 S1710-EXIT. DTSCS62
|
|
02719 EXIT. DTSCS62
|
|
02720 /*****************************************************************DTSCS62
|
|
02721 * *DTSCS62
|
|
02722 ******************************************************************DTSCS62
|
|
02723 S1800-ATTACHMENTS. DTSCS62
|
|
02724 IF (MAP-ATTACHMENTS-IND = LOW-VALUES OR SPACES) DTSCS62
|
|
02725 MOVE L063-DEFAULT-ATTACH-IND TO MAP-ATTACHMENTS-IND DTSCS62
|
|
02726 ELSE DTSCS62
|
|
02727 IF MAP-ATTACHMENTS-IND-VALID DTSCS62
|
|
02728 NEXT SENTENCE DTSCS62
|
|
02729 ELSE DTSCS62
|
|
02730 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS62
|
|
02731 PERFORM S1801-ERROR THRU S1801-EXIT. DTSCS62
|
|
02732 S1800-EXIT. EXIT. DTSCS62
|
|
02733 DTSCS62
|
|
02734 S1801-ERROR. DTSCS62
|
|
02735 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ATTACHMENTS-IND-A. DTSCS62
|
|
02736 IF LCCM-NO-MSG DTSCS62
|
|
02737 SET CURSOR-SET-YES TO TRUE DTSCS62
|
|
02738 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS62
|
|
02739 MOVE CATB-CURSOR TO MAP-ATTACHMENTS-IND-L. DTSCS62
|
|
02740 S1801-EXIT. EXIT. DTSCS62
|
|
02741 /*****************************************************************DTSCS62
|
|
02742 * *DTSCS62
|
|
02743 ******************************************************************DTSCS62
|
|
02744 S1900-SOURCE-OP-ID. DTSCS62
|
|
02745 IF MAP-SOURCE-OP-ID EQUAL LOW-VALUES OR SPACES DTSCS62
|
|
02746 MOVE LCCM-RESP-OP-ID TO MAP-SOURCE-OP-ID. DTSCS62
|
|
02747 DTSCS62
|
|
02748 IF MAP-SOURCE-OP-ID = 'SYSTEM' DTSCS62
|
|
02749 MOVE LCCM-OP-ID TO MAP-SOURCE-OP-ID DTSCS62
|
|
02750 ELSE DTSCS62
|
|
02751 IF MAP-SOURCE-OP-ID = LCCM-OP-ID DTSCS62
|
|
02752 NEXT SENTENCE DTSCS62
|
|
02753 ELSE DTSCS62
|
|
02754 MOVE MAP-SOURCE-OP-ID TO L082-OP-ID DTSCS62
|
|
02755 PERFORM S082-OP-ID-EDIT THRU S082-EXIT DTSCS62
|
|
02756 IF L082-INTERNAL-88 DTSCS62
|
|
02757 OR L082-NOT-VALID-OP DTSCS62
|
|
02758 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS62
|
|
02759 PERFORM S1901-ERROR THRU S1901-EXIT DTSCS62
|
|
02760 GO TO S1900-EXIT DTSCS62
|
|
02761 END-IF DTSCS62
|
|
02762 END-IF DTSCS62
|
|
02763 END-IF. DTSCS62
|
|
02764 SKIP3 DTSCS62
|
|
02765 ***** DTSCS62
|
|
02766 * DTSCS62
|
|
02767 * FOLLOWING LINE OF CODE COMMENTED OUT AS INAPPROPRIATE FOR DTSCS62
|
|
02768 * SCREEN 62. PER HELENA AND MARY. 01/24/95. DTSCS62
|
|
02769 * DTSCS62
|
|
02770 ***** DTSCS62
|
|
02771 DTSCS62
|
|
02772 *****MOVE MAP-SOURCE-OP-ID TO LCCM-RESP-OP-ID. DTSCS62
|
|
02773 S1900-EXIT. EXIT. DTSCS62
|
|
02774 DTSCS62
|
|
02775 S1901-ERROR. DTSCS62
|
|
02776 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-SOURCE-OP-ID-A. DTSCS62
|
|
02777 IF LCCM-NO-MSG DTSCS62
|
|
02778 SET CURSOR-SET-YES TO TRUE DTSCS62
|
|
02779 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS62
|
|
02780 MOVE CATB-CURSOR TO MAP-SOURCE-OP-ID-L. DTSCS62
|
|
02781 S1901-EXIT. EXIT. DTSCS62
|
|
02782 /*****************************************************************DTSCS62
|
|
02783 * *DTSCS62
|
|
02784 ******************************************************************DTSCS62
|
|
02785 S2000-TAX-EXTRACT. DTSCS62
|
|
02786 IF MAP-TAX-EXTRACT EQUAL LOW-VALUES OR SPACES DTSCS62
|
|
02787 SET MAP-TAX-EXTRACT-NO TO TRUE DTSCS62
|
|
02788 ELSE DTSCS62
|
|
02789 IF NOT MAP-TAX-EXTRACT-VALID DTSCS62
|
|
02790 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS62
|
|
02791 PERFORM S2001-ERROR THRU S2001-EXIT DTSCS62
|
|
02792 ELSE DTSCS62
|
|
02793 IF MAP-TAX-EXTRACT-YES DTSCS62
|
|
02794 SET WRK-EXTRACT-REQ-YES-88 TO TRUE. DTSCS62
|
|
02795 DTSCS62
|
|
02796 IF MAP-TAX-EXTRACT-YES DTSCS62
|
|
02797 IF MPRF-NOT-WRITTEN-OFF-88 DTSCS62
|
|
02798 NEXT SENTENCE DTSCS62
|
|
02799 ELSE DTSCS62
|
|
02800 MOVE MSG-E62E-AREA TO WRK-MSG-AREA DTSCS62
|
|
02801 PERFORM S2001-ERROR THRU S2001-EXIT. DTSCS62
|
|
02802 S2000-EXIT. EXIT. DTSCS62
|
|
02803 DTSCS62
|
|
02804 S2001-ERROR. DTSCS62
|
|
02805 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-TAX-EXTRACT-A. DTSCS62
|
|
02806 IF LCCM-NO-MSG DTSCS62
|
|
02807 SET CURSOR-SET-YES TO TRUE DTSCS62
|
|
02808 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS62
|
|
02809 MOVE CATB-CURSOR TO MAP-TAX-EXTRACT-L. DTSCS62
|
|
02810 S2001-EXIT. EXIT. DTSCS62
|
|
02811 /*****************************************************************DTSCS62
|
|
02812 * *DTSCS62
|
|
02813 ******************************************************************DTSCS62
|
|
02814 S2100-WAGE-EXTRACT. DTSCS62
|
|
02815 IF MAP-WAGE-EXTRACT EQUAL LOW-VALUES OR SPACES DTSCS62
|
|
02816 SET MAP-WAGE-EXTRACT-NO TO TRUE DTSCS62
|
|
02817 ELSE DTSCS62
|
|
02818 IF NOT MAP-WAGE-EXTRACT-VALID DTSCS62
|
|
02819 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS62
|
|
02820 PERFORM S2101-ERROR THRU S2101-EXIT DTSCS62
|
|
02821 ELSE DTSCS62
|
|
02822 IF MAP-WAGE-EXTRACT-YES DTSCS62
|
|
02823 SET WRK-EXTRACT-REQ-YES-88 TO TRUE. DTSCS62
|
|
02824 DTSCS62
|
|
02825 IF MAP-WAGE-EXTRACT-YES DTSCS62
|
|
02826 IF MPRF-NOT-WRITTEN-OFF-88 DTSCS62
|
|
02827 NEXT SENTENCE DTSCS62
|
|
02828 ELSE DTSCS62
|
|
02829 MOVE MSG-E62E-AREA TO WRK-MSG-AREA DTSCS62
|
|
02830 PERFORM S2101-ERROR THRU S2101-EXIT. DTSCS62
|
|
02831 S2100-EXIT. EXIT. DTSCS62
|
|
02832 DTSCS62
|
|
02833 S2101-ERROR. DTSCS62
|
|
02834 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-WAGE-EXTRACT-A. DTSCS62
|
|
02835 IF LCCM-NO-MSG DTSCS62
|
|
02836 SET CURSOR-SET-YES TO TRUE DTSCS62
|
|
02837 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS62
|
|
02838 MOVE CATB-CURSOR TO MAP-WAGE-EXTRACT-L. DTSCS62
|
|
02839 S2101-EXIT. EXIT. DTSCS62
|
|
02840 /*****************************************************************DTSCS62
|
|
02841 * DTSCS62
|
|
02842 ******************************************************************DTSCS62
|
|
02843 S2200-QTR-RANGE. DTSCS62
|
|
02844 MOVE MAP-AUDIT-START-YRQ-AREA TO L024-S-START-YRQ-AREA. DTSCS62
|
|
02845 DTSCS62
|
|
02846 MOVE MAP-AUDIT-END-YRQ-AREA TO L024-S-END-YRQ-AREA. DTSCS62
|
|
02847 DTSCS62
|
|
02848 PERFORM S024-EDIT-QTR-SPAN THRU S024-EXIT. DTSCS62
|
|
02849 DTSCS62
|
|
02850 DTSCS62
|
|
02851 IF LCCM-F05-88 DTSCS62
|
|
02852 PERFORM S2210-EXTRACT-ONLY-EDITS THRU S2210-EXIT DTSCS62
|
|
02853 GO TO S2200-EXIT. DTSCS62
|
|
02854 DTSCS62
|
|
02855 DTSCS62
|
|
02856 IF L024-START-NO-ENTRY DTSCS62
|
|
02857 IF L063-AUDIT-88 DTSCS62
|
|
02858 MOVE MSG-E62B-AREA TO WRK-MSG-AREA DTSCS62
|
|
02859 PERFORM S2201-ERROR THRU S2201-EXIT DTSCS62
|
|
02860 ELSE DTSCS62
|
|
02861 IF WRK-EXTRACT-REQ-YES-88 DTSCS62
|
|
02862 MOVE MSG-E629-AREA TO WRK-MSG-AREA DTSCS62
|
|
02863 PERFORM S2201-ERROR THRU S2201-EXIT DTSCS62
|
|
02864 ELSE DTSCS62
|
|
02865 NEXT SENTENCE DTSCS62
|
|
02866 ELSE DTSCS62
|
|
02867 IF L024-START-NOT-VALID DTSCS62
|
|
02868 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS62
|
|
02869 PERFORM S2201-ERROR THRU S2201-EXIT DTSCS62
|
|
02870 ELSE DTSCS62
|
|
02871 IF (L063-NON-AUDIT-88) DTSCS62
|
|
02872 AND DTSCS62
|
|
02873 (MFAS-NON-AUDIT-88) DTSCS62
|
|
02874 AND DTSCS62
|
|
02875 (WRK-EXTRACT-REQ-NO-88) DTSCS62
|
|
02876 AND DTSCS62
|
|
02877 (L024-START-YRQ NOT = MFAS-START-YRQ) DTSCS62
|
|
02878 MOVE MSG-E62A-AREA TO WRK-MSG-AREA DTSCS62
|
|
02879 PERFORM S2201-ERROR THRU S2201-EXIT. DTSCS62
|
|
02880 DTSCS62
|
|
02881 DTSCS62
|
|
02882 IF L024-END-NO-ENTRY DTSCS62
|
|
02883 IF L063-AUDIT-88 DTSCS62
|
|
02884 MOVE MSG-E62B-AREA TO WRK-MSG-AREA DTSCS62
|
|
02885 PERFORM S2203-ERROR THRU S2203-EXIT DTSCS62
|
|
02886 ELSE DTSCS62
|
|
02887 IF WRK-EXTRACT-REQ-YES-88 DTSCS62
|
|
02888 MOVE MSG-E629-AREA TO WRK-MSG-AREA DTSCS62
|
|
02889 PERFORM S2203-ERROR THRU S2203-EXIT DTSCS62
|
|
02890 ELSE DTSCS62
|
|
02891 NEXT SENTENCE DTSCS62
|
|
02892 ELSE DTSCS62
|
|
02893 IF L024-END-NOT-VALID OR L024-END-COPIED-FROM-START DTSCS62
|
|
02894 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS62
|
|
02895 PERFORM S2203-ERROR THRU S2203-EXIT DTSCS62
|
|
02896 ELSE DTSCS62
|
|
02897 IF (L063-NON-AUDIT-88) DTSCS62
|
|
02898 AND DTSCS62
|
|
02899 (MFAS-NON-AUDIT-88) DTSCS62
|
|
02900 AND DTSCS62
|
|
02901 (WRK-EXTRACT-REQ-NO-88) DTSCS62
|
|
02902 AND DTSCS62
|
|
02903 (L024-END-YRQ NOT = MFAS-END-YRQ) DTSCS62
|
|
02904 MOVE MSG-E62A-AREA TO WRK-MSG-AREA DTSCS62
|
|
02905 PERFORM S2203-ERROR THRU S2203-EXIT. DTSCS62
|
|
02906 DTSCS62
|
|
02907 DTSCS62
|
|
02908 IF L024-START-VALID AND L024-END-VALID DTSCS62
|
|
02909 NEXT SENTENCE DTSCS62
|
|
02910 ELSE DTSCS62
|
|
02911 GO TO S2200-EXIT. DTSCS62
|
|
02912 DTSCS62
|
|
02913 DTSCS62
|
|
02914 IF L024-SPAN-INVALID DTSCS62
|
|
02915 OR L024-END-BEFORE-START DTSCS62
|
|
02916 OR L024-QTRS-SPANNED > +12 DTSCS62
|
|
02917 MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS62
|
|
02918 PERFORM S2201-ERROR THRU S2201-EXIT DTSCS62
|
|
02919 PERFORM S2203-ERROR THRU S2203-EXIT DTSCS62
|
|
02920 END-IF. DTSCS62
|
|
02921 S2200-EXIT. EXIT. DTSCS62
|
|
02922 DTSCS62
|
|
02923 S2201-ERROR. DTSCS62
|
|
02924 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-AUDIT-START-YR-A DTSCS62
|
|
02925 MAP-AUDIT-START-Q-A DTSCS62
|
|
02926 IF LCCM-NO-MSG DTSCS62
|
|
02927 SET CURSOR-SET-YES TO TRUE DTSCS62
|
|
02928 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS62
|
|
02929 MOVE CATB-CURSOR TO MAP-AUDIT-START-YR-L. DTSCS62
|
|
02930 S2201-EXIT. EXIT. DTSCS62
|
|
02931 DTSCS62
|
|
02932 S2203-ERROR. DTSCS62
|
|
02933 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-AUDIT-END-YR-A DTSCS62
|
|
02934 MAP-AUDIT-END-Q-A DTSCS62
|
|
02935 IF LCCM-NO-MSG DTSCS62
|
|
02936 SET CURSOR-SET-YES TO TRUE DTSCS62
|
|
02937 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS62
|
|
02938 MOVE CATB-CURSOR TO MAP-AUDIT-END-YR-L. DTSCS62
|
|
02939 S2203-EXIT. EXIT. DTSCS62
|
|
02940 DTSCS62
|
|
02941 DTSCS62
|
|
02942 DTSCS62
|
|
02943 S2210-EXTRACT-ONLY-EDITS. DTSCS62
|
|
02944 IF L024-START-NO-ENTRY DTSCS62
|
|
02945 MOVE MSG-E629-AREA TO WRK-MSG-AREA DTSCS62
|
|
02946 PERFORM S2201-ERROR THRU S2201-EXIT DTSCS62
|
|
02947 ELSE DTSCS62
|
|
02948 IF L024-START-NOT-VALID DTSCS62
|
|
02949 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS62
|
|
02950 PERFORM S2201-ERROR THRU S2201-EXIT DTSCS62
|
|
02951 ELSE DTSCS62
|
|
02952 IF MFAS-AUDIT-88 DTSCS62
|
|
02953 IF L024-START-YRQ = MFAS-START-YRQ DTSCS62
|
|
02954 NEXT SENTENCE DTSCS62
|
|
02955 ELSE DTSCS62
|
|
02956 MOVE MSG-E62G-AREA TO WRK-MSG-AREA DTSCS62
|
|
02957 PERFORM S2201-ERROR THRU S2201-EXIT. DTSCS62
|
|
02958 DTSCS62
|
|
02959 DTSCS62
|
|
02960 IF L024-END-NO-ENTRY DTSCS62
|
|
02961 MOVE MSG-E629-AREA TO WRK-MSG-AREA DTSCS62
|
|
02962 PERFORM S2203-ERROR THRU S2203-EXIT DTSCS62
|
|
02963 ELSE DTSCS62
|
|
02964 IF L024-END-NOT-VALID OR L024-END-COPIED-FROM-START DTSCS62
|
|
02965 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS62
|
|
02966 PERFORM S2203-ERROR THRU S2203-EXIT DTSCS62
|
|
02967 ELSE DTSCS62
|
|
02968 IF MFAS-AUDIT-88 DTSCS62
|
|
02969 IF L024-END-YRQ = MFAS-END-YRQ DTSCS62
|
|
02970 NEXT SENTENCE DTSCS62
|
|
02971 ELSE DTSCS62
|
|
02972 MOVE MSG-E62G-AREA TO WRK-MSG-AREA DTSCS62
|
|
02973 PERFORM S2203-ERROR THRU S2203-EXIT. DTSCS62
|
|
02974 DTSCS62
|
|
02975 DTSCS62
|
|
02976 IF L024-START-VALID AND L024-END-VALID DTSCS62
|
|
02977 NEXT SENTENCE DTSCS62
|
|
02978 ELSE DTSCS62
|
|
02979 GO TO S2210-EXIT. DTSCS62
|
|
02980 DTSCS62
|
|
02981 DTSCS62
|
|
02982 IF (L024-SPAN-INVALID) DTSCS62
|
|
02983 OR DTSCS62
|
|
02984 (L024-END-BEFORE-START) DTSCS62
|
|
02985 OR DTSCS62
|
|
02986 (L024-QTRS-SPANNED > +12) DTSCS62
|
|
02987 MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS62
|
|
02988 PERFORM S2201-ERROR THRU S2201-EXIT DTSCS62
|
|
02989 PERFORM S2203-ERROR THRU S2203-EXIT. DTSCS62
|
|
02990 S2210-EXIT. DTSCS62
|
|
02991 EXIT. DTSCS62
|
|
02992 /*****************************************************************DTSCS62
|
|
02993 * DTSCS62
|
|
02994 ******************************************************************DTSCS62
|
|
02995 S2300-EMP-SIZE-IND. DTSCS62
|
|
02996 IF MAP-EMP-SIZE-IND = LOW-VALUES DTSCS62
|
|
02997 MOVE SPACES TO MAP-EMP-SIZE-IND. DTSCS62
|
|
02998 SKIP1 DTSCS62
|
|
02999 IF MAP-EMP-SIZE-IND = SPACES DTSCS62
|
|
03000 IF L063-NON-AUDIT-88 DTSCS62
|
|
03001 NEXT SENTENCE DTSCS62
|
|
03002 ELSE DTSCS62
|
|
03003 MOVE 'S' TO MAP-EMP-SIZE-IND DTSCS62
|
|
03004 ELSE DTSCS62
|
|
03005 IF MAP-EMP-SIZE-IND-VALID DTSCS62
|
|
03006 IF L063-NON-AUDIT-88 DTSCS62
|
|
03007 MOVE MSG-E62A-AREA TO WRK-MSG-AREA DTSCS62
|
|
03008 PERFORM S2301-ERROR THRU S2301-EXIT DTSCS62
|
|
03009 ELSE DTSCS62
|
|
03010 NEXT SENTENCE DTSCS62
|
|
03011 ELSE DTSCS62
|
|
03012 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS62
|
|
03013 PERFORM S2301-ERROR THRU S2301-EXIT. DTSCS62
|
|
03014 DTSCS62
|
|
03015 S2300-EXIT. EXIT. DTSCS62
|
|
03016 DTSCS62
|
|
03017 S2301-ERROR. DTSCS62
|
|
03018 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-EMP-SIZE-IND-A. DTSCS62
|
|
03019 IF LCCM-NO-MSG DTSCS62
|
|
03020 SET CURSOR-SET-YES TO TRUE DTSCS62
|
|
03021 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS62
|
|
03022 MOVE CATB-CURSOR TO MAP-EMP-SIZE-IND-L. DTSCS62
|
|
03023 S2301-EXIT. EXIT. DTSCS62
|
|
03024 /*****************************************************************DTSCS62
|
|
03025 * DTSCS62
|
|
03026 ******************************************************************DTSCS62
|
|
03027 *S2200-SIC-OWN-CD. DTSCS62
|
|
03028 *****IF MAP-SIC-CD = LOW-VALUES DTSCS62
|
|
03029 ***** MOVE SPACES TO MAP-SIC-CD. DTSCS62
|
|
03030 ***** DTSCS62
|
|
03031 *****IF MAP-OWN-CD = LOW-VALUES DTSCS62
|
|
03032 ***** MOVE SPACES TO MAP-OWN-CD. DTSCS62
|
|
03033 ***** DTSCS62
|
|
03034 *****IF (MAP-SIC-CD = SPACES) DTSCS62
|
|
03035 ***** AND DTSCS62
|
|
03036 ***** (MAP-OWN-CD = SPACES) DTSCS62
|
|
03037 ***** IF WRK-ASSIGN-TYPE-ERROR-YES DTSCS62
|
|
03038 ***** GO TO S2200-EXIT DTSCS62
|
|
03039 ***** ELSE DTSCS62
|
|
03040 ***** IF L063-AUDIT-88 DTSCS62
|
|
03041 ***** MOVE MPRF-SIC-CD TO MAP-SIC-CD DTSCS62
|
|
03042 ***** MOVE MPRF-OWN-CD TO MAP-OWN-CD DTSCS62
|
|
03043 ***** GO TO S2200-EXIT DTSCS62
|
|
03044 ***** ELSE DTSCS62
|
|
03045 ***** GO TO S2200-EXIT. DTSCS62
|
|
03046 ***** DTSCS62
|
|
03047 *****MOVE MAP-SIC-CD TO L039-SIC-CD. DTSCS62
|
|
03048 *****MOVE MAP-OWN-CD TO L039-OWN-CD. DTSCS62
|
|
03049 ***** DTSCS62
|
|
03050 *****PERFORM S039-SIC-OWN-CODE-EDIT THRU S039-EXIT. DTSCS62
|
|
03051 ***** DTSCS62
|
|
03052 *****IF L039-SIC-NOT-VALID DTSCS62
|
|
03053 ***** MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS62
|
|
03054 ***** PERFORM S2201-ERROR THRU S2201-EXIT. DTSCS62
|
|
03055 ***** DTSCS62
|
|
03056 *****IF L039-OWN-NOT-VALID DTSCS62
|
|
03057 ***** MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS62
|
|
03058 ***** PERFORM S2202-ERROR THRU S2202-EXIT. DTSCS62
|
|
03059 *S2200-EXIT. EXIT. DTSCS62
|
|
03060 DTSCS62
|
|
03061 *S2201-ERROR. DTSCS62
|
|
03062 *****MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS62
|
|
03063 ***** TO MAP-SIC-CD-A. DTSCS62
|
|
03064 *****IF LCCM-NO-MSG DTSCS62
|
|
03065 ***** SET CURSOR-SET-YES TO TRUE DTSCS62
|
|
03066 ***** MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS62
|
|
03067 ***** MOVE CATB-CURSOR TO MAP-SIC-CD-L. DTSCS62
|
|
03068 *S2201-EXIT. EXIT. DTSCS62
|
|
03069 DTSCS62
|
|
03070 *S2202-ERROR. DTSCS62
|
|
03071 *****MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS62
|
|
03072 ***** TO MAP-OWN-CD-A. DTSCS62
|
|
03073 *****IF LCCM-NO-MSG DTSCS62
|
|
03074 ***** SET CURSOR-SET-YES TO TRUE DTSCS62
|
|
03075 ***** MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS62
|
|
03076 ***** MOVE CATB-CURSOR TO MAP-OWN-CD-L. DTSCS62
|
|
03077 *S2202-EXIT. EXIT. DTSCS62
|
|
03078 /*****************************************************************DTSCS62
|
|
03079 * DTSCS62
|
|
03080 ******************************************************************DTSCS62
|
|
03081 S2400-AUDIT-SEL-REASON. DTSCS62
|
|
03082 INSPECT MAP-AUDIT-SEL-REASON (WRK-CTR) DTSCS62
|
|
03083 CONVERTING LOW-VALUES TO SPACES. DTSCS62
|
|
03084 DTSCS62
|
|
03085 IF MAP-AUDIT-SEL-REASON (WRK-CTR) = SPACES DTSCS62
|
|
03086 IF L063-AUDIT-88 DTSCS62
|
|
03087 AND WRK-CTR = 1 DTSCS62
|
|
03088 SET MAP-AUDIT-SEL-DEFAULT-88 (WRK-CTR) TO TRUE DTSCS62
|
|
03089 GO TO S2400-EXIT DTSCS62
|
|
03090 ELSE DTSCS62
|
|
03091 GO TO S2400-EXIT. DTSCS62
|
|
03092 DTSCS62
|
|
03093 IF L063-NON-AUDIT-88 DTSCS62
|
|
03094 MOVE MSG-E62A-AREA TO WRK-MSG-AREA DTSCS62
|
|
03095 PERFORM S2401-ERROR THRU S2401-EXIT DTSCS62
|
|
03096 GO TO S2400-EXIT. DTSCS62
|
|
03097 DTSCS62
|
|
03098 MOVE MAP-AUDIT-SEL-REASON (WRK-CTR) TO L036-CD. DTSCS62
|
|
03099 PERFORM S036-AUDIT-SEL-REASON THRU S036-EXIT. DTSCS62
|
|
03100 DTSCS62
|
|
03101 IF L036-NOT-VALID DTSCS62
|
|
03102 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS62
|
|
03103 PERFORM S2401-ERROR THRU S2401-EXIT. DTSCS62
|
|
03104 S2400-EXIT. EXIT. DTSCS62
|
|
03105 DTSCS62
|
|
03106 S2401-ERROR. DTSCS62
|
|
03107 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS62
|
|
03108 TO MAP-AUDIT-SEL-REASON-A (WRK-CTR). DTSCS62
|
|
03109 IF LCCM-NO-MSG DTSCS62
|
|
03110 SET CURSOR-SET-YES TO TRUE DTSCS62
|
|
03111 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS62
|
|
03112 MOVE CATB-CURSOR TO MAP-AUDIT-SEL-REASON-L(WRK-CTR). DTSCS62
|
|
03113 S2401-EXIT. EXIT. DTSCS62
|
|
03114 /*****************************************************************DTSCS62
|
|
03115 * *DTSCS62
|
|
03116 ******************************************************************DTSCS62
|
|
03117 *S2400-COPIES. DTSCS62
|
|
03118 ***** DTSCS62
|
|
03119 * DTSCS62
|
|
03120 * LYNNETTE WISHES THAT MAP-COPIES SHOULD ALWAYS DEFAULT TO 0. DTSCS62
|
|
03121 * HER WISH IS OUR COMMAND. 05/10/95 DTSCS62
|
|
03122 * DTSCS62
|
|
03123 ***** DTSCS62
|
|
03124 * DTSCS62
|
|
03125 * IF MAP-COPIES = LOW-VALUE OR SPACE DTSCS62
|
|
03126 * IF MAP-STATUS-CD = 'C' OR 'P' OR 'K' DTSCS62
|
|
03127 * MOVE '0' TO MAP-COPIES DTSCS62
|
|
03128 * ELSE DTSCS62
|
|
03129 * IF LCCM-OP-IS-FLD-DESK-88 DTSCS62
|
|
03130 * MOVE '0' TO MAP-COPIES DTSCS62
|
|
03131 * ELSE DTSCS62
|
|
03132 * MOVE '0' TO MAP-COPIES DTSCS62
|
|
03133 *********MOVE MAP-CLAIMANT-SSN-AREA TO L020-S-SSN-AREA DTSCS62
|
|
03134 *********PERFORM S020-SSN-FROM-SCREEN THRU S020-EXIT DTSCS62
|
|
03135 *********MOVE MAP-RELATED-EMP-NO-AREA TO L018-S-EMP-NO-AREA DTSCS62
|
|
03136 *********PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT DTSCS62
|
|
03137 *********IF L018-NO-ENTRY DTSCS62
|
|
03138 *********AND L020-NO-ENTRY DTSCS62
|
|
03139 ********* MOVE '0' TO MAP-COPIES DTSCS62
|
|
03140 *********ELSE DTSCS62
|
|
03141 *********IF L020-NO-ENTRY DTSCS62
|
|
03142 *********OR L018-NO-ENTRY DTSCS62
|
|
03143 ********* MOVE '0' TO MAP-COPIES DTSCS62
|
|
03144 *********ELSE DTSCS62
|
|
03145 ********* MOVE '0' TO MAP-COPIES DTSCS62
|
|
03146 * ELSE DTSCS62
|
|
03147 * IF NOT MAP-COPIES-VALID DTSCS62
|
|
03148 * MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS62
|
|
03149 * PERFORM S2401-ERROR THRU S2401-EXIT. DTSCS62
|
|
03150 *S2400-EXIT. EXIT. DTSCS62
|
|
03151 DTSCS62
|
|
03152 *S2401-ERROR. DTSCS62
|
|
03153 * MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-COPIES-A. DTSCS62
|
|
03154 * IF LCCM-NO-MSG DTSCS62
|
|
03155 * SET CURSOR-SET-YES TO TRUE DTSCS62
|
|
03156 * MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS62
|
|
03157 * MOVE CATB-CURSOR TO MAP-COPIES-L. DTSCS62
|
|
03158 *S2401-EXIT. EXIT. DTSCS62
|
|
03159 /*****************************************************************DTSCS62
|
|
03160 * *DTSCS62
|
|
03161 ******************************************************************DTSCS62
|
|
03162 *S2500-PRINTER-ID. DTSCS62
|
|
03163 * IF MAP-PRINTER-ID EQUAL LOW-VALUES OR SPACES DTSCS62
|
|
03164 * IF LCCM-NO-PRINTER DTSCS62
|
|
03165 * AND MAP-COPIES NOT = '0' DTSCS62
|
|
03166 * MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS62
|
|
03167 * PERFORM S2501-ERROR THRU S2501-EXIT DTSCS62
|
|
03168 * ELSE DTSCS62
|
|
03169 * MOVE LCCM-PRINTER-ID TO MAP-PRINTER-ID DTSCS62
|
|
03170 * ELSE DTSCS62
|
|
03171 * MOVE MAP-PRINTER-ID TO LCCM-PRINTER-ID. DTSCS62
|
|
03172 *S2500-EXIT. EXIT. DTSCS62
|
|
03173 DTSCS62
|
|
03174 *S2501-ERROR. DTSCS62
|
|
03175 * MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-PRINTER-ID-A. DTSCS62
|
|
03176 * IF LCCM-NO-MSG DTSCS62
|
|
03177 * SET CURSOR-SET-YES TO TRUE DTSCS62
|
|
03178 * MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS62
|
|
03179 * MOVE CATB-CURSOR TO MAP-PRINTER-ID-L. DTSCS62
|
|
03180 *S2501-EXIT. EXIT. DTSCS62
|
|
03181 /*****************************************************************DTSCS62
|
|
03182 * *DTSCS62
|
|
03183 ******************************************************************DTSCS62
|
|
03184 S2500-RELATED-EMP-NO. DTSCS62
|
|
03185 MOVE MAP-RELATED-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS62
|
|
03186 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS62
|
|
03187 IF L018-NO-ENTRY DTSCS62
|
|
03188 GO TO S2500-EXIT. DTSCS62
|
|
03189 DTSCS62
|
|
03190 IF L018-NOT-VALID DTSCS62
|
|
03191 OR L018-EMP-NO = LCCM-EMP-NO DTSCS62
|
|
03192 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS62
|
|
03193 PERFORM S2501-ERROR THRU S2501-EXIT DTSCS62
|
|
03194 GO TO S2500-EXIT. DTSCS62
|
|
03195 DTSCS62
|
|
03196 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS62
|
|
03197 MOVE L018-EMP-NO TO MPRF-EMP-NO. DTSCS62
|
|
03198 SET MPRF-PRF-88 TO TRUE. DTSCS62
|
|
03199 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS62
|
|
03200 PERFORM S810-READ THRU S810-EXIT. DTSCS62
|
|
03201 DTSCS62
|
|
03202 IF L810-NO-REC-88 DTSCS62
|
|
03203 IF L018-EMP-NO = MFAS-RELATED-EMP-NO DTSCS62
|
|
03204 NEXT SENTENCE DTSCS62
|
|
03205 ELSE DTSCS62
|
|
03206 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS62
|
|
03207 PERFORM S2501-ERROR THRU S2501-EXIT DTSCS62
|
|
03208 GO TO S2500-EXIT. DTSCS62
|
|
03209 DTSCS62
|
|
03210 MOVE MSKL-REC TO MPRF-REC. DTSCS62
|
|
03211 IF MPRF-CLASS-CHG-ONLY-88 DTSCS62
|
|
03212 MOVE MSG-E625-AREA TO WRK-MSG-AREA DTSCS62
|
|
03213 PERFORM S2501-ERROR THRU S2501-EXIT. DTSCS62
|
|
03214 DTSCS62
|
|
03215 *** NEED TO REREAD THE EMPLOYER FOR LATER DTSCS62
|
|
03216 DTSCS62
|
|
03217 PERFORM S1130-READ-MPRF THRU S1130-EXIT. DTSCS62
|
|
03218 S2500-EXIT. EXIT. DTSCS62
|
|
03219 DTSCS62
|
|
03220 S2501-ERROR. DTSCS62
|
|
03221 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-RELATED-EMP-NO-1-A DTSCS62
|
|
03222 MAP-RELATED-EMP-NO-2-A. DTSCS62
|
|
03223 IF LCCM-NO-MSG DTSCS62
|
|
03224 SET CURSOR-SET-YES TO TRUE DTSCS62
|
|
03225 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS62
|
|
03226 MOVE CATB-CURSOR TO MAP-RELATED-EMP-NO-1-L. DTSCS62
|
|
03227 S2501-EXIT. EXIT. DTSCS62
|
|
03228 /*****************************************************************DTSCS62
|
|
03229 * *DTSCS62
|
|
03230 ******************************************************************DTSCS62
|
|
03231 S2600-CLAIMANT-SSN. DTSCS62
|
|
03232 MOVE MAP-CLAIMANT-SSN-AREA TO L020-S-SSN-AREA. DTSCS62
|
|
03233 PERFORM S020-SSN-FROM-SCREEN THRU S020-EXIT. DTSCS62
|
|
03234 IF L020-NO-ENTRY DTSCS62
|
|
03235 NEXT SENTENCE DTSCS62
|
|
03236 ELSE DTSCS62
|
|
03237 IF L020-NOT-VALID DTSCS62
|
|
03238 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS62
|
|
03239 PERFORM S2601-ERROR THRU S2601-EXIT. DTSCS62
|
|
03240 DTSCS62
|
|
03241 S2600-EXIT. EXIT. DTSCS62
|
|
03242 DTSCS62
|
|
03243 S2601-ERROR. DTSCS62
|
|
03244 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-CLAIMANT-SSN-1-A DTSCS62
|
|
03245 MAP-CLAIMANT-SSN-2-A DTSCS62
|
|
03246 MAP-CLAIMANT-SSN-3-A. DTSCS62
|
|
03247 IF LCCM-NO-MSG DTSCS62
|
|
03248 SET CURSOR-SET-YES TO TRUE DTSCS62
|
|
03249 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS62
|
|
03250 MOVE CATB-CURSOR TO MAP-CLAIMANT-SSN-1-L. DTSCS62
|
|
03251 S2601-EXIT. EXIT. DTSCS62
|
|
03252 /*****************************************************************DTSCS62
|
|
03253 * *DTSCS62
|
|
03254 ******************************************************************DTSCS62
|
|
03255 S2700-CLAIMANT-NAME. DTSCS62
|
|
03256 INSPECT MAP-CLAIMANT-NAME DTSCS62
|
|
03257 CONVERTING LOW-VALUES TO SPACES. DTSCS62
|
|
03258 DTSCS62
|
|
03259 IF MAP-CLAIMANT-NAME = SPACES DTSCS62
|
|
03260 IF L020-NO-ENTRY DTSCS62
|
|
03261 GO TO S2700-EXIT. DTSCS62
|
|
03262 DTSCS62
|
|
03263 IF L020-NOT-VALID DTSCS62
|
|
03264 GO TO S2700-EXIT. DTSCS62
|
|
03265 DTSCS62
|
|
03266 IF L020-NO-ENTRY DTSCS62
|
|
03267 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS62
|
|
03268 PERFORM S2701-ERROR THRU S2701-EXIT DTSCS62
|
|
03269 GO TO S2700-EXIT. DTSCS62
|
|
03270 DTSCS62
|
|
03271 IF MAP-CLAIMANT-NAME = SPACES DTSCS62
|
|
03272 MOVE L020-SSN TO L081-CLAIMANT-SSN DTSCS62
|
|
03273 PERFORM S081-CLAIMANT-NAME THRU S081-EXIT DTSCS62
|
|
03274 IF L081-NAME-FOUND DTSCS62
|
|
03275 MOVE L081-CLAIMANT-NAME TO MAP-CLAIMANT-NAME. DTSCS62
|
|
03276 DTSCS62
|
|
03277 IF MAP-CLAIMANT-NAME = SPACES DTSCS62
|
|
03278 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS62
|
|
03279 PERFORM S2701-ERROR THRU S2701-EXIT DTSCS62
|
|
03280 ELSE DTSCS62
|
|
03281 MOVE MAP-CLAIMANT-NAME TO L071-NAM DTSCS62
|
|
03282 PERFORM S071-FROM-LAST-NAME-FIRST THRU S071-EXIT DTSCS62
|
|
03283 IF L071-NAME-INVALID DTSCS62
|
|
03284 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS62
|
|
03285 PERFORM S2701-ERROR THRU S2701-EXIT. DTSCS62
|
|
03286 DTSCS62
|
|
03287 S2700-EXIT. EXIT. DTSCS62
|
|
03288 DTSCS62
|
|
03289 S2701-ERROR. DTSCS62
|
|
03290 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-CLAIMANT-NAME-A. DTSCS62
|
|
03291 IF LCCM-NO-MSG DTSCS62
|
|
03292 SET CURSOR-SET-YES TO TRUE DTSCS62
|
|
03293 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS62
|
|
03294 MOVE CATB-CURSOR TO MAP-CLAIMANT-NAME-L. DTSCS62
|
|
03295 S2701-EXIT. EXIT. DTSCS62
|
|
03296 /*****************************************************************DTSCS62
|
|
03297 * *DTSCS62
|
|
03298 ******************************************************************DTSCS62
|
|
03299 S3100-TEXT. DTSCS62
|
|
03300 INSPECT MAP-TEXT (WRK-CTR) DTSCS62
|
|
03301 CONVERTING LOW-VALUES TO SPACES. DTSCS62
|
|
03302 S3100-EXIT. EXIT. DTSCS62
|
|
03303 DTSCS62
|
|
03304 /*****************************************************************DTSCS62
|
|
03305 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCS62
|
|
03306 ******************************************************************DTSCS62
|
|
03307 S5100-SET-LOCK-ATTRB. DTSCS62
|
|
03308 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS62
|
|
03309 WRK-ATB-NUM. DTSCS62
|
|
03310 DTSCS62
|
|
03311 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS62
|
|
03312 DTSCS62
|
|
03313 MOVE CATB-ASKIP-BRT-MDTON TO MAP-ASSIGN-NO-1-A DTSCS62
|
|
03314 MAP-ASSIGN-NO-2-A DTSCS62
|
|
03315 MAP-GOTO-A. DTSCS62
|
|
03316 S5100-EXIT. DTSCS62
|
|
03317 EXIT. DTSCS62
|
|
03318 DTSCS62
|
|
03319 ******************************************************************DTSCS62
|
|
03320 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS62
|
|
03321 ******************************************************************DTSCS62
|
|
03322 S5200-SET-UPDATE-ATTRB. DTSCS62
|
|
03323 IF LCCM-OP-IS-FLD-DESK-88 DTSCS62
|
|
03324 PERFORM S5210-FIELD-DESK-UPD THRU S5210-EXIT DTSCS62
|
|
03325 ELSE DTSCS62
|
|
03326 PERFORM S5220-REGULAR-UPD THRU S5220-EXIT. DTSCS62
|
|
03327 DTSCS62
|
|
03328 S5200-EXIT. DTSCS62
|
|
03329 EXIT. DTSCS62
|
|
03330 DTSCS62
|
|
03331 S5210-FIELD-DESK-UPD. DTSCS62
|
|
03332 MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN. DTSCS62
|
|
03333 MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM. DTSCS62
|
|
03334 DTSCS62
|
|
03335 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS62
|
|
03336 DTSCS62
|
|
03337 S5210-EXIT. DTSCS62
|
|
03338 EXIT. DTSCS62
|
|
03339 DTSCS62
|
|
03340 S5220-REGULAR-UPD. DTSCS62
|
|
03341 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS62
|
|
03342 WRK-ATB-NUM. DTSCS62
|
|
03343 DTSCS62
|
|
03344 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS62
|
|
03345 MOVE CATB-UNPROT-BRT-NUM-MDTON TO DTSCS62
|
|
03346 MAP-ASSIGN-NO-1-A DTSCS62
|
|
03347 MAP-ASSIGN-NO-2-A DTSCS62
|
|
03348 MAP-COMPLETED-DATE-DA-A DTSCS62
|
|
03349 MAP-COMPLETED-DATE-MO-A DTSCS62
|
|
03350 MAP-COMPLETED-DATE-YR-A DTSCS62
|
|
03351 MAP-AUDIT-END-Q-A DTSCS62
|
|
03352 MAP-AUDIT-END-YR-A DTSCS62
|
|
03353 MAP-AUDIT-START-Q-A DTSCS62
|
|
03354 MAP-AUDIT-START-YR-A. DTSCS62
|
|
03355 DTSCS62
|
|
03356 MOVE CATB-UNPROT-BRT-AN-MDTON TO DTSCS62
|
|
03357 MAP-STATUS-CD-A DTSCS62
|
|
03358 MAP-TAX-EXTRACT-A DTSCS62
|
|
03359 MAP-WAGE-EXTRACT-A. DTSCS62
|
|
03360 DTSCS62
|
|
03361 DTSCS62
|
|
03362 S5220-EXIT. DTSCS62
|
|
03363 EXIT. DTSCS62
|
|
03364 DTSCS62
|
|
03365 ******************************************************************DTSCS62
|
|
03366 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS62
|
|
03367 ******************************************************************DTSCS62
|
|
03368 S5300-SET-INQ-ATTRB. DTSCS62
|
|
03369 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS62
|
|
03370 WRK-ATB-NUM. DTSCS62
|
|
03371 DTSCS62
|
|
03372 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS62
|
|
03373 DTSCS62
|
|
03374 MOVE CATB-UNPROT-BRT-NUM-MDTON TO DTSCS62
|
|
03375 MAP-ASSIGN-NO-1-A DTSCS62
|
|
03376 MAP-ASSIGN-NO-2-A. DTSCS62
|
|
03377 DTSCS62
|
|
03378 S5300-EXIT. DTSCS62
|
|
03379 EXIT. DTSCS62
|
|
03380 DTSCS62
|
|
03381 S5900-SET-ATTRB. DTSCS62
|
|
03382 MOVE WRK-ATB-AN TO DTSCS62
|
|
03383 DTSCS62
|
|
03384 MAP-ASSIGN-TYPE-A DTSCS62
|
|
03385 MAP-ATTACHMENTS-IND-A DTSCS62
|
|
03386 MAP-EMP-SIZE-IND-A DTSCS62
|
|
03387 MAP-FLD-REP-ID-A DTSCS62
|
|
03388 MAP-SOURCE-OP-ID-A DTSCS62
|
|
03389 MAP-STATUS-CD-A DTSCS62
|
|
03390 MAP-TAX-EXTRACT-A DTSCS62
|
|
03391 MAP-WAGE-EXTRACT-A DTSCS62
|
|
03392 MAP-CLAIMANT-NAME-A DTSCS62
|
|
03393 PERFORM VARYING WRK-CTR FROM 1 BY 1 DTSCS62
|
|
03394 UNTIL WRK-CTR > MMAX-FAS-SEL-MAX DTSCS62
|
|
03395 MOVE WRK-ATB-AN TO DTSCS62
|
|
03396 MAP-AUDIT-SEL-REASON-A(WRK-CTR) DTSCS62
|
|
03397 END-PERFORM DTSCS62
|
|
03398 PERFORM VARYING WRK-CTR FROM 1 BY 1 DTSCS62
|
|
03399 UNTIL WRK-CTR > MMAX-FAS-TEXT-MAX DTSCS62
|
|
03400 MOVE CATB-UNPROT-BRT-AN-MDTON TO DTSCS62
|
|
03401 MAP-TEXT-A(WRK-CTR) DTSCS62
|
|
03402 END-PERFORM DTSCS62
|
|
03403 MOVE WRK-ATB-NUM TO DTSCS62
|
|
03404 MAP-ASSIGN-NO-1-A DTSCS62
|
|
03405 MAP-ASSIGN-NO-2-A DTSCS62
|
|
03406 MAP-AUDIT-END-Q-A DTSCS62
|
|
03407 MAP-AUDIT-END-YR-A DTSCS62
|
|
03408 MAP-AUDIT-START-Q-A DTSCS62
|
|
03409 MAP-AUDIT-START-YR-A DTSCS62
|
|
03410 MAP-CLAIMANT-SSN-1-A DTSCS62
|
|
03411 MAP-CLAIMANT-SSN-2-A DTSCS62
|
|
03412 MAP-CLAIMANT-SSN-3-A DTSCS62
|
|
03413 MAP-COMPLETED-DATE-DA-A DTSCS62
|
|
03414 MAP-COMPLETED-DATE-MO-A DTSCS62
|
|
03415 MAP-COMPLETED-DATE-YR-A DTSCS62
|
|
03416 MAP-DUE-DATE-DA-A DTSCS62
|
|
03417 MAP-DUE-DATE-MO-A DTSCS62
|
|
03418 MAP-DUE-DATE-YR-A DTSCS62
|
|
03419 MAP-RELATED-EMP-NO-1-A DTSCS62
|
|
03420 MAP-RELATED-EMP-NO-2-A DTSCS62
|
|
03421 MAP-START-DATE-DA-A DTSCS62
|
|
03422 MAP-START-DATE-MO-A DTSCS62
|
|
03423 MAP-START-DATE-YR-A. DTSCS62
|
|
03424 DTSCS62
|
|
03425 MOVE CATB-ASKIP-BRT-MDTON TO MAP-SIC-CD-A DTSCS62
|
|
03426 MAP-NAICS-CD-A DTSCS62
|
|
03427 MAP-OWN-CD-A. DTSCS62
|
|
03428 DTSCS62
|
|
03429 MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-NO-1-A DTSCS62
|
|
03430 MAP-EMP-NO-2-A DTSCS62
|
|
03431 MAP-PRIMARY-NAME-A DTSCS62
|
|
03432 MAP-PROCESSED-DATE-A DTSCS62
|
|
03433 MAP-WAGE-EXTRACT-DATE-A DTSCS62
|
|
03434 MAP-TAX-EXTRACT-DATE-A. DTSCS62
|
|
03435 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS62
|
|
03436 S5900-EXIT. DTSCS62
|
|
03437 EXIT. DTSCS62
|
|
03438 EJECT DTSCS62
|
|
03439 /*****************************************************************DTSCS62
|
|
03440 * MAP ROUTINES *DTSCS62
|
|
03441 ******************************************************************DTSCS62
|
|
03442 S9100-RECEIVE. DTSCS62
|
|
03443 SET L851-RECEIVE-88 TO TRUE. DTSCS62
|
|
03444 DTSCS62
|
|
03445 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS62
|
|
03446 DTSCS62
|
|
03447 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS62
|
|
03448 DTSCS62
|
|
03449 MOVE L851-AID TO LCCM-AID. DTSCS62
|
|
03450 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS62
|
|
03451 S9100-EXIT. DTSCS62
|
|
03452 EXIT. DTSCS62
|
|
03453 DTSCS62
|
|
03454 S9200-SEND-DATAONLY. DTSCS62
|
|
03455 MOVE LOW-VALUES TO MAP-AREA. DTSCS62
|
|
03456 DTSCS62
|
|
03457 IF LCCM-NO-MSG DTSCS62
|
|
03458 NEXT SENTENCE DTSCS62
|
|
03459 ELSE DTSCS62
|
|
03460 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS62
|
|
03461 DTSCS62
|
|
03462 IF CURSOR-SET-GOTO DTSCS62
|
|
03463 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS62
|
|
03464 ELSE DTSCS62
|
|
03465 MOVE CATB-CURSOR TO MAP-ASSIGN-NO-1-L. DTSCS62
|
|
03466 DTSCS62
|
|
03467 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS62
|
|
03468 DTSCS62
|
|
03469 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS62
|
|
03470 DTSCS62
|
|
03471 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS62
|
|
03472 S9200-EXIT. DTSCS62
|
|
03473 EXIT. DTSCS62
|
|
03474 DTSCS62
|
|
03475 S9300-SEND-MAP. DTSCS62
|
|
03476 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS62
|
|
03477 MOVE SPACES TO MAP-SYS-TIME. DTSCS62
|
|
03478 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS62
|
|
03479 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS62
|
|
03480 DTSCS62
|
|
03481 IF SCR-ACCESS-UPDATE DTSCS62
|
|
03482 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS62
|
|
03483 ELSE DTSCS62
|
|
03484 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS62
|
|
03485 DTSCS62
|
|
03486 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCS62
|
|
03487 DTSCS62
|
|
03488 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS62
|
|
03489 DTSCS62
|
|
03490 IF CURSOR-SET-NO DTSCS62
|
|
03491 MOVE CATB-CURSOR TO MAP-ASSIGN-NO-1-L. DTSCS62
|
|
03492 DTSCS62
|
|
03493 SET L851-SEND-88 TO TRUE. DTSCS62
|
|
03494 DTSCS62
|
|
03495 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS62
|
|
03496 DTSCS62
|
|
03497 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS62
|
|
03498 S9300-EXIT. DTSCS62
|
|
03499 EXIT. DTSCS62
|
|
03500 DTSCS62
|
|
03501 S9310-UPDATE-FKEYS. DTSCS62
|
|
03502 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS62
|
|
03503 DTSCS62
|
|
03504 DTSCS62
|
|
03505 IF LCCM-SCR-INQUIRE DTSCS62
|
|
03506 MOVE CFKD-MOD TO MAP-KEY-MOD DTSCS62
|
|
03507 MOVE CFKD-DEL TO MAP-KEY-DEL DTSCS62
|
|
03508 ELSE DTSCS62
|
|
03509 IF LCCM-SCR-UPDATE-LOCKED DTSCS62
|
|
03510 MOVE LOW-VALUES TO MAP-KEY-MOD DTSCS62
|
|
03511 MAP-KEY-DEL. DTSCS62
|
|
03512 S9310-EXIT. DTSCS62
|
|
03513 EXIT. DTSCS62
|
|
03514 DTSCS62
|
|
03515 S9320-INQUIRY-FKEYS. DTSCS62
|
|
03516 MOVE LOW-VALUES TO MAP-KEY-MOD DTSCS62
|
|
03517 MAP-KEY-DEL. DTSCS62
|
|
03518 DTSCS62
|
|
03519 * PERFORM S9321-JUMP-KEYS THRU S9321-EXIT. DTSCS62
|
|
03520 S9320-EXIT. DTSCS62
|
|
03521 EXIT. DTSCS62
|
|
03522 DTSCS62
|
|
03523 *S9321-JUMP-KEYS. DTSCS62
|
|
03524 * MOVE CFKD-REG-INQ DTSCS62
|
|
03525 * TO MAP-KEY-REG-INQ. DTSCS62
|
|
03526 * MOVE CFKD-AUDIT-RSLT-21 DTSCS62
|
|
03527 * TO MAP-KEY-AUDIT-RSLT-21. DTSCS62
|
|
03528 * MOVE CFKD-ASSIGN-RPT-22 DTSCS62
|
|
03529 * TO MAP-KEY-ASSIGN-RPT-22. DTSCS62
|
|
03530 *S9321-EXIT. DTSCS62
|
|
03531 * EXIT. DTSCS62
|
|
03532 * DTSCS62
|
|
03533 S9330-DSCR-FIELDS. DTSCS62
|
|
03534 IF WRK-MPRF-YES-88 DTSCS62
|
|
03535 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME DTSCS62
|
|
03536 ELSE DTSCS62
|
|
03537 MOVE LOW-VALUES TO MAP-PRIMARY-NAME. DTSCS62
|
|
03538 DTSCS62
|
|
03539 IF MAP-STATUS-CD = SPACES OR LOW-VALUES DTSCS62
|
|
03540 MOVE LOW-VALUES TO MAP-STATUS-CD-DESC DTSCS62
|
|
03541 ELSE DTSCS62
|
|
03542 MOVE MAP-STATUS-CD TO L036-CD DTSCS62
|
|
03543 PERFORM S036-EDIT-STATUS-CD THRU S036-EXIT DTSCS62
|
|
03544 MOVE L036-SHORT-DSCR TO MAP-STATUS-CD-DESC. DTSCS62
|
|
03545 DTSCS62
|
|
03546 IF MAP-FLD-REP-ID = SPACES OR LOW-VALUES DTSCS62
|
|
03547 MOVE LOW-VALUES TO MAP-FLD-REP-ID-DESC DTSCS62
|
|
03548 ELSE DTSCS62
|
|
03549 MOVE MAP-FLD-REP-ID TO L062-FLD-REP-ID DTSCS62
|
|
03550 PERFORM S062-FLD-REP-ID-DESC THRU S062-EXIT DTSCS62
|
|
03551 MOVE L062-NAME TO MAP-FLD-REP-ID-DESC. DTSCS62
|
|
03552 DTSCS62
|
|
03553 IF MAP-ASSIGN-TYPE = SPACES OR LOW-VALUES DTSCS62
|
|
03554 MOVE LOW-VALUES TO MAP-ASSIGN-TYPE-DESC DTSCS62
|
|
03555 ELSE DTSCS62
|
|
03556 MOVE MAP-ASSIGN-TYPE TO L063-TYPE DTSCS62
|
|
03557 PERFORM S063-FIELD-ASSIGNMENT-EDIT THRU S063-EXIT DTSCS62
|
|
03558 MOVE L063-DESCRIPTION TO MAP-ASSIGN-TYPE-DESC. DTSCS62
|
|
03559 DTSCS62
|
|
03560 IF MAP-SOURCE-OP-ID = LOW-VALUES OR SPACES DTSCS62
|
|
03561 MOVE LOW-VALUES TO MAP-SOURCE-OP-ID-DESC DTSCS62
|
|
03562 ELSE DTSCS62
|
|
03563 IF MAP-SOURCE-OP-ID = LCCM-OP-ID DTSCS62
|
|
03564 MOVE LCCM-OP-NAME TO MAP-SOURCE-OP-ID-DESC DTSCS62
|
|
03565 ELSE DTSCS62
|
|
03566 MOVE MAP-SOURCE-OP-ID TO L082-OP-ID DTSCS62
|
|
03567 PERFORM S082-OP-ID-EDIT THRU S082-EXIT DTSCS62
|
|
03568 MOVE L082-NAME TO MAP-SOURCE-OP-ID-DESC. DTSCS62
|
|
03569 DTSCS62
|
|
03570 MOVE MAP-RELATED-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS62
|
|
03571 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS62
|
|
03572 IF L018-NO-ENTRY OR L018-NOT-VALID DTSCS62
|
|
03573 MOVE LOW-VALUES TO MAP-RELATED-PRIMARY-NAME DTSCS62
|
|
03574 ELSE DTSCS62
|
|
03575 MOVE LOW-VALUES TO MPRF-KEY-AREA DTSCS62
|
|
03576 MOVE L018-EMP-NO TO MPRF-EMP-NO DTSCS62
|
|
03577 SET MPRF-PRF-88 TO TRUE DTSCS62
|
|
03578 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA DTSCS62
|
|
03579 PERFORM S810-READ THRU S810-EXIT DTSCS62
|
|
03580 IF L810-OK-88 DTSCS62
|
|
03581 MOVE MSKL-REC TO MPRF-REC DTSCS62
|
|
03582 MOVE MPRF-PRIMARY-NAME TO MAP-RELATED-PRIMARY-NAME DTSCS62
|
|
03583 ELSE DTSCS62
|
|
03584 MOVE 'NAME NOT AVAILABLE' DTSCS62
|
|
03585 TO MAP-RELATED-PRIMARY-NAME. DTSCS62
|
|
03586 DTSCS62
|
|
03587 S9330-EXIT. EXIT. DTSCS62
|
|
03588 DTSCS62
|
|
03589 S9900-PREPARE-SEND. DTSCS62
|
|
03590 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS62
|
|
03591 LCCM-SCR-ID. DTSCS62
|
|
03592 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS62
|
|
03593 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS62
|
|
03594 S9900-EXIT. DTSCS62
|
|
03595 EXIT. DTSCS62
|