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