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