5146 lines
402 KiB
COBOL
5146 lines
402 KiB
COBOL
00001 IDENTIFICATION DIVISION. 12/08/21
|
|
00002 PROGRAM-ID. DTSCS1A. DTSCS1A
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV108
|
|
00004 DATE-WRITTEN. APRIL 1994. DTSCS1A
|
|
00005 DATE-COMPILED. DTSCS1A
|
|
00006 DTSCS1A
|
|
00007 ****** DTSCS1A
|
|
00008 * DTSCS1A
|
|
00009 * FUNCTION: INITIAL REGISTRATION / CYCLE A INQUIRY/UPDATE DTSCS1A
|
|
00010 * SCREEN PROCESSOR. DTSCS1A
|
|
00011 * DTSCS1A
|
|
00012 * DTSCS1A
|
|
00013 * MODIFICATION LOG: DTSCS1A
|
|
00014 * DTSCS1A
|
|
00015 * 12/14/94 REPLACE THE SINGLE DEFAULT FOR LETTER-1-CD WITH DTSCS1A
|
|
00016 * THREE POSSIBLE DEFAULTS DEPENDING ON SOURCE-CD. DTSCS1A
|
|
00017 * WORK ORDER: CR029 PROGRAMMER: RHC DTSCS1A
|
|
00018 * DTSCS1A
|
|
00019 * 03/26/95 MODIFY CYCLE A, ADDING THE LETTER 3 TICKLER STEP. DTSCS1A
|
|
00020 * WORK ORDER: CR065 PROGRAMMER: EHH DTSCS1A
|
|
00021 * DTSCS1A
|
|
00022 * 03/31/95 CHANGE DATA PHONE NUMBER TO VOICE2 PHONE NUMBER. DTSCS1A
|
|
00023 * WORK ORDER: CR068 PROGRAMMER: RHC DTSCS1A
|
|
00024 * DTSCS1A
|
|
00025 * 09/18/95 INITIALIZE TWO NEW MPRF DATA ELEMENTS. MPRF-WH- DTSCS1A
|
|
00026 * OFLT-SEIN AND MPRF-WH-OFLT-MAIL-ADDR-IND DTSCS1A
|
|
00027 * WORK ORDER: JR PROGRAMMER: EHH DTSCS1A
|
|
00028 * DTSCS1A
|
|
00029 * 09/30/95 JOINT REGISTRATION PROCESSING. DURING MODIFY DTSCS1A
|
|
00030 * PROCESSING, IF UI EMPLOYER IS "CONNECTED" TO DTSCS1A
|
|
00031 * A WH/OFLT EMPLOYER, THEN UPDATE THE WH/OFLT DTSCS1A
|
|
00032 * EMPLOYER REGISTRATION INFORMATION. ALSO, IF DTSCS1A
|
|
00033 * UI EMPLOYER IS "CONNECTED" TO A WH/OFLT EMPLOYER, DTSCS1A
|
|
00034 * THEN DO NOT ALLOW EMPLOYER DELETE. DTSCS1A
|
|
00035 * WORK ORDER: JR PROGRAMMER: EHH DTSCS1A
|
|
00036 * DTSCS1A
|
|
00037 * 06/13/96 RE-COMPILED TO INCORPORATE MELF RECORD INTO DTSCS1A
|
|
00038 * DTSIMLEN AND DTSIMSKL. DTSCS1A
|
|
00039 * REFERENCE RFP: #WARP II PROGRAMMER: MJA DTSCS1A
|
|
00040 * DTSCS1A
|
|
00041 * 07/31/97 MODIFY LOGIC TO ALLOW DELETE FUNCTION TO BE DTSCS1A
|
|
00042 * PERFORMED USING FUNCTION KEY 23 INSTEAD OF 11. DTSCS1A
|
|
00043 * REFERENCE RFP: TCL 096 PROGRAMMER: FLS DTSCS1A
|
|
00044 * DTSCS1A
|
|
00045 * 09/10/1998 REVIEWED AND MODIFIED FOR DC. DTSCS1A
|
|
00046 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSCS1A
|
|
00047 * DTSCS1A
|
|
00048 * 05/13/1999 INITIALIZE MPRF-LAST-ARCHIVED-YRQ TO LCCM- DTSCS1A
|
|
00049 * PICKUP-YRQ (RATHER THAN 00000). DTSCS1A
|
|
00050 * REFERENCE: PICKUP DIR PROGRAMMER: EHH DTSCS1A
|
|
00051 * DTSCS1A
|
|
00052 * 10/10/1999 IF MERA-SOURCE-CD = '14', THEN DEFAULT DTSCS1A
|
|
00053 * MERA-LETTER-1-CD TO '04'. DTSCS1A
|
|
00054 * REFERENCE: PER LYNNETTE PROGRAMMER: EHH DTSCS1A
|
|
00055 * DTSCS1A
|
|
00056 * 05/26/2000 ADDED CODE TO VALIDATE AND DISPLAY FISCAL DTSCS1A
|
|
00057 * AGENT CODE AND ADDRESS. DTSCS1A
|
|
00058 * REFERENCE: SPEC019 PROGRAMMER: ZL1 DTSCS1A
|
|
00059 * DTSCS1A
|
|
00060 * 10/16/2001 MODIFIED FOR HOUSEHOLD -- ADD PENDING MFSC DTSCS1A
|
|
00061 * AGENT CODE AND ADDRESS. DTSCS1A
|
|
00062 * REFERENCE: PROGRAMMER: GD1 DTSCS1A
|
|
00063 * DTSCS1A
|
|
00064 * 12/09/2002 MODIFIED TO USE OPERATOR ID OF USER CURRENTLY DTSCS1A
|
|
00065 * SIGNED ON AS 'RESPONSIBLE OP ID,' UNLESS THE DTSCS1A
|
|
00066 * USER HAS SPECIFICALLY ENTERED A DIFFERENT ID DTSCS1A
|
|
00067 * IN THE MAP-RESP-OP-ID FIELD. DTSCS1A
|
|
00068 * REFERENCE: REQUEST FROM STATUS PROGRAMMER: GD DTSCS1A
|
|
00069 * DTSCS1A
|
|
00070 * 11/25/2003 MODIFIED P8930-MERA-UPDATE, S1800, S2200, DTSCS1A
|
|
00071 * S2600, S2800. IF NO MERA EXISTS, DTSCS1A
|
|
00072 * DO NOT ADD AN MERA IF THE EMPLOYER IS DTSCS1A
|
|
00073 * CONVERTED. THE PROGRAM WAS INCORRECTLY DTSCS1A
|
|
00074 * ADDING MERA RECORDS FOR CONVERTED (AND LIABLE) DTSCS1A
|
|
00075 * EMPLOYERS WHENEVER THE 1A SCREEN WAS UPDATED. DTSCS1A
|
|
00076 * AS A RESULT THE SYSTEM WAS SENDING CYCLE A DTSCS1A
|
|
00077 * LETTERS TO LIABLE EMPLOYERS. DTSCS1A
|
|
00078 * REFERENCE: PRODUCTION PROBLEM. PROGRAMMER: GD DTSCS1A
|
|
00079 * DTSCS1A
|
|
00080 * 06/29/2004 MODIFIED FOR ELIG CODE 17 - DOMESTIC VIOLENCE DTSCS1A
|
|
00081 * REFERENCE: PROGRAMMER: GD DTSCS1A
|
|
00082 * DTSCS1A
|
|
00083 * 07/16/2004 ADDED CODE IN S1400 AND S1500 TO CHECK FOR DTSCS1A
|
|
00084 * DUPLICATE NAMES. IF A DUPLICATE IS FOUND, A DTSCS1A
|
|
00085 * SUPERVISOR (FIELD DESK OR ACCOUNTING DESK) DTSCS1A
|
|
00086 * MAY OVERRIDE THE EDIT. DTSCS1A
|
|
00087 * REFERENCE: PROGRAMMER: GD DTSCS1A
|
|
00088 * DTSCS1A
|
|
00089 * 07/28/2004 MODIFIED P8930-MERA-UPDATE TO CHECK CYCLE A DTSCS1A
|
|
00090 * STATUS WHEN AN FR500 RECEIVED DATE IS ENTERED. DTSCS1A
|
|
00091 * IF CYCLE A IS ACTIVE, SET THE CYLE A STATUS DTSCS1A
|
|
00092 * TO EITHER LIABLE OR NOT LIABLE BASED ON MPRF DTSCS1A
|
|
00093 * STATUS. DTSCS1A
|
|
00094 * MODIFIED S3000 TO ALLOW ENTRY OF FR500 DTSCS1A
|
|
00095 * RECEIVED DATE WHILE CYCLE A IS ACTIVE. DTSCS1A
|
|
00096 * REFERENCE: PROGRAMMER: GD DTSCS1A
|
|
00097 * DTSCS1A
|
|
00098 * 08/11/2004 ADDED TEST FOR DC ADDRESS WHEN EMPLOYER IS DTSCS1A
|
|
00099 * LIABLE AND AN FR500 RECEIVED DATE IS ENTERED. DTSCS1A
|
|
00100 * REFERENCE: PROGRAMMER: GD DTSCS1A
|
|
00101 * DTSCS1A
|
|
00102 * 09/01/2004 MODIFIED DUPLICATE NAME EDIT TO IGNORE DUPLICATE DTSCS1A
|
|
00103 * IF EMPLOYER IS NOT ACTIVE. DTSCS1A
|
|
00104 * REFERENCE: PROGRAMMER: GD DTSCS1A
|
|
00105 * DTSCS1A
|
|
00106 * 03/08/2005 MODIFIED FOR ELIG CODE 18 - EDUCATIONAL DTSCS1A
|
|
00107 * STEPLADDER PROGRAM DTSCS1A
|
|
00108 * REFERENCE: PROGRAMMER: GD DTSCS1A
|
|
00109 * DTSCS1A
|
|
00110 * 02/01/2006 MODIFIED TO INITIALIZE RETURN MAIL INDICATOR DTSCS1A
|
|
00111 * REFERENCE: PROGRAMMER: GD DTSCS1A
|
|
00112 * DTSCS1A
|
|
00113 * 11/07/2007 RECOMPILED WITH MODIFIED COPY OF DTSICENO - DTSCS1A
|
|
00114 * THE NEW VERSION RESERVES A RANGE OF ACCOUNT DTSCS1A
|
|
00115 * NUMBERS TO BE USED FOR WEB REGISTRATION. DTSCS1A
|
|
00116 * REFERENCE: PROGRAMMER: GD DTSCS1A
|
|
00117 * DTSCS1A
|
|
00118 * 07/15/2008 MODIFIED FOR ELIG CODE 19 - EUC08 - 2008 DTSCS1A
|
|
00119 * EXTENDED BENEFITS PROGRAM DTSCS1A
|
|
00120 * REFERENCE: PROGRAMMER: GD DTSCS1A
|
|
00121 * DTSCS1A
|
|
00122 * 02/26/2009 MODIFIED FOR ELIG CODE 20 - FAC - 2009 TEMP DTSCS1A
|
|
00123 * FEDERAL ADDITIONAL COMPENSATION. DTSCS1A
|
|
00124 * REFERENCE: PROGRAMMER: GD DTSCS1A
|
|
00125 * DTSCS1A
|
|
00126 * 07/14/2009 MODIFIED FOR ADDITIONAL BENEFITS AND DTSCS1A
|
|
00127 * DEPENDENCY ALLOWANCE. SEE S1300. DTSCS1A
|
|
00128 * REFERENCE: PROGRAMMER: GD DTSCS1A
|
|
00129 * DTSCS1A
|
|
00130 * 07/17/2009 MODIFIED P8120 TO INITIALIZE POWER OF ATTORNEY DTSCS1A
|
|
00131 * DATE. DTSCS1A
|
|
00132 * REFERENCE: PROGRAMMER: GD DTSCS1A
|
|
00133 * DTSCS1A
|
|
00134 * 07/30/2009 MODIFIED FOR TRAINING EXTENSION BENEFITS DTSCS1A
|
|
00135 * PROGRAM. SEE S1300. DTSCS1A
|
|
00136 * REFERENCE: PROGRAMMER: GD DTSCS1A
|
|
00137 * DTSCS1A
|
|
00138 * 11/17/2009 MODIFIED FOR EUC 2008 TIERS 3 AND 4. DTSCS1A
|
|
00139 * SEE S1300. DTSCS1A
|
|
00140 * REFERENCE: PROGRAMMER: GD DTSCS1A
|
|
00141 * DTSCS1A
|
|
00142 * 03/31/2010 MODIFIED FOR SPECIAL PAYMENTS ELIG CODE. DTSCS1A
|
|
00143 * SEE S1300. DTSCS1A
|
|
00144 * REFERENCE: PROGRAMMER: GD DTSCS1A
|
|
00145 * DTSCS1A
|
|
00146 * 09/26/2014 MODIFIED FOR UCPIA ELIG CODE. DTSCS1A
|
|
00147 * SEE S1300. DTSCS1A
|
|
00148 * REFERENCE: PROGRAMMER: ZL1 DTSCS1A
|
|
00149 * DTSCS1A
|
|
00150 * DTSCS1A
|
|
00151 * 03/26/2015 MODIFIED FOR DUA AND GPA ELIG CODE DTSCS1A
|
|
00152 * SEE S1300. DTSCS1A
|
|
00153 * REFERENCE: PROGRAMMER: ZL1 DTSCS1A
|
|
00154 * DTSCS1A
|
|
00155 * DTSCS1A
|
|
00156 * 04/07/2020 MODIFIED FOR FPUC AND FRUR CODE DTSCS1A
|
|
00157 * SEE S1300. DTSCS1A
|
|
00158 * REFERENCE: PROGRAMMER: ZL1 DTSCS1A
|
|
00159 * DTSCS1A
|
|
00160 * DTSCS1A
|
|
00161 * 04/24/2020 MODIFIED FOR PEUC DTSCS1A
|
|
00162 * SEE S1300. DTSCS1A
|
|
00163 * REFERENCE: PROGRAMMER: ZL1 DTSCS1A
|
|
00164 * DTSCS1A
|
|
00165 * 05/08/2020 MODIFIED FOR REUR - RATED EMPLOYERS UNEMPLOYMENT DTSCS1A
|
|
00166 * RELIEF SEE S1300. DTSCS1A
|
|
00167 * REFERENCE: PROGRAMMER: ZL1 DTSCS1A
|
|
00168 * DTSCS1A
|
|
00169 * 09/02/2020 MODIFIED FOR LWA DTSCS1A
|
|
00170 * SEE S1300. DTSCS1A
|
|
00171 * REFERENCE: PROGRAMMER: ZL1 DTSCS1A
|
|
00172 * DTSCS1A
|
|
00173 * DTSCS1A
|
|
00174 * 12/05/2020 MODIFIED FOR PUA STIMULUS DTSCS1A
|
|
00175 * SEE S1300. DTSCS1A
|
|
00176 * REFERENCE: PROGRAMMER: ZL1 DTSCS1A
|
|
00177 * DTSCS1A
|
|
00178 * 02/16/2021 MODIFIED FOR MEUC DTSCS1A
|
|
00179 * SEE S1300. DTSCS1A
|
|
00180 * REFERENCE: PROGRAMMER: ZL1 DTSCS1A
|
|
00181 * DTSCS1A
|
|
00182 * DTSCS1A
|
|
00183 * 12/06/2021 MODIFIED FOR DUC DTSCS1A
|
|
00184 * SEE S1300. DTSCS1A
|
|
00185 * REFERENCE: PROGRAMMER: ZL1 DTSCS1A
|
|
00186 * DTSCS1A
|
|
00187 * DTSCS1A
|
|
00188 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS1A
|
|
00189 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS1A
|
|
00190 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSCS1A
|
|
00191 * DTSCS1A
|
|
00192 * DTSCS1A
|
|
00193 * DESCRIPTION: DTSCS1A
|
|
00194 * DTSCS1A
|
|
00195 * DTSCS1A
|
|
00196 * CLEAR: DTSCS1A
|
|
00197 * DTSCS1A
|
|
00198 * FIELDS DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO). DTSCS1A
|
|
00199 * DTSCS1A
|
|
00200 * DTSCS1A
|
|
00201 * INQUIRY: DTSCS1A
|
|
00202 * DTSCS1A
|
|
00203 * CONTROL FIELD(S): MAP-EMP-NO DTSCS1A
|
|
00204 * DTSCS1A
|
|
00205 * JUMP IN: DISPLAY DATA ASSOCIATED WITH LCCM-EMP-NO. DTSCS1A
|
|
00206 * DTSCS1A
|
|
00207 * ENTER: DISPLAY DATA ASSOCIATED WITH MAP-EMP-NO. DTSCS1A
|
|
00208 * DTSCS1A
|
|
00209 * STANDARD LCCM-EMP-NO MAINTENANCE. DTSCS1A
|
|
00210 * DTSCS1A
|
|
00211 * DTSCS1A
|
|
00212 * UPDATE: DTSCS1A
|
|
00213 * DTSCS1A
|
|
00214 * ADD: THIS MODULE IS UNIQUE IN THAT AN "ADD" CAUSES AN DTSCS1A
|
|
00215 * MPRF RECORD TO BE ADDED. IF "CHARGING ONLY" DTSCS1A
|
|
00216 * EMPLOYER, THEN USE MAP-EMP-NO AS KEY. IF NOT DTSCS1A
|
|
00217 * "CHARGING ONLY" EMPLOYER, THEN SYSTEM DETERMINES DTSCS1A
|
|
00218 * EMP-NO FROM MHDR RECORD. DTSCS1A
|
|
00219 * DTSCS1A
|
|
00220 * IF MAP-SOURCE-CD IS EQUAL TO 'NA', THEN DO NOT DTSCS1A
|
|
00221 * WRITE A MERA RECORD. DTSCS1A
|
|
00222 * DTSCS1A
|
|
00223 * IF MAP-SOURCE-CD IS NOT EQUAL TO 'NA', THEN DO DTSCS1A
|
|
00224 * NOT WRITE A MERA RECORD. DTSCS1A
|
|
00225 * DTSCS1A
|
|
00226 * THE MERA RECORD HAS NO MEANING FOR A "CHARGING ONLY" DTSCS1A
|
|
00227 * EMPLOYER. WHEN PROCESSING (ADDING) A "CHARGING DTSCS1A
|
|
00228 * ONLY" EMPLOYER, DO NOT ADD A MERA RECORD. DTSCS1A
|
|
00229 * DTSCS1A
|
|
00230 * DTSCS1A
|
|
00231 * MOD: IF NOT MERA RECORD EXISTS, THEN WRITE A MERA RECORD. DTSCS1A
|
|
00232 * DTSCS1A
|
|
00233 * DTSCS1A
|
|
00234 * DEL: IF MAP-DELETE-EMP IS EQUAL TO 'Y', THE DELETE DTSCS1A
|
|
00235 * ALL RECORDS ASSOCIATED WITH MAP-EMP-NO. DTSCS1A
|
|
00236 * DTSCS1A
|
|
00237 * IF ANY RECORD WITH MLEN-DEL-MPRF-NOT-OK-88 DTSCS1A
|
|
00238 * (DTSIMLEN) EXISTS, THEN DO NOT PERMIT THE MPRF DTSCS1A
|
|
00239 * RECORD TO BE DELETED. DTSCS1A
|
|
00240 * DTSCS1A
|
|
00241 * BEFORE DELETING A MPRF RECORD, DELETE ALL M* RECORDS DTSCS1A
|
|
00242 * ASSOCIATED WITH THE MPRF RECORD. DTSCS1A
|
|
00243 * DTSCS1A
|
|
00244 * IF MAP-DELETE-EMP IS NOT EQUAL TO 'Y', THEN JUST DTSCS1A
|
|
00245 * DELETE THE MERA RECORD. DTSCS1A
|
|
00246 * DTSCS1A
|
|
00247 * IF A MERA RECORD IS WRITTEN OR REWRITTEN (DURING AN ADD DTSCS1A
|
|
00248 * OR A MOD), THEN WRITE A MTCK RECORD WITH DTSCS1A
|
|
00249 * MTCK-TYPE-CYCLE-A-88. DTSCS1A
|
|
00250 * DTSCS1A
|
|
00251 * DTSCS1A
|
|
00252 * RECORDS READ: DTSCS1A
|
|
00253 * DTSCS1A
|
|
00254 * MASTER: DTSCS1A
|
|
00255 * DTSCS1A
|
|
00256 * MHDR DTSCS1A
|
|
00257 * MPRF DTSCS1A
|
|
00258 * MTAD DTSCS1A
|
|
00259 * MERA DTSCS1A
|
|
00260 * MFAE DTSCS1A
|
|
00261 * MFIS DTSCS1A
|
|
00262 * ALL OTHER RECORD TYPES ARE READ AS PART DTSCS1A
|
|
00263 * OF THE PROCESS OF DELETING A MPRF RECORD. DTSCS1A
|
|
00264 * DTSCS1A
|
|
00265 * DTSCS1A
|
|
00266 * ALTERNATE INDEX: DTSCS1A
|
|
00267 * DTSCS1A
|
|
00268 * NONE. DTSCS1A
|
|
00269 * DTSCS1A
|
|
00270 * DTSCS1A
|
|
00271 * REFERENCE: DTSCS1A
|
|
00272 * DTSCS1A
|
|
00273 * NONE. DTSCS1A
|
|
00274 * DTSCS1A
|
|
00275 * DTSCS1A
|
|
00276 * ACCOUNTING TRANSACTION COLLECTION: DTSCS1A
|
|
00277 * DTSCS1A
|
|
00278 * NONE. DTSCS1A
|
|
00279 * DTSCS1A
|
|
00280 * DTSCS1A
|
|
00281 * RECORDS UPDATED: DTSCS1A
|
|
00282 * DTSCS1A
|
|
00283 * MASTER: DTSCS1A
|
|
00284 * DTSCS1A
|
|
00285 * MHDR (REWRITE, DURING AN "ADD") DTSCS1A
|
|
00286 * MPRF (WRITE, REWRITE, DELETE) DTSCS1A
|
|
00287 * MTAD (WRITE, REWRITE, DELETE) DTSCS1A
|
|
00288 * MERA (WRITE, REWRITE, DELETE) DTSCS1A
|
|
00289 * MTCK (WRITE) DTSCS1A
|
|
00290 * MEVL (WRITE) DTSCS1A
|
|
00291 * DTSCS1A
|
|
00292 * DTSCS1A
|
|
00293 * IF A MERA RECORD IS ADDED OR MODIFIED, THEN WRITE A MTCK DTSCS1A
|
|
00294 * IF A MPRF RECORD IS WRITTEN, THEN WRITE A MEVL DTSCS1A
|
|
00295 * RECORD COMMEMORATING THE EVENT. DTSCS1A
|
|
00296 * DTSCS1A
|
|
00297 * DTSCS1A
|
|
00298 * REFERENCE: DTSCS1A
|
|
00299 * DTSCS1A
|
|
00300 * NONE. DTSCS1A
|
|
00301 * DTSCS1A
|
|
00302 * DTSCS1A
|
|
00303 * ACCOUNTING TRANSACTION COLLECTION: DTSCS1A
|
|
00304 * DTSCS1A
|
|
00305 * NONE. DTSCS1A
|
|
00306 * DTSCS1A
|
|
00307 * DTSCS1A
|
|
00308 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCS1A
|
|
00309 * DTSCS1A
|
|
00310 * NONE. DTSCS1A
|
|
00311 * DTSCS1A
|
|
00312 * DTSCS1A
|
|
00313 * TEMPORARY STORAGE USAGE: DTSCS1A
|
|
00314 * DTSCS1A
|
|
00315 * NONE. DTSCS1A
|
|
00316 * DTSCS1A
|
|
00317 * DTSCS1A
|
|
00318 * MODULES LINKED TO: DTSCS1A
|
|
00319 * DTSCS1A
|
|
00320 * DTSCU001 DATE EDIT/CONVERSION. DTSCS1A
|
|
00321 * DTSCU015 DATE FROM SCREEN FORMAT/EDIT. DTSCS1A
|
|
00322 * DTSCU017 FEIN FROM SCREEN FORMAT/EDIT. DTSCS1A
|
|
00323 * DTSCU018 EMP NO FROM SCREEN FORMAT/EDIT. DTSCS1A
|
|
00324 * DTSCU020 SSN FROM SCREEN FORMAT/EDIT. DTSCS1A
|
|
00325 * DTSCU021 TELEPHONE NUMBER FROM SCREEN FORMAT/EDIT. DTSCS1A
|
|
00326 * DTSCU031 EMPLOYER REGISTRATION CODES EDIT/DESCRIPTION. DTSCS1A
|
|
00327 * DTSCU061 FIELD ZIP/FIELD REP ID. DTSCS1A
|
|
00328 * DTSCU062 FIELD REP ID EDIT/DESCRIPTION. DTSCS1A
|
|
00329 * DTSCU071 INDIVIDUAL'S NAME EDIT/CONVERSION. DTSCS1A
|
|
00330 * DTSCU072 ADDRESS EDIT. DTSCS1A
|
|
00331 * DTSCU073 TELEPHONE NUMBER EDIT. DTSCS1A
|
|
00332 * DTSCU074 DUPLICATE FEIN EDIT. DTSCS1A
|
|
00333 * DTSCU081 CLAIMANT NAME LOOKUP. DTSCS1A
|
|
00334 * DTSCU082 OPERATOR ID EDIT/LOOKUP. DTSCS1A
|
|
00335 * DTSCU201 DETERMINE EMPLOYER CLASS. DTSCS1A
|
|
00336 * DTSCU202 DETERMINE EMPLOYER ELIGIBLE CODE DTSCS1A
|
|
00337 * DTSCU203 DETERMINE FIELD ZIP CODE AND JS ZIP CODE. DTSCS1A
|
|
00338 * DTSCU221 MPRF-UPDATE DATA ELEMENT MAINTENANCE. DTSCS1A
|
|
00339 * DTSCU331 WRITE MODIFICATION LOG RECORD. DTSCS1A
|
|
00340 * DTSCU810 MASTER FILE INPUT/OUTPUT. DTSCS1A
|
|
00341 * DTSCU831 REFERENCE FILE I-O. DTSCS1A
|
|
00342 * DTSCS1A
|
|
00343 ***** DTSCS1A
|
|
00344 SKIP3 DTSCS1A
|
|
00345 ENVIRONMENT DIVISION. DTSCS1A
|
|
00346 SKIP3 DTSCS1A
|
|
00347 DATA DIVISION. DTSCS1A
|
|
00348 SKIP3 DTSCS1A
|
|
00349 WORKING-STORAGE SECTION. DTSCS1A
|
|
003495 77 PAN-VALET PICTURE X(24) VALUE '108DTSCS1A 12/08/21'. DTSCS1A
|
|
00350 77 PAN-VALET PICTURE X(24) VALUE '002DTSCS1A 12/07/21'. DTSCS1A
|
|
00351 77 PAN-VALET PICTURE X(24) VALUE '106DTSCS1A 02/16/21'. DTSCS1A
|
|
00352 77 PAN-VALET PICTURE X(24) VALUE '002DTSCS1A 02/16/21'. DTSCS1A
|
|
00353 77 PAN-VALET PICTURE X(24) VALUE '104DTSCS1A 12/07/20'. DTSCS1A
|
|
00354 77 PAN-VALET PICTURE X(24) VALUE '003DTSCS1A 12/07/20'. DTSCS1A
|
|
00355 77 PAN-VALET PICTURE X(24) VALUE '102DTSCS1A 05/08/20'. DTSCS1A
|
|
00356 77 PAN-VALET PICTURE X(24) VALUE '002DTSCS1A 05/08/20'. DTSCS1A
|
|
00357 77 PAN-VALET PICTURE X(24) VALUE '100DTSCS1A 04/27/20'. DTSCS1A
|
|
00358 77 PAN-VALET PICTURE X(24) VALUE '003DTSCS1A 04/25/20'. DTSCS1A
|
|
00359 77 PAN-VALET PICTURE X(24) VALUE '098DTSCS1A 03/25/15'. DTSCS1A
|
|
00360 77 PAN-VALET PICTURE X(24) VALUE '002DTSCS1A 03/25/15'. DTSCS1A
|
|
00361 77 PAN-VALET PICTURE X(24) VALUE '096DTSCS1A 10/01/14'. DTSCS1A
|
|
00362 77 PAN-VALET PICTURE X(24) VALUE '003DTSCS1A 09/26/14'. DTSCS1A
|
|
00363 77 PAN-VALET PICTURE X(24) VALUE '094DTSCS1A 03/31/10'. DTSCS1A
|
|
00364 SKIP3 DTSCS1A
|
|
00365 01 WRK-AREA. DTSCS1A
|
|
00366 05 WRK-ABEND-CD PIC X(04) VALUE 'S1A '. DTSCS1A
|
|
00367 DTSCS1A
|
|
00368 05 WRK-SCR-ID PIC X(02) VALUE '1A'. DTSCS1A
|
|
00369 DTSCS1A
|
|
00370 05 WRK-F03-SCR-ID PIC X(02) VALUE '10'. DTSCS1A
|
|
00371 SKIP3 DTSCS1A
|
|
00372 05 SCR-ACCESS-IND PIC X(01). DTSCS1A
|
|
00373 88 SCR-ACCESS-INQ VALUE '1'. DTSCS1A
|
|
00374 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS1A
|
|
00375 DTSCS1A
|
|
00376 05 CURSOR-SET-IND PIC X(01). DTSCS1A
|
|
00377 88 CURSOR-SET-YES VALUE 'Y'. DTSCS1A
|
|
00378 88 CURSOR-SET-NO VALUE 'N'. DTSCS1A
|
|
00379 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS1A
|
|
00380 DTSCS1A
|
|
00381 05 REQ-IND PIC X(01). DTSCS1A
|
|
00382 88 REQ-ERROR VALUE 'O'. DTSCS1A
|
|
00383 88 REQ-JUMP VALUE 'J'. DTSCS1A
|
|
00384 88 REQ-INQUIRE VALUE 'I'. DTSCS1A
|
|
00385 88 REQ-CLEAR VALUE 'C'. DTSCS1A
|
|
00386 88 REQ-EDIT VALUE 'E'. DTSCS1A
|
|
00387 88 REQ-UPDATE VALUE 'U'. DTSCS1A
|
|
00388 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS1A
|
|
00389 DTSCS1A
|
|
00390 05 RESP-IND PIC X(01). DTSCS1A
|
|
00391 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS1A
|
|
00392 88 RESP-SEND-MAP VALUE 'M'. DTSCS1A
|
|
00393 88 RESP-JUMP VALUE 'J'. DTSCS1A
|
|
00394 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS1A
|
|
00395 DTSCS1A
|
|
00396 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSCS1A
|
|
00397 DTSCS1A
|
|
00398 05 WRK-HOLD-EMP-NO PIC S9(07) COMP-3. DTSCS1A
|
|
00399 DTSCS1A
|
|
00400 05 WRK-EMP-CHG-ONLY-IND PIC X(01). DTSCS1A
|
|
00401 88 WRK-EMP-CHG-ONLY-88 VALUE 'Y'. DTSCS1A
|
|
00402 88 WRK-EMP-NOT-CHG-ONLY-88 VALUE 'N'. DTSCS1A
|
|
00403 DTSCS1A
|
|
00404 05 WRK-MFAE-IND PIC X(01). DTSCS1A
|
|
00405 88 WRK-MFAE-YES-88 VALUE 'Y'. DTSCS1A
|
|
00406 88 WRK-MFAE-NO-88 VALUE 'N'. DTSCS1A
|
|
00407 DTSCS1A
|
|
00408 05 WRK-MPRF-IND PIC X(01). DTSCS1A
|
|
00409 88 WRK-MPRF-YES-88 VALUE 'Y'. DTSCS1A
|
|
00410 88 WRK-MPRF-NO-88 VALUE 'N'. DTSCS1A
|
|
00411 DTSCS1A
|
|
00412 05 WRK-MERA-IND PIC X(01). DTSCS1A
|
|
00413 88 WRK-MERA-YES-88 VALUE 'Y'. DTSCS1A
|
|
00414 88 WRK-MERA-NO-88 VALUE 'N'. DTSCS1A
|
|
00415 DTSCS1A
|
|
00416 05 WRK-UPD-MERA-IND PIC X(01). DTSCS1A
|
|
00417 88 WRK-UPD-MERA-YES-88 VALUE 'Y'. DTSCS1A
|
|
00418 88 WRK-UPD-MERA-NO-88 VALUE 'N'. DTSCS1A
|
|
00419 DTSCS1A
|
|
00420 05 WRK-MTAD-IND PIC X(01). DTSCS1A
|
|
00421 88 WRK-MTAD-YES-88 VALUE 'Y'. DTSCS1A
|
|
00422 88 WRK-MTAD-NO-88 VALUE 'N'. DTSCS1A
|
|
00423 DTSCS1A
|
|
00424 05 WRK-FISC-AGNT-ERROR-IND PIC X(01). DTSCS1A
|
|
00425 88 WRK-FISC-AGNT-ERROR-YES-88 VALUE 'Y'. DTSCS1A
|
|
00426 88 WRK-FISC-AGNT-ERROR-NO-88 VALUE 'N'. DTSCS1A
|
|
00427 DTSCS1A
|
|
00428 05 WRK-VALID-SOURCE-CD-IND PIC X(01). DTSCS1A
|
|
00429 88 WRK-VALID-SOURCE-CD-YES VALUE 'Y'. DTSCS1A
|
|
00430 88 WRK-VALID-SOURCE-CD-NO VALUE 'N'. DTSCS1A
|
|
00431 DTSCS1A
|
|
00432 05 WRK-NEXT-EMP-NO-FOUND-IND PIC X(01). DTSCS1A
|
|
00433 88 WRK-NEXT-EMP-NO-FOUND-NO-88 VALUE 'N'. DTSCS1A
|
|
00434 88 WRK-NEXT-EMP-NO-FOUND-YES-88 VALUE 'Y'. DTSCS1A
|
|
00435 DTSCS1A
|
|
00436 05 WRK-EMP-NO-UNUSED-IND PIC X(01). DTSCS1A
|
|
00437 88 WRK-EMP-NO-UNUSED-NO-88 VALUE 'N'. DTSCS1A
|
|
00438 88 WRK-EMP-NO-UNUSED-YES-88 VALUE 'Y'. DTSCS1A
|
|
00439 DTSCS1A
|
|
00440 05 WRK-DC-ADDR-IND PIC X(01). DTSCS1A
|
|
00441 88 WRK-DC-ADDR-YES-88 VALUE 'Y'. DTSCS1A
|
|
00442 88 WRK-DC-ADDR-NO-88 VALUE 'N'. DTSCS1A
|
|
00443 05 WRK-PO-BOX-IND PIC X(01). DTSCS1A
|
|
00444 88 WRK-PO-BOX-YES-88 VALUE 'Y'. DTSCS1A
|
|
00445 88 WRK-PO-BOX-NO-88 VALUE 'N'. DTSCS1A
|
|
00446 DTSCS1A
|
|
00447 05 WRK-FR500-RCVD-DATE PIC S9(09) COMP-3 DTSCS1A
|
|
00448 VALUE +0. DTSCS1A
|
|
00449 DTSCS1A
|
|
00450 05 WRK-MSG-AREA. DTSCS1A
|
|
00451 10 WRK-MSG-ID PIC X(04). DTSCS1A
|
|
00452 10 WRK-MSG-FILLER PIC X(60). DTSCS1A
|
|
00453 DTSCS1A
|
|
00454 05 WRK-ATB-AN PIC X(01). DTSCS1A
|
|
00455 DTSCS1A
|
|
00456 05 WRK-ATB-NUM PIC X(01). DTSCS1A
|
|
00457 DTSCS1A
|
|
00458 05 WRK-NAME PIC X(40). DTSCS1A
|
|
00459 DTSCS1A
|
|
00460 05 WRK-DISPLAY PIC 9(11). DTSCS1A
|
|
00461 DTSCS1A
|
|
00462 05 FILLER REDEFINES WRK-DISPLAY. DTSCS1A
|
|
00463 10 FILLER PIC X(05). DTSCS1A
|
|
00464 10 WRK-DISPLAY-EMP-NO-1 PIC X(03). DTSCS1A
|
|
00465 10 WRK-DISPLAY-EMP-NO-2 PIC X(03). DTSCS1A
|
|
00466 DTSCS1A
|
|
00467 05 FILLER REDEFINES WRK-DISPLAY. DTSCS1A
|
|
00468 10 FILLER PIC X(05). DTSCS1A
|
|
00469 10 WRK-DISPLAY-YR PIC X(02). DTSCS1A
|
|
00470 10 WRK-DISPLAY-MO PIC X(02). DTSCS1A
|
|
00471 10 WRK-DISPLAY-DA PIC X(02). DTSCS1A
|
|
00472 DTSCS1A
|
|
00473 05 FILLER REDEFINES WRK-DISPLAY. DTSCS1A
|
|
00474 10 FILLER PIC X(02). DTSCS1A
|
|
00475 10 WRK-DISPLAY-FEIN-1 PIC X(02). DTSCS1A
|
|
00476 10 WRK-DISPLAY-FEIN-2 PIC X(07). DTSCS1A
|
|
00477 DTSCS1A
|
|
00478 05 FILLER REDEFINES WRK-DISPLAY. DTSCS1A
|
|
00479 10 FILLER PIC X(02). DTSCS1A
|
|
00480 10 WRK-DISPLAY-SSN-1 PIC X(03). DTSCS1A
|
|
00481 10 WRK-DISPLAY-SSN-2 PIC X(02). DTSCS1A
|
|
00482 10 WRK-DISPLAY-SSN-3 PIC X(04). DTSCS1A
|
|
00483 DTSCS1A
|
|
00484 DTSCS1A
|
|
00485 05 HOLD-ATTRB-AREA. DTSCS1A
|
|
00486 10 HOLD-ATTN-LINE-A PIC X(01). DTSCS1A
|
|
00487 10 HOLD-DELIV-LINE-1-A PIC X(01). DTSCS1A
|
|
00488 10 HOLD-DELIV-LINE-2-A PIC X(01). DTSCS1A
|
|
00489 10 HOLD-CITY-A PIC X(01). DTSCS1A
|
|
00490 10 HOLD-ST-A PIC X(01). DTSCS1A
|
|
00491 10 HOLD-ZIP-A PIC X(01). DTSCS1A
|
|
00492 EJECT DTSCS1A
|
|
00493 01 MSG-LITERALS. DTSCS1A
|
|
00494 05 MSG-E1A1-AREA. DTSCS1A
|
|
00495 10 FILLER PIC X(04) VALUE 'E1A1'. DTSCS1A
|
|
00496 10 FILLER PIC X(30) DTSCS1A
|
|
00497 VALUE 'DELETE NOT ALLOWED FOR THIS EM'. DTSCS1A
|
|
00498 10 FILLER PIC X(30) DTSCS1A
|
|
00499 VALUE 'PLOYER '. DTSCS1A
|
|
00500 DTSCS1A
|
|
00501 05 MSG-E1A2-AREA. DTSCS1A
|
|
00502 10 FILLER PIC X(04) VALUE 'E1A2'. DTSCS1A
|
|
00503 10 FILLER PIC X(30) DTSCS1A
|
|
00504 VALUE 'NOT ALLOWED - PRIMARY NAME IS '. DTSCS1A
|
|
00505 10 FILLER PIC X(30) DTSCS1A
|
|
00506 VALUE 'ENTITY NAME '. DTSCS1A
|
|
00507 DTSCS1A
|
|
00508 05 MSG-E1A3-AREA. DTSCS1A
|
|
00509 10 FILLER PIC X(04) VALUE 'E1A3'. DTSCS1A
|
|
00510 10 FILLER PIC X(30) DTSCS1A
|
|
00511 VALUE 'NOT ALLOWED - PRIMARY AND ENTI'. DTSCS1A
|
|
00512 10 FILLER PIC X(30) DTSCS1A
|
|
00513 VALUE 'TY NAMES CANNOT BE IDENTICAL '. DTSCS1A
|
|
00514 DTSCS1A
|
|
00515 05 MSG-E1A4-AREA. DTSCS1A
|
|
00516 10 FILLER PIC X(04) VALUE 'E1A4'. DTSCS1A
|
|
00517 10 FILLER PIC X(30) DTSCS1A
|
|
00518 VALUE 'NOT ALLOWED - INITIAL HOUSEHOL'. DTSCS1A
|
|
00519 10 FILLER PIC X(30) DTSCS1A
|
|
00520 VALUE 'D NOTICES ALREADY SENT '. DTSCS1A
|
|
00521 DTSCS1A
|
|
00522 05 MSG-E1A5-AREA. DTSCS1A
|
|
00523 10 FILLER PIC X(04) VALUE 'E1A5'. DTSCS1A
|
|
00524 10 FILLER PIC X(30) DTSCS1A
|
|
00525 VALUE 'NOT ALLOWED - DETERMINATION CO'. DTSCS1A
|
|
00526 10 FILLER PIC X(30) DTSCS1A
|
|
00527 VALUE 'MPLETE '. DTSCS1A
|
|
00528 DTSCS1A
|
|
00529 05 MSG-E1A6-AREA. DTSCS1A
|
|
00530 10 FILLER PIC X(04) VALUE 'E1A6'. DTSCS1A
|
|
00531 10 FILLER PIC X(60) VALUE DTSCS1A
|
|
00532 'DUPLICATE NAME - VERIFY TO CONTINUE. '. DTSCS1A
|
|
00533 DTSCS1A
|
|
00534 05 MSG-E1A7-AREA. DTSCS1A
|
|
00535 10 FILLER PIC X(04) VALUE 'E1A7'. DTSCS1A
|
|
00536 10 FILLER PIC X(50) VALUE DTSCS1A
|
|
00537 'NO DC ADDRESS - VERIFY TO CONTINUE. '. DTSCS1A
|
|
00538 DTSCS1A
|
|
00539 05 MSG-E1A8-AREA. DTSCS1A
|
|
00540 10 FILLER PIC X(04) VALUE 'E1A8'. DTSCS1A
|
|
00541 10 FILLER PIC X(50) VALUE DTSCS1A
|
|
00542 'PO BOX - VERIFY TO CONTINUE. '. DTSCS1A
|
|
00543 DTSCS1A
|
|
00544 05 MSG-SUCCESSFUL-ADD-TEXT. DTSCS1A
|
|
00545 10 FILLER PIC X(17) DTSCS1A
|
|
00546 VALUE 'EMPLOYER ACCOUNT '. DTSCS1A
|
|
00547 10 MSG-EMP-NO-1 PIC X(03). DTSCS1A
|
|
00548 10 FILLER PIC X(01) VALUE ' '. DTSCS1A
|
|
00549 10 MSG-EMP-NO-2 PIC X(03). DTSCS1A
|
|
00550 10 FILLER PIC X(19) DTSCS1A
|
|
00551 VALUE ' SUCCESSFULLY ADDED'. DTSCS1A
|
|
00552 EJECT DTSCS1A
|
|
00553 01 L001-COMM-AREA. DTSCS1A
|
|
00554 ++INCLUDE DTSIL001 DTSCS1A
|
|
00555 EJECT DTSCS1A
|
|
00556 01 L015-COMM-AREA. DTSCS1A
|
|
00557 ++INCLUDE DTSIL015 DTSCS1A
|
|
00558 EJECT DTSCS1A
|
|
00559 01 L017-COMM-AREA. DTSCS1A
|
|
00560 ++INCLUDE DTSIL017 DTSCS1A
|
|
00561 EJECT DTSCS1A
|
|
00562 01 L018-COMM-AREA. DTSCS1A
|
|
00563 ++INCLUDE DTSIL018 DTSCS1A
|
|
00564 EJECT DTSCS1A
|
|
00565 01 L020-COMM-AREA. DTSCS1A
|
|
00566 ++INCLUDE DTSIL020 DTSCS1A
|
|
00567 EJECT DTSCS1A
|
|
00568 01 L021-COMM-AREA. DTSCS1A
|
|
00569 ++INCLUDE DTSIL021 DTSCS1A
|
|
00570 EJECT DTSCS1A
|
|
00571 01 L031-COMM-AREA. DTSCS1A
|
|
00572 ++INCLUDE DTSIL031 DTSCS1A
|
|
00573 EJECT DTSCS1A
|
|
00574 01 L061-COMM-AREA. DTSCS1A
|
|
00575 ++INCLUDE DTSIL061 DTSCS1A
|
|
00576 EJECT DTSCS1A
|
|
00577 01 L062-COMM-AREA. DTSCS1A
|
|
00578 ++INCLUDE DTSIL062 DTSCS1A
|
|
00579 EJECT DTSCS1A
|
|
00580 01 L071-COMM-AREA. DTSCS1A
|
|
00581 ++INCLUDE DTSIL071 DTSCS1A
|
|
00582 EJECT DTSCS1A
|
|
00583 01 L072-COMM-AREA. DTSCS1A
|
|
00584 ++INCLUDE DTSIL072 DTSCS1A
|
|
00585 EJECT DTSCS1A
|
|
00586 01 L073-COMM-AREA. DTSCS1A
|
|
00587 ++INCLUDE DTSIL073 DTSCS1A
|
|
00588 EJECT DTSCS1A
|
|
00589 01 L074-COMM-AREA. DTSCS1A
|
|
00590 ++INCLUDE DTSIL074 DTSCS1A
|
|
00591 EJECT DTSCS1A
|
|
00592 01 L081-COMM-AREA. DTSCS1A
|
|
00593 ++INCLUDE DTSIL081 DTSCS1A
|
|
00594 EJECT DTSCS1A
|
|
00595 01 L082-COMM-AREA. DTSCS1A
|
|
00596 ++INCLUDE DTSIL082 DTSCS1A
|
|
00597 EJECT DTSCS1A
|
|
00598 01 L203-COMM-AREA. DTSCS1A
|
|
00599 ++INCLUDE DTSIL203 DTSCS1A
|
|
00600 EJECT DTSCS1A
|
|
00601 01 L221-COMM-AREA. DTSCS1A
|
|
00602 ++INCLUDE DTSIL221 DTSCS1A
|
|
00603 EJECT DTSCS1A
|
|
00604 01 L331-COMM-AREA. DTSCS1A
|
|
00605 ++INCLUDE DTSIL331 DTSCS1A
|
|
00606 EJECT DTSCS1A
|
|
00607 01 L400-COMM-AREA. DTSCS1A
|
|
00608 ++INCLUDE DTSIL400 DTSCS1A
|
|
00609 EJECT DTSCS1A
|
|
00610 01 L805-COMM-AREA. DTSCS1A
|
|
00611 ++INCLUDE DTSIL805 DTSCS1A
|
|
00612 EJECT DTSCS1A
|
|
00613 01 L810-COMM-AREA. DTSCS1A
|
|
00614 05 L810-CONTROL-BLOCK. DTSCS1A
|
|
00615 ++INCLUDE DTSIL810 DTSCS1A
|
|
00616 EJECT DTSCS1A
|
|
00617 05 MSKL-REC. DTSCS1A
|
|
00618 ++INCLUDE DTSIMSKL DTSCS1A
|
|
00619 EJECT DTSCS1A
|
|
00620 01 L831-COMM-AREA. DTSCS1A
|
|
00621 05 L831-CONTROL-BLOCK. DTSCS1A
|
|
00622 ++INCLUDE DTSIL831 DTSCS1A
|
|
00623 EJECT DTSCS1A
|
|
00624 05 FSKL-REC. DTSCS1A
|
|
00625 ++INCLUDE DTSIFSKL DTSCS1A
|
|
00626 EJECT DTSCS1A
|
|
00627 05 MFAE-REC. DTSCS1A
|
|
00628 ++INCLUDE DTSIMFAE DTSCS1A
|
|
00629 EJECT DTSCS1A
|
|
00630 05 FFIS-REC. DTSCS1A
|
|
00631 ++INCLUDE DTSIFFIS DTSCS1A
|
|
00632 EJECT DTSCS1A
|
|
00633 01 MHDR-REC. DTSCS1A
|
|
00634 ++INCLUDE DTSIMHDR DTSCS1A
|
|
00635 EJECT DTSCS1A
|
|
00636 01 MPRF-REC. DTSCS1A
|
|
00637 ++INCLUDE DTSIMPRF DTSCS1A
|
|
00638 EJECT DTSCS1A
|
|
00639 01 MERA-REC. DTSCS1A
|
|
00640 ++INCLUDE DTSIMERA DTSCS1A
|
|
00641 EJECT DTSCS1A
|
|
00642 01 MTAD-REC. DTSCS1A
|
|
00643 ++INCLUDE DTSIMTAD DTSCS1A
|
|
00644 EJECT DTSCS1A
|
|
00645 01 MTCK-REC. DTSCS1A
|
|
00646 ++INCLUDE DTSIMTCK DTSCS1A
|
|
00647 EJECT DTSCS1A
|
|
00648 01 MEVL-REC. DTSCS1A
|
|
00649 ++INCLUDE DTSIMEVL DTSCS1A
|
|
00650 EJECT DTSCS1A
|
|
00651 01 L821-COMM-AREA. DTSCS1A
|
|
00652 05 L821-CONTROL-BLOCK. DTSCS1A
|
|
00653 ++INCLUDE DTSIL821 DTSCS1A
|
|
00654 SKIP3 DTSCS1A
|
|
00655 05 ISKL-REC. DTSCS1A
|
|
00656 ++INCLUDE DTSIISKL DTSCS1A
|
|
00657 DTSCS1A
|
|
00658 01 IBTB-REC. DTSCS1A
|
|
00659 ++INCLUDE DTSIIBTB DTSCS1A
|
|
00660 DTSCS1A
|
|
00661 * MAP DEFINITION DTSCS1A
|
|
00662 01 L851-COMM-AREA. DTSCS1A
|
|
00663 ++INCLUDE DTSIL851 DTSCS1A
|
|
00664 SKIP3 DTSCS1A
|
|
00665 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS1A
|
|
00666 ++INCLUDE DTSIS1A DTSCS1A
|
|
00667 EJECT DTSCS1A
|
|
00668 01 CATB-LITERALS. DTSCS1A
|
|
00669 ++INCLUDE DTSICATB DTSCS1A
|
|
00670 SKIP3 DTSCS1A
|
|
00671 01 CFKD-LITERALS. DTSCS1A
|
|
00672 ++INCLUDE DTSICFKD DTSCS1A
|
|
00673 SKIP3 DTSCS1A
|
|
00674 01 CECD-LITERALS. DTSCS1A
|
|
00675 ++INCLUDE DTSICECD DTSCS1A
|
|
00676 SKIP3 DTSCS1A
|
|
00677 01 CPCD-LITERALS. DTSCS1A
|
|
00678 ++INCLUDE DTSICPCD DTSCS1A
|
|
00679 EJECT DTSCS1A
|
|
00680 01 MLEN-LITERALS. DTSCS1A
|
|
00681 ++INCLUDE DTSIMLEN DTSCS1A
|
|
00682 EJECT DTSCS1A
|
|
00683 01 CENO-LITERALS. DTSCS1A
|
|
00684 ++INCLUDE DTSICENO DTSCS1A
|
|
00685 EJECT DTSCS1A
|
|
00686 LINKAGE SECTION. DTSCS1A
|
|
00687 SKIP3 DTSCS1A
|
|
00688 01 DFHCOMMAREA. DTSCS1A
|
|
00689 ++INCLUDE DTSILCCM DTSCS1A
|
|
00690 SKIP3 DTSCS1A
|
|
00691 15 FILLER REDEFINES LCCM-SCR-HOLD-AREA. DTSCS1A
|
|
00692 20 LCCM-HOLD-ADDRESS-1 PIC X(171). DTSCS1A
|
|
00693 EJECT DTSCS1A
|
|
00694 PROCEDURE DIVISION. DTSCS1A
|
|
00695 SKIP2 DTSCS1A
|
|
00696 MOVE +0 TO WRK-EMP-NO DTSCS1A
|
|
00697 WRK-HOLD-EMP-NO. DTSCS1A
|
|
00698 DTSCS1A
|
|
00699 SET WRK-EMP-NOT-CHG-ONLY-88 TO TRUE. DTSCS1A
|
|
00700 DTSCS1A
|
|
00701 SET WRK-MPRF-NO-88 TO TRUE. DTSCS1A
|
|
00702 DTSCS1A
|
|
00703 SET WRK-MERA-NO-88 TO TRUE. DTSCS1A
|
|
00704 DTSCS1A
|
|
00705 SET WRK-MTAD-NO-88 TO TRUE. DTSCS1A
|
|
00706 DTSCS1A
|
|
00707 MOVE LOW-VALUES TO MAP-AREA. DTSCS1A
|
|
00708 DTSCS1A
|
|
00709 SET CURSOR-SET-NO TO TRUE. DTSCS1A
|
|
00710 DTSCS1A
|
|
00711 SET SCR-ACCESS-INQ TO TRUE. DTSCS1A
|
|
00712 DTSCS1A
|
|
00713 PERFORM P0100-ACCESS-SEARCH THRU P0100-EXIT DTSCS1A
|
|
00714 VARYING LCCM-NONUM-IDX FROM 1 BY 1 DTSCS1A
|
|
00715 UNTIL LCCM-NONUM-IDX > LCCM-SCR-NONUM-CNT. DTSCS1A
|
|
00716 DTSCS1A
|
|
00717 DTSCS1A
|
|
00718 MOVE SPACE TO REQ-IND. DTSCS1A
|
|
00719 DTSCS1A
|
|
00720 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS1A
|
|
00721 DTSCS1A
|
|
00722 DTSCS1A
|
|
00723 *----------------------------------------------------- DTSCS1A
|
|
00724 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS1A
|
|
00725 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS1A
|
|
00726 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS1A
|
|
00727 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS1A
|
|
00728 * DTSCS1A
|
|
00729 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS1A
|
|
00730 * PROCESSED. DTSCS1A
|
|
00731 * DTSCS1A
|
|
00732 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS1A
|
|
00733 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS1A
|
|
00734 * WORK STATION OPERATOR. DTSCS1A
|
|
00735 *----------------------------------------------------- DTSCS1A
|
|
00736 DTSCS1A
|
|
00737 MOVE SPACE TO RESP-IND. DTSCS1A
|
|
00738 DTSCS1A
|
|
00739 IF REQ-ERROR DTSCS1A
|
|
00740 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS1A
|
|
00741 ELSE DTSCS1A
|
|
00742 IF REQ-JUMP DTSCS1A
|
|
00743 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS1A
|
|
00744 ELSE DTSCS1A
|
|
00745 IF REQ-CLEAR DTSCS1A
|
|
00746 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS1A
|
|
00747 ELSE DTSCS1A
|
|
00748 IF REQ-CURSOR-TO-GOTO DTSCS1A
|
|
00749 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS1A
|
|
00750 ELSE DTSCS1A
|
|
00751 IF REQ-INQUIRE DTSCS1A
|
|
00752 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS1A
|
|
00753 ELSE DTSCS1A
|
|
00754 IF REQ-EDIT DTSCS1A
|
|
00755 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS1A
|
|
00756 ELSE DTSCS1A
|
|
00757 IF REQ-UPDATE DTSCS1A
|
|
00758 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS1A
|
|
00759 ELSE DTSCS1A
|
|
00760 GO TO S899-ABEND. DTSCS1A
|
|
00761 DTSCS1A
|
|
00762 DTSCS1A
|
|
00763 *----------------------------------------------------- DTSCS1A
|
|
00764 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS1A
|
|
00765 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS1A
|
|
00766 *----------------------------------------------------- DTSCS1A
|
|
00767 DTSCS1A
|
|
00768 IF RESP-SEND-MAP DTSCS1A
|
|
00769 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS1A
|
|
00770 SET LCCM-END-TASK-88 TO TRUE DTSCS1A
|
|
00771 ELSE DTSCS1A
|
|
00772 IF RESP-SEND-MSGONLY DTSCS1A
|
|
00773 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS1A
|
|
00774 SET LCCM-END-TASK-88 TO TRUE DTSCS1A
|
|
00775 ELSE DTSCS1A
|
|
00776 IF RESP-JUMP DTSCS1A
|
|
00777 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS1A
|
|
00778 ELSE DTSCS1A
|
|
00779 IF RESP-CURSOR-TO-GOTO DTSCS1A
|
|
00780 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS1A
|
|
00781 SET LCCM-END-TASK-88 TO TRUE DTSCS1A
|
|
00782 ELSE DTSCS1A
|
|
00783 GO TO S899-ABEND. DTSCS1A
|
|
00784 DTSCS1A
|
|
00785 DTSCS1A
|
|
00786 MAINLINE-EXIT. DTSCS1A
|
|
00787 DTSCS1A
|
|
00788 EXEC CICS DTSCS1A
|
|
00789 RETURN DTSCS1A
|
|
00790 END-EXEC. DTSCS1A
|
|
00791 DTSCS1A
|
|
00792 GOBACK. DTSCS1A
|
|
00793 EJECT DTSCS1A
|
|
00794 P0100-ACCESS-SEARCH. DTSCS1A
|
|
00795 IF LCCM-SCR-NONUM-ID (LCCM-NONUM-IDX) = WRK-SCR-ID DTSCS1A
|
|
00796 MOVE LCCM-SCR-NONUM-ACCESS-IND (LCCM-NONUM-IDX) DTSCS1A
|
|
00797 TO SCR-ACCESS-IND. DTSCS1A
|
|
00798 P0100-EXIT. DTSCS1A
|
|
00799 EXIT. DTSCS1A
|
|
00800 /*****************************************************************DTSCS1A
|
|
00801 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS1A
|
|
00802 ******************************************************************DTSCS1A
|
|
00803 P1000-ANALYZE-REQUEST. DTSCS1A
|
|
00804 DTSCS1A
|
|
00805 *----------------------------------------------------- DTSCS1A
|
|
00806 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS1A
|
|
00807 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS1A
|
|
00808 * REPLACED WITH ENTER) DTSCS1A
|
|
00809 *----------------------------------------------------- DTSCS1A
|
|
00810 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS1A
|
|
00811 SET LCCM-ENTER-88 TO TRUE DTSCS1A
|
|
00812 SET REQ-INQUIRE TO TRUE DTSCS1A
|
|
00813 IF LCCM-EMP-NO > ZERO DTSCS1A
|
|
00814 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS1A
|
|
00815 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS1A
|
|
00816 END-IF DTSCS1A
|
|
00817 GO TO P1000-EXIT. DTSCS1A
|
|
00818 DTSCS1A
|
|
00819 DTSCS1A
|
|
00820 *----------------------------------------------------- DTSCS1A
|
|
00821 * MAP IS RECEIVED DTSCS1A
|
|
00822 *----------------------------------------------------- DTSCS1A
|
|
00823 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS1A
|
|
00824 DTSCS1A
|
|
00825 DTSCS1A
|
|
00826 *----------------------------------------------------- DTSCS1A
|
|
00827 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS1A
|
|
00828 * WORK STATION DTSCS1A
|
|
00829 *----------------------------------------------------- DTSCS1A
|
|
00830 IF LCCM-CLEAR-88 DTSCS1A
|
|
00831 SET REQ-CLEAR TO TRUE DTSCS1A
|
|
00832 GO TO P1000-EXIT. DTSCS1A
|
|
00833 DTSCS1A
|
|
00834 DTSCS1A
|
|
00835 *----------------------------------------------------- DTSCS1A
|
|
00836 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS1A
|
|
00837 *----------------------------------------------------- DTSCS1A
|
|
00838 IF LCCM-SCR-UPDATE-LOCKED DTSCS1A
|
|
00839 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS1A
|
|
00840 GO TO P1000-EXIT. DTSCS1A
|
|
00841 DTSCS1A
|
|
00842 DTSCS1A
|
|
00843 *----------------------------------------------------- DTSCS1A
|
|
00844 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS1A
|
|
00845 *----------------------------------------------------- DTSCS1A
|
|
00846 IF LCCM-PA2-88 DTSCS1A
|
|
00847 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS1A
|
|
00848 GO TO P1000-EXIT. DTSCS1A
|
|
00849 DTSCS1A
|
|
00850 DTSCS1A
|
|
00851 *----------------------------------------------------- DTSCS1A
|
|
00852 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS1A
|
|
00853 *----------------------------------------------------- DTSCS1A
|
|
00854 IF LCCM-PA-88 DTSCS1A
|
|
00855 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS1A
|
|
00856 SET REQ-ERROR TO TRUE DTSCS1A
|
|
00857 GO TO P1000-EXIT. DTSCS1A
|
|
00858 DTSCS1A
|
|
00859 DTSCS1A
|
|
00860 *----------------------------------------------------- DTSCS1A
|
|
00861 * F12 PRESSED WHEN UPDATE NOT IN PROGRESS IS A DTSCS1A
|
|
00862 * REQUES TO CLEAR THE SCREEN. DTSCS1A
|
|
00863 *----------------------------------------------------- DTSCS1A
|
|
00864 IF LCCM-F12-88 DTSCS1A
|
|
00865 MOVE LOW-VALUES TO MAP-AREA DTSCS1A
|
|
00866 SET REQ-CLEAR TO TRUE DTSCS1A
|
|
00867 GO TO P1000-EXIT. DTSCS1A
|
|
00868 DTSCS1A
|
|
00869 DTSCS1A
|
|
00870 *----------------------------------------------------- DTSCS1A
|
|
00871 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS1A
|
|
00872 *----------------------------------------------------- DTSCS1A
|
|
00873 IF LCCM-F03-88 DTSCS1A
|
|
00874 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS1A
|
|
00875 SET REQ-JUMP TO TRUE DTSCS1A
|
|
00876 GO TO P1000-EXIT. DTSCS1A
|
|
00877 DTSCS1A
|
|
00878 DTSCS1A
|
|
00879 *----------------------------------------------------- DTSCS1A
|
|
00880 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS1A
|
|
00881 *----------------------------------------------------- DTSCS1A
|
|
00882 IF LCCM-F04-88 DTSCS1A
|
|
00883 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS1A
|
|
00884 SET REQ-JUMP TO TRUE DTSCS1A
|
|
00885 GO TO P1000-EXIT. DTSCS1A
|
|
00886 DTSCS1A
|
|
00887 DTSCS1A
|
|
00888 *----------------------------------------------------- DTSCS1A
|
|
00889 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS1A
|
|
00890 * CORRESPONDENCE SCREEN DTSCS1A
|
|
00891 *----------------------------------------------------- DTSCS1A
|
|
00892 IF LCCM-F14-88 DTSCS1A
|
|
00893 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS1A
|
|
00894 SET REQ-JUMP TO TRUE DTSCS1A
|
|
00895 GO TO P1000-EXIT. DTSCS1A
|
|
00896 DTSCS1A
|
|
00897 DTSCS1A
|
|
00898 *----------------------------------------------------- DTSCS1A
|
|
00899 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS1A
|
|
00900 * REQUESTED SCREEN TYPE DTSCS1A
|
|
00901 *----------------------------------------------------- DTSCS1A
|
|
00902 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS1A
|
|
00903 NEXT SENTENCE DTSCS1A
|
|
00904 ELSE DTSCS1A
|
|
00905 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS1A
|
|
00906 SET REQ-JUMP TO TRUE DTSCS1A
|
|
00907 GO TO P1000-EXIT. DTSCS1A
|
|
00908 DTSCS1A
|
|
00909 DTSCS1A
|
|
00910 *----------------------------------------------------- DTSCS1A
|
|
00911 * IF REQUEST TO UPDATE THE DATA (ADD, MOD, DEL) DTSCS1A
|
|
00912 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS1A
|
|
00913 *----------------------------------------------------- DTSCS1A
|
|
00914 IF LCCM-F09-88 OR LCCM-F10-88 OR LCCM-F23-88 DTSCS1A
|
|
00915 IF SCR-ACCESS-UPDATE DTSCS1A
|
|
00916 SET REQ-EDIT TO TRUE DTSCS1A
|
|
00917 GO TO P1000-EXIT DTSCS1A
|
|
00918 ELSE DTSCS1A
|
|
00919 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS1A
|
|
00920 SET REQ-ERROR TO TRUE DTSCS1A
|
|
00921 GO TO P1000-EXIT. DTSCS1A
|
|
00922 DTSCS1A
|
|
00923 DTSCS1A
|
|
00924 *----------------------------------------------------- DTSCS1A
|
|
00925 * IF INQUIRY TYPE KEY PRESSED (ENTER), INDICATE DTSCS1A
|
|
00926 * INQUIRY REQUEST DTSCS1A
|
|
00927 *----------------------------------------------------- DTSCS1A
|
|
00928 IF LCCM-ENTER-88 DTSCS1A
|
|
00929 SET REQ-INQUIRE TO TRUE DTSCS1A
|
|
00930 GO TO P1000-EXIT. DTSCS1A
|
|
00931 DTSCS1A
|
|
00932 DTSCS1A
|
|
00933 *----------------------------------------------------- DTSCS1A
|
|
00934 * ANY OTHER KEY IS INVALID DTSCS1A
|
|
00935 *----------------------------------------------------- DTSCS1A
|
|
00936 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS1A
|
|
00937 DTSCS1A
|
|
00938 SET REQ-ERROR TO TRUE. DTSCS1A
|
|
00939 P1000-EXIT. DTSCS1A
|
|
00940 EXIT. DTSCS1A
|
|
00941 SKIP3 DTSCS1A
|
|
00942 ******************************************************************DTSCS1A
|
|
00943 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS1A
|
|
00944 ******************************************************************DTSCS1A
|
|
00945 DTSCS1A
|
|
00946 P1100-UPDATE-LOCKED. DTSCS1A
|
|
00947 *----------------------------------------------------- DTSCS1A
|
|
00948 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS1A
|
|
00949 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCS1A
|
|
00950 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS1A
|
|
00951 *----------------------------------------------------- DTSCS1A
|
|
00952 IF LCCM-ENTER-88 OR LCCM-F12-88 DTSCS1A
|
|
00953 SET REQ-UPDATE TO TRUE DTSCS1A
|
|
00954 ELSE DTSCS1A
|
|
00955 SET REQ-ERROR TO TRUE DTSCS1A
|
|
00956 IF LCCM-SCR-ADD-LOCKED DTSCS1A
|
|
00957 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS1A
|
|
00958 ELSE DTSCS1A
|
|
00959 IF LCCM-SCR-MOD-LOCKED DTSCS1A
|
|
00960 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS1A
|
|
00961 ELSE DTSCS1A
|
|
00962 IF LCCM-SCR-DEL-LOCKED DTSCS1A
|
|
00963 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID DTSCS1A
|
|
00964 ELSE DTSCS1A
|
|
00965 GO TO S899-ABEND. DTSCS1A
|
|
00966 P1100-EXIT. DTSCS1A
|
|
00967 EXIT. DTSCS1A
|
|
00968 /*****************************************************************DTSCS1A
|
|
00969 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS1A
|
|
00970 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS1A
|
|
00971 ******************************************************************DTSCS1A
|
|
00972 DTSCS1A
|
|
00973 P2000-REQUEST-ERROR. DTSCS1A
|
|
00974 IF LCCM-MSG DTSCS1A
|
|
00975 SET RESP-SEND-MSGONLY TO TRUE DTSCS1A
|
|
00976 ELSE DTSCS1A
|
|
00977 GO TO S899-ABEND. DTSCS1A
|
|
00978 P2000-EXIT. DTSCS1A
|
|
00979 EXIT. DTSCS1A
|
|
00980 /*****************************************************************DTSCS1A
|
|
00981 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS1A
|
|
00982 ******************************************************************DTSCS1A
|
|
00983 DTSCS1A
|
|
00984 P3000-REQUEST-JUMP. DTSCS1A
|
|
00985 *----------------------------------------------------- DTSCS1A
|
|
00986 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS1A
|
|
00987 * BY USER DTSCS1A
|
|
00988 *----------------------------------------------------- DTSCS1A
|
|
00989 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS1A
|
|
00990 DTSCS1A
|
|
00991 DTSCS1A
|
|
00992 *----------------------------------------------------- DTSCS1A
|
|
00993 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS1A
|
|
00994 *----------------------------------------------------- DTSCS1A
|
|
00995 IF LCCM-MSG DTSCS1A
|
|
00996 SET RESP-SEND-MSGONLY TO TRUE DTSCS1A
|
|
00997 SET CURSOR-SET-GOTO TO TRUE DTSCS1A
|
|
00998 GO TO P3000-EXIT. DTSCS1A
|
|
00999 DTSCS1A
|
|
01000 DTSCS1A
|
|
01001 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS1A
|
|
01002 DTSCS1A
|
|
01003 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS1A
|
|
01004 DTSCS1A
|
|
01005 IF L018-VALID DTSCS1A
|
|
01006 MOVE L018-EMP-NO TO LCCM-EMP-NO. DTSCS1A
|
|
01007 DTSCS1A
|
|
01008 DTSCS1A
|
|
01009 *----------------------------------------------------- DTSCS1A
|
|
01010 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS1A
|
|
01011 *----------------------------------------------------- DTSCS1A
|
|
01012 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS1A
|
|
01013 LCCM-SCR-HOLD-AREA. DTSCS1A
|
|
01014 DTSCS1A
|
|
01015 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS1A
|
|
01016 DTSCS1A
|
|
01017 SET RESP-JUMP TO TRUE. DTSCS1A
|
|
01018 P3000-EXIT. DTSCS1A
|
|
01019 EXIT. DTSCS1A
|
|
01020 /*****************************************************************DTSCS1A
|
|
01021 * CLEAR KEY WAS PRESSED *DTSCS1A
|
|
01022 ******************************************************************DTSCS1A
|
|
01023 DTSCS1A
|
|
01024 P4000-REQUEST-CLEAR. DTSCS1A
|
|
01025 IF SCR-ACCESS-UPDATE DTSCS1A
|
|
01026 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS1A
|
|
01027 ELSE DTSCS1A
|
|
01028 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS1A
|
|
01029 DTSCS1A
|
|
01030 DTSCS1A
|
|
01031 *----------------------------------------------------- DTSCS1A
|
|
01032 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS1A
|
|
01033 * FIELDS FROM EARLIER REQUESTS DTSCS1A
|
|
01034 *----------------------------------------------------- DTSCS1A
|
|
01035 IF LCCM-EMP-NO > ZERO DTSCS1A
|
|
01036 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS1A
|
|
01037 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS1A
|
|
01038 DTSCS1A
|
|
01039 MOVE ZERO TO LCCM-EMP-NO. DTSCS1A
|
|
01040 DTSCS1A
|
|
01041 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA. DTSCS1A
|
|
01042 DTSCS1A
|
|
01043 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS1A
|
|
01044 DTSCS1A
|
|
01045 SET LCCM-SCR-CLEAR TO TRUE. DTSCS1A
|
|
01046 DTSCS1A
|
|
01047 SET RESP-SEND-MAP TO TRUE. DTSCS1A
|
|
01048 P4000-EXIT. DTSCS1A
|
|
01049 EXIT. DTSCS1A
|
|
01050 /*****************************************************************DTSCS1A
|
|
01051 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS1A
|
|
01052 ******************************************************************DTSCS1A
|
|
01053 DTSCS1A
|
|
01054 P5000-CURSOR-TO-GOTO. DTSCS1A
|
|
01055 SET CURSOR-SET-GOTO TO TRUE. DTSCS1A
|
|
01056 DTSCS1A
|
|
01057 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS1A
|
|
01058 P5000-EXIT. DTSCS1A
|
|
01059 EXIT. DTSCS1A
|
|
01060 /*****************************************************************DTSCS1A
|
|
01061 * INQUIRY WAS REQUESTED *DTSCS1A
|
|
01062 ******************************************************************DTSCS1A
|
|
01063 DTSCS1A
|
|
01064 P6000-REQUEST-INQUIRE. DTSCS1A
|
|
01065 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS1A
|
|
01066 DTSCS1A
|
|
01067 MOVE LOW-VALUES TO MAP-AREA. DTSCS1A
|
|
01068 DTSCS1A
|
|
01069 MOVE L018-S-EMP-NO-AREA TO MAP-EMP-NO-AREA. DTSCS1A
|
|
01070 DTSCS1A
|
|
01071 IF SCR-ACCESS-UPDATE DTSCS1A
|
|
01072 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS1A
|
|
01073 ELSE DTSCS1A
|
|
01074 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS1A
|
|
01075 DTSCS1A
|
|
01076 SET LCCM-SCR-CLEAR TO TRUE. DTSCS1A
|
|
01077 DTSCS1A
|
|
01078 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS1A
|
|
01079 DTSCS1A
|
|
01080 PERFORM S1001-EDIT-KEY THRU S1001-EXIT. DTSCS1A
|
|
01081 DTSCS1A
|
|
01082 IF LCCM-MSG DTSCS1A
|
|
01083 NEXT SENTENCE DTSCS1A
|
|
01084 ELSE DTSCS1A
|
|
01085 IF LCCM-ENTER-88 DTSCS1A
|
|
01086 PERFORM P6100-NO-PAGE THRU P6100-EXIT DTSCS1A
|
|
01087 ELSE DTSCS1A
|
|
01088 GO TO S899-ABEND. DTSCS1A
|
|
01089 DTSCS1A
|
|
01090 SET RESP-SEND-MAP TO TRUE. DTSCS1A
|
|
01091 P6000-EXIT. DTSCS1A
|
|
01092 EXIT. DTSCS1A
|
|
01093 EJECT DTSCS1A
|
|
01094 P6100-NO-PAGE. DTSCS1A
|
|
01095 PERFORM S1190-READ-MPRF THRU S1190-EXIT. DTSCS1A
|
|
01096 DTSCS1A
|
|
01097 IF LCCM-MSG DTSCS1A
|
|
01098 GO TO P6100-EXIT. DTSCS1A
|
|
01099 DTSCS1A
|
|
01100 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS1A
|
|
01101 P6100-EXIT. DTSCS1A
|
|
01102 EXIT. DTSCS1A
|
|
01103 /*****************************************************************DTSCS1A
|
|
01104 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCS1A
|
|
01105 ******************************************************************DTSCS1A
|
|
01106 DTSCS1A
|
|
01107 P6900-CONSTRUCT-SCREEN. DTSCS1A
|
|
01108 PERFORM P6910-FROM-MPRF THRU P6910-EXIT. DTSCS1A
|
|
01109 DTSCS1A
|
|
01110 PERFORM P6920-FROM-MTAD THRU P6920-EXIT. DTSCS1A
|
|
01111 DTSCS1A
|
|
01112 PERFORM P6930-FROM-MERA THRU P6930-EXIT. DTSCS1A
|
|
01113 DTSCS1A
|
|
01114 PERFORM P6940-FROM-MFAE THRU P6940-EXIT. DTSCS1A
|
|
01115 DTSCS1A
|
|
01116 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS1A
|
|
01117 DTSCS1A
|
|
01118 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS1A
|
|
01119 P6900-EXIT. DTSCS1A
|
|
01120 EXIT. DTSCS1A
|
|
01121 SKIP3 DTSCS1A
|
|
01122 P6910-FROM-MPRF. DTSCS1A
|
|
01123 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME. DTSCS1A
|
|
01124 DTSCS1A
|
|
01125 MOVE MPRF-ENTITY-NAME-IND TO MAP-ENTITY-NAME-IND. DTSCS1A
|
|
01126 DTSCS1A
|
|
01127 MOVE MPRF-ENTITY-NAME TO MAP-ENTITY-NAME. DTSCS1A
|
|
01128 DTSCS1A
|
|
01129 IF MPRF-FEIN > 0 DTSCS1A
|
|
01130 MOVE MPRF-FEIN TO WRK-DISPLAY DTSCS1A
|
|
01131 MOVE WRK-DISPLAY-FEIN-1 TO MAP-FEIN-1 DTSCS1A
|
|
01132 MOVE WRK-DISPLAY-FEIN-2 TO MAP-FEIN-2. DTSCS1A
|
|
01133 P6910-EXIT. DTSCS1A
|
|
01134 EXIT. DTSCS1A
|
|
01135 SKIP3 DTSCS1A
|
|
01136 P6920-FROM-MTAD. DTSCS1A
|
|
01137 MOVE LOW-VALUES TO MTAD-KEY-AREA. DTSCS1A
|
|
01138 DTSCS1A
|
|
01139 MOVE WRK-EMP-NO TO MTAD-EMP-NO. DTSCS1A
|
|
01140 DTSCS1A
|
|
01141 SET MTAD-TAD-88 TO TRUE. DTSCS1A
|
|
01142 DTSCS1A
|
|
01143 SET MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE. DTSCS1A
|
|
01144 DTSCS1A
|
|
01145 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSCS1A
|
|
01146 DTSCS1A
|
|
01147 PERFORM S810-READ THRU S810-EXIT. DTSCS1A
|
|
01148 DTSCS1A
|
|
01149 IF L810-NO-REC-88 DTSCS1A
|
|
01150 GO TO P6920-EXIT. DTSCS1A
|
|
01151 DTSCS1A
|
|
01152 MOVE MSKL-REC TO MTAD-REC. DTSCS1A
|
|
01153 DTSCS1A
|
|
01154 MOVE MTAD-ATTN-LINE TO MAP-ATTN-LINE. DTSCS1A
|
|
01155 DTSCS1A
|
|
01156 MOVE MTAD-DELIV-LINE-1 TO MAP-DELIV-LINE-1. DTSCS1A
|
|
01157 DTSCS1A
|
|
01158 MOVE MTAD-DELIV-LINE-2 TO MAP-DELIV-LINE-2. DTSCS1A
|
|
01159 DTSCS1A
|
|
01160 MOVE MTAD-CITY TO MAP-CITY. DTSCS1A
|
|
01161 DTSCS1A
|
|
01162 MOVE MTAD-ST TO MAP-ST. DTSCS1A
|
|
01163 DTSCS1A
|
|
01164 MOVE MTAD-ZIP TO MAP-ZIP. DTSCS1A
|
|
01165 DTSCS1A
|
|
01166 IF MTAD-VOICE-1 NOT = SPACES DTSCS1A
|
|
01167 MOVE MTAD-VOICE-1-AREA-CD TO MAP-VOICE-1-AREA-CD DTSCS1A
|
|
01168 MOVE MTAD-VOICE-1-PREFIX TO MAP-VOICE-1-PREFIX DTSCS1A
|
|
01169 MOVE MTAD-VOICE-1-SUFFIX TO MAP-VOICE-1-SUFFIX DTSCS1A
|
|
01170 MOVE MTAD-VOICE-1-EXT TO MAP-VOICE-1-EXT. DTSCS1A
|
|
01171 DTSCS1A
|
|
01172 IF MTAD-VOICE-2 NOT = SPACES DTSCS1A
|
|
01173 MOVE MTAD-VOICE-2-AREA-CD TO MAP-VOICE-2-AREA-CD DTSCS1A
|
|
01174 MOVE MTAD-VOICE-2-PREFIX TO MAP-VOICE-2-PREFIX DTSCS1A
|
|
01175 MOVE MTAD-VOICE-2-SUFFIX TO MAP-VOICE-2-SUFFIX DTSCS1A
|
|
01176 MOVE MTAD-VOICE-2-EXT TO MAP-VOICE-2-EXT. DTSCS1A
|
|
01177 DTSCS1A
|
|
01178 IF MTAD-FAX NOT = SPACES DTSCS1A
|
|
01179 MOVE MTAD-FAX-AREA-CD TO MAP-FAX-AREA-CD DTSCS1A
|
|
01180 MOVE MTAD-FAX-PREFIX TO MAP-FAX-PREFIX DTSCS1A
|
|
01181 MOVE MTAD-FAX-SUFFIX TO MAP-FAX-SUFFIX DTSCS1A
|
|
01182 MOVE MTAD-FAX-EXT TO MAP-FAX-EXT. DTSCS1A
|
|
01183 P6920-EXIT. DTSCS1A
|
|
01184 EXIT. DTSCS1A
|
|
01185 SKIP3 DTSCS1A
|
|
01186 P6930-FROM-MERA. DTSCS1A
|
|
01187 MOVE LOW-VALUES TO MERA-KEY-AREA. DTSCS1A
|
|
01188 DTSCS1A
|
|
01189 MOVE WRK-EMP-NO TO MERA-EMP-NO. DTSCS1A
|
|
01190 DTSCS1A
|
|
01191 SET MERA-ERA-88 TO TRUE. DTSCS1A
|
|
01192 DTSCS1A
|
|
01193 MOVE MERA-KEY-AREA TO MSKL-KEY-AREA. DTSCS1A
|
|
01194 DTSCS1A
|
|
01195 PERFORM S810-READ THRU S810-EXIT. DTSCS1A
|
|
01196 DTSCS1A
|
|
01197 IF L810-NO-REC-88 DTSCS1A
|
|
01198 GO TO P6930-EXIT. DTSCS1A
|
|
01199 DTSCS1A
|
|
01200 MOVE MSKL-REC TO MERA-REC. DTSCS1A
|
|
01201 DTSCS1A
|
|
01202 MOVE MERA-SOURCE-CD TO MAP-SOURCE-CD. DTSCS1A
|
|
01203 DTSCS1A
|
|
01204 IF MERA-CLAIMANT-SSN NOT = +0 DTSCS1A
|
|
01205 MOVE MERA-CLAIMANT-SSN TO WRK-DISPLAY DTSCS1A
|
|
01206 MOVE WRK-DISPLAY-SSN-1 TO MAP-CLAIMANT-SSN-1 DTSCS1A
|
|
01207 MOVE WRK-DISPLAY-SSN-2 TO MAP-CLAIMANT-SSN-2 DTSCS1A
|
|
01208 MOVE WRK-DISPLAY-SSN-3 TO MAP-CLAIMANT-SSN-3. DTSCS1A
|
|
01209 DTSCS1A
|
|
01210 MOVE MERA-CLAIMANT-NAME TO MAP-CLAIMANT-NAME. DTSCS1A
|
|
01211 DTSCS1A
|
|
01212 IF MERA-POT-PRED-EMP-NO NOT = +0 DTSCS1A
|
|
01213 MOVE MERA-POT-PRED-EMP-NO TO WRK-DISPLAY DTSCS1A
|
|
01214 MOVE WRK-DISPLAY-EMP-NO-1 TO MAP-PRED-EMP-NO-1 DTSCS1A
|
|
01215 MOVE WRK-DISPLAY-EMP-NO-2 TO MAP-PRED-EMP-NO-2. DTSCS1A
|
|
01216 DTSCS1A
|
|
01217 MOVE MERA-RESPONSIBLE-OP-ID TO MAP-RESP-OP-ID. DTSCS1A
|
|
01218 DTSCS1A
|
|
01219 MOVE MERA-NOTE TO MAP-NOTE. DTSCS1A
|
|
01220 DTSCS1A
|
|
01221 MOVE MERA-STATUS-CD TO MAP-STATUS-CD. DTSCS1A
|
|
01222 DTSCS1A
|
|
01223 IF MERA-MAIL-DATE-1 NOT = +0 DTSCS1A
|
|
01224 MOVE MERA-MAIL-DATE-1 TO WRK-DISPLAY DTSCS1A
|
|
01225 MOVE WRK-DISPLAY-MO TO MAP-MAIL-1-MO DTSCS1A
|
|
01226 MOVE WRK-DISPLAY-DA TO MAP-MAIL-1-DA DTSCS1A
|
|
01227 MOVE WRK-DISPLAY-YR TO MAP-MAIL-1-YR. DTSCS1A
|
|
01228 DTSCS1A
|
|
01229 MOVE MERA-LETTER-1-CD TO MAP-LETTER-1-CD. DTSCS1A
|
|
01230 DTSCS1A
|
|
01231 IF MERA-MAIL-DATE-2 NOT = +0 DTSCS1A
|
|
01232 MOVE MERA-MAIL-DATE-2 TO WRK-DISPLAY DTSCS1A
|
|
01233 MOVE WRK-DISPLAY-MO TO MAP-MAIL-2-MO DTSCS1A
|
|
01234 MOVE WRK-DISPLAY-DA TO MAP-MAIL-2-DA DTSCS1A
|
|
01235 MOVE WRK-DISPLAY-YR TO MAP-MAIL-2-YR. DTSCS1A
|
|
01236 DTSCS1A
|
|
01237 IF MERA-RECEIVED-DATE NOT = +0 DTSCS1A
|
|
01238 MOVE MERA-RECEIVED-DATE TO WRK-DISPLAY DTSCS1A
|
|
01239 MOVE WRK-DISPLAY-MO TO MAP-RECEIVED-MO DTSCS1A
|
|
01240 MOVE WRK-DISPLAY-DA TO MAP-RECEIVED-DA DTSCS1A
|
|
01241 MOVE WRK-DISPLAY-YR TO MAP-RECEIVED-YR. DTSCS1A
|
|
01242 DTSCS1A
|
|
01243 IF MERA-COOP-AGENCY-REQ-DATE NOT = +0 DTSCS1A
|
|
01244 MOVE MERA-COOP-AGENCY-REQ-DATE TO WRK-DISPLAY DTSCS1A
|
|
01245 MOVE WRK-DISPLAY-MO TO MAP-COOP-AGENCY-REQ-MO DTSCS1A
|
|
01246 MOVE WRK-DISPLAY-DA TO MAP-COOP-AGENCY-REQ-DA DTSCS1A
|
|
01247 MOVE WRK-DISPLAY-YR TO MAP-COOP-AGENCY-REQ-YR. DTSCS1A
|
|
01248 DTSCS1A
|
|
01249 IF MERA-DETER-NOTSUB-DATE NOT = +0 DTSCS1A
|
|
01250 MOVE MERA-DETER-NOTSUB-DATE TO WRK-DISPLAY DTSCS1A
|
|
01251 MOVE WRK-DISPLAY-MO TO MAP-DETER-NOTSUB-MO DTSCS1A
|
|
01252 MOVE WRK-DISPLAY-DA TO MAP-DETER-NOTSUB-DA DTSCS1A
|
|
01253 MOVE WRK-DISPLAY-YR TO MAP-DETER-NOTSUB-YR. DTSCS1A
|
|
01254 DTSCS1A
|
|
01255 IF MERA-FIELD-ASSIGN-DATE NOT = +0 DTSCS1A
|
|
01256 MOVE MERA-FIELD-ASSIGN-DATE TO WRK-DISPLAY DTSCS1A
|
|
01257 MOVE WRK-DISPLAY-MO TO MAP-FIELD-ASSIGN-MO DTSCS1A
|
|
01258 MOVE WRK-DISPLAY-DA TO MAP-FIELD-ASSIGN-DA DTSCS1A
|
|
01259 MOVE WRK-DISPLAY-YR TO MAP-FIELD-ASSIGN-YR. DTSCS1A
|
|
01260 P6930-EXIT. DTSCS1A
|
|
01261 EXIT. DTSCS1A
|
|
01262 P6940-FROM-MFAE. DTSCS1A
|
|
01263 DTSCS1A
|
|
01264 MOVE LOW-VALUES TO MFAE-KEY-AREA. DTSCS1A
|
|
01265 DTSCS1A
|
|
01266 MOVE WRK-EMP-NO TO MFAE-EMP-NO. DTSCS1A
|
|
01267 DTSCS1A
|
|
01268 SET MFAE-FAE-88 TO TRUE. DTSCS1A
|
|
01269 DTSCS1A
|
|
01270 SET MFAE-SERVICE-CORRESPOND-88 TO TRUE. DTSCS1A
|
|
01271 DTSCS1A
|
|
01272 MOVE MFAE-KEY-AREA TO MSKL-KEY-AREA. DTSCS1A
|
|
01273 DTSCS1A
|
|
01274 PERFORM S810-READ THRU S810-EXIT. DTSCS1A
|
|
01275 DTSCS1A
|
|
01276 IF L810-OK-88 DTSCS1A
|
|
01277 MOVE MSKL-REC TO MFAE-REC DTSCS1A
|
|
01278 MOVE MFAE-FISCAL-AGENT-CD TO MAP-FISC-AGNT-CD DTSCS1A
|
|
01279 SET WRK-MFAE-YES-88 TO TRUE DTSCS1A
|
|
01280 MOVE CATB-ASKIP-BRT-MDTON TO MAP-FISC-AGNT-CD-A DTSCS1A
|
|
01281 MAP-ATTN-LINE-A DTSCS1A
|
|
01282 MAP-FISC-AGNT-CD-A DTSCS1A
|
|
01283 MAP-DELIV-LINE-1-A DTSCS1A
|
|
01284 MAP-DELIV-LINE-2-A DTSCS1A
|
|
01285 MAP-CITY-A DTSCS1A
|
|
01286 MAP-ST-A DTSCS1A
|
|
01287 MAP-ZIP-A DTSCS1A
|
|
01288 ELSE DTSCS1A
|
|
01289 GO TO P6940-EXIT. DTSCS1A
|
|
01290 DTSCS1A
|
|
01291 * MOVE LOW-VALUES TO FFIS-KEY-AREA. DTSCS1A
|
|
01292 * MOVE MFAE-FISCAL-AGENT-CD TO FFIS-FISCAL-AGENT-CD DTSCS1A
|
|
01293 * MAP-FISC-AGNT-CD. DTSCS1A
|
|
01294 * MOVE MFAE-SERVICE-TYPE TO FFIS-SERVICE-TYPE. DTSCS1A
|
|
01295 * SET FFIS-FIS-88 TO TRUE. DTSCS1A
|
|
01296 * MOVE FFIS-KEY-AREA TO FSKL-KEY-AREA. DTSCS1A
|
|
01297 * DTSCS1A
|
|
01298 * PERFORM S831-READ THRU S831-EXIT. DTSCS1A
|
|
01299 * DTSCS1A
|
|
01300 * IF NOT L831-OK-88 DTSCS1A
|
|
01301 * GO TO P6940-EXIT DTSCS1A
|
|
01302 * ELSE DTSCS1A
|
|
01303 * MOVE FSKL-REC TO FFIS-REC DTSCS1A
|
|
01304 * END-IF. DTSCS1A
|
|
01305 * DTSCS1A
|
|
01306 * MOVE FFIS-ATTN-LINE TO MAP-ATTN-LINE. DTSCS1A
|
|
01307 * MOVE FFIS-DELIV-LINE-1 TO MAP-DELIV-LINE-1. DTSCS1A
|
|
01308 * MOVE FFIS-DELIV-LINE-2 TO MAP-DELIV-LINE-2. DTSCS1A
|
|
01309 * MOVE FFIS-CITY TO MAP-CITY. DTSCS1A
|
|
01310 * MOVE FFIS-ST TO MAP-ST. DTSCS1A
|
|
01311 * MOVE FFIS-ZIP TO MAP-ZIP. DTSCS1A
|
|
01312 DTSCS1A
|
|
01313 DTSCS1A
|
|
01314 P6940-EXIT. DTSCS1A
|
|
01315 EXIT. DTSCS1A
|
|
01316 /*****************************************************************DTSCS1A
|
|
01317 * FUNCTION KEY TO ADD, MOD OR DEL THE RECORD WAS PRESSED. *DTSCS1A
|
|
01318 ******************************************************************DTSCS1A
|
|
01319 DTSCS1A
|
|
01320 P7000-REQUEST-EDIT. DTSCS1A
|
|
01321 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS1A
|
|
01322 DTSCS1A
|
|
01323 IF LCCM-F09-88 DTSCS1A
|
|
01324 PERFORM P7100-EDIT-ADD THRU P7100-EXIT DTSCS1A
|
|
01325 ELSE DTSCS1A
|
|
01326 IF LCCM-F10-88 DTSCS1A
|
|
01327 PERFORM P7200-EDIT-MOD THRU P7200-EXIT DTSCS1A
|
|
01328 ELSE DTSCS1A
|
|
01329 IF LCCM-F23-88 DTSCS1A
|
|
01330 PERFORM P7300-EDIT-DEL THRU P7300-EXIT DTSCS1A
|
|
01331 ELSE DTSCS1A
|
|
01332 GO TO S899-ABEND. DTSCS1A
|
|
01333 DTSCS1A
|
|
01334 DTSCS1A
|
|
01335 *------------------------------------------------------ DTSCS1A
|
|
01336 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCS1A
|
|
01337 * IN ORDER TO CONTINUE TO ATTEMPT AN ADD THE SCREEN MUST REMAIN DTSCS1A
|
|
01338 * IN A 'CLEAR' STATE. THE SCREEN MUST BE IN 'INQUIRE' STATUS DTSCS1A
|
|
01339 * IF MOD OR DEL FUNCTIONS ARE BEING REQUESTED. DTSCS1A
|
|
01340 *------------------------------------------------------ DTSCS1A
|
|
01341 DTSCS1A
|
|
01342 IF LCCM-MSG DTSCS1A
|
|
01343 NEXT SENTENCE DTSCS1A
|
|
01344 ELSE DTSCS1A
|
|
01345 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCS1A
|
|
01346 IF LCCM-F09-88 DTSCS1A
|
|
01347 SET LCCM-SCR-ADD-LOCKED TO TRUE DTSCS1A
|
|
01348 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS1A
|
|
01349 ELSE DTSCS1A
|
|
01350 IF LCCM-F10-88 DTSCS1A
|
|
01351 SET LCCM-SCR-MOD-LOCKED TO TRUE DTSCS1A
|
|
01352 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS1A
|
|
01353 ELSE DTSCS1A
|
|
01354 IF LCCM-F23-88 DTSCS1A
|
|
01355 SET LCCM-SCR-DEL-LOCKED TO TRUE DTSCS1A
|
|
01356 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID. DTSCS1A
|
|
01357 DTSCS1A
|
|
01358 SET RESP-SEND-MAP TO TRUE. DTSCS1A
|
|
01359 P7000-EXIT. DTSCS1A
|
|
01360 EXIT. DTSCS1A
|
|
01361 /*****************************************************************DTSCS1A
|
|
01362 * ADD FUNCTION WAS REQUESTED *DTSCS1A
|
|
01363 ******************************************************************DTSCS1A
|
|
01364 DTSCS1A
|
|
01365 P7100-EDIT-ADD. DTSCS1A
|
|
01366 *----------------------------------------------------- DTSCS1A
|
|
01367 * ADD REQUIRES THAT THE SCREEN WAS IN A CLEAR STATE DTSCS1A
|
|
01368 *----------------------------------------------------- DTSCS1A
|
|
01369 IF NOT LCCM-SCR-CLEAR DTSCS1A
|
|
01370 MOVE EMSG-ADD-PRECEDED TO LCCM-MSG-AREA DTSCS1A
|
|
01371 GO TO P7100-EXIT. DTSCS1A
|
|
01372 DTSCS1A
|
|
01373 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS1A
|
|
01374 DTSCS1A
|
|
01375 IF LCCM-NO-MSG DTSCS1A
|
|
01376 IF WRK-EMP-CHG-ONLY-88 DTSCS1A
|
|
01377 MOVE LOW-VALUES TO MPRF-KEY-AREA DTSCS1A
|
|
01378 MOVE WRK-EMP-NO TO MPRF-EMP-NO DTSCS1A
|
|
01379 SET MPRF-PRF-88 TO TRUE DTSCS1A
|
|
01380 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA DTSCS1A
|
|
01381 PERFORM S810-READ THRU S810-EXIT DTSCS1A
|
|
01382 IF L810-OK-88 DTSCS1A
|
|
01383 MOVE EMSG-RECORD-EXISTS TO WRK-MSG-AREA DTSCS1A
|
|
01384 PERFORM S1199-ERROR THRU S1199-EXIT. DTSCS1A
|
|
01385 P7100-EXIT. DTSCS1A
|
|
01386 EXIT. DTSCS1A
|
|
01387 /*****************************************************************DTSCS1A
|
|
01388 * MODIFICATION FUNCTION WAS REQUESTED *DTSCS1A
|
|
01389 ******************************************************************DTSCS1A
|
|
01390 DTSCS1A
|
|
01391 P7200-EDIT-MOD. DTSCS1A
|
|
01392 *----------------------------------------------------- DTSCS1A
|
|
01393 * MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS1A
|
|
01394 * INQUIRED DTSCS1A
|
|
01395 *----------------------------------------------------- DTSCS1A
|
|
01396 IF NOT LCCM-SCR-INQUIRE DTSCS1A
|
|
01397 MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-ID DTSCS1A
|
|
01398 GO TO P7200-EXIT. DTSCS1A
|
|
01399 DTSCS1A
|
|
01400 DTSCS1A
|
|
01401 *----------------------------------------------------- DTSCS1A
|
|
01402 * MAP-EMP-NO MAY NOT BE CHANGED DURING THE MOD DTSCS1A
|
|
01403 *----------------------------------------------------- DTSCS1A
|
|
01404 PERFORM S1001-EDIT-KEY THRU S1001-EXIT. DTSCS1A
|
|
01405 DTSCS1A
|
|
01406 IF LCCM-MSG DTSCS1A
|
|
01407 GO TO P7200-EXIT. DTSCS1A
|
|
01408 DTSCS1A
|
|
01409 DTSCS1A
|
|
01410 PERFORM S1190-READ-MPRF THRU S1190-EXIT. DTSCS1A
|
|
01411 DTSCS1A
|
|
01412 IF LCCM-MSG DTSCS1A
|
|
01413 GO TO P7200-EXIT. DTSCS1A
|
|
01414 DTSCS1A
|
|
01415 IF LCCM-EMP-NO NOT = WRK-EMP-NO DTSCS1A
|
|
01416 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS1A
|
|
01417 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS1A
|
|
01418 GO TO P7200-EXIT. DTSCS1A
|
|
01419 DTSCS1A
|
|
01420 DTSCS1A
|
|
01421 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS1A
|
|
01422 P7200-EXIT. DTSCS1A
|
|
01423 EXIT. DTSCS1A
|
|
01424 /*****************************************************************DTSCS1A
|
|
01425 * DTSCS1A
|
|
01426 ******************************************************************DTSCS1A
|
|
01427 DTSCS1A
|
|
01428 P7300-EDIT-DEL. DTSCS1A
|
|
01429 *----------------------------------------------------- DTSCS1A
|
|
01430 * DELETE REQUIRES THAT A RECORD WAS SUCCESSFULLY INQUIRED. DTSCS1A
|
|
01431 *----------------------------------------------------- DTSCS1A
|
|
01432 IF NOT LCCM-SCR-INQUIRE DTSCS1A
|
|
01433 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT DTSCS1A
|
|
01434 MOVE EMSG-DEL-PRECEDED TO LCCM-MSG-ID DTSCS1A
|
|
01435 GO TO P7300-EXIT. DTSCS1A
|
|
01436 DTSCS1A
|
|
01437 DTSCS1A
|
|
01438 *----------------------------------------------------- DTSCS1A
|
|
01439 * MAP-OP-ID MAY NOT BE CHANGED DURING THE MOD DTSCS1A
|
|
01440 *----------------------------------------------------- DTSCS1A
|
|
01441 PERFORM S1001-EDIT-KEY THRU S1001-EXIT. DTSCS1A
|
|
01442 DTSCS1A
|
|
01443 IF LCCM-MSG DTSCS1A
|
|
01444 GO TO P7300-EXIT. DTSCS1A
|
|
01445 DTSCS1A
|
|
01446 IF LCCM-EMP-NO NOT = WRK-EMP-NO DTSCS1A
|
|
01447 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS1A
|
|
01448 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS1A
|
|
01449 GO TO P7300-EXIT. DTSCS1A
|
|
01450 DTSCS1A
|
|
01451 DTSCS1A
|
|
01452 PERFORM S1190-READ-MPRF THRU S1190-EXIT. DTSCS1A
|
|
01453 DTSCS1A
|
|
01454 IF LCCM-MSG DTSCS1A
|
|
01455 GO TO P7300-EXIT. DTSCS1A
|
|
01456 DTSCS1A
|
|
01457 DTSCS1A
|
|
01458 PERFORM S1200-DELETE-EMP THRU S1200-EXIT. DTSCS1A
|
|
01459 DTSCS1A
|
|
01460 IF LCCM-MSG DTSCS1A
|
|
01461 GO TO P7300-EXIT. DTSCS1A
|
|
01462 DTSCS1A
|
|
01463 DTSCS1A
|
|
01464 IF MAP-DELETE-EMP-YES-88 DTSCS1A
|
|
01465 SET MSKL-PRF-88 TO TRUE DTSCS1A
|
|
01466 ADD +1 TO MSKL-REC-TYPE DTSCS1A
|
|
01467 SET MLEN-IDX TO MSKL-REC-TYPE DTSCS1A
|
|
01468 PERFORM P7310-DELETE-EDIT THRU P7310-EXIT DTSCS1A
|
|
01469 VARYING MLEN-IDX FROM MLEN-IDX BY 1 DTSCS1A
|
|
01470 UNTIL (MLEN-IDX > MLEN-MAX-REC-TYPE) DTSCS1A
|
|
01471 OR DTSCS1A
|
|
01472 (LCCM-MSG) DTSCS1A
|
|
01473 ELSE DTSCS1A
|
|
01474 MOVE LOW-VALUES TO MERA-KEY-AREA DTSCS1A
|
|
01475 MOVE WRK-EMP-NO TO MERA-EMP-NO DTSCS1A
|
|
01476 SET MERA-ERA-88 TO TRUE DTSCS1A
|
|
01477 MOVE MERA-KEY-AREA TO MSKL-KEY-AREA DTSCS1A
|
|
01478 PERFORM S810-READ THRU S810-EXIT DTSCS1A
|
|
01479 IF L810-NO-REC-88 DTSCS1A
|
|
01480 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS1A
|
|
01481 PERFORM S1801-ERROR THRU S1801-EXIT. DTSCS1A
|
|
01482 P7300-EXIT. DTSCS1A
|
|
01483 EXIT. DTSCS1A
|
|
01484 SKIP3 DTSCS1A
|
|
01485 P7310-DELETE-EDIT. DTSCS1A
|
|
01486 IF MLEN-FILE-ID (MLEN-IDX) = +0 DTSCS1A
|
|
01487 GO TO P7310-EXIT. DTSCS1A
|
|
01488 DTSCS1A
|
|
01489 IF MLEN-DEL-MPRF-OK-88 (MLEN-IDX) DTSCS1A
|
|
01490 GO TO P7310-EXIT. DTSCS1A
|
|
01491 DTSCS1A
|
|
01492 DTSCS1A
|
|
01493 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS1A
|
|
01494 DTSCS1A
|
|
01495 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS1A
|
|
01496 DTSCS1A
|
|
01497 SET MSKL-REC-TYPE TO MLEN-IDX. DTSCS1A
|
|
01498 DTSCS1A
|
|
01499 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS1A
|
|
01500 DTSCS1A
|
|
01501 IF L810-NO-REC-88 DTSCS1A
|
|
01502 GO TO P7310-EXIT. DTSCS1A
|
|
01503 DTSCS1A
|
|
01504 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS1A
|
|
01505 DTSCS1A
|
|
01506 MOVE MSG-E1A1-AREA TO WRK-MSG-AREA. DTSCS1A
|
|
01507 DTSCS1A
|
|
01508 PERFORM S1199-ERROR THRU S1199-EXIT. DTSCS1A
|
|
01509 P7310-EXIT. DTSCS1A
|
|
01510 EXIT. DTSCS1A
|
|
01511 /*****************************************************************DTSCS1A
|
|
01512 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED *DTSCS1A
|
|
01513 ******************************************************************DTSCS1A
|
|
01514 DTSCS1A
|
|
01515 P8000-REQUEST-UPDATE. DTSCS1A
|
|
01516 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS1A
|
|
01517 DTSCS1A
|
|
01518 IF LCCM-SCR-ADD-LOCKED DTSCS1A
|
|
01519 PERFORM P8100-ADD THRU P8100-EXIT DTSCS1A
|
|
01520 ELSE DTSCS1A
|
|
01521 IF LCCM-SCR-MOD-LOCKED DTSCS1A
|
|
01522 PERFORM P8200-MOD THRU P8200-EXIT DTSCS1A
|
|
01523 ELSE DTSCS1A
|
|
01524 IF LCCM-SCR-DEL-LOCKED DTSCS1A
|
|
01525 PERFORM P8300-DEL THRU P8300-EXIT DTSCS1A
|
|
01526 ELSE DTSCS1A
|
|
01527 GO TO S899-ABEND. DTSCS1A
|
|
01528 DTSCS1A
|
|
01529 SET RESP-SEND-MAP TO TRUE. DTSCS1A
|
|
01530 P8000-EXIT. DTSCS1A
|
|
01531 EXIT. DTSCS1A
|
|
01532 /*****************************************************************DTSCS1A
|
|
01533 * DTSCS1A
|
|
01534 ******************************************************************DTSCS1A
|
|
01535 P8100-ADD. DTSCS1A
|
|
01536 SET LCCM-SCR-CLEAR TO TRUE. DTSCS1A
|
|
01537 DTSCS1A
|
|
01538 IF LCCM-F12-88 DTSCS1A
|
|
01539 MOVE PMSG-ADD-CANCELED TO LCCM-MSG-ID DTSCS1A
|
|
01540 GO TO P8100-EXIT. DTSCS1A
|
|
01541 DTSCS1A
|
|
01542 PERFORM P8110-GET-KEY THRU P8110-EXIT. DTSCS1A
|
|
01543 DTSCS1A
|
|
01544 PERFORM P8120-INITIALIZE-MPRF THRU P8120-EXIT. DTSCS1A
|
|
01545 DTSCS1A
|
|
01546 MOVE MPRF-REC TO MSKL-REC. DTSCS1A
|
|
01547 DTSCS1A
|
|
01548 PERFORM S810-WRITE THRU S810-EXIT. DTSCS1A
|
|
01549 DTSCS1A
|
|
01550 MOVE 'A' TO L221-UPDATE-FUNCTION. DTSCS1A
|
|
01551 DTSCS1A
|
|
01552 PERFORM P8800-LOCK-EMPLOYER THRU P8800-EXIT. DTSCS1A
|
|
01553 DTSCS1A
|
|
01554 PERFORM P8900-INITIALIZE-L331 THRU P8900-EXIT. DTSCS1A
|
|
01555 DTSCS1A
|
|
01556 PERFORM P8920-MTAD-UPDATE THRU P8920-EXIT. DTSCS1A
|
|
01557 DTSCS1A
|
|
01558 PERFORM P8910-MPRF-UPDATE THRU P8910-EXIT. DTSCS1A
|
|
01559 DTSCS1A
|
|
01560 IF (WRK-EMP-CHG-ONLY-88) DTSCS1A
|
|
01561 OR DTSCS1A
|
|
01562 (MAP-SOURCE-CD-NA-88) DTSCS1A
|
|
01563 NEXT SENTENCE DTSCS1A
|
|
01564 ELSE DTSCS1A
|
|
01565 PERFORM P8930-MERA-UPDATE THRU P8930-EXIT DTSCS1A
|
|
01566 IF WRK-UPD-MERA-YES-88 DTSCS1A
|
|
01567 PERFORM S8000-TICKLE THRU S8000-EXIT. DTSCS1A
|
|
01568 DTSCS1A
|
|
01569 PERFORM P8130-MEVL-WRITE THRU P8130-EXIT. DTSCS1A
|
|
01570 DTSCS1A
|
|
01571 PERFORM P8140-MFAE-WRITE THRU P8140-EXIT. DTSCS1A
|
|
01572 DTSCS1A
|
|
01573 PERFORM P8950-POT-HOUSEHOLD THRU P8950-EXIT. DTSCS1A
|
|
01574 DTSCS1A
|
|
01575 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS1A
|
|
01576 DTSCS1A
|
|
01577 DTSCS1A
|
|
01578 MOVE LOW-VALUES TO MAP-AREA. DTSCS1A
|
|
01579 DTSCS1A
|
|
01580 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS1A
|
|
01581 DTSCS1A
|
|
01582 MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS1A
|
|
01583 DTSCS1A
|
|
01584 MOVE WRK-EMP-NO TO WRK-DISPLAY. DTSCS1A
|
|
01585 DTSCS1A
|
|
01586 MOVE WRK-DISPLAY-EMP-NO-1 TO MSG-EMP-NO-1. DTSCS1A
|
|
01587 DTSCS1A
|
|
01588 MOVE WRK-DISPLAY-EMP-NO-2 TO MSG-EMP-NO-2. DTSCS1A
|
|
01589 DTSCS1A
|
|
01590 MOVE MSG-SUCCESSFUL-ADD-TEXT TO LCCM-MSG-TEXT. DTSCS1A
|
|
01591 DTSCS1A
|
|
01592 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS1A
|
|
01593 P8100-EXIT. DTSCS1A
|
|
01594 EXIT. DTSCS1A
|
|
01595 SKIP3 DTSCS1A
|
|
01596 P8110-GET-KEY. DTSCS1A
|
|
01597 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS1A
|
|
01598 DTSCS1A
|
|
01599 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS1A
|
|
01600 DTSCS1A
|
|
01601 IF L018-NO-ENTRY DTSCS1A
|
|
01602 NEXT SENTENCE DTSCS1A
|
|
01603 ELSE DTSCS1A
|
|
01604 MOVE L018-EMP-NO TO WRK-EMP-NO DTSCS1A
|
|
01605 LCCM-EMP-NO DTSCS1A
|
|
01606 IF ((WRK-EMP-NO >= CENO-FED-START-EMP-NO) DTSCS1A
|
|
01607 AND DTSCS1A
|
|
01608 (WRK-EMP-NO <= CENO-FED-END-EMP-NO)) DTSCS1A
|
|
01609 OR DTSCS1A
|
|
01610 ((WRK-EMP-NO >= CENO-CWC-START-EMP-NO) DTSCS1A
|
|
01611 AND DTSCS1A
|
|
01612 (WRK-EMP-NO <= CENO-CWC-END-EMP-NO)) DTSCS1A
|
|
01613 OR DTSCS1A
|
|
01614 ((WRK-EMP-NO >= CENO-NEW-CHG-ONLY-START-EMP-NO) DTSCS1A
|
|
01615 AND DTSCS1A
|
|
01616 (WRK-EMP-NO <= CENO-NEW-CHG-ONLY-END-EMP-NO)) DTSCS1A
|
|
01617 SET WRK-EMP-CHG-ONLY-88 TO TRUE DTSCS1A
|
|
01618 GO TO P8110-EXIT DTSCS1A
|
|
01619 ELSE DTSCS1A
|
|
01620 GO TO S899-ABEND. DTSCS1A
|
|
01621 DTSCS1A
|
|
01622 MOVE LOW-VALUES TO MHDR-KEY-AREA. DTSCS1A
|
|
01623 DTSCS1A
|
|
01624 MOVE +0 TO MHDR-EMP-NO. DTSCS1A
|
|
01625 DTSCS1A
|
|
01626 SET MHDR-HDR-88 TO TRUE. DTSCS1A
|
|
01627 DTSCS1A
|
|
01628 MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA. DTSCS1A
|
|
01629 DTSCS1A
|
|
01630 PERFORM S810-READ-UPDATE THRU S810-EXIT. DTSCS1A
|
|
01631 DTSCS1A
|
|
01632 IF L810-NO-REC-88 DTSCS1A
|
|
01633 GO TO S899-ABEND. DTSCS1A
|
|
01634 DTSCS1A
|
|
01635 DTSCS1A
|
|
01636 MOVE MSKL-REC TO MHDR-REC. DTSCS1A
|
|
01637 DTSCS1A
|
|
01638 SET WRK-NEXT-EMP-NO-FOUND-NO-88 TO TRUE. DTSCS1A
|
|
01639 DTSCS1A
|
|
01640 PERFORM P8111-FIND-NEXT-EMP-NO THRU P8111-EXIT DTSCS1A
|
|
01641 UNTIL WRK-NEXT-EMP-NO-FOUND-YES-88. DTSCS1A
|
|
01642 DTSCS1A
|
|
01643 MOVE MHDR-LAST-USED-EMP-NO TO LCCM-EMP-NO DTSCS1A
|
|
01644 WRK-EMP-NO. DTSCS1A
|
|
01645 DTSCS1A
|
|
01646 MOVE MHDR-REC TO MSKL-REC. DTSCS1A
|
|
01647 DTSCS1A
|
|
01648 PERFORM S810-REWRITE-UPDATE THRU S810-EXIT. DTSCS1A
|
|
01649 P8110-EXIT. DTSCS1A
|
|
01650 EXIT. DTSCS1A
|
|
01651 SKIP3 DTSCS1A
|
|
01652 P8111-FIND-NEXT-EMP-NO. DTSCS1A
|
|
01653 IF MHDR-LAST-USED-EMP-NO < 999999 DTSCS1A
|
|
01654 CONTINUE DTSCS1A
|
|
01655 ELSE DTSCS1A
|
|
01656 GO TO S899-ABEND. DTSCS1A
|
|
01657 DTSCS1A
|
|
01658 ADD +1 TO MHDR-LAST-USED-EMP-NO. DTSCS1A
|
|
01659 DTSCS1A
|
|
01660 IF (MHDR-LAST-USED-EMP-NO >= CENO-FED-START-EMP-NO) DTSCS1A
|
|
01661 AND DTSCS1A
|
|
01662 (MHDR-LAST-USED-EMP-NO <= CENO-FED-END-EMP-NO) DTSCS1A
|
|
01663 GO TO P8111-EXIT. DTSCS1A
|
|
01664 DTSCS1A
|
|
01665 IF (MHDR-LAST-USED-EMP-NO >= CENO-CWC-START-EMP-NO) DTSCS1A
|
|
01666 AND DTSCS1A
|
|
01667 (MHDR-LAST-USED-EMP-NO <= CENO-CWC-END-EMP-NO) DTSCS1A
|
|
01668 GO TO P8111-EXIT. DTSCS1A
|
|
01669 DTSCS1A
|
|
01670 IF (MHDR-LAST-USED-EMP-NO >= CENO-NEW-CHG-ONLY-START-EMP-NO) DTSCS1A
|
|
01671 AND DTSCS1A
|
|
01672 (MHDR-LAST-USED-EMP-NO <= CENO-NEW-CHG-ONLY-END-EMP-NO) DTSCS1A
|
|
01673 GO TO P8111-EXIT. DTSCS1A
|
|
01674 DTSCS1A
|
|
01675 SET WRK-EMP-NO-UNUSED-NO-88 TO TRUE. DTSCS1A
|
|
01676 DTSCS1A
|
|
01677 PERFORM DTSCS1A
|
|
01678 VARYING CENO-AVAILABLE-IDX FROM 1 BY 1 DTSCS1A
|
|
01679 UNTIL (CENO-AVAILABLE-IDX > CENO-AVAILABLE-RANGE-CNT) DTSCS1A
|
|
01680 OR DTSCS1A
|
|
01681 (WRK-EMP-NO-UNUSED-YES-88) DTSCS1A
|
|
01682 IF (MHDR-LAST-USED-EMP-NO DTSCS1A
|
|
01683 >= CENO-AVAILABLE-START-EMP-NO DTSCS1A
|
|
01684 (CENO-AVAILABLE-IDX)) DTSCS1A
|
|
01685 AND DTSCS1A
|
|
01686 (MHDR-LAST-USED-EMP-NO DTSCS1A
|
|
01687 <= CENO-AVAILABLE-END-EMP-NO DTSCS1A
|
|
01688 (CENO-AVAILABLE-IDX)) DTSCS1A
|
|
01689 SET WRK-EMP-NO-UNUSED-YES-88 TO TRUE DTSCS1A
|
|
01690 END-IF DTSCS1A
|
|
01691 END-PERFORM. DTSCS1A
|
|
01692 DTSCS1A
|
|
01693 IF WRK-EMP-NO-UNUSED-NO-88 DTSCS1A
|
|
01694 GO TO P8111-EXIT. DTSCS1A
|
|
01695 DTSCS1A
|
|
01696 ***** DTSCS1A
|
|
01697 * DTSCS1A
|
|
01698 * BECAUSE THE MHDR RECORD IS IN THE SAME PHYSICAL VSAM DTSCS1A
|
|
01699 * FILE AS THE MPRF RECORDS AND THE MHDR RECORD WAS READ DTSCS1A
|
|
01700 * FOR UPDATE, THE COMMENTED OUT CODE CAUSES CICS TO ABEND DTSCS1A
|
|
01701 * WITH A POTENTIAL DEADLOCK ABEND. DTSCS1A
|
|
01702 * DTSCS1A
|
|
01703 * IF A PROPER JOB IS DONE POPULATING CENO-ALREADY-USED-RANGE DTSCS1A
|
|
01704 * -AREA IS DONE, THE COMMENTED OUT CODE WAS OVERKILL ANYWAY. DTSCS1A
|
|
01705 * DTSCS1A
|
|
01706 * IF IT TURNS OUT THE COMMENTED OUT CODE IS NEEDED, THEN IT DTSCS1A
|
|
01707 * WILL BE NECESSARY TO REVISE THE FUNCTION OF P8110 AND DTSCS1A
|
|
01708 * P8111 TO AVOID THE POTENTIAL DEADLOCK. ACTUALLY, AFTER DTSCS1A
|
|
01709 * A FEW RECORDS ARE IN MSTA AND THE MHDR RECORD IS IN A DTSCS1A
|
|
01710 * DIFFERENT CI THAN THE MPRF WE ARE ATTEMPTING TO READ, DTSCS1A
|
|
01711 * THE DEADLOCK MAY DISAPPEAR. DTSCS1A
|
|
01712 * DTSCS1A
|
|
01713 ***** DTSCS1A
|
|
01714 DTSCS1A
|
|
01715 *****MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS1A
|
|
01716 DTSCS1A
|
|
01717 *****MOVE MHDR-LAST-USED-EMP-NO TO MSKL-EMP-NO. DTSCS1A
|
|
01718 DTSCS1A
|
|
01719 *****SET MSKL-PRF-88 TO TRUE. DTSCS1A
|
|
01720 DTSCS1A
|
|
01721 *****PERFORM S810-READ THRU S810-EXIT. DTSCS1A
|
|
01722 DTSCS1A
|
|
01723 *****IF L810-NO-REC-88 DTSCS1A
|
|
01724 SET WRK-NEXT-EMP-NO-FOUND-YES-88 TO TRUE. DTSCS1A
|
|
01725 P8111-EXIT. DTSCS1A
|
|
01726 EXIT. DTSCS1A
|
|
01727 SKIP3 DTSCS1A
|
|
01728 P8120-INITIALIZE-MPRF. DTSCS1A
|
|
01729 MOVE LOW-VALUES TO MPRF-REC. DTSCS1A
|
|
01730 DTSCS1A
|
|
01731 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS1A
|
|
01732 DTSCS1A
|
|
01733 SET MPRF-PRF-88 TO TRUE. DTSCS1A
|
|
01734 DTSCS1A
|
|
01735 MOVE +0 TO MPRF-PURGE-DATE. DTSCS1A
|
|
01736 DTSCS1A
|
|
01737 IF WRK-EMP-CHG-ONLY-88 DTSCS1A
|
|
01738 SET MPRF-CLASS-CHG-ONLY-88 TO TRUE DTSCS1A
|
|
01739 ELSE DTSCS1A
|
|
01740 SET MPRF-CLASS-UNK-88 TO TRUE. DTSCS1A
|
|
01741 DTSCS1A
|
|
01742 IF MPRF-CLASS-CHG-ONLY-88 DTSCS1A
|
|
01743 SET MPRF-STATUS-NEVERSUB-88 TO TRUE DTSCS1A
|
|
01744 ELSE DTSCS1A
|
|
01745 SET MPRF-STATUS-UNK-88 TO TRUE. DTSCS1A
|
|
01746 DTSCS1A
|
|
01747 IF MPRF-CLASS-CHG-ONLY-88 DTSCS1A
|
|
01748 MOVE MAP-ELIGIBLE-CD TO L031-CD-3 DTSCS1A
|
|
01749 SET L031-MPRF-ELIGIBLE-CD TO TRUE DTSCS1A
|
|
01750 PERFORM S031-REG-CODES THRU S031-EXIT DTSCS1A
|
|
01751 IF L031-VALID DTSCS1A
|
|
01752 MOVE MAP-ELIGIBLE-CD-9 TO MPRF-ELIGIBLE-CD DTSCS1A
|
|
01753 ELSE DTSCS1A
|
|
01754 GO TO S899-ABEND DTSCS1A
|
|
01755 ELSE DTSCS1A
|
|
01756 SET MPRF-ELIGIBLE-NOT-SUBJECT-88 TO TRUE. DTSCS1A
|
|
01757 DTSCS1A
|
|
01758 MOVE SPACES TO MPRF-PRIMARY-NAME. DTSCS1A
|
|
01759 DTSCS1A
|
|
01760 SET MPRF-PRIMARY-IS-NOT-ENTITY-88 TO TRUE. DTSCS1A
|
|
01761 DTSCS1A
|
|
01762 MOVE SPACES TO MPRF-ENTITY-NAME. DTSCS1A
|
|
01763 DTSCS1A
|
|
01764 SET MPRF-UC30-MASS-MAIL-YES-88 TO TRUE. DTSCS1A
|
|
01765 DTSCS1A
|
|
01766 SET MPRF-UC30-CREDIT-YES-88 TO TRUE. DTSCS1A
|
|
01767 DTSCS1A
|
|
01768 SET MPRF-FEIN-HARASS-YES-88 TO TRUE. DTSCS1A
|
|
01769 DTSCS1A
|
|
01770 SET MPRF-CHRG-STMT-PRINT-YES-88 TO TRUE. DTSCS1A
|
|
01771 DTSCS1A
|
|
01772 SET MPRF-DC-CONTRACTOR-NO-88 TO TRUE. DTSCS1A
|
|
01773 DTSCS1A
|
|
01774 SET MPRF-ORG-UNK-88 TO TRUE. DTSCS1A
|
|
01775 DTSCS1A
|
|
01776 SET MPRF-FISC-AG-NONE-88 TO TRUE. DTSCS1A
|
|
01777 DTSCS1A
|
|
01778 MOVE +0 TO MPRF-FEIN. DTSCS1A
|
|
01779 DTSCS1A
|
|
01780 MOVE +0 TO MPRF-DC-BUSINESS-TAX-ACCT-NO. DTSCS1A
|
|
01781 DTSCS1A
|
|
01782 SET MPRF-SUSPEND-COLL-NO-88 TO TRUE. DTSCS1A
|
|
01783 DTSCS1A
|
|
01784 SET MPRF-NOT-WRITTEN-OFF-88 TO TRUE. DTSCS1A
|
|
01785 DTSCS1A
|
|
01786 SET MPRF-PURGE-ALL-NO-88 TO TRUE. DTSCS1A
|
|
01787 DTSCS1A
|
|
01788 SET MPRF-SIC-CD-NONCLASSIF-88 TO TRUE. DTSCS1A
|
|
01789 DTSCS1A
|
|
01790 MOVE SPACES TO MPRF-OLD-SIC-CD. DTSCS1A
|
|
01791 DTSCS1A
|
|
01792 MOVE +0 TO MPRF-SIC-CHNG-DATE. DTSCS1A
|
|
01793 DTSCS1A
|
|
01794 SET MPRF-SIC-AUX-UNK-88 TO TRUE. DTSCS1A
|
|
01795 DTSCS1A
|
|
01796 SET MPRF-NAICS-CD-NONCLASSIF-88 TO TRUE. DTSCS1A
|
|
01797 DTSCS1A
|
|
01798 MOVE SPACES TO MPRF-OLD-NAICS-CD. DTSCS1A
|
|
01799 DTSCS1A
|
|
01800 MOVE +0 TO MPRF-NAICS-CHNG-DATE. DTSCS1A
|
|
01801 DTSCS1A
|
|
01802 SET MPRF-NAICS-AUX-UNK-88 TO TRUE. DTSCS1A
|
|
01803 DTSCS1A
|
|
01804 SET MPRF-OWN-CD-NONCLASSIF-88 TO TRUE. DTSCS1A
|
|
01805 DTSCS1A
|
|
01806 MOVE SPACES TO MPRF-OLD-OWN-CD. DTSCS1A
|
|
01807 DTSCS1A
|
|
01808 MOVE +0 TO MPRF-OWN-CHNG-DATE. DTSCS1A
|
|
01809 DTSCS1A
|
|
01810 SET MPRF-SINGLE-UNIT-88 TO TRUE. DTSCS1A
|
|
01811 DTSCS1A
|
|
01812 SET MPRF-WARD-UNKNOWN-88 TO TRUE. DTSCS1A
|
|
01813 DTSCS1A
|
|
01814 SET MPRF-RETURN-MAIL-NO-88 TO TRUE. DTSCS1A
|
|
01815 DTSCS1A
|
|
01816 MOVE +0 TO MPRF-PWR-OF-ATTORNEY-DT. DTSCS1A
|
|
01817 DTSCS1A
|
|
01818 MOVE +0 TO MPRF-PURSUED-RPT-CNT. DTSCS1A
|
|
01819 DTSCS1A
|
|
01820 MOVE +0 TO MPRF-TOT-BALANCE-AMT. DTSCS1A
|
|
01821 DTSCS1A
|
|
01822 MOVE +0 TO MPRF-TOT-CREDIT-AMT. DTSCS1A
|
|
01823 DTSCS1A
|
|
01824 SET MPRF-BANKRP-NOT-OPEN-88 TO TRUE. DTSCS1A
|
|
01825 DTSCS1A
|
|
01826 MOVE +0 TO MPRF-ARCHIVED-AUDIT-YRQ. DTSCS1A
|
|
01827 DTSCS1A
|
|
01828 MOVE LCCM-PICKUP-YRQ TO MPRF-LAST-ARCHIVED-YRQ. DTSCS1A
|
|
01829 DTSCS1A
|
|
01830 SET MPRF-TAX-REC-ADDR-NO-88 TO TRUE. DTSCS1A
|
|
01831 DTSCS1A
|
|
01832 SET MPRF-BEN-MAIL-ADDR-NO-88 TO TRUE. DTSCS1A
|
|
01833 DTSCS1A
|
|
01834 MOVE SPACES TO MPRF-FLD-ZIP-ST. DTSCS1A
|
|
01835 DTSCS1A
|
|
01836 SET MPRF-NO-MAPL-88 TO TRUE. DTSCS1A
|
|
01837 DTSCS1A
|
|
01838 SET MPRF-NO-MLIN-88 TO TRUE. DTSCS1A
|
|
01839 DTSCS1A
|
|
01840 SET MPRF-NO-MDPC-88 TO TRUE. DTSCS1A
|
|
01841 DTSCS1A
|
|
01842 SET MPRF-NO-MFAS-88 TO TRUE. DTSCS1A
|
|
01843 DTSCS1A
|
|
01844 SET MPRF-UPDATED-NEVER-88 TO TRUE. DTSCS1A
|
|
01845 DTSCS1A
|
|
01846 MOVE +0 TO MPRF-UPDATE-TASK-ID. DTSCS1A
|
|
01847 DTSCS1A
|
|
01848 MOVE SPACES TO MPRF-UPDATE-OP-ID. DTSCS1A
|
|
01849 DTSCS1A
|
|
01850 MOVE SPACES TO MPRF-UPDATE-TERMID. DTSCS1A
|
|
01851 DTSCS1A
|
|
01852 MOVE SPACES TO MPRF-UPDATE-NETNAME. DTSCS1A
|
|
01853 DTSCS1A
|
|
01854 MOVE +0 TO MPRF-UPDATE-START-DATE. DTSCS1A
|
|
01855 DTSCS1A
|
|
01856 MOVE +0 TO MPRF-UPDATE-START-TIME. DTSCS1A
|
|
01857 DTSCS1A
|
|
01858 MOVE SPACES TO MPRF-UPDATE-SCR-ID. DTSCS1A
|
|
01859 DTSCS1A
|
|
01860 MOVE SPACES TO MPRF-UPDATE-FUNCTION. DTSCS1A
|
|
01861 DTSCS1A
|
|
01862 SET MPRF-NOT-CONVERTED-88 TO TRUE. DTSCS1A
|
|
01863 DTSCS1A
|
|
01864 MOVE LCCM-CURR-RUN-DATE TO MPRF-ESTB-DATE DTSCS1A
|
|
01865 MPRF-CHNG-DATE. DTSCS1A
|
|
01866 P8120-EXIT. DTSCS1A
|
|
01867 EXIT. DTSCS1A
|
|
01868 SKIP3 DTSCS1A
|
|
01869 P8130-MEVL-WRITE. DTSCS1A
|
|
01870 MOVE LOW-VALUES TO MEVL-REC. DTSCS1A
|
|
01871 DTSCS1A
|
|
01872 MOVE WRK-EMP-NO TO MEVL-EMP-NO. DTSCS1A
|
|
01873 DTSCS1A
|
|
01874 SET MEVL-EVL-88 TO TRUE. DTSCS1A
|
|
01875 DTSCS1A
|
|
01876 MOVE LCCM-TASK-START-DATE TO MEVL-DATE. DTSCS1A
|
|
01877 DTSCS1A
|
|
01878 MOVE LCCM-TASK-START-TIME TO MEVL-TIME. DTSCS1A
|
|
01879 DTSCS1A
|
|
01880 MOVE +0 TO MEVL-PURGE-DATE. DTSCS1A
|
|
01881 DTSCS1A
|
|
01882 MOVE 'INITIAL REGISTRATION' TO MEVL-TEXT. DTSCS1A
|
|
01883 DTSCS1A
|
|
01884 MOVE LCCM-OP-ID TO MEVL-SOURCE. DTSCS1A
|
|
01885 DTSCS1A
|
|
01886 SET MEVL-NOT-CONVERTED-88 TO TRUE. DTSCS1A
|
|
01887 DTSCS1A
|
|
01888 MOVE LCCM-CURR-RUN-DATE TO MEVL-ESTB-DATE DTSCS1A
|
|
01889 MEVL-CHNG-DATE. DTSCS1A
|
|
01890 DTSCS1A
|
|
01891 MOVE MEVL-REC TO MSKL-REC. DTSCS1A
|
|
01892 DTSCS1A
|
|
01893 PERFORM S810-WRITE THRU S810-EXIT. DTSCS1A
|
|
01894 P8130-EXIT. DTSCS1A
|
|
01895 EXIT. DTSCS1A
|
|
01896 DTSCS1A
|
|
01897 P8140-MFAE-WRITE. DTSCS1A
|
|
01898 DTSCS1A
|
|
01899 IF MAP-FISC-AGNT-CD = LOW-VALUES OR DTSCS1A
|
|
01900 MAP-FISC-AGNT-CD = SPACES DTSCS1A
|
|
01901 GO TO P8140-EXIT DTSCS1A
|
|
01902 END-IF. DTSCS1A
|
|
01903 DTSCS1A
|
|
01904 MOVE LOW-VALUES TO MFAE-REC. DTSCS1A
|
|
01905 DTSCS1A
|
|
01906 MOVE WRK-EMP-NO TO MFAE-EMP-NO. DTSCS1A
|
|
01907 DTSCS1A
|
|
01908 SET MFAE-FAE-88 TO TRUE. DTSCS1A
|
|
01909 DTSCS1A
|
|
01910 SET MFAE-SERVICE-CORRESPOND-88 TO TRUE. DTSCS1A
|
|
01911 DTSCS1A
|
|
01912 IF MAP-FISC-AGNT-CD NOT = MFAE-FISCAL-AGENT-CD DTSCS1A
|
|
01913 MOVE 'FISCAL AGENT ' TO L331-REC-OCC-ID. DTSCS1A
|
|
01914 MOVE 'FISC-AGNT-CD ' TO L331-FIELD-NAME DTSCS1A
|
|
01915 MOVE MFAE-FISCAL-AGENT-CD TO L331-FROM-VALUE DTSCS1A
|
|
01916 MOVE MAP-FISC-AGNT-CD TO L331-TO-VALUE DTSCS1A
|
|
01917 PERFORM S331-WRITE-MLOG THRU S331-EXIT. DTSCS1A
|
|
01918 DTSCS1A
|
|
01919 MOVE MAP-FISC-AGNT-CD TO MFAE-FISCAL-AGENT-CD. DTSCS1A
|
|
01920 DTSCS1A
|
|
01921 MOVE ZEROS TO MFAE-PURGE-DATE. DTSCS1A
|
|
01922 DTSCS1A
|
|
01923 SET MFAE-NOT-CONVERTED-88 TO TRUE. DTSCS1A
|
|
01924 DTSCS1A
|
|
01925 MOVE LCCM-CURR-RUN-DATE TO MFAE-ESTB-DATE DTSCS1A
|
|
01926 MFAE-CHNG-DATE. DTSCS1A
|
|
01927 DTSCS1A
|
|
01928 MOVE MFAE-REC TO MSKL-REC. DTSCS1A
|
|
01929 DTSCS1A
|
|
01930 PERFORM S810-WRITE THRU S810-EXIT. DTSCS1A
|
|
01931 DTSCS1A
|
|
01932 P8140-EXIT. DTSCS1A
|
|
01933 EXIT. DTSCS1A
|
|
01934 /*****************************************************************DTSCS1A
|
|
01935 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS1A
|
|
01936 ******************************************************************DTSCS1A
|
|
01937 DTSCS1A
|
|
01938 P8200-MOD. DTSCS1A
|
|
01939 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS1A
|
|
01940 DTSCS1A
|
|
01941 IF LCCM-F12-88 DTSCS1A
|
|
01942 MOVE PMSG-MOD-CANCELED TO LCCM-MSG-ID DTSCS1A
|
|
01943 GO TO P8200-EXIT. DTSCS1A
|
|
01944 DTSCS1A
|
|
01945 PERFORM S1001-EDIT-KEY THRU S1001-EXIT. DTSCS1A
|
|
01946 DTSCS1A
|
|
01947 MOVE 'M' TO L221-UPDATE-FUNCTION. DTSCS1A
|
|
01948 DTSCS1A
|
|
01949 PERFORM P8800-LOCK-EMPLOYER THRU P8800-EXIT. DTSCS1A
|
|
01950 DTSCS1A
|
|
01951 IF LCCM-MSG DTSCS1A
|
|
01952 GO TO P8200-EXIT. DTSCS1A
|
|
01953 DTSCS1A
|
|
01954 PERFORM P8900-INITIALIZE-L331 THRU P8900-EXIT. DTSCS1A
|
|
01955 DTSCS1A
|
|
01956 PERFORM P8920-MTAD-UPDATE THRU P8920-EXIT. DTSCS1A
|
|
01957 DTSCS1A
|
|
01958 PERFORM P8910-MPRF-UPDATE THRU P8910-EXIT. DTSCS1A
|
|
01959 DTSCS1A
|
|
01960 IF MPRF-CLASS-CHG-ONLY-88 DTSCS1A
|
|
01961 NEXT SENTENCE DTSCS1A
|
|
01962 ELSE DTSCS1A
|
|
01963 PERFORM P8930-MERA-UPDATE THRU P8930-EXIT DTSCS1A
|
|
01964 IF WRK-UPD-MERA-YES-88 DTSCS1A
|
|
01965 PERFORM S8000-TICKLE THRU S8000-EXIT. DTSCS1A
|
|
01966 DTSCS1A
|
|
01967 PERFORM P8950-POT-HOUSEHOLD THRU P8950-EXIT. DTSCS1A
|
|
01968 DTSCS1A
|
|
01969 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS1A
|
|
01970 DTSCS1A
|
|
01971 MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS1A
|
|
01972 DTSCS1A
|
|
01973 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS1A
|
|
01974 DTSCS1A
|
|
01975 MOVE LOW-VALUES TO MAP-CASS-IND DTSCS1A
|
|
01976 MAP-CASS-CD. DTSCS1A
|
|
01977 DTSCS1A
|
|
01978 IF MAP-FISC-AGNT-CD > SPACES DTSCS1A
|
|
01979 MOVE CATB-ASKIP-BRT-MDTON TO MAP-ATTN-LINE-A DTSCS1A
|
|
01980 MAP-FISC-AGNT-CD-A DTSCS1A
|
|
01981 MAP-DELIV-LINE-1-A DTSCS1A
|
|
01982 MAP-DELIV-LINE-2-A DTSCS1A
|
|
01983 MAP-CITY-A DTSCS1A
|
|
01984 MAP-ST-A DTSCS1A
|
|
01985 MAP-ZIP-A. DTSCS1A
|
|
01986 P8200-EXIT. DTSCS1A
|
|
01987 EXIT. DTSCS1A
|
|
01988 /*****************************************************************DTSCS1A
|
|
01989 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS1A
|
|
01990 ******************************************************************DTSCS1A
|
|
01991 DTSCS1A
|
|
01992 P8300-DEL. DTSCS1A
|
|
01993 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS1A
|
|
01994 DTSCS1A
|
|
01995 IF LCCM-F12-88 DTSCS1A
|
|
01996 MOVE PMSG-DEL-CANCELED TO LCCM-MSG-ID DTSCS1A
|
|
01997 GO TO P8300-EXIT. DTSCS1A
|
|
01998 DTSCS1A
|
|
01999 PERFORM S1001-EDIT-KEY THRU S1001-EXIT. DTSCS1A
|
|
02000 DTSCS1A
|
|
02001 MOVE 'D' TO L221-UPDATE-FUNCTION. DTSCS1A
|
|
02002 DTSCS1A
|
|
02003 PERFORM P8800-LOCK-EMPLOYER THRU P8800-EXIT. DTSCS1A
|
|
02004 DTSCS1A
|
|
02005 IF LCCM-MSG DTSCS1A
|
|
02006 GO TO P8300-EXIT. DTSCS1A
|
|
02007 DTSCS1A
|
|
02008 DTSCS1A
|
|
02009 IF MAP-DELETE-EMP-YES-88 DTSCS1A
|
|
02010 PERFORM P8310-DELETE-ALL THRU P8310-EXIT DTSCS1A
|
|
02011 ELSE DTSCS1A
|
|
02012 PERFORM P8320-DELETE-MERA THRU P8320-EXIT. DTSCS1A
|
|
02013 DTSCS1A
|
|
02014 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS1A
|
|
02015 DTSCS1A
|
|
02016 MOVE PMSG-DEL-SUCCESSFUL TO LCCM-MSG-ID. DTSCS1A
|
|
02017 DTSCS1A
|
|
02018 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS1A
|
|
02019 P8300-EXIT. DTSCS1A
|
|
02020 EXIT. DTSCS1A
|
|
02021 SKIP3 DTSCS1A
|
|
02022 P8310-DELETE-ALL. DTSCS1A
|
|
02023 SET MSKL-PRF-88 TO TRUE. DTSCS1A
|
|
02024 DTSCS1A
|
|
02025 ADD +1 TO MSKL-REC-TYPE. DTSCS1A
|
|
02026 DTSCS1A
|
|
02027 SET MLEN-IDX TO MSKL-REC-TYPE. DTSCS1A
|
|
02028 DTSCS1A
|
|
02029 PERFORM P8311-DELETE-REC-TYPE THRU P8311-EXIT DTSCS1A
|
|
02030 VARYING MLEN-IDX FROM MLEN-IDX BY 1 DTSCS1A
|
|
02031 UNTIL MLEN-IDX > MLEN-MAX-REC-TYPE. DTSCS1A
|
|
02032 DTSCS1A
|
|
02033 DTSCS1A
|
|
02034 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS1A
|
|
02035 DTSCS1A
|
|
02036 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS1A
|
|
02037 DTSCS1A
|
|
02038 SET MPRF-PRF-88 TO TRUE. DTSCS1A
|
|
02039 DTSCS1A
|
|
02040 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS1A
|
|
02041 DTSCS1A
|
|
02042 PERFORM S810-DELETE THRU S810-EXIT. DTSCS1A
|
|
02043 DTSCS1A
|
|
02044 DTSCS1A
|
|
02045 MOVE LOW-VALUES TO MAP-AREA. DTSCS1A
|
|
02046 DTSCS1A
|
|
02047 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS1A
|
|
02048 DTSCS1A
|
|
02049 MOVE WRK-EMP-NO TO WRK-DISPLAY. DTSCS1A
|
|
02050 DTSCS1A
|
|
02051 MOVE WRK-DISPLAY-EMP-NO-1 TO MAP-EMP-NO-1. DTSCS1A
|
|
02052 DTSCS1A
|
|
02053 MOVE WRK-DISPLAY-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS1A
|
|
02054 P8310-EXIT. DTSCS1A
|
|
02055 EXIT. DTSCS1A
|
|
02056 SKIP3 DTSCS1A
|
|
02057 P8311-DELETE-REC-TYPE. DTSCS1A
|
|
02058 IF MLEN-FILE-ID (MLEN-IDX) = +0 DTSCS1A
|
|
02059 GO TO P8311-EXIT. DTSCS1A
|
|
02060 DTSCS1A
|
|
02061 DTSCS1A
|
|
02062 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS1A
|
|
02063 DTSCS1A
|
|
02064 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS1A
|
|
02065 DTSCS1A
|
|
02066 SET MSKL-REC-TYPE TO MLEN-IDX. DTSCS1A
|
|
02067 DTSCS1A
|
|
02068 SET L810-OK-88 TO TRUE. DTSCS1A
|
|
02069 DTSCS1A
|
|
02070 PERFORM P8312-DELETE-LOOP THRU P8312-EXIT DTSCS1A
|
|
02071 UNTIL L810-NO-REC-88. DTSCS1A
|
|
02072 P8311-EXIT. DTSCS1A
|
|
02073 EXIT. DTSCS1A
|
|
02074 SKIP3 DTSCS1A
|
|
02075 P8312-DELETE-LOOP. DTSCS1A
|
|
02076 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS1A
|
|
02077 DTSCS1A
|
|
02078 IF L810-NO-REC-88 DTSCS1A
|
|
02079 GO TO P8312-EXIT. DTSCS1A
|
|
02080 DTSCS1A
|
|
02081 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS1A
|
|
02082 DTSCS1A
|
|
02083 PERFORM S810-DELETE THRU S810-EXIT. DTSCS1A
|
|
02084 P8312-EXIT. DTSCS1A
|
|
02085 EXIT. DTSCS1A
|
|
02086 SKIP3 DTSCS1A
|
|
02087 P8320-DELETE-MERA. DTSCS1A
|
|
02088 MOVE LOW-VALUES TO MERA-KEY-AREA. DTSCS1A
|
|
02089 DTSCS1A
|
|
02090 MOVE WRK-EMP-NO TO MERA-EMP-NO. DTSCS1A
|
|
02091 DTSCS1A
|
|
02092 SET MERA-ERA-88 TO TRUE. DTSCS1A
|
|
02093 DTSCS1A
|
|
02094 MOVE MERA-KEY-AREA TO MSKL-KEY-AREA. DTSCS1A
|
|
02095 DTSCS1A
|
|
02096 PERFORM S810-READ THRU S810-EXIT. DTSCS1A
|
|
02097 DTSCS1A
|
|
02098 IF L810-OK-88 DTSCS1A
|
|
02099 PERFORM S810-DELETE THRU S810-EXIT. DTSCS1A
|
|
02100 DTSCS1A
|
|
02101 DTSCS1A
|
|
02102 MOVE LOW-VALUES TO MAP-SOURCE-CD-AREA DTSCS1A
|
|
02103 MAP-CLAIMANT-SSN-AREA DTSCS1A
|
|
02104 MAP-CLAIMANT-NAME-AREA DTSCS1A
|
|
02105 MAP-PRED-EMP-NO-AREA DTSCS1A
|
|
02106 MAP-RESP-OP-ID-AREA DTSCS1A
|
|
02107 MAP-NOTE-AREA DTSCS1A
|
|
02108 MAP-STATUS-CD-AREA DTSCS1A
|
|
02109 MAP-MAIL-DATE-1-AREA DTSCS1A
|
|
02110 MAP-LETTER-1-CD-AREA DTSCS1A
|
|
02111 MAP-MAIL-DATE-2-AREA DTSCS1A
|
|
02112 MAP-RECEIVED-DATE-AREA DTSCS1A
|
|
02113 MAP-COOP-AGENCY-REQ-DATE-AREA DTSCS1A
|
|
02114 MAP-DETER-NOTSUB-DATE-AREA DTSCS1A
|
|
02115 MAP-FIELD-ASSIGN-DATE-AREA. DTSCS1A
|
|
02116 DTSCS1A
|
|
02117 MOVE LOW-VALUES TO MAP-CASS-IND-AREA DTSCS1A
|
|
02118 MAP-CASS-CD-AREA. DTSCS1A
|
|
02119 DTSCS1A
|
|
02120 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS1A
|
|
02121 P8320-EXIT. DTSCS1A
|
|
02122 EXIT. DTSCS1A
|
|
02123 EJECT DTSCS1A
|
|
02124 P8800-LOCK-EMPLOYER. DTSCS1A
|
|
02125 MOVE WRK-EMP-NO TO L221-EMP-NO. DTSCS1A
|
|
02126 DTSCS1A
|
|
02127 MOVE LCCM-SCR-ABSTIME TO L221-SCR-ABSTIME. DTSCS1A
|
|
02128 DTSCS1A
|
|
02129 MOVE LCCM-TASK-ID TO L221-UPDATE-TASK-ID. DTSCS1A
|
|
02130 DTSCS1A
|
|
02131 MOVE LCCM-OP-ID TO L221-UPDATE-OP-ID. DTSCS1A
|
|
02132 DTSCS1A
|
|
02133 MOVE LCCM-CICS-TERM-ID TO L221-UPDATE-TERMID. DTSCS1A
|
|
02134 DTSCS1A
|
|
02135 MOVE LCCM-TASK-NETNAME TO L221-UPDATE-NETNAME. DTSCS1A
|
|
02136 DTSCS1A
|
|
02137 MOVE LCCM-TASK-START-DATE TO L221-UPDATE-START-DATE. DTSCS1A
|
|
02138 DTSCS1A
|
|
02139 MOVE LCCM-TASK-START-TIME TO L221-UPDATE-START-TIME. DTSCS1A
|
|
02140 DTSCS1A
|
|
02141 MOVE WRK-SCR-ID TO L221-UPDATE-SCR-ID. DTSCS1A
|
|
02142 DTSCS1A
|
|
02143 PERFORM S221-EMP-LOCK THRU S221-EXIT. DTSCS1A
|
|
02144 P8800-EXIT. DTSCS1A
|
|
02145 EXIT. DTSCS1A
|
|
02146 EJECT DTSCS1A
|
|
02147 P8900-INITIALIZE-L331. DTSCS1A
|
|
02148 MOVE WRK-EMP-NO TO L331-EMP-NO. DTSCS1A
|
|
02149 DTSCS1A
|
|
02150 MOVE LCCM-CURR-RUN-DATE TO L331-CURR-RUN-DATE. DTSCS1A
|
|
02151 DTSCS1A
|
|
02152 MOVE LCCM-TASK-START-ABSTIME TO L331-UPDATE-ABSTIME. DTSCS1A
|
|
02153 DTSCS1A
|
|
02154 MOVE LCCM-OP-ID TO L331-OP-ID. DTSCS1A
|
|
02155 P8900-EXIT. DTSCS1A
|
|
02156 EXIT. DTSCS1A
|
|
02157 EJECT DTSCS1A
|
|
02158 P8910-MPRF-UPDATE. DTSCS1A
|
|
02159 PERFORM S1190-READ-MPRF THRU S1190-EXIT. DTSCS1A
|
|
02160 DTSCS1A
|
|
02161 IF LCCM-MSG DTSCS1A
|
|
02162 GO TO S899-ABEND. DTSCS1A
|
|
02163 DTSCS1A
|
|
02164 DTSCS1A
|
|
02165 MOVE SPACES TO L331-REC-OCC-ID. DTSCS1A
|
|
02166 DTSCS1A
|
|
02167 DTSCS1A
|
|
02168 IF MAP-PRIMARY-NAME = MPRF-PRIMARY-NAME DTSCS1A
|
|
02169 NEXT SENTENCE DTSCS1A
|
|
02170 ELSE DTSCS1A
|
|
02171 MOVE 'MPRF-PRIMARY-NAME' TO L331-FIELD-NAME DTSCS1A
|
|
02172 MOVE MPRF-PRIMARY-NAME TO L331-FROM-VALUE DTSCS1A
|
|
02173 MOVE MAP-PRIMARY-NAME TO L331-TO-VALUE DTSCS1A
|
|
02174 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSCS1A
|
|
02175 MOVE MAP-PRIMARY-NAME TO MPRF-PRIMARY-NAME DTSCS1A
|
|
02176 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSCS1A
|
|
02177 DTSCS1A
|
|
02178 DTSCS1A
|
|
02179 IF MAP-ENTITY-NAME-IND = MPRF-ENTITY-NAME-IND DTSCS1A
|
|
02180 NEXT SENTENCE DTSCS1A
|
|
02181 ELSE DTSCS1A
|
|
02182 MOVE 'MPRF-ENTITY-NAME-IND' TO L331-FIELD-NAME DTSCS1A
|
|
02183 MOVE MPRF-ENTITY-NAME-IND TO L331-FROM-VALUE DTSCS1A
|
|
02184 MOVE MAP-ENTITY-NAME-IND TO L331-TO-VALUE DTSCS1A
|
|
02185 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSCS1A
|
|
02186 MOVE MAP-ENTITY-NAME-IND TO MPRF-ENTITY-NAME-IND DTSCS1A
|
|
02187 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSCS1A
|
|
02188 DTSCS1A
|
|
02189 DTSCS1A
|
|
02190 IF MAP-ENTITY-NAME = MPRF-ENTITY-NAME DTSCS1A
|
|
02191 NEXT SENTENCE DTSCS1A
|
|
02192 ELSE DTSCS1A
|
|
02193 MOVE 'MPRF-ENTITY-NAME' TO L331-FIELD-NAME DTSCS1A
|
|
02194 MOVE MPRF-ENTITY-NAME TO L331-FROM-VALUE DTSCS1A
|
|
02195 MOVE MAP-ENTITY-NAME TO L331-TO-VALUE DTSCS1A
|
|
02196 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSCS1A
|
|
02197 MOVE MAP-ENTITY-NAME TO MPRF-ENTITY-NAME DTSCS1A
|
|
02198 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSCS1A
|
|
02199 DTSCS1A
|
|
02200 DTSCS1A
|
|
02201 MOVE WRK-EMP-NO TO L203-EMP-NO. DTSCS1A
|
|
02202 DTSCS1A
|
|
02203 MOVE MPRF-TAX-REC-ADDR-EXISTS-IND DTSCS1A
|
|
02204 TO L203-TAX-REC-ADDR-EXISTS-IND. DTSCS1A
|
|
02205 DTSCS1A
|
|
02206 PERFORM S203-DETER-ZIPS THRU S203-EXIT. DTSCS1A
|
|
02207 DTSCS1A
|
|
02208 IF L203-FLD-ZIP NOT = MPRF-FLD-ZIP DTSCS1A
|
|
02209 MOVE L203-FLD-ZIP TO MPRF-FLD-ZIP DTSCS1A
|
|
02210 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSCS1A
|
|
02211 DTSCS1A
|
|
02212 IF L203-FLD-STATE NOT = MPRF-FLD-ST DTSCS1A
|
|
02213 MOVE L203-FLD-STATE TO MPRF-FLD-ST DTSCS1A
|
|
02214 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSCS1A
|
|
02215 DTSCS1A
|
|
02216 DTSCS1A
|
|
02217 MOVE MAP-FEIN-AREA TO L017-S-FEIN-AREA. DTSCS1A
|
|
02218 DTSCS1A
|
|
02219 PERFORM S017-FEIN-FROM-SCREEN THRU S017-EXIT. DTSCS1A
|
|
02220 DTSCS1A
|
|
02221 IF L017-FEIN = MPRF-FEIN DTSCS1A
|
|
02222 NEXT SENTENCE DTSCS1A
|
|
02223 ELSE DTSCS1A
|
|
02224 MOVE 'MPRF-FEIN' TO L331-FIELD-NAME DTSCS1A
|
|
02225 MOVE SPACES TO L331-TO-VALUE DTSCS1A
|
|
02226 L331-FROM-VALUE DTSCS1A
|
|
02227 IF MPRF-FEIN NOT = +0 DTSCS1A
|
|
02228 MOVE MPRF-FEIN TO WRK-DISPLAY DTSCS1A
|
|
02229 STRING WRK-DISPLAY-FEIN-1 DELIMITED BY SIZE DTSCS1A
|
|
02230 ' ' DELIMITED BY SIZE DTSCS1A
|
|
02231 WRK-DISPLAY-FEIN-2 DELIMITED BY SIZE DTSCS1A
|
|
02232 INTO L331-FROM-VALUE DTSCS1A
|
|
02233 END-IF DTSCS1A
|
|
02234 IF L017-FEIN NOT = +0 DTSCS1A
|
|
02235 MOVE L017-FEIN TO WRK-DISPLAY DTSCS1A
|
|
02236 STRING WRK-DISPLAY-FEIN-1 DELIMITED BY SIZE DTSCS1A
|
|
02237 ' ' DELIMITED BY SIZE DTSCS1A
|
|
02238 WRK-DISPLAY-FEIN-2 DELIMITED BY SIZE DTSCS1A
|
|
02239 INTO L331-TO-VALUE DTSCS1A
|
|
02240 END-IF DTSCS1A
|
|
02241 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSCS1A
|
|
02242 MOVE L017-FEIN TO MPRF-FEIN DTSCS1A
|
|
02243 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSCS1A
|
|
02244 DTSCS1A
|
|
02245 MOVE MPRF-REC TO MSKL-REC. DTSCS1A
|
|
02246 DTSCS1A
|
|
02247 PERFORM S810-REWRITE THRU S810-EXIT. DTSCS1A
|
|
02248 P8910-EXIT. DTSCS1A
|
|
02249 EXIT. DTSCS1A
|
|
02250 SKIP3 DTSCS1A
|
|
02251 P8920-MTAD-UPDATE. DTSCS1A
|
|
02252 MOVE LOW-VALUES TO MTAD-KEY-AREA. DTSCS1A
|
|
02253 DTSCS1A
|
|
02254 MOVE WRK-EMP-NO TO MTAD-EMP-NO. DTSCS1A
|
|
02255 DTSCS1A
|
|
02256 SET MTAD-TAD-88 TO TRUE. DTSCS1A
|
|
02257 DTSCS1A
|
|
02258 SET MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE. DTSCS1A
|
|
02259 DTSCS1A
|
|
02260 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSCS1A
|
|
02261 DTSCS1A
|
|
02262 PERFORM S810-READ THRU S810-EXIT. DTSCS1A
|
|
02263 DTSCS1A
|
|
02264 IF L810-NO-REC-88 DTSCS1A
|
|
02265 PERFORM P8921-MTAD-INITIALIZE THRU P8921-EXIT DTSCS1A
|
|
02266 PERFORM P8922-UPDATE THRU P8922-EXIT DTSCS1A
|
|
02267 MOVE MTAD-REC TO MSKL-REC DTSCS1A
|
|
02268 PERFORM S810-WRITE THRU S810-EXIT DTSCS1A
|
|
02269 ELSE DTSCS1A
|
|
02270 MOVE MSKL-REC TO MTAD-REC DTSCS1A
|
|
02271 PERFORM P8922-UPDATE THRU P8922-EXIT DTSCS1A
|
|
02272 MOVE MTAD-REC TO MSKL-REC DTSCS1A
|
|
02273 PERFORM S810-REWRITE THRU S810-EXIT. DTSCS1A
|
|
02274 P8920-EXIT. DTSCS1A
|
|
02275 EXIT. DTSCS1A
|
|
02276 SKIP3 DTSCS1A
|
|
02277 P8921-MTAD-INITIALIZE. DTSCS1A
|
|
02278 MOVE +0 TO MTAD-PURGE-DATE. DTSCS1A
|
|
02279 DTSCS1A
|
|
02280 MOVE LOW-VALUES TO MTAD-DATA-AREA. DTSCS1A
|
|
02281 DTSCS1A
|
|
02282 MOVE SPACES TO MTAD-ADDRESS. DTSCS1A
|
|
02283 DTSCS1A
|
|
02284 MOVE SPACES TO MTAD-PHONE-NUMBERS. DTSCS1A
|
|
02285 DTSCS1A
|
|
02286 MOVE SPACES TO MTAD-EMAIL-ADDRESS. DTSCS1A
|
|
02287 DTSCS1A
|
|
02288 SET MTAD-UC223-YES-88 TO TRUE. DTSCS1A
|
|
02289 DTSCS1A
|
|
02290 SET MTAD-MISSING-RPT-LTRS-YES-88 TO TRUE. DTSCS1A
|
|
02291 DTSCS1A
|
|
02292 SET MTAD-PHYSICAL-ADDRESS-NO-88 TO TRUE. DTSCS1A
|
|
02293 DTSCS1A
|
|
02294 SET MPRF-EFT-SOLICITED-NO-88 TO TRUE. DTSCS1A
|
|
02295 DTSCS1A
|
|
02296 SET MPRF-EFT-ENROLLED-NO-88 TO TRUE. DTSCS1A
|
|
02297 DTSCS1A
|
|
02298 SET MTAD-NOT-CONVERTED-88 TO TRUE. DTSCS1A
|
|
02299 DTSCS1A
|
|
02300 MOVE LCCM-CURR-RUN-DATE TO MTAD-ESTB-DATE DTSCS1A
|
|
02301 MTAD-CHNG-DATE. DTSCS1A
|
|
02302 P8921-EXIT. DTSCS1A
|
|
02303 EXIT. DTSCS1A
|
|
02304 SKIP3 DTSCS1A
|
|
02305 P8922-UPDATE. DTSCS1A
|
|
02306 MOVE 'MAILING ADDRESS' TO L331-REC-OCC-ID. DTSCS1A
|
|
02307 DTSCS1A
|
|
02308 MOVE LCCM-HOLD-ADDRESS-1 TO L072-ADDRESS. DTSCS1A
|
|
02309 DTSCS1A
|
|
02310 IF L072-ATTN-LINE = MTAD-ATTN-LINE DTSCS1A
|
|
02311 NEXT SENTENCE DTSCS1A
|
|
02312 ELSE DTSCS1A
|
|
02313 MOVE 'MTAD-ATTN-LINE' TO L331-FIELD-NAME DTSCS1A
|
|
02314 MOVE MTAD-ATTN-LINE TO L331-FROM-VALUE DTSCS1A
|
|
02315 MOVE L072-ATTN-LINE TO L331-TO-VALUE DTSCS1A
|
|
02316 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSCS1A
|
|
02317 MOVE L072-ATTN-LINE TO MTAD-ATTN-LINE DTSCS1A
|
|
02318 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE. DTSCS1A
|
|
02319 DTSCS1A
|
|
02320 IF L072-DELIV-LINE-1 = MTAD-DELIV-LINE-1 DTSCS1A
|
|
02321 NEXT SENTENCE DTSCS1A
|
|
02322 ELSE DTSCS1A
|
|
02323 MOVE 'MTAD-DELIV-LINE-1' TO L331-FIELD-NAME DTSCS1A
|
|
02324 MOVE MTAD-DELIV-LINE-1 TO L331-FROM-VALUE DTSCS1A
|
|
02325 MOVE L072-DELIV-LINE-1 TO L331-TO-VALUE DTSCS1A
|
|
02326 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSCS1A
|
|
02327 MOVE L072-DELIV-LINE-1 TO MTAD-DELIV-LINE-1 DTSCS1A
|
|
02328 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE. DTSCS1A
|
|
02329 DTSCS1A
|
|
02330 IF L072-DELIV-LINE-2 = MTAD-DELIV-LINE-2 DTSCS1A
|
|
02331 NEXT SENTENCE DTSCS1A
|
|
02332 ELSE DTSCS1A
|
|
02333 MOVE 'MTAD-DELIV-LINE-2' TO L331-FIELD-NAME DTSCS1A
|
|
02334 MOVE MTAD-DELIV-LINE-2 TO L331-FROM-VALUE DTSCS1A
|
|
02335 MOVE L072-DELIV-LINE-2 TO L331-TO-VALUE DTSCS1A
|
|
02336 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSCS1A
|
|
02337 MOVE L072-DELIV-LINE-2 TO MTAD-DELIV-LINE-2 DTSCS1A
|
|
02338 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE. DTSCS1A
|
|
02339 DTSCS1A
|
|
02340 IF L072-CITY = MTAD-CITY DTSCS1A
|
|
02341 NEXT SENTENCE DTSCS1A
|
|
02342 ELSE DTSCS1A
|
|
02343 MOVE 'MTAD-CITY' TO L331-FIELD-NAME DTSCS1A
|
|
02344 MOVE MTAD-CITY TO L331-FROM-VALUE DTSCS1A
|
|
02345 MOVE L072-CITY TO L331-TO-VALUE DTSCS1A
|
|
02346 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSCS1A
|
|
02347 MOVE L072-CITY TO MTAD-CITY DTSCS1A
|
|
02348 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE. DTSCS1A
|
|
02349 DTSCS1A
|
|
02350 IF L072-ST = MTAD-ST DTSCS1A
|
|
02351 NEXT SENTENCE DTSCS1A
|
|
02352 ELSE DTSCS1A
|
|
02353 MOVE 'MTAD-ST' TO L331-FIELD-NAME DTSCS1A
|
|
02354 MOVE MTAD-ST TO L331-FROM-VALUE DTSCS1A
|
|
02355 MOVE L072-ST TO L331-TO-VALUE DTSCS1A
|
|
02356 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSCS1A
|
|
02357 MOVE L072-ST TO MTAD-ST DTSCS1A
|
|
02358 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE. DTSCS1A
|
|
02359 DTSCS1A
|
|
02360 IF L072-ZIP = MTAD-ZIP DTSCS1A
|
|
02361 NEXT SENTENCE DTSCS1A
|
|
02362 ELSE DTSCS1A
|
|
02363 MOVE 'MTAD-ZIP' TO L331-FIELD-NAME DTSCS1A
|
|
02364 MOVE MTAD-ZIP TO L331-FROM-VALUE DTSCS1A
|
|
02365 MOVE L072-ZIP TO L331-TO-VALUE DTSCS1A
|
|
02366 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSCS1A
|
|
02367 MOVE L072-ZIP TO MTAD-ZIP DTSCS1A
|
|
02368 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE. DTSCS1A
|
|
02369 DTSCS1A
|
|
02370 IF L072-ADVANCED-BARCODE = MTAD-ADVANCED-BARCODE DTSCS1A
|
|
02371 NEXT SENTENCE DTSCS1A
|
|
02372 ELSE DTSCS1A
|
|
02373 MOVE L072-ADVANCED-BARCODE TO MTAD-ADVANCED-BARCODE DTSCS1A
|
|
02374 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE. DTSCS1A
|
|
02375 DTSCS1A
|
|
02376 MOVE MAP-VOICE-1-AREA TO L021-S-TNO-AREA. DTSCS1A
|
|
02377 PERFORM S021-TELNO-FROM-SCREEN THRU S021-EXIT. DTSCS1A
|
|
02378 IF L021-TNO = MTAD-VOICE-1 DTSCS1A
|
|
02379 NEXT SENTENCE DTSCS1A
|
|
02380 ELSE DTSCS1A
|
|
02381 MOVE 'MTAD-VOICE-1' TO L331-FIELD-NAME DTSCS1A
|
|
02382 MOVE SPACE TO L331-FROM-VALUE DTSCS1A
|
|
02383 L331-TO-VALUE DTSCS1A
|
|
02384 STRING MTAD-VOICE-1-AREA-CD DELIMITED BY SIZE DTSCS1A
|
|
02385 ' ' DELIMITED BY SIZE DTSCS1A
|
|
02386 MTAD-VOICE-1-PREFIX DELIMITED BY SIZE DTSCS1A
|
|
02387 ' ' DELIMITED BY SIZE DTSCS1A
|
|
02388 MTAD-VOICE-1-SUFFIX DELIMITED BY SIZE DTSCS1A
|
|
02389 ' ' DELIMITED BY SIZE DTSCS1A
|
|
02390 MTAD-VOICE-1-EXT DELIMITED BY SIZE DTSCS1A
|
|
02391 INTO L331-FROM-VALUE DTSCS1A
|
|
02392 STRING L021-TNO-AREA-CD DELIMITED BY SIZE DTSCS1A
|
|
02393 ' ' DELIMITED BY SIZE DTSCS1A
|
|
02394 L021-TNO-PREFIX DELIMITED BY SIZE DTSCS1A
|
|
02395 ' ' DELIMITED BY SIZE DTSCS1A
|
|
02396 L021-TNO-SUFFIX DELIMITED BY SIZE DTSCS1A
|
|
02397 ' ' DELIMITED BY SIZE DTSCS1A
|
|
02398 L021-TNO-EXT DELIMITED BY SIZE DTSCS1A
|
|
02399 INTO L331-TO-VALUE DTSCS1A
|
|
02400 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSCS1A
|
|
02401 MOVE L021-TNO TO MTAD-VOICE-1 DTSCS1A
|
|
02402 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE. DTSCS1A
|
|
02403 DTSCS1A
|
|
02404 MOVE MAP-VOICE-2-AREA TO L021-S-TNO-AREA. DTSCS1A
|
|
02405 PERFORM S021-TELNO-FROM-SCREEN THRU S021-EXIT. DTSCS1A
|
|
02406 IF L021-TNO = MTAD-VOICE-2 DTSCS1A
|
|
02407 NEXT SENTENCE DTSCS1A
|
|
02408 ELSE DTSCS1A
|
|
02409 MOVE 'MTAD-VOICE-2' TO L331-FIELD-NAME DTSCS1A
|
|
02410 MOVE SPACE TO L331-FROM-VALUE DTSCS1A
|
|
02411 L331-TO-VALUE DTSCS1A
|
|
02412 STRING MTAD-VOICE-2-AREA-CD DELIMITED BY SIZE DTSCS1A
|
|
02413 ' ' DELIMITED BY SIZE DTSCS1A
|
|
02414 MTAD-VOICE-2-PREFIX DELIMITED BY SIZE DTSCS1A
|
|
02415 ' ' DELIMITED BY SIZE DTSCS1A
|
|
02416 MTAD-VOICE-2-SUFFIX DELIMITED BY SIZE DTSCS1A
|
|
02417 ' ' DELIMITED BY SIZE DTSCS1A
|
|
02418 MTAD-VOICE-2-EXT DELIMITED BY SIZE DTSCS1A
|
|
02419 INTO L331-FROM-VALUE DTSCS1A
|
|
02420 STRING L021-TNO-AREA-CD DELIMITED BY SIZE DTSCS1A
|
|
02421 ' ' DELIMITED BY SIZE DTSCS1A
|
|
02422 L021-TNO-PREFIX DELIMITED BY SIZE DTSCS1A
|
|
02423 ' ' DELIMITED BY SIZE DTSCS1A
|
|
02424 L021-TNO-SUFFIX DELIMITED BY SIZE DTSCS1A
|
|
02425 ' ' DELIMITED BY SIZE DTSCS1A
|
|
02426 L021-TNO-EXT DELIMITED BY SIZE DTSCS1A
|
|
02427 INTO L331-TO-VALUE DTSCS1A
|
|
02428 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSCS1A
|
|
02429 MOVE L021-TNO TO MTAD-VOICE-2 DTSCS1A
|
|
02430 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE. DTSCS1A
|
|
02431 DTSCS1A
|
|
02432 MOVE MAP-FAX-AREA TO L021-S-TNO-AREA. DTSCS1A
|
|
02433 PERFORM S021-TELNO-FROM-SCREEN THRU S021-EXIT. DTSCS1A
|
|
02434 IF L021-TNO = MTAD-FAX DTSCS1A
|
|
02435 NEXT SENTENCE DTSCS1A
|
|
02436 ELSE DTSCS1A
|
|
02437 MOVE 'MTAD-FAX' TO L331-FIELD-NAME DTSCS1A
|
|
02438 MOVE SPACE TO L331-FROM-VALUE DTSCS1A
|
|
02439 L331-TO-VALUE DTSCS1A
|
|
02440 STRING MTAD-FAX-AREA-CD DELIMITED BY SIZE DTSCS1A
|
|
02441 ' ' DELIMITED BY SIZE DTSCS1A
|
|
02442 MTAD-FAX-PREFIX DELIMITED BY SIZE DTSCS1A
|
|
02443 ' ' DELIMITED BY SIZE DTSCS1A
|
|
02444 MTAD-FAX-SUFFIX DELIMITED BY SIZE DTSCS1A
|
|
02445 ' ' DELIMITED BY SIZE DTSCS1A
|
|
02446 MTAD-FAX-EXT DELIMITED BY SIZE DTSCS1A
|
|
02447 INTO L331-FROM-VALUE DTSCS1A
|
|
02448 STRING L021-TNO-AREA-CD DELIMITED BY SIZE DTSCS1A
|
|
02449 ' ' DELIMITED BY SIZE DTSCS1A
|
|
02450 L021-TNO-PREFIX DELIMITED BY SIZE DTSCS1A
|
|
02451 ' ' DELIMITED BY SIZE DTSCS1A
|
|
02452 L021-TNO-SUFFIX DELIMITED BY SIZE DTSCS1A
|
|
02453 ' ' DELIMITED BY SIZE DTSCS1A
|
|
02454 L021-TNO-EXT DELIMITED BY SIZE DTSCS1A
|
|
02455 INTO L331-TO-VALUE DTSCS1A
|
|
02456 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSCS1A
|
|
02457 MOVE L021-TNO TO MTAD-FAX DTSCS1A
|
|
02458 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE. DTSCS1A
|
|
02459 P8922-EXIT. DTSCS1A
|
|
02460 EXIT. DTSCS1A
|
|
02461 SKIP3 DTSCS1A
|
|
02462 P8930-MERA-UPDATE. DTSCS1A
|
|
02463 SET WRK-UPD-MERA-YES-88 TO TRUE. DTSCS1A
|
|
02464 DTSCS1A
|
|
02465 MOVE LOW-VALUES TO MERA-KEY-AREA. DTSCS1A
|
|
02466 DTSCS1A
|
|
02467 MOVE WRK-EMP-NO TO MERA-EMP-NO. DTSCS1A
|
|
02468 DTSCS1A
|
|
02469 SET MERA-ERA-88 TO TRUE. DTSCS1A
|
|
02470 DTSCS1A
|
|
02471 MOVE MERA-KEY-AREA TO MSKL-KEY-AREA. DTSCS1A
|
|
02472 DTSCS1A
|
|
02473 PERFORM S810-READ THRU S810-EXIT. DTSCS1A
|
|
02474 DTSCS1A
|
|
02475 IF L810-NO-REC-88 DTSCS1A
|
|
02476 IF MPRF-CONVERTED-88 DTSCS1A
|
|
02477 SET WRK-UPD-MERA-NO-88 TO TRUE DTSCS1A
|
|
02478 ELSE DTSCS1A
|
|
02479 PERFORM P8931-MERA-INITIALIZE THRU P8931-EXIT DTSCS1A
|
|
02480 PERFORM P8932-UPDATE THRU P8932-EXIT DTSCS1A
|
|
02481 MOVE MERA-REC TO MSKL-REC DTSCS1A
|
|
02482 PERFORM S810-WRITE THRU S810-EXIT DTSCS1A
|
|
02483 END-IF DTSCS1A
|
|
02484 ELSE DTSCS1A
|
|
02485 MOVE MSKL-REC TO MERA-REC DTSCS1A
|
|
02486 PERFORM P8932-UPDATE THRU P8932-EXIT DTSCS1A
|
|
02487 MOVE MERA-REC TO MSKL-REC DTSCS1A
|
|
02488 PERFORM S810-REWRITE THRU S810-EXIT. DTSCS1A
|
|
02489 P8930-EXIT. DTSCS1A
|
|
02490 EXIT. DTSCS1A
|
|
02491 SKIP3 DTSCS1A
|
|
02492 P8931-MERA-INITIALIZE. DTSCS1A
|
|
02493 MOVE +0 TO MERA-PURGE-DATE. DTSCS1A
|
|
02494 DTSCS1A
|
|
02495 MOVE LOW-VALUES TO MERA-DATA-AREA. DTSCS1A
|
|
02496 DTSCS1A
|
|
02497 SET MERA-SOURCE-UNK-88 TO TRUE. DTSCS1A
|
|
02498 DTSCS1A
|
|
02499 MOVE +0 TO MERA-CLAIMANT-SSN. DTSCS1A
|
|
02500 DTSCS1A
|
|
02501 MOVE SPACE TO MERA-CLAIMANT-NAME. DTSCS1A
|
|
02502 DTSCS1A
|
|
02503 MOVE SPACE TO MERA-RESPONSIBLE-OP-ID. DTSCS1A
|
|
02504 DTSCS1A
|
|
02505 MOVE +0 TO MERA-POT-PRED-EMP-NO. DTSCS1A
|
|
02506 DTSCS1A
|
|
02507 MOVE SPACE TO MERA-NOTE. DTSCS1A
|
|
02508 DTSCS1A
|
|
02509 SET MERA-LETTER-GENERIC-88 TO TRUE. DTSCS1A
|
|
02510 DTSCS1A
|
|
02511 SET MERA-FIRST-LABEL-NEEDED-88 TO TRUE. DTSCS1A
|
|
02512 DTSCS1A
|
|
02513 MOVE +1 TO MERA-LABEL-CNT. DTSCS1A
|
|
02514 DTSCS1A
|
|
02515 SET MERA-STATUS-SETUP-88 TO TRUE. DTSCS1A
|
|
02516 DTSCS1A
|
|
02517 MOVE LCCM-CURR-RUN-DATE TO MERA-STATUS-CHNG-DATE. DTSCS1A
|
|
02518 DTSCS1A
|
|
02519 MOVE +0 TO MERA-MAIL-DATE-1 DTSCS1A
|
|
02520 MERA-MAIL-DATE-2 DTSCS1A
|
|
02521 MERA-COOP-AGENCY-REQ-DATE DTSCS1A
|
|
02522 MERA-FIELD-ASSIGN-DATE DTSCS1A
|
|
02523 MERA-RECEIVED-DATE DTSCS1A
|
|
02524 MERA-DETER-NOTSUB-DATE. DTSCS1A
|
|
02525 DTSCS1A
|
|
02526 SET MERA-NOT-CONVERTED-88 TO TRUE. DTSCS1A
|
|
02527 DTSCS1A
|
|
02528 MOVE LCCM-CURR-RUN-DATE TO MERA-ESTB-DATE DTSCS1A
|
|
02529 MERA-CHNG-DATE. DTSCS1A
|
|
02530 P8931-EXIT. DTSCS1A
|
|
02531 EXIT. DTSCS1A
|
|
02532 SKIP3 DTSCS1A
|
|
02533 P8932-UPDATE. DTSCS1A
|
|
02534 IF MAP-SOURCE-CD = MERA-SOURCE-CD DTSCS1A
|
|
02535 NEXT SENTENCE DTSCS1A
|
|
02536 ELSE DTSCS1A
|
|
02537 MOVE MAP-SOURCE-CD TO MERA-SOURCE-CD DTSCS1A
|
|
02538 MOVE LCCM-CURR-RUN-DATE TO MERA-CHNG-DATE. DTSCS1A
|
|
02539 DTSCS1A
|
|
02540 DTSCS1A
|
|
02541 MOVE MAP-CLAIMANT-SSN-AREA TO L020-S-SSN-AREA. DTSCS1A
|
|
02542 DTSCS1A
|
|
02543 PERFORM S020-SSN-FROM-SCREEN THRU S020-EXIT. DTSCS1A
|
|
02544 DTSCS1A
|
|
02545 IF L020-SSN = MERA-CLAIMANT-SSN DTSCS1A
|
|
02546 NEXT SENTENCE DTSCS1A
|
|
02547 ELSE DTSCS1A
|
|
02548 MOVE L020-SSN TO MERA-CLAIMANT-SSN DTSCS1A
|
|
02549 MOVE LCCM-CURR-RUN-DATE TO MERA-CHNG-DATE. DTSCS1A
|
|
02550 DTSCS1A
|
|
02551 DTSCS1A
|
|
02552 IF MAP-CLAIMANT-NAME = MERA-CLAIMANT-NAME DTSCS1A
|
|
02553 NEXT SENTENCE DTSCS1A
|
|
02554 ELSE DTSCS1A
|
|
02555 MOVE MAP-CLAIMANT-NAME TO MERA-CLAIMANT-NAME DTSCS1A
|
|
02556 MOVE LCCM-CURR-RUN-DATE TO MERA-CHNG-DATE. DTSCS1A
|
|
02557 DTSCS1A
|
|
02558 DTSCS1A
|
|
02559 IF MAP-RESP-OP-ID = MERA-RESPONSIBLE-OP-ID DTSCS1A
|
|
02560 NEXT SENTENCE DTSCS1A
|
|
02561 ELSE DTSCS1A
|
|
02562 MOVE MAP-RESP-OP-ID TO MERA-RESPONSIBLE-OP-ID DTSCS1A
|
|
02563 MOVE LCCM-CURR-RUN-DATE TO MERA-CHNG-DATE. DTSCS1A
|
|
02564 DTSCS1A
|
|
02565 DTSCS1A
|
|
02566 MOVE MAP-PRED-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS1A
|
|
02567 DTSCS1A
|
|
02568 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS1A
|
|
02569 DTSCS1A
|
|
02570 IF L018-EMP-NO = MERA-POT-PRED-EMP-NO DTSCS1A
|
|
02571 NEXT SENTENCE DTSCS1A
|
|
02572 ELSE DTSCS1A
|
|
02573 MOVE L018-EMP-NO TO MERA-POT-PRED-EMP-NO DTSCS1A
|
|
02574 MOVE LCCM-CURR-RUN-DATE TO MERA-CHNG-DATE. DTSCS1A
|
|
02575 DTSCS1A
|
|
02576 DTSCS1A
|
|
02577 IF MAP-NOTE = MERA-NOTE DTSCS1A
|
|
02578 NEXT SENTENCE DTSCS1A
|
|
02579 ELSE DTSCS1A
|
|
02580 MOVE MAP-NOTE TO MERA-NOTE DTSCS1A
|
|
02581 MOVE LCCM-CURR-RUN-DATE TO MERA-CHNG-DATE. DTSCS1A
|
|
02582 DTSCS1A
|
|
02583 DTSCS1A
|
|
02584 IF MAP-LETTER-1-CD = MERA-LETTER-1-CD DTSCS1A
|
|
02585 NEXT SENTENCE DTSCS1A
|
|
02586 ELSE DTSCS1A
|
|
02587 MOVE MAP-LETTER-1-CD TO MERA-LETTER-1-CD DTSCS1A
|
|
02588 MOVE LCCM-CURR-RUN-DATE TO MERA-CHNG-DATE. DTSCS1A
|
|
02589 DTSCS1A
|
|
02590 DTSCS1A
|
|
02591 IF MAP-STATUS-CD = MERA-STATUS-CD DTSCS1A
|
|
02592 NEXT SENTENCE DTSCS1A
|
|
02593 ELSE DTSCS1A
|
|
02594 MOVE MAP-STATUS-CD TO MERA-STATUS-CD DTSCS1A
|
|
02595 MOVE LCCM-CURR-RUN-DATE TO MERA-STATUS-CHNG-DATE DTSCS1A
|
|
02596 MOVE LCCM-CURR-RUN-DATE TO MERA-CHNG-DATE DTSCS1A
|
|
02597 IF MERA-STATUS-SETUP-88 DTSCS1A
|
|
02598 MOVE +1 TO MERA-LABEL-CNT. DTSCS1A
|
|
02599 DTSCS1A
|
|
02600 DTSCS1A
|
|
02601 MOVE MAP-MAIL-DATE-1-AREA TO L015-S-DATE-AREA. DTSCS1A
|
|
02602 DTSCS1A
|
|
02603 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS1A
|
|
02604 DTSCS1A
|
|
02605 IF L015-DATE = MERA-MAIL-DATE-1 DTSCS1A
|
|
02606 NEXT SENTENCE DTSCS1A
|
|
02607 ELSE DTSCS1A
|
|
02608 MOVE L015-DATE TO MERA-MAIL-DATE-1 DTSCS1A
|
|
02609 MOVE LCCM-CURR-RUN-DATE TO MERA-CHNG-DATE. DTSCS1A
|
|
02610 DTSCS1A
|
|
02611 DTSCS1A
|
|
02612 MOVE MAP-MAIL-DATE-2-AREA TO L015-S-DATE-AREA. DTSCS1A
|
|
02613 DTSCS1A
|
|
02614 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS1A
|
|
02615 DTSCS1A
|
|
02616 IF L015-DATE = MERA-MAIL-DATE-2 DTSCS1A
|
|
02617 NEXT SENTENCE DTSCS1A
|
|
02618 ELSE DTSCS1A
|
|
02619 MOVE L015-DATE TO MERA-MAIL-DATE-2 DTSCS1A
|
|
02620 MOVE LCCM-CURR-RUN-DATE TO MERA-CHNG-DATE. DTSCS1A
|
|
02621 DTSCS1A
|
|
02622 MOVE MAP-COOP-AGENCY-REQ-DATE-AREA TO L015-S-DATE-AREA. DTSCS1A
|
|
02623 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS1A
|
|
02624 IF L015-DATE = MERA-COOP-AGENCY-REQ-DATE DTSCS1A
|
|
02625 NEXT SENTENCE DTSCS1A
|
|
02626 ELSE DTSCS1A
|
|
02627 MOVE L015-DATE TO MERA-COOP-AGENCY-REQ-DATE DTSCS1A
|
|
02628 MOVE LCCM-CURR-RUN-DATE TO MERA-CHNG-DATE. DTSCS1A
|
|
02629 DTSCS1A
|
|
02630 DTSCS1A
|
|
02631 MOVE MAP-FIELD-ASSIGN-DATE-AREA TO L015-S-DATE-AREA. DTSCS1A
|
|
02632 DTSCS1A
|
|
02633 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS1A
|
|
02634 DTSCS1A
|
|
02635 IF L015-DATE = MERA-FIELD-ASSIGN-DATE DTSCS1A
|
|
02636 NEXT SENTENCE DTSCS1A
|
|
02637 ELSE DTSCS1A
|
|
02638 MOVE L015-DATE TO MERA-FIELD-ASSIGN-DATE DTSCS1A
|
|
02639 MOVE LCCM-CURR-RUN-DATE TO MERA-CHNG-DATE. DTSCS1A
|
|
02640 DTSCS1A
|
|
02641 DTSCS1A
|
|
02642 MOVE MAP-RECEIVED-DATE-AREA TO L015-S-DATE-AREA. DTSCS1A
|
|
02643 DTSCS1A
|
|
02644 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS1A
|
|
02645 DTSCS1A
|
|
02646 IF L015-DATE = MERA-RECEIVED-DATE DTSCS1A
|
|
02647 NEXT SENTENCE DTSCS1A
|
|
02648 ELSE DTSCS1A
|
|
02649 IF MERA-RECEIVED-DATE = ZERO DTSCS1A
|
|
02650 AND L015-VALID DTSCS1A
|
|
02651 PERFORM P8932A-CHK-CYCLE-A THRU P8932A-EXIT DTSCS1A
|
|
02652 END-IF DTSCS1A
|
|
02653 MOVE L015-DATE TO MERA-RECEIVED-DATE DTSCS1A
|
|
02654 MOVE LCCM-CURR-RUN-DATE TO MERA-CHNG-DATE DTSCS1A
|
|
02655 END-IF. DTSCS1A
|
|
02656 DTSCS1A
|
|
02657 DTSCS1A
|
|
02658 MOVE MAP-DETER-NOTSUB-DATE-AREA TO L015-S-DATE-AREA. DTSCS1A
|
|
02659 DTSCS1A
|
|
02660 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS1A
|
|
02661 DTSCS1A
|
|
02662 IF L015-DATE = MERA-DETER-NOTSUB-DATE DTSCS1A
|
|
02663 NEXT SENTENCE DTSCS1A
|
|
02664 ELSE DTSCS1A
|
|
02665 MOVE L015-DATE TO MERA-DETER-NOTSUB-DATE DTSCS1A
|
|
02666 MOVE LCCM-CURR-RUN-DATE TO MERA-CHNG-DATE. DTSCS1A
|
|
02667 P8932-EXIT. DTSCS1A
|
|
02668 EXIT. DTSCS1A
|
|
02669 DTSCS1A
|
|
02670 P8932A-CHK-CYCLE-A. DTSCS1A
|
|
02671 IF MERA-STATUS-ACTIVE-88 DTSCS1A
|
|
02672 IF MPRF-STATUS-SUB-88 DTSCS1A
|
|
02673 SET MERA-STATUS-LIAB-88 TO TRUE DTSCS1A
|
|
02674 ELSE DTSCS1A
|
|
02675 IF MPRF-STATUS-UNK-88 DTSCS1A
|
|
02676 SET MERA-STATUS-RECD-88 TO TRUE DTSCS1A
|
|
02677 ELSE DTSCS1A
|
|
02678 SET MERA-STATUS-NOT-LIAB-88 TO TRUE DTSCS1A
|
|
02679 END-IF DTSCS1A
|
|
02680 END-IF DTSCS1A
|
|
02681 END-IF. DTSCS1A
|
|
02682 DTSCS1A
|
|
02683 P8932A-EXIT. DTSCS1A
|
|
02684 EXIT. DTSCS1A
|
|
02685 DTSCS1A
|
|
02686 P8950-POT-HOUSEHOLD. DTSCS1A
|
|
02687 IF MAP-POT-HOUSEHOLD-IND = 'Y' DTSCS1A
|
|
02688 NEXT SENTENCE DTSCS1A
|
|
02689 ELSE DTSCS1A
|
|
02690 GO TO P8950-EXIT. DTSCS1A
|
|
02691 DTSCS1A
|
|
02692 IF LCCM-SCR-ADD-LOCKED DTSCS1A
|
|
02693 SET L400-ADD-PENDING-1A-88 TO TRUE DTSCS1A
|
|
02694 ELSE DTSCS1A
|
|
02695 SET L400-DETERM-PENDING-88 TO TRUE. DTSCS1A
|
|
02696 MOVE WRK-EMP-NO TO L400-EMP-NO. DTSCS1A
|
|
02697 MOVE LCCM-CURR-RUN-DATE TO L400-CURR-RUN-DATE. DTSCS1A
|
|
02698 MOVE LCCM-OP-ID TO L400-OP-ID. DTSCS1A
|
|
02699 PERFORM S400-HOUSEHOLD THRU S400-EXIT. DTSCS1A
|
|
02700 DTSCS1A
|
|
02701 P8950-EXIT. DTSCS1A
|
|
02702 EXIT. DTSCS1A
|
|
02703 /*****************************************************************DTSCS1A
|
|
02704 * LINKS TO UTILITY MODULES DTSCS1A
|
|
02705 ******************************************************************DTSCS1A
|
|
02706 DTSCS1A
|
|
02707 S001-DATE. DTSCS1A
|
|
02708 EXEC CICS LINK DTSCS1A
|
|
02709 PROGRAM('DTSCU001') DTSCS1A
|
|
02710 COMMAREA(L001-COMM-AREA) DTSCS1A
|
|
02711 END-EXEC. DTSCS1A
|
|
02712 S001-EXIT. DTSCS1A
|
|
02713 EXIT. DTSCS1A
|
|
02714 SKIP3 DTSCS1A
|
|
02715 S015-DATE-FROM-SCREEN. DTSCS1A
|
|
02716 EXEC CICS LINK DTSCS1A
|
|
02717 PROGRAM('DTSCU015') DTSCS1A
|
|
02718 COMMAREA(L015-COMM-AREA) DTSCS1A
|
|
02719 END-EXEC. DTSCS1A
|
|
02720 S015-EXIT. DTSCS1A
|
|
02721 EXIT. DTSCS1A
|
|
02722 SKIP3 DTSCS1A
|
|
02723 S017-FEIN-FROM-SCREEN. DTSCS1A
|
|
02724 EXEC CICS LINK DTSCS1A
|
|
02725 PROGRAM('DTSCU017') DTSCS1A
|
|
02726 COMMAREA(L017-COMM-AREA) DTSCS1A
|
|
02727 END-EXEC. DTSCS1A
|
|
02728 S017-EXIT. DTSCS1A
|
|
02729 EXIT. DTSCS1A
|
|
02730 SKIP3 DTSCS1A
|
|
02731 S018-EMP-NO-FROM-SCREEN. DTSCS1A
|
|
02732 EXEC CICS LINK DTSCS1A
|
|
02733 PROGRAM('DTSCU018') DTSCS1A
|
|
02734 COMMAREA(L018-COMM-AREA) DTSCS1A
|
|
02735 END-EXEC. DTSCS1A
|
|
02736 S018-EXIT. DTSCS1A
|
|
02737 EXIT. DTSCS1A
|
|
02738 SKIP3 DTSCS1A
|
|
02739 S020-SSN-FROM-SCREEN. DTSCS1A
|
|
02740 EXEC CICS LINK DTSCS1A
|
|
02741 PROGRAM('DTSCU020') DTSCS1A
|
|
02742 COMMAREA(L020-COMM-AREA) DTSCS1A
|
|
02743 END-EXEC. DTSCS1A
|
|
02744 S020-EXIT. DTSCS1A
|
|
02745 EXIT. DTSCS1A
|
|
02746 SKIP3 DTSCS1A
|
|
02747 S021-TELNO-FROM-SCREEN. DTSCS1A
|
|
02748 EXEC CICS LINK DTSCS1A
|
|
02749 PROGRAM('DTSCU021') DTSCS1A
|
|
02750 COMMAREA(L021-COMM-AREA) DTSCS1A
|
|
02751 END-EXEC. DTSCS1A
|
|
02752 S021-EXIT. DTSCS1A
|
|
02753 EXIT. DTSCS1A
|
|
02754 SKIP3 DTSCS1A
|
|
02755 S031-REG-CODES. DTSCS1A
|
|
02756 EXEC CICS LINK DTSCS1A
|
|
02757 PROGRAM('DTSCU031') DTSCS1A
|
|
02758 COMMAREA(L031-COMM-AREA) DTSCS1A
|
|
02759 END-EXEC. DTSCS1A
|
|
02760 S031-EXIT. DTSCS1A
|
|
02761 EXIT. DTSCS1A
|
|
02762 SKIP3 DTSCS1A
|
|
02763 S061-FLD-REP-FIND. DTSCS1A
|
|
02764 EXEC CICS LINK DTSCS1A
|
|
02765 PROGRAM('DTSCU061') DTSCS1A
|
|
02766 COMMAREA(L061-COMM-AREA) DTSCS1A
|
|
02767 END-EXEC. DTSCS1A
|
|
02768 DTSCS1A
|
|
02769 IF L061-FILE-CLOSED DTSCS1A
|
|
02770 MOVE L061-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
02771 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS1A
|
|
02772 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS1A
|
|
02773 GO TO MAINLINE-EXIT. DTSCS1A
|
|
02774 S061-EXIT. DTSCS1A
|
|
02775 EXIT. DTSCS1A
|
|
02776 SKIP3 DTSCS1A
|
|
02777 S062-FLD-REP-LOOKUP. DTSCS1A
|
|
02778 EXEC CICS LINK DTSCS1A
|
|
02779 PROGRAM('DTSCU062') DTSCS1A
|
|
02780 COMMAREA(L062-COMM-AREA) DTSCS1A
|
|
02781 END-EXEC. DTSCS1A
|
|
02782 DTSCS1A
|
|
02783 IF L062-FILE-CLOSED DTSCS1A
|
|
02784 MOVE L062-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
02785 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS1A
|
|
02786 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS1A
|
|
02787 GO TO MAINLINE-EXIT. DTSCS1A
|
|
02788 S062-EXIT. DTSCS1A
|
|
02789 EXIT. DTSCS1A
|
|
02790 SKIP3 DTSCS1A
|
|
02791 S071-NAME-EDIT. DTSCS1A
|
|
02792 EXEC CICS LINK DTSCS1A
|
|
02793 PROGRAM('DTSCU071') DTSCS1A
|
|
02794 COMMAREA(L071-COMM-AREA) DTSCS1A
|
|
02795 END-EXEC. DTSCS1A
|
|
02796 S071-EXIT. DTSCS1A
|
|
02797 EXIT. DTSCS1A
|
|
02798 SKIP3 DTSCS1A
|
|
02799 S072-ADDRESS-EDIT. DTSCS1A
|
|
02800 EXEC CICS LINK DTSCS1A
|
|
02801 PROGRAM('DTSCU072') DTSCS1A
|
|
02802 COMMAREA(L072-COMM-AREA) DTSCS1A
|
|
02803 END-EXEC. DTSCS1A
|
|
02804 S072-EXIT. DTSCS1A
|
|
02805 EXIT. DTSCS1A
|
|
02806 SKIP3 DTSCS1A
|
|
02807 S073-TELNO-EDIT. DTSCS1A
|
|
02808 EXEC CICS LINK DTSCS1A
|
|
02809 PROGRAM('DTSCU073') DTSCS1A
|
|
02810 COMMAREA(L073-COMM-AREA) DTSCS1A
|
|
02811 END-EXEC. DTSCS1A
|
|
02812 S073-EXIT. DTSCS1A
|
|
02813 EXIT. DTSCS1A
|
|
02814 SKIP3 DTSCS1A
|
|
02815 S074-DUP-FEIN-EDIT. DTSCS1A
|
|
02816 EXEC CICS LINK DTSCS1A
|
|
02817 PROGRAM('DTSCU074') DTSCS1A
|
|
02818 COMMAREA(L074-COMM-AREA) DTSCS1A
|
|
02819 END-EXEC. DTSCS1A
|
|
02820 DTSCS1A
|
|
02821 IF L074-FILE-CLOSED-88 DTSCS1A
|
|
02822 MOVE L074-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
02823 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS1A
|
|
02824 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS1A
|
|
02825 GO TO MAINLINE-EXIT. DTSCS1A
|
|
02826 S074-EXIT. DTSCS1A
|
|
02827 EXIT. DTSCS1A
|
|
02828 SKIP3 DTSCS1A
|
|
02829 S081-CLAIMANT-NAME-LOOKUP. DTSCS1A
|
|
02830 EXEC CICS LINK DTSCS1A
|
|
02831 PROGRAM('DTSCU081') DTSCS1A
|
|
02832 COMMAREA(L081-COMM-AREA) DTSCS1A
|
|
02833 END-EXEC. DTSCS1A
|
|
02834 DTSCS1A
|
|
02835 IF L081-FILE-CLOSED DTSCS1A
|
|
02836 MOVE L081-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
02837 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS1A
|
|
02838 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS1A
|
|
02839 GO TO MAINLINE-EXIT. DTSCS1A
|
|
02840 S081-EXIT. DTSCS1A
|
|
02841 EXIT. DTSCS1A
|
|
02842 SKIP3 DTSCS1A
|
|
02843 S082-OP-ID-LOOKUP. DTSCS1A
|
|
02844 EXEC CICS LINK DTSCS1A
|
|
02845 PROGRAM('DTSCU082') DTSCS1A
|
|
02846 COMMAREA(L082-COMM-AREA) DTSCS1A
|
|
02847 END-EXEC. DTSCS1A
|
|
02848 DTSCS1A
|
|
02849 IF L082-FILE-CLOSED DTSCS1A
|
|
02850 MOVE L082-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
02851 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS1A
|
|
02852 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS1A
|
|
02853 GO TO MAINLINE-EXIT. DTSCS1A
|
|
02854 S082-EXIT. DTSCS1A
|
|
02855 EXIT. DTSCS1A
|
|
02856 SKIP3 DTSCS1A
|
|
02857 S203-DETER-ZIPS. DTSCS1A
|
|
02858 EXEC CICS LINK DTSCS1A
|
|
02859 PROGRAM('DTSCU203') DTSCS1A
|
|
02860 COMMAREA(L203-COMM-AREA) DTSCS1A
|
|
02861 END-EXEC. DTSCS1A
|
|
02862 DTSCS1A
|
|
02863 IF L203-FILE-CLOSED-88 DTSCS1A
|
|
02864 MOVE L203-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
02865 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS1A
|
|
02866 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS1A
|
|
02867 GO TO MAINLINE-EXIT. DTSCS1A
|
|
02868 S203-EXIT. DTSCS1A
|
|
02869 EXIT. DTSCS1A
|
|
02870 SKIP3 DTSCS1A
|
|
02871 S221-EMP-LOCK. DTSCS1A
|
|
02872 SET L221-START-UPDATE TO TRUE. DTSCS1A
|
|
02873 GO TO S221-EMP-LOCK-UNLOCK. DTSCS1A
|
|
02874 DTSCS1A
|
|
02875 S221-EMP-UNLOCK. DTSCS1A
|
|
02876 SET L221-END-UPDATE TO TRUE. DTSCS1A
|
|
02877 GO TO S221-EMP-LOCK-UNLOCK. DTSCS1A
|
|
02878 DTSCS1A
|
|
02879 S221-EMP-LOCK-UNLOCK. DTSCS1A
|
|
02880 EXEC CICS LINK DTSCS1A
|
|
02881 PROGRAM('DTSCU221') DTSCS1A
|
|
02882 COMMAREA(L221-COMM-AREA) DTSCS1A
|
|
02883 END-EXEC. DTSCS1A
|
|
02884 DTSCS1A
|
|
02885 IF L221-FILE-CLOSED DTSCS1A
|
|
02886 MOVE L221-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
02887 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS1A
|
|
02888 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS1A
|
|
02889 GO TO MAINLINE-EXIT. DTSCS1A
|
|
02890 DTSCS1A
|
|
02891 IF L221-END-UPDATE DTSCS1A
|
|
02892 AND DTSCS1A
|
|
02893 L221-NO-REC DTSCS1A
|
|
02894 GO TO S221-EXIT. DTSCS1A
|
|
02895 DTSCS1A
|
|
02896 IF L221-NOT-OK DTSCS1A
|
|
02897 MOVE L221-MSG-AREA TO LCCM-MSG-AREA. DTSCS1A
|
|
02898 S221-EXIT. DTSCS1A
|
|
02899 EXIT. DTSCS1A
|
|
02900 SKIP3 DTSCS1A
|
|
02901 S331-WRITE-MLOG. DTSCS1A
|
|
02902 EXEC CICS LINK DTSCS1A
|
|
02903 PROGRAM('DTSCU331') DTSCS1A
|
|
02904 COMMAREA(L331-COMM-AREA) DTSCS1A
|
|
02905 END-EXEC. DTSCS1A
|
|
02906 DTSCS1A
|
|
02907 IF L331-FILE-CLOSED DTSCS1A
|
|
02908 MOVE L331-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
02909 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS1A
|
|
02910 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS1A
|
|
02911 GO TO MAINLINE-EXIT. DTSCS1A
|
|
02912 S331-EXIT. DTSCS1A
|
|
02913 EXIT. DTSCS1A
|
|
02914 SKIP3 DTSCS1A
|
|
02915 S400-HOUSEHOLD. DTSCS1A
|
|
02916 MOVE ZERO TO L400-FIRST-LIAB-YRQ. DTSCS1A
|
|
02917 MOVE SPACES TO L400-ORG-TYPE DTSCS1A
|
|
02918 L400-FILING-SCHED. DTSCS1A
|
|
02919 DTSCS1A
|
|
02920 EXEC CICS LINK DTSCS1A
|
|
02921 PROGRAM('DTSCU400') DTSCS1A
|
|
02922 COMMAREA(L400-COMM-AREA) DTSCS1A
|
|
02923 END-EXEC. DTSCS1A
|
|
02924 DTSCS1A
|
|
02925 S400-EXIT. DTSCS1A
|
|
02926 EXIT. DTSCS1A
|
|
02927 SKIP3 DTSCS1A
|
|
02928 S803-REQ-SCR-ID-EDIT. DTSCS1A
|
|
02929 EXEC CICS LINK DTSCS1A
|
|
02930 PROGRAM ('DTSCU803') DTSCS1A
|
|
02931 COMMAREA (DFHCOMMAREA) DTSCS1A
|
|
02932 END-EXEC. DTSCS1A
|
|
02933 S803-EXIT. DTSCS1A
|
|
02934 EXIT. DTSCS1A
|
|
02935 SKIP3 DTSCS1A
|
|
02936 S804-INVALID-KEY. DTSCS1A
|
|
02937 EXEC CICS LINK DTSCS1A
|
|
02938 PROGRAM ('DTSCU804') DTSCS1A
|
|
02939 COMMAREA (DFHCOMMAREA) DTSCS1A
|
|
02940 END-EXEC. DTSCS1A
|
|
02941 S804-EXIT. DTSCS1A
|
|
02942 EXIT. DTSCS1A
|
|
02943 SKIP3 DTSCS1A
|
|
02944 S805-MSG-AREA. DTSCS1A
|
|
02945 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS1A
|
|
02946 DTSCS1A
|
|
02947 EXEC CICS LINK DTSCS1A
|
|
02948 PROGRAM ('DTSCU805') DTSCS1A
|
|
02949 COMMAREA (L805-COMM-AREA) DTSCS1A
|
|
02950 END-EXEC. DTSCS1A
|
|
02951 DTSCS1A
|
|
02952 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS1A
|
|
02953 S805-EXIT. DTSCS1A
|
|
02954 EXIT. DTSCS1A
|
|
02955 EJECT DTSCS1A
|
|
02956 S810-READ. DTSCS1A
|
|
02957 SET L810-READ-88 TO TRUE. DTSCS1A
|
|
02958 GO TO S810-IO. DTSCS1A
|
|
02959 DTSCS1A
|
|
02960 S810-START-BROWSE. DTSCS1A
|
|
02961 SET L810-START-BROWSE-88 TO TRUE. DTSCS1A
|
|
02962 GO TO S810-IO. DTSCS1A
|
|
02963 DTSCS1A
|
|
02964 S810-READ-NEXT. DTSCS1A
|
|
02965 SET L810-READ-NEXT-88 TO TRUE. DTSCS1A
|
|
02966 GO TO S810-IO. DTSCS1A
|
|
02967 DTSCS1A
|
|
02968 S810-READ-PREV. DTSCS1A
|
|
02969 SET L810-READ-PREV-88 TO TRUE. DTSCS1A
|
|
02970 GO TO S810-IO. DTSCS1A
|
|
02971 DTSCS1A
|
|
02972 S810-END-BROWSE. DTSCS1A
|
|
02973 SET L810-END-BROWSE-88 TO TRUE. DTSCS1A
|
|
02974 GO TO S810-IO. DTSCS1A
|
|
02975 DTSCS1A
|
|
02976 S810-REWRITE. DTSCS1A
|
|
02977 SET L810-REWRITE-88 TO TRUE. DTSCS1A
|
|
02978 GO TO S810-IO. DTSCS1A
|
|
02979 DTSCS1A
|
|
02980 S810-WRITE. DTSCS1A
|
|
02981 SET L810-WRITE-88 TO TRUE. DTSCS1A
|
|
02982 GO TO S810-IO. DTSCS1A
|
|
02983 DTSCS1A
|
|
02984 S810-DELETE. DTSCS1A
|
|
02985 SET L810-DELETE-88 TO TRUE. DTSCS1A
|
|
02986 GO TO S810-IO. DTSCS1A
|
|
02987 DTSCS1A
|
|
02988 S810-READ-UPDATE. DTSCS1A
|
|
02989 SET L810-READ-UPDATE-88 TO TRUE. DTSCS1A
|
|
02990 GO TO S810-IO. DTSCS1A
|
|
02991 DTSCS1A
|
|
02992 S810-REWRITE-UPDATE. DTSCS1A
|
|
02993 SET L810-REWRITE-UPDATE-88 TO TRUE. DTSCS1A
|
|
02994 GO TO S810-IO. DTSCS1A
|
|
02995 DTSCS1A
|
|
02996 S810-IO. DTSCS1A
|
|
02997 DTSCS1A
|
|
02998 EXEC CICS LINK DTSCS1A
|
|
02999 PROGRAM ('DTSCU810') DTSCS1A
|
|
03000 COMMAREA (L810-COMM-AREA) DTSCS1A
|
|
03001 END-EXEC. DTSCS1A
|
|
03002 DTSCS1A
|
|
03003 IF L810-FILE-CLOSED-88 DTSCS1A
|
|
03004 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
03005 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS1A
|
|
03006 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS1A
|
|
03007 GO TO MAINLINE-EXIT. DTSCS1A
|
|
03008 S810-EXIT. DTSCS1A
|
|
03009 EXIT. DTSCS1A
|
|
03010 EJECT DTSCS1A
|
|
03011 S821-START-BROWSE. DTSCS1A
|
|
03012 SET L821-START-BROWSE-88 TO TRUE. DTSCS1A
|
|
03013 GO TO S821-I. DTSCS1A
|
|
03014 S821-READ-NEXT. DTSCS1A
|
|
03015 SET L821-READ-NEXT-88 TO TRUE. DTSCS1A
|
|
03016 GO TO S821-I. DTSCS1A
|
|
03017 DTSCS1A
|
|
03018 S821-END-BROWSE. DTSCS1A
|
|
03019 SET L821-END-BROWSE-88 TO TRUE. DTSCS1A
|
|
03020 GO TO S821-I. DTSCS1A
|
|
03021 DTSCS1A
|
|
03022 S821-I. DTSCS1A
|
|
03023 EXEC CICS LINK DTSCS1A
|
|
03024 PROGRAM ('DTSCU821') DTSCS1A
|
|
03025 COMMAREA (L821-COMM-AREA) DTSCS1A
|
|
03026 END-EXEC. DTSCS1A
|
|
03027 IF L821-FILE-CLOSED-88 DTSCS1A
|
|
03028 MOVE L821-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
03029 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS1A
|
|
03030 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS1A
|
|
03031 GO TO MAINLINE-EXIT. DTSCS1A
|
|
03032 S821-EXIT. DTSCS1A
|
|
03033 EXIT. DTSCS1A
|
|
03034 DTSCS1A
|
|
03035 S831-READ. DTSCS1A
|
|
03036 SET L831-READ-88 TO TRUE. DTSCS1A
|
|
03037 SKIP1 DTSCS1A
|
|
03038 EXEC CICS LINK DTSCS1A
|
|
03039 PROGRAM ('DTSCU831') DTSCS1A
|
|
03040 COMMAREA (L831-COMM-AREA) DTSCS1A
|
|
03041 END-EXEC. DTSCS1A
|
|
03042 SKIP1 DTSCS1A
|
|
03043 IF L831-FILE-CLOSED-88 DTSCS1A
|
|
03044 MOVE L831-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
03045 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS1A
|
|
03046 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS1A
|
|
03047 GO TO MAINLINE-EXIT. DTSCS1A
|
|
03048 S831-EXIT. DTSCS1A
|
|
03049 EXIT. DTSCS1A
|
|
03050 EJECT DTSCS1A
|
|
03051 S851-SCREEN-PROCESSING. DTSCS1A
|
|
03052 EXEC CICS LINK DTSCS1A
|
|
03053 PROGRAM ('DTSCU851') DTSCS1A
|
|
03054 COMMAREA (L851-COMM-AREA) DTSCS1A
|
|
03055 END-EXEC. DTSCS1A
|
|
03056 S851-EXIT. DTSCS1A
|
|
03057 EXIT. DTSCS1A
|
|
03058 SKIP3 DTSCS1A
|
|
03059 S899-ABEND. DTSCS1A
|
|
03060 EXEC CICS ABEND DTSCS1A
|
|
03061 ABCODE(WRK-ABEND-CD) DTSCS1A
|
|
03062 END-EXEC. DTSCS1A
|
|
03063 S899-EXIT. DTSCS1A
|
|
03064 EXIT. DTSCS1A
|
|
03065 /*****************************************************************DTSCS1A
|
|
03066 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS1A
|
|
03067 ******************************************************************DTSCS1A
|
|
03068 DTSCS1A
|
|
03069 S1000-SCREEN-EDITS. DTSCS1A
|
|
03070 MOVE LOW-VALUES TO MAP-CASS-CD. DTSCS1A
|
|
03071 DTSCS1A
|
|
03072 PERFORM S1100-EMP-NO THRU S1100-EXIT. DTSCS1A
|
|
03073 DTSCS1A
|
|
03074 IF LCCM-MSG DTSCS1A
|
|
03075 GO TO S1000-EXIT. DTSCS1A
|
|
03076 DTSCS1A
|
|
03077 DTSCS1A
|
|
03078 PERFORM S1010-READ-MERA THRU S1010-EXIT. DTSCS1A
|
|
03079 DTSCS1A
|
|
03080 PERFORM S1020-READ-MTAD THRU S1020-EXIT. DTSCS1A
|
|
03081 DTSCS1A
|
|
03082 PERFORM S1030-READ-MFAE THRU S1030-EXIT. DTSCS1A
|
|
03083 DTSCS1A
|
|
03084 DTSCS1A
|
|
03085 PERFORM S1200-DELETE-EMP THRU S1200-EXIT. DTSCS1A
|
|
03086 DTSCS1A
|
|
03087 PERFORM S1300-ELIGIBLE-CD THRU S1300-EXIT. DTSCS1A
|
|
03088 DTSCS1A
|
|
03089 PERFORM S1400-PRIMARY-NAME THRU S1400-EXIT. DTSCS1A
|
|
03090 DTSCS1A
|
|
03091 PERFORM S1410-ENTITY-IND THRU S1410-EXIT. DTSCS1A
|
|
03092 DTSCS1A
|
|
03093 PERFORM S1500-ENTITY-NAME THRU S1500-EXIT. DTSCS1A
|
|
03094 DTSCS1A
|
|
03095 PERFORM S1600-EDIT-ADDRESS THRU S1600-EXIT. DTSCS1A
|
|
03096 DTSCS1A
|
|
03097 PERFORM S1710-VOICE-1 THRU S1710-EXIT. DTSCS1A
|
|
03098 DTSCS1A
|
|
03099 PERFORM S1720-VOICE-2 THRU S1720-EXIT. DTSCS1A
|
|
03100 DTSCS1A
|
|
03101 PERFORM S1730-FAX THRU S1730-EXIT. DTSCS1A
|
|
03102 DTSCS1A
|
|
03103 PERFORM S1800-SOURCE-CD THRU S1800-EXIT. DTSCS1A
|
|
03104 DTSCS1A
|
|
03105 PERFORM S1900-FEIN THRU S1900-EXIT. DTSCS1A
|
|
03106 DTSCS1A
|
|
03107 PERFORM S1950-POT-HOUSEHOLD THRU S1950-EXIT. DTSCS1A
|
|
03108 DTSCS1A
|
|
03109 PERFORM S2000-CLAIMANT-SSN THRU S2000-EXIT. DTSCS1A
|
|
03110 DTSCS1A
|
|
03111 PERFORM S2010-CLAIMANT-NAME THRU S2010-EXIT. DTSCS1A
|
|
03112 DTSCS1A
|
|
03113 PERFORM S2100-POT-PRED-EMP-NO THRU S2100-EXIT. DTSCS1A
|
|
03114 DTSCS1A
|
|
03115 PERFORM S2200-RESPONSIBLE-OP-ID THRU S2200-EXIT. DTSCS1A
|
|
03116 DTSCS1A
|
|
03117 PERFORM S2300-NOTE THRU S2300-EXIT. DTSCS1A
|
|
03118 DTSCS1A
|
|
03119 PERFORM S2600-STATUS-CD THRU S2600-EXIT. DTSCS1A
|
|
03120 DTSCS1A
|
|
03121 PERFORM S2700-MAIL-DATE-1 THRU S2700-EXIT. DTSCS1A
|
|
03122 DTSCS1A
|
|
03123 PERFORM S2800-LETTER-1-CD THRU S2800-EXIT. DTSCS1A
|
|
03124 DTSCS1A
|
|
03125 PERFORM S2900-MAIL-DATE-2 THRU S2900-EXIT. DTSCS1A
|
|
03126 DTSCS1A
|
|
03127 PERFORM S3000-RECEIVED-DATE THRU S3000-EXIT. DTSCS1A
|
|
03128 DTSCS1A
|
|
03129 PERFORM S3100-COOP-AGENCY-REQ-DATE THRU S3100-EXIT. DTSCS1A
|
|
03130 DTSCS1A
|
|
03131 PERFORM S3200-DETER-NOTSUB-DATE THRU S3200-EXIT. DTSCS1A
|
|
03132 DTSCS1A
|
|
03133 PERFORM S3300-FIELD-ASSIGN-DATE THRU S3300-EXIT. DTSCS1A
|
|
03134 DTSCS1A
|
|
03135 PERFORM S4000-CHK-FOR-DC-ADDR THRU S4000-EXIT. DTSCS1A
|
|
03136 S1000-EXIT. DTSCS1A
|
|
03137 EXIT. DTSCS1A
|
|
03138 SKIP3 DTSCS1A
|
|
03139 S1001-EDIT-KEY. DTSCS1A
|
|
03140 PERFORM S1100-EMP-NO THRU S1100-EXIT. DTSCS1A
|
|
03141 S1001-EXIT. DTSCS1A
|
|
03142 EXIT. DTSCS1A
|
|
03143 SKIP3 DTSCS1A
|
|
03144 S1010-READ-MERA. DTSCS1A
|
|
03145 MOVE LOW-VALUES TO MERA-KEY-AREA. DTSCS1A
|
|
03146 DTSCS1A
|
|
03147 MOVE WRK-EMP-NO TO MERA-EMP-NO. DTSCS1A
|
|
03148 DTSCS1A
|
|
03149 SET MERA-ERA-88 TO TRUE. DTSCS1A
|
|
03150 DTSCS1A
|
|
03151 MOVE MERA-KEY-AREA TO MSKL-KEY-AREA. DTSCS1A
|
|
03152 DTSCS1A
|
|
03153 PERFORM S810-READ THRU S810-EXIT. DTSCS1A
|
|
03154 DTSCS1A
|
|
03155 IF L810-OK-88 DTSCS1A
|
|
03156 MOVE MSKL-REC TO MERA-REC DTSCS1A
|
|
03157 SET WRK-MERA-YES-88 TO TRUE. DTSCS1A
|
|
03158 S1010-EXIT. DTSCS1A
|
|
03159 EXIT. DTSCS1A
|
|
03160 SKIP3 DTSCS1A
|
|
03161 S1020-READ-MTAD. DTSCS1A
|
|
03162 MOVE LOW-VALUES TO MTAD-KEY-AREA. DTSCS1A
|
|
03163 DTSCS1A
|
|
03164 MOVE WRK-EMP-NO TO MTAD-EMP-NO. DTSCS1A
|
|
03165 DTSCS1A
|
|
03166 SET MTAD-TAD-88 TO TRUE. DTSCS1A
|
|
03167 DTSCS1A
|
|
03168 SET MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE. DTSCS1A
|
|
03169 DTSCS1A
|
|
03170 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSCS1A
|
|
03171 DTSCS1A
|
|
03172 PERFORM S810-READ THRU S810-EXIT. DTSCS1A
|
|
03173 DTSCS1A
|
|
03174 IF L810-OK-88 DTSCS1A
|
|
03175 MOVE MSKL-REC TO MTAD-REC DTSCS1A
|
|
03176 SET WRK-MTAD-YES-88 TO TRUE. DTSCS1A
|
|
03177 S1020-EXIT. DTSCS1A
|
|
03178 EXIT. DTSCS1A
|
|
03179 EJECT DTSCS1A
|
|
03180 S1030-READ-MFAE. DTSCS1A
|
|
03181 MOVE LOW-VALUES TO MFAE-KEY-AREA. DTSCS1A
|
|
03182 DTSCS1A
|
|
03183 MOVE WRK-EMP-NO TO MFAE-EMP-NO. DTSCS1A
|
|
03184 DTSCS1A
|
|
03185 SET MFAE-FAE-88 TO TRUE. DTSCS1A
|
|
03186 DTSCS1A
|
|
03187 SET MFAE-SERVICE-CORRESPOND-88 TO TRUE. DTSCS1A
|
|
03188 DTSCS1A
|
|
03189 MOVE MFAE-KEY-AREA TO MSKL-KEY-AREA. DTSCS1A
|
|
03190 DTSCS1A
|
|
03191 PERFORM S810-READ THRU S810-EXIT. DTSCS1A
|
|
03192 DTSCS1A
|
|
03193 IF L810-OK-88 DTSCS1A
|
|
03194 MOVE MSKL-REC TO MFAE-REC DTSCS1A
|
|
03195 SET WRK-MFAE-YES-88 TO TRUE. DTSCS1A
|
|
03196 S1030-EXIT. DTSCS1A
|
|
03197 EXIT. DTSCS1A
|
|
03198 EJECT DTSCS1A
|
|
03199 S1100-EMP-NO. DTSCS1A
|
|
03200 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS1A
|
|
03201 DTSCS1A
|
|
03202 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS1A
|
|
03203 DTSCS1A
|
|
03204 IF LCCM-F09-88 DTSCS1A
|
|
03205 PERFORM S1110-ADD THRU S1110-EXIT DTSCS1A
|
|
03206 GO TO S1100-EXIT. DTSCS1A
|
|
03207 DTSCS1A
|
|
03208 IF L018-NO-ENTRY DTSCS1A
|
|
03209 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS1A
|
|
03210 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS1A
|
|
03211 ELSE DTSCS1A
|
|
03212 IF L018-NOT-VALID DTSCS1A
|
|
03213 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A
|
|
03214 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS1A
|
|
03215 ELSE DTSCS1A
|
|
03216 MOVE L018-EMP-NO TO WRK-EMP-NO DTSCS1A
|
|
03217 IF ((WRK-EMP-NO >= CENO-FED-START-EMP-NO) DTSCS1A
|
|
03218 AND DTSCS1A
|
|
03219 (WRK-EMP-NO <= CENO-FED-END-EMP-NO)) DTSCS1A
|
|
03220 OR DTSCS1A
|
|
03221 ((WRK-EMP-NO >= CENO-CWC-START-EMP-NO) DTSCS1A
|
|
03222 AND DTSCS1A
|
|
03223 (WRK-EMP-NO <= CENO-CWC-END-EMP-NO)) DTSCS1A
|
|
03224 OR DTSCS1A
|
|
03225 ((WRK-EMP-NO >= CENO-NEW-CHG-ONLY-START-EMP-NO) DTSCS1A
|
|
03226 AND DTSCS1A
|
|
03227 (WRK-EMP-NO <= CENO-NEW-CHG-ONLY-END-EMP-NO)) DTSCS1A
|
|
03228 SET WRK-EMP-CHG-ONLY-88 TO TRUE. DTSCS1A
|
|
03229 S1100-EXIT. DTSCS1A
|
|
03230 EXIT. DTSCS1A
|
|
03231 SKIP3 DTSCS1A
|
|
03232 S1110-ADD. DTSCS1A
|
|
03233 IF L018-NO-ENTRY DTSCS1A
|
|
03234 NEXT SENTENCE DTSCS1A
|
|
03235 ELSE DTSCS1A
|
|
03236 IF L018-NOT-VALID DTSCS1A
|
|
03237 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A
|
|
03238 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS1A
|
|
03239 ELSE DTSCS1A
|
|
03240 MOVE L018-EMP-NO TO WRK-EMP-NO DTSCS1A
|
|
03241 IF ((WRK-EMP-NO >= CENO-FED-START-EMP-NO) DTSCS1A
|
|
03242 AND DTSCS1A
|
|
03243 (WRK-EMP-NO <= CENO-FED-END-EMP-NO)) DTSCS1A
|
|
03244 OR DTSCS1A
|
|
03245 ((WRK-EMP-NO >= CENO-CWC-START-EMP-NO) DTSCS1A
|
|
03246 AND DTSCS1A
|
|
03247 (WRK-EMP-NO <= CENO-CWC-END-EMP-NO)) DTSCS1A
|
|
03248 OR DTSCS1A
|
|
03249 ((WRK-EMP-NO >= CENO-NEW-CHG-ONLY-START-EMP-NO) DTSCS1A
|
|
03250 AND DTSCS1A
|
|
03251 (WRK-EMP-NO <= CENO-NEW-CHG-ONLY-END-EMP-NO)) DTSCS1A
|
|
03252 SET WRK-EMP-CHG-ONLY-88 TO TRUE DTSCS1A
|
|
03253 ELSE DTSCS1A
|
|
03254 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A
|
|
03255 PERFORM S1199-ERROR THRU S1199-EXIT. DTSCS1A
|
|
03256 S1110-EXIT. DTSCS1A
|
|
03257 EXIT. DTSCS1A
|
|
03258 SKIP3 DTSCS1A
|
|
03259 S1190-READ-MPRF. DTSCS1A
|
|
03260 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS1A
|
|
03261 DTSCS1A
|
|
03262 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS1A
|
|
03263 DTSCS1A
|
|
03264 SET MPRF-PRF-88 TO TRUE. DTSCS1A
|
|
03265 DTSCS1A
|
|
03266 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS1A
|
|
03267 DTSCS1A
|
|
03268 PERFORM S810-READ THRU S810-EXIT. DTSCS1A
|
|
03269 DTSCS1A
|
|
03270 IF L810-NO-REC-88 DTSCS1A
|
|
03271 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS1A
|
|
03272 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS1A
|
|
03273 ELSE DTSCS1A
|
|
03274 SET WRK-MPRF-YES-88 TO TRUE DTSCS1A
|
|
03275 MOVE MSKL-REC TO MPRF-REC DTSCS1A
|
|
03276 IF MPRF-CLASS-CHG-ONLY-88 DTSCS1A
|
|
03277 SET WRK-EMP-CHG-ONLY-88 TO TRUE. DTSCS1A
|
|
03278 S1190-EXIT. DTSCS1A
|
|
03279 EXIT. DTSCS1A
|
|
03280 SKIP3 DTSCS1A
|
|
03281 S1199-ERROR. DTSCS1A
|
|
03282 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS1A
|
|
03283 MAP-EMP-NO-2-A. DTSCS1A
|
|
03284 DTSCS1A
|
|
03285 IF LCCM-NO-MSG DTSCS1A
|
|
03286 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
03287 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L DTSCS1A
|
|
03288 SET CURSOR-SET-YES TO TRUE. DTSCS1A
|
|
03289 S1199-EXIT. DTSCS1A
|
|
03290 EXIT. DTSCS1A
|
|
03291 /*****************************************************************DTSCS1A
|
|
03292 * *DTSCS1A
|
|
03293 ******************************************************************DTSCS1A
|
|
03294 S1200-DELETE-EMP. DTSCS1A
|
|
03295 IF LCCM-F23-88 DTSCS1A
|
|
03296 NEXT SENTENCE DTSCS1A
|
|
03297 ELSE DTSCS1A
|
|
03298 MOVE SPACES TO MAP-DELETE-EMP-IND DTSCS1A
|
|
03299 GO TO S1200-EXIT. DTSCS1A
|
|
03300 DTSCS1A
|
|
03301 IF MAP-DELETE-EMP-IND = SPACES OR LOW-VALUES DTSCS1A
|
|
03302 SET MAP-DELETE-EMP-NO-88 TO TRUE. DTSCS1A
|
|
03303 DTSCS1A
|
|
03304 IF MAP-DELETE-EMP-VALID-88 DTSCS1A
|
|
03305 NEXT SENTENCE DTSCS1A
|
|
03306 ELSE DTSCS1A
|
|
03307 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A
|
|
03308 PERFORM S1201-ERROR THRU S1201-EXIT. DTSCS1A
|
|
03309 S1200-EXIT. EXIT. DTSCS1A
|
|
03310 DTSCS1A
|
|
03311 DTSCS1A
|
|
03312 DTSCS1A
|
|
03313 S1201-ERROR. DTSCS1A
|
|
03314 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-DELETE-EMP-IND-A. DTSCS1A
|
|
03315 DTSCS1A
|
|
03316 IF LCCM-NO-MSG DTSCS1A
|
|
03317 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
03318 MOVE CATB-CURSOR TO MAP-DELETE-EMP-IND-L DTSCS1A
|
|
03319 SET CURSOR-SET-YES TO TRUE. DTSCS1A
|
|
03320 S1201-EXIT. EXIT. DTSCS1A
|
|
03321 /*****************************************************************DTSCS1A
|
|
03322 * *DTSCS1A
|
|
03323 ******************************************************************DTSCS1A
|
|
03324 S1300-ELIGIBLE-CD. DTSCS1A
|
|
03325 IF MAP-ELIGIBLE-CD = LOW-VALUES DTSCS1A
|
|
03326 MOVE SPACES TO MAP-ELIGIBLE-CD. DTSCS1A
|
|
03327 DTSCS1A
|
|
03328 IF LCCM-F09-88 DTSCS1A
|
|
03329 NEXT SENTENCE DTSCS1A
|
|
03330 ELSE DTSCS1A
|
|
03331 MOVE SPACES TO MAP-ELIGIBLE-CD DTSCS1A
|
|
03332 GO TO S1300-EXIT. DTSCS1A
|
|
03333 DTSCS1A
|
|
03334 IF WRK-EMP-NO = +0 DTSCS1A
|
|
03335 IF MAP-ELIGIBLE-CD = SPACES DTSCS1A
|
|
03336 GO TO S1300-EXIT DTSCS1A
|
|
03337 ELSE DTSCS1A
|
|
03338 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS1A
|
|
03339 PERFORM S1399-ERROR THRU S1399-EXIT DTSCS1A
|
|
03340 GO TO S1300-EXIT. DTSCS1A
|
|
03341 DTSCS1A
|
|
03342 IF MAP-ELIGIBLE-CD = SPACES DTSCS1A
|
|
03343 NEXT SENTENCE DTSCS1A
|
|
03344 ELSE DTSCS1A
|
|
03345 SET L031-MPRF-ELIGIBLE-CD TO TRUE DTSCS1A
|
|
03346 MOVE MAP-ELIGIBLE-CD TO L031-CD-3 DTSCS1A
|
|
03347 PERFORM S031-REG-CODES THRU S031-EXIT DTSCS1A
|
|
03348 IF L031-VALID DTSCS1A
|
|
03349 NEXT SENTENCE DTSCS1A
|
|
03350 ELSE DTSCS1A
|
|
03351 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A
|
|
03352 PERFORM S1399-ERROR THRU S1399-EXIT DTSCS1A
|
|
03353 GO TO S1300-EXIT. DTSCS1A
|
|
03354 DTSCS1A
|
|
03355 IF (WRK-EMP-NO >= CENO-FED-START-EMP-NO) DTSCS1A
|
|
03356 AND DTSCS1A
|
|
03357 (WRK-EMP-NO <= CENO-FED-END-EMP-NO) DTSCS1A
|
|
03358 PERFORM S1310-FED-CHG-ONLY THRU S1310-EXIT DTSCS1A
|
|
03359 ELSE DTSCS1A
|
|
03360 IF (WRK-EMP-NO >= CENO-CWC-START-EMP-NO) DTSCS1A
|
|
03361 AND DTSCS1A
|
|
03362 (WRK-EMP-NO <= CENO-CWC-END-EMP-NO) DTSCS1A
|
|
03363 PERFORM S1320-CWC-CHG-ONLY THRU S1320-EXIT DTSCS1A
|
|
03364 ELSE DTSCS1A
|
|
03365 IF (WRK-EMP-NO >= CENO-NEW-CHG-ONLY-START-EMP-NO) DTSCS1A
|
|
03366 AND DTSCS1A
|
|
03367 (WRK-EMP-NO <= CENO-NEW-CHG-ONLY-END-EMP-NO) DTSCS1A
|
|
03368 PERFORM S1330-POOL-CHG-ONLY THRU S1330-EXIT DTSCS1A
|
|
03369 ELSE DTSCS1A
|
|
03370 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS1A
|
|
03371 PERFORM S1399-ERROR THRU S1399-EXIT. DTSCS1A
|
|
03372 S1300-EXIT. EXIT. DTSCS1A
|
|
03373 DTSCS1A
|
|
03374 DTSCS1A
|
|
03375 DTSCS1A
|
|
03376 S1310-FED-CHG-ONLY. DTSCS1A
|
|
03377 IF MAP-ELIGIBLE-CD = SPACES DTSCS1A
|
|
03378 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS1A
|
|
03379 PERFORM S1399-ERROR THRU S1399-EXIT DTSCS1A
|
|
03380 ELSE DTSCS1A
|
|
03381 IF MAP-ELIGIBLE-CD = '001' OR '002' DTSCS1A
|
|
03382 NEXT SENTENCE DTSCS1A
|
|
03383 ELSE DTSCS1A
|
|
03384 MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS1A
|
|
03385 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS1A
|
|
03386 PERFORM S1399-ERROR THRU S1399-EXIT. DTSCS1A
|
|
03387 S1310-EXIT. DTSCS1A
|
|
03388 EXIT. DTSCS1A
|
|
03389 DTSCS1A
|
|
03390 DTSCS1A
|
|
03391 DTSCS1A
|
|
03392 S1320-CWC-CHG-ONLY. DTSCS1A
|
|
03393 IF MAP-ELIGIBLE-CD = SPACES DTSCS1A
|
|
03394 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS1A
|
|
03395 PERFORM S1399-ERROR THRU S1399-EXIT DTSCS1A
|
|
03396 ELSE DTSCS1A
|
|
03397 IF MAP-ELIGIBLE-CD = '004' DTSCS1A
|
|
03398 NEXT SENTENCE DTSCS1A
|
|
03399 ELSE DTSCS1A
|
|
03400 MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS1A
|
|
03401 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS1A
|
|
03402 PERFORM S1399-ERROR THRU S1399-EXIT. DTSCS1A
|
|
03403 S1320-EXIT. DTSCS1A
|
|
03404 EXIT. DTSCS1A
|
|
03405 DTSCS1A
|
|
03406 DTSCS1A
|
|
03407 DTSCS1A
|
|
03408 S1330-POOL-CHG-ONLY. DTSCS1A
|
|
03409 IF MAP-ELIGIBLE-CD = SPACES DTSCS1A
|
|
03410 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS1A
|
|
03411 PERFORM S1399-ERROR THRU S1399-EXIT DTSCS1A
|
|
03412 ELSE DTSCS1A
|
|
03413 IF MAP-ELIGIBLE-CD = '005' OR '006' OR '007' OR '009' DTSCS1A
|
|
03414 OR '010' OR '015' OR '016' OR '017' DTSCS1A
|
|
03415 OR '018' OR '019' OR '020' OR '021' DTSCS1A
|
|
03416 OR '022' OR '023' OR '024' OR '025' DTSCS1A
|
|
03417 OR '026' OR '027' OR '028' OR '029' DTSCS1A
|
|
03418 OR '030' OR '032' OR '033' OR '034' DTSCS1A
|
|
03419 OR '035' OR '036' OR '037' OR '038' DTSCS1A
|
|
03420 OR '039' DTSCS1A
|
|
03421 NEXT SENTENCE DTSCS1A
|
|
03422 ELSE DTSCS1A
|
|
03423 MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS1A
|
|
03424 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS1A
|
|
03425 PERFORM S1399-ERROR THRU S1399-EXIT. DTSCS1A
|
|
03426 S1330-EXIT. DTSCS1A
|
|
03427 EXIT. DTSCS1A
|
|
03428 DTSCS1A
|
|
03429 DTSCS1A
|
|
03430 DTSCS1A
|
|
03431 S1399-ERROR. DTSCS1A
|
|
03432 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ELIGIBLE-CD-A. DTSCS1A
|
|
03433 DTSCS1A
|
|
03434 IF LCCM-NO-MSG DTSCS1A
|
|
03435 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
03436 MOVE CATB-CURSOR TO MAP-ELIGIBLE-CD-L DTSCS1A
|
|
03437 SET CURSOR-SET-YES TO TRUE. DTSCS1A
|
|
03438 S1399-EXIT. EXIT. DTSCS1A
|
|
03439 /*****************************************************************DTSCS1A
|
|
03440 * *DTSCS1A
|
|
03441 ******************************************************************DTSCS1A
|
|
03442 S1400-PRIMARY-NAME. DTSCS1A
|
|
03443 IF MAP-PRIMARY-NAME = LOW-VALUES OR SPACES DTSCS1A
|
|
03444 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS1A
|
|
03445 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS1A
|
|
03446 ELSE DTSCS1A
|
|
03447 IF MAP-PRIMARY-NAME (1:1) = LOW-VALUES OR SPACES DTSCS1A
|
|
03448 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A
|
|
03449 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS1A
|
|
03450 ELSE DTSCS1A
|
|
03451 IF NOT MAP-VERIFY-YES-88 DTSCS1A
|
|
03452 MOVE MAP-PRIMARY-NAME TO WRK-NAME DTSCS1A
|
|
03453 PERFORM S1550-CHECK-DUP-NAME THRU S1550-EXIT DTSCS1A
|
|
03454 IF WRK-MSG-ID = 'E1A6' DTSCS1A
|
|
03455 PERFORM S1402-ERROR THRU S1402-EXIT DTSCS1A
|
|
03456 END-IF DTSCS1A
|
|
03457 END-IF DTSCS1A
|
|
03458 END-IF DTSCS1A
|
|
03459 END-IF. DTSCS1A
|
|
03460 DTSCS1A
|
|
03461 S1400-EXIT. EXIT. DTSCS1A
|
|
03462 DTSCS1A
|
|
03463 DTSCS1A
|
|
03464 DTSCS1A
|
|
03465 S1401-ERROR. DTSCS1A
|
|
03466 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-PRIMARY-NAME-A. DTSCS1A
|
|
03467 DTSCS1A
|
|
03468 IF LCCM-NO-MSG DTSCS1A
|
|
03469 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
03470 MOVE CATB-CURSOR TO MAP-PRIMARY-NAME-L DTSCS1A
|
|
03471 SET CURSOR-SET-YES TO TRUE. DTSCS1A
|
|
03472 S1401-EXIT. EXIT. DTSCS1A
|
|
03473 DTSCS1A
|
|
03474 S1402-ERROR. DTSCS1A
|
|
03475 MOVE CATB-CURSOR TO MAP-VERIFY-L DTSCS1A
|
|
03476 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-VERIFY-A DTSCS1A
|
|
03477 MOVE CATB-ASKIP-BRT-MDTOFF TO MAP-VERIFY-LIT-A DTSCS1A
|
|
03478 MOVE 'VERIFY?' TO MAP-VERIFY-LIT DTSCS1A
|
|
03479 * MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-PRIMARY-NAME-A. DTSCS1A
|
|
03480 IF LCCM-NO-MSG DTSCS1A
|
|
03481 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
03482 MOVE CATB-CURSOR TO MAP-PRIMARY-NAME-L DTSCS1A
|
|
03483 SET CURSOR-SET-YES TO TRUE DTSCS1A
|
|
03484 * IF LCCM-OP-IS-FLD-DESK-88 DTSCS1A
|
|
03485 * OR LCCM-OP-IS-ACCOUNTING-DESK-88 DTSCS1A
|
|
03486 * MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-VERIFY-A DTSCS1A
|
|
03487 * MOVE CATB-ASKIP-BRT-MDTOFF TO MAP-VERIFY-LIT-A DTSCS1A
|
|
03488 * MOVE 'VERIFY?' TO MAP-VERIFY-LIT DTSCS1A
|
|
03489 END-IF. DTSCS1A
|
|
03490 S1402-EXIT. DTSCS1A
|
|
03491 EXIT. DTSCS1A
|
|
03492 DTSCS1A
|
|
03493 /*****************************************************************DTSCS1A
|
|
03494 * *DTSCS1A
|
|
03495 ******************************************************************DTSCS1A
|
|
03496 S1410-ENTITY-IND. DTSCS1A
|
|
03497 IF MAP-ENTITY-NAME-IND = LOW-VALUES OR SPACES DTSCS1A
|
|
03498 SET MAP-ENTITY-NAME-NO-88 TO TRUE. DTSCS1A
|
|
03499 DTSCS1A
|
|
03500 IF MAP-ENTITY-NAME-VALID-88 DTSCS1A
|
|
03501 NEXT SENTENCE DTSCS1A
|
|
03502 ELSE DTSCS1A
|
|
03503 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A
|
|
03504 PERFORM S1411-ERROR THRU S1411-EXIT. DTSCS1A
|
|
03505 S1410-EXIT. EXIT. DTSCS1A
|
|
03506 DTSCS1A
|
|
03507 DTSCS1A
|
|
03508 DTSCS1A
|
|
03509 S1411-ERROR. DTSCS1A
|
|
03510 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ENTITY-NAME-IND-A. DTSCS1A
|
|
03511 DTSCS1A
|
|
03512 IF LCCM-NO-MSG DTSCS1A
|
|
03513 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
03514 MOVE CATB-CURSOR TO MAP-ENTITY-NAME-IND-L DTSCS1A
|
|
03515 SET CURSOR-SET-YES TO TRUE. DTSCS1A
|
|
03516 S1411-EXIT. EXIT. DTSCS1A
|
|
03517 /*****************************************************************DTSCS1A
|
|
03518 * *DTSCS1A
|
|
03519 ******************************************************************DTSCS1A
|
|
03520 S1500-ENTITY-NAME. DTSCS1A
|
|
03521 IF MAP-ENTITY-NAME = LOW-VALUES OR SPACES DTSCS1A
|
|
03522 MOVE SPACES TO MAP-ENTITY-NAME DTSCS1A
|
|
03523 GO TO S1500-EXIT. DTSCS1A
|
|
03524 DTSCS1A
|
|
03525 IF MAP-ENTITY-NAME-YES-88 DTSCS1A
|
|
03526 IF MAP-ENTITY-NAME > SPACES DTSCS1A
|
|
03527 MOVE MSG-E1A2-AREA TO WRK-MSG-AREA DTSCS1A
|
|
03528 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS1A
|
|
03529 ELSE DTSCS1A
|
|
03530 GO TO S1500-EXIT DTSCS1A
|
|
03531 ELSE DTSCS1A
|
|
03532 IF MAP-PRIMARY-NAME = MAP-ENTITY-NAME DTSCS1A
|
|
03533 MOVE MSG-E1A3-AREA TO WRK-MSG-AREA DTSCS1A
|
|
03534 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS1A
|
|
03535 GO TO S1500-EXIT. DTSCS1A
|
|
03536 DTSCS1A
|
|
03537 IF MAP-ENTITY-NAME (1:1) = LOW-VALUES OR SPACES DTSCS1A
|
|
03538 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A
|
|
03539 PERFORM S1501-ERROR THRU S1501-EXIT. DTSCS1A
|
|
03540 DTSCS1A
|
|
03541 IF NOT MAP-VERIFY-YES-88 DTSCS1A
|
|
03542 MOVE MAP-ENTITY-NAME TO WRK-NAME DTSCS1A
|
|
03543 PERFORM S1550-CHECK-DUP-NAME THRU S1550-EXIT DTSCS1A
|
|
03544 IF WRK-MSG-ID = 'E1A6' DTSCS1A
|
|
03545 PERFORM S1502-ERROR THRU S1502-EXIT DTSCS1A
|
|
03546 END-IF DTSCS1A
|
|
03547 END-IF. DTSCS1A
|
|
03548 S1500-EXIT. EXIT. DTSCS1A
|
|
03549 DTSCS1A
|
|
03550 S1501-ERROR. DTSCS1A
|
|
03551 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ENTITY-NAME-A. DTSCS1A
|
|
03552 DTSCS1A
|
|
03553 IF LCCM-NO-MSG DTSCS1A
|
|
03554 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
03555 MOVE CATB-CURSOR TO MAP-ENTITY-NAME-L DTSCS1A
|
|
03556 SET CURSOR-SET-YES TO TRUE. DTSCS1A
|
|
03557 S1501-EXIT. EXIT. DTSCS1A
|
|
03558 DTSCS1A
|
|
03559 S1502-ERROR. DTSCS1A
|
|
03560 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ENTITY-NAME-A. DTSCS1A
|
|
03561 IF LCCM-NO-MSG DTSCS1A
|
|
03562 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
03563 MOVE CATB-CURSOR TO MAP-ENTITY-NAME-L DTSCS1A
|
|
03564 SET CURSOR-SET-YES TO TRUE DTSCS1A
|
|
03565 * IF LCCM-OP-IS-FLD-DESK-88 DTSCS1A
|
|
03566 * OR LCCM-OP-IS-ACCOUNTING-DESK-88 DTSCS1A
|
|
03567 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-VERIFY-A DTSCS1A
|
|
03568 MOVE CATB-ASKIP-BRT-MDTOFF TO MAP-VERIFY-LIT-A DTSCS1A
|
|
03569 MOVE 'VERIFY?' TO MAP-VERIFY-LIT DTSCS1A
|
|
03570 END-IF. DTSCS1A
|
|
03571 S1502-EXIT. DTSCS1A
|
|
03572 EXIT. DTSCS1A
|
|
03573 DTSCS1A
|
|
03574 S1550-CHECK-DUP-NAME. DTSCS1A
|
|
03575 MOVE LOW-VALUES TO IBTB-REC. DTSCS1A
|
|
03576 SET IBTB-BTB-88 TO TRUE. DTSCS1A
|
|
03577 MOVE WRK-NAME TO IBTB-NAME. DTSCS1A
|
|
03578 MOVE IBTB-KEY-AREA TO ISKL-KEY-AREA. DTSCS1A
|
|
03579 PERFORM S821-START-BROWSE THRU S821-EXIT. DTSCS1A
|
|
03580 IF L821-NO-REC-88 DTSCS1A
|
|
03581 NEXT SENTENCE DTSCS1A
|
|
03582 ELSE DTSCS1A
|
|
03583 IF ISKL-BTB-88 DTSCS1A
|
|
03584 MOVE ISKL-REC TO IBTB-REC DTSCS1A
|
|
03585 PERFORM S1551-VERIFY-DUP THRU S1551-EXIT DTSCS1A
|
|
03586 END-IF DTSCS1A
|
|
03587 END-IF. DTSCS1A
|
|
03588 PERFORM S821-END-BROWSE THRU S821-EXIT. DTSCS1A
|
|
03589 S1550-EXIT. DTSCS1A
|
|
03590 EXIT. DTSCS1A
|
|
03591 DTSCS1A
|
|
03592 S1551-VERIFY-DUP. DTSCS1A
|
|
03593 IF (IBTB-NAME = WRK-NAME DTSCS1A
|
|
03594 AND IBTB-EMP-NO NOT = WRK-EMP-NO) DTSCS1A
|
|
03595 NEXT SENTENCE DTSCS1A
|
|
03596 ELSE DTSCS1A
|
|
03597 GO TO S1551-EXIT DTSCS1A
|
|
03598 END-IF. DTSCS1A
|
|
03599 DTSCS1A
|
|
03600 IF WRK-MPRF-YES-88 DTSCS1A
|
|
03601 MOVE MPRF-EMP-NO TO WRK-HOLD-EMP-NO DTSCS1A
|
|
03602 END-IF. DTSCS1A
|
|
03603 DTSCS1A
|
|
03604 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS1A
|
|
03605 MOVE IBTB-EMP-NO TO MPRF-EMP-NO. DTSCS1A
|
|
03606 SET MPRF-PRF-88 TO TRUE. DTSCS1A
|
|
03607 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS1A
|
|
03608 DTSCS1A
|
|
03609 PERFORM S810-READ THRU S810-EXIT. DTSCS1A
|
|
03610 IF L810-OK-88 DTSCS1A
|
|
03611 MOVE MSKL-REC TO MPRF-REC DTSCS1A
|
|
03612 IF MPRF-STATUS-ACT-88 DTSCS1A
|
|
03613 MOVE MSG-E1A6-AREA TO WRK-MSG-AREA DTSCS1A
|
|
03614 END-IF DTSCS1A
|
|
03615 END-IF. DTSCS1A
|
|
03616 DTSCS1A
|
|
03617 IF WRK-MPRF-YES-88 DTSCS1A
|
|
03618 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS1A
|
|
03619 MOVE WRK-HOLD-EMP-NO TO MPRF-EMP-NO. DTSCS1A
|
|
03620 SET MPRF-PRF-88 TO TRUE. DTSCS1A
|
|
03621 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS1A
|
|
03622 DTSCS1A
|
|
03623 PERFORM S810-READ THRU S810-EXIT. DTSCS1A
|
|
03624 IF L810-OK-88 DTSCS1A
|
|
03625 MOVE MSKL-REC TO MPRF-REC DTSCS1A
|
|
03626 END-IF. DTSCS1A
|
|
03627 DTSCS1A
|
|
03628 S1551-EXIT. DTSCS1A
|
|
03629 EXIT. DTSCS1A
|
|
03630 DTSCS1A
|
|
03631 /*****************************************************************DTSCS1A
|
|
03632 * *DTSCS1A
|
|
03633 ******************************************************************DTSCS1A
|
|
03634 S1600-EDIT-ADDRESS. DTSCS1A
|
|
03635 DTSCS1A
|
|
03636 PERFORM S1610-EDIT-FISCAL-AGENT THRU S1610-EXIT. DTSCS1A
|
|
03637 DTSCS1A
|
|
03638 IF WRK-FISC-AGNT-ERROR-YES-88 DTSCS1A
|
|
03639 GO TO S1600-EXIT. DTSCS1A
|
|
03640 DTSCS1A
|
|
03641 IF MAP-ATTN-LINE = SPACES OR LOW-VALUES DTSCS1A
|
|
03642 MOVE SPACES TO MAP-ATTN-LINE. DTSCS1A
|
|
03643 DTSCS1A
|
|
03644 IF MAP-DELIV-LINE-1 = SPACES OR LOW-VALUES DTSCS1A
|
|
03645 MOVE SPACES TO MAP-DELIV-LINE-1. DTSCS1A
|
|
03646 DTSCS1A
|
|
03647 IF MAP-DELIV-LINE-2 = SPACES OR LOW-VALUES DTSCS1A
|
|
03648 MOVE SPACES TO MAP-DELIV-LINE-2. DTSCS1A
|
|
03649 DTSCS1A
|
|
03650 IF MAP-CASS-IND = SPACES OR LOW-VALUES DTSCS1A
|
|
03651 MOVE SPACES TO MAP-CASS-IND. DTSCS1A
|
|
03652 DTSCS1A
|
|
03653 IF MAP-CITY = SPACES OR LOW-VALUES DTSCS1A
|
|
03654 MOVE SPACES TO MAP-CITY. DTSCS1A
|
|
03655 DTSCS1A
|
|
03656 IF MAP-ST = SPACES OR LOW-VALUES DTSCS1A
|
|
03657 MOVE SPACES TO MAP-ST. DTSCS1A
|
|
03658 DTSCS1A
|
|
03659 IF MAP-ZIP = SPACES OR LOW-VALUES DTSCS1A
|
|
03660 MOVE SPACES TO MAP-ZIP. DTSCS1A
|
|
03661 DTSCS1A
|
|
03662 DTSCS1A
|
|
03663 MOVE MAP-CASS-IND TO L072-CASS-IND. DTSCS1A
|
|
03664 DTSCS1A
|
|
03665 SET L072-MTAD-88 TO TRUE. DTSCS1A
|
|
03666 DTSCS1A
|
|
03667 MOVE MAP-PRIMARY-NAME TO L072-NAME. DTSCS1A
|
|
03668 DTSCS1A
|
|
03669 MOVE SPACES TO L072-ADDRESS. DTSCS1A
|
|
03670 DTSCS1A
|
|
03671 MOVE MAP-ATTN-LINE TO L072-ATTN-LINE. DTSCS1A
|
|
03672 DTSCS1A
|
|
03673 MOVE MAP-DELIV-LINE-1 TO L072-DELIV-LINE-1. DTSCS1A
|
|
03674 DTSCS1A
|
|
03675 MOVE MAP-DELIV-LINE-2 TO L072-DELIV-LINE-2. DTSCS1A
|
|
03676 DTSCS1A
|
|
03677 MOVE MAP-CITY TO L072-CITY. DTSCS1A
|
|
03678 DTSCS1A
|
|
03679 MOVE MAP-ST TO L072-ST. DTSCS1A
|
|
03680 DTSCS1A
|
|
03681 MOVE MAP-ZIP TO L072-ZIP. DTSCS1A
|
|
03682 DTSCS1A
|
|
03683 DTSCS1A
|
|
03684 IF (WRK-MTAD-YES-88) DTSCS1A
|
|
03685 AND DTSCS1A
|
|
03686 (L072-ATTN-LINE = MTAD-ATTN-LINE) DTSCS1A
|
|
03687 AND DTSCS1A
|
|
03688 (L072-DELIV-LINE-1 = MTAD-DELIV-LINE-1) DTSCS1A
|
|
03689 AND DTSCS1A
|
|
03690 (L072-DELIV-LINE-2 = MTAD-DELIV-LINE-2) DTSCS1A
|
|
03691 AND DTSCS1A
|
|
03692 (L072-CITY = MTAD-CITY) DTSCS1A
|
|
03693 AND DTSCS1A
|
|
03694 (L072-ST = MTAD-ST) DTSCS1A
|
|
03695 AND DTSCS1A
|
|
03696 (L072-ZIP = MTAD-ZIP) DTSCS1A
|
|
03697 MOVE MTAD-ADVANCED-BARCODE TO L072-ADVANCED-BARCODE DTSCS1A
|
|
03698 MOVE L072-ADDRESS TO LCCM-HOLD-ADDRESS-1 DTSCS1A
|
|
03699 GO TO S1600-EXIT. DTSCS1A
|
|
03700 DTSCS1A
|
|
03701 DTSCS1A
|
|
03702 PERFORM S072-ADDRESS-EDIT THRU S072-EXIT. DTSCS1A
|
|
03703 DTSCS1A
|
|
03704 DTSCS1A
|
|
03705 MOVE L072-CASS-IND TO MAP-CASS-IND. DTSCS1A
|
|
03706 DTSCS1A
|
|
03707 MOVE L072-CASS-RETURN-CODES TO MAP-CASS-CD. DTSCS1A
|
|
03708 DTSCS1A
|
|
03709 MOVE L072-ADDRESS TO LCCM-HOLD-ADDRESS-1. DTSCS1A
|
|
03710 DTSCS1A
|
|
03711 IF L072-ATTN-LINE-NOT-VALID-88 DTSCS1A
|
|
03712 PERFORM S1691-ERROR THRU S1691-EXIT DTSCS1A
|
|
03713 ELSE DTSCS1A
|
|
03714 MOVE L072-ATTN-LINE TO MAP-ATTN-LINE DTSCS1A
|
|
03715 IF L072-ATTN-LINE-CHANGED-88 DTSCS1A
|
|
03716 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ATTN-LINE-A. DTSCS1A
|
|
03717 DTSCS1A
|
|
03718 IF L072-DELIV-LINE-1-NOT-VALID-88 DTSCS1A
|
|
03719 PERFORM S1692-ERROR THRU S1692-EXIT DTSCS1A
|
|
03720 ELSE DTSCS1A
|
|
03721 MOVE L072-DELIV-LINE-1 TO MAP-DELIV-LINE-1 DTSCS1A
|
|
03722 IF L072-DELIV-LINE-1-CHANGED-88 DTSCS1A
|
|
03723 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-DELIV-LINE-1-A.DTSCS1A
|
|
03724 DTSCS1A
|
|
03725 IF L072-DELIV-LINE-2-NOT-VALID-88 DTSCS1A
|
|
03726 PERFORM S1693-ERROR THRU S1693-EXIT DTSCS1A
|
|
03727 ELSE DTSCS1A
|
|
03728 MOVE L072-DELIV-LINE-2 TO MAP-DELIV-LINE-2 DTSCS1A
|
|
03729 IF L072-DELIV-LINE-2-CHANGED-88 DTSCS1A
|
|
03730 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-DELIV-LINE-2-A.DTSCS1A
|
|
03731 DTSCS1A
|
|
03732 IF L072-CITY-NOT-VALID-88 DTSCS1A
|
|
03733 PERFORM S1694-ERROR THRU S1694-EXIT DTSCS1A
|
|
03734 ELSE DTSCS1A
|
|
03735 MOVE L072-CITY TO MAP-CITY DTSCS1A
|
|
03736 IF L072-CITY-CHANGED-88 DTSCS1A
|
|
03737 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-CITY-A. DTSCS1A
|
|
03738 DTSCS1A
|
|
03739 IF L072-ST-NOT-VALID-88 DTSCS1A
|
|
03740 PERFORM S1695-ERROR THRU S1695-EXIT DTSCS1A
|
|
03741 ELSE DTSCS1A
|
|
03742 MOVE L072-ST TO MAP-ST DTSCS1A
|
|
03743 IF L072-ST-CHANGED-88 DTSCS1A
|
|
03744 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ST-A. DTSCS1A
|
|
03745 DTSCS1A
|
|
03746 IF L072-ZIP-NOT-VALID-88 DTSCS1A
|
|
03747 PERFORM S1696-ERROR THRU S1696-EXIT DTSCS1A
|
|
03748 ELSE DTSCS1A
|
|
03749 MOVE L072-ZIP TO MAP-ZIP DTSCS1A
|
|
03750 IF L072-ZIP-CHANGED-88 DTSCS1A
|
|
03751 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ZIP-A. DTSCS1A
|
|
03752 DTSCS1A
|
|
03753 IF L072-ADDRESS-NOT-VALID-88 DTSCS1A
|
|
03754 IF LCCM-NO-MSG DTSCS1A
|
|
03755 PERFORM S1691-ERROR THRU S1691-EXIT. DTSCS1A
|
|
03756 S1600-EXIT. EXIT. DTSCS1A
|
|
03757 SKIP3 DTSCS1A
|
|
03758 S1610-EDIT-FISCAL-AGENT. DTSCS1A
|
|
03759 SET WRK-FISC-AGNT-ERROR-NO-88 TO TRUE. DTSCS1A
|
|
03760 DTSCS1A
|
|
03761 IF WRK-MFAE-YES-88 DTSCS1A
|
|
03762 MOVE MFAE-FISCAL-AGENT-CD TO MAP-FISC-AGNT-CD DTSCS1A
|
|
03763 END-IF. DTSCS1A
|
|
03764 DTSCS1A
|
|
03765 IF MAP-FISC-AGNT-CD = LOW-VALUE OR DTSCS1A
|
|
03766 MAP-FISC-AGNT-CD = SPACES DTSCS1A
|
|
03767 GO TO S1610-EXIT DTSCS1A
|
|
03768 END-IF. DTSCS1A
|
|
03769 DTSCS1A
|
|
03770 IF LCCM-F09-88 DTSCS1A
|
|
03771 NEXT SENTENCE DTSCS1A
|
|
03772 ELSE DTSCS1A
|
|
03773 GO TO S1610-EXIT. DTSCS1A
|
|
03774 DTSCS1A
|
|
03775 MOVE LOW-VALUES TO FFIS-KEY-AREA. DTSCS1A
|
|
03776 MOVE MAP-FISC-AGNT-CD TO FFIS-FISCAL-AGENT-CD. DTSCS1A
|
|
03777 SET FFIS-SERVICE-CORRESPOND-88 TO TRUE. DTSCS1A
|
|
03778 SET FFIS-FIS-88 TO TRUE. DTSCS1A
|
|
03779 MOVE FFIS-KEY-AREA TO FSKL-KEY-AREA. DTSCS1A
|
|
03780 DTSCS1A
|
|
03781 PERFORM S831-READ THRU S831-EXIT. DTSCS1A
|
|
03782 DTSCS1A
|
|
03783 IF NOT L831-OK-88 DTSCS1A
|
|
03784 SET WRK-FISC-AGNT-ERROR-YES-88 TO TRUE DTSCS1A
|
|
03785 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A
|
|
03786 PERFORM S1611-ERROR THRU S1611-EXIT DTSCS1A
|
|
03787 GO TO S1610-EXIT DTSCS1A
|
|
03788 ELSE DTSCS1A
|
|
03789 MOVE FSKL-REC TO FFIS-REC DTSCS1A
|
|
03790 END-IF. DTSCS1A
|
|
03791 DTSCS1A
|
|
03792 MOVE FFIS-ATTN-LINE TO MAP-ATTN-LINE. DTSCS1A
|
|
03793 MOVE FFIS-DELIV-LINE-1 TO MAP-DELIV-LINE-1. DTSCS1A
|
|
03794 MOVE FFIS-DELIV-LINE-2 TO MAP-DELIV-LINE-2. DTSCS1A
|
|
03795 MOVE FFIS-CITY TO MAP-CITY. DTSCS1A
|
|
03796 MOVE FFIS-ST TO MAP-ST. DTSCS1A
|
|
03797 MOVE FFIS-ZIP TO MAP-ZIP. DTSCS1A
|
|
03798 DTSCS1A
|
|
03799 IF FFIS-BUSINESS-VOICE NOT = SPACES DTSCS1A
|
|
03800 MOVE FFIS-BUSINESS-VOICE-AREA-CD TO MAP-VOICE-1-AREA-CD DTSCS1A
|
|
03801 MOVE FFIS-BUSINESS-VOICE-PREFIX TO MAP-VOICE-1-PREFIX DTSCS1A
|
|
03802 MOVE FFIS-BUSINESS-VOICE-SUFFIX TO MAP-VOICE-1-SUFFIX DTSCS1A
|
|
03803 MOVE FFIS-BUSINESS-VOICE-EXT TO MAP-VOICE-1-EXT. DTSCS1A
|
|
03804 DTSCS1A
|
|
03805 DTSCS1A
|
|
03806 S1610-EXIT. DTSCS1A
|
|
03807 EXIT. DTSCS1A
|
|
03808 S1611-ERROR. DTSCS1A
|
|
03809 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-FISC-AGNT-CD-A. DTSCS1A
|
|
03810 DTSCS1A
|
|
03811 IF LCCM-NO-MSG DTSCS1A
|
|
03812 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
03813 MOVE CATB-CURSOR TO MAP-FISC-AGNT-CD-L DTSCS1A
|
|
03814 SET CURSOR-SET-YES TO TRUE. DTSCS1A
|
|
03815 S1611-EXIT. DTSCS1A
|
|
03816 EXIT. DTSCS1A
|
|
03817 SKIP3 DTSCS1A
|
|
03818 S1691-ERROR. DTSCS1A
|
|
03819 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ATTN-LINE-A. DTSCS1A
|
|
03820 DTSCS1A
|
|
03821 IF LCCM-NO-MSG DTSCS1A
|
|
03822 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
03823 MOVE CATB-CURSOR TO MAP-ATTN-LINE-L DTSCS1A
|
|
03824 SET CURSOR-SET-YES TO TRUE. DTSCS1A
|
|
03825 S1691-EXIT. DTSCS1A
|
|
03826 EXIT. DTSCS1A
|
|
03827 SKIP3 DTSCS1A
|
|
03828 S1692-ERROR. DTSCS1A
|
|
03829 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-DELIV-LINE-1-A. DTSCS1A
|
|
03830 DTSCS1A
|
|
03831 IF LCCM-NO-MSG DTSCS1A
|
|
03832 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
03833 MOVE CATB-CURSOR TO MAP-DELIV-LINE-1-L DTSCS1A
|
|
03834 SET CURSOR-SET-YES TO TRUE. DTSCS1A
|
|
03835 S1692-EXIT. DTSCS1A
|
|
03836 EXIT. DTSCS1A
|
|
03837 SKIP3 DTSCS1A
|
|
03838 S1693-ERROR. DTSCS1A
|
|
03839 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-DELIV-LINE-2-A. DTSCS1A
|
|
03840 DTSCS1A
|
|
03841 IF LCCM-NO-MSG DTSCS1A
|
|
03842 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
03843 MOVE CATB-CURSOR TO MAP-DELIV-LINE-2-L DTSCS1A
|
|
03844 SET CURSOR-SET-YES TO TRUE. DTSCS1A
|
|
03845 S1693-EXIT. DTSCS1A
|
|
03846 EXIT. DTSCS1A
|
|
03847 SKIP3 DTSCS1A
|
|
03848 S1694-ERROR. DTSCS1A
|
|
03849 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-CITY-A. DTSCS1A
|
|
03850 DTSCS1A
|
|
03851 IF LCCM-NO-MSG DTSCS1A
|
|
03852 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
03853 MOVE CATB-CURSOR TO MAP-CITY-L DTSCS1A
|
|
03854 SET CURSOR-SET-YES TO TRUE. DTSCS1A
|
|
03855 S1694-EXIT. DTSCS1A
|
|
03856 EXIT. DTSCS1A
|
|
03857 SKIP3 DTSCS1A
|
|
03858 S1695-ERROR. DTSCS1A
|
|
03859 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ST-A. DTSCS1A
|
|
03860 DTSCS1A
|
|
03861 IF LCCM-NO-MSG DTSCS1A
|
|
03862 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
03863 MOVE CATB-CURSOR TO MAP-ST-L DTSCS1A
|
|
03864 SET CURSOR-SET-YES TO TRUE. DTSCS1A
|
|
03865 S1695-EXIT. DTSCS1A
|
|
03866 EXIT. DTSCS1A
|
|
03867 SKIP3 DTSCS1A
|
|
03868 S1696-ERROR. DTSCS1A
|
|
03869 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ZIP-A. DTSCS1A
|
|
03870 DTSCS1A
|
|
03871 IF LCCM-NO-MSG DTSCS1A
|
|
03872 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
03873 MOVE CATB-CURSOR TO MAP-ZIP-L DTSCS1A
|
|
03874 SET CURSOR-SET-YES TO TRUE. DTSCS1A
|
|
03875 S1696-EXIT. DTSCS1A
|
|
03876 EXIT. DTSCS1A
|
|
03877 /*****************************************************************DTSCS1A
|
|
03878 * *DTSCS1A
|
|
03879 ******************************************************************DTSCS1A
|
|
03880 S1710-VOICE-1. DTSCS1A
|
|
03881 MOVE MAP-VOICE-1-AREA TO L021-S-TNO-AREA. DTSCS1A
|
|
03882 DTSCS1A
|
|
03883 PERFORM S021-TELNO-FROM-SCREEN THRU S021-EXIT. DTSCS1A
|
|
03884 DTSCS1A
|
|
03885 IF L021-NOT-VALID DTSCS1A
|
|
03886 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A
|
|
03887 PERFORM S1711-ERROR THRU S1711-EXIT DTSCS1A
|
|
03888 ELSE DTSCS1A
|
|
03889 IF L021-VALID DTSCS1A
|
|
03890 MOVE L021-TNO TO L073-TELEPHONE DTSCS1A
|
|
03891 MOVE MAP-ST TO L073-ST DTSCS1A
|
|
03892 MOVE MAP-ZIP TO L073-ZIP DTSCS1A
|
|
03893 PERFORM S073-TELNO-EDIT THRU S073-EXIT DTSCS1A
|
|
03894 IF L073-NOT-VALID DTSCS1A
|
|
03895 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A
|
|
03896 PERFORM S1711-ERROR THRU S1711-EXIT DTSCS1A
|
|
03897 ELSE DTSCS1A
|
|
03898 MOVE L073-AREA-CD TO MAP-VOICE-1-AREA-CD DTSCS1A
|
|
03899 MOVE L073-PREFIX TO MAP-VOICE-1-PREFIX DTSCS1A
|
|
03900 MOVE L073-SUFFIX TO MAP-VOICE-1-SUFFIX DTSCS1A
|
|
03901 MOVE L073-EXT TO MAP-VOICE-1-EXT. DTSCS1A
|
|
03902 S1710-EXIT. EXIT. DTSCS1A
|
|
03903 DTSCS1A
|
|
03904 DTSCS1A
|
|
03905 DTSCS1A
|
|
03906 S1711-ERROR. DTSCS1A
|
|
03907 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-VOICE-1-AREA-CD-A DTSCS1A
|
|
03908 MAP-VOICE-1-PREFIX-A DTSCS1A
|
|
03909 MAP-VOICE-1-SUFFIX-A DTSCS1A
|
|
03910 MAP-VOICE-1-EXT-A. DTSCS1A
|
|
03911 DTSCS1A
|
|
03912 IF LCCM-NO-MSG DTSCS1A
|
|
03913 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
03914 MOVE CATB-CURSOR TO MAP-VOICE-1-AREA-CD-L DTSCS1A
|
|
03915 SET CURSOR-SET-YES TO TRUE. DTSCS1A
|
|
03916 S1711-EXIT. EXIT. DTSCS1A
|
|
03917 /*****************************************************************DTSCS1A
|
|
03918 * *DTSCS1A
|
|
03919 ******************************************************************DTSCS1A
|
|
03920 S1720-VOICE-2. DTSCS1A
|
|
03921 MOVE MAP-VOICE-2-AREA TO L021-S-TNO-AREA. DTSCS1A
|
|
03922 DTSCS1A
|
|
03923 PERFORM S021-TELNO-FROM-SCREEN THRU S021-EXIT. DTSCS1A
|
|
03924 DTSCS1A
|
|
03925 IF L021-NOT-VALID DTSCS1A
|
|
03926 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A
|
|
03927 PERFORM S1721-ERROR THRU S1721-EXIT DTSCS1A
|
|
03928 ELSE DTSCS1A
|
|
03929 IF L021-VALID DTSCS1A
|
|
03930 MOVE L021-TNO TO L073-TELEPHONE DTSCS1A
|
|
03931 MOVE MAP-ST TO L073-ST DTSCS1A
|
|
03932 MOVE MAP-ZIP TO L073-ZIP DTSCS1A
|
|
03933 PERFORM S073-TELNO-EDIT THRU S073-EXIT DTSCS1A
|
|
03934 IF L073-NOT-VALID DTSCS1A
|
|
03935 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A
|
|
03936 PERFORM S1721-ERROR THRU S1721-EXIT DTSCS1A
|
|
03937 ELSE DTSCS1A
|
|
03938 MOVE L073-AREA-CD TO MAP-VOICE-2-AREA-CD DTSCS1A
|
|
03939 MOVE L073-PREFIX TO MAP-VOICE-2-PREFIX DTSCS1A
|
|
03940 MOVE L073-SUFFIX TO MAP-VOICE-2-SUFFIX DTSCS1A
|
|
03941 MOVE L073-EXT TO MAP-VOICE-2-EXT. DTSCS1A
|
|
03942 S1720-EXIT. EXIT. DTSCS1A
|
|
03943 DTSCS1A
|
|
03944 DTSCS1A
|
|
03945 DTSCS1A
|
|
03946 S1721-ERROR. DTSCS1A
|
|
03947 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-VOICE-2-AREA-CD-A DTSCS1A
|
|
03948 MAP-VOICE-2-PREFIX-A DTSCS1A
|
|
03949 MAP-VOICE-2-SUFFIX-A DTSCS1A
|
|
03950 MAP-VOICE-2-EXT-A. DTSCS1A
|
|
03951 IF LCCM-NO-MSG DTSCS1A
|
|
03952 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
03953 MOVE CATB-CURSOR TO MAP-VOICE-2-AREA-CD-L DTSCS1A
|
|
03954 SET CURSOR-SET-YES TO TRUE. DTSCS1A
|
|
03955 S1721-EXIT. EXIT. DTSCS1A
|
|
03956 /*****************************************************************DTSCS1A
|
|
03957 * *DTSCS1A
|
|
03958 ******************************************************************DTSCS1A
|
|
03959 S1730-FAX. DTSCS1A
|
|
03960 MOVE MAP-FAX-AREA TO L021-S-TNO-AREA. DTSCS1A
|
|
03961 DTSCS1A
|
|
03962 PERFORM S021-TELNO-FROM-SCREEN THRU S021-EXIT. DTSCS1A
|
|
03963 DTSCS1A
|
|
03964 IF L021-NOT-VALID DTSCS1A
|
|
03965 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A
|
|
03966 PERFORM S1731-ERROR THRU S1731-EXIT DTSCS1A
|
|
03967 ELSE DTSCS1A
|
|
03968 IF L021-VALID DTSCS1A
|
|
03969 MOVE L021-TNO TO L073-TELEPHONE DTSCS1A
|
|
03970 MOVE MAP-ST TO L073-ST DTSCS1A
|
|
03971 MOVE MAP-ZIP TO L073-ZIP DTSCS1A
|
|
03972 PERFORM S073-TELNO-EDIT THRU S073-EXIT DTSCS1A
|
|
03973 IF L073-NOT-VALID DTSCS1A
|
|
03974 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A
|
|
03975 PERFORM S1731-ERROR THRU S1731-EXIT DTSCS1A
|
|
03976 ELSE DTSCS1A
|
|
03977 MOVE L073-AREA-CD TO MAP-FAX-AREA-CD DTSCS1A
|
|
03978 MOVE L073-PREFIX TO MAP-FAX-PREFIX DTSCS1A
|
|
03979 MOVE L073-SUFFIX TO MAP-FAX-SUFFIX DTSCS1A
|
|
03980 MOVE L073-EXT TO MAP-FAX-EXT. DTSCS1A
|
|
03981 S1730-EXIT. EXIT. DTSCS1A
|
|
03982 DTSCS1A
|
|
03983 DTSCS1A
|
|
03984 DTSCS1A
|
|
03985 S1731-ERROR. DTSCS1A
|
|
03986 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-FAX-AREA-CD-A DTSCS1A
|
|
03987 MAP-FAX-PREFIX-A DTSCS1A
|
|
03988 MAP-FAX-SUFFIX-A DTSCS1A
|
|
03989 MAP-FAX-EXT-A. DTSCS1A
|
|
03990 DTSCS1A
|
|
03991 IF LCCM-NO-MSG DTSCS1A
|
|
03992 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
03993 MOVE CATB-CURSOR TO MAP-FAX-AREA-CD-L DTSCS1A
|
|
03994 SET CURSOR-SET-YES TO TRUE. DTSCS1A
|
|
03995 S1731-EXIT. EXIT. DTSCS1A
|
|
03996 /*****************************************************************DTSCS1A
|
|
03997 * *DTSCS1A
|
|
03998 ******************************************************************DTSCS1A
|
|
03999 S1800-SOURCE-CD. DTSCS1A
|
|
04000 SET WRK-VALID-SOURCE-CD-YES TO TRUE. DTSCS1A
|
|
04001 DTSCS1A
|
|
04002 IF WRK-MPRF-YES-88 DTSCS1A
|
|
04003 IF MPRF-CONVERTED-88 DTSCS1A
|
|
04004 MOVE SPACES TO MAP-SOURCE-CD DTSCS1A
|
|
04005 GO TO S1800-EXIT. DTSCS1A
|
|
04006 DTSCS1A
|
|
04007 IF MAP-SOURCE-CD = LOW-VALUES OR SPACES DTSCS1A
|
|
04008 IF WRK-EMP-CHG-ONLY-88 DTSCS1A
|
|
04009 MOVE SPACES TO MAP-SOURCE-CD DTSCS1A
|
|
04010 ELSE DTSCS1A
|
|
04011 MOVE '99' TO MAP-SOURCE-CD DTSCS1A
|
|
04012 ELSE DTSCS1A
|
|
04013 MOVE MAP-SOURCE-CD TO L031-CD-2 DTSCS1A
|
|
04014 SET L031-MERA-SOURCE-CD TO TRUE DTSCS1A
|
|
04015 PERFORM S031-REG-CODES THRU S031-EXIT DTSCS1A
|
|
04016 IF L031-NOT-VALID DTSCS1A
|
|
04017 SET WRK-VALID-SOURCE-CD-NO TO TRUE DTSCS1A
|
|
04018 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A
|
|
04019 PERFORM S1801-ERROR THRU S1801-EXIT DTSCS1A
|
|
04020 ELSE DTSCS1A
|
|
04021 IF MAP-SOURCE-CD-NA-88 DTSCS1A
|
|
04022 IF LCCM-F09-88 DTSCS1A
|
|
04023 NEXT SENTENCE DTSCS1A
|
|
04024 ELSE DTSCS1A
|
|
04025 SET WRK-VALID-SOURCE-CD-NO TO TRUE DTSCS1A
|
|
04026 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A
|
|
04027 PERFORM S1801-ERROR THRU S1801-EXIT. DTSCS1A
|
|
04028 S1800-EXIT. EXIT. DTSCS1A
|
|
04029 DTSCS1A
|
|
04030 DTSCS1A
|
|
04031 DTSCS1A
|
|
04032 S1801-ERROR. DTSCS1A
|
|
04033 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-SOURCE-CD-A. DTSCS1A
|
|
04034 DTSCS1A
|
|
04035 IF LCCM-NO-MSG DTSCS1A
|
|
04036 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
04037 MOVE CATB-CURSOR TO MAP-SOURCE-CD-L DTSCS1A
|
|
04038 SET CURSOR-SET-YES TO TRUE. DTSCS1A
|
|
04039 S1801-EXIT. EXIT. DTSCS1A
|
|
04040 /*****************************************************************DTSCS1A
|
|
04041 * *DTSCS1A
|
|
04042 ******************************************************************DTSCS1A
|
|
04043 S1900-FEIN. DTSCS1A
|
|
04044 MOVE MAP-FEIN-AREA TO L017-S-FEIN-AREA. DTSCS1A
|
|
04045 DTSCS1A
|
|
04046 PERFORM S017-FEIN-FROM-SCREEN THRU S017-EXIT. DTSCS1A
|
|
04047 DTSCS1A
|
|
04048 IF L017-NOT-VALID DTSCS1A
|
|
04049 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A
|
|
04050 PERFORM S1901-ERROR THRU S1901-EXIT DTSCS1A
|
|
04051 GO TO S1900-EXIT. DTSCS1A
|
|
04052 DTSCS1A
|
|
04053 IF L017-NO-ENTRY DTSCS1A
|
|
04054 GO TO S1900-EXIT. DTSCS1A
|
|
04055 DTSCS1A
|
|
04056 IF WRK-MPRF-YES-88 DTSCS1A
|
|
04057 IF L017-FEIN NOT = MPRF-FEIN DTSCS1A
|
|
04058 IF MPRF-STATUS-ACT-88 DTSCS1A
|
|
04059 SET L074-ACTIVE-DUP-88 TO TRUE DTSCS1A
|
|
04060 MOVE WRK-EMP-NO TO L074-EMP-NO DTSCS1A
|
|
04061 MOVE L017-FEIN TO L074-FEIN DTSCS1A
|
|
04062 MOVE +0 TO L074-INACTIVE-EMP-NO DTSCS1A
|
|
04063 PERFORM S074-DUP-FEIN-EDIT THRU S074-EXIT DTSCS1A
|
|
04064 IF L074-DUP-NOT-OK-88 DTSCS1A
|
|
04065 MOVE EMSG-DUPLICATE-FEIN TO WRK-MSG-AREA DTSCS1A
|
|
04066 PERFORM S1901-ERROR THRU S1901-EXIT. DTSCS1A
|
|
04067 S1900-EXIT. EXIT. DTSCS1A
|
|
04068 DTSCS1A
|
|
04069 S1901-ERROR. DTSCS1A
|
|
04070 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-FEIN-1-A DTSCS1A
|
|
04071 MAP-FEIN-2-A. DTSCS1A
|
|
04072 DTSCS1A
|
|
04073 IF LCCM-NO-MSG DTSCS1A
|
|
04074 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
04075 MOVE CATB-CURSOR TO MAP-FEIN-1-L DTSCS1A
|
|
04076 SET CURSOR-SET-YES TO TRUE. DTSCS1A
|
|
04077 S1901-EXIT. EXIT. DTSCS1A
|
|
04078 /*****************************************************************DTSCS1A
|
|
04079 * *DTSCS1A
|
|
04080 ******************************************************************DTSCS1A
|
|
04081 S1950-POT-HOUSEHOLD. DTSCS1A
|
|
04082 IF MAP-POT-HOUSEHOLD-IND = SPACES OR LOW-VALUES DTSCS1A
|
|
04083 MOVE 'N' TO MAP-POT-HOUSEHOLD-IND DTSCS1A
|
|
04084 GO TO S1950-EXIT DTSCS1A
|
|
04085 ELSE DTSCS1A
|
|
04086 IF MAP-POT-HOUSEHOLD-IND = 'Y' OR 'N' DTSCS1A
|
|
04087 NEXT SENTENCE DTSCS1A
|
|
04088 ELSE DTSCS1A
|
|
04089 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A
|
|
04090 PERFORM S1951-ERROR THRU S1951-EXIT DTSCS1A
|
|
04091 GO TO S1950-EXIT. DTSCS1A
|
|
04092 DTSCS1A
|
|
04093 IF MAP-POT-HOUSEHOLD-IND = 'Y' DTSCS1A
|
|
04094 AND WRK-EMP-NO > ZERO DTSCS1A
|
|
04095 IF MPRF-STATUS-ACT-88 DTSCS1A
|
|
04096 MOVE MSG-E1A5-AREA TO WRK-MSG-AREA DTSCS1A
|
|
04097 PERFORM S1951-ERROR THRU S1951-EXIT DTSCS1A
|
|
04098 GO TO S1950-EXIT DTSCS1A
|
|
04099 ELSE DTSCS1A
|
|
04100 SET L400-FIND-PRIOR-88 TO TRUE DTSCS1A
|
|
04101 MOVE WRK-EMP-NO TO L400-EMP-NO DTSCS1A
|
|
04102 MOVE ZERO TO L400-CURR-RUN-DATE DTSCS1A
|
|
04103 MOVE SPACES TO L400-OP-ID DTSCS1A
|
|
04104 PERFORM S400-HOUSEHOLD THRU S400-EXIT DTSCS1A
|
|
04105 IF L400-NOTICE-SENT-YES-88 DTSCS1A
|
|
04106 MOVE MSG-E1A4-AREA TO WRK-MSG-AREA DTSCS1A
|
|
04107 PERFORM S1951-ERROR THRU S1951-EXIT DTSCS1A
|
|
04108 GO TO S1950-EXIT. DTSCS1A
|
|
04109 DTSCS1A
|
|
04110 S1950-EXIT. EXIT. DTSCS1A
|
|
04111 DTSCS1A
|
|
04112 S1951-ERROR. DTSCS1A
|
|
04113 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-POT-HOUSEHOLD-A. DTSCS1A
|
|
04114 DTSCS1A
|
|
04115 IF LCCM-NO-MSG DTSCS1A
|
|
04116 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
04117 MOVE CATB-CURSOR TO MAP-POT-HOUSEHOLD-L DTSCS1A
|
|
04118 SET CURSOR-SET-YES TO TRUE. DTSCS1A
|
|
04119 S1951-EXIT. EXIT. DTSCS1A
|
|
04120 /*****************************************************************DTSCS1A
|
|
04121 * *DTSCS1A
|
|
04122 ******************************************************************DTSCS1A
|
|
04123 S2000-CLAIMANT-SSN. DTSCS1A
|
|
04124 IF WRK-EMP-CHG-ONLY-88 DTSCS1A
|
|
04125 OR DTSCS1A
|
|
04126 MAP-SOURCE-CD-NA-88 DTSCS1A
|
|
04127 MOVE SPACES TO MAP-CLAIMANT-SSN-1 DTSCS1A
|
|
04128 MOVE SPACES TO MAP-CLAIMANT-SSN-2 DTSCS1A
|
|
04129 MOVE SPACES TO MAP-CLAIMANT-SSN-3 DTSCS1A
|
|
04130 GO TO S2000-EXIT. DTSCS1A
|
|
04131 DTSCS1A
|
|
04132 MOVE MAP-CLAIMANT-SSN-AREA TO L020-S-SSN-AREA. DTSCS1A
|
|
04133 DTSCS1A
|
|
04134 PERFORM S020-SSN-FROM-SCREEN THRU S020-EXIT. DTSCS1A
|
|
04135 DTSCS1A
|
|
04136 IF L020-NO-ENTRY DTSCS1A
|
|
04137 IF MAP-LETTER-1-CD = '05' OR MAP-SOURCE-CD = '05' DTSCS1A
|
|
04138 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS1A
|
|
04139 PERFORM S2001-ERROR THRU S2001-EXIT DTSCS1A
|
|
04140 ELSE DTSCS1A
|
|
04141 NEXT SENTENCE DTSCS1A
|
|
04142 ELSE DTSCS1A
|
|
04143 IF L020-NOT-VALID DTSCS1A
|
|
04144 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A
|
|
04145 PERFORM S2001-ERROR THRU S2001-EXIT. DTSCS1A
|
|
04146 DTSCS1A
|
|
04147 S2000-EXIT. EXIT. DTSCS1A
|
|
04148 DTSCS1A
|
|
04149 DTSCS1A
|
|
04150 DTSCS1A
|
|
04151 S2001-ERROR. DTSCS1A
|
|
04152 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-CLAIMANT-SSN-1-A DTSCS1A
|
|
04153 MAP-CLAIMANT-SSN-2-A DTSCS1A
|
|
04154 MAP-CLAIMANT-SSN-3-A. DTSCS1A
|
|
04155 DTSCS1A
|
|
04156 IF LCCM-NO-MSG DTSCS1A
|
|
04157 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
04158 MOVE CATB-CURSOR TO MAP-CLAIMANT-SSN-1-L DTSCS1A
|
|
04159 SET CURSOR-SET-YES TO TRUE. DTSCS1A
|
|
04160 S2001-EXIT. EXIT. DTSCS1A
|
|
04161 /*****************************************************************DTSCS1A
|
|
04162 * *DTSCS1A
|
|
04163 ******************************************************************DTSCS1A
|
|
04164 S2010-CLAIMANT-NAME. DTSCS1A
|
|
04165 IF WRK-EMP-CHG-ONLY-88 DTSCS1A
|
|
04166 OR DTSCS1A
|
|
04167 MAP-SOURCE-CD-NA-88 DTSCS1A
|
|
04168 MOVE SPACES TO MAP-CLAIMANT-NAME DTSCS1A
|
|
04169 GO TO S2010-EXIT. DTSCS1A
|
|
04170 DTSCS1A
|
|
04171 IF MAP-CLAIMANT-NAME = LOW-VALUES OR SPACES DTSCS1A
|
|
04172 MOVE SPACES TO MAP-CLAIMANT-NAME DTSCS1A
|
|
04173 IF L020-NO-ENTRY DTSCS1A
|
|
04174 GO TO S2010-EXIT. DTSCS1A
|
|
04175 DTSCS1A
|
|
04176 IF L020-NOT-VALID DTSCS1A
|
|
04177 GO TO S2010-EXIT. DTSCS1A
|
|
04178 DTSCS1A
|
|
04179 IF L020-NO-ENTRY DTSCS1A
|
|
04180 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS1A
|
|
04181 PERFORM S2011-ERROR THRU S2011-EXIT DTSCS1A
|
|
04182 GO TO S2010-EXIT. DTSCS1A
|
|
04183 DTSCS1A
|
|
04184 IF MAP-CLAIMANT-NAME = SPACES DTSCS1A
|
|
04185 MOVE L020-SSN TO L081-CLAIMANT-SSN DTSCS1A
|
|
04186 PERFORM S081-CLAIMANT-NAME-LOOKUP THRU S081-EXIT DTSCS1A
|
|
04187 IF L081-NAME-FOUND DTSCS1A
|
|
04188 MOVE L081-CLAIMANT-NAME TO MAP-CLAIMANT-NAME. DTSCS1A
|
|
04189 DTSCS1A
|
|
04190 IF MAP-CLAIMANT-NAME = SPACES DTSCS1A
|
|
04191 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS1A
|
|
04192 PERFORM S2011-ERROR THRU S2011-EXIT DTSCS1A
|
|
04193 ELSE DTSCS1A
|
|
04194 SET L071-FROM-LAST-NAME-FIRST TO TRUE DTSCS1A
|
|
04195 MOVE MAP-CLAIMANT-NAME TO L071-NAM DTSCS1A
|
|
04196 PERFORM S071-NAME-EDIT THRU S071-EXIT DTSCS1A
|
|
04197 IF L071-NAME-INVALID DTSCS1A
|
|
04198 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A
|
|
04199 PERFORM S2011-ERROR THRU S2011-EXIT. DTSCS1A
|
|
04200 DTSCS1A
|
|
04201 S2010-EXIT. EXIT. DTSCS1A
|
|
04202 DTSCS1A
|
|
04203 DTSCS1A
|
|
04204 DTSCS1A
|
|
04205 S2011-ERROR. DTSCS1A
|
|
04206 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-CLAIMANT-NAME-A. DTSCS1A
|
|
04207 DTSCS1A
|
|
04208 IF LCCM-NO-MSG DTSCS1A
|
|
04209 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
04210 MOVE CATB-CURSOR TO MAP-CLAIMANT-NAME-L DTSCS1A
|
|
04211 SET CURSOR-SET-YES TO TRUE. DTSCS1A
|
|
04212 S2011-EXIT. EXIT. DTSCS1A
|
|
04213 /*****************************************************************DTSCS1A
|
|
04214 * *DTSCS1A
|
|
04215 ******************************************************************DTSCS1A
|
|
04216 S2100-POT-PRED-EMP-NO. DTSCS1A
|
|
04217 IF WRK-EMP-CHG-ONLY-88 DTSCS1A
|
|
04218 OR DTSCS1A
|
|
04219 MAP-SOURCE-CD-NA-88 DTSCS1A
|
|
04220 MOVE SPACES TO MAP-PRED-EMP-NO-1 DTSCS1A
|
|
04221 MAP-PRED-EMP-NO-2 DTSCS1A
|
|
04222 GO TO S2100-EXIT. DTSCS1A
|
|
04223 DTSCS1A
|
|
04224 MOVE MAP-PRED-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS1A
|
|
04225 DTSCS1A
|
|
04226 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS1A
|
|
04227 DTSCS1A
|
|
04228 IF L018-NO-ENTRY DTSCS1A
|
|
04229 IF MAP-SOURCE-CD = '04' DTSCS1A
|
|
04230 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS1A
|
|
04231 PERFORM S2101-ERROR THRU S2101-EXIT DTSCS1A
|
|
04232 ELSE DTSCS1A
|
|
04233 NEXT SENTENCE DTSCS1A
|
|
04234 ELSE DTSCS1A
|
|
04235 IF L018-NOT-VALID DTSCS1A
|
|
04236 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A
|
|
04237 PERFORM S2101-ERROR THRU S2101-EXIT DTSCS1A
|
|
04238 ELSE DTSCS1A
|
|
04239 IF L018-EMP-NO EQUAL WRK-EMP-NO DTSCS1A
|
|
04240 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A
|
|
04241 PERFORM S2101-ERROR THRU S2101-EXIT DTSCS1A
|
|
04242 ELSE DTSCS1A
|
|
04243 PERFORM S2110-CHECK-EMP THRU S2110-EXIT. DTSCS1A
|
|
04244 S2100-EXIT. EXIT. DTSCS1A
|
|
04245 DTSCS1A
|
|
04246 DTSCS1A
|
|
04247 DTSCS1A
|
|
04248 S2101-ERROR. DTSCS1A
|
|
04249 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-PRED-EMP-NO-1-A DTSCS1A
|
|
04250 MAP-PRED-EMP-NO-2-A. DTSCS1A
|
|
04251 DTSCS1A
|
|
04252 IF LCCM-NO-MSG DTSCS1A
|
|
04253 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
04254 MOVE CATB-CURSOR TO MAP-PRED-EMP-NO-1-L DTSCS1A
|
|
04255 SET CURSOR-SET-YES TO TRUE. DTSCS1A
|
|
04256 S2101-EXIT. EXIT. DTSCS1A
|
|
04257 DTSCS1A
|
|
04258 DTSCS1A
|
|
04259 DTSCS1A
|
|
04260 S2110-CHECK-EMP. DTSCS1A
|
|
04261 IF WRK-MERA-YES-88 DTSCS1A
|
|
04262 AND DTSCS1A
|
|
04263 L018-EMP-NO = MERA-POT-PRED-EMP-NO DTSCS1A
|
|
04264 GO TO S2110-EXIT. DTSCS1A
|
|
04265 DTSCS1A
|
|
04266 DTSCS1A
|
|
04267 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS1A
|
|
04268 DTSCS1A
|
|
04269 MOVE L018-EMP-NO TO MSKL-EMP-NO. DTSCS1A
|
|
04270 DTSCS1A
|
|
04271 SET MSKL-PRF-88 TO TRUE. DTSCS1A
|
|
04272 DTSCS1A
|
|
04273 PERFORM S810-READ THRU S810-EXIT. DTSCS1A
|
|
04274 DTSCS1A
|
|
04275 IF L810-NO-REC-88 DTSCS1A
|
|
04276 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS1A
|
|
04277 PERFORM S2101-ERROR THRU S2101-EXIT. DTSCS1A
|
|
04278 S2110-EXIT. EXIT. DTSCS1A
|
|
04279 /*****************************************************************DTSCS1A
|
|
04280 * *DTSCS1A
|
|
04281 ******************************************************************DTSCS1A
|
|
04282 S2200-RESPONSIBLE-OP-ID. DTSCS1A
|
|
04283 ** MODIFIED TO SET RESP-OP-ID TO USER CURRENTLY SIGNED ON, DTSCS1A
|
|
04284 ** UNLESS USER HAS SET MAP-RESP-OP-ID. DTSCS1A
|
|
04285 ** REQUEST FROM STATUS UNIT. 12/09/2002 GD DTSCS1A
|
|
04286 DTSCS1A
|
|
04287 IF WRK-EMP-CHG-ONLY-88 DTSCS1A
|
|
04288 OR DTSCS1A
|
|
04289 MAP-SOURCE-CD-NA-88 DTSCS1A
|
|
04290 MOVE SPACES TO MAP-RESP-OP-ID DTSCS1A
|
|
04291 GO TO S2200-EXIT. DTSCS1A
|
|
04292 DTSCS1A
|
|
04293 IF WRK-MPRF-YES-88 DTSCS1A
|
|
04294 IF MPRF-CONVERTED-88 DTSCS1A
|
|
04295 MOVE SPACES TO MAP-RESP-OP-ID DTSCS1A
|
|
04296 GO TO S2200-EXIT. DTSCS1A
|
|
04297 DTSCS1A
|
|
04298 IF MAP-RESP-OP-ID = LOW-VALUES OR SPACES DTSCS1A
|
|
04299 ******** MOVE LCCM-RESP-OP-ID TO MAP-RESP-OP-ID. DTSCS1A
|
|
04300 MOVE LCCM-OP-ID TO MAP-RESP-OP-ID. DTSCS1A
|
|
04301 DTSCS1A
|
|
04302 IF MAP-RESP-OP-ID = LCCM-OP-ID DTSCS1A
|
|
04303 MOVE MAP-RESP-OP-ID TO LCCM-RESP-OP-ID DTSCS1A
|
|
04304 GO TO S2200-EXIT. DTSCS1A
|
|
04305 DTSCS1A
|
|
04306 MOVE MAP-RESP-OP-ID TO L082-OP-ID. DTSCS1A
|
|
04307 DTSCS1A
|
|
04308 PERFORM S082-OP-ID-LOOKUP THRU S082-EXIT. DTSCS1A
|
|
04309 DTSCS1A
|
|
04310 IF L082-VALID-OP AND L082-EXTERNAL-88 DTSCS1A
|
|
04311 MOVE MAP-RESP-OP-ID TO LCCM-RESP-OP-ID DTSCS1A
|
|
04312 ELSE DTSCS1A
|
|
04313 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A
|
|
04314 PERFORM S2201-ERROR THRU S2201-EXIT. DTSCS1A
|
|
04315 S2200-EXIT. EXIT. DTSCS1A
|
|
04316 DTSCS1A
|
|
04317 DTSCS1A
|
|
04318 DTSCS1A
|
|
04319 S2201-ERROR. DTSCS1A
|
|
04320 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-RESP-OP-ID-A. DTSCS1A
|
|
04321 DTSCS1A
|
|
04322 IF LCCM-NO-MSG DTSCS1A
|
|
04323 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
04324 MOVE CATB-CURSOR TO MAP-RESP-OP-ID-L DTSCS1A
|
|
04325 SET CURSOR-SET-YES TO TRUE. DTSCS1A
|
|
04326 S2201-EXIT. EXIT. DTSCS1A
|
|
04327 /*****************************************************************DTSCS1A
|
|
04328 * *DTSCS1A
|
|
04329 ******************************************************************DTSCS1A
|
|
04330 S2300-NOTE. DTSCS1A
|
|
04331 IF WRK-EMP-CHG-ONLY-88 DTSCS1A
|
|
04332 OR DTSCS1A
|
|
04333 MAP-SOURCE-CD-NA-88 DTSCS1A
|
|
04334 MOVE SPACES TO MAP-NOTE DTSCS1A
|
|
04335 GO TO S2300-EXIT. DTSCS1A
|
|
04336 DTSCS1A
|
|
04337 IF MAP-NOTE = LOW-VALUES OR SPACES DTSCS1A
|
|
04338 MOVE SPACES TO MAP-NOTE. DTSCS1A
|
|
04339 S2300-EXIT. EXIT. DTSCS1A
|
|
04340 DTSCS1A
|
|
04341 DTSCS1A
|
|
04342 DTSCS1A
|
|
04343 S2301-ERROR. DTSCS1A
|
|
04344 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-NOTE-A. DTSCS1A
|
|
04345 DTSCS1A
|
|
04346 IF LCCM-NO-MSG DTSCS1A
|
|
04347 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
04348 MOVE CATB-CURSOR TO MAP-NOTE-L DTSCS1A
|
|
04349 SET CURSOR-SET-YES TO TRUE. DTSCS1A
|
|
04350 S2301-EXIT. EXIT. DTSCS1A
|
|
04351 /*****************************************************************DTSCS1A
|
|
04352 * *DTSCS1A
|
|
04353 ******************************************************************DTSCS1A
|
|
04354 S2600-STATUS-CD. DTSCS1A
|
|
04355 IF WRK-EMP-CHG-ONLY-88 DTSCS1A
|
|
04356 OR DTSCS1A
|
|
04357 MAP-SOURCE-CD-NA-88 DTSCS1A
|
|
04358 MOVE SPACES TO MAP-STATUS-CD DTSCS1A
|
|
04359 GO TO S2600-EXIT. DTSCS1A
|
|
04360 DTSCS1A
|
|
04361 IF WRK-MPRF-YES-88 DTSCS1A
|
|
04362 IF MPRF-CONVERTED-88 DTSCS1A
|
|
04363 MOVE SPACES TO MAP-STATUS-CD DTSCS1A
|
|
04364 GO TO S2600-EXIT. DTSCS1A
|
|
04365 DTSCS1A
|
|
04366 IF MAP-STATUS-CD = LOW-VALUES OR SPACES DTSCS1A
|
|
04367 ********IF MAP-SOURCE-CD = '07' DTSCS1A
|
|
04368 ***********MOVE '11' TO MAP-STATUS-CD DTSCS1A
|
|
04369 ********ELSE DTSCS1A
|
|
04370 MOVE '00' TO MAP-STATUS-CD. DTSCS1A
|
|
04371 DTSCS1A
|
|
04372 MOVE MAP-STATUS-CD TO L031-CD-2. DTSCS1A
|
|
04373 DTSCS1A
|
|
04374 SET L031-MERA-STATUS-CD TO TRUE. DTSCS1A
|
|
04375 DTSCS1A
|
|
04376 PERFORM S031-REG-CODES THRU S031-EXIT. DTSCS1A
|
|
04377 DTSCS1A
|
|
04378 IF L031-NOT-VALID DTSCS1A
|
|
04379 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A
|
|
04380 PERFORM S2601-ERROR THRU S2601-EXIT DTSCS1A
|
|
04381 GO TO S2600-EXIT. DTSCS1A
|
|
04382 DTSCS1A
|
|
04383 MOVE MAP-STATUS-CD TO MERA-STATUS-CD. DTSCS1A
|
|
04384 S2600-EXIT. EXIT. DTSCS1A
|
|
04385 DTSCS1A
|
|
04386 DTSCS1A
|
|
04387 DTSCS1A
|
|
04388 S2601-ERROR. DTSCS1A
|
|
04389 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-STATUS-CD-A. DTSCS1A
|
|
04390 DTSCS1A
|
|
04391 IF LCCM-NO-MSG DTSCS1A
|
|
04392 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
04393 MOVE CATB-CURSOR TO MAP-STATUS-CD-L DTSCS1A
|
|
04394 SET CURSOR-SET-YES TO TRUE. DTSCS1A
|
|
04395 S2601-EXIT. EXIT. DTSCS1A
|
|
04396 /*****************************************************************DTSCS1A
|
|
04397 * *DTSCS1A
|
|
04398 ******************************************************************DTSCS1A
|
|
04399 S2700-MAIL-DATE-1. DTSCS1A
|
|
04400 IF WRK-EMP-CHG-ONLY-88 DTSCS1A
|
|
04401 OR DTSCS1A
|
|
04402 MAP-SOURCE-CD-NA-88 DTSCS1A
|
|
04403 MOVE SPACES TO MAP-MAIL-1-MO DTSCS1A
|
|
04404 MAP-MAIL-1-DA DTSCS1A
|
|
04405 MAP-MAIL-1-YR DTSCS1A
|
|
04406 GO TO S2700-EXIT. DTSCS1A
|
|
04407 DTSCS1A
|
|
04408 DTSCS1A
|
|
04409 MOVE MAP-MAIL-DATE-1-AREA TO L015-S-DATE-AREA. DTSCS1A
|
|
04410 DTSCS1A
|
|
04411 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS1A
|
|
04412 DTSCS1A
|
|
04413 IF L015-NOT-VALID DTSCS1A
|
|
04414 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A
|
|
04415 PERFORM S2701-ERROR THRU S2701-EXIT. DTSCS1A
|
|
04416 S2700-EXIT. EXIT. DTSCS1A
|
|
04417 DTSCS1A
|
|
04418 DTSCS1A
|
|
04419 DTSCS1A
|
|
04420 S2701-ERROR. DTSCS1A
|
|
04421 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-MAIL-1-MO-A DTSCS1A
|
|
04422 MAP-MAIL-1-DA-A DTSCS1A
|
|
04423 MAP-MAIL-1-YR-A. DTSCS1A
|
|
04424 DTSCS1A
|
|
04425 IF LCCM-NO-MSG DTSCS1A
|
|
04426 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
04427 MOVE CATB-CURSOR TO MAP-MAIL-1-MO-L DTSCS1A
|
|
04428 SET CURSOR-SET-YES TO TRUE. DTSCS1A
|
|
04429 S2701-EXIT. EXIT. DTSCS1A
|
|
04430 /*****************************************************************DTSCS1A
|
|
04431 * *DTSCS1A
|
|
04432 ******************************************************************DTSCS1A
|
|
04433 S2800-LETTER-1-CD. DTSCS1A
|
|
04434 IF WRK-EMP-CHG-ONLY-88 DTSCS1A
|
|
04435 OR DTSCS1A
|
|
04436 MAP-SOURCE-CD-NA-88 DTSCS1A
|
|
04437 MOVE SPACES TO MAP-LETTER-1-CD DTSCS1A
|
|
04438 GO TO S2800-EXIT. DTSCS1A
|
|
04439 DTSCS1A
|
|
04440 IF WRK-MPRF-YES-88 DTSCS1A
|
|
04441 IF MPRF-CONVERTED-88 DTSCS1A
|
|
04442 MOVE SPACES TO MAP-LETTER-1-CD DTSCS1A
|
|
04443 GO TO S2800-EXIT. DTSCS1A
|
|
04444 DTSCS1A
|
|
04445 DTSCS1A
|
|
04446 IF MAP-LETTER-1-CD = LOW-VALUES OR SPACES DTSCS1A
|
|
04447 IF WRK-VALID-SOURCE-CD-NO DTSCS1A
|
|
04448 GO TO S2800-EXIT DTSCS1A
|
|
04449 ELSE DTSCS1A
|
|
04450 IF MAP-SOURCE-CD = '05' DTSCS1A
|
|
04451 MOVE '05' TO MAP-LETTER-1-CD DTSCS1A
|
|
04452 ELSE DTSCS1A
|
|
04453 IF MAP-SOURCE-CD = '01' OR '02' DTSCS1A
|
|
04454 MOVE '02' TO MAP-LETTER-1-CD DTSCS1A
|
|
04455 ELSE DTSCS1A
|
|
04456 IF MAP-SOURCE-CD = '14' DTSCS1A
|
|
04457 MOVE '04' TO MAP-LETTER-1-CD DTSCS1A
|
|
04458 ELSE DTSCS1A
|
|
04459 MOVE '01' TO MAP-LETTER-1-CD. DTSCS1A
|
|
04460 DTSCS1A
|
|
04461 MOVE MAP-LETTER-1-CD TO L031-CD-2. DTSCS1A
|
|
04462 DTSCS1A
|
|
04463 SET L031-MERA-LETTER-1-CD TO TRUE. DTSCS1A
|
|
04464 DTSCS1A
|
|
04465 PERFORM S031-REG-CODES THRU S031-EXIT. DTSCS1A
|
|
04466 DTSCS1A
|
|
04467 IF L031-NOT-VALID DTSCS1A
|
|
04468 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A
|
|
04469 PERFORM S2801-ERROR THRU S2801-EXIT. DTSCS1A
|
|
04470 S2800-EXIT. EXIT. DTSCS1A
|
|
04471 DTSCS1A
|
|
04472 DTSCS1A
|
|
04473 DTSCS1A
|
|
04474 S2801-ERROR. DTSCS1A
|
|
04475 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-LETTER-1-CD-A. DTSCS1A
|
|
04476 DTSCS1A
|
|
04477 IF LCCM-NO-MSG DTSCS1A
|
|
04478 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
04479 MOVE CATB-CURSOR TO MAP-LETTER-1-CD-L DTSCS1A
|
|
04480 SET CURSOR-SET-YES TO TRUE. DTSCS1A
|
|
04481 S2801-EXIT. EXIT. DTSCS1A
|
|
04482 /*****************************************************************DTSCS1A
|
|
04483 * *DTSCS1A
|
|
04484 ******************************************************************DTSCS1A
|
|
04485 S2900-MAIL-DATE-2. DTSCS1A
|
|
04486 IF WRK-EMP-CHG-ONLY-88 DTSCS1A
|
|
04487 OR DTSCS1A
|
|
04488 MAP-SOURCE-CD-NA-88 DTSCS1A
|
|
04489 MOVE SPACES TO MAP-MAIL-2-MO DTSCS1A
|
|
04490 MAP-MAIL-2-DA DTSCS1A
|
|
04491 MAP-MAIL-2-YR DTSCS1A
|
|
04492 GO TO S2900-EXIT. DTSCS1A
|
|
04493 DTSCS1A
|
|
04494 DTSCS1A
|
|
04495 MOVE MAP-MAIL-DATE-2-AREA TO L015-S-DATE-AREA. DTSCS1A
|
|
04496 DTSCS1A
|
|
04497 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS1A
|
|
04498 DTSCS1A
|
|
04499 IF L015-NOT-VALID DTSCS1A
|
|
04500 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A
|
|
04501 PERFORM S2901-ERROR THRU S2901-EXIT. DTSCS1A
|
|
04502 S2900-EXIT. EXIT. DTSCS1A
|
|
04503 DTSCS1A
|
|
04504 DTSCS1A
|
|
04505 DTSCS1A
|
|
04506 S2901-ERROR. DTSCS1A
|
|
04507 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-MAIL-2-MO-A DTSCS1A
|
|
04508 MAP-MAIL-2-DA-A DTSCS1A
|
|
04509 MAP-MAIL-2-YR-A. DTSCS1A
|
|
04510 DTSCS1A
|
|
04511 IF LCCM-NO-MSG DTSCS1A
|
|
04512 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
04513 MOVE CATB-CURSOR TO MAP-MAIL-2-MO-L DTSCS1A
|
|
04514 SET CURSOR-SET-YES TO TRUE. DTSCS1A
|
|
04515 S2901-EXIT. EXIT. DTSCS1A
|
|
04516 /*****************************************************************DTSCS1A
|
|
04517 * *DTSCS1A
|
|
04518 ******************************************************************DTSCS1A
|
|
04519 S3000-RECEIVED-DATE. DTSCS1A
|
|
04520 MOVE ZERO TO WRK-FR500-RCVD-DATE. DTSCS1A
|
|
04521 DTSCS1A
|
|
04522 IF WRK-EMP-CHG-ONLY-88 DTSCS1A
|
|
04523 OR DTSCS1A
|
|
04524 MAP-SOURCE-CD-NA-88 DTSCS1A
|
|
04525 MOVE SPACES TO MAP-RECEIVED-MO DTSCS1A
|
|
04526 MAP-RECEIVED-DA DTSCS1A
|
|
04527 MAP-RECEIVED-YR DTSCS1A
|
|
04528 GO TO S3000-EXIT. DTSCS1A
|
|
04529 DTSCS1A
|
|
04530 DTSCS1A
|
|
04531 MOVE MAP-RECEIVED-DATE-AREA TO L015-S-DATE-AREA. DTSCS1A
|
|
04532 DTSCS1A
|
|
04533 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS1A
|
|
04534 DTSCS1A
|
|
04535 IF L015-NOT-VALID DTSCS1A
|
|
04536 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A
|
|
04537 PERFORM S3001-ERROR THRU S3001-EXIT DTSCS1A
|
|
04538 ELSE DTSCS1A
|
|
04539 IF L015-NO-ENTRY DTSCS1A
|
|
04540 IF MAP-STATUS-CD = '11' DTSCS1A
|
|
04541 MOVE LCCM-CURR-RUN-DATE TO WRK-DISPLAY DTSCS1A
|
|
04542 MOVE WRK-DISPLAY-YR TO MAP-RECEIVED-YR DTSCS1A
|
|
04543 MOVE WRK-DISPLAY-MO TO MAP-RECEIVED-MO DTSCS1A
|
|
04544 MOVE WRK-DISPLAY-DA TO MAP-RECEIVED-DA DTSCS1A
|
|
04545 END-IF DTSCS1A
|
|
04546 END-IF DTSCS1A
|
|
04547 END-IF. DTSCS1A
|
|
04548 DTSCS1A
|
|
04549 IF L015-VALID DTSCS1A
|
|
04550 MOVE L015-DATE TO WRK-FR500-RCVD-DATE DTSCS1A
|
|
04551 END-IF. DTSCS1A
|
|
04552 DTSCS1A
|
|
04553 * ELSE DTSCS1A
|
|
04554 * NEXT SENTENCE DTSCS1A
|
|
04555 * ELSE DTSCS1A
|
|
04556 * IF MAP-STATUS-CD < '11' DTSCS1A
|
|
04557 * MOVE SPACES TO MAP-RECEIVED-MO DTSCS1A
|
|
04558 * MAP-RECEIVED-DA DTSCS1A
|
|
04559 * MAP-RECEIVED-YR. DTSCS1A
|
|
04560 S3000-EXIT. EXIT. DTSCS1A
|
|
04561 DTSCS1A
|
|
04562 DTSCS1A
|
|
04563 DTSCS1A
|
|
04564 S3001-ERROR. DTSCS1A
|
|
04565 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-RECEIVED-MO-A DTSCS1A
|
|
04566 MAP-RECEIVED-DA-A DTSCS1A
|
|
04567 MAP-RECEIVED-YR-A. DTSCS1A
|
|
04568 DTSCS1A
|
|
04569 IF LCCM-NO-MSG DTSCS1A
|
|
04570 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
04571 MOVE CATB-CURSOR TO MAP-RECEIVED-MO-L DTSCS1A
|
|
04572 SET CURSOR-SET-YES TO TRUE. DTSCS1A
|
|
04573 S3001-EXIT. EXIT. DTSCS1A
|
|
04574 /*****************************************************************DTSCS1A
|
|
04575 * *DTSCS1A
|
|
04576 ******************************************************************DTSCS1A
|
|
04577 S3100-COOP-AGENCY-REQ-DATE. DTSCS1A
|
|
04578 IF WRK-EMP-CHG-ONLY-88 DTSCS1A
|
|
04579 OR DTSCS1A
|
|
04580 MAP-SOURCE-CD-NA-88 DTSCS1A
|
|
04581 MOVE SPACES TO MAP-COOP-AGENCY-REQ-MO DTSCS1A
|
|
04582 MAP-COOP-AGENCY-REQ-DA DTSCS1A
|
|
04583 MAP-COOP-AGENCY-REQ-YR DTSCS1A
|
|
04584 GO TO S3100-EXIT. DTSCS1A
|
|
04585 DTSCS1A
|
|
04586 DTSCS1A
|
|
04587 MOVE MAP-COOP-AGENCY-REQ-DATE-AREA TO L015-S-DATE-AREA. DTSCS1A
|
|
04588 DTSCS1A
|
|
04589 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS1A
|
|
04590 DTSCS1A
|
|
04591 IF L015-NOT-VALID DTSCS1A
|
|
04592 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A
|
|
04593 PERFORM S3101-ERROR THRU S3101-EXIT. DTSCS1A
|
|
04594 S3100-EXIT. EXIT. DTSCS1A
|
|
04595 DTSCS1A
|
|
04596 DTSCS1A
|
|
04597 DTSCS1A
|
|
04598 S3101-ERROR. DTSCS1A
|
|
04599 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS1A
|
|
04600 TO MAP-COOP-AGENCY-REQ-MO-A DTSCS1A
|
|
04601 MAP-COOP-AGENCY-REQ-DA-A DTSCS1A
|
|
04602 MAP-COOP-AGENCY-REQ-YR-A. DTSCS1A
|
|
04603 DTSCS1A
|
|
04604 IF LCCM-NO-MSG DTSCS1A
|
|
04605 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
04606 MOVE CATB-CURSOR TO MAP-COOP-AGENCY-REQ-MO-L DTSCS1A
|
|
04607 SET CURSOR-SET-YES TO TRUE. DTSCS1A
|
|
04608 S3101-EXIT. EXIT. DTSCS1A
|
|
04609 /*****************************************************************DTSCS1A
|
|
04610 * *DTSCS1A
|
|
04611 ******************************************************************DTSCS1A
|
|
04612 S3200-DETER-NOTSUB-DATE. DTSCS1A
|
|
04613 IF WRK-EMP-CHG-ONLY-88 DTSCS1A
|
|
04614 OR DTSCS1A
|
|
04615 MAP-SOURCE-CD-NA-88 DTSCS1A
|
|
04616 MOVE SPACES TO MAP-DETER-NOTSUB-MO DTSCS1A
|
|
04617 MAP-DETER-NOTSUB-DA DTSCS1A
|
|
04618 MAP-DETER-NOTSUB-YR DTSCS1A
|
|
04619 GO TO S3200-EXIT. DTSCS1A
|
|
04620 DTSCS1A
|
|
04621 DTSCS1A
|
|
04622 MOVE MAP-DETER-NOTSUB-DATE-AREA TO L015-S-DATE-AREA. DTSCS1A
|
|
04623 DTSCS1A
|
|
04624 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS1A
|
|
04625 DTSCS1A
|
|
04626 IF L015-NOT-VALID DTSCS1A
|
|
04627 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A
|
|
04628 PERFORM S3201-ERROR THRU S3201-EXIT DTSCS1A
|
|
04629 ELSE DTSCS1A
|
|
04630 IF L015-NO-ENTRY DTSCS1A
|
|
04631 AND (MAP-STATUS-CD = '21') DTSCS1A
|
|
04632 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS1A
|
|
04633 PERFORM S3201-ERROR THRU S3201-EXIT DTSCS1A
|
|
04634 ELSE DTSCS1A
|
|
04635 IF L015-VALID DTSCS1A
|
|
04636 IF MAP-STATUS-CD = '21' DTSCS1A
|
|
04637 NEXT SENTENCE DTSCS1A
|
|
04638 ELSE DTSCS1A
|
|
04639 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS1A
|
|
04640 PERFORM S3201-ERROR THRU S3201-EXIT. DTSCS1A
|
|
04641 S3200-EXIT. EXIT. DTSCS1A
|
|
04642 DTSCS1A
|
|
04643 DTSCS1A
|
|
04644 DTSCS1A
|
|
04645 S3201-ERROR. DTSCS1A
|
|
04646 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-DETER-NOTSUB-MO-A DTSCS1A
|
|
04647 MAP-DETER-NOTSUB-DA-A DTSCS1A
|
|
04648 MAP-DETER-NOTSUB-YR-A. DTSCS1A
|
|
04649 DTSCS1A
|
|
04650 IF LCCM-NO-MSG DTSCS1A
|
|
04651 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
04652 MOVE CATB-CURSOR TO MAP-DETER-NOTSUB-MO-L DTSCS1A
|
|
04653 SET CURSOR-SET-YES TO TRUE. DTSCS1A
|
|
04654 S3201-EXIT. EXIT. DTSCS1A
|
|
04655 /*****************************************************************DTSCS1A
|
|
04656 * *DTSCS1A
|
|
04657 ******************************************************************DTSCS1A
|
|
04658 S3300-FIELD-ASSIGN-DATE. DTSCS1A
|
|
04659 IF WRK-EMP-CHG-ONLY-88 DTSCS1A
|
|
04660 OR DTSCS1A
|
|
04661 MAP-SOURCE-CD-NA-88 DTSCS1A
|
|
04662 MOVE SPACES TO MAP-FIELD-ASSIGN-MO DTSCS1A
|
|
04663 MAP-FIELD-ASSIGN-DA DTSCS1A
|
|
04664 MAP-FIELD-ASSIGN-YR DTSCS1A
|
|
04665 GO TO S3300-EXIT. DTSCS1A
|
|
04666 DTSCS1A
|
|
04667 DTSCS1A
|
|
04668 MOVE MAP-FIELD-ASSIGN-DATE-AREA TO L015-S-DATE-AREA. DTSCS1A
|
|
04669 DTSCS1A
|
|
04670 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS1A
|
|
04671 DTSCS1A
|
|
04672 IF L015-NOT-VALID DTSCS1A
|
|
04673 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A
|
|
04674 PERFORM S3301-ERROR THRU S3301-EXIT. DTSCS1A
|
|
04675 S3300-EXIT. EXIT. DTSCS1A
|
|
04676 DTSCS1A
|
|
04677 DTSCS1A
|
|
04678 DTSCS1A
|
|
04679 S3301-ERROR. DTSCS1A
|
|
04680 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS1A
|
|
04681 TO MAP-FIELD-ASSIGN-MO-A DTSCS1A
|
|
04682 MAP-FIELD-ASSIGN-DA-A DTSCS1A
|
|
04683 MAP-FIELD-ASSIGN-YR-A. DTSCS1A
|
|
04684 DTSCS1A
|
|
04685 IF LCCM-NO-MSG DTSCS1A
|
|
04686 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
04687 MOVE CATB-CURSOR TO MAP-FIELD-ASSIGN-MO-L DTSCS1A
|
|
04688 SET CURSOR-SET-YES TO TRUE. DTSCS1A
|
|
04689 S3301-EXIT. EXIT. DTSCS1A
|
|
04690 EJECT DTSCS1A
|
|
04691 /*****************************************************************DTSCS1A
|
|
04692 * ENSURE THAT A LOCAL DC ADDRESS IS ON FILE BEFORE ALLOWING *DTSCS1A
|
|
04693 * A LIABLE DETERMINATION, IF THAT DETERMINATION IS BASED ON *DTSCS1A
|
|
04694 * AN FR-500. *DTSCS1A
|
|
04695 ******************************************************************DTSCS1A
|
|
04696 S4000-CHK-FOR-DC-ADDR. DTSCS1A
|
|
04697 SET WRK-DC-ADDR-NO-88 TO TRUE. DTSCS1A
|
|
04698 SET WRK-PO-BOX-NO-88 TO TRUE. DTSCS1A
|
|
04699 DTSCS1A
|
|
04700 IF MAP-VERIFY-YES-88 DTSCS1A
|
|
04701 * AND (LCCM-OP-IS-FLD-DESK-88 DTSCS1A
|
|
04702 * OR LCCM-OP-IS-ACCOUNTING-DESK-88) DTSCS1A
|
|
04703 GO TO S4000-EXIT DTSCS1A
|
|
04704 END-IF. DTSCS1A
|
|
04705 DTSCS1A
|
|
04706 IF NOT MPRF-STATUS-ACT-88 DTSCS1A
|
|
04707 GO TO S4000-EXIT DTSCS1A
|
|
04708 END-IF. DTSCS1A
|
|
04709 DTSCS1A
|
|
04710 IF WRK-MERA-NO-88 DTSCS1A
|
|
04711 GO TO S4000-EXIT DTSCS1A
|
|
04712 ELSE DTSCS1A
|
|
04713 IF WRK-FR500-RCVD-DATE > ZERO DTSCS1A
|
|
04714 AND MERA-RECEIVED-DATE = ZERO DTSCS1A
|
|
04715 NEXT SENTENCE DTSCS1A
|
|
04716 ELSE DTSCS1A
|
|
04717 GO TO S4000-EXIT DTSCS1A
|
|
04718 END-IF DTSCS1A
|
|
04719 END-IF. DTSCS1A
|
|
04720 DTSCS1A
|
|
04721 IF MTAD-ST = 'DC' DTSCS1A
|
|
04722 SET WRK-DC-ADDR-YES-88 TO TRUE DTSCS1A
|
|
04723 IF MTAD-DELIV-LINE-1(1:6) = 'PO BOX' DTSCS1A
|
|
04724 OR MTAD-DELIV-LINE-2(1:6) = 'PO BOX' DTSCS1A
|
|
04725 OR MTAD-DELIV-LINE-1(1:7) = 'P O BOX' DTSCS1A
|
|
04726 OR MTAD-DELIV-LINE-2(1:7) = 'P O BOX' DTSCS1A
|
|
04727 SET WRK-PO-BOX-YES-88 TO TRUE DTSCS1A
|
|
04728 ELSE DTSCS1A
|
|
04729 GO TO S4000-EXIT DTSCS1A
|
|
04730 END-IF DTSCS1A
|
|
04731 END-IF. DTSCS1A
|
|
04732 DTSCS1A
|
|
04733 MOVE LOW-VALUES TO DTSCS1A
|
|
04734 MTAD-KEY-AREA. DTSCS1A
|
|
04735 MOVE WRK-EMP-NO TO MTAD-EMP-NO. DTSCS1A
|
|
04736 SET MTAD-TAD-88 TO TRUE. DTSCS1A
|
|
04737 SET MTAD-ID-TAX-RECORDS-ADDR-88 TO TRUE. DTSCS1A
|
|
04738 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSCS1A
|
|
04739 PERFORM S810-READ THRU S810-EXIT. DTSCS1A
|
|
04740 IF L810-NO-REC-88 DTSCS1A
|
|
04741 IF WRK-DC-ADDR-NO-88 DTSCS1A
|
|
04742 MOVE MSG-E1A7-AREA TO WRK-MSG-AREA DTSCS1A
|
|
04743 PERFORM S4001-ERROR THRU S4001-EXIT DTSCS1A
|
|
04744 GO TO S4000-EXIT DTSCS1A
|
|
04745 ELSE DTSCS1A
|
|
04746 IF WRK-PO-BOX-YES-88 DTSCS1A
|
|
04747 MOVE MSG-E1A8-AREA TO WRK-MSG-AREA DTSCS1A
|
|
04748 PERFORM S4001-ERROR THRU S4001-EXIT DTSCS1A
|
|
04749 GO TO S4000-EXIT DTSCS1A
|
|
04750 END-IF DTSCS1A
|
|
04751 END-IF DTSCS1A
|
|
04752 END-IF. DTSCS1A
|
|
04753 DTSCS1A
|
|
04754 MOVE MSKL-REC TO MTAD-REC. DTSCS1A
|
|
04755 IF MTAD-ST = 'DC' DTSCS1A
|
|
04756 IF MTAD-DELIV-LINE-1(1:6) = 'PO BOX' DTSCS1A
|
|
04757 OR MTAD-DELIV-LINE-2(1:6) = 'PO BOX' DTSCS1A
|
|
04758 OR MTAD-DELIV-LINE-1(1:7) = 'P O BOX' DTSCS1A
|
|
04759 OR MTAD-DELIV-LINE-2(1:7) = 'P O BOX' DTSCS1A
|
|
04760 MOVE MSG-E1A8-AREA TO WRK-MSG-AREA DTSCS1A
|
|
04761 PERFORM S4001-ERROR THRU S4001-EXIT DTSCS1A
|
|
04762 ELSE DTSCS1A
|
|
04763 GO TO S4000-EXIT DTSCS1A
|
|
04764 END-IF DTSCS1A
|
|
04765 ELSE DTSCS1A
|
|
04766 MOVE MSG-E1A7-AREA TO WRK-MSG-AREA DTSCS1A
|
|
04767 PERFORM S4001-ERROR THRU S4001-EXIT DTSCS1A
|
|
04768 END-IF. DTSCS1A
|
|
04769 DTSCS1A
|
|
04770 S4000-EXIT. EXIT. DTSCS1A
|
|
04771 DTSCS1A
|
|
04772 S4001-ERROR. DTSCS1A
|
|
04773 MOVE CATB-CURSOR TO MAP-VERIFY-L DTSCS1A
|
|
04774 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-VERIFY-A DTSCS1A
|
|
04775 MOVE CATB-ASKIP-BRT-MDTOFF TO MAP-VERIFY-LIT-A DTSCS1A
|
|
04776 MOVE 'VERIFY?' TO MAP-VERIFY-LIT DTSCS1A
|
|
04777 DTSCS1A
|
|
04778 * MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-RECEIVED-MO-A. DTSCS1A
|
|
04779 DTSCS1A
|
|
04780 IF LCCM-NO-MSG DTSCS1A
|
|
04781 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A
|
|
04782 MOVE CATB-CURSOR TO MAP-RECEIVED-MO-L DTSCS1A
|
|
04783 SET CURSOR-SET-YES TO TRUE DTSCS1A
|
|
04784 * IF LCCM-OP-IS-FLD-DESK-88 DTSCS1A
|
|
04785 * OR LCCM-OP-IS-ACCOUNTING-DESK-88 DTSCS1A
|
|
04786 * MOVE CATB-CURSOR TO MAP-VERIFY-L DTSCS1A
|
|
04787 * MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-VERIFY-A DTSCS1A
|
|
04788 * MOVE CATB-ASKIP-BRT-MDTOFF TO MAP-VERIFY-LIT-A DTSCS1A
|
|
04789 * MOVE 'VERIFY?' TO MAP-VERIFY-LIT DTSCS1A
|
|
04790 END-IF. DTSCS1A
|
|
04791 S4001-EXIT. EXIT. DTSCS1A
|
|
04792 DTSCS1A
|
|
04793 ******************************************************************DTSCS1A
|
|
04794 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCS1A
|
|
04795 ******************************************************************DTSCS1A
|
|
04796 S5100-SET-LOCK-ATTRB. DTSCS1A
|
|
04797 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS1A
|
|
04798 WRK-ATB-NUM. DTSCS1A
|
|
04799 DTSCS1A
|
|
04800 DTSCS1A
|
|
04801 MOVE MAP-ATTN-LINE-A TO HOLD-ATTN-LINE-A. DTSCS1A
|
|
04802 DTSCS1A
|
|
04803 MOVE MAP-DELIV-LINE-1-A TO HOLD-DELIV-LINE-1-A. DTSCS1A
|
|
04804 DTSCS1A
|
|
04805 MOVE MAP-DELIV-LINE-2-A TO HOLD-DELIV-LINE-2-A. DTSCS1A
|
|
04806 DTSCS1A
|
|
04807 MOVE MAP-CITY-A TO HOLD-CITY-A. DTSCS1A
|
|
04808 DTSCS1A
|
|
04809 MOVE MAP-ST-A TO HOLD-ST-A. DTSCS1A
|
|
04810 DTSCS1A
|
|
04811 MOVE MAP-ZIP-A TO HOLD-ZIP-A. DTSCS1A
|
|
04812 DTSCS1A
|
|
04813 DTSCS1A
|
|
04814 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS1A
|
|
04815 DTSCS1A
|
|
04816 DTSCS1A
|
|
04817 IF HOLD-ATTN-LINE-A = CATB-UNPROT-NORM-AN-MDTON DTSCS1A
|
|
04818 MOVE CATB-ASKIP-NORM-MDTON TO MAP-ATTN-LINE-A. DTSCS1A
|
|
04819 DTSCS1A
|
|
04820 IF HOLD-DELIV-LINE-1-A = CATB-UNPROT-NORM-AN-MDTON DTSCS1A
|
|
04821 MOVE CATB-ASKIP-NORM-MDTON TO MAP-DELIV-LINE-1-A. DTSCS1A
|
|
04822 DTSCS1A
|
|
04823 IF HOLD-DELIV-LINE-2-A = CATB-UNPROT-NORM-AN-MDTON DTSCS1A
|
|
04824 MOVE CATB-ASKIP-NORM-MDTON TO MAP-DELIV-LINE-2-A. DTSCS1A
|
|
04825 DTSCS1A
|
|
04826 IF HOLD-CITY-A = CATB-UNPROT-NORM-AN-MDTON DTSCS1A
|
|
04827 MOVE CATB-ASKIP-NORM-MDTON TO MAP-CITY-A. DTSCS1A
|
|
04828 DTSCS1A
|
|
04829 IF HOLD-ST-A = CATB-UNPROT-NORM-AN-MDTON DTSCS1A
|
|
04830 MOVE CATB-ASKIP-NORM-MDTON TO MAP-ST-A. DTSCS1A
|
|
04831 DTSCS1A
|
|
04832 IF HOLD-ZIP-A = CATB-UNPROT-NORM-AN-MDTON DTSCS1A
|
|
04833 MOVE CATB-ASKIP-NORM-MDTON TO MAP-ZIP-A. DTSCS1A
|
|
04834 DTSCS1A
|
|
04835 DTSCS1A
|
|
04836 MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-NO-1-A DTSCS1A
|
|
04837 MAP-EMP-NO-2-A DTSCS1A
|
|
04838 MAP-GOTO-A. DTSCS1A
|
|
04839 S5100-EXIT. DTSCS1A
|
|
04840 EXIT. DTSCS1A
|
|
04841 SKIP3 DTSCS1A
|
|
04842 ******************************************************************DTSCS1A
|
|
04843 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS1A
|
|
04844 ******************************************************************DTSCS1A
|
|
04845 S5200-SET-UPDATE-ATTRB. DTSCS1A
|
|
04846 MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN. DTSCS1A
|
|
04847 DTSCS1A
|
|
04848 MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM. DTSCS1A
|
|
04849 DTSCS1A
|
|
04850 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS1A
|
|
04851 S5200-EXIT. DTSCS1A
|
|
04852 EXIT. DTSCS1A
|
|
04853 SKIP3 DTSCS1A
|
|
04854 ******************************************************************DTSCS1A
|
|
04855 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS1A
|
|
04856 ******************************************************************DTSCS1A
|
|
04857 S5300-SET-INQ-ATTRB. DTSCS1A
|
|
04858 MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN DTSCS1A
|
|
04859 WRK-ATB-NUM. DTSCS1A
|
|
04860 DTSCS1A
|
|
04861 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS1A
|
|
04862 S5300-EXIT. DTSCS1A
|
|
04863 EXIT. DTSCS1A
|
|
04864 SKIP3 DTSCS1A
|
|
04865 S5900-SET-ATTRB. DTSCS1A
|
|
04866 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS1A
|
|
04867 MAP-EMP-NO-2-A. DTSCS1A
|
|
04868 DTSCS1A
|
|
04869 MOVE WRK-ATB-AN TO MAP-DELETE-EMP-IND-A DTSCS1A
|
|
04870 MAP-ELIGIBLE-CD-A DTSCS1A
|
|
04871 MAP-PRIMARY-NAME-A DTSCS1A
|
|
04872 MAP-ENTITY-NAME-IND-A DTSCS1A
|
|
04873 MAP-ENTITY-NAME-A DTSCS1A
|
|
04874 MAP-CASS-IND-A DTSCS1A
|
|
04875 MAP-ATTN-LINE-A DTSCS1A
|
|
04876 MAP-ATTN-LINE-A DTSCS1A
|
|
04877 MAP-FISC-AGNT-CD-A DTSCS1A
|
|
04878 MAP-DELIV-LINE-1-A DTSCS1A
|
|
04879 MAP-DELIV-LINE-2-A DTSCS1A
|
|
04880 MAP-CITY-A DTSCS1A
|
|
04881 MAP-ST-A DTSCS1A
|
|
04882 MAP-ZIP-A DTSCS1A
|
|
04883 MAP-SOURCE-CD-A DTSCS1A
|
|
04884 MAP-POT-HOUSEHOLD-A DTSCS1A
|
|
04885 MAP-CLAIMANT-NAME-A DTSCS1A
|
|
04886 MAP-RESP-OP-ID-A DTSCS1A
|
|
04887 MAP-NOTE-A. DTSCS1A
|
|
04888 DTSCS1A
|
|
04889 MOVE WRK-ATB-NUM TO MAP-VOICE-1-AREA-CD-A DTSCS1A
|
|
04890 MAP-VOICE-1-PREFIX-A DTSCS1A
|
|
04891 MAP-VOICE-1-SUFFIX-A DTSCS1A
|
|
04892 MAP-VOICE-1-EXT-A DTSCS1A
|
|
04893 MAP-VOICE-2-AREA-CD-A DTSCS1A
|
|
04894 MAP-VOICE-2-PREFIX-A DTSCS1A
|
|
04895 MAP-VOICE-2-SUFFIX-A DTSCS1A
|
|
04896 MAP-VOICE-2-EXT-A DTSCS1A
|
|
04897 MAP-FAX-AREA-CD-A DTSCS1A
|
|
04898 MAP-FAX-PREFIX-A DTSCS1A
|
|
04899 MAP-FAX-SUFFIX-A DTSCS1A
|
|
04900 MAP-FAX-EXT-A DTSCS1A
|
|
04901 MAP-FEIN-1-A DTSCS1A
|
|
04902 MAP-FEIN-2-A DTSCS1A
|
|
04903 MAP-CLAIMANT-SSN-1-A DTSCS1A
|
|
04904 MAP-CLAIMANT-SSN-2-A DTSCS1A
|
|
04905 MAP-CLAIMANT-SSN-3-A DTSCS1A
|
|
04906 MAP-PRED-EMP-NO-1-A DTSCS1A
|
|
04907 MAP-PRED-EMP-NO-2-A DTSCS1A
|
|
04908 MAP-STATUS-CD-A DTSCS1A
|
|
04909 MAP-LETTER-1-CD-A DTSCS1A
|
|
04910 MAP-MAIL-1-MO-A DTSCS1A
|
|
04911 MAP-MAIL-1-DA-A DTSCS1A
|
|
04912 MAP-MAIL-1-YR-A DTSCS1A
|
|
04913 MAP-MAIL-2-MO-A DTSCS1A
|
|
04914 MAP-MAIL-2-DA-A DTSCS1A
|
|
04915 MAP-MAIL-2-YR-A DTSCS1A
|
|
04916 MAP-RECEIVED-MO-A DTSCS1A
|
|
04917 MAP-RECEIVED-DA-A DTSCS1A
|
|
04918 MAP-RECEIVED-YR-A DTSCS1A
|
|
04919 MAP-COOP-AGENCY-REQ-MO-A DTSCS1A
|
|
04920 MAP-COOP-AGENCY-REQ-DA-A DTSCS1A
|
|
04921 MAP-COOP-AGENCY-REQ-YR-A DTSCS1A
|
|
04922 MAP-DETER-NOTSUB-MO-A DTSCS1A
|
|
04923 MAP-DETER-NOTSUB-DA-A DTSCS1A
|
|
04924 MAP-DETER-NOTSUB-YR-A DTSCS1A
|
|
04925 MAP-FIELD-ASSIGN-MO-A DTSCS1A
|
|
04926 MAP-FIELD-ASSIGN-DA-A DTSCS1A
|
|
04927 MAP-FIELD-ASSIGN-YR-A. DTSCS1A
|
|
04928 DTSCS1A
|
|
04929 MOVE CATB-ASKIP-BRT-MDTOFF TO MAP-FLD-REP-ID-A. DTSCS1A
|
|
04930 DTSCS1A
|
|
04931 MOVE CATB-ASKIP-DRK-MDTOFF TO MAP-VERIFY-A. DTSCS1A
|
|
04932 MOVE CATB-ASKIP-DRK-MDTOFF TO MAP-VERIFY-LIT-A. DTSCS1A
|
|
04933 DTSCS1A
|
|
04934 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS1A
|
|
04935 S5900-EXIT. DTSCS1A
|
|
04936 EXIT. DTSCS1A
|
|
04937 EJECT DTSCS1A
|
|
04938 S8000-TICKLE. DTSCS1A
|
|
04939 MOVE LOW-VALUES TO MTCK-REC. DTSCS1A
|
|
04940 DTSCS1A
|
|
04941 MOVE WRK-EMP-NO TO MTCK-EMP-NO. DTSCS1A
|
|
04942 DTSCS1A
|
|
04943 SET MTCK-TCK-88 TO TRUE. DTSCS1A
|
|
04944 DTSCS1A
|
|
04945 MOVE LCCM-TASK-START-ABSTIME TO MTCK-ESTB-ABSTIME. DTSCS1A
|
|
04946 DTSCS1A
|
|
04947 MOVE ZEROS TO MTCK-PURGE-DATE DTSCS1A
|
|
04948 DTSCS1A
|
|
04949 SET MTCK-TYPE-CYCLE-A-88 TO TRUE. DTSCS1A
|
|
04950 DTSCS1A
|
|
04951 MOVE LCCM-CURR-RUN-DATE TO MTCK-TRIGGER-DATE DTSCS1A
|
|
04952 DTSCS1A
|
|
04953 MOVE ZEROS TO MTCK-ACKNOWLEDGED-DATE. DTSCS1A
|
|
04954 DTSCS1A
|
|
04955 MOVE 'SYSTEM' TO MTCK-SOURCE-OP-ID. DTSCS1A
|
|
04956 DTSCS1A
|
|
04957 MOVE 'SYSTEM' TO MTCK-DEST-OP-ID. DTSCS1A
|
|
04958 DTSCS1A
|
|
04959 SET MTCK-NOT-CONVERTED-88 TO TRUE. DTSCS1A
|
|
04960 DTSCS1A
|
|
04961 MOVE LCCM-CURR-RUN-DATE TO MTCK-ESTB-DATE. DTSCS1A
|
|
04962 DTSCS1A
|
|
04963 MOVE LCCM-CURR-RUN-DATE TO MTCK-CHNG-DATE. DTSCS1A
|
|
04964 DTSCS1A
|
|
04965 MOVE ZEROS TO MTCK-TEXT-CNT. DTSCS1A
|
|
04966 DTSCS1A
|
|
04967 MOVE MTCK-REC TO MSKL-REC. DTSCS1A
|
|
04968 DTSCS1A
|
|
04969 PERFORM S810-WRITE THRU S810-EXIT. DTSCS1A
|
|
04970 S8000-EXIT. EXIT. DTSCS1A
|
|
04971 /*****************************************************************DTSCS1A
|
|
04972 * MAP ROUTINES *DTSCS1A
|
|
04973 ******************************************************************DTSCS1A
|
|
04974 S9100-RECEIVE. DTSCS1A
|
|
04975 SET L851-RECEIVE-88 TO TRUE. DTSCS1A
|
|
04976 DTSCS1A
|
|
04977 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS1A
|
|
04978 DTSCS1A
|
|
04979 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS1A
|
|
04980 DTSCS1A
|
|
04981 MOVE L851-AID TO LCCM-AID. DTSCS1A
|
|
04982 DTSCS1A
|
|
04983 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS1A
|
|
04984 S9100-EXIT. DTSCS1A
|
|
04985 EXIT. DTSCS1A
|
|
04986 SKIP3 DTSCS1A
|
|
04987 S9200-SEND-DATAONLY. DTSCS1A
|
|
04988 MOVE LOW-VALUES TO MAP-AREA. DTSCS1A
|
|
04989 DTSCS1A
|
|
04990 IF LCCM-NO-MSG DTSCS1A
|
|
04991 NEXT SENTENCE DTSCS1A
|
|
04992 ELSE DTSCS1A
|
|
04993 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS1A
|
|
04994 DTSCS1A
|
|
04995 IF CURSOR-SET-GOTO DTSCS1A
|
|
04996 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS1A
|
|
04997 ELSE DTSCS1A
|
|
04998 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS1A
|
|
04999 DTSCS1A
|
|
05000 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS1A
|
|
05001 DTSCS1A
|
|
05002 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS1A
|
|
05003 DTSCS1A
|
|
05004 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS1A
|
|
05005 S9200-EXIT. DTSCS1A
|
|
05006 EXIT. DTSCS1A
|
|
05007 SKIP3 DTSCS1A
|
|
05008 S9300-SEND-MAP. DTSCS1A
|
|
05009 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS1A
|
|
05010 DTSCS1A
|
|
05011 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS1A
|
|
05012 DTSCS1A
|
|
05013 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS1A
|
|
05014 DTSCS1A
|
|
05015 IF SCR-ACCESS-UPDATE DTSCS1A
|
|
05016 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS1A
|
|
05017 ELSE DTSCS1A
|
|
05018 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS1A
|
|
05019 DTSCS1A
|
|
05020 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCS1A
|
|
05021 DTSCS1A
|
|
05022 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS1A
|
|
05023 DTSCS1A
|
|
05024 IF CURSOR-SET-NO DTSCS1A
|
|
05025 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS1A
|
|
05026 DTSCS1A
|
|
05027 SET L851-SEND-88 TO TRUE. DTSCS1A
|
|
05028 DTSCS1A
|
|
05029 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS1A
|
|
05030 DTSCS1A
|
|
05031 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS1A
|
|
05032 S9300-EXIT. DTSCS1A
|
|
05033 EXIT. DTSCS1A
|
|
05034 SKIP3 DTSCS1A
|
|
05035 S9310-UPDATE-FKEYS. DTSCS1A
|
|
05036 MOVE CFKD-ADD TO MAP-KEY-ADD. DTSCS1A
|
|
05037 DTSCS1A
|
|
05038 MOVE CFKD-MOD TO MAP-KEY-MOD. DTSCS1A
|
|
05039 DTSCS1A
|
|
05040 MOVE CFKD-DEL TO MAP-KEY-DEL. DTSCS1A
|
|
05041 DTSCS1A
|
|
05042 IF LCCM-SCR-CLEAR DTSCS1A
|
|
05043 MOVE LOW-VALUES TO MAP-KEY-MOD DTSCS1A
|
|
05044 MAP-KEY-DEL DTSCS1A
|
|
05045 ELSE DTSCS1A
|
|
05046 IF LCCM-SCR-INQUIRE DTSCS1A
|
|
05047 MOVE LOW-VALUES TO MAP-KEY-ADD DTSCS1A
|
|
05048 ELSE DTSCS1A
|
|
05049 IF LCCM-SCR-UPDATE-LOCKED DTSCS1A
|
|
05050 MOVE LOW-VALUES TO MAP-KEY-ADD DTSCS1A
|
|
05051 MAP-KEY-MOD DTSCS1A
|
|
05052 MAP-KEY-DEL DTSCS1A
|
|
05053 ELSE DTSCS1A
|
|
05054 NEXT SENTENCE. DTSCS1A
|
|
05055 S9310-EXIT. DTSCS1A
|
|
05056 EXIT. DTSCS1A
|
|
05057 SKIP3 DTSCS1A
|
|
05058 S9320-INQUIRY-FKEYS. DTSCS1A
|
|
05059 MOVE LOW-VALUES TO MAP-KEY-ADD DTSCS1A
|
|
05060 MAP-KEY-MOD DTSCS1A
|
|
05061 MAP-KEY-DEL. DTSCS1A
|
|
05062 S9320-EXIT. DTSCS1A
|
|
05063 EXIT. DTSCS1A
|
|
05064 SKIP3 DTSCS1A
|
|
05065 S9330-DSCR-FIELDS. DTSCS1A
|
|
05066 IF MAP-SOURCE-CD EQUAL LOW-VALUES OR SPACES DTSCS1A
|
|
05067 MOVE LOW-VALUES TO MAP-SOURCE-DESC DTSCS1A
|
|
05068 ELSE DTSCS1A
|
|
05069 MOVE MAP-SOURCE-CD TO L031-CD-2 DTSCS1A
|
|
05070 SET L031-MERA-SOURCE-CD TO TRUE DTSCS1A
|
|
05071 PERFORM S031-REG-CODES THRU S031-EXIT DTSCS1A
|
|
05072 MOVE L031-SHORT-DSCR TO MAP-SOURCE-DESC. DTSCS1A
|
|
05073 DTSCS1A
|
|
05074 DTSCS1A
|
|
05075 IF MAP-RESP-OP-ID EQUAL LOW-VALUES OR SPACES DTSCS1A
|
|
05076 MOVE LOW-VALUES TO MAP-RESP-OP-ID-DESC DTSCS1A
|
|
05077 ELSE DTSCS1A
|
|
05078 IF MAP-RESP-OP-ID = LCCM-OP-ID DTSCS1A
|
|
05079 MOVE LCCM-OP-NAME TO MAP-RESP-OP-ID-DESC DTSCS1A
|
|
05080 ELSE DTSCS1A
|
|
05081 MOVE MAP-RESP-OP-ID TO L082-OP-ID DTSCS1A
|
|
05082 PERFORM S082-OP-ID-LOOKUP THRU S082-EXIT DTSCS1A
|
|
05083 MOVE L082-NAME TO MAP-RESP-OP-ID-DESC. DTSCS1A
|
|
05084 DTSCS1A
|
|
05085 DTSCS1A
|
|
05086 IF (WRK-MPRF-YES-88) AND (NOT LCCM-SCR-CLEAR) DTSCS1A
|
|
05087 MOVE MPRF-FLD-ZIP-ST TO L061-FLD-ZIP-ST DTSCS1A
|
|
05088 MOVE WRK-EMP-NO TO L061-EMP-NO DTSCS1A
|
|
05089 PERFORM S061-FLD-REP-FIND THRU S061-EXIT DTSCS1A
|
|
05090 MOVE L061-FLD-REP-ID TO MAP-FLD-REP-ID DTSCS1A
|
|
05091 L062-FLD-REP-ID DTSCS1A
|
|
05092 PERFORM S062-FLD-REP-LOOKUP THRU S062-EXIT DTSCS1A
|
|
05093 MOVE L062-NAME TO MAP-FLD-REP-DESC DTSCS1A
|
|
05094 ELSE DTSCS1A
|
|
05095 MOVE LOW-VALUES TO MAP-FLD-REP-ID DTSCS1A
|
|
05096 MAP-FLD-REP-DESC. DTSCS1A
|
|
05097 DTSCS1A
|
|
05098 DTSCS1A
|
|
05099 IF MAP-STATUS-CD EQUAL LOW-VALUES OR SPACES DTSCS1A
|
|
05100 MOVE LOW-VALUES TO MAP-STATUS-DESC DTSCS1A
|
|
05101 ELSE DTSCS1A
|
|
05102 MOVE MAP-STATUS-CD TO L031-CD-2 DTSCS1A
|
|
05103 SET L031-MERA-STATUS-CD TO TRUE DTSCS1A
|
|
05104 PERFORM S031-REG-CODES THRU S031-EXIT DTSCS1A
|
|
05105 MOVE L031-SHORT-DSCR TO MAP-STATUS-DESC. DTSCS1A
|
|
05106 DTSCS1A
|
|
05107 DTSCS1A
|
|
05108 IF MAP-LETTER-1-CD EQUAL LOW-VALUES OR SPACES DTSCS1A
|
|
05109 MOVE LOW-VALUES TO MAP-LETTER-1-DESC DTSCS1A
|
|
05110 ELSE DTSCS1A
|
|
05111 MOVE MAP-LETTER-1-CD TO L031-CD-2 DTSCS1A
|
|
05112 SET L031-MERA-LETTER-1-CD TO TRUE DTSCS1A
|
|
05113 PERFORM S031-REG-CODES THRU S031-EXIT DTSCS1A
|
|
05114 MOVE L031-SHORT-DSCR TO MAP-LETTER-1-DESC. DTSCS1A
|
|
05115 DTSCS1A
|
|
05116 DTSCS1A
|
|
05117 MOVE MAP-PRED-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS1A
|
|
05118 DTSCS1A
|
|
05119 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS1A
|
|
05120 DTSCS1A
|
|
05121 IF L018-VALID DTSCS1A
|
|
05122 MOVE LOW-VALUES TO MPRF-KEY-AREA DTSCS1A
|
|
05123 MOVE L018-EMP-NO TO MPRF-EMP-NO DTSCS1A
|
|
05124 SET MPRF-PRF-88 TO TRUE DTSCS1A
|
|
05125 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA DTSCS1A
|
|
05126 PERFORM S810-READ THRU S810-EXIT DTSCS1A
|
|
05127 IF L810-OK-88 DTSCS1A
|
|
05128 MOVE MSKL-REC TO MPRF-REC DTSCS1A
|
|
05129 MOVE MPRF-PRIMARY-NAME TO MAP-PRED-NAME DTSCS1A
|
|
05130 ELSE DTSCS1A
|
|
05131 MOVE 'NAME NOT AVAILABLE' TO MAP-PRED-NAME DTSCS1A
|
|
05132 ELSE DTSCS1A
|
|
05133 MOVE LOW-VALUES TO MAP-PRED-NAME. DTSCS1A
|
|
05134 S9330-EXIT. EXIT. DTSCS1A
|
|
05135 SKIP3 DTSCS1A
|
|
05136 S9900-PREPARE-SEND. DTSCS1A
|
|
05137 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS1A
|
|
05138 LCCM-SCR-ID. DTSCS1A
|
|
05139 DTSCS1A
|
|
05140 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS1A
|
|
05141 DTSCS1A
|
|
05142 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS1A
|
|
05143 S9900-EXIT. DTSCS1A
|
|
05144 EXIT. DTSCS1A
|