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