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