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